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