ROMS
Loading...
Searching...
No Matches
mod_grid.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE mod_grid
3!
4!git $Id$
5!================================================== Hernan G. Arango ===
6! Copyright (c) 2002-2025 The ROMS Group !
7! Licensed under a MIT/X style license !
8! See License_ROMS.md !
9!=======================================================================
10! !
11! IJwaterR Water points IJ couter for RHO-points masked variables. !
12! IJwaterU Water points IJ couter for U-points masked variables. !
13! IJwaterV Water points IJ couter for V-points masked variables. !
14! Hz Thicknesses (m) of vertical RHO-points. !
15# ifdef ADJUST_BOUNDARY
16! Hz_bry Thicknesses (m) at the open boundaries; used only for !
17! 4DVAR adjustments. !
18# endif
19! Huon Total U-momentum flux term, Hz*u/pn. !
20! Hvom Total V-momentum flux term, Hz*v/pm. !
21! IcePress Pressure under the ice shelf at RHO-points. !
22! Rscope Adjoint sensitivity spatial scope mask at RHO-points. !
23! Tcline Width (m) of surface or bottom boundary layer where !
24! higher vertical resolution is required during !
25! stretching. !
26! Uscope Adjoint sensitivity spatial scope mask at U-points. !
27! Vscope Adjoint sensitivity spatial scope mask at V-points. !
28! angler Angle (radians) between XI-axis and true EAST at !
29! RHO-points. !
30! CosAngler Cosine of curvilinear angle, angler. !
31! SinAngler Sine of curvilinear angle, angler. !
32#if defined TIDE_GENERATING_FORCES
33! Cos2Lat Squared cosine of latitude, COS2(latr). !
34! SinLat2 Sine of twice the latitude, SIN(2*latr). !
35#endif
36! dmde ETA-derivative of inverse metric factor pm, !
37! d(1/pm)/d(ETA). !
38! dndx XI-derivative of inverse metric factor pn, !
39! d(1/pn)/d(XI). !
40! f Coriolis parameter (1/s). !
41! fomn Compound term, f/(pm*pn) at RHO points. !
42! grdscl Grid scale used to adjust horizontal mixing according !
43! to grid area. !
44! h Bottom depth (m) at RHO-points. !
45! latp Latitude (degrees_north) at PSI-points. !
46! latr Latitude (degrees_north) at RHO-points. !
47! latu Latitude (degrees_north) at U-points. !
48! latv Latitude (degrees_north) at V-points. !
49! lonp Longitude (degrees_east) at PSI-points. !
50! lonr Longitude (degrees_east) at RHO-points. !
51! lonu Longitude (degrees_east) at U-points. !
52! lonv Longitude (degrees_east) at V-points. !
53! MyLon Longitude work array for regridding. !
54! omm RHO-grid area (meters2). !
55! om_p PSI-grid spacing (meters) in the XI-direction. !
56! om_r RHO-grid spacing (meters) in the XI-direction. !
57! om_u U-grid spacing (meters) in the XI-direction. !
58! om_v V-grid spacing (meters) in the XI-direction. !
59! on_p PSI-grid spacing (meters) in the ETA-direction. !
60! on_r RHO-grid spacing (meters) in the ETA-direction. !
61! on_u U-grid spacing (meters) in the ETA-direction. !
62! on_v V-grid spacing (meters) in the ETA-direction. !
63! pm Coordinate transformation metric "m" (1/meters) !
64! associated with the differential distances in XI. !
65! pmon_p Compound term, pm/pn at PSI-points. !
66! pmon_r Compound term, pm/pn at RHO-points. !
67! pmon_u Compound term, pm/pn at U-points. !
68! pmon_v Compound term, pm/pn at V-points. !
69! pn Coordinate transformation metric "n" (1/meters) !
70! associated with the differential distances in ETA. !
71! pnom_p Compound term, pn/pm at PSI-points. !
72! pnom_r Compound term, pn/pm at RHO-points. !
73! pnom_u Compound term, pn/pm at U-points. !
74! pnom_v Compound term, pn/pm at V-points. !
75#ifdef MASKING
76! pmask Slipperiness time-independent mask at PSI-points: !
77! (0=Land, 1=Sea, 2=no-slip). !
78! rmask Time-independent mask at RHO-points (0=Land, 1=Sea). !
79! umask Time-independent mask at U-points (0=Land, 1=Sea). !
80! vmask Time-independent mask at V-points (0=Land, 1=Sea). !
81# if defined AVERAGES || \
82 (defined ad_averages && defined adjoint) || \
83 (defined rp_averages && defined tl_ioms) || \
84 (defined tl_averages && defined tangent)
85!
86! pmask_avg Time-averaged full mask at PSI-points (0=dry, 1=wet). !
87! rmask_avg Time-averaged full mask at RHO-points (0=dry, 1=wet). !
88! rmask_avg Time-averaged full mask at U-points (0=dry, 1=wet). !
89! rmask_avg Time-averaged full mask at V-points (0=dry, 1=wet). !
90# endif
91# ifdef DIAGNOSTICS
92!
93! pmask_dia Diagnostics full mask at PSI-points (0=dry, 1=wet). !
94! rmask_dia Diagnostics full mask at RHO-points (0=dry, 1=wet). !
95! rmask_dia Diagnostics full mask at U-points (0=dry, 1=wet). !
96! rmask_dia Diagnostics full mask at V-points (0=dry, 1=wet). !
97# endif
98! !
99! pmask_full Full mask at PSI-points (0=dry, 1=wet, 2=no-slip). !
100! rmask_full Full mask at RHO-points (0=dry, 1=wet). !
101! rmask_full Full mask at U-points (0=dry, 1=wet). !
102! rmask_full Full mask at V-points (0=dry, 1=wet). !
103#endif
104#ifdef WET_DRY
105! pmask_wet Wet/Dry mask at PSI-points (0=dry, 1=wet, 2=no-slip). !
106! rmask_wet Wet/Dry mask at RHO-points (0=dry, 1=wet). !
107! umask_wet Wet/Dry mask at U-points (0=dry, 1,2=wet). !
108! vmask_wet Wet/Dry mask at V-points (0=dry, 1,2=wet). !
109#endif
110#if defined UV_LOGDRAG || defined GLS_MIXING || \
111 defined bbl_model || defined sediment
112! ZoBot Bottom roughness length (m). !
113#endif
114#if defined UV_LDRAG
115! rdrag Linear drag coefficient (m/s). !
116#elif defined UV_QDRAG
117! rdrag2 Quadratic drag coefficient (nondimensional). !
118#endif
119! xp XI-coordinates (m) at PSI-points. !
120! xr XI-coordinates (m) at RHO-points. !
121! xu XI-coordinates (m) at U-points. !
122! xv XI-coordinates (m) at V-points. !
123! yp ETA-coordinates (m) at PSI-points. !
124! yr ETA-coordinates (m) at RHO-points. !
125! yu ETA-coordinates (m) at U-points. !
126! yv ETA-coordinates (m) at V-points. !
127! zice Depth of ice shelf cavity (m, negative) at !
128! RHO-points. !
129! z0_r Time independent depths (m) at horizontal RHO-points and !
130! vertical RHO-points. !
131! z0_w Time independent depths (m) at horizontal RHO-points and !
132! vertical W-points. !
133! z_r Actual depths (m) at horizontal RHO-points and !
134! vertical RHO-points. !
135! z_w Actual depths (m) at horizontal RHO-points and !
136! vertical W-points. !
137#ifdef GRID_EXTRACT
138! !
139! Packed global arrays needed for field extraction by interpolation: !
140! !
141! Gangle_psi Global curvilinear angle (radians) at PSI-points. !
142! Gangle_rho Global curvilinear angle (radians) at RHO-points. !
143! Gangle_u Global curvilinear angle (radians) at U-points. !
144! Gangle_v Global curvilinear angle (radians) at V-points. !
145# ifdef MASKING
146! Gmask_psi Global time-independent land/sea mask at PSI-points. !
147! Gmask_rho Global time-independent land/sea mask at RHO-points. !
148! Gmask_u Global time-independent land/sea mask at U-points. !
149! Gmask_v Global time-independent land/sea mask at V-points. !
150# endif
151! Gx_psi Global X-coordinate at PSI-points. !
152! Gx_rho Global X-coordinate at RHO-points. !
153! Gx_u Global X-coordinate at U-points. !
154! Gx_v Global X-coordinate at V-points. !
155! Gy_psi Global Y-coordinate at PSI-points. !
156! Gy_rho Global Y-coordinate at RHO-points. !
157! Gy_u Global Y-coordinate at U-points. !
158! Gy_v Global Y-coordinate at V-points. !
159#endif
160! !
161!=======================================================================
162!
163 USE mod_kinds
164!
165 implicit none
166!
167 PUBLIC :: allocate_grid
168 PUBLIC :: deallocate_grid
169 PUBLIC :: initialize_grid
170!
171!-----------------------------------------------------------------------
172! Define T_GRID structure.
173!-----------------------------------------------------------------------
174!
175 TYPE t_grid
176!
177! Nonlinear model state.
178!
179#if defined MASKING && defined PROPAGATOR
180 integer, pointer :: ijwaterr(:,:)
181 integer, pointer :: ijwateru(:,:)
182 integer, pointer :: ijwaterv(:,:)
183#endif
184
185 real(r8), pointer :: angler(:,:)
186 real(r8), pointer :: cosangler(:,:)
187 real(r8), pointer :: sinangler(:,:)
188
189#if defined TIDE_GENERATING_FORCES
190 real(r8), pointer :: cos2lat(:,:)
191 real(r8), pointer :: sinlat2(:,:)
192#endif
193
194#if defined CURVGRID && defined UV_ADV
195 real(r8), pointer :: dmde(:,:)
196 real(r8), pointer :: dndx(:,:)
197#endif
198 real(r8), pointer :: f(:,:)
199 real(r8), pointer :: fomn(:,:)
200 real(r8), pointer :: grdscl(:,:)
201 real(r8), pointer :: h(:,:)
202 real(r8), pointer :: latp(:,:)
203 real(r8), pointer :: latr(:,:)
204 real(r8), pointer :: latu(:,:)
205 real(r8), pointer :: latv(:,:)
206 real(r8), pointer :: lonp(:,:)
207 real(r8), pointer :: lonr(:,:)
208 real(r8), pointer :: lonu(:,:)
209 real(r8), pointer :: lonv(:,:)
210 real(r8), pointer :: mylon(:,:)
211 real(r8), pointer :: omn(:,:)
212 real(r8), pointer :: om_p(:,:)
213 real(r8), pointer :: om_r(:,:)
214 real(r8), pointer :: om_u(:,:)
215 real(r8), pointer :: om_v(:,:)
216 real(r8), pointer :: on_p(:,:)
217 real(r8), pointer :: on_r(:,:)
218 real(r8), pointer :: on_u(:,:)
219 real(r8), pointer :: on_v(:,:)
220 real(r8), pointer :: pm(:,:)
221 real(r8), pointer :: pn(:,:)
222 real(r8), pointer :: pmon_p(:,:)
223 real(r8), pointer :: pmon_r(:,:)
224 real(r8), pointer :: pmon_u(:,:)
225 real(r8), pointer :: pmon_v(:,:)
226 real(r8), pointer :: pnom_p(:,:)
227 real(r8), pointer :: pnom_r(:,:)
228 real(r8), pointer :: pnom_u(:,:)
229 real(r8), pointer :: pnom_v(:,:)
230#if defined UV_LOGDRAG || defined GLS_MIXING || \
231 defined bbl_model || defined sediment
232 real(r8), pointer :: zobot(:,:)
233#endif
234 real(r8), pointer :: rdrag(:,:)
235#if defined UV_QDRAG
236 real(r8), pointer :: rdrag2(:,:)
237#endif
238 real(r8), pointer :: xp(:,:)
239 real(r8), pointer :: xr(:,:)
240 real(r8), pointer :: xu(:,:)
241 real(r8), pointer :: xv(:,:)
242 real(r8), pointer :: yp(:,:)
243 real(r8), pointer :: yr(:,:)
244 real(r8), pointer :: yu(:,:)
245 real(r8), pointer :: yv(:,:)
246#ifdef SOLVE3D
247 real(r8), pointer :: hz(:,:,:)
248# ifdef ADJUST_BOUNDARY
249 real(r8), pointer :: hz_bry(:,:,:)
250# endif
251 real(r8), pointer :: huon(:,:,:)
252 real(r8), pointer :: hvom(:,:,:)
253 real(r8), pointer :: z0_r(:,:,:)
254 real(r8), pointer :: z0_w(:,:,:)
255 real(r8), pointer :: z_r(:,:,:)
256 real(r8), pointer :: z_v(:,:,:)
257 real(r8), pointer :: z_w(:,:,:)
258# ifdef ICESHELF
259 real(r8), pointer :: icepress(:,:)
260 real(r8), pointer :: zice(:,:)
261# endif
262#endif
263#ifdef MASKING
264 real(r8), pointer :: pmask(:,:)
265 real(r8), pointer :: rmask(:,:)
266 real(r8), pointer :: umask(:,:)
267 real(r8), pointer :: vmask(:,:)
268
269# if defined AVERAGES || \
270 (defined ad_averages && defined adjoint) || \
271 (defined rp_averages && defined tl_ioms) || \
272 (defined tl_averages && defined tangent)
273 real(r8), pointer :: pmask_avg(:,:)
274 real(r8), pointer :: rmask_avg(:,:)
275 real(r8), pointer :: umask_avg(:,:)
276 real(r8), pointer :: vmask_avg(:,:)
277# endif
278# ifdef DIAGNOSTICS
279 real(r8), pointer :: pmask_dia(:,:)
280 real(r8), pointer :: rmask_dia(:,:)
281 real(r8), pointer :: umask_dia(:,:)
282 real(r8), pointer :: vmask_dia(:,:)
283# endif
284 real(r8), pointer :: pmask_full(:,:)
285 real(r8), pointer :: rmask_full(:,:)
286 real(r8), pointer :: umask_full(:,:)
287 real(r8), pointer :: vmask_full(:,:)
288#endif
289#ifdef WET_DRY
290 real(r8), pointer :: pmask_wet(:,:)
291 real(r8), pointer :: rmask_wet(:,:)
292 real(r8), pointer :: umask_wet(:,:)
293 real(r8), pointer :: vmask_wet(:,:)
294# ifdef SOLVE3D
295 real(r8), pointer :: rmask_wet_avg(:,:)
296# endif
297#endif
298#if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
299 defined opt_observations || defined sensitivity_4dvar || \
300 defined so_semi
301 real(r8), pointer :: rscope(:,:)
302 real(r8), pointer :: uscope(:,:)
303 real(r8), pointer :: vscope(:,:)
304#endif
305#if defined TANGENT || defined TL_IOMS
306!
307! Tangent linear model state.
308!
309 real(r8), pointer :: tl_h(:,:)
310# ifdef SOLVE3D
311 real(r8), pointer :: tl_hz(:,:,:)
312# ifdef ADJUST_BOUNDARY
313 real(r8), pointer :: tl_hz_bry(:,:,:)
314# endif
315 real(r8), pointer :: tl_huon(:,:,:)
316 real(r8), pointer :: tl_hvom(:,:,:)
317 real(r8), pointer :: tl_z_r(:,:,:)
318 real(r8), pointer :: tl_z_w(:,:,:)
319# endif
320#endif
321
322#ifdef ADJOINT
323!
324! Adjoint model state.
325!
326 real(r8), pointer :: ad_h(:,:)
327# ifdef SOLVE3D
328 real(r8), pointer :: ad_hz(:,:,:)
329# ifdef ADJUST_BOUNDARY
330 real(r8), pointer :: ad_hz_bry(:,:,:)
331# endif
332 real(r8), pointer :: ad_huon(:,:,:)
333 real(r8), pointer :: ad_hvom(:,:,:)
334 real(r8), pointer :: ad_z_r(:,:,:)
335 real(r8), pointer :: ad_z_w(:,:,:)
336# endif
337#endif
338#ifdef GRID_EXTRACT
339!
340! Set global geometry 1D arrays, packed in column-major order, needed
341! for field extraction by interpolation during writing to the proper
342! output NetCDF file.
343!
344 real(r8), pointer :: gangle_psi(:)
345 real(r8), pointer :: gangle_rho(:)
346 real(r8), pointer :: gangle_u(:)
347 real(r8), pointer :: gangle_v(:)
348 real(r8), pointer :: gx_psi(:)
349 real(r8), pointer :: gx_rho(:)
350 real(r8), pointer :: gx_u(:)
351 real(r8), pointer :: gx_v(:)
352 real(r8), pointer :: gy_psi(:)
353 real(r8), pointer :: gy_rho(:)
354 real(r8), pointer :: gy_u(:)
355 real(r8), pointer :: gy_v(:)
356# ifdef MASKING
357 real(r8), pointer :: gmask_psi(:)
358 real(r8), pointer :: gmask_rho(:)
359 real(r8), pointer :: gmask_u(:)
360 real(r8), pointer :: gmask_v(:)
361# endif
362#endif
363 END TYPE t_grid
364!
365 TYPE (t_grid), allocatable :: grid(:)
366!
367 CONTAINS
368!
369 SUBROUTINE allocate_grid (ng, Extract_Flag, &
370 & LBi, UBi, LBj, UBj, LBij, UBij)
371!
372!=======================================================================
373! !
374! This routine allocates all variables in the module for all nested !
375! grids. !
376! !
377!=======================================================================
378!
379 USE mod_param
380!
381! Local variable declarations.
382!
383 integer, intent(in) :: ng, extract_flag
384 integer, intent(in) :: lbi, ubi, lbj, ubj, lbij, ubij
385!
386! Local variable declarations.
387!
388 integer :: my_size
389!
390 real(r8) :: size2d
391!
392!-----------------------------------------------------------------------
393! Allocate and initialize module variables.
394!-----------------------------------------------------------------------
395!
396 IF (ng.eq.1) allocate ( grid(ngrids) )
397!
398! Set horizontal array size.
399!
400 size2d=real((ubi-lbi+1)*(ubj-lbj+1),r8)
401!
402! Nonlinear model state.
403!
404#if defined MASKING && defined PROPAGATOR
405 allocate ( grid(ng) % IJwaterR(lbi:ubi,lbj:ubj) )
406 dmem(ng)=dmem(ng)+size2d
407
408 allocate ( grid(ng) % IJwaterU(lbi:ubi,lbj:ubj) )
409 dmem(ng)=dmem(ng)+size2d
410
411 allocate ( grid(ng) % IJwaterV(lbi:ubi,lbj:ubj) )
412 dmem(ng)=dmem(ng)+size2d
413#endif
414
415 allocate ( grid(ng) % angler(lbi:ubi,lbj:ubj) )
416 dmem(ng)=dmem(ng)+size2d
417
418 allocate ( grid(ng) % CosAngler(lbi:ubi,lbj:ubj) )
419 dmem(ng)=dmem(ng)+size2d
420
421 allocate ( grid(ng) % SinAngler(lbi:ubi,lbj:ubj) )
422 dmem(ng)=dmem(ng)+size2d
423
424#if defined TIDE_GENERATING_FORCES
425 allocate ( grid(ng) % Cos2Lat(lbi:ubi,lbj:ubj) )
426 dmem(ng)=dmem(ng)+size2d
427
428 allocate ( grid(ng) % SinLat2(lbi:ubi,lbj:ubj) )
429 dmem(ng)=dmem(ng)+size2d
430#endif
431
432#if defined CURVGRID && defined UV_ADV
433 allocate ( grid(ng) % dmde(lbi:ubi,lbj:ubj) )
434 dmem(ng)=dmem(ng)+size2d
435
436 allocate ( grid(ng) % dndx(lbi:ubi,lbj:ubj) )
437 dmem(ng)=dmem(ng)+size2d
438#endif
439
440 allocate ( grid(ng) % f(lbi:ubi,lbj:ubj) )
441 dmem(ng)=dmem(ng)+size2d
442
443 allocate ( grid(ng) % fomn(lbi:ubi,lbj:ubj) )
444 dmem(ng)=dmem(ng)+size2d
445
446 allocate ( grid(ng) % grdscl(lbi:ubi,lbj:ubj) )
447 dmem(ng)=dmem(ng)+size2d
448
449 allocate ( grid(ng) % h(lbi:ubi,lbj:ubj) )
450 dmem(ng)=dmem(ng)+size2d
451
452 allocate ( grid(ng) % latp(lbi:ubi,lbj:ubj) )
453 dmem(ng)=dmem(ng)+size2d
454
455 allocate ( grid(ng) % latr(lbi:ubi,lbj:ubj) )
456 dmem(ng)=dmem(ng)+size2d
457
458 allocate ( grid(ng) % latu(lbi:ubi,lbj:ubj) )
459 dmem(ng)=dmem(ng)+size2d
460
461 allocate ( grid(ng) % latv(lbi:ubi,lbj:ubj) )
462 dmem(ng)=dmem(ng)+size2d
463
464 allocate ( grid(ng) % lonp(lbi:ubi,lbj:ubj))
465 dmem(ng)=dmem(ng)+size2d
466
467 allocate ( grid(ng) % lonr(lbi:ubi,lbj:ubj))
468 dmem(ng)=dmem(ng)+size2d
469
470 allocate ( grid(ng) % lonu(lbi:ubi,lbj:ubj))
471 dmem(ng)=dmem(ng)+size2d
472
473 allocate ( grid(ng) % lonv(lbi:ubi,lbj:ubj))
474 dmem(ng)=dmem(ng)+size2d
475
476 allocate ( grid(ng) % Mylon(lbi:ubi,lbj:ubj))
477 dmem(ng)=dmem(ng)+size2d
478
479 allocate ( grid(ng) % omn(lbi:ubi,lbj:ubj) )
480 dmem(ng)=dmem(ng)+size2d
481
482 allocate ( grid(ng) % om_p(lbi:ubi,lbj:ubj) )
483 dmem(ng)=dmem(ng)+size2d
484
485 allocate ( grid(ng) % om_r(lbi:ubi,lbj:ubj) )
486 dmem(ng)=dmem(ng)+size2d
487
488 allocate ( grid(ng) % om_u(lbi:ubi,lbj:ubj) )
489 dmem(ng)=dmem(ng)+size2d
490
491 allocate ( grid(ng) % om_v(lbi:ubi,lbj:ubj) )
492 dmem(ng)=dmem(ng)+size2d
493
494 allocate ( grid(ng) % on_p(lbi:ubi,lbj:ubj) )
495 dmem(ng)=dmem(ng)+size2d
496
497 allocate ( grid(ng) % on_r(lbi:ubi,lbj:ubj) )
498 dmem(ng)=dmem(ng)+size2d
499
500 allocate ( grid(ng) % on_u(lbi:ubi,lbj:ubj) )
501 dmem(ng)=dmem(ng)+size2d
502
503 allocate ( grid(ng) % on_v(lbi:ubi,lbj:ubj) )
504 dmem(ng)=dmem(ng)+size2d
505
506 allocate ( grid(ng) % pm(lbi:ubi,lbj:ubj) )
507 dmem(ng)=dmem(ng)+size2d
508
509 allocate ( grid(ng) % pn(lbi:ubi,lbj:ubj) )
510 dmem(ng)=dmem(ng)+size2d
511
512 allocate ( grid(ng) % pmon_p(lbi:ubi,lbj:ubj) )
513 dmem(ng)=dmem(ng)+size2d
514
515 allocate ( grid(ng) % pmon_r(lbi:ubi,lbj:ubj) )
516 dmem(ng)=dmem(ng)+size2d
517
518 allocate ( grid(ng) % pmon_u(lbi:ubi,lbj:ubj) )
519 dmem(ng)=dmem(ng)+size2d
520
521 allocate ( grid(ng) % pmon_v(lbi:ubi,lbj:ubj) )
522 dmem(ng)=dmem(ng)+size2d
523
524 allocate ( grid(ng) % pnom_p(lbi:ubi,lbj:ubj) )
525 dmem(ng)=dmem(ng)+size2d
526
527 allocate ( grid(ng) % pnom_r(lbi:ubi,lbj:ubj) )
528 dmem(ng)=dmem(ng)+size2d
529
530 allocate ( grid(ng) % pnom_u(lbi:ubi,lbj:ubj) )
531 dmem(ng)=dmem(ng)+size2d
532
533 allocate ( grid(ng) % pnom_v(lbi:ubi,lbj:ubj) )
534 dmem(ng)=dmem(ng)+size2d
535
536#if defined UV_LOGDRAG || defined GLS_MIXING || \
537 defined bbl_model || defined sediment
538 allocate ( grid(ng) % ZoBot(lbi:ubi,lbj:ubj) )
539 dmem(ng)=dmem(ng)+size2d
540#endif
541
542 allocate ( grid(ng) % rdrag(lbi:ubi,lbj:ubj) )
543 dmem(ng)=dmem(ng)+size2d
544
545#if defined UV_QDRAG
546 allocate ( grid(ng) % rdrag2(lbi:ubi,lbj:ubj) )
547 dmem(ng)=dmem(ng)+size2d
548#endif
549
550 allocate ( grid(ng) % xp(lbi:ubi,lbj:ubj) )
551 dmem(ng)=dmem(ng)+size2d
552
553 allocate ( grid(ng) % xr(lbi:ubi,lbj:ubj) )
554 dmem(ng)=dmem(ng)+size2d
555
556 allocate ( grid(ng) % xu(lbi:ubi,lbj:ubj) )
557 dmem(ng)=dmem(ng)+size2d
558
559 allocate ( grid(ng) % xv(lbi:ubi,lbj:ubj) )
560 dmem(ng)=dmem(ng)+size2d
561
562 allocate ( grid(ng) % yp(lbi:ubi,lbj:ubj) )
563 dmem(ng)=dmem(ng)+size2d
564
565 allocate ( grid(ng) % yr(lbi:ubi,lbj:ubj) )
566 dmem(ng)=dmem(ng)+size2d
567
568 allocate ( grid(ng) % yu(lbi:ubi,lbj:ubj) )
569 dmem(ng)=dmem(ng)+size2d
570
571 allocate ( grid(ng) % yv(lbi:ubi,lbj:ubj) )
572 dmem(ng)=dmem(ng)+size2d
573
574#ifdef SOLVE3D
575 allocate ( grid(ng) % Hz(lbi:ubi,lbj:ubj,n(ng)) )
576 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
577
578# ifdef ADJUST_BOUNDARY
579 allocate ( grid(ng) % Hz_bry(lbij:ubij,n(ng),4) )
580 dmem(ng)=dmem(ng)+4.0_r8*real((ubij-lbij)*n(ng),r8)
581# endif
582
583 allocate ( grid(ng) % Huon(lbi:ubi,lbj:ubj,n(ng)) )
584 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
585
586 allocate ( grid(ng) % Hvom(lbi:ubi,lbj:ubj,n(ng)) )
587 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
588
589 allocate ( grid(ng) % z0_r(lbi:ubi,lbj:ubj,n(ng)) )
590 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
591
592 allocate ( grid(ng) % z0_w(lbi:ubi,lbj:ubj,0:n(ng)) )
593 dmem(ng)=dmem(ng)+real(n(ng)+1,r8)*size2d
594
595 allocate ( grid(ng) % z_r(lbi:ubi,lbj:ubj,n(ng)) )
596 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
597
598 allocate ( grid(ng) % z_v(lbi:ubi,lbj:ubj,n(ng)) )
599 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
600
601 allocate ( grid(ng) % z_w(lbi:ubi,lbj:ubj,0:n(ng)) )
602 dmem(ng)=dmem(ng)+real(n(ng)+1,r8)*size2d
603
604# ifdef ICESHELF
605 allocate ( grid(ng) % IcePress(lbi:ubi,lbj:ubj) )
606 dmem(ng)=dmem(ng)+size2d
607
608 allocate ( grid(ng) % zice(lbi:ubi,lbj:ubj) )
609 dmem(ng)=dmem(ng)+size2d
610# endif
611
612#endif
613
614#ifdef MASKING
615 allocate ( grid(ng) % pmask(lbi:ubi,lbj:ubj) )
616 dmem(ng)=dmem(ng)+size2d
617
618 allocate ( grid(ng) % rmask(lbi:ubi,lbj:ubj) )
619 dmem(ng)=dmem(ng)+size2d
620
621 allocate ( grid(ng) % umask(lbi:ubi,lbj:ubj) )
622 dmem(ng)=dmem(ng)+size2d
623
624 allocate ( grid(ng) % vmask(lbi:ubi,lbj:ubj) )
625 dmem(ng)=dmem(ng)+size2d
626# if defined AVERAGES || \
627 (defined ad_averages && defined adjoint) || \
628 (defined rp_averages && defined tl_ioms) || \
629 (defined tl_averages && defined tangent)
630 allocate ( grid(ng) % pmask_avg(lbi:ubi,lbj:ubj) )
631 dmem(ng)=dmem(ng)+size2d
632
633 allocate ( grid(ng) % rmask_avg(lbi:ubi,lbj:ubj) )
634 dmem(ng)=dmem(ng)+size2d
635
636 allocate ( grid(ng) % umask_avg(lbi:ubi,lbj:ubj) )
637 dmem(ng)=dmem(ng)+size2d
638
639 allocate ( grid(ng) % vmask_avg(lbi:ubi,lbj:ubj) )
640 dmem(ng)=dmem(ng)+size2d
641# endif
642# ifdef DIAGNOSTICS
643 allocate ( grid(ng) % pmask_dia(lbi:ubi,lbj:ubj) )
644 dmem(ng)=dmem(ng)+size2d
645
646 allocate ( grid(ng) % rmask_dia(lbi:ubi,lbj:ubj) )
647 dmem(ng)=dmem(ng)+size2d
648
649 allocate ( grid(ng) % umask_dia(lbi:ubi,lbj:ubj) )
650 dmem(ng)=dmem(ng)+size2d
651
652 allocate ( grid(ng) % vmask_dia(lbi:ubi,lbj:ubj) )
653 dmem(ng)=dmem(ng)+size2d
654# endif
655 allocate ( grid(ng) % pmask_full(lbi:ubi,lbj:ubj) )
656 dmem(ng)=dmem(ng)+size2d
657
658 allocate ( grid(ng) % rmask_full(lbi:ubi,lbj:ubj) )
659 dmem(ng)=dmem(ng)+size2d
660
661 allocate ( grid(ng) % umask_full(lbi:ubi,lbj:ubj) )
662 dmem(ng)=dmem(ng)+size2d
663
664 allocate ( grid(ng) % vmask_full(lbi:ubi,lbj:ubj) )
665 dmem(ng)=dmem(ng)+size2d
666#endif
667
668#ifdef WET_DRY
669 allocate ( grid(ng) % pmask_wet(lbi:ubi,lbj:ubj) )
670 dmem(ng)=dmem(ng)+size2d
671
672 allocate ( grid(ng) % rmask_wet(lbi:ubi,lbj:ubj) )
673 dmem(ng)=dmem(ng)+size2d
674
675 allocate ( grid(ng) % umask_wet(lbi:ubi,lbj:ubj) )
676 dmem(ng)=dmem(ng)+size2d
677
678 allocate ( grid(ng) % vmask_wet(lbi:ubi,lbj:ubj) )
679 dmem(ng)=dmem(ng)+size2d
680# ifdef SOLVE3D
681 allocate ( grid(ng) % rmask_wet_avg(lbi:ubi,lbj:ubj) )
682 dmem(ng)=dmem(ng)+size2d
683# endif
684#endif
685
686#if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
687 defined opt_observations || defined sensitivity_4dvar || \
688 defined so_semi
689 allocate ( grid(ng) % Rscope(lbi:ubi,lbj:ubj) )
690 dmem(ng)=dmem(ng)+size2d
691
692 allocate ( grid(ng) % Uscope(lbi:ubi,lbj:ubj) )
693 dmem(ng)=dmem(ng)+size2d
694
695 allocate ( grid(ng) % Vscope(lbi:ubi,lbj:ubj) )
696 dmem(ng)=dmem(ng)+size2d
697#endif
698
699#if defined TANGENT || defined TL_IOMS
700!
701! Tangent linear model state.
702!
703 allocate ( grid(ng) % tl_h(lbi:ubi,lbj:ubj) )
704 dmem(ng)=dmem(ng)+size2d
705
706# ifdef SOLVE3D
707 allocate ( grid(ng) % tl_Hz(lbi:ubi,lbj:ubj,n(ng)) )
708 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
709
710# ifdef ADJUST_BOUNDARY
711 allocate ( grid(ng) % tl_Hz_bry(lbij:ubij,n(ng),4) )
712 dmem(ng)=dmem(ng)+4.0_r8*real((ubij-lbij)*n(ng),r8)*size2d
713# endif
714
715 allocate ( grid(ng) % tl_Huon(lbi:ubi,lbj:ubj,n(ng)) )
716 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
717
718 allocate ( grid(ng) % tl_Hvom(lbi:ubi,lbj:ubj,n(ng)) )
719 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
720
721 allocate ( grid(ng) % tl_z_r(lbi:ubi,lbj:ubj,n(ng)) )
722 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
723
724 allocate ( grid(ng) % tl_z_w(lbi:ubi,lbj:ubj,0:n(ng)) )
725 dmem(ng)=dmem(ng)+real(n(ng)+1,r8)*size2d
726# endif
727#endif
728
729#ifdef ADJOINT
730!
731! Adjoint model state.
732!
733 allocate ( grid(ng) % ad_h(lbi:ubi,lbj:ubj) )
734 dmem(ng)=dmem(ng)+size2d
735
736# ifdef SOLVE3D
737 allocate ( grid(ng) % ad_Hz(lbi:ubi,lbj:ubj,n(ng)) )
738 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
739
740# ifdef ADJUST_BOUNDARY
741 allocate ( grid(ng) % ad_Hz_bry(lbij:ubij,n(ng),4) )
742 dmem(ng)=dmem(ng)+4.0_r8*real((ubij-lbij)*n(ng),r8)*size2d
743# endif
744
745 allocate ( grid(ng) % ad_Huon(lbi:ubi,lbj:ubj,n(ng)) )
746 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
747
748 allocate ( grid(ng) % ad_Hvom(lbi:ubi,lbj:ubj,n(ng)) )
749 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
750
751 allocate ( grid(ng) % ad_z_r(lbi:ubi,lbj:ubj,n(ng)) )
752 dmem(ng)=dmem(ng)+real(n(ng),r8)*size2d
753
754 allocate ( grid(ng) % ad_z_w(lbi:ubi,lbj:ubj,0:n(ng)) )
755 dmem(ng)=dmem(ng)+real(n(ng)+1,r8)*size2d
756# endif
757#endif
758
759#ifdef GRID_EXTRACT
760!
761! Allocate global arrays for extraction by interpolation.
762!
763 IF (extract_flag.ge.1) THEN
764 my_size=(iobounds(ng)%IUB_psi-iobounds(ng)%ILB_psi+1)* &
765 & (iobounds(ng)%JUB_psi-iobounds(ng)%JLB_psi+1)
766
767 allocate ( grid(ng) % Gangle_psi(my_size) )
768 dmem(ng)=dmem(ng)+real(my_size,r8)
769
770# ifdef MASKING
771 allocate ( grid(ng) % Gmask_psi(my_size) )
772 dmem(ng)=dmem(ng)+real(my_size,r8)
773# endif
774
775 allocate ( grid(ng) % Gx_psi(my_size) )
776 dmem(ng)=dmem(ng)+real(my_size,r8)
777
778 allocate ( grid(ng) % Gy_psi(my_size) )
779 dmem(ng)=dmem(ng)+real(my_size,r8)
780!
781 my_size=(iobounds(ng)%IUB_rho-iobounds(ng)%ILB_rho+1)* &
782 & (iobounds(ng)%JUB_rho-iobounds(ng)%JLB_rho+1)
783
784 allocate ( grid(ng) % Gangle_rho(my_size) )
785 dmem(ng)=dmem(ng)+real(my_size,r8)
786
787# ifdef MASKING
788 allocate ( grid(ng) % Gmask_rho(my_size) )
789 dmem(ng)=dmem(ng)+real(my_size,r8)
790# endif
791
792 allocate ( grid(ng) % Gx_rho(my_size) )
793 dmem(ng)=dmem(ng)+real(my_size,r8)
794
795 allocate ( grid(ng) % Gy_rho(my_size) )
796 dmem(ng)=dmem(ng)+real(my_size,r8)
797!
798 my_size=(iobounds(ng)%IUB_u-iobounds(ng)%ILB_u+1)* &
799 & (iobounds(ng)%JUB_u-iobounds(ng)%JLB_u+1)
800
801 allocate ( grid(ng) % Gangle_u(my_size) )
802 dmem(ng)=dmem(ng)+real(my_size,r8)
803
804# ifdef MASKING
805 allocate ( grid(ng) % Gmask_u(my_size) )
806 dmem(ng)=dmem(ng)+real(my_size,r8)
807# endif
808
809 allocate ( grid(ng) % Gx_u(my_size) )
810 dmem(ng)=dmem(ng)+real(my_size,r8)
811
812 allocate ( grid(ng) % Gy_u(my_size) )
813 dmem(ng)=dmem(ng)+real(my_size,r8)
814!
815 my_size=(iobounds(ng)%IUB_v-iobounds(ng)%ILB_v+1)* &
816 & (iobounds(ng)%JUB_v-iobounds(ng)%JLB_v+1)
817
818 allocate ( grid(ng) % Gangle_v(my_size) )
819 dmem(ng)=dmem(ng)+real(my_size,r8)
820
821# ifdef MASKING
822 allocate ( grid(ng) % Gmask_v(my_size) )
823 dmem(ng)=dmem(ng)+real(my_size,r8)
824# endif
825
826 allocate ( grid(ng) % Gx_v(my_size) )
827 dmem(ng)=dmem(ng)+real(my_size,r8)
828
829 allocate ( grid(ng) % Gy_v(my_size) )
830 dmem(ng)=dmem(ng)+real(my_size,r8)
831 END IF
832#endif
833!
834 RETURN
835 END SUBROUTINE allocate_grid
836!
837 SUBROUTINE deallocate_grid (ng)
838!
839!=======================================================================
840! !
841! This routine deallocates all variables in the module for all nested !
842! grids. !
843! !
844!=======================================================================
845!
846 USE mod_param, ONLY : ngrids
847#ifdef SUBOBJECT_DEALLOCATION
848 USE destroy_mod, ONLY : destroy
849#endif
850!
851! Imported variable declarations.
852!
853 integer, intent(in) :: ng
854!
855! Local variable declarations.
856!
857 character (len=*), parameter :: myfile = &
858 & __FILE__//", deallocate_grid"
859
860#ifdef SUBOBJECT_DEALLOCATION
861!
862!-----------------------------------------------------------------------
863! Deallocate each variable in the derived-type T_GRID structure
864! separately.
865!-----------------------------------------------------------------------
866!
867! Nonlinear model state.
868!
869# if defined MASKING && defined PROPAGATOR
870 IF (.not.destroy(ng, grid(ng)%IJwaterR, myfile, &
871 & __line__, 'GRID(ng)%IJwaterR')) RETURN
872
873 IF (.not.destroy(ng, grid(ng)%IJwaterU, myfile, &
874 & __line__, 'GRID(ng)%IJwaterU')) RETURN
875
876 IF (.not.destroy(ng, grid(ng)%IJwaterV, myfile, &
877 & __line__, 'GRID(ng)%IJwaterV')) RETURN
878# endif
879
880 IF (.not.destroy(ng, grid(ng)%angler, myfile, &
881 & __line__, 'GRID(ng)%angler')) RETURN
882
883 IF (.not.destroy(ng, grid(ng)%CosAngler, myfile, &
884 & __line__, 'GRID(ng)%CosAngler')) RETURN
885
886 IF (.not.destroy(ng, grid(ng)%SinAngler, myfile, &
887 & __line__, 'GRID(ng)%SinAngler')) RETURN
888
889# if defined TIDE_GENERATING_FORCES
890 IF (.not.destroy(ng, grid(ng)%Cos2Lat, myfile, &
891 & __line__, 'GRID(ng)%Cos2Lat')) RETURN
892
893 IF (.not.destroy(ng, grid(ng)%SinLat2, myfile, &
894 & __line__, 'GRID(ng)%SinLat2')) RETURN
895# endif
896
897# if defined CURVGRID && defined UV_ADV
898 IF (.not.destroy(ng, grid(ng)%dmde, myfile, &
899 & __line__, 'GRID(ng)%dmde')) RETURN
900
901 IF (.not.destroy(ng, grid(ng)%dndx, myfile, &
902 & __line__, 'GRID(ng)%dndx')) RETURN
903# endif
904
905 IF (.not.destroy(ng, grid(ng)%f, myfile, &
906 & __line__, 'GRID(ng)%f')) RETURN
907
908 IF (.not.destroy(ng, grid(ng)%fomn, myfile, &
909 & __line__, 'GRID(ng)%fomn')) RETURN
910
911 IF (.not.destroy(ng, grid(ng)%grdscl, myfile, &
912 & __line__, 'GRID(ng)%grdscl')) RETURN
913
914 IF (.not.destroy(ng, grid(ng)%h, myfile, &
915 & __line__, 'GRID(ng)%h')) RETURN
916
917 IF (.not.destroy(ng, grid(ng)%latp, myfile, &
918 & __line__, 'GRID(ng)%latp')) RETURN
919
920 IF (.not.destroy(ng, grid(ng)%latr, myfile, &
921 & __line__, 'GRID(ng)%latr')) RETURN
922
923 IF (.not.destroy(ng, grid(ng)%latu, myfile, &
924 & __line__, 'GRID(ng)%latu')) RETURN
925
926 IF (.not.destroy(ng, grid(ng)%latv, myfile, &
927 & __line__, 'GRID(ng)%latv')) RETURN
928
929 IF (.not.destroy(ng, grid(ng)%lonp, myfile, &
930 & __line__, 'GRID(ng)%lonp')) RETURN
931
932 IF (.not.destroy(ng, grid(ng)%lonr, myfile, &
933 & __line__, 'GRID(ng)%lonr')) RETURN
934
935 IF (.not.destroy(ng, grid(ng)%lonu, myfile, &
936 & __line__, 'GRID(ng)%lonu')) RETURN
937
938 IF (.not.destroy(ng, grid(ng)%lonv, myfile, &
939 & __line__, 'GRID(ng)%lonv')) RETURN
940
941 IF (.not.destroy(ng, grid(ng)%Mylon, myfile, &
942 & __line__, 'GRID(ng)%Mylon')) RETURN
943
944 IF (.not.destroy(ng, grid(ng)%omn, myfile, &
945 & __line__, 'GRID(ng)%omn')) RETURN
946
947 IF (.not.destroy(ng, grid(ng)%om_p, myfile, &
948 & __line__, 'GRID(ng)%om_p')) RETURN
949
950 IF (.not.destroy(ng, grid(ng)%om_r, myfile, &
951 & __line__, 'GRID(ng)%om_r')) RETURN
952
953 IF (.not.destroy(ng, grid(ng)%om_u, myfile, &
954 & __line__, 'GRID(ng)%om_u')) RETURN
955
956 IF (.not.destroy(ng, grid(ng)%om_v, myfile, &
957 & __line__, 'GRID(ng)%om_v')) RETURN
958
959 IF (.not.destroy(ng, grid(ng)%on_p, myfile, &
960 & __line__, 'GRID(ng)%on_p')) RETURN
961
962 IF (.not.destroy(ng, grid(ng)%on_r, myfile, &
963 & __line__, 'GRID(ng)%on_r')) RETURN
964
965 IF (.not.destroy(ng, grid(ng)%on_u, myfile, &
966 & __line__, 'GRID(ng)%on_u')) RETURN
967
968 IF (.not.destroy(ng, grid(ng)%on_v, myfile, &
969 & __line__, 'GRID(ng)%on_v')) RETURN
970
971 IF (.not.destroy(ng, grid(ng)%pm, myfile, &
972 & __line__, 'GRID(ng)%pm')) RETURN
973
974 IF (.not.destroy(ng, grid(ng)%pn, myfile, &
975 & __line__, 'GRID(ng)%pn')) RETURN
976
977 IF (.not.destroy(ng, grid(ng)%pmon_p, myfile, &
978 & __line__, 'GRID(ng)%pmon_p')) RETURN
979
980 IF (.not.destroy(ng, grid(ng)%pmon_r, myfile, &
981 & __line__, 'GRID(ng)%pmon_r')) RETURN
982
983 IF (.not.destroy(ng, grid(ng)%pmon_u, myfile, &
984 & __line__, 'GRID(ng)%pmon_u')) RETURN
985
986 IF (.not.destroy(ng, grid(ng)%pmon_v, myfile, &
987 & __line__, 'GRID(ng)%pmon_v')) RETURN
988
989 IF (.not.destroy(ng, grid(ng)%pnom_p, myfile, &
990 & __line__, 'GRID(ng)%pnom_p')) RETURN
991
992 IF (.not.destroy(ng, grid(ng)%pnom_r, myfile, &
993 & __line__, 'GRID(ng)%pnom_r')) RETURN
994
995 IF (.not.destroy(ng, grid(ng)%pnom_u, myfile, &
996 & __line__, 'GRID(ng)%pnom_u')) RETURN
997
998 IF (.not.destroy(ng, grid(ng)%pnom_v, myfile, &
999 & __line__, 'GRID(ng)%pnom_v')) RETURN
1000
1001# if defined UV_LOGDRAG || defined GLS_MIXING || \
1002 defined bbl_model || defined sediment
1003 IF (.not.destroy(ng, grid(ng)%ZoBot, myfile, &
1004 & __line__, 'GRID(ng)%ZoBot')) RETURN
1005# endif
1006
1007 IF (.not.destroy(ng, grid(ng)%rdrag, myfile, &
1008 & __line__, 'GRID(ng)%rdrag')) RETURN
1009
1010# if defined UV_QDRAG
1011 IF (.not.destroy(ng, grid(ng)%rdrag2, myfile, &
1012 & __line__, 'GRID(ng)%rdrag2')) RETURN
1013# endif
1014
1015 IF (.not.destroy(ng, grid(ng)%xp, myfile, &
1016 & __line__, 'GRID(ng)%xp')) RETURN
1017
1018 IF (.not.destroy(ng, grid(ng)%xr, myfile, &
1019 & __line__, 'GRID(ng)%xr')) RETURN
1020
1021 IF (.not.destroy(ng, grid(ng)%xu, myfile, &
1022 & __line__, 'GRID(ng)%xu')) RETURN
1023
1024 IF (.not.destroy(ng, grid(ng)%xv, myfile, &
1025 & __line__, 'GRID(ng)%xv')) RETURN
1026
1027 IF (.not.destroy(ng, grid(ng)%yp, myfile, &
1028 & __line__, 'GRID(ng)%yp')) RETURN
1029
1030 IF (.not.destroy(ng, grid(ng)%yr, myfile, &
1031 & __line__, 'GRID(ng)%yr')) RETURN
1032
1033 IF (.not.destroy(ng, grid(ng)%yu, myfile, &
1034 & __line__, 'GRID(ng)%yu')) RETURN
1035
1036 IF (.not.destroy(ng, grid(ng)%yv, myfile, &
1037 & __line__, 'GRID(ng)%yv')) RETURN
1038
1039# ifdef SOLVE3D
1040 IF (.not.destroy(ng, grid(ng)%Hz, myfile, &
1041 & __line__, 'GRID(ng)%Hz')) RETURN
1042
1043# ifdef ADJUST_BOUNDARY
1044 IF (.not.destroy(ng, grid(ng)%Hz_bry, myfile, &
1045 & __line__, 'GRID(ng)%Hz_bry')) RETURN
1046# endif
1047
1048 IF (.not.destroy(ng, grid(ng)%Huon, myfile, &
1049 & __line__, 'GRID(ng)%Huon')) RETURN
1050
1051 IF (.not.destroy(ng, grid(ng)%Hvom, myfile, &
1052 & __line__, 'GRID(ng)%Hvom')) RETURN
1053
1054 IF (.not.destroy(ng, grid(ng)%z0_r, myfile, &
1055 & __line__, 'GRID(ng)%z0_r')) RETURN
1056
1057 IF (.not.destroy(ng, grid(ng)%z0_w, myfile, &
1058 & __line__, 'GRID(ng)%z0_w')) RETURN
1059
1060 IF (.not.destroy(ng, grid(ng)%z_r, myfile, &
1061 & __line__, 'GRID(ng)%z_r')) RETURN
1062
1063 IF (.not.destroy(ng, grid(ng)%z_v, myfile, &
1064 & __line__, 'GRID(ng)%z_v')) RETURN
1065
1066 IF (.not.destroy(ng, grid(ng)%z_w, myfile, &
1067 & __line__, 'GRID(ng)%z_w')) RETURN
1068
1069# ifdef ICESHELF
1070 IF (.not.destroy(ng, grid(ng)%IcePress, myfile, &
1071 & __line__, 'GRID(ng)%IcePress')) RETURN
1072
1073 IF (.not.destroy(ng, grid(ng)%zice, myfile, &
1074 & __line__, 'GRID(ng)%zice')) RETURN
1075# endif
1076
1077# endif
1078
1079# ifdef MASKING
1080 IF (.not.destroy(ng, grid(ng)%pmask, myfile, &
1081 & __line__, 'GRID(ng)%pmask')) RETURN
1082
1083 IF (.not.destroy(ng, grid(ng)%rmask, myfile, &
1084 & __line__, 'GRID(ng)%rmask')) RETURN
1085
1086 IF (.not.destroy(ng, grid(ng)%umask, myfile, &
1087 & __line__, 'GRID(ng)%umask')) RETURN
1088
1089 IF (.not.destroy(ng, grid(ng)%vmask, myfile, &
1090 & __line__, 'GRID(ng)%vmask')) RETURN
1091
1092# if defined AVERAGES || \
1093 (defined ad_averages && defined adjoint) || \
1094 (defined rp_averages && defined tl_ioms) || \
1095 (defined tl_averages && defined tangent)
1096 IF (.not.destroy(ng, grid(ng)%pmask_avg, myfile, &
1097 & __line__, 'GRID(ng)%pmask_avg')) RETURN
1098
1099 IF (.not.destroy(ng, grid(ng)%rmask_avg, myfile, &
1100 & __line__, 'GRID(ng)%rmask_avg')) RETURN
1101
1102 IF (.not.destroy(ng, grid(ng)%umask_avg, myfile, &
1103 & __line__, 'GRID(ng)%umask_avg')) RETURN
1104
1105 IF (.not.destroy(ng, grid(ng)%vmask_avg, myfile, &
1106 & __line__, 'GRID(ng)%vmask_avg')) RETURN
1107# endif
1108
1109# ifdef DIAGNOSTICS
1110 IF (.not.destroy(ng, grid(ng)%pmask_dia, myfile, &
1111 & __line__, 'GRID(ng)%pmask_dia')) RETURN
1112
1113 IF (.not.destroy(ng, grid(ng)%rmask_dia, myfile, &
1114 & __line__, 'GRID(ng)%rmask_dia')) RETURN
1115
1116 IF (.not.destroy(ng, grid(ng)%umask_dia, myfile, &
1117 & __line__, 'GRID(ng)%umask_dia')) RETURN
1118
1119 IF (.not.destroy(ng, grid(ng)%vmask_dia, myfile, &
1120 & __line__, 'GRID(ng)%vmask_dia')) RETURN
1121# endif
1122
1123 IF (.not.destroy(ng, grid(ng)%pmask_full, myfile, &
1124 & __line__, 'GRID(ng)%pmask_full')) RETURN
1125
1126 IF (.not.destroy(ng, grid(ng)%rmask_full, myfile, &
1127 & __line__, 'GRID(ng)%rmask_full')) RETURN
1128
1129 IF (.not.destroy(ng, grid(ng)%umask_full, myfile, &
1130 & __line__, 'GRID(ng)%umask_full')) RETURN
1131
1132 IF (.not.destroy(ng, grid(ng)%vmask_full, myfile, &
1133 & __line__, 'GRID(ng)%vmask_full')) RETURN
1134# endif
1135
1136# ifdef WET_DRY
1137 IF (.not.destroy(ng, grid(ng)%pmask_wet, myfile, &
1138 & __line__, 'GRID(ng)%pmask_wet')) RETURN
1139
1140 IF (.not.destroy(ng, grid(ng)%rmask_wet, myfile, &
1141 & __line__, 'GRID(ng)%rmask_wet')) RETURN
1142
1143 IF (.not.destroy(ng, grid(ng)%umask_wet, myfile, &
1144 & __line__, 'GRID(ng)%umask_wet')) RETURN
1145
1146 IF (.not.destroy(ng, grid(ng)%vmask_wet, myfile, &
1147 & __line__, 'GRID(ng)%vmask_wet')) RETURN
1148
1149# ifdef SOLVE3D
1150 IF (.not.destroy(ng, grid(ng)%rmask_wet_avg, myfile, &
1151 & __line__, 'GRID(ng)%rmask_wet_avg')) RETURN
1152# endif
1153# endif
1154
1155# if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
1156 defined opt_observations || defined sensitivity_4dvar || \
1157 defined so_semi
1158 IF (.not.destroy(ng, grid(ng)%Rscope, myfile, &
1159 & __line__, 'GRID(ng)%Rscope')) RETURN
1160
1161 IF (.not.destroy(ng, grid(ng)%Uscope, myfile, &
1162 & __line__, 'GRID(ng)%Uscope')) RETURN
1163
1164 IF (.not.destroy(ng, grid(ng)%Vscope, myfile, &
1165 & __line__, 'GRID(ng)%Vscope')) RETURN
1166# endif
1167
1168# if defined TANGENT || defined TL_IOMS
1169!
1170! Tangent linear model state.
1171!
1172 IF (.not.destroy(ng, grid(ng)%tl_h, myfile, &
1173 & __line__, 'GRID(ng)%tl_h')) RETURN
1174
1175# ifdef SOLVE3D
1176 IF (.not.destroy(ng, grid(ng)%tl_Hz, myfile, &
1177 & __line__, 'GRID(ng)%tl_Hz')) RETURN
1178
1179# ifdef ADJUST_BOUNDARY
1180 IF (.not.destroy(ng, grid(ng)%tl_Hz_bry, myfile, &
1181 & __line__, 'GRID(ng)%tl_Hz_bry')) RETURN
1182# endif
1183
1184 IF (.not.destroy(ng, grid(ng)%tl_Huon, myfile, &
1185 & __line__, 'GRID(ng)%tl_Huon')) RETURN
1186
1187 IF (.not.destroy(ng, grid(ng)%tl_Hvom, myfile, &
1188 & __line__, 'GRID(ng)%tl_Hvom')) RETURN
1189
1190 IF (.not.destroy(ng, grid(ng)%tl_z_r, myfile, &
1191 & __line__, 'GRID(ng)%tl_z_r')) RETURN
1192
1193 IF (.not.destroy(ng, grid(ng)%tl_z_w, myfile, &
1194 & __line__, 'GRID(ng)%tl_z_w')) RETURN
1195# endif
1196# endif
1197
1198# ifdef ADJOINT
1199!
1200! Adjoint model state.
1201!
1202 IF (.not.destroy(ng, grid(ng)%ad_h, myfile, &
1203 & __line__, 'GRID(ng)%ad_h')) RETURN
1204
1205# ifdef SOLVE3D
1206 IF (.not.destroy(ng, grid(ng)%ad_Hz, myfile, &
1207 & __line__, 'GRID(ng)%ad_Hz')) RETURN
1208
1209# ifdef ADJUST_BOUNDARY
1210 IF (.not.destroy(ng, grid(ng)%ad_Hz_bry, myfile, &
1211 & __line__, 'GRID(ng)%ad_Hz_bry')) RETURN
1212# endif
1213
1214 IF (.not.destroy(ng, grid(ng)%ad_Huon, myfile, &
1215 & __line__, 'GRID(ng)%ad_Huon')) RETURN
1216
1217 IF (.not.destroy(ng, grid(ng)%ad_Hvom, myfile, &
1218 & __line__, 'GRID(ng)%ad_Hvom')) RETURN
1219
1220 IF (.not.destroy(ng, grid(ng)%ad_z_r, myfile, &
1221 & __line__, 'GRID(ng)%ad_z_r')) RETURN
1222
1223 IF (.not.destroy(ng, grid(ng)%ad_z_w, myfile, &
1224 & __line__, 'GRID(ng)%ad_z_w')) RETURN
1225# endif
1226# endif
1227#endif
1228!
1229!-----------------------------------------------------------------------
1230! Deallocate derived-type GRID structure.
1231!-----------------------------------------------------------------------
1232!
1233 IF (ng.eq.ngrids) THEN
1234 IF (allocated(grid)) deallocate ( grid )
1235 END IF
1236!
1237 RETURN
1238 END SUBROUTINE deallocate_grid
1239!
1240 SUBROUTINE initialize_grid (ng, tile, model)
1241!
1242!=======================================================================
1243! !
1244! This routine initialize all variables in the module using first !
1245! touch distribution policy. In shared-memory configuration, this !
1246! operation actually performs propagation of the "shared arrays" !
1247! across the cluster, unless another policy is specified to !
1248! override the default. !
1249! !
1250!=======================================================================
1251!
1252 USE mod_param
1253 USE mod_scalars
1254!
1255! Imported variable declarations.
1256!
1257 integer, intent(in) :: ng, tile, model
1258!
1259! Local variable declarations.
1260!
1261 integer :: imin, imax, jmin, jmax
1262 integer :: i, j
1263#ifdef SOLVE3D
1264 integer :: k
1265#endif
1266
1267 real(r8), parameter :: inival = 0.0_r8
1268 real(r8) :: inimetricval
1269
1270#include "set_bounds.h"
1271!
1272! Set array initialization range.
1273!
1274#ifdef DISTRIBUTE
1275 imin=bounds(ng)%LBi(tile)
1276 imax=bounds(ng)%UBi(tile)
1277 jmin=bounds(ng)%LBj(tile)
1278 jmax=bounds(ng)%UBj(tile)
1279#else
1280 IF (domain(ng)%Western_Edge(tile)) THEN
1281 imin=bounds(ng)%LBi(tile)
1282 ELSE
1283 imin=istr
1284 END IF
1285 IF (domain(ng)%Eastern_Edge(tile)) THEN
1286 imax=bounds(ng)%UBi(tile)
1287 ELSE
1288 imax=iend
1289 END IF
1290 IF (domain(ng)%Southern_Edge(tile)) THEN
1291 jmin=bounds(ng)%LBj(tile)
1292 ELSE
1293 jmin=jstr
1294 END IF
1295 IF (domain(ng)%Northern_Edge(tile)) THEN
1296 jmax=bounds(ng)%UBj(tile)
1297 ELSE
1298 jmax=jend
1299 END IF
1300#endif
1301!
1302! Set initialization value that it is special in nexting to just
1303! load contact points that have not been initialized from the
1304! regular physical grid. This is done to make sure that all these
1305! important metric values have been set-up correctly.
1306!
1307#ifdef NESTING
1308 inimetricval=spval ! very large value
1309#else
1310 inimetricval=inival
1311#endif
1312!
1313!-----------------------------------------------------------------------
1314! Initialize module variables.
1315!-----------------------------------------------------------------------
1316!
1317! Nonlinear model state.
1318!
1319 IF ((model.eq.0).or.(model.eq.inlm)) THEN
1320 DO j=jmin,jmax
1321 DO i=imin,imax
1322#if defined MASKING && defined PROPAGATOR
1323 grid(ng) % IJwaterR(i,j) = 0
1324 grid(ng) % IJwaterU(i,j) = 0
1325 grid(ng) % IJwaterV(i,j) = 0
1326#endif
1327 grid(ng) % angler(i,j) = inimetricval
1328 grid(ng) % CosAngler(i,j) = inival
1329 grid(ng) % SinAngler(i,j) = inival
1330
1331#if defined TIDE_GENERATING_FORCES
1332 grid(ng) % Cos2Lat(i,j) = inival
1333 grid(ng) % SinLat2(i,j) = inival
1334#endif
1335
1336#if defined CURVGRID && defined UV_ADV
1337 grid(ng) % dmde(i,j) = inimetricval
1338 grid(ng) % dndx(i,j) = inimetricval
1339#endif
1340 grid(ng) % f(i,j) = inimetricval
1341 grid(ng) % fomn(i,j) = inival
1342 grid(ng) % grdscl(i,j) = inival
1343
1344 grid(ng) % h(i,j) = inimetricval
1345
1346 grid(ng) % latp(i,j) = inival
1347 grid(ng) % latr(i,j) = inimetricval
1348 grid(ng) % latu(i,j) = inimetricval
1349 grid(ng) % latv(i,j) = inimetricval
1350 grid(ng) % lonp(i,j) = inival
1351 grid(ng) % lonr(i,j) = inimetricval
1352 grid(ng) % lonu(i,j) = inimetricval
1353 grid(ng) % lonv(i,j) = inimetricval
1354 grid(ng) % MyLon(i,j) = inimetricval
1355
1356 grid(ng) % omn(i,j) = inival
1357 grid(ng) % om_p(i,j) = inival
1358 grid(ng) % om_r(i,j) = inival
1359 grid(ng) % om_u(i,j) = inival
1360 grid(ng) % om_v(i,j) = inival
1361 grid(ng) % on_p(i,j) = inival
1362 grid(ng) % on_r(i,j) = inival
1363 grid(ng) % on_u(i,j) = inival
1364 grid(ng) % on_v(i,j) = inival
1365
1366 grid(ng) % pm(i,j) = inimetricval
1367 grid(ng) % pn(i,j) = inimetricval
1368
1369 grid(ng) % pmon_p(i,j) = inival
1370 grid(ng) % pmon_r(i,j) = inival
1371 grid(ng) % pmon_u(i,j) = inival
1372 grid(ng) % pmon_v(i,j) = inival
1373 grid(ng) % pnom_p(i,j) = inival
1374 grid(ng) % pnom_r(i,j) = inival
1375 grid(ng) % pnom_u(i,j) = inival
1376 grid(ng) % pnom_v(i,j) = inival
1377
1378#if defined UV_LOGDRAG || defined GLS_MIXING || \
1379 defined bbl_model || defined sediment
1380 grid(ng) % ZoBot(i,j) = zob(ng)
1381#endif
1382 grid(ng) % rdrag(i,j) = rdrg(ng)
1383#if defined UV_QDRAG
1384 grid(ng) % rdrag2(i,j) = rdrg2(ng)
1385#endif
1386
1387 grid(ng) % xp(i,j) = inival
1388 grid(ng) % xr(i,j) = inimetricval
1389 grid(ng) % xu(i,j) = inimetricval
1390 grid(ng) % xv(i,j) = inimetricval
1391 grid(ng) % yp(i,j) = inival
1392 grid(ng) % yr(i,j) = inimetricval
1393 grid(ng) % yu(i,j) = inimetricval
1394 grid(ng) % yv(i,j) = inimetricval
1395
1396#if defined ICESHELF && defined SOLVE3D
1397 grid(ng) % IcePress(i,j) = inival
1398 grid(ng) % zice(i,j) = inival
1399#endif
1400
1401#ifdef MASKING
1402 grid(ng) % pmask(i,j) = inival
1403 grid(ng) % rmask(i,j) = inimetricval
1404 grid(ng) % umask(i,j) = inimetricval
1405 grid(ng) % vmask(i,j) = inimetricval
1406# if defined AVERAGES || \
1407 (defined ad_averages && defined adjoint) || \
1408 (defined rp_averages && defined tl_ioms) || \
1409 (defined tl_averages && defined tangent)
1410 grid(ng) % pmask_avg(i,j) = inival
1411 grid(ng) % rmask_avg(i,j) = inival
1412 grid(ng) % umask_avg(i,j) = inival
1413 grid(ng) % vmask_avg(i,j) = inival
1414# endif
1415# ifdef DIAGNOSTICS
1416 grid(ng) % pmask_dia(i,j) = inival
1417 grid(ng) % rmask_dia(i,j) = inival
1418 grid(ng) % umask_dia(i,j) = inival
1419 grid(ng) % vmask_dia(i,j) = inival
1420# endif
1421 grid(ng) % pmask_full(i,j) = inival
1422 grid(ng) % rmask_full(i,j) = inival
1423 grid(ng) % umask_full(i,j) = inival
1424 grid(ng) % vmask_full(i,j) = inival
1425#endif
1426
1427#ifdef WET_DRY
1428 grid(ng) % pmask_wet(i,j) = inival
1429 grid(ng) % rmask_wet(i,j) = inival
1430 grid(ng) % umask_wet(i,j) = inival
1431 grid(ng) % vmask_wet(i,j) = inival
1432# ifdef SOLVE3D
1433 grid(ng) % rmask_wet_avg(i,j) = inival
1434# endif
1435#endif
1436
1437#if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
1438 defined opt_observations || defined sensitivity_4dvar || \
1439 defined so_semi
1440 grid(ng) % Rscope(i,j) = inival
1441 grid(ng) % Uscope(i,j) = inival
1442 grid(ng) % Vscope(i,j) = inival
1443#endif
1444 END DO
1445
1446#ifdef SOLVE3D
1447 DO k=1,n(ng)
1448 DO i=imin,imax
1449 grid(ng) % Hz(i,j,k) = inival
1450 grid(ng) % Huon(i,j,k) = inival
1451 grid(ng) % Hvom(i,j,k) = inival
1452 grid(ng) % z0_r(i,j,k) = inival
1453 grid(ng) % z_r(i,j,k) = inival
1454 grid(ng) % z_v(i,j,k) = inival
1455 END DO
1456 END DO
1457 DO k=0,n(ng)
1458 DO i=imin,imax
1459 grid(ng) % z0_w(i,j,k) = inival
1460 grid(ng) % z_w(i,j,k) = inival
1461 END DO
1462 END DO
1463#endif
1464 END DO
1465#if defined ADJUST_BOUNDARY && defined SOLVE3D
1466 grid(ng) % Hz_bry = inival
1467#endif
1468 END IF
1469
1470#if defined TANGENT || defined TL_IOMS
1471!
1472! Tangent linear model state.
1473!
1474 IF ((model.eq.0).or.(model.eq.itlm).or.(model.eq.irpm)) THEN
1475 DO j=jmin,jmax
1476 DO i=imin,imax
1477 grid(ng) % tl_h(i,j) = inival
1478 END DO
1479# ifdef SOLVE3D
1480 DO k=1,n(ng)
1481 DO i=imin,imax
1482 grid(ng) % tl_Hz(i,j,k) = inival
1483 grid(ng) % tl_Huon(i,j,k) = inival
1484 grid(ng) % tl_Hvom(i,j,k) = inival
1485 grid(ng) % tl_z_r(i,j,k) = inival
1486 END DO
1487 END DO
1488 DO k=0,n(ng)
1489 DO i=imin,imax
1490 grid(ng) % tl_z_w(i,j,k) = inival
1491 END DO
1492 END DO
1493# endif
1494 END DO
1495# if defined ADJUST_BOUNDARY && defined SOLVE3D
1496 grid(ng) % tl_Hz_bry = inival
1497# endif
1498 END IF
1499#endif
1500
1501#ifdef ADJOINT
1502!
1503! Adjoint model state.
1504!
1505 IF ((model.eq.0).or.(model.eq.iadm)) THEN
1506 DO j=jmin,jmax
1507 DO i=imin,imax
1508 grid(ng) % ad_h(i,j) = inival
1509 END DO
1510# ifdef SOLVE3D
1511 DO k=1,n(ng)
1512 DO i=imin,imax
1513 grid(ng) % ad_Hz(i,j,k) = inival
1514 grid(ng) % ad_Huon(i,j,k) = inival
1515 grid(ng) % ad_Hvom(i,j,k) = inival
1516 grid(ng) % ad_z_r(i,j,k) = inival
1517 END DO
1518 END DO
1519 DO k=0,n(ng)
1520 DO i=imin,imax
1521 grid(ng) % ad_z_w(i,j,k) = inival
1522 END DO
1523 END DO
1524# endif
1525 END DO
1526# if defined ADJUST_BOUNDARY && defined SOLVE3D
1527 grid(ng) % ad_Hz_bry = inival
1528# endif
1529 END IF
1530#endif
1531!
1532 RETURN
1533 END SUBROUTINE initialize_grid
1534
1535 END MODULE mod_grid
destroy_mod::destroy
Definition destroy.F:36
destroy_mod
Definition destroy.F:2
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_grid::initialize_grid
subroutine, public initialize_grid(ng, tile, model)
Definition mod_grid.F:1241
mod_grid::allocate_grid
subroutine, public allocate_grid(ng, extract_flag, lbi, ubi, lbj, ubj, lbij, ubij)
Definition mod_grid.F:371
mod_grid::deallocate_grid
subroutine, public deallocate_grid(ng)
Definition mod_grid.F:838
mod_kinds
Definition mod_kinds.F:2
mod_kinds::r8
integer, parameter r8
Definition mod_kinds.F:28
mod_param
Definition mod_param.F:2
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::irpm
integer, parameter irpm
Definition mod_param.F:664
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::bounds
type(t_bounds), dimension(:), allocatable bounds
Definition mod_param.F:232
mod_param::dmem
real(r8), dimension(:), allocatable dmem
Definition mod_param.F:137
mod_param::iobounds
type(t_iobounds), dimension(:), allocatable iobounds
Definition mod_param.F:282
mod_param::iadm
integer, parameter iadm
Definition mod_param.F:665
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_param::ngrids
integer ngrids
Definition mod_param.F:113
mod_param::itlm
integer, parameter itlm
Definition mod_param.F:663
mod_scalars
Definition mod_scalars.F:2
mod_scalars::spval
real(dp), parameter spval
Definition mod_scalars.F:821
mod_scalars::rdrg
real(r8), dimension(:), allocatable rdrg
Definition mod_scalars.F:767
mod_scalars::zob
real(r8), dimension(:), allocatable zob
Definition mod_scalars.F:778
mod_scalars::rdrg2
real(r8), dimension(:), allocatable rdrg2
Definition mod_scalars.F:768
mod_grid::t_grid
Definition mod_grid.F:175