40 use  fms_mod, 
only: file_exist, open_namelist_file,  &
    42                     stdlog, write_version_number,    &
    43                     mpp_pe, mpp_root_pe,             &
    81    real, 
dimension(maxmts) :: 
height = 0.
    82    real, 
dimension(maxmts) ::  
olon  = 0.
    83    real, 
dimension(maxmts) ::  
olat  = 0.
    84    real, 
dimension(maxmts) ::  
wlon  = 0.
    85    real, 
dimension(maxmts) ::  
wlat  = 0.
    86    real, 
dimension(maxmts) ::  
rlon  = 0.
    87    real, 
dimension(maxmts) ::  
rlat  = 0.
    95 #include<file_version.h>   135 real, 
intent(in)  :: lon(:), lat(:)
   136 real, 
intent(out) :: zsurf(:,:)
   141      call write_version_number(
"GAUSSIAN_TOPOG_MOD", version)
   144   if(any(shape(zsurf) /= (/
size(lon(:)),
size(lat(:))/))) 
then   145     call error_mesg (
'get_gaussian_topog in topography_mod', &
   146      'shape(zsurf) is not equal to (/size(lon),size(lat)/)', fatal)
   154     if ( 
height(n) == 0. ) cycle
   214                               olond, olatd, wlond, wlatd, rlond, rlatd ) &
   217 real, 
intent(in)  :: lon(:), lat(:)
   218 real, 
intent(in)  :: 
height   219 real, 
intent(in), 
optional :: olond, olatd, wlond, wlatd, rlond, rlatd
   220 real :: zsurf(
size(lon,1),
size(lat,1))
   224 real    :: tpi, dtr, dx, dy, xx, yy
   238   olon = 90.*dtr;  
if (
present(olond)) 
olon=olond*dtr
   239   olat = 45.*dtr;  
if (
present(olatd)) 
olat=olatd*dtr
   240   wlon = 15.*dtr;  
if (
present(wlond)) 
wlon=wlond*dtr
   241   wlat = 15.*dtr;  
if (
present(wlatd)) 
wlat=wlatd*dtr
   242   rlon =  0.    ;  
if (
present(rlond)) 
rlon=rlond*dtr
   243   rlat =  0.    ;  
if (
present(rlatd)) 
rlat=rlatd*dtr
   247       dy = abs(lat(j) - 
olat)   
   250         dx = abs(lon(i) - 
olon) 
   251         dx = 
min(dx, abs(dx-tpi))  
   253         zsurf(i,j) = 
height*exp(-xx**2 - yy**2)
   264    integer :: unit, ierr, io
   269 #ifdef INTERNAL_FILE_NML   273    if ( file_exist(
'input.nml')) 
then   274       unit = open_namelist_file( )
   275       ierr=1; 
do while (ierr /= 0)
   276          read  (unit, nml=gaussian_topog_nml, iostat=io, end=10)
   279  10   
call close_file (unit)
   285    if (mpp_pe() == mpp_root_pe()) 
then   287       write (unit, nml=gaussian_topog_nml)
 
real, dimension(maxmts) olat
 
integer function, public check_nml_error(IOSTAT, NML_NAME)
 
character(len=input_str_length), dimension(:), allocatable, target, public input_nml_file
 
logical module_is_initialized
 
subroutine, public gaussian_topog_init(lon, lat, zsurf)
 
real, dimension(maxmts) height
 
real, dimension(maxmts) rlon
 
real, dimension(maxmts) olon
 
real, dimension(maxmts) wlon
 
integer, parameter maxmts
 
real function, dimension(size(lon, 1), size(lat, 1)), public get_gaussian_topog(lon, lat, height, olond, olatd, wlond, wlatd, rlond, rlatd)
 
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> tlevel if(PRESENT(start_in) .AND. PRESENT(axsiz_in)) then if(size(start(! the data domain and compute domain must refer to the subdomain being passed ! In this ! since that attempts to gather all data on PE size(field%axes(:)) axsiz(i)
 
real, dimension(maxmts) rlat
 
subroutine, public error_mesg(routine, message, level)
 
real(fp), parameter, public pi
 
real, dimension(maxmts) wlat