ROMS
Loading...
Searching...
No Matches
get_grid.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE get_grid_mod
3
4#ifndef ANA_GRID
5!
6!git $Id$
7!================================================== Hernan G. Arango ===
8! Copyright (c) 2002-2025 The ROMS Group !
9! Licensed under a MIT/X style license !
10! See License_ROMS.md !
11!=======================================================================
12! !
13! This module reads grid information from input file using either !
14! the standard NetCDF library or the Parallel-IO (PIO) library. !
15! !
16!=======================================================================
17!
18 USE mod_param
19 USE mod_parallel
20 USE mod_grid
21 USE mod_iounits
22 USE mod_mixing
23 USE mod_ncparam
24# ifdef NESTING
25 USE mod_nesting
26# endif
27 USE mod_netcdf
28# if defined PIO_LIB && defined DISTRIBUTE
29 USE mod_pio_netcdf
30# endif
31 USE mod_scalars
32!
33 USE exchange_2d_mod
34# ifdef DISTRIBUTE
35 USE mp_exchange_mod, ONLY : mp_exchange2d
36# endif
37# ifdef NESTING
38 USE nesting_mod, ONLY : fill_contact
39# endif
40 USE nf_fread2d_mod, ONLY : nf_fread2d
41 USE strings_mod, ONLY : founderror, find_string
42!
43 implicit none
44!
45 PUBLIC :: get_grid
46 PRIVATE :: get_grid_nf90
47# if defined PIO_LIB && defined DISTRIBUTE
48 PRIVATE :: get_grid_pio
49# endif
50!
51 CONTAINS
52!
53!***********************************************************************
54 SUBROUTINE get_grid (ng, tile, model)
55!***********************************************************************
56!
57! Imported variable declarations.
58!
59 integer, intent(in) :: ng, tile, model
60!
61! Local variable declarations.
62!
63 integer :: lbi, ubi, lbj, ubj
64!
65 character (len=*), parameter :: myfile = &
66 & __FILE__
67!
68!-----------------------------------------------------------------------
69! Read in GRID NetCDF file according to IO type.
70!-----------------------------------------------------------------------
71!
72 lbi=bounds(ng)%LBi(tile)
73 ubi=bounds(ng)%UBi(tile)
74 lbj=bounds(ng)%LBj(tile)
75 ubj=bounds(ng)%UBj(tile)
76!
77 SELECT CASE (grd(ng)%IOtype)
78 CASE (io_nf90)
79 CALL get_grid_nf90 (ng, tile, model, &
80 & lbi, ubi, lbj, ubj)
81
82# if defined PIO_LIB && defined DISTRIBUTE
83 CASE (io_pio)
84 CALL get_grid_pio (ng, tile, model, &
85 & lbi, ubi, lbj, ubj)
86# endif
87 CASE DEFAULT
88 IF (master) WRITE (stdout,10) grd(ng)%IOtype
89 exit_flag=2
90 END SELECT
91 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
92!
93 10 FORMAT (' GET_GRID - Illegal input file type, io_type = ',i0, &
94 & /,12x,'Check KeyWord ''INP_LIB'' in ''roms.in''.')
95!
96 RETURN
97 END SUBROUTINE get_grid
98!
99!***********************************************************************
100 SUBROUTINE get_grid_nf90 (ng, tile, model, &
101 & LBi, UBi, LBj, UBj)
102!***********************************************************************
103!
104! Imported variable declarations.
105!
106 integer, intent(in) :: ng, tile, model
107 integer, intent(in) :: lbi, ubi, lbj, ubj
108!
109! Local variable declarations.
110!
111# if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
112 defined opt_observations || defined sensitivity_4dvar || \
113 defined so_semi
114# ifndef OBS_SPACE
115 logical :: gotscope(6)
116!
117# endif
118# endif
119 integer :: cr, gtype, i, status, vindex
120# if defined UV_DRAG_GRID && !defined ANA_DRAG
121 integer :: varid_dragl, varid_dragq, varid_zobl
122# endif
123#if defined UV_WAVEDRAG
124 integer :: varid_dragw
125#endif
126 integer :: vsize(4)
127# ifdef CHECKSUM
128 integer(i8b) :: fhash
129# endif
130!
131 real(dp), parameter :: fscl = 1.0_dp
132
133 real(r8) :: fmax, fmin
134!
135 character (len=256) :: ncname
136
137 character (len=*), parameter :: myfile = &
138 & __FILE__//", get_grid_nf90"
139!
140 sourcefile=myfile
141!
142!-----------------------------------------------------------------------
143! Inquire about the contents of grid NetCDF file: Inquire about
144! the dimensions and variables. Check for consistency.
145!-----------------------------------------------------------------------
146!
147 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
148 ncname=grd(ng)%name
149!
150! Open grid NetCDF file for reading.
151!
152 IF (grd(ng)%ncid.eq.-1) THEN
153 CALL netcdf_open (ng, model, ncname, 0, grd(ng)%ncid)
154 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
155 WRITE (stdout,10) trim(ncname)
156 RETURN
157 END IF
158 END IF
159!
160! Check grid file dimensions for consitency.
161!
162 CALL netcdf_check_dim (ng, model, ncname, &
163 & ncid = grd(ng)%ncid)
164 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
165!
166! Inquire about the variables.
167!
168 CALL netcdf_inq_var (ng, model, ncname, &
169 & ncid = grd(ng)%ncid)
170 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
171
172# ifdef NESTING
173!
174! Determine contact region index "cr" for which nested grid "ng" is
175! the receiver grid.
176!
177 DO i=1,ncontact
178 IF (rcontact(i)%receiver_grid.eq.ng) THEN
179 cr=i
180 EXIT
181 END IF
182 END DO
183# endif
184!
185!-----------------------------------------------------------------------
186! Check if required variables are available.
187!-----------------------------------------------------------------------
188!
189 IF (.not.find_string(var_name,n_var,'xl',vindex)) THEN
190 IF (master) WRITE (stdout,20) 'xl', trim(ncname)
191 exit_flag=2
192 RETURN
193 END IF
194 IF (.not.find_string(var_name,n_var,'el',vindex)) THEN
195 IF (master) WRITE (stdout,20) 'el', trim(ncname)
196 exit_flag=2
197 RETURN
198 END IF
199 IF (.not.find_string(var_name,n_var,'spherical',vindex)) THEN
200 IF (master) WRITE (stdout,20) 'spherical', trim(ncname)
201 exit_flag=2
202 RETURN
203 END IF
204 IF (.not.find_string(var_name,n_var,'h',vindex)) THEN
205 IF (master) WRITE (stdout,20) 'h', trim(ncname)
206 exit_flag=2
207 RETURN
208 END IF
209# ifdef ICESHELF
210 IF (.not.find_string(var_name,n_var,'zice',vindex)) THEN
211 IF (master) WRITE (stdout,20) 'zice', trim(ncname)
212 exit_flag=2
213 RETURN
214 END IF
215# endif
216 IF (.not.find_string(var_name,n_var,'f',vindex)) THEN
217 IF (master) WRITE (stdout,20) 'f', trim(ncname)
218 exit_flag=2
219 RETURN
220 END IF
221 IF (.not.find_string(var_name,n_var,'pm',vindex)) THEN
222 IF (master) WRITE (stdout,20) 'pm', trim(ncname)
223 exit_flag=2
224 RETURN
225 END IF
226 IF (.not.find_string(var_name,n_var,'pn',vindex)) THEN
227 IF (master) WRITE (stdout,20) 'pn', trim(ncname)
228 exit_flag=2
229 RETURN
230 END IF
231# if (defined CURVGRID && defined UV_ADV)
232 IF (.not.find_string(var_name,n_var,'dndx',vindex)) THEN
233 IF (master) WRITE (stdout,20) 'dndx', trim(ncname)
234 exit_flag=2
235 RETURN
236 END IF
237 IF (.not.find_string(var_name,n_var,'dmde',vindex)) THEN
238 IF (master) WRITE (stdout,20) 'dmde', trim(ncname)
239 exit_flag=2
240 RETURN
241 END IF
242# endif
243# ifdef CURVGRID
244 IF (.not.find_string(var_name,n_var,'angle',vindex)) THEN
245 IF (master) WRITE (stdout,20) 'angle', trim(ncname)
246 exit_flag=2
247 RETURN
248 END IF
249# endif
250# ifdef MASKING
251 IF (.not.find_string(var_name,n_var,'mask_rho',vindex)) THEN
252 IF (master) WRITE (stdout,20) 'mask_rho', trim(ncname)
253 exit_flag=2
254 RETURN
255 END IF
256 IF (.not.find_string(var_name,n_var,'mask_u',vindex)) THEN
257 IF (master) WRITE (stdout,20) 'mask_u', trim(ncname)
258 exit_flag=2
259 RETURN
260 END IF
261 IF (.not.find_string(var_name,n_var,'mask_v',vindex)) THEN
262 IF (master) WRITE (stdout,20) 'mask_v', trim(ncname)
263 exit_flag=2
264 RETURN
265 END IF
266 IF (.not.find_string(var_name,n_var,'mask_psi',vindex)) THEN
267 IF (master) WRITE (stdout,20) 'mask_psi', trim(ncname)
268 exit_flag=2
269 RETURN
270 END IF
271# endif
272# if defined WTYPE_GRID && \
273 (defined lmd_skpp || defined solar_source) && \
274 !defined ANA_WTYPE
275 IF (.not.find_string(var_name,n_var,'wtype_grid',vindex)) THEN
276 IF (master) WRITE (stdout,20) 'wtype_grid', trim(ncname)
277 exit_flag=2
278 RETURN
279 END IF
280# endif
281# ifndef ANA_SPONGE
282 IF (luvsponge(ng)) THEN
283 IF (.not.find_string(var_name,n_var,'visc_factor',vindex)) THEN
284 IF (master) WRITE (stdout,20) 'visc_factor', trim(ncname)
285 exit_flag=2
286 RETURN
287 END IF
288 END IF
289# ifdef SOLVE3D
290 IF (any(ltracersponge(:,ng))) THEN
291 IF (.not.find_string(var_name,n_var,'diff_factor',vindex)) THEN
292 IF (master) WRITE (stdout,20) 'diff_factor', trim(ncname)
293 exit_flag=2
294 RETURN
295 END IF
296 END IF
297# endif
298# endif
299# if defined UV_DRAG_GRID && !defined ANA_DRAG
300# if defined UV_LOGDRAG || defined BBL_MODEL
301 IF (.not.find_string(var_name,n_var,trim(vname(1,idzobl)), &
302 & varid_zobl)) THEN
303 IF (master) WRITE (stdout,20) trim(vname(1,idzobl)), &
304 & trim(ncname)
305 exit_flag=2
306 RETURN
307 END IF
308# endif
309# ifdef UV_LDRAG
310 IF (.not.find_string(var_name,n_var,trim(vname(1,idragl)), &
311 & varid_dragl)) THEN
312 IF (master) WRITE (stdout,20) trim(vname(1,idragl)), &
313 & trim(ncname)
314 exit_flag=2
315 RETURN
316 END IF
317# endif
318# ifdef UV_QDRAG
319 IF (.not.find_string(var_name,n_var,trim(vname(1,idragq)), &
320 & varid_dragq)) THEN
321 IF (master) WRITE (stdout,20) trim(vname(1,idragq)), &
322 & trim(ncname)
323 exit_flag=2
324 RETURN
325 END IF
326# endif
327# endif
328!
329! Read in logical switch for spherical grid configuration.
330!
331 spherical=.false.
332 IF (find_string(var_name,n_var,'spherical',vindex)) THEN
333 CALL netcdf_get_lvar (ng, model, ncname, 'spherical', &
334 & spherical, &
335 & ncid = grd(ng)%ncid)
336 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
337 END IF
338!
339!-----------------------------------------------------------------------
340! Read in grid variables.
341!-----------------------------------------------------------------------
342!
343! Set Vsize to zero to deativate interpolation of input data to model
344! grid in "nf_fread2d".
345!
346 DO i=1,4
347 vsize(i)=0
348 END DO
349!
350! Scan the variable list and read in needed variables.
351!
352 IF (master) WRITE (stdout,'(1x)')
353!
354 DO i=1,n_var
355
356 SELECT CASE (trim(adjustl(var_name(i))))
357!
358! Read in basin X-length.
359!
360 CASE ('xl')
361 CALL netcdf_get_fvar (ng, model, ncname, &
362 & 'xl', xl(ng), &
363 & ncid = grd(ng)%ncid)
364 IF (founderror(exit_flag, noerror, __line__, myfile)) EXIT
365!
366! Read in basin Y-length.
367!
368 CASE ('el')
369 CALL netcdf_get_fvar (ng, model, ncname, &
370 & 'el', el(ng), &
371 & ncid = grd(ng)%ncid)
372 IF (founderror(exit_flag, noerror, __line__, myfile)) EXIT
373!
374! Read in bathymetry.
375!
376 CASE ('h')
377 gtype=r2dvar
378 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
379 & var_name(i), var_id(i), &
380 & 0, gtype, vsize, &
381 & lbi, ubi, lbj, ubj, &
382 & fscl, fmin, fmax, &
383# ifdef MASKING
384 & grid(ng) % rmask, &
385# endif
386# ifdef CHECKSUM
387 & grid(ng) % h, &
388 & checksum = fhash)
389# else
390 & grid(ng) % h)
391# endif
392 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
393 exit_flag=2
394 ioerror=status
395 EXIT
396 ELSE
397# ifdef SINGLE_PRECISION
398 hmin(ng)=real(fmin,dp)
399 hmax(ng)=real(fmax,dp)
400# else
401 hmin(ng)=fmin
402 hmax(ng)=fmax
403# endif
404 IF (master) THEN
405 WRITE (stdout,30) 'bathymetry at RHO-points: h', &
406 & ng, trim(ncname), hmin(ng), hmax(ng)
407# ifdef CHECKSUM
408 WRITE (stdout,60) fhash
409# endif
410 END IF
411 END IF
412# ifdef NESTING
413 CALL fill_contact(ng, model, tile, &
414 & cr, rcontact(cr)%Npoints, rcontact, &
415 & r2dvar, var_name(i), spval_check, &
416 & lbi, ubi, lbj, ubj, &
417 & contact_metric(cr) % h, &
418 & grid(ng) % h)
419 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
420# endif
421 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
422 CALL exchange_r2d_tile (ng, tile, &
423 & lbi, ubi, lbj, ubj, &
424 & grid(ng) % h)
425 END IF
426# ifdef DISTRIBUTE
427 CALL mp_exchange2d (ng, tile, model, 1, &
428 & lbi, ubi, lbj, ubj, &
429 & nghostpoints, &
430 & ewperiodic(ng), nsperiodic(ng), &
431 & grid(ng) % h)
432# endif
433# ifdef MASKING
434!
435! Read in Land/Sea masking at RHO-points.
436!
437 CASE ('mask_rho')
438 gtype=r2dvar
439 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
440 & var_name(i), var_id(i), &
441 & 0, gtype, vsize, &
442 & lbi, ubi, lbj, ubj, &
443 & fscl, fmin, fmax, &
444 & grid(ng) % rmask, &
445# ifdef CHECKSUM
446 & grid(ng) % rmask, &
447 & checksum = fhash)
448# else
449 & grid(ng) % rmask)
450# endif
451 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
452 exit_flag=2
453 ioerror=status
454 EXIT
455 ELSE
456 IF (master) THEN
457 WRITE (stdout,30) 'mask on RHO-points: mask_rho', &
458 & ng, trim(ncname), fmin, fmax
459# ifdef CHECKSUM
460 WRITE (stdout,60) fhash
461# endif
462 END IF
463 END IF
464# ifdef NESTING
465# if !defined NOFILL_NESTING_MASK
466 CALL fill_contact(ng, model, tile, &
467 & cr, rcontact(cr)%Npoints, rcontact, &
468 & r2dvar, 'rmask', spval_check, &
469 & lbi, ubi, lbj, ubj, &
470 & contact_metric(cr) % rmask, &
471 & grid(ng) % rmask)
472 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
473# endif
474# endif
475 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
476 CALL exchange_r2d_tile (ng, tile, &
477 & lbi, ubi, lbj, ubj, &
478 & grid(ng) % rmask)
479 END IF
480# ifdef DISTRIBUTE
481 CALL mp_exchange2d (ng, tile, model, 1, &
482 & lbi, ubi, lbj, ubj, &
483 & nghostpoints, &
484 & ewperiodic(ng), nsperiodic(ng), &
485 & grid(ng) % rmask)
486# endif
487!
488! Read in Land/Sea masking at U-points.
489!
490 CASE ('mask_u')
491 gtype=u2dvar
492 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
493 & var_name(i), var_id(i), &
494 & 0, gtype, vsize, &
495 & lbi, ubi, lbj, ubj, &
496 & fscl, fmin, fmax, &
497 & grid(ng) % umask, &
498# ifdef CHECKSUM
499 & grid(ng) % umask, &
500 & checksum = fhash)
501# else
502 & grid(ng) % umask)
503# endif
504 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
505 exit_flag=2
506 ioerror=status
507 EXIT
508 ELSE
509 IF (master) THEN
510 WRITE (stdout,30) 'mask on U-points: mask_u', &
511 & ng, trim(ncname), fmin, fmax
512# ifdef CHECKSUM
513 WRITE (stdout,60) fhash
514# endif
515 END IF
516 END IF
517# ifdef NESTING
518# if !defined NOFILL_NESTING_MASK
519 CALL fill_contact(ng, model, tile, &
520 & cr, ucontact(cr)%Npoints, ucontact, &
521 & u2dvar, 'umask', spval_check, &
522 & lbi, ubi, lbj, ubj, &
523 & contact_metric(cr) % umask, &
524 & grid(ng) % umask)
525 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
526# endif
527# endif
528 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
529 CALL exchange_u2d_tile (ng, tile, &
530 & lbi, ubi, lbj, ubj, &
531 & grid(ng) % umask)
532 END IF
533# ifdef DISTRIBUTE
534 CALL mp_exchange2d (ng, tile, model, 1, &
535 & lbi, ubi, lbj, ubj, &
536 & nghostpoints, &
537 & ewperiodic(ng), nsperiodic(ng), &
538 & grid(ng) % umask)
539# endif
540!
541! Read in Land/Sea masking at V-points.
542!
543 CASE ('mask_v')
544 gtype=v2dvar
545 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
546 & var_name(i), var_id(i), &
547 & 0, gtype, vsize, &
548 & lbi, ubi, lbj, ubj, &
549 & fscl, fmin, fmax, &
550 & grid(ng) % vmask, &
551# ifdef CHECKSUM
552 & grid(ng) % vmask, &
553 & checksum = fhash)
554# else
555 & grid(ng) % vmask)
556# endif
557 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
558 exit_flag=2
559 ioerror=status
560 EXIT
561 ELSE
562 IF (master) THEN
563 WRITE (stdout,30) 'mask on V-points: mask_v', &
564 & ng, trim(ncname), fmin, fmax
565# ifdef CHECKSUM
566 WRITE (stdout,60) fhash
567# endif
568 END IF
569 END IF
570# ifdef NESTING
571# if !defined NOFILL_NESTING_MASK
572 CALL fill_contact(ng, model, tile, &
573 & cr, vcontact(cr)%Npoints, vcontact, &
574 & v2dvar, 'vmask', spval_check, &
575 & lbi, ubi, lbj, ubj, &
576 & contact_metric(cr) % vmask, &
577 & grid(ng) % vmask)
578 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
579# endif
580# endif
581 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
582 CALL exchange_v2d_tile (ng, tile, &
583 & lbi, ubi, lbj, ubj, &
584 & grid(ng) % vmask)
585 END IF
586# ifdef DISTRIBUTE
587 CALL mp_exchange2d (ng, tile, model, 1, &
588 & lbi, ubi, lbj, ubj, &
589 & nghostpoints, &
590 & ewperiodic(ng), nsperiodic(ng), &
591 & grid(ng) % vmask)
592# endif
593!
594! Read in Land/Sea masking at PSI-points.
595!
596 CASE ('mask_psi')
597 gtype=p2dvar
598 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
599 & var_name(i), var_id(i), &
600 & 0, gtype, vsize, &
601 & lbi, ubi, lbj, ubj, &
602 & fscl, fmin, fmax, &
603 & grid(ng) % pmask, &
604# ifdef CHECKSUM
605 & grid(ng) % pmask, &
606 & checksum = fhash)
607# else
608 & grid(ng) % pmask)
609# endif
610 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
611 exit_flag=2
612 ioerror=status
613 EXIT
614 ELSE
615 IF (master) THEN
616 WRITE (stdout,30) 'mask on PSI-points: mask_psi', &
617 & ng, trim(ncname), fmin, fmax
618# ifdef CHECKSUM
619 WRITE (stdout,60) fhash
620# endif
621 END IF
622 END IF
623 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
624 CALL exchange_p2d_tile (ng, tile, &
625 & lbi, ubi, lbj, ubj, &
626 & grid(ng) % pmask)
627 END IF
628# ifdef DISTRIBUTE
629 CALL mp_exchange2d (ng, tile, model, 1, &
630 & lbi, ubi, lbj, ubj, &
631 & nghostpoints, &
632 & ewperiodic(ng), nsperiodic(ng), &
633 & grid(ng) % pmask)
634# endif
635# endif
636# ifdef ICESHELF
637!
638! Read in ice shelf thickness.
639!
640 CASE ('zice')
641 gtype=r2dvar
642 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
643 & var_name(i), var_id(i), &
644 & 0, gtype, vsize, &
645 & lbi, ubi, lbj, ubj, &
646 & fscl, fmin, fmax, &
647# ifdef MASKING
648 & grid(ng) % rmask, &
649# endif
650# ifdef CHECKSUM
651 & grid(ng) % zice, &
652 & checksum = fhash)
653# else
654 & grid(ng) % zice)
655# endif
656 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
657 exit_flag=2
658 ioerror=status
659 EXIT
660 ELSE
661 IF (master) THEN
662 WRITE (stdout,30) 'ice shelf thickness: zice', &
663 & ng, trim(ncname), fmin, fmax
664# ifdef CHECKSUM
665 WRITE (stdout,60) fhash
666# endif
667 END IF
668 END IF
669 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
670 CALL exchange_r2d_tile (ng, tile, &
671 & lbi, ubi, lbj, ubj, &
672 & grid(ng) % zice)
673 END IF
674# ifdef DISTRIBUTE
675 CALL mp_exchange2d (ng, tile, model, 1, &
676 & lbi, ubi, lbj, ubj, &
677 & nghostpoints, &
678 & ewperiodic(ng), nsperiodic(ng), &
679 & grid(ng) % zice)
680# endif
681# endif
682# if defined WTYPE_GRID && \
683 (defined lmd_skpp || defined solar_source) && \
684 !defined ANA_WTYPE
685!
686! Read in Jerlov water type.
687!
688 CASE ('wtype_grid')
689 gtype=r2dvar
690 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
691 & var_name(i), var_id(i), &
692 & 0, gtype, vsize, &
693 & lbi, ubi, lbj, ubj, &
694 & fscl, fmin, fmax, &
695# ifdef MASKING
696 & grid(ng) % rmask, &
697# endif
698# ifdef CHECKSUM
699 & mixing(ng) % Jwtype, &
700 & checksum = fhash)
701# else
702 & mixing(ng) % Jwtype)
703# endif
704 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
705 exit_flag=2
706 ioerror=status
707 EXIT
708 ELSE
709 IF (master) THEN
710 WRITE (stdout,30) 'Jerlov water type: wtype_grid', &
711 & ng, trim(ncname), fmin, fmax
712# ifdef CHECKSUM
713 WRITE (stdout,60) fhash
714# endif
715 END IF
716 END IF
717 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
718 CALL exchange_r2d_tile (ng, tile, &
719 & lbi, ubi, lbj, ubj, &
720 & mixing(ng) % Jwtype)
721 END IF
722# ifdef DISTRIBUTE
723 CALL mp_exchange2d (ng, tile, model, 1, &
724 & lbi, ubi, lbj, ubj, &
725 & nghostpoints, &
726 & ewperiodic(ng), nsperiodic(ng), &
727 & mixing(ng) % Jwtype)
728# endif
729# endif
730# ifndef ANA_SPONGE
731!
732! Read in horizontal, spatially varying factor to increase/decrease
733! viscosity (nondimensional) in specific areas of the domain.
734!
735 CASE ('visc_factor')
736 IF (luvsponge(ng)) THEN
737 gtype=r2dvar
738 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
739 & var_name(i), var_id(i), &
740 & 0, gtype, vsize, &
741 & lbi, ubi, lbj, ubj, &
742 & fscl, fmin, fmax, &
743# ifdef MASKING
744 & grid(ng) % rmask, &
745# endif
746# ifdef CHECKSUM
747 & mixing(ng) % visc_factor, &
748 & checksum = fhash)
749# else
750 & mixing(ng) % visc_factor)
751# endif
752 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
753 exit_flag=2
754 ioerror=status
755 EXIT
756 ELSE
757 IF (master) THEN
758 WRITE (stdout,30) 'horizontal viscosity sponge '// &
759 & 'factor: visc_factor', &
760 & ng, trim(ncname), fmin, fmax
761# ifdef CHECKSUM
762 WRITE (stdout,60) fhash
763# endif
764 END IF
765 END IF
766 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
767 CALL exchange_r2d_tile (ng, tile, &
768 & lbi, ubi, lbj, ubj, &
769 & mixing(ng) % visc_factor)
770 END IF
771# ifdef DISTRIBUTE
772 CALL mp_exchange2d (ng, tile, model, 1, &
773 & lbi, ubi, lbj, ubj, &
774 & nghostpoints, &
775 & ewperiodic(ng), nsperiodic(ng), &
776 & mixing(ng) % visc_factor)
777# endif
778 END IF
779
780# ifdef SOLVE3D
781!
782! Read in horizontal, spatially varying factor to increase/decrease
783! diffusivity (nondimensional) in specific areas of the domain.
784!
785 CASE ('diff_factor')
786 IF (any(ltracersponge(:,ng))) THEN
787 gtype=r2dvar
788 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
789 & var_name(i), var_id(i), &
790 & 0, gtype, vsize, &
791 & lbi, ubi, lbj, ubj, &
792 & fscl, fmin, fmax, &
793# ifdef MASKING
794 & grid(ng) % rmask, &
795# endif
796# ifdef CHECKSUM
797 & mixing(ng) % diff_factor, &
798 & checksum = fhash)
799# else
800 & mixing(ng) % diff_factor)
801# endif
802 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
803 exit_flag=2
804 ioerror=status
805 EXIT
806 ELSE
807 IF (master) THEN
808 WRITE (stdout,30) 'horizontal diffusivity sponge '// &
809 & 'factor: diff_factor', &
810 & ng, trim(ncname), fmin, fmax
811# ifdef CHECKSUM
812 WRITE (stdout,60) fhash
813# endif
814 END IF
815 END IF
816 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
817 CALL exchange_r2d_tile (ng, tile, &
818 & lbi, ubi, lbj, ubj, &
819 & mixing(ng) % diff_factor)
820 END IF
821# ifdef DISTRIBUTE
822 CALL mp_exchange2d (ng, tile, model, 1, &
823 & lbi, ubi, lbj, ubj, &
824 & nghostpoints, &
825 & ewperiodic(ng), nsperiodic(ng), &
826 & mixing(ng) % diff_factor)
827# endif
828 END IF
829# endif
830# endif
831!
832! Read in Coriolis parameter.
833!
834 CASE ('f')
835 gtype=r2dvar
836 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
837 & var_name(i), var_id(i), &
838 & 0, gtype, vsize, &
839 & lbi, ubi, lbj, ubj, &
840 & fscl, fmin, fmax, &
841# ifdef MASKING
842 & grid(ng) % rmask, &
843# endif
844# ifdef CHECKSUM
845 & grid(ng) % f, &
846 & checksum = fhash)
847# else
848 & grid(ng) % f)
849# endif
850 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
851 exit_flag=2
852 ioerror=status
853 EXIT
854 ELSE
855 IF (master) THEN
856 WRITE (stdout,30) 'Coriolis parameter at RHO-points: f',&
857 & ng, trim(ncname), fmin, fmax
858# ifdef CHECKSUM
859 WRITE (stdout,60) fhash
860# endif
861 END IF
862 END IF
863# ifdef NESTING
864 CALL fill_contact(ng, model, tile, &
865 & cr, rcontact(cr)%Npoints, rcontact, &
866 & r2dvar, var_name(i), spval_check, &
867 & lbi, ubi, lbj, ubj, &
868 & contact_metric(cr) % f, &
869 & grid(ng) % f)
870 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
871# endif
872 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
873 CALL exchange_r2d_tile (ng, tile, &
874 & lbi, ubi, lbj, ubj, &
875 & grid(ng) % f)
876 END IF
877# ifdef DISTRIBUTE
878 CALL mp_exchange2d (ng, tile, model, 1, &
879 & lbi, ubi, lbj, ubj, &
880 & nghostpoints, &
881 & ewperiodic(ng), nsperiodic(ng), &
882 & grid(ng) % f)
883# endif
884!
885! Read in coordinate transfomation metrics (m) associated with the
886! differential distances in XI.
887!
888 CASE ('pm')
889 gtype=r2dvar
890 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
891 & var_name(i), var_id(i), &
892 & 0, gtype, vsize, &
893 & lbi, ubi, lbj, ubj, &
894 & fscl, fmin, fmax, &
895# ifdef MASKING
896 & grid(ng) % rmask, &
897# endif
898# ifdef CHECKSUM
899 & grid(ng) % pm, &
900 & checksum = fhash)
901# else
902 & grid(ng) % pm)
903# endif
904 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
905 exit_flag=2
906 ioerror=status
907 EXIT
908 ELSE
909 IF (master) THEN
910 WRITE (stdout,30) 'reciprocal XI-grid spacing: pm', &
911 & ng, trim(ncname), fmin, fmax
912# ifdef CHECKSUM
913 WRITE (stdout,60) fhash
914# endif
915 END IF
916 END IF
917# ifdef NESTING
918 CALL fill_contact(ng, model, tile, &
919 & cr, rcontact(cr)%Npoints, rcontact, &
920 & r2dvar, var_name(i), spval_check, &
921 & lbi, ubi, lbj, ubj, &
922 & contact_metric(cr) % pm, &
923 & grid(ng) % pm)
924 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
925# endif
926 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
927 CALL exchange_r2d_tile (ng, tile, &
928 & lbi, ubi, lbj, ubj, &
929 & grid(ng) % pm)
930 END IF
931# ifdef DISTRIBUTE
932 CALL mp_exchange2d (ng, tile, model, 1, &
933 & lbi, ubi, lbj, ubj, &
934 & nghostpoints, &
935 & ewperiodic(ng), nsperiodic(ng), &
936 & grid(ng) % pm)
937# endif
938!
939! Read in coordinate transfomation metrics (n) associated with the
940! differential distances in ETA.
941!
942 CASE ('pn')
943 gtype=r2dvar
944 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
945 & var_name(i), var_id(i), &
946 & 0, gtype, vsize, &
947 & lbi, ubi, lbj, ubj, &
948 & fscl, fmin, fmax, &
949# ifdef MASKING
950 & grid(ng) % rmask, &
951# endif
952# ifdef CHECKSUM
953 & grid(ng) % pn, &
954 & checksum = fhash)
955# else
956 & grid(ng) % pn)
957# endif
958 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
959 exit_flag=2
960 ioerror=status
961 EXIT
962 ELSE
963 IF (master) THEN
964 WRITE (stdout,30) 'reciprocal ETA-grid spacing: pn', &
965 & ng, trim(ncname), fmin, fmax
966# ifdef CHECKSUM
967 WRITE (stdout,60) fhash
968# endif
969 END IF
970 END IF
971# ifdef NESTING
972 CALL fill_contact(ng, model, tile, &
973 & cr, rcontact(cr)%Npoints, rcontact, &
974 & r2dvar, var_name(i), spval_check, &
975 & lbi, ubi, lbj, ubj, &
976 & contact_metric(cr) % pn, &
977 & grid(ng) % pn)
978 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
979# endif
980 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
981 CALL exchange_r2d_tile (ng, tile, &
982 & lbi, ubi, lbj, ubj, &
983 & grid(ng) % pn)
984 END IF
985# ifdef DISTRIBUTE
986 CALL mp_exchange2d (ng, tile, model, 1, &
987 & lbi, ubi, lbj, ubj, &
988 & nghostpoints, &
989 & ewperiodic(ng), nsperiodic(ng), &
990 & grid(ng) % pn)
991# endif
992# if (defined CURVGRID && defined UV_ADV)
993!
994! Read in derivatives of inverse metrics factors: d(m)/d(eta).
995!
996 CASE ('dmde')
997 gtype=r2dvar
998 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
999 & var_name(i), var_id(i), &
1000 & 0, gtype, vsize, &
1001 & lbi, ubi, lbj, ubj, &
1002 & fscl, fmin, fmax, &
1003# ifdef MASKING
1004 & grid(ng) % rmask, &
1005# endif
1006# ifdef CHECKSUM
1007 & grid(ng) % dmde, &
1008 & checksum = fhash)
1009# else
1010 & grid(ng) % dmde)
1011# endif
1012 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1013 exit_flag=2
1014 ioerror=status
1015 EXIT
1016 ELSE
1017 IF (master) THEN
1018 WRITE (stdout,30) 'ETA-derivative of inverse metric '// &
1019 & 'factor pm: dmde', &
1020 & ng, trim(ncname), fmin, fmax
1021# ifdef CHECKSUM
1022 WRITE (stdout,60) fhash
1023# endif
1024 END IF
1025 END IF
1026# ifdef NESTING
1027 CALL fill_contact(ng, model, tile, &
1028 & cr, rcontact(cr)%Npoints, rcontact, &
1029 & r2dvar, var_name(i), spval_check, &
1030 & lbi, ubi, lbj, ubj, &
1031 & contact_metric(cr) % dmde, &
1032 & grid(ng) % dmde)
1033 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1034# endif
1035 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1036 CALL exchange_r2d_tile (ng, tile, &
1037 & lbi, ubi, lbj, ubj, &
1038 & grid(ng) % dmde)
1039 END IF
1040# ifdef DISTRIBUTE
1041 CALL mp_exchange2d (ng, tile, model, 1, &
1042 & lbi, ubi, lbj, ubj, &
1043 & nghostpoints, &
1044 & ewperiodic(ng), nsperiodic(ng), &
1045 & grid(ng) % dmde)
1046# endif
1047!
1048! Read in derivatives of inverse metrics factors: d(n)/d(xi).
1049!
1050 CASE ('dndx')
1051 gtype=r2dvar
1052 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1053 & var_name(i), var_id(i), &
1054 & 0, gtype, vsize, &
1055 & lbi, ubi, lbj, ubj, &
1056 & fscl, fmin, fmax, &
1057# ifdef MASKING
1058 & grid(ng) % rmask, &
1059# endif
1060# ifdef CHECKSUM
1061 & grid(ng) % dndx, &
1062 & checksum = fhash)
1063# else
1064 & grid(ng) % dndx)
1065# endif
1066 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1067 exit_flag=2
1068 ioerror=status
1069 EXIT
1070 ELSE
1071 IF (master) THEN
1072 WRITE (stdout,30) 'XI-derivative of inverse metric '// &
1073 & 'factor pn: dndx', &
1074 & ng, trim(ncname), fmin, fmax
1075# ifdef CHECKSUM
1076 WRITE (stdout,60) fhash
1077# endif
1078 END IF
1079 END IF
1080# ifdef NESTING
1081 CALL fill_contact(ng, model, tile, &
1082 & cr, rcontact(cr)%Npoints, rcontact, &
1083 & r2dvar, var_name(i), spval_check, &
1084 & lbi, ubi, lbj, ubj, &
1085 & contact_metric(cr) % dndx, &
1086 & grid(ng) % dndx)
1087 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1088# endif
1089 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1090 CALL exchange_r2d_tile (ng, tile, &
1091 & lbi, ubi, lbj, ubj, &
1092 & grid(ng) % dndx)
1093 END IF
1094# ifdef DISTRIBUTE
1095 CALL mp_exchange2d (ng, tile, model, 1, &
1096 & lbi, ubi, lbj, ubj, &
1097 & nghostpoints, &
1098 & ewperiodic(ng), nsperiodic(ng), &
1099 & grid(ng) % dndx)
1100# endif
1101# endif
1102!
1103! Read in X-coordinates at PSI-points.
1104!
1105 CASE ('x_psi')
1106 gtype=p2dvar
1107 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1108 & var_name(i), var_id(i), &
1109 & 0, gtype, vsize, &
1110 & lbi, ubi, lbj, ubj, &
1111 & fscl, fmin, fmax, &
1112# ifdef MASKING
1113 & grid(ng) % pmask, &
1114# endif
1115# ifdef CHECKSUM
1116 & grid(ng) % xp, &
1117 & checksum = fhash)
1118# else
1119 & grid(ng) % xp)
1120# endif
1121 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1122 exit_flag=2
1123 ioerror=status
1124 EXIT
1125 ELSE
1126 IF (master) THEN
1127 WRITE (stdout,30) 'x-location of PSI-points: x_psi', &
1128 & ng, trim(ncname), fmin, fmax
1129# ifdef CHECKSUM
1130 WRITE (stdout,60) fhash
1131# endif
1132 END IF
1133 END IF
1134# ifdef DISTRIBUTE
1135 CALL mp_exchange2d (ng, tile, model, 1, &
1136 & lbi, ubi, lbj, ubj, &
1137 & nghostpoints, &
1138 & .false., .false., &
1139 & grid(ng) % xp)
1140# endif
1141!
1142! Read in Y-coordinates at PSI-points.
1143!
1144 CASE ('y_psi')
1145 gtype=p2dvar
1146 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1147 & var_name(i), var_id(i), &
1148 & 0, gtype, vsize, &
1149 & lbi, ubi, lbj, ubj, &
1150 & fscl, fmin, fmax, &
1151# ifdef MASKING
1152 & grid(ng) % pmask, &
1153# endif
1154# ifdef CHECKSUM
1155 & grid(ng) % yp, &
1156 & checksum = fhash)
1157# else
1158 & grid(ng) % yp)
1159# endif
1160 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1161 exit_flag=2
1162 ioerror=status
1163 EXIT
1164 ELSE
1165 IF (master) THEN
1166 WRITE (stdout,30) 'y-location of PSI-points: y-psi', &
1167 & ng, trim(ncname), fmin, fmax
1168# ifdef CHECKSUM
1169 WRITE (stdout,60) fhash
1170# endif
1171 END IF
1172 END IF
1173# ifdef DISTRIBUTE
1174 CALL mp_exchange2d (ng, tile, model, 1, &
1175 & lbi, ubi, lbj, ubj, &
1176 & nghostpoints, &
1177 & .false., .false., &
1178 & grid(ng) % yp)
1179# endif
1180!
1181! Read in X-coordinates at RHO-points.
1182!
1183 CASE ('x_rho')
1184 gtype=r2dvar
1185 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1186 & var_name(i), var_id(i), &
1187 & 0, gtype, vsize, &
1188 & lbi, ubi, lbj, ubj, &
1189 & fscl, fmin, fmax, &
1190# ifdef MASKING
1191 & grid(ng) % rmask, &
1192# endif
1193# ifdef CHECKSUM
1194 & grid(ng) % xr, &
1195 & checksum = fhash)
1196# else
1197 & grid(ng) % xr)
1198# endif
1199 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1200 exit_flag=2
1201 ioerror=status
1202 EXIT
1203 ELSE
1204 IF (master) THEN
1205 WRITE (stdout,30) 'x-location of RHO-points: x-rho', &
1206 & ng, trim(ncname), fmin, fmax
1207# ifdef CHECKSUM
1208 WRITE (stdout,60) fhash
1209# endif
1210 END IF
1211 END IF
1212 IF (.not.spherical) THEN
1213 lonmin(ng)=fmin
1214 lonmax(ng)=fmax
1215 END IF
1216# ifdef NESTING
1217 IF (.not.spherical) THEN
1218 CALL fill_contact(ng, model, tile, &
1219 & cr, rcontact(cr)%Npoints, rcontact, &
1220 & r2dvar, var_name(i), spval_check, &
1221 & lbi, ubi, lbj, ubj, &
1222 & contact_metric(cr) % Xr, &
1223 & grid(ng) % xr)
1224 IF (founderror(exit_flag, noerror, &
1225 & __line__, myfile)) RETURN
1226 END IF
1227# endif
1228# ifdef DISTRIBUTE
1229 CALL mp_exchange2d (ng, tile, model, 1, &
1230 & lbi, ubi, lbj, ubj, &
1231 & nghostpoints, &
1232 & .false., .false., &
1233 & grid(ng) % xr)
1234# endif
1235!
1236! Read in Y-coordinates at RHO-points.
1237!
1238 CASE ('y_rho')
1239 gtype=r2dvar
1240 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1241 & var_name(i), var_id(i), &
1242 & 0, gtype, vsize, &
1243 & lbi, ubi, lbj, ubj, &
1244 & fscl, fmin, fmax, &
1245# ifdef MASKING
1246 & grid(ng) % rmask, &
1247# endif
1248# ifdef CHECKSUM
1249 & grid(ng) % yr, &
1250 & checksum = fhash)
1251# else
1252 & grid(ng) % yr)
1253# endif
1254 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1255 exit_flag=2
1256 ioerror=status
1257 EXIT
1258 ELSE
1259 IF (master) THEN
1260 WRITE (stdout,30) 'y-location of RHO-points: y_rho', &
1261 & ng, trim(ncname), fmin, fmax
1262# ifdef CHECKSUM
1263 WRITE (stdout,60) fhash
1264# endif
1265 END IF
1266 END IF
1267 IF (.not.spherical) THEN
1268 latmin(ng)=fmin
1269 latmax(ng)=fmax
1270 END IF
1271# ifdef NESTING
1272 IF (.not.spherical) THEN
1273 CALL fill_contact(ng, model, tile, &
1274 & cr, rcontact(cr)%Npoints, rcontact, &
1275 & r2dvar, var_name(i), spval_check, &
1276 & lbi, ubi, lbj, ubj, &
1277 & contact_metric(cr) % Yr, &
1278 & grid(ng) % yr)
1279 IF (founderror(exit_flag, noerror, &
1280 & __line__, myfile)) RETURN
1281 END IF
1282# endif
1283# ifdef DISTRIBUTE
1284 CALL mp_exchange2d (ng, tile, model, 1, &
1285 & lbi, ubi, lbj, ubj, &
1286 & nghostpoints, &
1287 & .false., .false., &
1288 & grid(ng) % yr)
1289# endif
1290!
1291! Read in X-coordinates at U-points.
1292!
1293 CASE ('x_u')
1294 gtype=u2dvar
1295 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1296 & var_name(i), var_id(i), &
1297 & 0, gtype, vsize, &
1298 & lbi, ubi, lbj, ubj, &
1299 & fscl, fmin, fmax, &
1300# ifdef MASKING
1301 & grid(ng) % umask, &
1302# endif
1303# ifdef CHECKSUM
1304 & grid(ng) % xu, &
1305 & checksum = fhash)
1306# else
1307 & grid(ng) % xu)
1308# endif
1309 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1310 exit_flag=2
1311 ioerror=status
1312 EXIT
1313 ELSE
1314 IF (master) THEN
1315 WRITE (stdout,30) 'x-location of U-points: x_u', &
1316 & ng, trim(ncname), fmin, fmax
1317# ifdef CHECKSUM
1318 WRITE (stdout,60) fhash
1319# endif
1320 END IF
1321 END IF
1322# ifdef NESTING
1323 IF (.not.spherical) THEN
1324 CALL fill_contact(ng, model, tile, &
1325 & cr, ucontact(cr)%Npoints, ucontact, &
1326 & u2dvar, var_name(i), spval_check, &
1327 & lbi, ubi, lbj, ubj, &
1328 & contact_metric(cr) % Xu, &
1329 & grid(ng) % xu)
1330 IF (founderror(exit_flag, noerror, &
1331 & __line__, myfile)) RETURN
1332 END IF
1333# endif
1334# ifdef DISTRIBUTE
1335 CALL mp_exchange2d (ng, tile, model, 1, &
1336 & lbi, ubi, lbj, ubj, &
1337 & nghostpoints, &
1338 & .false., .false., &
1339 & grid(ng) % xu)
1340# endif
1341!
1342! Read in Y-coordinates at U-points.
1343!
1344 CASE ('y_u')
1345 gtype=u2dvar
1346 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1347 & var_name(i), var_id(i), &
1348 & 0, gtype, vsize, &
1349 & lbi, ubi, lbj, ubj, &
1350 & fscl, fmin, fmax, &
1351# ifdef MASKING
1352 & grid(ng) % umask, &
1353# endif
1354# ifdef CHECKSUM
1355 & grid(ng) % yu, &
1356 & checksum = fhash)
1357# else
1358 & grid(ng) % yu)
1359# endif
1360 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1361 exit_flag=2
1362 ioerror=status
1363 EXIT
1364 ELSE
1365 IF (master) THEN
1366 WRITE (stdout,30) 'y-location of U-points: y_u', &
1367 & ng, trim(ncname), fmin, fmax
1368# ifdef CHECKSUM
1369 WRITE (stdout,60) fhash
1370# endif
1371 END IF
1372 END IF
1373# ifdef NESTING
1374 IF (.not.spherical) THEN
1375 CALL fill_contact(ng, model, tile, &
1376 & cr, ucontact(cr)%Npoints, ucontact, &
1377 & u2dvar, var_name(i), spval_check, &
1378 & lbi, ubi, lbj, ubj, &
1379 & contact_metric(cr) % Yu, &
1380 & grid(ng) % yu)
1381 IF (founderror(exit_flag, noerror, &
1382 & __line__, myfile)) RETURN
1383 END IF
1384# endif
1385# ifdef DISTRIBUTE
1386 CALL mp_exchange2d (ng, tile, model, 1, &
1387 & lbi, ubi, lbj, ubj, &
1388 & nghostpoints, &
1389 & .false., .false., &
1390 & grid(ng) % yu)
1391# endif
1392!
1393! Read in X-coordinates at V-points.
1394!
1395 CASE ('x_v')
1396 gtype=v2dvar
1397 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1398 & var_name(i), var_id(i), &
1399 & 0, gtype, vsize, &
1400 & lbi, ubi, lbj, ubj, &
1401 & fscl, fmin, fmax, &
1402# ifdef MASKING
1403 & grid(ng) % vmask, &
1404# endif
1405# ifdef CHECKSUM
1406 & grid(ng) % xv, &
1407 & checksum = fhash)
1408# else
1409 & grid(ng) % xv)
1410# endif
1411 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1412 exit_flag=2
1413 ioerror=status
1414 EXIT
1415 ELSE
1416 IF (master) THEN
1417 WRITE (stdout,30) 'x-location of V-points: x_v', &
1418 & ng, trim(ncname), fmin, fmax
1419# ifdef CHECKSUM
1420 WRITE (stdout,60) fhash
1421# endif
1422 END IF
1423 END IF
1424# ifdef NESTING
1425 IF (.not.spherical) THEN
1426 CALL fill_contact(ng, model, tile, &
1427 & cr, vcontact(cr)%Npoints, vcontact, &
1428 & v2dvar, var_name(i), spval_check, &
1429 & lbi, ubi, lbj, ubj, &
1430 & contact_metric(cr) % Xv, &
1431 & grid(ng) % xv)
1432 IF (founderror(exit_flag, noerror, &
1433 & __line__, myfile)) RETURN
1434 END IF
1435# endif
1436# ifdef DISTRIBUTE
1437 CALL mp_exchange2d (ng, tile, model, 1, &
1438 & lbi, ubi, lbj, ubj, &
1439 & nghostpoints, &
1440 & .false., .false., &
1441 & grid(ng) % xv)
1442# endif
1443!
1444! Read in Y-coordinates at V-points.
1445!
1446 CASE ('y_v')
1447 gtype=v2dvar
1448 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1449 & var_name(i), var_id(i), &
1450 & 0, gtype, vsize, &
1451 & lbi, ubi, lbj, ubj, &
1452 & fscl, fmin, fmax, &
1453# ifdef MASKING
1454 & grid(ng) % vmask, &
1455# endif
1456# ifdef CHECKSUM
1457 & grid(ng) % yv, &
1458 & checksum = fhash)
1459# else
1460 & grid(ng) % yv)
1461# endif
1462 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1463 exit_flag=2
1464 ioerror=status
1465 EXIT
1466 ELSE
1467 IF (master) THEN
1468 WRITE (stdout,30) 'y-location of V-points: y_v', &
1469 & ng, trim(ncname), fmin, fmax
1470# ifdef CHECKSUM
1471 WRITE (stdout,60) fhash
1472# endif
1473 END IF
1474 END IF
1475# ifdef NESTING
1476 IF (.not.spherical) THEN
1477 CALL fill_contact(ng, model, tile, &
1478 & cr, vcontact(cr)%Npoints, vcontact, &
1479 & v2dvar, var_name(i), spval_check, &
1480 & lbi, ubi, lbj, ubj, &
1481 & contact_metric(cr) % Yv, &
1482 & grid(ng) % yv)
1483 IF (founderror(exit_flag, noerror, &
1484 & __line__, myfile)) RETURN
1485 END IF
1486# endif
1487# ifdef DISTRIBUTE
1488 CALL mp_exchange2d (ng, tile, model, 1, &
1489 & lbi, ubi, lbj, ubj, &
1490 & nghostpoints, &
1491 & .false., .false., &
1492 & grid(ng) % yv)
1493# endif
1494!
1495! Read in longitude at PSI-points.
1496!
1497 CASE ('lon_psi')
1498 IF (spherical) THEN
1499 gtype=p2dvar
1500 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1501 & var_name(i), var_id(i), &
1502 & 0, gtype, vsize, &
1503 & lbi, ubi, lbj, ubj, &
1504 & fscl, fmin, fmax, &
1505# ifdef MASKING
1506 & grid(ng) % pmask, &
1507# endif
1508# ifdef CHECKSUM
1509 & grid(ng) % lonp, &
1510 & checksum = fhash)
1511# else
1512 & grid(ng) % lonp)
1513# endif
1514 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1515 exit_flag=2
1516 ioerror=status
1517 EXIT
1518 ELSE
1519 IF (master) THEN
1520 WRITE (stdout,30) 'longitude of PSI-points: lon_psi', &
1521 & ng, trim(ncname), fmin, fmax
1522# ifdef CHECKSUM
1523 WRITE (stdout,60) fhash
1524# endif
1525 END IF
1526 END IF
1527# ifdef DISTRIBUTE
1528 CALL mp_exchange2d (ng, tile, model, 1, &
1529 & lbi, ubi, lbj, ubj, &
1530 & nghostpoints, &
1531 & .false., .false., &
1532 & grid(ng) % lonp)
1533# endif
1534 END IF
1535!
1536! Read in latitude at PSI-points.
1537!
1538 CASE ('lat_psi')
1539 IF (spherical) THEN
1540 gtype=p2dvar
1541 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1542 & var_name(i), var_id(i), &
1543 & 0, gtype, vsize, &
1544 & lbi, ubi, lbj, ubj, &
1545 & fscl, fmin, fmax, &
1546# ifdef MASKING
1547 & grid(ng) % pmask, &
1548# endif
1549# ifdef CHECKSUM
1550 & grid(ng) % latp, &
1551 & checksum = fhash)
1552# else
1553 & grid(ng) % latp)
1554# endif
1555 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1556 exit_flag=2
1557 ioerror=status
1558 EXIT
1559 ELSE
1560 IF (master) THEN
1561 WRITE (stdout,30) 'latitude of PSI-points lat_psi', &
1562 & ng, trim(ncname), fmin, fmax
1563# ifdef CHECKSUM
1564 WRITE (stdout,60) fhash
1565# endif
1566 END IF
1567 END IF
1568# ifdef DISTRIBUTE
1569 CALL mp_exchange2d (ng, tile, model, 1, &
1570 & lbi, ubi, lbj, ubj, &
1571 & nghostpoints, &
1572 & .false., .false., &
1573 & grid(ng) % latp)
1574# endif
1575 END IF
1576!
1577! Read in longitude at RHO-points.
1578!
1579 CASE ('lon_rho')
1580 IF (spherical) THEN
1581 gtype=r2dvar
1582 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1583 & var_name(i), var_id(i), &
1584 & 0, gtype, vsize, &
1585 & lbi, ubi, lbj, ubj, &
1586 & fscl, lonmin(ng), lonmax(ng), &
1587# ifdef MASKING
1588 & grid(ng) % rmask, &
1589# endif
1590# ifdef CHECKSUM
1591 & grid(ng) % lonr, &
1592 & checksum = fhash)
1593# else
1594 & grid(ng) % lonr)
1595# endif
1596 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1597 exit_flag=2
1598 ioerror=status
1599 EXIT
1600 ELSE
1601 IF (master) THEN
1602 WRITE (stdout,30) 'longitude of RHO-points: lon_rho', &
1603 & ng, trim(ncname), &
1604 & lonmin(ng), lonmax(ng)
1605# ifdef CHECKSUM
1606 WRITE (stdout,60) fhash
1607# endif
1608 END IF
1609 END IF
1610# ifdef NESTING
1611 CALL fill_contact(ng, model, tile, &
1612 & cr, rcontact(cr)%Npoints, rcontact, &
1613 & r2dvar, var_name(i), spval_check, &
1614 & lbi, ubi, lbj, ubj, &
1615 & contact_metric(cr) % Xr, &
1616 & grid(ng) % lonr)
1617 IF (founderror(exit_flag, noerror, &
1618 & __line__, myfile)) RETURN
1619# endif
1620# ifdef DISTRIBUTE
1621 CALL mp_exchange2d (ng, tile, model, 1, &
1622 & lbi, ubi, lbj, ubj, &
1623 & nghostpoints, &
1624 & .false., .false., &
1625 & grid(ng) % lonr)
1626# endif
1627 END IF
1628!
1629! Read in latitude at RHO-points.
1630!
1631 CASE ('lat_rho')
1632 IF (spherical) THEN
1633 gtype=r2dvar
1634 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1635 & var_name(i), var_id(i), &
1636 & 0, gtype, vsize, &
1637 & lbi, ubi, lbj, ubj, &
1638 & fscl, latmin(ng), latmax(ng), &
1639# ifdef MASKING
1640 & grid(ng) % rmask, &
1641# endif
1642# ifdef CHECKSUM
1643 & grid(ng) % latr, &
1644 & checksum = fhash)
1645# else
1646 & grid(ng) % latr)
1647# endif
1648 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1649 exit_flag=2
1650 ioerror=status
1651 EXIT
1652 ELSE
1653 IF (master) THEN
1654 WRITE (stdout,30) 'latitude of RHO-points lat_rho', &
1655 & ng, trim(ncname), &
1656 & latmin(ng), latmax(ng)
1657# ifdef CHECKSUM
1658 WRITE (stdout,60) fhash
1659# endif
1660 END IF
1661 END IF
1662# ifdef NESTING
1663 CALL fill_contact(ng, model, tile, &
1664 & cr, rcontact(cr)%Npoints, rcontact, &
1665 & r2dvar, var_name(i), spval_check, &
1666 & lbi, ubi, lbj, ubj, &
1667 & contact_metric(cr) % Yr, &
1668 & grid(ng) % latr)
1669 IF (founderror(exit_flag, noerror, &
1670 & __line__, myfile)) RETURN
1671# endif
1672# ifdef DISTRIBUTE
1673 CALL mp_exchange2d (ng, tile, model, 1, &
1674 & lbi, ubi, lbj, ubj, &
1675 & nghostpoints, &
1676 & .false., .false., &
1677 & grid(ng) % latr)
1678# endif
1679 END IF
1680!
1681! Read in longitude at U-points.
1682!
1683 CASE ('lon_u')
1684 IF (spherical) THEN
1685 gtype=u2dvar
1686 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1687 & var_name(i), var_id(i), &
1688 & 0, gtype, vsize, &
1689 & lbi, ubi, lbj, ubj, &
1690 & fscl, fmin, fmax, &
1691# ifdef MASKING
1692 & grid(ng) % umask, &
1693# endif
1694# ifdef CHECKSUM
1695 & grid(ng) % lonu, &
1696 & checksum = fhash)
1697# else
1698 & grid(ng) % lonu)
1699# endif
1700 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1701 exit_flag=2
1702 ioerror=status
1703 EXIT
1704 ELSE
1705 IF (master) THEN
1706 WRITE (stdout,30) 'longitude of U-points: lon_u', &
1707 & ng, trim(ncname), fmin, fmax
1708# ifdef CHECKSUM
1709 WRITE (stdout,60) fhash
1710# endif
1711 END IF
1712 END IF
1713# ifdef NESTING
1714 CALL fill_contact(ng, model, tile, &
1715 & cr, ucontact(cr)%Npoints, ucontact, &
1716 & u2dvar, var_name(i), spval_check, &
1717 & lbi, ubi, lbj, ubj, &
1718 & contact_metric(cr) % Xu, &
1719 & grid(ng) % lonu)
1720 IF (founderror(exit_flag, noerror, &
1721 & __line__, myfile)) RETURN
1722# endif
1723# ifdef DISTRIBUTE
1724 CALL mp_exchange2d (ng, tile, model, 1, &
1725 & lbi, ubi, lbj, ubj, &
1726 & nghostpoints, &
1727 & .false., .false., &
1728 & grid(ng) % lonu)
1729# endif
1730 END IF
1731!
1732! Read in latitude at U-points.
1733!
1734 CASE ('lat_u')
1735 IF (spherical) THEN
1736 gtype=u2dvar
1737 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1738 & var_name(i), var_id(i), &
1739 & 0, gtype, vsize, &
1740 & lbi, ubi, lbj, ubj, &
1741 & fscl, fmin, fmax, &
1742# ifdef MASKING
1743 & grid(ng) % umask, &
1744# endif
1745# ifdef CHECKSUM
1746 & grid(ng) % latu, &
1747 & checksum = fhash)
1748# else
1749 & grid(ng) % latu)
1750# endif
1751 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1752 exit_flag=2
1753 ioerror=status
1754 EXIT
1755 ELSE
1756 IF (master) THEN
1757 WRITE (stdout,30) 'latitude of U-points: lat_u', &
1758 & ng, trim(ncname), fmin, fmax
1759# ifdef CHECKSUM
1760 WRITE (stdout,60) fhash
1761# endif
1762 END IF
1763 END IF
1764# ifdef NESTING
1765 CALL fill_contact(ng, model, tile, &
1766 & cr, ucontact(cr)%Npoints, ucontact, &
1767 & u2dvar, var_name(i), spval_check, &
1768 & lbi, ubi, lbj, ubj, &
1769 & contact_metric(cr) % Yu, &
1770 & grid(ng) % latu)
1771 IF (founderror(exit_flag, noerror, &
1772 & __line__, myfile)) RETURN
1773# endif
1774# ifdef DISTRIBUTE
1775 CALL mp_exchange2d (ng, tile, model, 1, &
1776 & lbi, ubi, lbj, ubj, &
1777 & nghostpoints, &
1778 & .false., .false., &
1779 & grid(ng) % latu)
1780# endif
1781 END IF
1782!
1783! Read in longitude at V-points.
1784!
1785 CASE ('lon_v')
1786 IF (spherical) THEN
1787 gtype=v2dvar
1788 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1789 & var_name(i), var_id(i), &
1790 & 0, gtype, vsize, &
1791 & lbi, ubi, lbj, ubj, &
1792 & fscl, fmin, fmax, &
1793# ifdef MASKING
1794 & grid(ng) % vmask, &
1795# endif
1796# ifdef CHECKSUM
1797 & grid(ng) % lonv, &
1798 & checksum = fhash)
1799# else
1800 & grid(ng) % lonv)
1801# endif
1802 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1803 exit_flag=2
1804 ioerror=status
1805 EXIT
1806 ELSE
1807 IF (master) THEN
1808 WRITE (stdout,30) 'longitude of V-points: lon_v', &
1809 & ng, trim(ncname), fmin, fmax
1810# ifdef CHECKSUM
1811 WRITE (stdout,60) fhash
1812# endif
1813 END IF
1814 END IF
1815# ifdef NESTING
1816 CALL fill_contact(ng, model, tile, &
1817 & cr, vcontact(cr)%Npoints, vcontact, &
1818 & v2dvar, var_name(i), spval_check, &
1819 & lbi, ubi, lbj, ubj, &
1820 & contact_metric(cr) % Xv, &
1821 & grid(ng) % lonv)
1822 IF (founderror(exit_flag, noerror, &
1823 & __line__, myfile)) RETURN
1824# endif
1825# ifdef DISTRIBUTE
1826 CALL mp_exchange2d (ng, tile, model, 1, &
1827 & lbi, ubi, lbj, ubj, &
1828 & nghostpoints, &
1829 & .false., .false., &
1830 & grid(ng) % lonv)
1831# endif
1832 END IF
1833!
1834! Read in latitude at V-points.
1835!
1836 CASE ('lat_v')
1837 IF (spherical) THEN
1838 gtype=v2dvar
1839 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1840 & var_name(i), var_id(i), &
1841 & 0, gtype, vsize, &
1842 & lbi, ubi, lbj, ubj, &
1843 & fscl, fmin, fmax, &
1844# ifdef MASKING
1845 & grid(ng) % vmask, &
1846# endif
1847# ifdef CHECKSUM
1848 & grid(ng) % latv, &
1849 & checksum = fhash)
1850# else
1851 & grid(ng) % latv)
1852# endif
1853 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1854 exit_flag=2
1855 ioerror=status
1856 EXIT
1857 ELSE
1858 IF (master) THEN
1859 WRITE (stdout,30) 'latitude of V-points: lat_v', &
1860 & ng, trim(ncname), fmin, fmax
1861# ifdef CHECKSUM
1862 WRITE (stdout,60) fhash
1863# endif
1864 END IF
1865 END IF
1866# ifdef NESTING
1867 CALL fill_contact(ng, model, tile, &
1868 & cr, vcontact(cr)%Npoints, vcontact, &
1869 & v2dvar, var_name(i), spval_check, &
1870 & lbi, ubi, lbj, ubj, &
1871 & contact_metric(cr) % Yv, &
1872 & grid(ng) % latv)
1873 IF (founderror(exit_flag, noerror, &
1874 & __line__, myfile)) RETURN
1875# endif
1876# ifdef DISTRIBUTE
1877 CALL mp_exchange2d (ng, tile, model, 1, &
1878 & lbi, ubi, lbj, ubj, &
1879 & nghostpoints, &
1880 & .false., .false., &
1881 & grid(ng) % latv)
1882# endif
1883 END IF
1884!
1885! Read in angle (radians) between XI-axis and EAST at RHO-points.
1886!
1887 CASE ('angle')
1888 gtype=r2dvar
1889 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1890 & var_name(i), var_id(i), &
1891 & 0, gtype, vsize, &
1892 & lbi, ubi, lbj, ubj, &
1893 & fscl, fmin, fmax, &
1894# ifdef MASKING
1895 & grid(ng) % rmask, &
1896# endif
1897# ifdef CHECKSUM
1898 & grid(ng) % angler, &
1899 & checksum = fhash)
1900# else
1901 & grid(ng) % angler)
1902# endif
1903 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1904 exit_flag=2
1905 ioerror=status
1906 EXIT
1907 ELSE
1908 IF (master) THEN
1909 WRITE (stdout,30) 'angle between XI-axis and EAST: '// &
1910 & 'angler', &
1911 & ng, trim(ncname), fmin, fmax
1912# ifdef CHECKSUM
1913 WRITE (stdout,60) fhash
1914# endif
1915 END IF
1916 END IF
1917# ifdef NESTING
1918 CALL fill_contact(ng, model, tile, &
1919 & cr, rcontact(cr)%Npoints, rcontact, &
1920 & r2dvar, 'angler', spval_check, &
1921 & lbi, ubi, lbj, ubj, &
1922 & contact_metric(cr) % angler, &
1923 & grid(ng) % angler)
1924 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1925# endif
1926 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1927 CALL exchange_r2d_tile (ng, tile, &
1928 & lbi, ubi, lbj, ubj, &
1929 & grid(ng) % angler)
1930 END IF
1931# ifdef DISTRIBUTE
1932 CALL mp_exchange2d (ng, tile, model, 1, &
1933 & lbi, ubi, lbj, ubj, &
1934 & nghostpoints, &
1935 & ewperiodic(ng), nsperiodic(ng), &
1936 & grid(ng) % angler)
1937# endif
1938# if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
1939 defined opt_observations || defined sensitivity_4dvar || \
1940 defined so_semi
1941# ifndef OBS_SPACE
1942!
1943! Read in adjoint sensitivity spatial scope masking at RHO-points.
1944!
1945 CASE ('scope_rho')
1946 gtype=r2dvar
1947 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1948 & var_name(i), var_id(i), &
1949 & 0, gtype, vsize, &
1950 & lbi, ubi, lbj, ubj, &
1951 & fscl, fmin, fmax, &
1952# ifdef MASKING
1953 & grid(ng) % rmask, &
1954# endif
1955# ifdef CHECKSUM
1956 & grid(ng) % Rscope, &
1957 & checksum = fhash)
1958# else
1959 & grid(ng) % Rscope)
1960# endif
1961 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1962 exit_flag=2
1963 ioerror=status
1964 EXIT
1965 ELSE
1966 IF (master) THEN
1967 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
1968 & 'scope on RHO-points: scope_rho', &
1969 & ng, trim(ncname), fmin, fmax
1970# ifdef CHECKSUM
1971 WRITE (stdout,60) fhash
1972# endif
1973 END IF
1974 END IF
1975 gotscope(1)=.true.
1976 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1977 CALL exchange_r2d_tile (ng, tile, &
1978 & lbi, ubi, lbj, ubj, &
1979 & grid(ng) % Rscope)
1980 END IF
1981# ifdef DISTRIBUTE
1982 CALL mp_exchange2d (ng, tile, model, 1, &
1983 & lbi, ubi, lbj, ubj, &
1984 & nghostpoints, &
1985 & ewperiodic(ng), nsperiodic(ng), &
1986 & grid(ng) % Rscope)
1987# endif
1988!
1989! Read in adjoint sensitivity spatial scope masking at U-points.
1990!
1991 CASE ('scope_u')
1992 gtype=u2dvar
1993 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
1994 & var_name(i), var_id(i), &
1995 & 0, gtype, vsize, &
1996 & lbi, ubi, lbj, ubj, &
1997 & fscl, fmin, fmax, &
1998# ifdef MASKING
1999 & grid(ng) % umask, &
2000# endif
2001# ifdef CHECKSUM
2002 & grid(ng) % Uscope, &
2003 & checksum = fhash)
2004# else
2005 & grid(ng) % Uscope)
2006# endif
2007 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2008 exit_flag=2
2009 ioerror=status
2010 EXIT
2011 ELSE
2012 IF (master) THEN
2013 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
2014 & 'scope on U-points: scope_u', &
2015 & ng, trim(ncname), fmin, fmax
2016# ifdef CHECKSUM
2017 WRITE (stdout,60) fhash
2018# endif
2019 END IF
2020 END IF
2021 gotscope(2)=.true.
2022 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2023 CALL exchange_u2d_tile (ng, tile, &
2024 & lbi, ubi, lbj, ubj, &
2025 & grid(ng) % Uscope)
2026 END IF
2027# ifdef DISTRIBUTE
2028 CALL mp_exchange2d (ng, tile, model, 1, &
2029 & lbi, ubi, lbj, ubj, &
2030 & nghostpoints, &
2031 & ewperiodic(ng), nsperiodic(ng), &
2032 & grid(ng) % Uscope)
2033# endif
2034!
2035! Read in adjoint sensitivity spatial scope masking at V-points.
2036!
2037 CASE ('scope_v')
2038 gtype=v2dvar
2039 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
2040 & var_name(i), var_id(i), &
2041 & 0, gtype, vsize, &
2042 & lbi, ubi, lbj, ubj, &
2043 & fscl, fmin, fmax, &
2044# ifdef MASKING
2045 & grid(ng) % vmask, &
2046# endif
2047# ifdef CHECKSUM
2048 & grid(ng) % Vscope, &
2049 & checksum = fhash)
2050# else
2051 & grid(ng) % Vscope)
2052# endif
2053 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2054 exit_flag=2
2055 ioerror=status
2056 EXIT
2057 ELSE
2058 IF (master) THEN
2059 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
2060 & 'scope on V-points: scope_v', &
2061 & ng, trim(ncname), fmin, fmax
2062# ifdef CHECKSUM
2063 WRITE (stdout,60) fhash
2064# endif
2065 END IF
2066 END IF
2067 gotscope(3)=.true.
2068 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2069 CALL exchange_v2d_tile (ng, tile, &
2070 & lbi, ubi, lbj, ubj, &
2071 & grid(ng) % Vscope)
2072 END IF
2073# ifdef DISTRIBUTE
2074 CALL mp_exchange2d (ng, tile, model, 1, &
2075 & lbi, ubi, lbj, ubj, &
2076 & nghostpoints, &
2077 & ewperiodic(ng), nsperiodic(ng), &
2078 & grid(ng) % Vscope)
2079# endif
2080# endif
2081# endif
2082 END SELECT
2083 END DO
2084 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
2085 IF (master) WRITE (stdout,40) trim(var_name(i)), trim(ncname)
2086 RETURN
2087 END IF
2088
2089# if defined UV_DRAG_GRID && !defined ANA_DRAG
2090# if defined UV_LOGDRAG || defined BBL_MODEL
2091!
2092! Read in spacially varying bottom roughness length (m).
2093!
2094 gtype=r2dvar
2095 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
2096 & vname(1,idzobl), varid_zobl, &
2097 & 0, gtype, vsize, &
2098 & lbi, ubi, lbj, ubj, &
2099 & fscl, fmin, fmax, &
2100# ifdef MASKING
2101 & grid(ng) % rmask, &
2102# endif
2103# ifdef CHECKSUM
2104 & grid(ng) % ZoBot, &
2105 & checksum = fhash)
2106# else
2107 & grid(ng) % ZoBot)
2108# endif
2109 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2110 IF (master) WRITE (stdout,40) trim(vname(1,idzobl)), &
2111 & trim(ncname)
2112 exit_flag=2
2113 ioerror=status
2114 RETURN
2115 ELSE
2116 IF (master) THEN
2117 WRITE (stdout,30) 'time invariant, bottom roughness '// &
2118 & 'length scale: ZoBot', &
2119 & ng, trim(ncname), fmin, fmax
2120# ifdef CHECKSUM
2121 WRITE (stdout,60) fhash
2122# endif
2123 END IF
2124 END IF
2125 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2126 CALL exchange_r2d_tile (ng, tile, &
2127 & lbi, ubi, lbj, ubj, &
2128 & grid(ng) % ZoBot)
2129 END IF
2130# ifdef DISTRIBUTE
2131 CALL mp_exchange2d (ng, tile, model, 1, &
2132 & lbi, ubi, lbj, ubj, &
2133 & nghostpoints, &
2134 & ewperiodic(ng), nsperiodic(ng), &
2135 & grid(ng) % ZoBot)
2136# endif
2137# endif
2138# ifdef UV_LDRAG
2139!
2140! Read in spacially varying linear drag coefficients (m/s).
2141!
2142 gtype=r2dvar
2143 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
2144 & vname(1,idragl), varid_dragl, &
2145 & 0, gtype, vsize, &
2146 & lbi, ubi, lbj, ubj, &
2147 & fscl, fmin, fmax, &
2148# ifdef MASKING
2149 & grid(ng) % rmask, &
2150# endif
2151# ifdef CHECKSUM
2152 & grid(ng) % rdrag, &
2153 & checksum = fhash)
2154# else
2155 & grid(ng) % rdrag)
2156# endif
2157 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2158 IF (master) WRITE (stdout,40) trim(vname(1,idragl)), &
2159 & trim(ncname)
2160 exit_flag=2
2161 ioerror=status
2162 RETURN
2163 ELSE
2164 IF (master) THEN
2165 WRITE (stdout,30) 'linear bottom drag coefficient: rdrag', &
2166 & ng, trim(ncname), fmin, fmax
2167# ifdef CHECKSUM
2168 WRITE (stdout,60) fhash
2169# endif
2170 END IF
2171 END IF
2172 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2173 CALL exchange_r2d_tile (ng, tile, &
2174 & lbi, ubi, lbj, ubj, &
2175 & grid(ng) % rdrag)
2176 END IF
2177# ifdef DISTRIBUTE
2178 CALL mp_exchange2d (ng, tile, model, 1, &
2179 & lbi, ubi, lbj, ubj, &
2180 & nghostpoints, &
2181 & ewperiodic(ng), nsperiodic(ng), &
2182 & grid(ng) % rdrag)
2183# endif
2184# endif
2185# ifdef UV_QDRAG
2186!
2187! Read in spacially varying quadratic drag coefficients.
2188!
2189 gtype=r2dvar
2190 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
2191 & vname(1,idragq), varid_dragq, &
2192 & 0, gtype, vsize, &
2193 & lbi, ubi, lbj, ubj, &
2194 & fscl, fmin, fmax, &
2195# ifdef MASKING
2196 & grid(ng) % rmask, &
2197# endif
2198# ifdef CHECKSUM
2199 & grid(ng) % rdrag2, &
2200 & checksum = fhash)
2201# else
2202 & grid(ng) % rdrag2)
2203# endif
2204 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2205 IF (master) WRITE (stdout,40) trim(vname(1,idragq)), &
2206 & trim(ncname)
2207 exit_flag=2
2208 ioerror=status
2209 RETURN
2210 ELSE
2211 IF (master) THEN
2212 WRITE (stdout,30) 'quadratic bottom drag coefficient: rdrag2',&
2213 & ng, trim(ncname), fmin, fmax
2214# ifdef CHECKSUM
2215 WRITE (stdout,60) fhash
2216# endif
2217 END IF
2218 END IF
2219 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2220 CALL exchange_r2d_tile (ng, tile, &
2221 & lbi, ubi, lbj, ubj, &
2222 & grid(ng) % rdrag2)
2223 END IF
2224# ifdef DISTRIBUTE
2225 CALL mp_exchange2d (ng, tile, model, 1, &
2226 & lbi, ubi, lbj, ubj, &
2227 & nghostpoints, &
2228 & ewperiodic(ng), nsperiodic(ng), &
2229 & grid(ng) % rdrag2)
2230# endif
2231# endif
2232# endif
2233# if defined UV_WAVEDRAG
2234!
2235! Read in spacially varying linear drag coefficients (m/s).
2236!
2237 gtype=r2dvar
2238 status=nf_fread2d(ng, model, ncname, grd(ng)%ncid, &
2239 & vname(1,idragw), varid_dragw, &
2240 & 0, gtype, vsize, &
2241 & lbi, ubi, lbj, ubj, &
2242 & fscl, fmin, fmax, &
2243# ifdef MASKING
2244 & grid(ng) % rmask, &
2245# endif
2246 & grid(ng) % wavedrag)
2247 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2248 IF (master) WRITE (stdout,30) trim(vname(1,idragw)), &
2249 & trim(ncname)
2250 exit_flag=2
2251 ioerror=status
2252 RETURN
2253 END IF
2254 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2255 CALL exchange_r2d_tile (ng, tile, &
2256 & lbi, ubi, lbj, ubj, &
2257 & grid(ng) % wavedrag)
2258 END IF
2259# ifdef DISTRIBUTE
2260 CALL mp_exchange2d (ng, tile, model, 1, &
2261 & lbi, ubi, lbj, ubj, &
2262 & nghostpoints, &
2263 & ewperiodic(ng), nsperiodic(ng), &
2264 & grid(ng) % wavedrag)
2265# endif
2266# endif
2267!
2268! Close GRID NetCDF file.
2269!
2270 CALL netcdf_close (ng, model, grd(ng)%ncid, ncname, .false.)
2271 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2272
2273# if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
2274 defined opt_observations || defined sensitivity_4dvar || \
2275 defined so_semi
2276# ifndef OBS_SPACE
2277!
2278!-----------------------------------------------------------------------
2279! Inquire adjoint sensitivity forcing file. Read scope arrays again.
2280! These fields take precedence
2281!-----------------------------------------------------------------------
2282!
2283 ncname=ads(ng)%name
2284!
2285! Open adjoint sensitivity NetCDF file for reading.
2286!
2287 IF (ads(ng)%ncid.eq.-1) THEN
2288 CALL netcdf_open (ng, model, ncname, 0, ads(ng)%ncid)
2289 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
2290 WRITE (stdout,10) trim(ncname)
2291 RETURN
2292 END IF
2293 END IF
2294!
2295! Check grid file dimensions for consitency
2296!
2297 CALL netcdf_check_dim (ng, model, ncname, &
2298 & ncid = ads(ng)%ncid)
2299 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2300!
2301! Inquire about the variables.
2302!
2303 CALL netcdf_inq_var (ng, model, ncname, &
2304 & ncid = ads(ng)%ncid)
2305 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2306!
2307! Check if the adjoint sensitivity scope arrays are available.
2308!
2309 gotscope(4)=find_string(var_name,n_var,'scope_rho',vindex)
2310 gotscope(5)=find_string(var_name,n_var,'scope_u',vindex)
2311 gotscope(6)=find_string(var_name,n_var,'scope_v',vindex)
2312!
2313 IF ((.not.gotscope(1)).and.(.not.gotscope(4))) THEN
2314 IF (master) WRITE (stdout,20) 'scope_rho', trim(ncname)
2315 exit_flag=2
2316 RETURN
2317 END IF
2318 IF ((.not.gotscope(2)).and.(.not.gotscope(5))) THEN
2319 IF (master) WRITE (stdout,20) 'scope_u', trim(ncname)
2320 exit_flag=2
2321 RETURN
2322 END IF
2323 IF ((.not.gotscope(3)).and.(.not.gotscope(6))) THEN
2324 IF (master) WRITE (stdout,20) 'scope_v', trim(ncname)
2325 exit_flag=2
2326 RETURN
2327 END IF
2328 IF (master) THEN
2329 IF (gotscope(4)) THEN
2330 WRITE (stdout,50) trim(ads(ng)%name)
2331 ELSE
2332 WRITE (stdout,50) trim(grd(ng)%name)
2333 END IF
2334 END IF
2335!
2336! Scan adjoint sensitivity variables.
2337!
2338 DO i=1,n_var
2339
2340 SELECT CASE (trim(adjustl(var_name(i))))
2341!
2342! Read in adjoint sensitivity spatial scope masking at RHO-points.
2343!
2344 CASE ('scope_rho')
2345 gtype=r2dvar
2346 status=nf_fread2d(ng, model, ncname, ads(ng)%ncid, &
2347 & var_name(i), var_id(i), &
2348 & 0, gtype, vsize, &
2349 & lbi, ubi, lbj, ubj, &
2350 & fscl, fmin, fmax, &
2351# ifdef MASKING
2352 & grid(ng) % rmask, &
2353# endif
2354# ifdef CHECKSUM
2355 & grid(ng) % Rscope, &
2356 & checksum = fhash)
2357# else
2358 & grid(ng) % Rscope)
2359# endif
2360 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2361 exit_flag=2
2362 ioerror=status
2363 EXIT
2364 ELSE
2365 IF (master) THEN
2366 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
2367 & 'scope on RHO-points: scope_rho', &
2368 & ng, trim(ncname), fmin, fmax
2369# ifdef CHECKSUM
2370 WRITE (stdout,60) fhash
2371# endif
2372 END IF
2373 END IF
2374 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2375 CALL exchange_r2d_tile (ng, tile, &
2376 & lbi, ubi, lbj, ubj, &
2377 & grid(ng) % Rscope)
2378 END IF
2379# ifdef DISTRIBUTE
2380 CALL mp_exchange2d (ng, tile, model, 1, &
2381 & lbi, ubi, lbj, ubj, &
2382 & nghostpoints, &
2383 & ewperiodic(ng), nsperiodic(ng), &
2384 & grid(ng) % Rscope)
2385# endif
2386!
2387! Read in adjoint sensitivity spatial scope masking at U-points.
2388!
2389 CASE ('scope_u')
2390 gtype=u2dvar
2391 status=nf_fread2d(ng, model, ncname, ads(ng)%ncid, &
2392 & var_name(i), var_id(i), &
2393 & 0, gtype, vsize, &
2394 & lbi, ubi, lbj, ubj, &
2395 & fscl, fmin, fmax, &
2396# ifdef MASKING
2397 & grid(ng) % umask, &
2398# endif
2399# ifdef CHECKSUM
2400 & grid(ng) % Uscope, &
2401 & checksum = fhash)
2402# else
2403 & grid(ng) % Uscope)
2404# endif
2405 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2406 exit_flag=2
2407 ioerror=status
2408 EXIT
2409 ELSE
2410 IF (master) THEN
2411 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
2412 & 'scope on U-points: scope_u', &
2413 & ng, trim(ncname), fmin, fmax
2414# ifdef CHECKSUM
2415 WRITE (stdout,60) fhash
2416# endif
2417 END IF
2418 END IF
2419 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2420 CALL exchange_u2d_tile (ng, tile, &
2421 & lbi, ubi, lbj, ubj, &
2422 & grid(ng) % Uscope)
2423 END IF
2424# ifdef DISTRIBUTE
2425 CALL mp_exchange2d (ng, tile, model, 1, &
2426 & lbi, ubi, lbj, ubj, &
2427 & nghostpoints, &
2428 & ewperiodic(ng), nsperiodic(ng), &
2429 & grid(ng) % Uscope)
2430# endif
2431!
2432! Read in adjoint sensitivity spatial scope masking at V-points.
2433!
2434 CASE ('scope_v')
2435 gtype=v2dvar
2436 status=nf_fread2d(ng, model, ncname, ads(ng)%ncid, &
2437 & var_name(i), var_id(i), &
2438 & 0, gtype, vsize, &
2439 & lbi, ubi, lbj, ubj, &
2440 & fscl, fmin, fmax, &
2441# ifdef MASKING
2442 & grid(ng) % vmask, &
2443# endif
2444# ifdef CHECKSUM
2445 & grid(ng) % Vscope, &
2446 & checksum = fhash)
2447# else
2448 & grid(ng) % Vscope)
2449# endif
2450 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2451 exit_flag=2
2452 ioerror=status
2453 EXIT
2454 ELSE
2455 IF (master) THEN
2456 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
2457 & 'scope on V-points: scope_v', &
2458 & ng, trim(ncname), fmin, fmax
2459# ifdef CHECKSUM
2460 WRITE (stdout,60) fhash
2461# endif
2462 END IF
2463 END IF
2464 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2465 CALL exchange_v2d_tile (ng, tile, &
2466 & lbi, ubi, lbj, ubj, &
2467 & grid(ng) % Vscope)
2468 END IF
2469# ifdef DISTRIBUTE
2470 CALL mp_exchange2d (ng, tile, model, 1, &
2471 & lbi, ubi, lbj, ubj, &
2472 & nghostpoints, &
2473 & ewperiodic(ng), nsperiodic(ng), &
2474 & grid(ng) % Vscope)
2475# endif
2476 END SELECT
2477 END DO
2478 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
2479 IF (master) WRITE (stdout,40) trim(var_name(i)), trim(ncname)
2480 RETURN
2481 END IF
2482# endif
2483# endif
2484!
2485 10 FORMAT (/,' GET_GRID_NF90 - unable to open grid NetCDF file: ',a)
2486 20 FORMAT (/,' GET_GRID_NF90 - unable to find grid variable: ',a, &
2487 & /,12x,'in grid NetCDF file: ',a)
2488 30 FORMAT (2x,'GET_GRID_NF90 - ',a,/,22x, &
2489 & '(Grid = ',i2.2,', File: ',a,')',/,22x, &
2490 & '(Min = ', 1p,e15.8,0p,' Max = ',1p,e15.8,0p,')')
2491 40 FORMAT (/,' GET_GRID_NF90 - error while reading variable: ',a, &
2492 & /,12x,'in grid NetCDF file: ',a)
2493 50 FORMAT (/,2x,'GET_GRID_NF90 - Reading adjoint sensitivity', &
2494 & ' scope arrays from file:',/22x,a,/)
2495
2496# ifdef CHECKSUM
2497 60 FORMAT (22x,'(CheckSum = ',i0,')')
2498# endif
2499!
2500 RETURN
2501 END SUBROUTINE get_grid_nf90
2502
2503# if defined PIO_LIB && defined DISTRIBUTE
2504!
2505!***********************************************************************
2506 SUBROUTINE get_grid_pio (ng, tile, model, &
2507 & LBi, UBi, LBj, UBj)
2508!***********************************************************************
2509!
2510! Imported variable declarations.
2511!
2512 integer, intent(in) :: ng, tile, model
2513 integer, intent(in) :: lbi, ubi, lbj, ubj
2514!
2515! Local variable declarations.
2516!
2517# if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
2518 defined opt_observations || defined sensitivity_4dvar || \
2519 defined so_semi
2520# ifndef OBS_SPACE
2521 logical :: gotscope(6)
2522!
2523# endif
2524# endif
2525 integer :: cr, i, status, vindex
2526 integer :: vsize(4)
2527# ifdef CHECKSUM
2528 integer(i8b) :: fhash
2529# endif
2530!
2531 real(dp), parameter :: fscl = 1.0_dp
2532
2533 real(r8) :: fmax, fmin
2534!
2535 character (len=256) :: ncname
2536
2537 character (len=*), parameter :: myfile = &
2538 & __FILE__//", get_grid_pio"
2539!
2540 TYPE (io_desc_t), pointer :: iodesc
2541 TYPE (my_vardesc) :: piovar
2542# if defined UV_DRAG_GRID && !defined ANA_DRAG
2543 TYPE (my_vardesc) :: piovar_dragl, piovar_dragq, piovar_zobl
2544# endif
2545
2546!
2547 sourcefile=myfile
2548!
2549!-----------------------------------------------------------------------
2550! Inquire about the contents of grid NetCDF file: Inquire about
2551! the dimensions and variables. Check for consistency.
2552!-----------------------------------------------------------------------
2553!
2554 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2555 ncname=grd(ng)%name
2556!
2557! Open grid NetCDF file for reading.
2558!
2559 IF (grd(ng)%pioFile%fh.eq.-1) THEN
2560 CALL pio_netcdf_open (ng, model, ncname, 0, grd(ng)%pioFile)
2561 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
2562 WRITE (stdout,10) trim(ncname)
2563 RETURN
2564 END IF
2565 END IF
2566!
2567! Check grid file dimensions for consitency.
2568!
2569 CALL pio_netcdf_check_dim (ng, model, ncname, &
2570 & piofile = grd(ng)%pioFile)
2571 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2572!
2573! Inquire about the variables.
2574!
2575 CALL pio_netcdf_inq_var (ng, model, ncname, &
2576 & piofile = grd(ng)%pioFile)
2577 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2578
2579# ifdef NESTING
2580!
2581! Determine contact region index "cr" for which nested grid "ng" is
2582! the receiver grid.
2583!
2584 DO i=1,ncontact
2585 IF (rcontact(i)%receiver_grid.eq.ng) THEN
2586 cr=i
2587 EXIT
2588 END IF
2589 END DO
2590# endif
2591!
2592!-----------------------------------------------------------------------
2593! Check if required variables are available.
2594!-----------------------------------------------------------------------
2595!
2596 IF (.not.find_string(var_name,n_var,'xl',vindex)) THEN
2597 IF (master) WRITE (stdout,20) 'xl', trim(ncname)
2598 exit_flag=2
2599 RETURN
2600 END IF
2601 IF (.not.find_string(var_name,n_var,'el',vindex)) THEN
2602 IF (master) WRITE (stdout,20) 'el', trim(ncname)
2603 exit_flag=2
2604 RETURN
2605 END IF
2606 IF (.not.find_string(var_name,n_var,'spherical',vindex)) THEN
2607 IF (master) WRITE (stdout,20) 'spherical', trim(ncname)
2608 exit_flag=2
2609 RETURN
2610 END IF
2611 IF (.not.find_string(var_name,n_var,'h',vindex)) THEN
2612 IF (master) WRITE (stdout,20) 'h', trim(ncname)
2613 exit_flag=2
2614 RETURN
2615 END IF
2616# ifdef ICESHELF
2617 IF (.not.find_string(var_name,n_var,'zice',vindex)) THEN
2618 IF (master) WRITE (stdout,20) 'zice', trim(ncname)
2619 exit_flag=2
2620 RETURN
2621 END IF
2622# endif
2623 IF (.not.find_string(var_name,n_var,'f',vindex)) THEN
2624 IF (master) WRITE (stdout,20) 'f', trim(ncname)
2625 exit_flag=2
2626 RETURN
2627 END IF
2628 IF (.not.find_string(var_name,n_var,'pm',vindex)) THEN
2629 IF (master) WRITE (stdout,20) 'pm', trim(ncname)
2630 exit_flag=2
2631 RETURN
2632 END IF
2633 IF (.not.find_string(var_name,n_var,'pn',vindex)) THEN
2634 IF (master) WRITE (stdout,20) 'pn', trim(ncname)
2635 exit_flag=2
2636 RETURN
2637 END IF
2638# if (defined CURVGRID && defined UV_ADV)
2639 IF (.not.find_string(var_name,n_var,'dndx',vindex)) THEN
2640 IF (master) WRITE (stdout,20) 'dndx', trim(ncname)
2641! exit_flag=2
2642! RETURN
2643 END IF
2644 IF (.not.find_string(var_name,n_var,'dmde',vindex)) THEN
2645 IF (master) WRITE (stdout,20) 'dmde', trim(ncname)
2646! exit_flag=2
2647! RETURN
2648 END IF
2649# endif
2650# ifdef CURVGRID
2651 IF (.not.find_string(var_name,n_var,'angle',vindex)) THEN
2652 IF (master) WRITE (stdout,20) 'angle', trim(ncname)
2653 exit_flag=2
2654 RETURN
2655 END IF
2656# endif
2657# ifdef MASKING
2658 IF (.not.find_string(var_name,n_var,'mask_rho',vindex)) THEN
2659 IF (master) WRITE (stdout,20) 'mask_rho', trim(ncname)
2660 exit_flag=2
2661 RETURN
2662 END IF
2663 IF (.not.find_string(var_name,n_var,'mask_u',vindex)) THEN
2664 IF (master) WRITE (stdout,20) 'mask_u', trim(ncname)
2665 exit_flag=2
2666 RETURN
2667 END IF
2668 IF (.not.find_string(var_name,n_var,'mask_v',vindex)) THEN
2669 IF (master) WRITE (stdout,20) 'mask_v', trim(ncname)
2670 exit_flag=2
2671 RETURN
2672 END IF
2673 IF (.not.find_string(var_name,n_var,'mask_psi',vindex)) THEN
2674 IF (master) WRITE (stdout,20) 'mask_psi', trim(ncname)
2675 exit_flag=2
2676 RETURN
2677 END IF
2678# endif
2679# if defined WTYPE_GRID && \
2680 (defined lmd_skpp || defined solar_source) && \
2681 !defined ANA_WTYPE
2682 IF (.not.find_string(var_name,n_var,'wtype_grid',vindex)) THEN
2683 IF (master) WRITE (stdout,20) 'wtype_grid', trim(ncname)
2684 exit_flag=2
2685 RETURN
2686 END IF
2687# endif
2688# ifndef ANA_SPONGE
2689 IF (luvsponge(ng)) THEN
2690 IF (.not.find_string(var_name,n_var,'visc_factor',vindex)) THEN
2691 IF (master) WRITE (stdout,20) 'visc_factor', trim(ncname)
2692 exit_flag=2
2693 RETURN
2694 END IF
2695 END IF
2696# ifdef SOLVE3D
2697 IF (any(ltracersponge(:,ng))) THEN
2698 IF (.not.find_string(var_name,n_var,'diff_factor',vindex)) THEN
2699 IF (master) WRITE (stdout,20) 'diff_factor', trim(ncname)
2700 exit_flag=2
2701 RETURN
2702 END IF
2703 END IF
2704# endif
2705# endif
2706# if defined UV_DRAG_GRID && !defined ANA_DRAG
2707# ifdef UV_LOGDRAG
2708 IF (.not.find_string(var_name,n_var,trim(vname(1,idzobl)), &
2709 & vindex)) THEN
2710 IF (master) WRITE (stdout,20) trim(vname(1,idzobl)), &
2711 & trim(ncname)
2712 exit_flag=2
2713 RETURN
2714 ELSE
2715 piovar_zobl%vd=var_desc(vindex)
2716 piovar_zobl%gtype=r2dvar
2717 END IF
2718# endif
2719# ifdef UV_LDRAG
2720 IF (.not.find_string(var_name,n_var,trim(vname(1,idragl)), &
2721 & vindex)) THEN
2722 IF (master) WRITE (stdout,20) trim(vname(1,idragl)), &
2723 & trim(ncname)
2724 exit_flag=2
2725 RETURN
2726 ELSE
2727 piovar_dragl%vd=var_desc(vindex)
2728 piovar_dragl%gtype=r2dvar
2729 END IF
2730# endif
2731# ifdef UV_QDRAG
2732 IF (.not.find_string(var_name,n_var,trim(vname(1,idragq)), &
2733 & vindex)) THEN
2734 IF (master) WRITE (stdout,20) trim(vname(1,idragq)), &
2735 & trim(ncname)
2736 exit_flag=2
2737 RETURN
2738 ELSE
2739 piovar_dragq%vd=var_desc(vindex)
2740 piovar_dragq%gtype=r2dvar
2741 END IF
2742# endif
2743# endif
2744!
2745! Read in logical switch for spherical grid configuration.
2746!
2747 spherical=.false.
2748 IF (find_string(var_name,n_var,'spherical',vindex)) THEN
2749 CALL pio_netcdf_get_lvar (ng, model, ncname, &
2750 & 'spherical', spherical, &
2751 & piofile = grd(ng)%pioFile)
2752 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2753 END IF
2754!
2755!-----------------------------------------------------------------------
2756! Read in grid variables.
2757!-----------------------------------------------------------------------
2758!
2759! Set Vsize to zero to deativate interpolation of input data to model
2760! grid in "nf_fread2d".
2761!
2762 DO i=1,4
2763 vsize(i)=0
2764 END DO
2765!
2766! Scan the variable list and read in needed variables.
2767!
2768 IF (master) WRITE (stdout,'(1x)')
2769!
2770 DO i=1,n_var
2771
2772 SELECT CASE (trim(adjustl(var_name(i))))
2773!
2774! Read in basin X-length.
2775!
2776 CASE ('xl')
2777 CALL pio_netcdf_get_fvar (ng, model, ncname, &
2778 & 'xl', xl(ng), &
2779 & piofile = grd(ng)%pioFile)
2780 IF (founderror(exit_flag, noerror, __line__, myfile)) EXIT
2781!
2782! Read in basin Y-length.
2783!
2784 CASE ('el')
2785 CALL pio_netcdf_get_fvar (ng, model, ncname, &
2786 & 'el', el(ng), &
2787 & piofile = grd(ng)%pioFile)
2788 IF (founderror(exit_flag, noerror, __line__, myfile)) EXIT
2789!
2790! Read in bathymetry.
2791!
2792 CASE ('h')
2793 piovar%vd=var_desc(i)
2794 piovar%gtype=r2dvar
2795 IF (kind(grid(ng)%h).eq.8) THEN
2796 piovar%dkind=pio_double
2797 iodesc => iodesc_dp_r2dvar(ng)
2798 ELSE
2799 piovar%dkind=pio_real
2800 iodesc => iodesc_sp_r2dvar(ng)
2801 END IF
2802!
2803 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
2804 & var_name(i), piovar, &
2805 & 0, iodesc, vsize, &
2806 & lbi, ubi, lbj, ubj, &
2807 & fscl, fmin, fmax, &
2808# ifdef MASKING
2809 & grid(ng) % rmask, &
2810# endif
2811# ifdef CHECKSUM
2812 & grid(ng) % h, &
2813 & checksum = fhash)
2814# else
2815 & grid(ng) % h)
2816# endif
2817 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2818 exit_flag=2
2819 ioerror=status
2820 EXIT
2821 ELSE
2822# ifdef SINGLE_PRECISION
2823 hmin(ng)=real(fmin,dp)
2824 hmax(ng)=real(fmax,dp)
2825# else
2826 hmin(ng)=fmin
2827 hmax(ng)=fmax
2828# endif
2829 IF (master) THEN
2830 WRITE (stdout,30) 'bathymetry at RHO-points: h', &
2831 & ng, trim(ncname), hmin(ng), hmax(ng)
2832# ifdef CHECKSUM
2833 WRITE (stdout,60) fhash
2834# endif
2835 END IF
2836 END IF
2837# ifdef NESTING
2838 CALL fill_contact(ng, model, tile, &
2839 & cr, rcontact(cr)%Npoints, rcontact, &
2840 & r2dvar, var_name(i), spval_check, &
2841 & lbi, ubi, lbj, ubj, &
2842 & contact_metric(cr) % h, &
2843 & grid(ng) % h)
2844 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2845# endif
2846 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2847 CALL exchange_r2d_tile (ng, tile, &
2848 & lbi, ubi, lbj, ubj, &
2849 & grid(ng) % h)
2850 END IF
2851# ifdef DISTRIBUTE
2852 CALL mp_exchange2d (ng, tile, model, 1, &
2853 & lbi, ubi, lbj, ubj, &
2854 & nghostpoints, &
2855 & ewperiodic(ng), nsperiodic(ng), &
2856 & grid(ng) % h)
2857# endif
2858# ifdef MASKING
2859!
2860! Read in Land/Sea masking at RHO-points.
2861!
2862 CASE ('mask_rho')
2863 piovar%vd=var_desc(i)
2864 piovar%gtype=r2dvar
2865 IF (kind(grid(ng)%rmask).eq.8) THEN
2866 piovar%dkind=pio_double
2867 iodesc => iodesc_dp_r2dvar(ng)
2868 ELSE
2869 piovar%dkind=pio_real
2870 iodesc => iodesc_sp_r2dvar(ng)
2871 END IF
2872!
2873 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
2874 & var_name(i), piovar, &
2875 & 0, iodesc, vsize, &
2876 & lbi, ubi, lbj, ubj, &
2877 & fscl, fmin, fmax, &
2878 & grid(ng) % rmask, &
2879# ifdef CHECKSUM
2880 & grid(ng) % rmask, &
2881 & checksum = fhash)
2882# else
2883 & grid(ng) % rmask)
2884# endif
2885 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2886 exit_flag=2
2887 ioerror=status
2888 EXIT
2889 ELSE
2890 IF (master) THEN
2891 WRITE (stdout,30) 'mask on RHO-points: mask_rho', &
2892 & ng, trim(ncname), fmin, fmax
2893# ifdef CHECKSUM
2894 WRITE (stdout,60) fhash
2895# endif
2896 END IF
2897 END IF
2898# ifdef NESTING
2899 CALL fill_contact(ng, model, tile, &
2900 & cr, rcontact(cr)%Npoints, rcontact, &
2901 & r2dvar, 'rmask', spval_check, &
2902 & lbi, ubi, lbj, ubj, &
2903 & contact_metric(cr) % rmask, &
2904 & grid(ng) % rmask)
2905 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2906# endif
2907 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2908 CALL exchange_r2d_tile (ng, tile, &
2909 & lbi, ubi, lbj, ubj, &
2910 & grid(ng) % rmask)
2911 END IF
2912# ifdef DISTRIBUTE
2913 CALL mp_exchange2d (ng, tile, model, 1, &
2914 & lbi, ubi, lbj, ubj, &
2915 & nghostpoints, &
2916 & ewperiodic(ng), nsperiodic(ng), &
2917 & grid(ng) % rmask)
2918# endif
2919!
2920! Read in Land/Sea masking at U-points.
2921!
2922 CASE ('mask_u')
2923 piovar%vd=var_desc(i)
2924 piovar%gtype=u2dvar
2925 IF (kind(grid(ng)%umask).eq.8) THEN
2926 piovar%dkind=pio_double
2927 iodesc => iodesc_dp_u2dvar(ng)
2928 ELSE
2929 piovar%dkind=pio_real
2930 iodesc => iodesc_sp_u2dvar(ng)
2931 END IF
2932!
2933 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
2934 & var_name(i), piovar, &
2935 & 0, iodesc, vsize, &
2936 & lbi, ubi, lbj, ubj, &
2937 & fscl, fmin, fmax, &
2938 & grid(ng) % umask, &
2939# ifdef CHECKSUM
2940 & grid(ng) % umask, &
2941 & checksum = fhash)
2942# else
2943 & grid(ng) % umask)
2944# endif
2945 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2946 exit_flag=2
2947 ioerror=status
2948 EXIT
2949 ELSE
2950 IF (master) THEN
2951 WRITE (stdout,30) 'mask on U-points: mask_u', &
2952 & ng, trim(ncname), fmin, fmax
2953# ifdef CHECKSUM
2954 WRITE (stdout,60) fhash
2955# endif
2956 END IF
2957 END IF
2958# ifdef NESTING
2959 CALL fill_contact(ng, model, tile, &
2960 & cr, ucontact(cr)%Npoints, ucontact, &
2961 & u2dvar, 'umask', spval_check, &
2962 & lbi, ubi, lbj, ubj, &
2963 & contact_metric(cr) % umask, &
2964 & grid(ng) % umask)
2965 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2966# endif
2967 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2968 CALL exchange_u2d_tile (ng, tile, &
2969 & lbi, ubi, lbj, ubj, &
2970 & grid(ng) % umask)
2971 END IF
2972# ifdef DISTRIBUTE
2973 CALL mp_exchange2d (ng, tile, model, 1, &
2974 & lbi, ubi, lbj, ubj, &
2975 & nghostpoints, &
2976 & ewperiodic(ng), nsperiodic(ng), &
2977 & grid(ng) % umask)
2978# endif
2979!
2980! Read in Land/Sea masking at V-points.
2981!
2982 CASE ('mask_v')
2983 piovar%vd=var_desc(i)
2984 piovar%gtype=v2dvar
2985 IF (kind(grid(ng)%vmask).eq.8) THEN
2986 piovar%dkind=pio_double
2987 iodesc => iodesc_dp_v2dvar(ng)
2988 ELSE
2989 piovar%dkind=pio_real
2990 iodesc => iodesc_sp_v2dvar(ng)
2991 END IF
2992!
2993 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
2994 & var_name(i), piovar, &
2995 & 0, iodesc, vsize, &
2996 & lbi, ubi, lbj, ubj, &
2997 & fscl, fmin, fmax, &
2998 & grid(ng) % vmask, &
2999# ifdef CHECKSUM
3000 & grid(ng) % vmask, &
3001 & checksum = fhash)
3002# else
3003 & grid(ng) % vmask)
3004# endif
3005 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3006 exit_flag=2
3007 ioerror=status
3008 EXIT
3009 ELSE
3010 IF (master) THEN
3011 WRITE (stdout,30) 'mask on V-points: mask_v', &
3012 & ng, trim(ncname), fmin, fmax
3013# ifdef CHECKSUM
3014 WRITE (stdout,60) fhash
3015# endif
3016 END IF
3017 END IF
3018# ifdef NESTING
3019 CALL fill_contact(ng, model, tile, &
3020 & cr, vcontact(cr)%Npoints, vcontact, &
3021 & v2dvar, 'vmask', spval_check, &
3022 & lbi, ubi, lbj, ubj, &
3023 & contact_metric(cr) % vmask, &
3024 & grid(ng) % vmask)
3025 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3026# endif
3027 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3028 CALL exchange_v2d_tile (ng, tile, &
3029 & lbi, ubi, lbj, ubj, &
3030 & grid(ng) % vmask)
3031 END IF
3032# ifdef DISTRIBUTE
3033 CALL mp_exchange2d (ng, tile, model, 1, &
3034 & lbi, ubi, lbj, ubj, &
3035 & nghostpoints, &
3036 & ewperiodic(ng), nsperiodic(ng), &
3037 & grid(ng) % vmask)
3038# endif
3039!
3040! Read in Land/Sea masking at PSI-points.
3041!
3042 CASE ('mask_psi')
3043 piovar%vd=var_desc(i)
3044 piovar%gtype=p2dvar
3045 IF (kind(grid(ng)%pmask).eq.8) THEN
3046 piovar%dkind=pio_double
3047 iodesc => iodesc_dp_p2dvar(ng)
3048 ELSE
3049 piovar%dkind=pio_real
3050 iodesc => iodesc_sp_p2dvar(ng)
3051 END IF
3052!
3053 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3054 & var_name(i), piovar, &
3055 & 0, iodesc, vsize, &
3056 & lbi, ubi, lbj, ubj, &
3057 & fscl, fmin, fmax, &
3058 & grid(ng) % pmask, &
3059# ifdef CHECKSUM
3060 & grid(ng) % pmask, &
3061 & checksum = fhash)
3062# else
3063 & grid(ng) % pmask)
3064# endif
3065 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3066 exit_flag=2
3067 ioerror=status
3068 EXIT
3069 ELSE
3070 IF (master) THEN
3071 WRITE (stdout,30) 'mask on PSI-points: mask_psi', &
3072 & ng, trim(ncname), fmin, fmax
3073# ifdef CHECKSUM
3074 WRITE (stdout,60) fhash
3075# endif
3076 END IF
3077 END IF
3078 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3079 CALL exchange_p2d_tile (ng, tile, &
3080 & lbi, ubi, lbj, ubj, &
3081 & grid(ng) % pmask)
3082 END IF
3083# ifdef DISTRIBUTE
3084 CALL mp_exchange2d (ng, tile, model, 1, &
3085 & lbi, ubi, lbj, ubj, &
3086 & nghostpoints, &
3087 & ewperiodic(ng), nsperiodic(ng), &
3088 & grid(ng) % pmask)
3089# endif
3090# endif
3091# ifdef ICESHELF
3092!
3093! Read in ice shelf thickness.
3094!
3095 CASE ('zice')
3096 piovar%vd=var_desc(i)
3097 piovar%gtype=r2dvar
3098 IF (kind(grid(ng)%zice).eq.8) THEN
3099 piovar%dkind=pio_double
3100 iodesc => iodesc_dp_r2dvar(ng)
3101 ELSE
3102 piovar%dkind=pio_real
3103 iodesc => iodesc_sp_r2dvar(ng)
3104 END IF
3105!
3106 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3107 & var_name(i), piovar, &
3108 & 0, iodesc, vsize, &
3109 & lbi, ubi, lbj, ubj, &
3110 & fscl, fmin, fmax, &
3111# ifdef MASKING
3112 & grid(ng) % rmask, &
3113# endif
3114# ifdef CHECKSUM
3115 & grid(ng) % zice, &
3116 & checksum = fhash)
3117# else
3118 & grid(ng) % zice)
3119# endif
3120 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3121 exit_flag=2
3122 ioerror=status
3123 EXIT
3124 ELSE
3125 IF (master) THEN
3126 WRITE (stdout,30) 'ice shelf thickness: zice', &
3127 & ng, trim(ncname), fmin, fmax
3128# ifdef CHECKSUM
3129 WRITE (stdout,60) fhash
3130# endif
3131 END IF
3132 END IF
3133 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3134 CALL exchange_r2d_tile (ng, tile, &
3135 & lbi, ubi, lbj, ubj, &
3136 & grid(ng) % zice)
3137 END IF
3138# ifdef DISTRIBUTE
3139 CALL mp_exchange2d (ng, tile, model, 1, &
3140 & lbi, ubi, lbj, ubj, &
3141 & nghostpoints, &
3142 & ewperiodic(ng), nsperiodic(ng), &
3143 & grid(ng) % zice)
3144# endif
3145# endif
3146# if defined WTYPE_GRID && \
3147 (defined lmd_skpp || defined solar_source) && \
3148 !defined ANA_WTYPE
3149!
3150! Read in Jerlov water type.
3151!
3152 CASE ('wtype_grid')
3153 piovar%vd=var_desc(i)
3154 piovar%gtype=r2dvar
3155 IF (kind(grid(ng)%Jwtype).eq.8) THEN
3156 piovar%dkind=pio_double
3157 iodesc => iodesc_dp_r2dvar(ng)
3158 ELSE
3159 piovar%dkind=pio_real
3160 iodesc => iodesc_sp_r2dvar(ng)
3161 END IF
3162!
3163 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3164 & var_name(i), piovar, &
3165 & 0, iodesc, vsize, &
3166 & lbi, ubi, lbj, ubj, &
3167 & fscl, fmin, fmax, &
3168# ifdef MASKING
3169 & grid(ng) % rmask, &
3170# endif
3171# ifdef CHECKSUM
3172 & mixing(ng) % Jwtype, &
3173 & checksum = fhash)
3174# else
3175 & mixing(ng) % Jwtype)
3176# endif
3177 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3178 exit_flag=2
3179 ioerror=status
3180 EXIT
3181 ELSE
3182 IF (master) THEN
3183 WRITE (stdout,30) 'Jerlov water type: wtype_grid', &
3184 & ng, trim(ncname), fmin, fmax
3185# ifdef CHECKSUM
3186 WRITE (stdout,60) fhash
3187# endif
3188 END IF
3189 END IF
3190 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3191 CALL exchange_r2d_tile (ng, tile, &
3192 & lbi, ubi, lbj, ubj, &
3193 & mixing(ng) % Jwtype)
3194 END IF
3195# ifdef DISTRIBUTE
3196 CALL mp_exchange2d (ng, tile, model, 1, &
3197 & lbi, ubi, lbj, ubj, &
3198 & nghostpoints, &
3199 & ewperiodic(ng), nsperiodic(ng), &
3200 & mixing(ng) % Jwtype)
3201# endif
3202# endif
3203# ifndef ANA_SPONGE
3204!
3205! Read in horizontal, spatially varying factor to increase/decrease
3206! viscosity (nondimensional) in specific areas of the domain.
3207!
3208 CASE ('visc_factor')
3209 IF (luvsponge(ng)) THEN
3210 piovar%vd=var_desc(i)
3211 piovar%gtype=r2dvar
3212 IF (kind(mixing(ng)%visc_factor).eq.8) THEN
3213 piovar%dkind=pio_double
3214 iodesc => iodesc_dp_r2dvar(ng)
3215 ELSE
3216 piovar%dkind=pio_real
3217 iodesc => iodesc_sp_r2dvar(ng)
3218 END IF
3219!
3220 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3221 & var_name(i), piovar, &
3222 & 0, iodesc, vsize, &
3223 & lbi, ubi, lbj, ubj, &
3224 & fscl, fmin, fmax, &
3225# ifdef MASKING
3226 & grid(ng) % rmask, &
3227# endif
3228# ifdef CHECKSUM
3229 & mixing(ng) % visc_factor, &
3230 & checksum = fhash)
3231# else
3232 & mixing(ng) % visc_factor)
3233# endif
3234 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3235 exit_flag=2
3236 ioerror=status
3237 EXIT
3238 ELSE
3239 IF (master) THEN
3240 WRITE (stdout,30) 'horizontal viscosity sponge '// &
3241 & 'factor: visc_factor', &
3242 & ng, trim(ncname), fmin, fmax
3243# ifdef CHECKSUM
3244 WRITE (stdout,60) fhash
3245# endif
3246 END IF
3247 END IF
3248 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3249 CALL exchange_r2d_tile (ng, tile, &
3250 & lbi, ubi, lbj, ubj, &
3251 & mixing(ng) % visc_factor)
3252 END IF
3253# ifdef DISTRIBUTE
3254 CALL mp_exchange2d (ng, tile, model, 1, &
3255 & lbi, ubi, lbj, ubj, &
3256 & nghostpoints, &
3257 & ewperiodic(ng), nsperiodic(ng), &
3258 & mixing(ng) % visc_factor)
3259# endif
3260 END IF
3261
3262# ifdef SOLVE3D
3263!
3264! Read in horizontal, spatially varying factor to increase/decrease
3265! diffusivity (nondimensional) in specific areas of the domain.
3266!
3267 CASE ('diff_factor')
3268 IF (any(ltracersponge(:,ng))) THEN
3269 piovar%vd=var_desc(i)
3270 piovar%gtype=r2dvar
3271 IF (kind(mixing(ng)%diff_factor).eq.8) THEN
3272 piovar%dkind=pio_double
3273 iodesc => iodesc_dp_r2dvar(ng)
3274 ELSE
3275 piovar%dkind=pio_real
3276 iodesc => iodesc_sp_r2dvar(ng)
3277 END IF
3278!
3279 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3280 & var_name(i), piovar, &
3281 & 0, iodesc, vsize, &
3282 & lbi, ubi, lbj, ubj, &
3283 & fscl, fmin, fmax, &
3284# ifdef MASKING
3285 & grid(ng) % rmask, &
3286# endif
3287# ifdef CHECKSUM
3288 & mixing(ng) % diff_factor, &
3289 & checksum = fhash)
3290# else
3291 & mixing(ng) % diff_factor)
3292# endif
3293 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3294 exit_flag=2
3295 ioerror=status
3296 EXIT
3297 ELSE
3298 IF (master) THEN
3299 WRITE (stdout,30) 'horizontal diffusivity sponge '// &
3300 & 'factor: diff_factor', &
3301 & ng, trim(ncname), fmin, fmax
3302# ifdef CHECKSUM
3303 WRITE (stdout,60) fhash
3304# endif
3305 END IF
3306 END IF
3307 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3308 CALL exchange_r2d_tile (ng, tile, &
3309 & lbi, ubi, lbj, ubj, &
3310 & mixing(ng) % diff_factor)
3311 END IF
3312# ifdef DISTRIBUTE
3313 CALL mp_exchange2d (ng, tile, model, 1, &
3314 & lbi, ubi, lbj, ubj, &
3315 & nghostpoints, &
3316 & ewperiodic(ng), nsperiodic(ng), &
3317 & mixing(ng) % diff_factor)
3318# endif
3319 END IF
3320# endif
3321# endif
3322!
3323! Read in Coriolis parameter.
3324!
3325 CASE ('f')
3326 piovar%vd=var_desc(i)
3327 piovar%gtype=r2dvar
3328 IF (kind(grid(ng)%f).eq.8) THEN
3329 piovar%dkind=pio_double
3330 iodesc => iodesc_dp_r2dvar(ng)
3331 ELSE
3332 piovar%dkind=pio_real
3333 iodesc => iodesc_sp_r2dvar(ng)
3334 END IF
3335!
3336 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3337 & var_name(i), piovar, &
3338 & 0, iodesc, vsize, &
3339 & lbi, ubi, lbj, ubj, &
3340 & fscl, fmin, fmax, &
3341# ifdef MASKING
3342 & grid(ng) % rmask, &
3343# endif
3344# ifdef CHECKSUM
3345 & grid(ng) % f, &
3346 & checksum = fhash)
3347# else
3348 & grid(ng) % f)
3349# endif
3350 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3351 exit_flag=2
3352 ioerror=status
3353 EXIT
3354 ELSE
3355 IF (master) THEN
3356 WRITE (stdout,30) 'Coriolis parameter at RHO-points: f',&
3357 & ng, trim(ncname), fmin, fmax
3358# ifdef CHECKSUM
3359 WRITE (stdout,60) fhash
3360# endif
3361 END IF
3362 END IF
3363# ifdef NESTING
3364 CALL fill_contact(ng, model, tile, &
3365 & cr, rcontact(cr)%Npoints, rcontact, &
3366 & r2dvar, var_name(i), spval_check, &
3367 & lbi, ubi, lbj, ubj, &
3368 & contact_metric(cr) % f, &
3369 & grid(ng) % f)
3370 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3371# endif
3372 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3373 CALL exchange_r2d_tile (ng, tile, &
3374 & lbi, ubi, lbj, ubj, &
3375 & grid(ng) % f)
3376 END IF
3377# ifdef DISTRIBUTE
3378 CALL mp_exchange2d (ng, tile, model, 1, &
3379 & lbi, ubi, lbj, ubj, &
3380 & nghostpoints, &
3381 & ewperiodic(ng), nsperiodic(ng), &
3382 & grid(ng) % f)
3383# endif
3384!
3385! Read in coordinate transfomation metrics (m) associated with the
3386! differential distances in XI.
3387!
3388 CASE ('pm')
3389 piovar%vd=var_desc(i)
3390 piovar%gtype=r2dvar
3391 IF (kind(grid(ng)%pm).eq.8) THEN
3392 piovar%dkind=pio_double
3393 iodesc => iodesc_dp_r2dvar(ng)
3394 ELSE
3395 piovar%dkind=pio_real
3396 iodesc => iodesc_sp_r2dvar(ng)
3397 END IF
3398!
3399 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3400 & var_name(i), piovar, &
3401 & 0, iodesc, vsize, &
3402 & lbi, ubi, lbj, ubj, &
3403 & fscl, fmin, fmax, &
3404# ifdef MASKING
3405 & grid(ng) % rmask, &
3406# endif
3407# ifdef CHECKSUM
3408 & grid(ng) % pm, &
3409 & checksum = fhash)
3410# else
3411 & grid(ng) % pm)
3412# endif
3413 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3414 exit_flag=2
3415 ioerror=status
3416 EXIT
3417 ELSE
3418 IF (master) THEN
3419 WRITE (stdout,30) 'reciprocal XI-grid spacing: pm', &
3420 & ng, trim(ncname), fmin, fmax
3421# ifdef CHECKSUM
3422 WRITE (stdout,60) fhash
3423# endif
3424 END IF
3425 END IF
3426# ifdef NESTING
3427 CALL fill_contact(ng, model, tile, &
3428 & cr, rcontact(cr)%Npoints, rcontact, &
3429 & r2dvar, var_name(i), spval_check, &
3430 & lbi, ubi, lbj, ubj, &
3431 & contact_metric(cr) % pm, &
3432 & grid(ng) % pm)
3433 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3434# endif
3435 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3436 CALL exchange_r2d_tile (ng, tile, &
3437 & lbi, ubi, lbj, ubj, &
3438 & grid(ng) % pm)
3439 END IF
3440# ifdef DISTRIBUTE
3441 CALL mp_exchange2d (ng, tile, model, 1, &
3442 & lbi, ubi, lbj, ubj, &
3443 & nghostpoints, &
3444 & ewperiodic(ng), nsperiodic(ng), &
3445 & grid(ng) % pm)
3446# endif
3447!
3448! Read in coordinate transfomation metrics (n) associated with the
3449! differential distances in ETA.
3450!
3451 CASE ('pn')
3452 piovar%vd=var_desc(i)
3453 piovar%gtype=r2dvar
3454 IF (kind(grid(ng)%pn).eq.8) THEN
3455 piovar%dkind=pio_double
3456 iodesc => iodesc_dp_r2dvar(ng)
3457 ELSE
3458 piovar%dkind=pio_real
3459 iodesc => iodesc_sp_r2dvar(ng)
3460 END IF
3461!
3462 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3463 & var_name(i), piovar, &
3464 & 0, iodesc, vsize, &
3465 & lbi, ubi, lbj, ubj, &
3466 & fscl, fmin, fmax, &
3467# ifdef MASKING
3468 & grid(ng) % rmask, &
3469# endif
3470# ifdef CHECKSUM
3471 & grid(ng) % pn, &
3472 & checksum = fhash)
3473# else
3474 & grid(ng) % pn)
3475# endif
3476 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3477 exit_flag=2
3478 ioerror=status
3479 EXIT
3480 ELSE
3481 IF (master) THEN
3482 WRITE (stdout,30) 'reciprocal ETA-grid spacing: pn', &
3483 & ng, trim(ncname), fmin, fmax
3484# ifdef CHECKSUM
3485 WRITE (stdout,60) fhash
3486# endif
3487 END IF
3488 END IF
3489# ifdef NESTING
3490 CALL fill_contact(ng, model, tile, &
3491 & cr, rcontact(cr)%Npoints, rcontact, &
3492 & r2dvar, var_name(i), spval_check, &
3493 & lbi, ubi, lbj, ubj, &
3494 & contact_metric(cr) % pn, &
3495 & grid(ng) % pn)
3496 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3497# endif
3498 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3499 CALL exchange_r2d_tile (ng, tile, &
3500 & lbi, ubi, lbj, ubj, &
3501 & grid(ng) % pn)
3502 END IF
3503# ifdef DISTRIBUTE
3504 CALL mp_exchange2d (ng, tile, model, 1, &
3505 & lbi, ubi, lbj, ubj, &
3506 & nghostpoints, &
3507 & ewperiodic(ng), nsperiodic(ng), &
3508 & grid(ng) % pn)
3509# endif
3510# if (defined CURVGRID && defined UV_ADV)
3511!
3512! Read in derivatives of inverse metrics factors: d(m)/d(eta).
3513!
3514 CASE ('dmde')
3515 piovar%vd=var_desc(i)
3516 piovar%gtype=r2dvar
3517 IF (kind(grid(ng)%dmde).eq.8) THEN
3518 piovar%dkind=pio_double
3519 iodesc => iodesc_dp_r2dvar(ng)
3520 ELSE
3521 piovar%dkind=pio_real
3522 iodesc => iodesc_sp_r2dvar(ng)
3523 END IF
3524!
3525 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3526 & var_name(i), piovar, &
3527 & 0, iodesc, vsize, &
3528 & lbi, ubi, lbj, ubj, &
3529 & fscl, fmin, fmax, &
3530# ifdef MASKING
3531 & grid(ng) % rmask, &
3532# endif
3533# ifdef CHECKSUM
3534 & grid(ng) % dmde, &
3535 & checksum = fhash)
3536# else
3537 & grid(ng) % dmde)
3538# endif
3539 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3540 exit_flag=2
3541 ioerror=status
3542 EXIT
3543 ELSE
3544 IF (master) THEN
3545 WRITE (stdout,30) 'ETA-derivative of inverse metric '// &
3546 & 'factor pm: dmde', &
3547 & ng, trim(ncname), fmin, fmax
3548# ifdef CHECKSUM
3549 WRITE (stdout,60) fhash
3550# endif
3551 END IF
3552 END IF
3553# ifdef NESTING
3554 CALL fill_contact(ng, model, tile, &
3555 & cr, rcontact(cr)%Npoints, rcontact, &
3556 & r2dvar, var_name(i), spval_check, &
3557 & lbi, ubi, lbj, ubj, &
3558 & contact_metric(cr) % dmde, &
3559 & grid(ng) % dmde)
3560 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3561# endif
3562 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3563 CALL exchange_r2d_tile (ng, tile, &
3564 & lbi, ubi, lbj, ubj, &
3565 & grid(ng) % dmde)
3566 END IF
3567# ifdef DISTRIBUTE
3568 CALL mp_exchange2d (ng, tile, model, 1, &
3569 & lbi, ubi, lbj, ubj, &
3570 & nghostpoints, &
3571 & ewperiodic(ng), nsperiodic(ng), &
3572 & grid(ng) % dmde)
3573# endif
3574!
3575! Read in derivatives of inverse metrics factors: d(n)/d(xi).
3576!
3577 CASE ('dndx')
3578 piovar%vd=var_desc(i)
3579 piovar%gtype=r2dvar
3580 IF (kind(grid(ng)%dndx).eq.8) THEN
3581 piovar%dkind=pio_double
3582 iodesc => iodesc_dp_r2dvar(ng)
3583 ELSE
3584 piovar%dkind=pio_real
3585 iodesc => iodesc_sp_r2dvar(ng)
3586 END IF
3587!
3588 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3589 & var_name(i), piovar, &
3590 & 0, iodesc, vsize, &
3591 & lbi, ubi, lbj, ubj, &
3592 & fscl, fmin, fmax, &
3593# ifdef MASKING
3594 & grid(ng) % rmask, &
3595# endif
3596# ifdef CHECKSUM
3597 & grid(ng) % dndx, &
3598 & checksum = fhash)
3599# else
3600 & grid(ng) % dndx)
3601# endif
3602 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3603 exit_flag=2
3604 ioerror=status
3605 EXIT
3606 ELSE
3607 IF (master) THEN
3608 WRITE (stdout,30) 'XI-derivative of inverse metric '// &
3609 & 'factor pn: dndx', &
3610 & ng, trim(ncname), fmin, fmax
3611# ifdef CHECKSUM
3612 WRITE (stdout,60) fhash
3613# endif
3614 END IF
3615 END IF
3616# ifdef NESTING
3617 CALL fill_contact(ng, model, tile, &
3618 & cr, rcontact(cr)%Npoints, rcontact, &
3619 & r2dvar, var_name(i), spval_check, &
3620 & lbi, ubi, lbj, ubj, &
3621 & contact_metric(cr) % dndx, &
3622 & grid(ng) % dndx)
3623 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3624# endif
3625 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3626 CALL exchange_r2d_tile (ng, tile, &
3627 & lbi, ubi, lbj, ubj, &
3628 & grid(ng) % dndx)
3629 END IF
3630# ifdef DISTRIBUTE
3631 CALL mp_exchange2d (ng, tile, model, 1, &
3632 & lbi, ubi, lbj, ubj, &
3633 & nghostpoints, &
3634 & ewperiodic(ng), nsperiodic(ng), &
3635 & grid(ng) % dndx)
3636# endif
3637# endif
3638!
3639! Read in X-coordinates at PSI-points.
3640!
3641 CASE ('x_psi')
3642 piovar%vd=var_desc(i)
3643 piovar%gtype=p2dvar
3644 IF (kind(grid(ng)%xp).eq.8) THEN
3645 piovar%dkind=pio_double
3646 iodesc => iodesc_dp_p2dvar(ng)
3647 ELSE
3648 piovar%dkind=pio_real
3649 iodesc => iodesc_sp_p2dvar(ng)
3650 END IF
3651!
3652 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3653 & var_name(i), piovar, &
3654 & 0, iodesc, vsize, &
3655 & lbi, ubi, lbj, ubj, &
3656 & fscl, fmin, fmax, &
3657# ifdef MASKING
3658 & grid(ng) % pmask, &
3659# endif
3660# ifdef CHECKSUM
3661 & grid(ng) % xp, &
3662 & checksum = fhash)
3663# else
3664 & grid(ng) % xp)
3665# endif
3666 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3667 exit_flag=2
3668 ioerror=status
3669 EXIT
3670 ELSE
3671 IF (master) THEN
3672 WRITE (stdout,30) 'x-location of PSI-points: x_psi', &
3673 & ng, trim(ncname), fmin, fmax
3674# ifdef CHECKSUM
3675 WRITE (stdout,60) fhash
3676# endif
3677 END IF
3678 END IF
3679# ifdef DISTRIBUTE
3680 CALL mp_exchange2d (ng, tile, model, 1, &
3681 & lbi, ubi, lbj, ubj, &
3682 & nghostpoints, &
3683 & .false., .false., &
3684 & grid(ng) % xp)
3685# endif
3686!
3687! Read in Y-coordinates at PSI-points.
3688!
3689 CASE ('y_psi')
3690 piovar%vd=var_desc(i)
3691 piovar%gtype=p2dvar
3692 IF (kind(grid(ng)%yp).eq.8) THEN
3693 piovar%dkind=pio_double
3694 iodesc => iodesc_dp_p2dvar(ng)
3695 ELSE
3696 piovar%dkind=pio_real
3697 iodesc => iodesc_sp_p2dvar(ng)
3698 END IF
3699!
3700 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3701 & var_name(i), piovar, &
3702 & 0, iodesc, vsize, &
3703 & lbi, ubi, lbj, ubj, &
3704 & fscl, fmin, fmax, &
3705# ifdef MASKING
3706 & grid(ng) % pmask, &
3707# endif
3708# ifdef CHECKSUM
3709 & grid(ng) % yp, &
3710 & checksum = fhash)
3711# else
3712 & grid(ng) % yp)
3713# endif
3714 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3715 exit_flag=2
3716 ioerror=status
3717 EXIT
3718 ELSE
3719 IF (master) THEN
3720 WRITE (stdout,30) 'y-location of PSI-points: y-psi', &
3721 & ng, trim(ncname), fmin, fmax
3722# ifdef CHECKSUM
3723 WRITE (stdout,60) fhash
3724# endif
3725 END IF
3726 END IF
3727# ifdef DISTRIBUTE
3728 CALL mp_exchange2d (ng, tile, model, 1, &
3729 & lbi, ubi, lbj, ubj, &
3730 & nghostpoints, &
3731 & .false., .false., &
3732 & grid(ng) % yp)
3733# endif
3734!
3735! Read in X-coordinates at RHO-points.
3736!
3737 CASE ('x_rho')
3738 piovar%vd=var_desc(i)
3739 piovar%gtype=r2dvar
3740 IF (kind(grid(ng)%xr).eq.8) THEN
3741 piovar%dkind=pio_double
3742 iodesc => iodesc_dp_r2dvar(ng)
3743 ELSE
3744 piovar%dkind=pio_real
3745 iodesc => iodesc_sp_r2dvar(ng)
3746 END IF
3747!
3748 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3749 & var_name(i), piovar, &
3750 & 0, iodesc, vsize, &
3751 & lbi, ubi, lbj, ubj, &
3752 & fscl, fmin, fmax, &
3753# ifdef MASKING
3754 & grid(ng) % rmask, &
3755# endif
3756# ifdef CHECKSUM
3757 & grid(ng) % xr, &
3758 & checksum = fhash)
3759# else
3760 & grid(ng) % xr)
3761# endif
3762 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3763 exit_flag=2
3764 ioerror=status
3765 EXIT
3766 ELSE
3767 IF (master) THEN
3768 WRITE (stdout,30) 'x-location of RHO-points: x-rho', &
3769 & ng, trim(ncname), fmin, fmax
3770# ifdef CHECKSUM
3771 WRITE (stdout,60) fhash
3772# endif
3773 END IF
3774 END IF
3775# ifdef NESTING
3776 IF (.not.spherical) THEN
3777 CALL fill_contact(ng, model, tile, &
3778 & cr, rcontact(cr)%Npoints, rcontact, &
3779 & r2dvar, var_name(i), spval_check, &
3780 & lbi, ubi, lbj, ubj, &
3781 & contact_metric(cr) % Xr, &
3782 & grid(ng) % xr)
3783 IF (founderror(exit_flag, noerror, &
3784 & __line__, myfile)) RETURN
3785 END IF
3786# endif
3787# ifdef DISTRIBUTE
3788 CALL mp_exchange2d (ng, tile, model, 1, &
3789 & lbi, ubi, lbj, ubj, &
3790 & nghostpoints, &
3791 & .false., .false., &
3792 & grid(ng) % xr)
3793# endif
3794!
3795! Read in Y-coordinates at RHO-points.
3796!
3797 CASE ('y_rho')
3798 piovar%vd=var_desc(i)
3799 piovar%gtype=r2dvar
3800 IF (kind(grid(ng)%yr).eq.8) THEN
3801 piovar%dkind=pio_double
3802 iodesc => iodesc_dp_r2dvar(ng)
3803 ELSE
3804 piovar%dkind=pio_real
3805 iodesc => iodesc_sp_r2dvar(ng)
3806 END IF
3807!
3808 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3809 & var_name(i), piovar, &
3810 & 0, iodesc, vsize, &
3811 & lbi, ubi, lbj, ubj, &
3812 & fscl, fmin, fmax, &
3813# ifdef MASKING
3814 & grid(ng) % rmask, &
3815# endif
3816# ifdef CHECKSUM
3817 & grid(ng) % yr, &
3818 & checksum = fhash)
3819# else
3820 & grid(ng) % yr)
3821# endif
3822 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3823 exit_flag=2
3824 ioerror=status
3825 EXIT
3826 ELSE
3827 IF (master) THEN
3828 WRITE (stdout,30) 'y-location of RHO-points: y_rho', &
3829 & ng, trim(ncname), fmin, fmax
3830# ifdef CHECKSUM
3831 WRITE (stdout,60) fhash
3832# endif
3833 END IF
3834 END IF
3835# ifdef NESTING
3836 IF (.not.spherical) THEN
3837 CALL fill_contact(ng, model, tile, &
3838 & cr, rcontact(cr)%Npoints, rcontact, &
3839 & r2dvar, var_name(i), spval_check, &
3840 & lbi, ubi, lbj, ubj, &
3841 & contact_metric(cr) % Yr, &
3842 & grid(ng) % yr)
3843 IF (founderror(exit_flag, noerror, &
3844 & __line__, myfile)) RETURN
3845 END IF
3846# endif
3847# ifdef DISTRIBUTE
3848 CALL mp_exchange2d (ng, tile, model, 1, &
3849 & lbi, ubi, lbj, ubj, &
3850 & nghostpoints, &
3851 & .false., .false., &
3852 & grid(ng) % yr)
3853# endif
3854!
3855! Read in X-coordinates at U-points.
3856!
3857 CASE ('x_u')
3858 piovar%vd=var_desc(i)
3859 piovar%gtype=u2dvar
3860 IF (kind(grid(ng)%xu).eq.8) THEN
3861 piovar%dkind=pio_double
3862 iodesc => iodesc_dp_u2dvar(ng)
3863 ELSE
3864 piovar%dkind=pio_real
3865 iodesc => iodesc_sp_u2dvar(ng)
3866 END IF
3867!
3868 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3869 & var_name(i), piovar, &
3870 & 0, iodesc, vsize, &
3871 & lbi, ubi, lbj, ubj, &
3872 & fscl, fmin, fmax, &
3873# ifdef MASKING
3874 & grid(ng) % umask, &
3875# endif
3876# ifdef CHECKSUM
3877 & grid(ng) % xu, &
3878 & checksum = fhash)
3879# else
3880 & grid(ng) % xu)
3881# endif
3882 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3883 exit_flag=2
3884 ioerror=status
3885 EXIT
3886 ELSE
3887 IF (master) THEN
3888 WRITE (stdout,30) 'x-location of U-points: x_u', &
3889 & ng, trim(ncname), fmin, fmax
3890# ifdef CHECKSUM
3891 WRITE (stdout,60) fhash
3892# endif
3893 END IF
3894 END IF
3895# ifdef NESTING
3896 IF (.not.spherical) THEN
3897 CALL fill_contact(ng, model, tile, &
3898 & cr, ucontact(cr)%Npoints, ucontact, &
3899 & u2dvar, var_name(i), spval_check, &
3900 & lbi, ubi, lbj, ubj, &
3901 & contact_metric(cr) % Xu, &
3902 & grid(ng) % xu)
3903 IF (founderror(exit_flag, noerror, &
3904 & __line__, myfile)) RETURN
3905 END IF
3906# endif
3907# ifdef DISTRIBUTE
3908 CALL mp_exchange2d (ng, tile, model, 1, &
3909 & lbi, ubi, lbj, ubj, &
3910 & nghostpoints, &
3911 & .false., .false., &
3912 & grid(ng) % xu)
3913# endif
3914!
3915! Read in Y-coordinates at U-points.
3916!
3917 CASE ('y_u')
3918 piovar%vd=var_desc(i)
3919 piovar%gtype=u2dvar
3920 IF (kind(grid(ng)%yu).eq.8) THEN
3921 piovar%dkind=pio_double
3922 iodesc => iodesc_dp_u2dvar(ng)
3923 ELSE
3924 piovar%dkind=pio_real
3925 iodesc => iodesc_sp_u2dvar(ng)
3926 END IF
3927!
3928 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3929 & var_name(i), piovar, &
3930 & 0, iodesc, vsize, &
3931 & lbi, ubi, lbj, ubj, &
3932 & fscl, fmin, fmax, &
3933# ifdef MASKING
3934 & grid(ng) % umask, &
3935# endif
3936# ifdef CHECKSUM
3937 & grid(ng) % yu, &
3938 & checksum = fhash)
3939# else
3940 & grid(ng) % yu)
3941# endif
3942 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3943 exit_flag=2
3944 ioerror=status
3945 EXIT
3946 ELSE
3947 IF (master) THEN
3948 WRITE (stdout,30) 'y-location of U-points: y_u', &
3949 & ng, trim(ncname), fmin, fmax
3950# ifdef CHECKSUM
3951 WRITE (stdout,60) fhash
3952# endif
3953 END IF
3954 END IF
3955# ifdef NESTING
3956 IF (.not.spherical) THEN
3957 CALL fill_contact(ng, model, tile, &
3958 & cr, ucontact(cr)%Npoints, ucontact, &
3959 & u2dvar, var_name(i), spval_check, &
3960 & lbi, ubi, lbj, ubj, &
3961 & contact_metric(cr) % Yu, &
3962 & grid(ng) % yu)
3963 IF (founderror(exit_flag, noerror, &
3964 & __line__, myfile)) RETURN
3965 END IF
3966# endif
3967# ifdef DISTRIBUTE
3968 CALL mp_exchange2d (ng, tile, model, 1, &
3969 & lbi, ubi, lbj, ubj, &
3970 & nghostpoints, &
3971 & .false., .false., &
3972 & grid(ng) % yu)
3973# endif
3974!
3975! Read in X-coordinates at V-points.
3976!
3977 CASE ('x_v')
3978 piovar%vd=var_desc(i)
3979 piovar%gtype=v2dvar
3980 IF (kind(grid(ng)%xv).eq.8) THEN
3981 piovar%dkind=pio_double
3982 iodesc => iodesc_dp_v2dvar(ng)
3983 ELSE
3984 piovar%dkind=pio_real
3985 iodesc => iodesc_sp_v2dvar(ng)
3986 END IF
3987!
3988 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3989 & var_name(i), piovar, &
3990 & 0, iodesc, vsize, &
3991 & lbi, ubi, lbj, ubj, &
3992 & fscl, fmin, fmax, &
3993# ifdef MASKING
3994 & grid(ng) % vmask, &
3995# endif
3996# ifdef CHECKSUM
3997 & grid(ng) % xv, &
3998 & checksum = fhash)
3999# else
4000 & grid(ng) % xv)
4001# endif
4002 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4003 exit_flag=2
4004 ioerror=status
4005 EXIT
4006 ELSE
4007 IF (master) THEN
4008 WRITE (stdout,30) 'x-location of V-points: x_v', &
4009 & ng, trim(ncname), fmin, fmax
4010# ifdef CHECKSUM
4011 WRITE (stdout,60) fhash
4012# endif
4013 END IF
4014 END IF
4015# ifdef NESTING
4016 IF (.not.spherical) THEN
4017 CALL fill_contact(ng, model, tile, &
4018 & cr, vcontact(cr)%Npoints, vcontact, &
4019 & v2dvar, var_name(i), spval_check, &
4020 & lbi, ubi, lbj, ubj, &
4021 & contact_metric(cr) % Xv, &
4022 & grid(ng) % xv)
4023 IF (founderror(exit_flag, noerror, &
4024 & __line__, myfile)) RETURN
4025 END IF
4026# endif
4027# ifdef DISTRIBUTE
4028 CALL mp_exchange2d (ng, tile, model, 1, &
4029 & lbi, ubi, lbj, ubj, &
4030 & nghostpoints, &
4031 & .false., .false., &
4032 & grid(ng) % xv)
4033# endif
4034!
4035! Read in Y-coordinates at V-points.
4036!
4037 CASE ('y_v')
4038 piovar%vd=var_desc(i)
4039 piovar%gtype=v2dvar
4040 IF (kind(grid(ng)%yv).eq.8) THEN
4041 piovar%dkind=pio_double
4042 iodesc => iodesc_dp_v2dvar(ng)
4043 ELSE
4044 piovar%dkind=pio_real
4045 iodesc => iodesc_sp_v2dvar(ng)
4046 END IF
4047!
4048 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4049 & var_name(i), piovar, &
4050 & 0, iodesc, vsize, &
4051 & lbi, ubi, lbj, ubj, &
4052 & fscl, fmin, fmax, &
4053# ifdef MASKING
4054 & grid(ng) % vmask, &
4055# endif
4056# ifdef CHECKSUM
4057 & grid(ng) % yv, &
4058 & checksum = fhash)
4059# else
4060 & grid(ng) % yv)
4061# endif
4062 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4063 exit_flag=2
4064 ioerror=status
4065 EXIT
4066 ELSE
4067 IF (master) THEN
4068 WRITE (stdout,30) 'y-location of V-points: y_v', &
4069 & ng, trim(ncname), fmin, fmax
4070# ifdef CHECKSUM
4071 WRITE (stdout,60) fhash
4072# endif
4073 END IF
4074 END IF
4075# ifdef NESTING
4076 IF (.not.spherical) THEN
4077 CALL fill_contact(ng, model, tile, &
4078 & cr, vcontact(cr)%Npoints, vcontact, &
4079 & v2dvar, var_name(i), spval_check, &
4080 & lbi, ubi, lbj, ubj, &
4081 & contact_metric(cr) % Yv, &
4082 & grid(ng) % yv)
4083 IF (founderror(exit_flag, noerror, &
4084 & __line__, myfile)) RETURN
4085 END IF
4086# endif
4087# ifdef DISTRIBUTE
4088 CALL mp_exchange2d (ng, tile, model, 1, &
4089 & lbi, ubi, lbj, ubj, &
4090 & nghostpoints, &
4091 & .false., .false., &
4092 & grid(ng) % yv)
4093# endif
4094!
4095! Read in longitude at PSI-points.
4096!
4097 CASE ('lon_psi')
4098 IF (spherical) THEN
4099 piovar%vd=var_desc(i)
4100 piovar%gtype=p2dvar
4101 IF (kind(grid(ng)%lonp).eq.8) THEN
4102 piovar%dkind=pio_double
4103 iodesc => iodesc_dp_p2dvar(ng)
4104 ELSE
4105 piovar%dkind=pio_real
4106 iodesc => iodesc_sp_p2dvar(ng)
4107 END IF
4108!
4109 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4110 & var_name(i), piovar, &
4111 & 0, iodesc, vsize, &
4112 & lbi, ubi, lbj, ubj, &
4113 & fscl, fmin, fmax, &
4114# ifdef MASKING
4115 & grid(ng) % pmask, &
4116# endif
4117# ifdef CHECKSUM
4118 & grid(ng) % lonp, &
4119 & checksum = fhash)
4120# else
4121 & grid(ng) % lonp)
4122# endif
4123 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4124 exit_flag=2
4125 ioerror=status
4126 EXIT
4127 ELSE
4128 IF (master) THEN
4129 WRITE (stdout,30) 'longitude of PSI-points: lon_psi', &
4130 & ng, trim(ncname), fmin, fmax
4131# ifdef CHECKSUM
4132 WRITE (stdout,60) fhash
4133# endif
4134 END IF
4135 END IF
4136# ifdef DISTRIBUTE
4137 CALL mp_exchange2d (ng, tile, model, 1, &
4138 & lbi, ubi, lbj, ubj, &
4139 & nghostpoints, &
4140 & .false., .false., &
4141 & grid(ng) % lonp)
4142# endif
4143 END IF
4144!
4145! Read in latitude at PSI-points.
4146!
4147 CASE ('lat_psi')
4148 IF (spherical) THEN
4149 piovar%vd=var_desc(i)
4150 piovar%gtype=p2dvar
4151 IF (kind(grid(ng)%latp).eq.8) THEN
4152 piovar%dkind=pio_double
4153 iodesc => iodesc_dp_p2dvar(ng)
4154 ELSE
4155 piovar%dkind=pio_real
4156 iodesc => iodesc_sp_p2dvar(ng)
4157 END IF
4158!
4159 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4160 & var_name(i), piovar, &
4161 & 0, iodesc, vsize, &
4162 & lbi, ubi, lbj, ubj, &
4163 & fscl, fmin, fmax, &
4164# ifdef MASKING
4165 & grid(ng) % pmask, &
4166# endif
4167# ifdef CHECKSUM
4168 & grid(ng) % latp, &
4169 & checksum = fhash)
4170# else
4171 & grid(ng) % latp)
4172# endif
4173 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4174 exit_flag=2
4175 ioerror=status
4176 EXIT
4177 ELSE
4178 IF (master) THEN
4179 WRITE (stdout,30) 'latitude of PSI-points lat_psi', &
4180 & ng, trim(ncname), fmin, fmax
4181# ifdef CHECKSUM
4182 WRITE (stdout,60) fhash
4183# endif
4184 END IF
4185 END IF
4186# ifdef DISTRIBUTE
4187 CALL mp_exchange2d (ng, tile, model, 1, &
4188 & lbi, ubi, lbj, ubj, &
4189 & nghostpoints, &
4190 & .false., .false., &
4191 & grid(ng) % latp)
4192# endif
4193 END IF
4194!
4195! Read in longitude at RHO-points.
4196!
4197 CASE ('lon_rho')
4198 IF (spherical) THEN
4199 piovar%vd=var_desc(i)
4200 piovar%gtype=r2dvar
4201 IF (kind(grid(ng)%lonr).eq.8) THEN
4202 piovar%dkind=pio_double
4203 iodesc => iodesc_dp_r2dvar(ng)
4204 ELSE
4205 piovar%dkind=pio_real
4206 iodesc => iodesc_sp_r2dvar(ng)
4207 END IF
4208!
4209 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4210 & var_name(i), piovar, &
4211 & 0, iodesc, vsize, &
4212 & lbi, ubi, lbj, ubj, &
4213 & fscl, lonmin(ng), lonmax(ng), &
4214# ifdef MASKING
4215 & grid(ng) % rmask, &
4216# endif
4217# ifdef CHECKSUM
4218 & grid(ng) % lonr, &
4219 & checksum = fhash)
4220# else
4221 & grid(ng) % lonr)
4222# endif
4223 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4224 exit_flag=2
4225 ioerror=status
4226 EXIT
4227 ELSE
4228 IF (master) THEN
4229 WRITE (stdout,30) 'longitude of RHO-points: lon_rho', &
4230 & ng, trim(ncname), &
4231 & lonmin(ng), lonmax(ng)
4232# ifdef CHECKSUM
4233 WRITE (stdout,60) fhash
4234# endif
4235 END IF
4236 END IF
4237# ifdef NESTING
4238 CALL fill_contact(ng, model, tile, &
4239 & cr, rcontact(cr)%Npoints, rcontact, &
4240 & r2dvar, var_name(i), spval_check, &
4241 & lbi, ubi, lbj, ubj, &
4242 & contact_metric(cr) % Xr, &
4243 & grid(ng) % lonr)
4244 IF (founderror(exit_flag, noerror, &
4245 & __line__, myfile)) RETURN
4246# endif
4247# ifdef DISTRIBUTE
4248 CALL mp_exchange2d (ng, tile, model, 1, &
4249 & lbi, ubi, lbj, ubj, &
4250 & nghostpoints, &
4251 & .false., .false., &
4252 & grid(ng) % lonr)
4253# endif
4254 END IF
4255!
4256! Read in latitude at RHO-points.
4257!
4258 CASE ('lat_rho')
4259 IF (spherical) THEN
4260 piovar%vd=var_desc(i)
4261 piovar%gtype=r2dvar
4262 IF (kind(grid(ng)%latr).eq.8) THEN
4263 piovar%dkind=pio_double
4264 iodesc => iodesc_dp_r2dvar(ng)
4265 ELSE
4266 piovar%dkind=pio_real
4267 iodesc => iodesc_sp_r2dvar(ng)
4268 END IF
4269!
4270 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4271 & var_name(i), piovar, &
4272 & 0, iodesc, vsize, &
4273 & lbi, ubi, lbj, ubj, &
4274 & fscl, latmin(ng), latmax(ng), &
4275# ifdef MASKING
4276 & grid(ng) % rmask, &
4277# endif
4278# ifdef CHECKSUM
4279 & grid(ng) % latr, &
4280 & checksum = fhash)
4281# else
4282 & grid(ng) % latr)
4283# endif
4284 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4285 exit_flag=2
4286 ioerror=status
4287 EXIT
4288 ELSE
4289 IF (master) THEN
4290 WRITE (stdout,30) 'latitude of RHO-points lat_rho', &
4291 & ng, trim(ncname), &
4292 & latmin(ng), latmax(ng)
4293# ifdef CHECKSUM
4294 WRITE (stdout,60) fhash
4295# endif
4296 END IF
4297 END IF
4298# ifdef NESTING
4299 CALL fill_contact(ng, model, tile, &
4300 & cr, rcontact(cr)%Npoints, rcontact, &
4301 & r2dvar, var_name(i), spval_check, &
4302 & lbi, ubi, lbj, ubj, &
4303 & contact_metric(cr) % Yr, &
4304 & grid(ng) % latr)
4305 IF (founderror(exit_flag, noerror, &
4306 & __line__, myfile)) RETURN
4307# endif
4308# ifdef DISTRIBUTE
4309 CALL mp_exchange2d (ng, tile, model, 1, &
4310 & lbi, ubi, lbj, ubj, &
4311 & nghostpoints, &
4312 & .false., .false., &
4313 & grid(ng) % latr)
4314# endif
4315 END IF
4316!
4317! Read in longitude at U-points.
4318!
4319 CASE ('lon_u')
4320 IF (spherical) THEN
4321 piovar%vd=var_desc(i)
4322 piovar%gtype=u2dvar
4323 IF (kind(grid(ng)%lonu).eq.8) THEN
4324 piovar%dkind=pio_double
4325 iodesc => iodesc_dp_u2dvar(ng)
4326 ELSE
4327 piovar%dkind=pio_real
4328 iodesc => iodesc_sp_u2dvar(ng)
4329 END IF
4330!
4331 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4332 & var_name(i), piovar, &
4333 & 0, iodesc, vsize, &
4334 & lbi, ubi, lbj, ubj, &
4335 & fscl, fmin, fmax, &
4336# ifdef MASKING
4337 & grid(ng) % umask, &
4338# endif
4339# ifdef CHECKSUM
4340 & grid(ng) % lonu, &
4341 & checksum = fhash)
4342# else
4343 & grid(ng) % lonu)
4344# endif
4345 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4346 exit_flag=2
4347 ioerror=status
4348 EXIT
4349 ELSE
4350 IF (master) THEN
4351 WRITE (stdout,30) 'longitude of U-points: lon_u', &
4352 & ng, trim(ncname), fmin, fmax
4353# ifdef CHECKSUM
4354 WRITE (stdout,60) fhash
4355# endif
4356 END IF
4357 END IF
4358# ifdef NESTING
4359 CALL fill_contact(ng, model, tile, &
4360 & cr, ucontact(cr)%Npoints, ucontact, &
4361 & u2dvar, var_name(i), spval_check, &
4362 & lbi, ubi, lbj, ubj, &
4363 & contact_metric(cr) % Xu, &
4364 & grid(ng) % lonu)
4365 IF (founderror(exit_flag, noerror, &
4366 & __line__, myfile)) RETURN
4367# endif
4368# ifdef DISTRIBUTE
4369 CALL mp_exchange2d (ng, tile, model, 1, &
4370 & lbi, ubi, lbj, ubj, &
4371 & nghostpoints, &
4372 & .false., .false., &
4373 & grid(ng) % lonu)
4374# endif
4375 END IF
4376!
4377! Read in latitude at U-points.
4378!
4379 CASE ('lat_u')
4380 IF (spherical) THEN
4381 piovar%vd=var_desc(i)
4382 piovar%gtype=u2dvar
4383 IF (kind(grid(ng)%latu).eq.8) THEN
4384 piovar%dkind=pio_double
4385 iodesc => iodesc_dp_u2dvar(ng)
4386 ELSE
4387 piovar%dkind=pio_real
4388 iodesc => iodesc_sp_u2dvar(ng)
4389 END IF
4390!
4391 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4392 & var_name(i), piovar, &
4393 & 0, iodesc, vsize, &
4394 & lbi, ubi, lbj, ubj, &
4395 & fscl, fmin, fmax, &
4396# ifdef MASKING
4397 & grid(ng) % umask, &
4398# endif
4399# ifdef CHECKSUM
4400 & grid(ng) % latu, &
4401 & checksum = fhash)
4402# else
4403 & grid(ng) % latu)
4404# endif
4405 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4406 exit_flag=2
4407 ioerror=status
4408 EXIT
4409 ELSE
4410 IF (master) THEN
4411 WRITE (stdout,30) 'latitude of U-points: lat_u', &
4412 & ng, trim(ncname), fmin, fmax
4413# ifdef CHECKSUM
4414 WRITE (stdout,60) fhash
4415# endif
4416 END IF
4417 END IF
4418# ifdef NESTING
4419 CALL fill_contact(ng, model, tile, &
4420 & cr, ucontact(cr)%Npoints, ucontact, &
4421 & u2dvar, var_name(i), spval_check, &
4422 & lbi, ubi, lbj, ubj, &
4423 & contact_metric(cr) % Yu, &
4424 & grid(ng) % latu)
4425 IF (founderror(exit_flag, noerror, &
4426 & __line__, myfile)) RETURN
4427# endif
4428# ifdef DISTRIBUTE
4429 CALL mp_exchange2d (ng, tile, model, 1, &
4430 & lbi, ubi, lbj, ubj, &
4431 & nghostpoints, &
4432 & .false., .false., &
4433 & grid(ng) % latu)
4434# endif
4435 END IF
4436!
4437! Read in longitude at V-points.
4438!
4439 CASE ('lon_v')
4440 IF (spherical) THEN
4441 piovar%vd=var_desc(i)
4442 piovar%gtype=v2dvar
4443 IF (kind(grid(ng)%lonv).eq.8) THEN
4444 piovar%dkind=pio_double
4445 iodesc => iodesc_dp_v2dvar(ng)
4446 ELSE
4447 piovar%dkind=pio_real
4448 iodesc => iodesc_sp_v2dvar(ng)
4449 END IF
4450!
4451 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4452 & var_name(i), piovar, &
4453 & 0, iodesc, vsize, &
4454 & lbi, ubi, lbj, ubj, &
4455 & fscl, fmin, fmax, &
4456# ifdef MASKING
4457 & grid(ng) % vmask, &
4458# endif
4459# ifdef CHECKSUM
4460 & grid(ng) % lonv, &
4461 & checksum = fhash)
4462# else
4463 & grid(ng) % lonv)
4464# endif
4465 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4466 exit_flag=2
4467 ioerror=status
4468 EXIT
4469 ELSE
4470 IF (master) THEN
4471 WRITE (stdout,30) 'longitude of V-points: lon_v', &
4472 & ng, trim(ncname), fmin, fmax
4473# ifdef CHECKSUM
4474 WRITE (stdout,60) fhash
4475# endif
4476 END IF
4477 END IF
4478# ifdef NESTING
4479 CALL fill_contact(ng, model, tile, &
4480 & cr, vcontact(cr)%Npoints, vcontact, &
4481 & v2dvar, var_name(i), spval_check, &
4482 & lbi, ubi, lbj, ubj, &
4483 & contact_metric(cr) % Xv, &
4484 & grid(ng) % lonv)
4485 IF (founderror(exit_flag, noerror, &
4486 & __line__, myfile)) RETURN
4487# endif
4488# ifdef DISTRIBUTE
4489 CALL mp_exchange2d (ng, tile, model, 1, &
4490 & lbi, ubi, lbj, ubj, &
4491 & nghostpoints, &
4492 & .false., .false., &
4493 & grid(ng) % lonv)
4494# endif
4495 END IF
4496!
4497! Read in latitude at V-points.
4498!
4499 CASE ('lat_v')
4500 IF (spherical) THEN
4501 piovar%vd=var_desc(i)
4502 piovar%gtype=v2dvar
4503 IF (kind(grid(ng)%latv).eq.8) THEN
4504 piovar%dkind=pio_double
4505 iodesc => iodesc_dp_v2dvar(ng)
4506 ELSE
4507 piovar%dkind=pio_real
4508 iodesc => iodesc_sp_v2dvar(ng)
4509 END IF
4510!
4511 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4512 & var_name(i), piovar, &
4513 & 0, iodesc, vsize, &
4514 & lbi, ubi, lbj, ubj, &
4515 & fscl, fmin, fmax, &
4516# ifdef MASKING
4517 & grid(ng) % vmask, &
4518# endif
4519# ifdef CHECKSUM
4520 & grid(ng) % latv, &
4521 & checksum = fhash)
4522# else
4523 & grid(ng) % latv)
4524# endif
4525 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4526 exit_flag=2
4527 ioerror=status
4528 EXIT
4529 ELSE
4530 IF (master) THEN
4531 WRITE (stdout,30) 'latitude of V-points: lat_v', &
4532 & ng, trim(ncname), fmin, fmax
4533# ifdef CHECKSUM
4534 WRITE (stdout,60) fhash
4535# endif
4536 END IF
4537 END IF
4538# ifdef NESTING
4539 CALL fill_contact(ng, model, tile, &
4540 & cr, vcontact(cr)%Npoints, vcontact, &
4541 & v2dvar, var_name(i), spval_check, &
4542 & lbi, ubi, lbj, ubj, &
4543 & contact_metric(cr) % Yv, &
4544 & grid(ng) % latv)
4545 IF (founderror(exit_flag, noerror, &
4546 & __line__, myfile)) RETURN
4547# endif
4548# ifdef DISTRIBUTE
4549 CALL mp_exchange2d (ng, tile, model, 1, &
4550 & lbi, ubi, lbj, ubj, &
4551 & nghostpoints, &
4552 & .false., .false., &
4553 & grid(ng) % latv)
4554# endif
4555 END IF
4556!
4557! Read in angle (radians) between XI-axis and EAST at RHO-points.
4558!
4559 CASE ('angle')
4560 piovar%vd=var_desc(i)
4561 piovar%gtype=r2dvar
4562 IF (kind(grid(ng)%angler).eq.8) THEN
4563 piovar%dkind=pio_double
4564 iodesc => iodesc_dp_r2dvar(ng)
4565 ELSE
4566 piovar%dkind=pio_real
4567 iodesc => iodesc_sp_r2dvar(ng)
4568 END IF
4569!
4570 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4571 & var_name(i), piovar, &
4572 & 0, iodesc, vsize, &
4573 & lbi, ubi, lbj, ubj, &
4574 & fscl, fmin, fmax, &
4575# ifdef MASKING
4576 & grid(ng) % rmask, &
4577# endif
4578# ifdef CHECKSUM
4579 & grid(ng) % angler, &
4580 & checksum = fhash)
4581# else
4582 & grid(ng) % angler)
4583# endif
4584 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4585 exit_flag=2
4586 ioerror=status
4587 EXIT
4588 ELSE
4589 IF (master) THEN
4590 WRITE (stdout,30) 'angle between XI-axis and EAST: '// &
4591 & 'angler', &
4592 & ng, trim(ncname), fmin, fmax
4593# ifdef CHECKSUM
4594 WRITE (stdout,60) fhash
4595# endif
4596 END IF
4597 END IF
4598# ifdef NESTING
4599 CALL fill_contact(ng, model, tile, &
4600 & cr, rcontact(cr)%Npoints, rcontact, &
4601 & r2dvar, 'angler', spval_check, &
4602 & lbi, ubi, lbj, ubj, &
4603 & contact_metric(cr) % angler, &
4604 & grid(ng) % angler)
4605 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4606# endif
4607 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4608 CALL exchange_r2d_tile (ng, tile, &
4609 & lbi, ubi, lbj, ubj, &
4610 & grid(ng) % angler)
4611 END IF
4612# ifdef DISTRIBUTE
4613 CALL mp_exchange2d (ng, tile, model, 1, &
4614 & lbi, ubi, lbj, ubj, &
4615 & nghostpoints, &
4616 & ewperiodic(ng), nsperiodic(ng), &
4617 & grid(ng) % angler)
4618# endif
4619# if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
4620 defined opt_observations || defined sensitivity_4dvar || \
4621 defined so_semi
4622# ifndef OBS_SPACE
4623!
4624! Read in adjoint sensitivity spatial scope masking at RHO-points.
4625!
4626 CASE ('scope_rho')
4627 piovar%vd=var_desc(i)
4628 piovar%gtype=r2dvar
4629 IF (kind(grid(ng)%Rscope).eq.8) THEN
4630 piovar%dkind=pio_double
4631 iodesc => iodesc_dp_r2dvar(ng)
4632 ELSE
4633 piovar%dkind=pio_real
4634 iodesc => iodesc_sp_r2dvar(ng)
4635 END IF
4636!
4637 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4638 & var_name(i), piovar, &
4639 & 0, iodesc, vsize, &
4640 & lbi, ubi, lbj, ubj, &
4641 & fscl, fmin, fmax, &
4642# ifdef MASKING
4643 & grid(ng) % rmask, &
4644# endif
4645# ifdef CHECKSUM
4646 & grid(ng) % Rscope, &
4647 & checksum = fhash)
4648# else
4649 & grid(ng) % Rscope)
4650# endif
4651 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4652 exit_flag=2
4653 ioerror=status
4654 EXIT
4655 ELSE
4656 IF (master) THEN
4657 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
4658 & 'scope on RHO-points: scope_rho', &
4659 & ng, trim(ncname), fmin, fmax
4660# ifdef CHECKSUM
4661 WRITE (stdout,60) fhash
4662# endif
4663 END IF
4664 END IF
4665 gotscope(1)=.true.
4666 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4667 CALL exchange_r2d_tile (ng, tile, &
4668 & lbi, ubi, lbj, ubj, &
4669 & grid(ng) % Rscope)
4670 END IF
4671# ifdef DISTRIBUTE
4672 CALL mp_exchange2d (ng, tile, model, 1, &
4673 & lbi, ubi, lbj, ubj, &
4674 & nghostpoints, &
4675 & ewperiodic(ng), nsperiodic(ng), &
4676 & grid(ng) % Rscope)
4677# endif
4678!
4679! Read in adjoint sensitivity spatial scope masking at U-points.
4680!
4681 CASE ('scope_u')
4682 piovar%vd=var_desc(i)
4683 piovar%gtype=u2dvar
4684 IF (kind(grid(ng)%Uscope).eq.8) THEN
4685 piovar%dkind=pio_double
4686 iodesc => iodesc_dp_u2dvar(ng)
4687 ELSE
4688 piovar%dkind=pio_real
4689 iodesc => iodesc_sp_u2dvar(ng)
4690 END IF
4691!
4692 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4693 & var_name(i), piovar, &
4694 & 0, iodesc, vsize, &
4695 & lbi, ubi, lbj, ubj, &
4696 & fscl, fmin, fmax, &
4697# ifdef MASKING
4698 & grid(ng) % umask, &
4699# endif
4700# ifdef CHECKSUM
4701 & grid(ng) % Uscope, &
4702 & checksum = fhash)
4703# else
4704 & grid(ng) % Uscope)
4705# endif
4706 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4707 exit_flag=2
4708 ioerror=status
4709 EXIT
4710 ELSE
4711 IF (master) THEN
4712 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
4713 & 'scope on U-points: scope_u', &
4714 & ng, trim(ncname), fmin, fmax
4715# ifdef CHECKSUM
4716 WRITE (stdout,60) fhash
4717# endif
4718 END IF
4719 END IF
4720 gotscope(2)=.true.
4721 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4722 CALL exchange_u2d_tile (ng, tile, &
4723 & lbi, ubi, lbj, ubj, &
4724 & grid(ng) % Uscope)
4725 END IF
4726# ifdef DISTRIBUTE
4727 CALL mp_exchange2d (ng, tile, model, 1, &
4728 & lbi, ubi, lbj, ubj, &
4729 & nghostpoints, &
4730 & ewperiodic(ng), nsperiodic(ng), &
4731 & grid(ng) % Uscope)
4732# endif
4733!
4734! Read in adjoint sensitivity spatial scope masking at V-points.
4735!
4736 CASE ('scope_v')
4737 piovar%vd=var_desc(i)
4738 piovar%gtype=v2dvar
4739 IF (kind(grid(ng)%Vscope).eq.8) THEN
4740 piovar%dkind=pio_double
4741 iodesc => iodesc_dp_v2dvar(ng)
4742 ELSE
4743 piovar%dkind=pio_real
4744 iodesc => iodesc_sp_v2dvar(ng)
4745 END IF
4746!
4747 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4748 & var_name(i), piovar, &
4749 & 0, iodesc, vsize, &
4750 & lbi, ubi, lbj, ubj, &
4751 & fscl, fmin, fmax, &
4752# ifdef MASKING
4753 & grid(ng) % vmask, &
4754# endif
4755# ifdef CHECKSUM
4756 & grid(ng) % Vscope, &
4757 & checksum = fhash)
4758# else
4759 & grid(ng) % Vscope)
4760# endif
4761 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4762 exit_flag=2
4763 ioerror=status
4764 EXIT
4765 ELSE
4766 IF (master) THEN
4767 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
4768 & 'scope on V-points: scope_v', &
4769 & ng, trim(ncname), fmin, fmax
4770# ifdef CHECKSUM
4771 WRITE (stdout,60) fhash
4772# endif
4773 END IF
4774 END IF
4775 gotscope(3)=.true.
4776 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4777 CALL exchange_v2d_tile (ng, tile, &
4778 & lbi, ubi, lbj, ubj, &
4779 & grid(ng) % Vscope)
4780 END IF
4781# ifdef DISTRIBUTE
4782 CALL mp_exchange2d (ng, tile, model, 1, &
4783 & lbi, ubi, lbj, ubj, &
4784 & nghostpoints, &
4785 & ewperiodic(ng), nsperiodic(ng), &
4786 & grid(ng) % Vscope)
4787# endif
4788# endif
4789# endif
4790 END SELECT
4791 END DO
4792 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
4793 IF (master) WRITE (stdout,40) trim(var_name(i)), trim(ncname)
4794 RETURN
4795 END IF
4796
4797# if defined UV_DRAG_GRID && !defined ANA_DRAG
4798# ifdef UV_LOGDRAG
4799!
4800! Read in spacially varying bottom roughness length (m).
4801!
4802 IF (kind(grid(ng)%ZoBot).eq.8) THEN
4803 piovar_zobl%dkind=pio_double
4804 iodesc => iodesc_dp_r2dvar(ng)
4805 ELSE
4806 piovar_zobl%dkind=pio_real
4807 iodesc => iodesc_sp_r2dvar(ng)
4808 END IF
4809!
4810 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4811 & vname(1,idzobl), piovar_zobl, &
4812 & 0, iodesc, vsize, &
4813 & lbi, ubi, lbj, ubj, &
4814 & fscl, fmin, fmax, &
4815# ifdef MASKING
4816 & grid(ng) % rmask, &
4817# endif
4818# ifdef CHECKSUM
4819 & grid(ng) % ZoBot, &
4820 & checksum = fhash)
4821# else
4822 & grid(ng) % ZoBot)
4823# endif
4824 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4825 IF (master) WRITE (stdout,40) trim(vname(1,idzobl)), &
4826 & trim(ncname)
4827 exit_flag=2
4828 ioerror=status
4829 RETURN
4830 ELSE
4831 IF (master) THEN
4832 WRITE (stdout,30) 'time invariant, bottom roughness '// &
4833 & 'length scale: ZoBot', &
4834 & ng, trim(ncname), fmin, fmax
4835# ifdef CHECKSUM
4836 WRITE (stdout,60) fhash
4837# endif
4838 END IF
4839 END IF
4840 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4841 CALL exchange_r2d_tile (ng, tile, &
4842 & lbi, ubi, lbj, ubj, &
4843 & grid(ng) % ZoBot)
4844 END IF
4845# ifdef DISTRIBUTE
4846 CALL mp_exchange2d (ng, tile, model, 1, &
4847 & lbi, ubi, lbj, ubj, &
4848 & nghostpoints, &
4849 & ewperiodic(ng), nsperiodic(ng), &
4850 & grid(ng) % ZoBot)
4851# endif
4852# endif
4853# ifdef UV_LDRAG
4854!
4855! Read in spacially varying linear drag coefficients (m/s).
4856!
4857 IF (kind(grid(ng)%rdrag).eq.8) THEN
4858 piovar_dragl%dkind=pio_double
4859 iodesc => iodesc_dp_r2dvar(ng)
4860 ELSE
4861 piovar_dragl%dkind=pio_real
4862 iodesc => iodesc_sp_r2dvar(ng)
4863 END IF
4864!
4865 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4866 & vname(1,idragl), piovar_dragl, &
4867 & 0, iodesc, vsize, &
4868 & lbi, ubi, lbj, ubj, &
4869 & fscl, fmin, fmax, &
4870# ifdef MASKING
4871 & grid(ng) % rmask, &
4872# endif
4873# ifdef CHECKSUM
4874 & grid(ng) % rdrag, &
4875 & checksum = fhash)
4876# else
4877 & grid(ng) % rdrag)
4878# endif
4879 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4880 IF (master) WRITE (stdout,40) trim(vname(1,idragl)), &
4881 & trim(ncname)
4882 exit_flag=2
4883 ioerror=status
4884 RETURN
4885 ELSE
4886 IF (master) THEN
4887 WRITE (stdout,30) 'linear bottom drag coefficient: rdrag', &
4888 & ng, trim(ncname), fmin, fmax
4889# ifdef CHECKSUM
4890 WRITE (stdout,60) fhash
4891# endif
4892 END IF
4893 END IF
4894 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4895 CALL exchange_r2d_tile (ng, tile, &
4896 & lbi, ubi, lbj, ubj, &
4897 & grid(ng) % rdrag)
4898 END IF
4899# ifdef DISTRIBUTE
4900 CALL mp_exchange2d (ng, tile, model, 1, &
4901 & lbi, ubi, lbj, ubj, &
4902 & nghostpoints, &
4903 & ewperiodic(ng), nsperiodic(ng), &
4904 & grid(ng) % rdrag)
4905# endif
4906# endif
4907# ifdef UV_QDRAG
4908!
4909! Read in spacially varying quadratic drag coefficients.
4910!
4911 IF (kind(grid(ng)%rdrag2).eq.8) THEN
4912 piovar_dragq%dkind=pio_double
4913 iodesc => iodesc_dp_r2dvar(ng)
4914 ELSE
4915 piovar_dragq%dkind=pio_real
4916 iodesc => iodesc_sp_r2dvar(ng)
4917 END IF
4918!
4919 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4920 & vname(1,idragq), piovar_dragq, &
4921 & 0, iodesc, vsize, &
4922 & lbi, ubi, lbj, ubj, &
4923 & fscl, fmin, fmax, &
4924# ifdef MASKING
4925 & grid(ng) % rmask, &
4926# endif
4927# ifdef CHECKSUM
4928 & grid(ng) % rdrag2, &
4929 & checksum = fhash)
4930# else
4931 & grid(ng) % rdrag2)
4932# endif
4933 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4934 IF (master) WRITE (stdout,40) trim(vname(1,idragq)), &
4935 & trim(ncname)
4936 exit_flag=2
4937 ioerror=status
4938 RETURN
4939 ELSE
4940 IF (master) THEN
4941 WRITE (stdout,30) 'quadratic bottom drag coefficient: rdrag2',&
4942 & ng, trim(ncname), fmin, fmax
4943# ifdef CHECKSUM
4944 WRITE (stdout,60) fhash
4945# endif
4946 END IF
4947 END IF
4948 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4949 CALL exchange_r2d_tile (ng, tile, &
4950 & lbi, ubi, lbj, ubj, &
4951 & grid(ng) % rdrag2)
4952 END IF
4953# ifdef DISTRIBUTE
4954 CALL mp_exchange2d (ng, tile, model, 1, &
4955 & lbi, ubi, lbj, ubj, &
4956 & nghostpoints, &
4957 & ewperiodic(ng), nsperiodic(ng), &
4958 & grid(ng) % rdrag2)
4959# endif
4960# endif
4961# endif
4962!
4963! Close GRID NetCDF file.
4964!
4965 CALL pio_netcdf_close (ng, model, grd(ng)%pioFile, ncname, .false.)
4966 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4967
4968# if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
4969 defined opt_observations || defined sensitivity_4dvar || \
4970 defined so_semi
4971# ifndef OBS_SPACE
4972!
4973!-----------------------------------------------------------------------
4974! Inquire adjoint sensitivity forcing file. Read scope arrays again.
4975! These fields take precedence
4976!-----------------------------------------------------------------------
4977!
4978 ncname=ads(ng)%name
4979!
4980! Open adjoint sensitivity NetCDF file for reading.
4981!
4982 IF (ads(ng)%pioFile%fh.eq.-1) THEN
4983 CALL pio_netcdf_open (ng, model, ncname, 0, ads(ng)%pioFile)
4984 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
4985 WRITE (stdout,10) trim(ncname)
4986 RETURN
4987 END IF
4988 END IF
4989!
4990! Check grid file dimensions for consitency
4991!
4992 CALL pio_netcdf_check_dim (ng, model, ncname, &
4993 & piofile = ads(ng)%pioFile)
4994 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4995!
4996! Inquire about the variables.
4997!
4998 CALL pio_netcdf_inq_var (ng, model, ncname, &
4999 & piofile = ads(ng)%pioFile)
5000 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5001!
5002! Check if the adjoint sensitivity scope arrays are available.
5003!
5004 gotscope(4)=find_string(var_name,n_var,'scope_rho',vindex)
5005 gotscope(5)=find_string(var_name,n_var,'scope_u',vindex)
5006 gotscope(6)=find_string(var_name,n_var,'scope_v',vindex)
5007!
5008 IF ((.not.gotscope(1)).and.(.not.gotscope(4))) THEN
5009 IF (master) WRITE (stdout,20) 'scope_rho', trim(ncname)
5010 exit_flag=2
5011 RETURN
5012 END IF
5013 IF ((.not.gotscope(2)).and.(.not.gotscope(5))) THEN
5014 IF (master) WRITE (stdout,20) 'scope_u', trim(ncname)
5015 exit_flag=2
5016 RETURN
5017 END IF
5018 IF ((.not.gotscope(3)).and.(.not.gotscope(6))) THEN
5019 IF (master) WRITE (stdout,20) 'scope_v', trim(ncname)
5020 exit_flag=2
5021 RETURN
5022 END IF
5023 IF (master) THEN
5024 IF (gotscope(4)) THEN
5025 WRITE (stdout,50) trim(ads(ng)%name)
5026 ELSE
5027 WRITE (stdout,50) trim(grd(ng)%name)
5028 END IF
5029 END IF
5030!
5031! Scan adjoint sensitivity variables.
5032!
5033 DO i=1,n_var
5034
5035 SELECT CASE (trim(adjustl(var_name(i))))
5036!
5037! Read in adjoint sensitivity spatial scope masking at RHO-points.
5038!
5039 CASE ('scope_rho')
5040 piovar%vd=var_desc(i)
5041 piovar%gtype=r2dvar
5042 IF (kind(grid(ng)%Rscope).eq.8) THEN
5043 piovar%dkind=pio_double
5044 iodesc => iodesc_dp_r2dvar(ng)
5045 ELSE
5046 piovar%dkind=pio_real
5047 iodesc => iodesc_sp_r2dvar(ng)
5048 END IF
5049!
5050 status=nf_fread2d(ng, model, ncname, ads(ng)%pioFile, &
5051 & var_name(i), piovar, &
5052 & 0, iodesc, vsize, &
5053 & lbi, ubi, lbj, ubj, &
5054 & fscl, fmin, fmax, &
5055# ifdef MASKING
5056 & grid(ng) % rmask, &
5057# endif
5058# ifdef CHECKSUM
5059 & grid(ng) % Rscope, &
5060 & checksum = fhash)
5061# else
5062 & grid(ng) % Rscope)
5063# endif
5064 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5065 exit_flag=2
5066 ioerror=status
5067 EXIT
5068 ELSE
5069 IF (master) THEN
5070 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
5071 & 'scope on RHO-points: scope_rho', &
5072 & ng, trim(ncname), fmin, fmax
5073# ifdef CHECKSUM
5074 WRITE (stdout,60) fhash
5075# endif
5076 END IF
5077 END IF
5078 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5079 CALL exchange_r2d_tile (ng, tile, &
5080 & lbi, ubi, lbj, ubj, &
5081 & grid(ng) % Rscope)
5082 END IF
5083# ifdef DISTRIBUTE
5084 CALL mp_exchange2d (ng, tile, model, 1, &
5085 & lbi, ubi, lbj, ubj, &
5086 & nghostpoints, &
5087 & ewperiodic(ng), nsperiodic(ng), &
5088 & grid(ng) % Rscope)
5089# endif
5090!
5091! Read in adjoint sensitivity spatial scope masking at U-points.
5092!
5093 CASE ('scope_u')
5094 piovar%vd=var_desc(i)
5095 piovar%gtype=u2dvar
5096 IF (kind(grid(ng)%Uscope).eq.8) THEN
5097 piovar%dkind=pio_double
5098 iodesc => iodesc_dp_u2dvar(ng)
5099 ELSE
5100 piovar%dkind=pio_real
5101 iodesc => iodesc_sp_u2dvar(ng)
5102 END IF
5103!
5104 status=nf_fread2d(ng, model, ncname, ads(ng)%pioFile, &
5105 & var_name(i), piovar, &
5106 & 0, iodesc, vsize, &
5107 & lbi, ubi, lbj, ubj, &
5108 & fscl, fmin, fmax, &
5109# ifdef MASKING
5110 & grid(ng) % umask, &
5111# endif
5112# ifdef CHECKSUM
5113 & grid(ng) % Uscope, &
5114 & checksum = fhash)
5115# else
5116 & grid(ng) % Uscope)
5117# endif
5118 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5119 exit_flag=2
5120 ioerror=status
5121 EXIT
5122 ELSE
5123 IF (master) THEN
5124 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
5125 & 'scope on U-points: scope_u', &
5126 & ng, trim(ncname), fmin, fmax
5127# ifdef CHECKSUM
5128 WRITE (stdout,60) fhash
5129# endif
5130 END IF
5131 END IF
5132 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5133 CALL exchange_u2d_tile (ng, tile, &
5134 & lbi, ubi, lbj, ubj, &
5135 & grid(ng) % Uscope)
5136 END IF
5137# ifdef DISTRIBUTE
5138 CALL mp_exchange2d (ng, tile, model, 1, &
5139 & lbi, ubi, lbj, ubj, &
5140 & nghostpoints, &
5141 & ewperiodic(ng), nsperiodic(ng), &
5142 & grid(ng) % Uscope)
5143# endif
5144!
5145! Read in adjoint sensitivity spatial scope masking at V-points.
5146!
5147 CASE ('scope_v')
5148 piovar%vd=var_desc(i)
5149 piovar%gtype=v2dvar
5150 IF (kind(grid(ng)%Vscope).eq.8) THEN
5151 piovar%dkind=pio_double
5152 iodesc => iodesc_dp_v2dvar(ng)
5153 ELSE
5154 piovar%dkind=pio_real
5155 iodesc => iodesc_sp_v2dvar(ng)
5156 END IF
5157!
5158 status=nf_fread2d(ng, model, ncname, ads(ng)%pioFile, &
5159 & var_name(i), piovar, &
5160 & 0, iodesc, vsize, &
5161 & lbi, ubi, lbj, ubj, &
5162 & fscl, fmin, fmax, &
5163# ifdef MASKING
5164 & grid(ng) % vmask, &
5165# endif
5166# ifdef CHECKSUM
5167 & grid(ng) % Vscope, &
5168 & checksum = fhash)
5169# else
5170 & grid(ng) % Vscope)
5171# endif
5172 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5173 exit_flag=2
5174 ioerror=status
5175 EXIT
5176 ELSE
5177 IF (master) THEN
5178 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
5179 & 'scope on V-points: scope_v', &
5180 & ng, trim(ncname), fmin, fmax
5181# ifdef CHECKSUM
5182 WRITE (stdout,60) fhash
5183# endif
5184 END IF
5185 END IF
5186 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5187 CALL exchange_v2d_tile (ng, tile, &
5188 & lbi, ubi, lbj, ubj, &
5189 & grid(ng) % Vscope)
5190 END IF
5191# ifdef DISTRIBUTE
5192 CALL mp_exchange2d (ng, tile, model, 1, &
5193 & lbi, ubi, lbj, ubj, &
5194 & nghostpoints, &
5195 & ewperiodic(ng), nsperiodic(ng), &
5196 & grid(ng) % Vscope)
5197# endif
5198 END SELECT
5199 END DO
5200 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
5201 IF (master) WRITE (stdout,40) trim(var_name(i)), trim(ncname)
5202 RETURN
5203 END IF
5204# endif
5205# endif
5206!
5207 10 FORMAT (/,' GET_GRID_PIO - unable to open grid NetCDF file: ',a)
5208 20 FORMAT (/,' GET_GRID_PIO - unable to find grid variable: ',a, &
5209 & /,16x,'in grid NetCDF file: ',a)
5210 30 FORMAT (2x,'GET_GRID_PIO - ',a,/,22x, &
5211 & '(Grid = ',i2.2,', File: ',a,')',/,22x, &
5212 & '(Min = ', 1p,e15.8,0p,' Max = ',1p,e15.8,0p,')')
5213 40 FORMAT (/,' GET_GRID_PIO - error while reading variable: ',a, &
5214 & /,12x,'in grid NetCDF file: ',a)
5215 50 FORMAT (/,2x,'GET_GRID_PIO - Reading adjoint sensitivity', &
5216 & ' scope arrays from file:',/22x,a,/)
5217# ifdef CHECKSUM
5218 60 FORMAT (22x,'(CheckSum = ',i0,')')
5219# endif
5220!
5221 RETURN
5222 END SUBROUTINE get_grid_pio
5223# endif
5224#endif
5225 END MODULE get_grid_mod
mod_netcdf::netcdf_get_fvar
Definition mod_netcdf.F:45
mod_netcdf::netcdf_get_lvar
Definition mod_netcdf.F:65
mod_pio_netcdf::pio_netcdf_get_fvar
Definition mod_pio_netcdf.F:52
mod_pio_netcdf::pio_netcdf_get_lvar
Definition mod_pio_netcdf.F:72
nf_fread2d_mod::nf_fread2d
Definition nf_fread2d.F:69
lmd_skpp
subroutine lmd_skpp(ng, tile)
Definition lmd_skpp.F:45
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
exchange_2d_mod::exchange_u2d_tile
subroutine exchange_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:440
exchange_2d_mod::exchange_p2d_tile
subroutine exchange_p2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:66
exchange_2d_mod::exchange_v2d_tile
subroutine exchange_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:627
get_grid_mod
Definition get_grid.F:2
get_grid_mod::get_grid_nf90
subroutine, private get_grid_nf90(ng, tile, model, lbi, ubi, lbj, ubj)
Definition get_grid.F:102
get_grid_mod::get_grid_pio
subroutine, private get_grid_pio(ng, tile, model, lbi, ubi, lbj, ubj)
Definition get_grid.F:2508
get_grid_mod::get_grid
subroutine, public get_grid(ng, tile, model)
Definition get_grid.F:55
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_iounits
Definition mod_iounits.F:2
mod_iounits::ads
type(t_io), dimension(:), allocatable ads
Definition mod_iounits.F:201
mod_iounits::ioerror
integer ioerror
Definition mod_iounits.F:313
mod_iounits::grd
type(t_io), dimension(:), allocatable grd
Definition mod_iounits.F:218
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_iounits::sourcefile
character(len=256) sourcefile
Definition mod_iounits.F:317
mod_mixing
Definition mod_mixing.F:2
mod_mixing::mixing
type(t_mixing), dimension(:), allocatable mixing
Definition mod_mixing.F:399
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::io_nf90
integer, parameter io_nf90
Definition mod_ncparam.F:95
mod_ncparam::io_pio
integer, parameter io_pio
Definition mod_ncparam.F:96
mod_ncparam::idragl
integer idragl
Definition mod_ncparam.F:288
mod_ncparam::idzobl
integer idzobl
Definition mod_ncparam.F:432
mod_ncparam::vname
character(len=maxlen), dimension(6, 0:nv) vname
Definition mod_ncparam.F:591
mod_ncparam::idragq
integer idragq
Definition mod_ncparam.F:289
mod_nesting
Definition mod_nesting.F:2
mod_nesting::vcontact
type(t_ngc), dimension(:), allocatable vcontact
Definition mod_nesting.F:288
mod_nesting::contact_metric
type(t_ngm), dimension(:), allocatable contact_metric
Definition mod_nesting.F:374
mod_nesting::rcontact
type(t_ngc), dimension(:), allocatable rcontact
Definition mod_nesting.F:286
mod_nesting::ucontact
type(t_ngc), dimension(:), allocatable ucontact
Definition mod_nesting.F:287
mod_nesting::ncontact
integer ncontact
Definition mod_nesting.F:256
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::netcdf_close
subroutine, public netcdf_close(ng, model, ncid, ncname, lupdate)
Definition mod_netcdf.F:8930
mod_netcdf::netcdf_check_dim
subroutine, public netcdf_check_dim(ng, model, ncname, ncid)
Definition mod_netcdf.F:538
mod_netcdf::netcdf_open
subroutine, public netcdf_open(ng, model, ncname, omode, ncid)
Definition mod_netcdf.F:9293
mod_netcdf::var_name
character(len=100), dimension(mvars) var_name
Definition mod_netcdf.F:169
mod_netcdf::var_id
integer, dimension(mvars) var_id
Definition mod_netcdf.F:160
mod_netcdf::n_var
integer n_var
Definition mod_netcdf.F:152
mod_netcdf::netcdf_inq_var
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)
Definition mod_netcdf.F:1371
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_param
Definition mod_param.F:2
mod_param::bounds
type(t_bounds), dimension(:), allocatable bounds
Definition mod_param.F:232
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_param::u2dvar
integer, parameter u2dvar
Definition mod_param.F:718
mod_param::p2dvar
integer, parameter p2dvar
Definition mod_param.F:716
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_param::v2dvar
integer, parameter v2dvar
Definition mod_param.F:719
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::iodesc_sp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dvar
Definition mod_pio_netcdf.F:195
mod_pio_netcdf::var_desc
type(var_desc_t), dimension(:), pointer var_desc
Definition mod_pio_netcdf.F:437
mod_pio_netcdf::iodesc_sp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
Definition mod_pio_netcdf.F:194
mod_pio_netcdf::pio_netcdf_inq_var
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
Definition mod_pio_netcdf.F:1923
mod_pio_netcdf::pio_netcdf_close
subroutine, public pio_netcdf_close(ng, model, piofile, ncname, lupdate)
Definition mod_pio_netcdf.F:8858
mod_pio_netcdf::pio_netcdf_open
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
Definition mod_pio_netcdf.F:9148
mod_pio_netcdf::iodesc_dp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dvar
Definition mod_pio_netcdf.F:234
mod_pio_netcdf::iodesc_dp_p2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_p2dvar
Definition mod_pio_netcdf.F:232
mod_pio_netcdf::pio_netcdf_check_dim
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:1080
mod_pio_netcdf::iodesc_dp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dvar
Definition mod_pio_netcdf.F:235
mod_pio_netcdf::iodesc_dp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dvar
Definition mod_pio_netcdf.F:233
mod_pio_netcdf::iodesc_sp_p2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_p2dvar
Definition mod_pio_netcdf.F:193
mod_pio_netcdf::iodesc_sp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dvar
Definition mod_pio_netcdf.F:196
mod_scalars
Definition mod_scalars.F:2
mod_scalars::spherical
logical spherical
Definition mod_scalars.F:478
mod_scalars::luvsponge
logical, dimension(:), allocatable luvsponge
Definition mod_scalars.F:945
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::spval_check
real(dp), parameter spval_check
Definition mod_scalars.F:832
mod_scalars::latmax
real(r8), dimension(:), allocatable latmax
Definition mod_scalars.F:643
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::latmin
real(r8), dimension(:), allocatable latmin
Definition mod_scalars.F:642
mod_scalars::ltracersponge
logical, dimension(:,:), allocatable ltracersponge
Definition mod_scalars.F:946
mod_scalars::lonmax
real(r8), dimension(:), allocatable lonmax
Definition mod_scalars.F:641
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::lonmin
real(r8), dimension(:), allocatable lonmin
Definition mod_scalars.F:640
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::noerror
integer noerror
Definition mod_scalars.F:561
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
nesting_mod
Definition nesting.F:2
nesting_mod::fill_contact
subroutine, public fill_contact(rg, model, tile, cr, npoints, contact, gtype, mvname, spvalcheck, lbi, ubi, lbj, ubj, ac, ar)
Definition nesting.F:1081
nf_fread2d_mod
Definition nf_fread2d.F:2
strings_mod
Definition strings.F:2
strings_mod::find_string
logical function, public find_string(a, asize, string, aindex)
Definition strings.F:417
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
mod_iounits::my_vardesc
Definition mod_iounits.F:151