ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
ana_grid.h File Reference
This graph shows which files directly or indirectly include this file:

Go to the source code of this file.

Functions/Subroutines

subroutine ana_grid (ng, tile, model)
 
subroutine ana_grid_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, angler, dmde, dndx, zice, lonp, lonr, lonu, lonv, latp, latr, latu, latv, xp, xr, xu, xv, yp, yr, yu, yv, pn, pm, f, h)
 

Function/Subroutine Documentation

◆ ana_grid()

subroutine ana_grid ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_grid.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets model grid using an analytical expressions. !
12! !
13! On Output: stored in common blocks: !
14! !
15! "grid" (file grid.h) !
16! "scalars" (file scalar.h) !
17! !
18! el Length (m) of domain box in the ETA-direction. !
19! f Coriolis parameter (1/seconds) at RHO-points. !
20! h Bathymetry (meters; positive) at RHO-points. !
21! hmin Minimum depth of bathymetry (m). !
22! hmax Maximum depth of bathymetry (m). !
23! pm Coordinate transformation metric "m" (1/meters) !
24! associated with the differential distances in XI !
25! at RHO-points. !
26! pn Coordinate transformation metric "n" (1/meters) !
27! associated with the differential distances in ETA. !
28! at RHO-points. !
29! xl Length (m) of domain box in the XI-direction. !
30! xp XI-coordinates (m) at PSI-points. !
31! xr XI-coordinates (m) at RHO-points. !
32! yp ETA-coordinates (m) at PSI-points. !
33! yr ETA-coordinates (m) at RHO-points. !
34! !
35!=======================================================================
36!
37 USE mod_param
38 USE mod_grid
39 USE mod_ncparam
40!
41! Imported variable declarations.
42!
43 integer, intent(in) :: ng, tile, model
44!
45! Local variable declarations.
46!
47 character (len=*), parameter :: MyFile = &
48 & __FILE__
49!
50#include "tile.h"
51!
52 CALL ana_grid_tile (ng, tile, model, &
53 & lbi, ubi, lbj, ubj, &
54 & imins, imaxs, jmins, jmaxs, &
55 & grid(ng) % angler, &
56#if defined CURVGRID && defined UV_ADV
57 & grid(ng) % dmde, &
58 & grid(ng) % dndx, &
59#endif
60#ifdef ICESHELF
61 & grid(ng) % zice, &
62#endif
63#ifdef SPHERICAL
64 & grid(ng) % lonp, &
65 & grid(ng) % lonr, &
66 & grid(ng) % lonu, &
67 & grid(ng) % lonv, &
68 & grid(ng) % latp, &
69 & grid(ng) % latr, &
70 & grid(ng) % latu, &
71 & grid(ng) % latv, &
72#else
73 & grid(ng) % xp, &
74 & grid(ng) % xr, &
75 & grid(ng) % xu, &
76 & grid(ng) % xv, &
77 & grid(ng) % yp, &
78 & grid(ng) % yr, &
79 & grid(ng) % yu, &
80 & grid(ng) % yv, &
81#endif
82 & grid(ng) % pn, &
83 & grid(ng) % pm, &
84 & grid(ng) % f, &
85 & grid(ng) % h)
86!
87! Set analytical header file name used.
88!
89#ifdef DISTRIBUTE
90 IF (lanafile) THEN
91#else
92 IF (lanafile.and.(tile.eq.0)) THEN
93#endif
94 ananame( 7)=myfile
95 END IF
96!
97 RETURN
ana_grid_tile
subroutine ana_grid_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, angler, dmde, dndx, zice, lonp, lonr, lonu, lonv, latp, latr, latu, latv, xp, xr, xu, xv, yp, yr, yu, yv, pn, pm, f, h)
Definition ana_grid.h:119
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::lanafile
logical lanafile
Definition mod_ncparam.F:602
mod_ncparam::ananame
character(len=256), dimension(39) ananame
Definition mod_ncparam.F:604
mod_param
Definition mod_param.F:2

References ana_grid_tile(), mod_ncparam::ananame, mod_grid::grid, and mod_ncparam::lanafile.

Referenced by ana_grid_tile(), checkdefs(), and set_grid().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_grid_tile()

subroutine ana_grid_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) angler,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) dmde,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) dndx,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) zice,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) lonp,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) lonr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) lonu,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) lonv,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) latp,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) latr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) latu,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) latv,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) xp,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) xr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) xu,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) xv,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) yp,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) yr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) yu,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) yv,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) pn,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) pm,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) f,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) h )

Definition at line 101 of file ana_grid.h.

119!***********************************************************************
120!
121 USE mod_param
122 USE mod_parallel
123 USE mod_ncparam
124 USE mod_iounits
125 USE mod_scalars
126!
127 USE exchange_2d_mod, ONLY : exchange_r2d_tile
128#ifdef DISTRIBUTE
129 USE mp_exchange_mod, ONLY : mp_exchange2d
130#endif
131 USE stats_mod, ONLY : stats_2dfld
132!
133! Imported variable declarations.
134!
135 integer, intent(in) :: ng, tile, model
136 integer, intent(in) :: LBi, UBi, LBj, UBj
137 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
138!
139#ifdef ASSUMED_SHAPE
140 real(r8), intent(out) :: angler(LBi:,LBj:)
141# if defined CURVGRID && defined UV_ADV
142 real(r8), intent(out) :: dmde(LBi:,LBj:)
143 real(r8), intent(out) :: dndx(LBi:,LBj:)
144# endif
145# ifdef ICESHELF
146 real(r8), intent(out) :: zice(LBi:,LBj:)
147# endif
148# ifdef SPHERICAL
149 real(r8), intent(out) :: lonp(LBi:,LBj:)
150 real(r8), intent(out) :: lonr(LBi:,LBj:)
151 real(r8), intent(out) :: lonu(LBi:,LBj:)
152 real(r8), intent(out) :: lonv(LBi:,LBj:)
153 real(r8), intent(out) :: latp(LBi:,LBj:)
154 real(r8), intent(out) :: latr(LBi:,LBj:)
155 real(r8), intent(out) :: latu(LBi:,LBj:)
156 real(r8), intent(out) :: latv(LBi:,LBj:)
157# else
158 real(r8), intent(out) :: xp(LBi:,LBj:)
159 real(r8), intent(out) :: xr(LBi:,LBj:)
160 real(r8), intent(out) :: xu(LBi:,LBj:)
161 real(r8), intent(out) :: xv(LBi:,LBj:)
162 real(r8), intent(out) :: yp(LBi:,LBj:)
163 real(r8), intent(out) :: yr(LBi:,LBj:)
164 real(r8), intent(out) :: yu(LBi:,LBj:)
165 real(r8), intent(out) :: yv(LBi:,LBj:)
166# endif
167 real(r8), intent(out) :: pn(LBi:,LBj:)
168 real(r8), intent(out) :: pm(LBi:,LBj:)
169 real(r8), intent(out) :: f(LBi:,LBj:)
170 real(r8), intent(out) :: h(LBi:,LBj:)
171#else
172 real(r8), intent(out) :: angler(LBi:UBi,LBj:UBj)
173# if defined CURVGRID && defined UV_ADV
174 real(r8), intent(out) :: dmde(LBi:UBi,LBj:UBj)
175 real(r8), intent(out) :: dndx(LBi:UBi,LBj:UBj)
176# endif
177# ifdef ICESHELF
178 real(r8), intent(out) :: zice(LBi:UBi,LBj:UBj)
179# endif
180# ifdef SPHERICAL
181 real(r8), intent(out) :: lonp(LBi:UBi,LBj:UBj)
182 real(r8), intent(out) :: lonr(LBi:UBi,LBj:UBj)
183 real(r8), intent(out) :: lonu(LBi:UBi,LBj:UBj)
184 real(r8), intent(out) :: lonv(LBi:UBi,LBj:UBj)
185 real(r8), intent(out) :: latp(LBi:UBi,LBj:UBj)
186 real(r8), intent(out) :: latr(LBi:UBi,LBj:UBj)
187 real(r8), intent(out) :: latu(LBi:UBi,LBj:UBj)
188 real(r8), intent(out) :: latv(LBi:UBi,LBj:UBj)
189# else
190 real(r8), intent(out) :: xp(LBi:UBi,LBj:UBj)
191 real(r8), intent(out) :: xr(LBi:UBi,LBj:UBj)
192 real(r8), intent(out) :: xu(LBi:UBi,LBj:UBj)
193 real(r8), intent(out) :: xv(LBi:UBi,LBj:UBj)
194 real(r8), intent(out) :: yp(LBi:UBi,LBj:UBj)
195 real(r8), intent(out) :: yr(LBi:UBi,LBj:UBj)
196 real(r8), intent(out) :: yu(LBi:UBi,LBj:UBj)
197 real(r8), intent(out) :: yv(LBi:UBi,LBj:UBj)
198# endif
199 real(r8), intent(out) :: pn(LBi:UBi,LBj:UBj)
200 real(r8), intent(out) :: pm(LBi:UBi,LBj:UBj)
201 real(r8), intent(out) :: f(LBi:UBi,LBj:UBj)
202 real(r8), intent(out) :: h(LBi:UBi,LBj:UBj)
203#endif
204!
205! Local variable declarations.
206!
207 logical, save :: first = .true.
208!
209 integer :: Imin, Imax, Jmin, Jmax
210 integer :: i, ival, j, k
211!
212 real(r8), parameter :: twopi = 2.0_r8*pi
213
214 real(r8) :: Esize, Xsize, beta, cff, depth, dth
215 real(r8) :: dx, dy, f0, r, theta, val1, val2
216
217#ifdef WEDDELL
218 real(r8) :: hwrk(-1:235), xwrk(-1:235), zwrk
219#endif
220 real(r8) :: wrkX(IminS:ImaxS,JminS:JmaxS)
221 real(r8) :: wrkY(IminS:ImaxS,JminS:JmaxS)
222!
223 TYPE (T_STATS), save :: Stats(16)
224
225#include "set_bounds.h"
226!
227!-----------------------------------------------------------------------
228! Set grid parameters:
229!
230! Xsize Length (m) of domain box in the XI-direction.
231! Esize Length (m) of domain box in the ETA-direction.
232! depth Maximum depth of bathymetry (m).
233! f0 Coriolis parameter, f-plane constant (1/s).
234! beta Coriolis parameter, beta-plane constant (1/s/m).
235!-----------------------------------------------------------------------
236!
237#if defined BASIN
238 xsize=3600.0e+03_r8
239 esize=2800.0e+03_r8
240 depth=5000.0_r8
241 f0=1.0e-04_r8
242 beta=2.0e-11_r8
243#elif defined BENCHMARK
244 xsize=360.0_r8 ! degrees of longitude
245 esize=20.0_r8 ! degrees of latitude
246 depth=4000.0_r8
247 f0=-1.0e-04_r8
248 beta=2.0e-11_r8
249#elif defined BL_TEST
250 xsize=100.0e+03_r8
251 esize=5.0e+03_r8
252 depth=47.5_r8
253 f0=9.25e-04_r8
254 beta=0.0_r8
255#elif defined CHANNEL
256 xsize=600.0e+03_r8
257 esize=360.0e+03_r8
258 depth=500.0_r8
259 f0=1.0e-04_r8
260 beta=0.0_r8
261#elif defined CANYON
262 xsize=128.0e+03_r8
263 esize=96.0e+03_r8
264 depth=4000.0_r8
265 f0=1.0e-04_r8
266 beta=0.0_r8
267#elif defined COUPLING_TEST
268 xsize=6000.0_r8*real(lm(ng),r8)
269 esize=6000.0_r8*real(mm(ng),r8)
270 depth=1500.0_r8
271 f0=5.0e-05_r8
272 beta=0.0_r8
273#elif defined DOUBLE_GYRE
274 xsize=1000.0e+03_r8
275 esize=2000.0e+03_r8
276 depth=500.0_r8
277!! depth=5000.0_r8
278 f0=7.3e-05_r8
279 beta=2.0e-11_r8
280#elif defined ESTUARY_TEST
281 xsize=100000.0_r8
282 esize=300.0_r8
283 depth=10.0_r8
284 f0=0.0_r8
285 beta=0.0_r8
286#elif defined KELVIN
287 xsize=20000.0_r8*real(lm(ng),r8)
288 esize=20000.0_r8*real(mm(ng),r8)
289 depth=100.0_r8
290 f0=1.0e-04_r8
291 beta=0.0_r8
292#elif defined FLT_TEST
293 xsize=1.0e+03_r8*real(lm(ng),r8)
294 esize=1.0e+03_r8*real(mm(ng),r8)
295 depth=10.0_r8
296 f0=0.0_r8
297 beta=0.0_r8
298#elif defined GRAV_ADJ
299 xsize=64.0e+03_r8
300!! Esize=2.0E+03_r8
301 esize=mm(ng)*xsize/lm(ng)
302 depth=20.0_r8
303 f0=0.0_r8
304 beta=0.0_r8
305#elif defined LAB_CANYON
306 xsize=0.55_r8 ! width of annulus
307 esize=2.0_r8*pi ! azimuthal length (radians)
308 f0=4.0_r8*pi/25.0_r8
309 beta=0.0_r8
310#elif defined LAKE_SIGNELL
311 xsize=50.0e3_r8
312 esize=10.0e3_r8
313 depth=18.0_r8
314 f0=0.0e-04_r8
315 beta=0.0_r8
316#elif defined LMD_TEST
317 xsize=100.0e+03_r8
318 esize=100.0e+03_r8
319 depth=50.0_r8
320 f0=1.09e-04_r8
321 beta=0.0_r8
322# elif defined MIXED_LAYER
323 xsize=500.0_r8
324 esize=400.0_r8
325 depth=50.0_r8
326 f0=0.0_r8
327 beta=0.0_r8
328#elif defined OVERFLOW
329 xsize=4.0e+03_r8
330 esize=200.0e+03_r8
331 depth=4000.0_r8
332 f0=0.0_r8
333 beta=0.0_r8
334#elif defined RIVERPLUME1
335 xsize=58.5e+03_r8
336 esize=201.0e+03_r8
337 depth=150.0_r8
338 f0=1.0e-04_r8
339 beta=0.0_r8
340#elif defined RIVERPLUME2
341 xsize=100.0e+03_r8
342 esize=210.0e+03_r8
343 depth=190.0_r8
344 f0=1.0e-04_r8
345 beta=0.0_r8
346#elif defined SEAMOUNT
347 xsize=320.0e+03_r8
348 esize=320.0e+03_r8
349 depth=5000.0_r8
350!! f0=1.0E-04_r8
351 f0=0.0_r8
352 beta=0.0_r8
353#elif defined SOLITON
354!! Xsize=0.5_r8*REAL(Lm(ng),r8)
355!! Esize=0.5_r8*REAL(Mm(ng),r8)
356 xsize=48.0_r8
357 esize=16.0_r8
358 depth=1.0_r8
359 f0=0.0_r8
360 beta=1.0_r8
361 g=1.0_r8
362#elif defined SED_TEST1
363 xsize=300.0_r8
364 esize=36.0_r8
365 depth=10.0_r8
366 f0=0.0_r8
367 beta=0.0_r8
368#elif defined SED_TOY
369 xsize=40.0_r8
370 esize=30.0_r8
371 depth=0.5_r8
372 f0=0.0_r8
373 beta=0.0_r8
374# elif defined SHOREFACE
375 xsize=1180.0_r8
376 esize=140.0_r8
377 depth=15.0_r8
378 f0=0.0e-04_r8
379 beta=0.0_r8
380#elif defined TEST_CHAN
381 xsize=10000.0_r8
382 esize=1000.0_r8
383 depth=10.0_r8
384 f0=0.0_r8
385 beta=0.0_r8
386#elif defined UPWELLING
387 xsize=1000.0_r8*real(lm(ng),r8)
388 esize=1000.0_r8*real(mm(ng),r8)
389 depth=150.0_r8
390 f0=-8.26e-05_r8
391 beta=0.0_r8
392#elif defined WEDDELL
393 xsize=4000.0_r8*real(lm(ng),r8)
394 esize=4000.0_r8*real(mm(ng),r8)
395 depth=4500.0_r8
396 f0=0.0_r8
397 beta=0.0_r8
398#elif defined WINDBASIN
399 xsize=2000.0_r8*real(lm(ng),r8)
400 esize=1000.0_r8*real(mm(ng),r8)
401 depth=50.0_r8
402 f0=1.0e-04_r8
403 beta=0.0_r8
404#else
405 ana_grid.h: no values provided for xsize, esize, depth, f0, beta.
406#endif
407!
408! Load grid parameters to global storage.
409!
410 IF (domain(ng)%NorthEast_Test(tile)) THEN
411 xl(ng)=xsize
412 el(ng)=esize
413 END IF
414!
415!-----------------------------------------------------------------------
416! Initialize field statistics structure.
417!-----------------------------------------------------------------------
418!
419 IF (first) THEN
420 first=.false.
421 DO i=1,SIZE(stats,1)
422 stats(i) % checksum=0_i8b
423 stats(i) % count=0
424 stats(i) % min=large
425 stats(i) % max=-large
426 stats(i) % avg=0.0_r8
427 stats(i) % rms=0.0_r8
428 END DO
429 END IF
430 IF (domain(ng)%NorthEast_Corner(tile)) WRITE (stdout,'(1x)')
431!
432!-----------------------------------------------------------------------
433! Compute the (XI,ETA) coordinates at PSI- and RHO-points.
434! Set grid spacing (m).
435!-----------------------------------------------------------------------
436!
437! Determine I- and J-ranges for computing grid data. These ranges
438! are special in periodic boundary conditons since periodicity cannot
439! be imposed in the grid coordinates.
440!
441 IF (domain(ng)%Western_Edge(tile)) THEN
442 imin=istr-1
443 ELSE
444 imin=istr
445 END IF
446 IF (domain(ng)%Eastern_Edge(tile)) THEN
447 imax=iend+1
448 ELSE
449 imax=iend
450 END IF
451 IF (domain(ng)%Southern_Edge(tile)) THEN
452 jmin=jstr-1
453 ELSE
454 jmin=jstr
455 END IF
456 IF (domain(ng)%Northern_Edge(tile)) THEN
457 jmax=jend+1
458 ELSE
459 jmax=jend
460 END IF
461
462#if defined BENCHMARK
463!
464! Spherical coordinates set-up.
465!
466 dx=xsize/real(lm(ng),r8)
467 dy=esize/real(mm(ng),r8)
468 spherical=.true.
469 DO j=jmin,jmax
470 val1=-70.0_r8+dy*(real(j,r8)-0.5_r8)
471 val2=-70.0_r8+dy*real(j,r8)
472 DO i=imin,imax
473 lonr(i,j)=dx*(real(i,r8)-0.5_r8)
474 latr(i,j)=val1
475 lonu(i,j)=dx*real(i,r8)
476 lonp(i,j)=lonu(i,j)
477 latu(i,j)=latr(i,j)
478 lonv(i,j)=lonr(i,j)
479 latv(i,j)=val2
480 latp(i,j)=latv(i,j)
481 END DO
482 END DO
483#elif defined LAB_CANYON
484!
485! Polar coordinates set-up.
486!
487 dx=xsize/real(lm(ng),r8)
488 dy=esize/real(mm(ng),r8)
489!! dth=twopi/REAL(Mm(ng),r8) ! equal azimultal spacing
490 dth=0.01_r8 ! azimultal spacing
491 cff=(4.0_r8*pi/(dth*real(mm(ng),r8)))-1.0_r8 ! F
492 DO j=jmin,jmax
493 DO i=imin,imax
494 r=0.35_r8+dx*real(i-1,r8)
495 theta=-pi+ &
496 & 0.5_r8*dth*((cff+1.0_r8)*real(j-1,r8)+ &
497 & (cff-1.0_r8)*(real(mm(ng),r8)/twopi)* &
498 & sin(twopi*real(j-1,r8)/real(mm(ng),r8)))
499 xp(i,j)=r*cos(theta)
500 yp(i,j)=r*sin(theta)
501 r=0.35_r8+dx*(real(i-1,r8)+0.5_r8)
502 theta=-pi+ &
503 & 0.5_r8*dth*((cff+1.0_r8)*(real(j-1,r8)+0.5_r8)+ &
504 & (cff-1.0_r8)*(real(mm(ng),r8)/twopi)* &
505 & sin(twopi*(real(j-1,r8)+0.5_r8)/ &
506 & real(mm(ng),r8)))
507 xr(i,j)=r*cos(theta)
508 yr(i,j)=r*sin(theta)
509 xu(i,j)=xp(i,j)
510 yu(i,j)=yr(i,j)
511 xv(i,j)=xr(i,j)
512 yv(i,j)=yp(i,j)
513 END DO
514 END DO
515#else
516 dx=xsize/real(lm(ng),r8)
517 dy=esize/real(mm(ng),r8)
518 DO j=jmin,jmax
519 DO i=imin,imax
520# ifdef BL_TEST
521 dx=0.5_r8*(4000.0_r8/real(lm(ng)+1,r8))*real(i,r8)+675.0_r8
522# endif
523 xp(i,j)=dx*real(i-1,r8)
524 xr(i,j)=dx*(real(i-1,r8)+0.5_r8)
525 xu(i,j)=xp(i,j)
526 xv(i,j)=xr(i,j)
527 yp(i,j)=dy*real(j-1,r8)
528 yr(i,j)=dy*(real(j-1,r8)+0.5_r8)
529 yu(i,j)=yr(i,j)
530 yv(i,j)=yp(i,j)
531 END DO
532 END DO
533#endif
534!
535! Report statistics.
536!
537#ifdef SPHERICAL
538 CALL stats_2dfld (ng, tile, inlm, p2dvar, stats(1), 0, &
539 & lbi, ubi, lbj, ubj, lonp)
540 IF (domain(ng)%NorthEast_Corner(tile)) THEN
541 WRITE (stdout,10) 'longitude of PSI-points: lon_psi', &
542 & ng, stats(1)%min, stats(1)%max
543 END IF
544 CALL stats_2dfld (ng, tile, inlm, p2dvar, stats(2), 0, &
545 & lbi, ubi, lbj, ubj, latp)
546 IF (domain(ng)%NorthEast_Corner(tile)) THEN
547 WRITE (stdout,10) 'latitude of PSI-points: lat_psi', &
548 & ng, stats(2)%min, stats(2)%max
549 END IF
550
551 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(3), 0, &
552 & lbi, ubi, lbj, ubj, lonr)
553 IF (domain(ng)%NorthEast_Corner(tile)) THEN
554 WRITE (stdout,10) 'longitude of RHO-points: lon_rho', &
555 & ng, stats(3)%min, stats(3)%max
556 END IF
557 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(4), 0, &
558 & lbi, ubi, lbj, ubj, latr)
559 IF (domain(ng)%NorthEast_Corner(tile)) THEN
560 WRITE (stdout,10) 'latitude of RHO-points: lat_rho', &
561 & ng, stats(4)%min, stats(4)%max
562 END IF
563
564 CALL stats_2dfld (ng, tile, inlm, u2dvar, stats(5), 0, &
565 & lbi, ubi, lbj, ubj, lonu)
566 IF (domain(ng)%NorthEast_Corner(tile)) THEN
567 WRITE (stdout,10) 'longitude of U-points: lon_u', &
568 & ng, stats(5)%min, stats(5)%max
569 END IF
570 CALL stats_2dfld (ng, tile, inlm, u2dvar, stats(6), 0, &
571 & lbi, ubi, lbj, ubj, latu)
572 IF (domain(ng)%NorthEast_Corner(tile)) THEN
573 WRITE (stdout,10) 'latitude of U-points: lat_u', &
574 & ng, stats(6)%min, stats(6)%max
575 END IF
576
577 CALL stats_2dfld (ng, tile, inlm, v2dvar, stats(7), 0, &
578 & lbi, ubi, lbj, ubj, lonv)
579 IF (domain(ng)%NorthEast_Corner(tile)) THEN
580 WRITE (stdout,10) 'longitude of V-points: lon_v', &
581 & ng, stats(7)%min, stats(7)%max
582 END IF
583 CALL stats_2dfld (ng, tile, inlm, v2dvar, stats(8), 0, &
584 & lbi, ubi, lbj, ubj, latv)
585 IF (domain(ng)%NorthEast_Corner(tile)) THEN
586 WRITE (stdout,10) 'latitude of V-points: lat_v', &
587 & ng, stats(8)%min, stats(8)%max
588 END IF
589#else
590 CALL stats_2dfld (ng, tile, inlm, p2dvar, stats(1), 0, &
591 & lbi, ubi, lbj, ubj, xp)
592 IF (domain(ng)%NorthEast_Corner(tile)) THEN
593 WRITE (stdout,10) 'x-location of PSI-points: x_psi', &
594 & ng, stats(1)%min, stats(1)%max
595 END IF
596 CALL stats_2dfld (ng, tile, inlm, p2dvar, stats(2), 0, &
597 & lbi, ubi, lbj, ubj, yp)
598 IF (domain(ng)%NorthEast_Corner(tile)) THEN
599 WRITE (stdout,10) 'y-location of PSI-points: y_psi', &
600 & ng, stats(2)%min, stats(2)%max
601 END IF
602
603 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(3), 0, &
604 & lbi, ubi, lbj, ubj, xr)
605 IF (domain(ng)%NorthEast_Corner(tile)) THEN
606 WRITE (stdout,10) 'x-location of RHO-points: x_rho', &
607 & ng, stats(3)%min, stats(3)%max
608 END IF
609 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(4), 0, &
610 & lbi, ubi, lbj, ubj, yr)
611 IF (domain(ng)%NorthEast_Corner(tile)) THEN
612 WRITE (stdout,10) 'y-location of RHO-points: y_rho', &
613 & ng, stats(4)%min, stats(4)%max
614 END IF
615
616 CALL stats_2dfld (ng, tile, inlm, u2dvar, stats(5), 0, &
617 & lbi, ubi, lbj, ubj, xu)
618 IF (domain(ng)%NorthEast_Corner(tile)) THEN
619 WRITE (stdout,10) 'x-location of U-points: x_u', &
620 & ng, stats(5)%min, stats(5)%max
621 END IF
622 CALL stats_2dfld (ng, tile, inlm, u2dvar, stats(6), 0, &
623 & lbi, ubi, lbj, ubj, yu)
624 IF (domain(ng)%NorthEast_Corner(tile)) THEN
625 WRITE (stdout,10) 'y-location of U-points: y_u', &
626 & ng, stats(6)%min, stats(6)%max
627 END IF
628
629 CALL stats_2dfld (ng, tile, inlm, v2dvar, stats(7), 0, &
630 & lbi, ubi, lbj, ubj, xv)
631 IF (domain(ng)%NorthEast_Corner(tile)) THEN
632 WRITE (stdout,10) 'x-location of V-points: x_v', &
633 & ng, stats(7)%min, stats(7)%max
634 END IF
635 CALL stats_2dfld (ng, tile, inlm, v2dvar, stats(8), 0, &
636 & lbi, ubi, lbj, ubj, yv)
637 IF (domain(ng)%NorthEast_Corner(tile)) THEN
638 WRITE (stdout,10) 'y-location of V-points: y_v', &
639 & ng, stats(8)%min, stats(8)%max
640 END IF
641#endif
642
643#ifdef DISTRIBUTE
644!
645! Exchange boundary data.
646!
647# ifdef SPHERICAL
648 CALL mp_exchange2d (ng, tile, model, 4, &
649 & lbi, ubi, lbj, ubj, &
650 & nghostpoints, .false., .false., &
651 & lonp, lonr, lonu, lonv)
652 CALL mp_exchange2d (ng, tile, model, 4, &
653 & lbi, ubi, lbj, ubj, &
654 & nghostpoints, .false., .false., &
655 & latp, latr, latu, latv)
656# else
657 CALL mp_exchange2d (ng, tile, model, 4, &
658 & lbi, ubi, lbj, ubj, &
659 & nghostpoints, .false., .false., &
660 & xp, xr, xu, xv)
661 CALL mp_exchange2d (ng, tile, model, 4, &
662 & lbi, ubi, lbj, ubj, &
663 & nghostpoints, .false., .false., &
664 & yp, yr, yu, yv)
665# endif
666#endif
667!
668!-----------------------------------------------------------------------
669! Compute coordinate transformation metrics at RHO-points "pm" and
670! "pn" (1/m) associated with the differential distances in XI and
671! ETA, respectively.
672!-----------------------------------------------------------------------
673!
674#define J_RANGE MIN(JstrT,Jstr-1),MAX(Jend+1,JendT)
675#define I_RANGE MIN(IstrT,Istr-1),MAX(Iend+1,IendT)
676
677#if defined BENCHMARK
678!
679! Spherical coordinates set-up.
680!
681 val1=real(lm(ng),r8)/(2.0_r8*pi*eradius)
682 val2=real(mm(ng),r8)*360.0_r8/(2.0_r8*pi*eradius*esize)
683 DO j=j_range
684 cff=1.0_r8/cos((-70.0_r8+dy*(real(j,r8)-0.5_r8))*deg2rad)
685 DO i=i_range
686 wrkx(i,j)=val1*cff
687 wrky(i,j)=val2
688 END DO
689 END DO
690#elif defined LAB_CANYON
691!
692! Polar coordinates set-up.
693!
694 DO j=j_range
695 DO i=i_range
696 r=0.35_r8+dx*(real(i-1,r8)+0.5_r8)
697 theta=0.5_r8*dth*((cff+1.0_r8)+ &
698 & (cff-1.0_r8)* &
699 & cos(twopi*real(j-1,r8)/real(mm(ng),r8)))
700 wrkx(i,j)=1.0_r8/dx
701 wrky(i,j)=1.0_r8/(r*theta)
702 END DO
703 END DO
704#else
705 DO j=j_range
706 DO i=i_range
707# ifdef BL_TEST
708 dx=0.5_r8*(4000.0_r8/real(lm(ng)+1,r8))*real(i,r8)+675.0_r8
709# endif
710 wrkx(i,j)=1.0_r8/dx
711 wrky(i,j)=1.0_r8/dy
712 END DO
713 END DO
714#endif
715#undef J_RANGE
716#undef I_RANGE
717 DO j=jstrt,jendt
718 DO i=istrt,iendt
719 pm(i,j)=wrkx(i,j)
720 pn(i,j)=wrky(i,j)
721 END DO
722 END DO
723!
724! Report statistics.
725!
726 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(9), 0, &
727 & lbi, ubi, lbj, ubj, pm)
728 IF (domain(ng)%NorthEast_Corner(tile)) THEN
729 WRITE (stdout,10) 'reciprocal XI-grid spacing: pm', &
730 & ng, stats(9)%min, stats(9)%max
731 END IF
732 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(10), 0, &
733 & lbi, ubi, lbj, ubj, pn)
734 IF (domain(ng)%NorthEast_Corner(tile)) THEN
735 WRITE (stdout,10) 'reciprocal ETA-grid spacing: pn', &
736 & ng, stats(10)%min, stats(10)%max
737 END IF
738!
739! Exchange boundary data.
740!
741 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
742 CALL exchange_r2d_tile (ng, tile, &
743 & lbi, ubi, lbj, ubj, &
744 & pm)
745 CALL exchange_r2d_tile (ng, tile, &
746 & lbi, ubi, lbj, ubj, &
747 & pn)
748 END IF
749
750#ifdef DISTRIBUTE
751 CALL mp_exchange2d (ng, tile, model, 2, &
752 & lbi, ubi, lbj, ubj, &
753 & nghostpoints, &
754 & ewperiodic(ng), nsperiodic(ng), &
755 & pm, pn)
756#endif
757
758#if (defined CURVGRID && defined UV_ADV)
759!
760!-----------------------------------------------------------------------
761! Compute d(1/n)/d(xi) and d(1/m)/d(eta) at RHO-points.
762!-----------------------------------------------------------------------
763!
764 DO j=jstr,jend
765 DO i=istr,iend
766 dndx(i,j)=0.5_r8*((1.0_r8/wrky(i+1,j ))- &
767 & (1.0_r8/wrky(i-1,j )))
768 dmde(i,j)=0.5_r8*((1.0_r8/wrkx(i ,j+1))- &
769 & (1.0_r8/wrkx(i ,j-1)))
770 END DO
771 END DO
772!
773! Report statistics.
774!
775 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(11), 0, &
776 & lbi, ubi, lbj, ubj, dmde)
777 IF (domain(ng)%NorthEast_Corner(tile)) THEN
778 WRITE (stdout,10) 'ETA-derivative of inverse metric '// &
779 & 'factor pm: dmde', &
780 & ng, stats(11)%min, stats(11)%max
781 END IF
782 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(12), 0, &
783 & lbi, ubi, lbj, ubj, dndx)
784 IF (domain(ng)%NorthEast_Corner(tile)) THEN
785 WRITE (stdout,10) 'XI-derivative of inverse metric '// &
786 & 'factor pn: dndx', &
787 & ng, stats(12)%min, stats(12)%max
788 END IF
789!
790! Exchange boundary data.
791!
792 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
793 CALL exchange_r2d_tile (ng, tile, &
794 & lbi, ubi, lbj, ubj, &
795 & dndx)
796 CALL exchange_r2d_tile (ng, tile, &
797 & lbi, ubi, lbj, ubj, &
798 & dmde)
799 END IF
800
801# ifdef DISTRIBUTE
802 CALL mp_exchange2d (ng, tile, model, 2, &
803 & lbi, ubi, lbj, ubj, &
804 & nghostpoints, &
805 & ewperiodic(ng), nsperiodic(ng), &
806 & dndx, dmde)
807# endif
808#endif
809!
810!-----------------------------------------------------------------------
811! Angle (radians) between XI-axis and true EAST at RHO-points.
812!-----------------------------------------------------------------------
813!
814#if defined LAB_CANYON
815 DO j=jstrt,jendt
816 DO i=istrt,iendt
817 theta=-pi+ &
818 & 0.5_r8*dth*((cff+1.0_r8)*(real(j-1,r8)+0.5_r8)+ &
819 & (cff-1.0_r8)*(real(mm(ng),r8)/twopi)* &
820 & sin(twopi*(real(j-1,r8)+0.5_r8)/ &
821 & real(mm(ng),r8)))
822 angler(i,j)=theta
823 END DO
824 END DO
825#elif defined WEDDELL
826 val1=90.0_r8*deg2rad
827 DO j=jstrt,jendt
828 DO i=istrt,iendt
829 angler(i,j)=val1
830 END DO
831 END DO
832#else
833 DO j=jstrt,jendt
834 DO i=istrt,iendt
835 angler(i,j)=0.0_r8
836 END DO
837 END DO
838#endif
839!
840! Report Statistics.
841!
842 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(13), 0, &
843 & lbi, ubi, lbj, ubj, angler)
844 IF (domain(ng)%NorthEast_Corner(tile)) THEN
845 WRITE (stdout,10) 'angle between XI-axis and EAST: '// &
846 & 'angler', &
847 & ng, stats(13)%min, stats(13)%max
848 END IF
849!
850! Exchange boundary data.
851!
852 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
853 CALL exchange_r2d_tile (ng, tile, &
854 & lbi, ubi, lbj, ubj, &
855 & angler)
856 END IF
857
858#ifdef DISTRIBUTE
859 CALL mp_exchange2d (ng, tile, model, 1, &
860 & lbi, ubi, lbj, ubj, &
861 & nghostpoints, &
862 & ewperiodic(ng), nsperiodic(ng), &
863 & angler)
864#endif
865!
866!-----------------------------------------------------------------------
867! Compute Coriolis parameter (1/s) at RHO-points.
868!-----------------------------------------------------------------------
869!
870#if defined BENCHMARK
871 val1=2.0_r8*(2.0_r8*pi*366.25_r8/365.25_r8)/86400.0_r8
872 DO j=jstrt,jendt
873 DO i=istrt,iendt
874 f(i,j)=val1*sin(latr(i,j)*deg2rad)
875 END DO
876 END DO
877#elif defined WEDDELL
878 val1=10.4_r8/real(lm(ng),r8)
879 DO j=jstrt,jendt
880 DO i=istrt,iendt
881 f(i,j)=2.0_r8*7.2e-05_r8* &
882 & sin((-79.0_r8+real(i-1,r8)*val1)*deg2rad)
883 END DO
884 END DO
885#else
886 IF (beta.eq.0.0_r8) THEN
887 DO j=jstrt,jendt
888 DO i=istrt,iendt
889 f(i,j)=f0
890 END DO
891 END DO
892 ELSE
893 val1=0.5_r8*esize
894 DO j=jstrt,jendt
895 DO i=istrt,iendt
896 f(i,j)=f0+beta*(yr(i,j)-val1)
897 END DO
898 END DO
899 END IF
900#endif
901!
902! Report Statistics.
903!
904 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(14), 0, &
905 & lbi, ubi, lbj, ubj, f)
906 IF (domain(ng)%NorthEast_Corner(tile)) THEN
907 WRITE (stdout,10) 'Coriolis parameter at RHO-points: f', &
908 & ng, stats(14)%min, stats(14)%max
909 END IF
910!
911! Exchange boundary data.
912!
913 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
914 CALL exchange_r2d_tile (ng, tile, &
915 & lbi, ubi, lbj, ubj, &
916 & f)
917 END IF
918
919#ifdef DISTRIBUTE
920 CALL mp_exchange2d (ng, tile, model, 1, &
921 & lbi, ubi, lbj, ubj, &
922 & nghostpoints, &
923 & ewperiodic(ng), nsperiodic(ng), &
924 & f)
925#endif
926!
927!-----------------------------------------------------------------------
928! Set bathymetry (meters; positive) at RHO-points.
929!-----------------------------------------------------------------------
930!
931#if defined BENCHMARK
932 DO j=jstrt,jendt
933 DO i=istrt,iendt
934 h(i,j)=500.0_r8+1750.0_r8*(1.0+tanh((68.0_r8+latr(i,j))/dy))
935 END DO
936 END DO
937#elif defined BL_TEST
938 DO j=jstrt,jendt
939 DO i=istrt,iendt
940 val1=(xr(i,j)+500.0_r8)/15000.0_r8
941 h(i,j)=14.0_r8+ &
942 & 25.0_r8*(1.0_r8-exp(-pi*xr(i,j)*1.0e-05_r8))- &
943 & 8.0_r8*exp(-val1*val1)
944 END DO
945 END DO
946#elif defined CANYON
947 DO j=jstrt,jendt
948 DO i=istrt,iendt
949 val1=32000.0_r8-16000.0_r8*(sin(pi*xr(i,j)/xsize))**24
950 h(i,j)=20.0_r8+0.5_r8*(depth-20.0_r8)* &
951 & (1.0_r8+tanh((yr(i,j)-val1)/10000.0_r8))
952 END DO
953 END DO
954#elif defined ESTUARY_TEST
955 DO j=jstrt,jendt
956 DO i=istrt,iendt
957 h(i,j)=5.0_r8+(xsize-xr(i,j))/xsize*5.0_r8
958 END DO
959 END DO
960#elif defined LAB_CANYON
961 DO j=jstrt,jendt
962 DO i=istrt,iendt
963 r=0.35_r8+dx*(real(i-1,r8)+0.5_r8)
964 theta=-pi+ &
965 & 0.5_r8*dth*((cff+1.0_r8)*(real(j-1,r8)+0.5_r8)+ &
966 & (cff-1.0_r8)*(real(mm(ng),r8)/twopi)* &
967 & sin(dth*(real(j-1,r8)+0.5_r8)/ &
968 & real(mm(ng),r8)))
969 val1=0.55_r8-0.15_r8*(cos(pi*theta*0.55_r8/0.2_r8)**2) !r_small
970 val2=0.15_r8+0.15_r8*(cos(pi*theta*0.55_r8/0.2_r8)**2) !lambda
971 IF (abs(theta).ge.0.181818181818_r8) THEN
972 IF (r.le.0.55_r8) THEN
973 h(i,j)=0.025_r8 ! shelf
974 ELSE IF (r.ge.0.7_r8) THEN
975 h(i,j)=0.125_r8 ! deep
976 ELSE
977 h(i,j)=0.125_r8-0.1_r8* &
978 & (cos(0.5_r8*pi*(r-0.55_r8)/0.15_r8)**2)
979 END IF
980 ELSE
981 IF (r.le.val1) THEN
982 h(i,j)=0.025_r8 ! shelf
983 ELSE IF (r.ge.0.7_r8) THEN
984 h(i,j)=0.125_r8 ! deep
985 ELSE
986 h(i,j)=0.125_r8-0.1_r8* &
987 & (cos(0.5_r8*pi*(r-val1)/val2)**2)
988 END IF
989 END IF
990 END DO
991 END DO
992#elif defined LAKE_SIGNELL
993 DO j=jstrt,jendt
994 DO i=istrt,iendt
995 h(i,j)=18.0_r8-16.0_r8*real(mm(ng)-j,r8)/real(mm(ng)-1,r8)
996 END DO
997 END DO
998# elif defined MIXED_LAYER
999 DO j=jstrt,jendt
1000 DO i=istrt,iendt
1001 h(i,j)=50.0_r8
1002 END DO
1003 END DO
1004#elif defined OVERFLOW
1005 val1=200.0_r8
1006 DO j=jstrt,jendt
1007 DO i=istrt,iendt
1008 h(i,j)=val1+0.5_r8*(depth-val1)* &
1009 & (1.0_r8+tanh((yr(i,j)-100000.0_r8)/20000.0_r8))
1010 END DO
1011 END DO
1012#elif defined RIVERPLUME1
1013 DO j=jstrt,jendt
1014 DO i=istrt,min(5,iendt)
1015 h(i,j)=15.0_r8
1016 END DO
1017 DO i=max(6,istrt),iendt
1018 h(i,j)=depth+real(lm(ng)-i,r8)*(15.0_r8-depth)/ &
1019 & real(lm(ng)-6,r8)
1020 END DO
1021 END DO
1022#elif defined RIVERPLUME2
1023 DO j=jstrt,jendt
1024 DO i=istrt,min(5,iendt)
1025 h(i,j)=15.0_r8
1026 END DO
1027 DO i=max(6,istrt),iendt
1028 h(i,j)=depth+real(lm(ng)-i,r8)*(15.0_r8-depth)/ &
1029 & real(lm(ng)-6,r8)
1030 END DO
1031 END DO
1032#elif defined SEAMOUNT
1033 DO j=jstrt,jendt
1034 DO i=istrt,iendt
1035 val1=(xr(i,j)-0.5_r8*xsize)/40000.0_r8
1036 val2=(yr(i,j)-0.5_r8*esize)/40000.0_r8
1037 h(i,j)=depth-4500.0_r8*exp(-(val1*val1+val2*val2))
1038 END DO
1039 END DO
1040#elif defined SED_TOY
1041 DO j=jstrt,jendt
1042 DO i=istrt,iendt
1043 h(i,j)=20.0_r8
1044 END DO
1045 END DO
1046#elif defined SHOREFACE
1047 DO j=jstrt,jendt
1048 DO i=istrt,iendt
1049 h(i,j)=11.75_r8-0.0125_r8*xsize/real(lm(ng)+1,r8)*real(i,r8)
1050 END DO
1051 END DO
1052#elif defined TEST_CHAN
1053 DO j=jstrt,jendt
1054 DO i=istrt,iendt
1055 h(i,j)=10.0_r8+0.4040_r8*real(i,r8)/real(lm(ng)+1,r8)
1056 END DO
1057 END DO
1058#elif defined UPWELLING
1059 IF (nsperiodic(ng)) THEN
1060 DO i=istrt,iendt
1061 IF (i.le.lm(ng)/2) THEN
1062 val1=real(i,r8)
1063 ELSE
1064 val1=real(lm(ng)+1-i,r8)
1065 END IF
1066 val2=min(depth,84.5_r8+66.526_r8*tanh((val1-10.0_r8)/7.0_r8))
1067 DO j=jstrt,jendt
1068 h(i,j)=val2
1069 END DO
1070 END DO
1071 ELSE IF (ewperiodic(ng)) THEN
1072 DO j=jstrt,jendt
1073 IF (j.le.mm(ng)/2) THEN
1074 val1=real(j,r8)
1075 ELSE
1076 val1=real(mm(ng)+1-j,r8)
1077 END IF
1078 val2=min(depth,84.5_r8+66.526_r8*tanh((val1-10.0_r8)/7.0_r8))
1079 DO i=istrt,iendt
1080 h(i,j)=val2
1081 END DO
1082 END DO
1083 END IF
1084#elif defined WEDDELL
1085 val1=98.80_r8
1086 val2=0.8270_r8
1087 DO k=-1,26
1088 xwrk(k)=real(k-1,r8)*15.0_r8*1000.0_r8
1089 hwrk(k)=375.0_r8
1090 END DO
1091 DO k=27,232
1092 zwrk=-2.0_r8+real(k-1,r8)*0.020_r8
1093 xwrk(k)=(520.0_r8+val1+zwrk*val1+ &
1094 & val1*val2*log(cosh(zwrk)))*1000.0_r8
1095 hwrk(k)=-75.0_r8+2198.0_r8*(1.0_r8+val2*tanh(zwrk))
1096 END DO
1097 DO k=233,235
1098 xwrk(k)=(850.0_r8+real(k-228,r8)*50.0_r8)*1000.0_r8
1099 hwrk(k)=4000.0_r8
1100 END DO
1101 DO j=jstrt,jendt
1102 DO i=istrt,iendt
1103 h(i,j)=375.0_r8
1104 DO k=1,234
1105 IF ((xwrk(k).le.xr(i,1)).and.(xr(i,1).lt.xwrk(k+1))) THEN
1106 cff=1.0_r8/(xwrk(k+1)-xwrk(k))
1107 h(i,j)=cff*(xwrk(k+1)-xr(i,j))*hwrk(k )+ &
1108 & cff*(xr(i,j)-xwrk(k ))*hwrk(k+1)
1109 END IF
1110 END DO
1111 END DO
1112 END DO
1113#elif defined WINDBASIN
1114 DO i=istrt,iendt
1115 ival=int(0.03_r8*real(lm(ng)+1,r8))
1116 IF (i.lt.ival) THEN
1117 val1=1.0_r8-(real((i+1)-ival,r8)/real(ival,r8))**2
1118 ELSE IF ((lm(ng)+1-i).lt.ival) THEN
1119 val1=1.0_r8-(real((lm(ng)+1-i)-ival,r8)/real(ival,r8))**2
1120 ELSE
1121 val1=1.0_r8
1122 END IF
1123 DO j=jstrt,jendt
1124 val2=2.0_r8*real(j-(mm(ng)+1)/2,r8)/real(mm(ng)+1,r8)
1125 h(i,j)=depth*(0.08_r8+0.92_r8*val1*(1.0_r8-val2*val2))
1126 END DO
1127 END DO
1128#else
1129 DO j=jstrt,jendt
1130 DO i=istrt,iendt
1131 h(i,j)=depth
1132 END DO
1133 END DO
1134#endif
1135!
1136! Report Statistics.
1137!
1138 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(15), 0, &
1139 & lbi, ubi, lbj, ubj, h)
1140 IF (domain(ng)%NorthEast_Corner(tile)) THEN
1141 WRITE (stdout,10) 'bathymetry at RHO-points: h', &
1142 & ng, stats(15)%min, stats(15)%max
1143 END IF
1144 hmin(ng)=stats(15)%min
1145 hmax(ng)=stats(15)%max
1146!
1147! Exchange boundary data.
1148!
1149 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1150 CALL exchange_r2d_tile (ng, tile, &
1151 & lbi, ubi, lbj, ubj, &
1152 & h)
1153 END IF
1154
1155#ifdef DISTRIBUTE
1156 CALL mp_exchange2d (ng, tile, model, 1, &
1157 & lbi, ubi, lbj, ubj, &
1158 & nghostpoints, &
1159 & ewperiodic(ng), nsperiodic(ng), &
1160 & h)
1161#endif
1162#ifdef ICESHELF
1163!
1164!-----------------------------------------------------------------------
1165! Set depth of ice shelf (meters; negative) at RHO-points.
1166!-----------------------------------------------------------------------
1167!
1168# ifdef WEDDELL
1169 val1=340.0_r8
1170 val2=val1/16.0_r8
1171 DO j=jstrt,jendt
1172 DO i=istrt,iendt
1173 IF (i.gt.20) THEN
1174 zice(i,j)=0.0_r8
1175 ELSE IF (i.gt.4) THEN
1176 zice(i,j)=-val1+real(i-1,r8)*val2
1177 ELSE
1178 zice(i,j)=-val1
1179 END IF
1180 END DO
1181 END DO
1182# else
1183 DO j=jstrt,jendt
1184 DO i=istrt,iendt
1185 zice(i,j)=0.0_r8
1186 END DO
1187 END DO
1188# endif
1189!
1190! Report Statistics.
1191!
1192 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(16), 0, &
1193 & lbi, ubi, lbj, ubj, zice)
1194 IF (domain(ng)%NorthEast_Corner(tile)) THEN
1195 WRITE (stdout,10) 'ice shelf thickness: zice', &
1196 & ng, stats(16)%min, stats(16)%max
1197 END IF
1198!
1199! Exchange boundary data.
1200!
1201 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1202 CALL exchange_r2d_tile (ng, tile, &
1203 & lbi, ubi, lbj, ubj, &
1204 & zice)
1205 END IF
1206
1207# ifdef DISTRIBUTE
1208 CALL mp_exchange2d (ng, tile, model, 1, &
1209 & lbi, ubi, lbj, ubj, &
1210 & nghostpoints, &
1211 & ewperiodic(ng), nsperiodic(ng), &
1212 & zice)
1213# endif
1214#endif
1215!
1216 10 FORMAT (3x,' ANA_GRID - ',a,/,19x, &
1217 & '(Grid = ',i2.2,', Min = ',1p,e15.8,0p, &
1218 & ' Max = ',1p,e15.8,0p,')')
1219!
1220 RETURN
ana_grid
subroutine ana_grid(ng, tile, model)
Definition ana_grid.h:3
exchange_2d_mod
Definition exchange_2d.F:2
exchange_2d_mod::exchange_r2d_tile
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:253
mod_iounits
Definition mod_iounits.F:2
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_parallel
Definition mod_parallel.F:2
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_param::lm
integer, dimension(:), allocatable lm
Definition mod_param.F:455
mod_param::u2dvar
integer, parameter u2dvar
Definition mod_param.F:718
mod_param::p2dvar
integer, parameter p2dvar
Definition mod_param.F:716
mod_param::mm
integer, dimension(:), allocatable mm
Definition mod_param.F:456
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_param::v2dvar
integer, parameter v2dvar
Definition mod_param.F:719
mod_scalars
Definition mod_scalars.F:2
mod_scalars::spherical
logical spherical
Definition mod_scalars.F:478
mod_scalars::hmin
real(dp), dimension(:), allocatable hmin
Definition mod_scalars.F:630
mod_scalars::el
real(r8), dimension(:), allocatable el
Definition mod_scalars.F:636
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mod_scalars::large
real(dp), parameter large
Definition mod_scalars.F:823
mod_scalars::eradius
real(dp) eradius
Definition mod_scalars.F:459
mod_scalars::deg2rad
real(dp), parameter deg2rad
Definition mod_scalars.F:814
mod_scalars::g
real(dp) g
Definition mod_scalars.F:464
mod_scalars::xl
real(r8), dimension(:), allocatable xl
Definition mod_scalars.F:635
mod_scalars::hmax
real(dp), dimension(:), allocatable hmax
Definition mod_scalars.F:631
mod_scalars::pi
real(dp), parameter pi
Definition mod_scalars.F:813
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange2d
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:294
stats_mod
Definition stats.F:2
stats_mod::stats_2dfld
subroutine, public stats_2dfld(ng, tile, model, gtype, s, extract_flag, lbi, ubi, lbj, ubj, f, fmask, debug)
Definition stats.F:47

References ana_grid(), mod_scalars::deg2rad, mod_param::domain, mod_scalars::el, mod_scalars::eradius, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mod_scalars::g, mod_scalars::hmax, mod_scalars::hmin, mod_param::inlm, mod_scalars::large, mod_param::lm, mod_param::mm, mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_param::p2dvar, mod_scalars::pi, mod_param::r2dvar, mod_scalars::spherical, stats_mod::stats_2dfld(), mod_iounits::stdout, mod_param::u2dvar, mod_param::v2dvar, and mod_scalars::xl.

Referenced by ana_grid().

Here is the call graph for this function:
Here is the caller graph for this function: