ROMS
Loading...
Searching...
No Matches
get_extract.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE get_extract_mod
3
4#ifdef GRID_EXTRACT
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 extraction grid information from input file using !
14! either standard NetCDF library or the Parallel-IO (PIO) library. !
15! !
16! This grid geometry will be used in field extraction by decimation !
17! or interpolation, which are written to output NetCDF file. !
18! !
19!=======================================================================
20!
21 USE mod_param
22 USE mod_parallel
23 USE mod_extract
24 USE mod_grid
25 USE mod_iounits
26 USE mod_ncparam
27 USE mod_netcdf
28# if defined PIO_LIB && defined DISTRIBUTE
29 USE mod_pio_netcdf
30# endif
31!
32 USE exchange_2d_xtr_mod
33 USE extract_field_mod, ONLY : interp_coords
34# ifdef DISTRIBUTE
35 USE mp_exchange_mod, ONLY : mp_exchange2d_xtr
36# endif
37 USE nf_fread2d_xtr_mod, ONLY : nf_fread2d_xtr
38 USE strings_mod, ONLY : founderror, find_string
39!
40 implicit none
41!
42 PUBLIC :: get_extract
43 PRIVATE :: get_extract_nf90
44# if defined PIO_LIB && defined DISTRIBUTE
45 PRIVATE :: get_extract_pio
46# endif
47!
48 CONTAINS
49!
50!***********************************************************************
51 SUBROUTINE get_extract (ng, tile, model)
52!***********************************************************************
53!
54! Imported variable declarations.
55!
56 integer, intent(in) :: ng, tile, model
57!
58! Local variable declarations.
59!
60 integer :: LBi, UBi, LBj, UBj
61!
62 character (len=*), parameter :: MyFile = &
63 & __FILE__
64!
65!-----------------------------------------------------------------------
66! Read in GRID NetCDF file according to IO type.
67!-----------------------------------------------------------------------
68!
69 lbi=xtr_bounds(ng)%LBi(tile)
70 ubi=xtr_bounds(ng)%UBi(tile)
71 lbj=xtr_bounds(ng)%LBj(tile)
72 ubj=xtr_bounds(ng)%UBj(tile)
73!
74 SELECT CASE (grx(ng)%IOtype)
75 CASE (io_nf90)
76 CALL get_extract_nf90 (ng, tile, model, &
77 & lbi, ubi, lbj, ubj)
78
79# if defined PIO_LIB && defined DISTRIBUTE
80 CASE (io_pio)
81 CALL get_extract_pio (ng, tile, model, &
82 & lbi, ubi, lbj, ubj)
83# endif
84 CASE DEFAULT
85 IF (master) WRITE (stdout,10) grx(ng)%IOtype
86 exit_flag=2
87 END SELECT
88 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
89!
90!-----------------------------------------------------------------------
91! Set packed, global geometry arrays needed for field extraction by
92! decimation or interpolation.
93!-----------------------------------------------------------------------
94!
95 IF (extractflag(ng).ge.1) THEN
96 CALL interp_coords (ng, tile, model, p2dvar, &
97 & grid(ng)%Gangle_psi, &
98# ifdef MASKING
99 & grid(ng)%Gmask_psi, &
100# endif
101 & grid(ng)%Gx_psi, &
102 & grid(ng)%Gy_psi, &
103# ifdef MASKING
104 & extract(ng)%Gmask_psi, &
105# endif
106 & extract(ng)%Gx_psi, &
107 & extract(ng)%Gy_psi, &
108 & extract(ng)%Iout_psi, &
109 & extract(ng)%Jout_psi)
110!
111 CALL interp_coords (ng, tile, model, r2dvar, &
112 & grid(ng)%Gangle_rho, &
113# ifdef MASKING
114 & grid(ng)%Gmask_rho, &
115# endif
116 & grid(ng)%Gx_rho, &
117 & grid(ng)%Gy_rho, &
118# ifdef MASKING
119 & extract(ng)%Gmask_rho, &
120# endif
121 & extract(ng)%Gx_rho, &
122 & extract(ng)%Gy_rho, &
123 & extract(ng)%Iout_rho, &
124 & extract(ng)%Jout_rho)
125!
126 CALL interp_coords (ng, tile, model, u2dvar, &
127 & grid(ng)%Gangle_u, &
128# ifdef MASKING
129 & grid(ng)%Gmask_u, &
130# endif
131 & grid(ng)%Gx_u, &
132 & grid(ng)%Gy_u, &
133# ifdef MASKING
134 & extract(ng)%Gmask_u, &
135# endif
136 & extract(ng)%Gx_u, &
137 & extract(ng)%Gy_u, &
138 & extract(ng)%Iout_u, &
139 & extract(ng)%Jout_u)
140!
141 CALL interp_coords (ng, tile, model, v2dvar, &
142 & grid(ng)%Gangle_v, &
143# ifdef MASKING
144 & grid(ng)%Gmask_v, &
145# endif
146 & grid(ng)%Gx_v, &
147 & grid(ng)%Gy_v, &
148# ifdef MASKING
149 & extract(ng)%Gmask_v, &
150# endif
151 & extract(ng)%Gx_v, &
152 & extract(ng)%Gy_v, &
153
154 & extract(ng)%Iout_v, &
155 & extract(ng)%Jout_v)
156 END IF
157!
158 10 FORMAT (' GET_EXTRACT - Illegal input file type, io_type = ',i0, &
159 & /,12x,'Check KeyWord ''INP_LIB'' in ''roms.in''.')
160!
161 RETURN
162 END SUBROUTINE get_extract
163!
164!***********************************************************************
165 SUBROUTINE get_extract_nf90 (ng, tile, model, &
166 & LBi, UBi, LBj, UBj)
167!***********************************************************************
168!
169! Imported variable declarations.
170!
171 integer, intent(in) :: ng, tile, model
172 integer, intent(in) :: LBi, UBi, LBj, UBj
173!
174! Local variable declarations.
175!
176 integer :: cr, gtype, i, status, vindex
177 integer :: Vsize(4)
178# ifdef CHECKSUM
179 integer(i8b) :: Fhash
180# endif
181!
182 real(dp), parameter :: Fscl = 1.0_dp
183
184 real(r8) :: Fmax, Fmin
185!
186 character (len=256) :: ncname
187
188 character (len=*), parameter :: MyFile = &
189 & __FILE__//", get_extract_nf90"
190!
191 sourcefile=myfile
192!
193!-----------------------------------------------------------------------
194! Inquire about the contents of extraction grid NetCDF file: Inquire
195! about the dimensions and variables.
196!-----------------------------------------------------------------------
197!
198 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
199 ncname=grx(ng)%name
200!
201! Open grid NetCDF file for reading.
202!
203 IF (grx(ng)%ncid.eq.-1) THEN
204 CALL netcdf_open (ng, model, ncname, 0, grx(ng)%ncid)
205 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
206 WRITE (stdout,10) trim(ncname)
207 RETURN
208 END IF
209 END IF
210!
211! Inquire about the variables.
212!
213 CALL netcdf_inq_var (ng, model, ncname, &
214 & ncid = grx(ng)%ncid)
215 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
216!
217!-----------------------------------------------------------------------
218! Check if required variables are available.
219!-----------------------------------------------------------------------
220!
221 IF (.not.find_string(var_name,n_var,'spherical',vindex)) THEN
222 IF (master) WRITE (stdout,20) 'spherical', trim(ncname)
223 exit_flag=2
224 RETURN
225 END IF
226 IF (.not.find_string(var_name,n_var,'h',vindex)) THEN
227 IF (master) WRITE (stdout,20) 'h', trim(ncname)
228 exit_flag=2
229 RETURN
230 END IF
231 IF (.not.find_string(var_name,n_var,'pm',vindex)) THEN
232 IF (master) WRITE (stdout,20) 'pm', trim(ncname)
233 exit_flag=2
234 RETURN
235 END IF
236 IF (.not.find_string(var_name,n_var,'pn',vindex)) THEN
237 IF (master) WRITE (stdout,20) 'pn', trim(ncname)
238 exit_flag=2
239 RETURN
240 END IF
241# if (defined CURVGRID && defined UV_ADV)
242 IF (.not.find_string(var_name,n_var,'dndx',vindex)) THEN
243 IF (master) WRITE (stdout,20) 'dndx', trim(ncname)
244 exit_flag=2
245 RETURN
246 END IF
247 IF (.not.find_string(var_name,n_var,'dmde',vindex)) THEN
248 IF (master) WRITE (stdout,20) 'dmde', trim(ncname)
249 exit_flag=2
250 RETURN
251 END IF
252# endif
253# ifdef CURVGRID
254 IF (.not.find_string(var_name,n_var,'angle',vindex)) THEN
255 IF (master) WRITE (stdout,20) 'angle', trim(ncname)
256 exit_flag=2
257 RETURN
258 END IF
259# endif
260# ifdef MASKING
261 IF (.not.find_string(var_name,n_var,'mask_rho',vindex)) THEN
262 IF (master) WRITE (stdout,20) 'mask_rho', trim(ncname)
263 exit_flag=2
264 RETURN
265 END IF
266 IF (.not.find_string(var_name,n_var,'mask_u',vindex)) THEN
267 IF (master) WRITE (stdout,20) 'mask_u', trim(ncname)
268 exit_flag=2
269 RETURN
270 END IF
271 IF (.not.find_string(var_name,n_var,'mask_v',vindex)) THEN
272 IF (master) WRITE (stdout,20) 'mask_v', trim(ncname)
273 exit_flag=2
274 RETURN
275 END IF
276 IF (.not.find_string(var_name,n_var,'mask_psi',vindex)) THEN
277 IF (master) WRITE (stdout,20) 'mask_psi', trim(ncname)
278 exit_flag=2
279 RETURN
280 END IF
281# endif
282!
283! Read in logical switch for spherical grid configuration.
284!
285 spherical=.false.
286 IF (find_string(var_name,n_var,'spherical',vindex)) THEN
287 CALL netcdf_get_lvar (ng, model, ncname, 'spherical', &
288 & spherical, &
289 & ncid = grx(ng)%ncid)
290 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
291 END IF
292!
293!-----------------------------------------------------------------------
294! Read in grid variables.
295!-----------------------------------------------------------------------
296!
297! Set Vsize to zero to deativate interpolation of input data to model
298! grid in "nf_fread2d".
299!
300 DO i=1,4
301 vsize(i)=0
302 END DO
303!
304! Scan the variable list and read in needed variables.
305!
306 IF (master) WRITE (stdout,'(1x)')
307!
308 DO i=1,n_var
309
310 SELECT CASE (trim(adjustl(var_name(i))))
311!
312! Read in bathymetry.
313!
314 CASE ('h')
315 gtype=r2dvar
316 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
317 & var_name(i), var_id(i), &
318 & 0, gtype, vsize, &
319 & lbi, ubi, lbj, ubj, &
320 & fscl, fmin, fmax, &
321# ifdef MASKING
322 & extract(ng) % rmask, &
323# endif
324# ifdef CHECKSUM
325 & extract(ng) % h, &
326 & checksum = fhash)
327# else
328 & extract(ng) % h)
329# endif
330 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
331 exit_flag=2
332 ioerror=status
333 EXIT
334 ELSE
335 IF (master) THEN
336 WRITE (stdout,30) 'bathymetry at RHO-points: h', &
337 & ng, trim(ncname), fmin, fmax
338# ifdef CHECKSUM
339 WRITE (stdout,60) fhash
340# endif
341 END IF
342 END IF
343 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
344 CALL exchange_r2d_xtr_tile (ng, tile, &
345 & lbi, ubi, lbj, ubj, &
346 & extract(ng) % h)
347 END IF
348# ifdef DISTRIBUTE
349 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
350 & lbi, ubi, lbj, ubj, &
351 & nghostpoints, &
352 & ewperiodic(ng), nsperiodic(ng), &
353 & extract(ng) % h)
354# endif
355# ifdef MASKING
356!
357! Read in Land/Sea masking at RHO-points.
358!
359 CASE ('mask_rho')
360 gtype=r2dvar
361 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
362 & var_name(i), var_id(i), &
363 & 0, gtype, vsize, &
364 & lbi, ubi, lbj, ubj, &
365 & fscl, fmin, fmax, &
366 & extract(ng) % rmask, &
367# ifdef CHECKSUM
368 & extract(ng) % rmask, &
369 & checksum = fhash)
370# else
371 & extract(ng) % rmask)
372# endif
373 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
374 exit_flag=2
375 ioerror=status
376 EXIT
377 ELSE
378 IF (master) THEN
379 WRITE (stdout,30) 'mask on RHO-points: mask_rho', &
380 & ng, trim(ncname), fmin, fmax
381# ifdef CHECKSUM
382 WRITE (stdout,60) fhash
383# endif
384 END IF
385 END IF
386 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
387 CALL exchange_r2d_xtr_tile (ng, tile, &
388 & lbi, ubi, lbj, ubj, &
389 & extract(ng) % rmask)
390 END IF
391# ifdef DISTRIBUTE
392 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
393 & lbi, ubi, lbj, ubj, &
394 & nghostpoints, &
395 & ewperiodic(ng), nsperiodic(ng), &
396 & extract(ng) % rmask)
397# endif
398!
399! Read in Land/Sea masking at U-points.
400!
401 CASE ('mask_u')
402 gtype=u2dvar
403 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
404 & var_name(i), var_id(i), &
405 & 0, gtype, vsize, &
406 & lbi, ubi, lbj, ubj, &
407 & fscl, fmin, fmax, &
408 & extract(ng) % umask, &
409# ifdef CHECKSUM
410 & extract(ng) % umask, &
411 & checksum = fhash)
412# else
413 & extract(ng) % umask)
414# endif
415 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
416 exit_flag=2
417 ioerror=status
418 EXIT
419 ELSE
420 IF (master) THEN
421 WRITE (stdout,30) 'mask on U-points: mask_u', &
422 & ng, trim(ncname), fmin, fmax
423# ifdef CHECKSUM
424 WRITE (stdout,60) fhash
425# endif
426 END IF
427 END IF
428 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
429 CALL exchange_u2d_xtr_tile (ng, tile, &
430 & lbi, ubi, lbj, ubj, &
431 & extract(ng) % umask)
432 END IF
433# ifdef DISTRIBUTE
434 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
435 & lbi, ubi, lbj, ubj, &
436 & nghostpoints, &
437 & ewperiodic(ng), nsperiodic(ng), &
438 & extract(ng) % umask)
439# endif
440!
441! Read in Land/Sea masking at V-points.
442!
443 CASE ('mask_v')
444 gtype=v2dvar
445 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
446 & var_name(i), var_id(i), &
447 & 0, gtype, vsize, &
448 & lbi, ubi, lbj, ubj, &
449 & fscl, fmin, fmax, &
450 & extract(ng) % vmask, &
451# ifdef CHECKSUM
452 & extract(ng) % vmask, &
453 & checksum = fhash)
454# else
455 & extract(ng) % vmask)
456# endif
457 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
458 exit_flag=2
459 ioerror=status
460 EXIT
461 ELSE
462 IF (master) THEN
463 WRITE (stdout,30) 'mask on V-points: mask_v', &
464 & ng, trim(ncname), fmin, fmax
465# ifdef CHECKSUM
466 WRITE (stdout,60) fhash
467# endif
468 END IF
469 END IF
470 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
471 CALL exchange_v2d_xtr_tile (ng, tile, &
472 & lbi, ubi, lbj, ubj, &
473 & extract(ng) % vmask)
474 END IF
475# ifdef DISTRIBUTE
476 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
477 & lbi, ubi, lbj, ubj, &
478 & nghostpoints, &
479 & ewperiodic(ng), nsperiodic(ng), &
480 & extract(ng) % vmask)
481# endif
482!
483! Read in Land/Sea masking at PSI-points.
484!
485 CASE ('mask_psi')
486 gtype=p2dvar
487 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
488 & var_name(i), var_id(i), &
489 & 0, gtype, vsize, &
490 & lbi, ubi, lbj, ubj, &
491 & fscl, fmin, fmax, &
492 & extract(ng) % pmask, &
493# ifdef CHECKSUM
494 & extract(ng) % pmask, &
495 & checksum = fhash)
496# else
497 & extract(ng) % pmask)
498# endif
499 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
500 exit_flag=2
501 ioerror=status
502 EXIT
503 ELSE
504 IF (master) THEN
505 WRITE (stdout,30) 'mask on PSI-points: mask_psi', &
506 & ng, trim(ncname), fmin, fmax
507# ifdef CHECKSUM
508 WRITE (stdout,60) fhash
509# endif
510 END IF
511 END IF
512 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
513 CALL exchange_p2d_xtr_tile (ng, tile, &
514 & lbi, ubi, lbj, ubj, &
515 & extract(ng) % pmask)
516 END IF
517# ifdef DISTRIBUTE
518 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
519 & lbi, ubi, lbj, ubj, &
520 & nghostpoints, &
521 & ewperiodic(ng), nsperiodic(ng), &
522 & extract(ng) % pmask)
523# endif
524# endif
525!
526! Read in Coriolis parameter.
527!
528 CASE ('f')
529 gtype=r2dvar
530 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
531 & var_name(i), var_id(i), &
532 & 0, gtype, vsize, &
533 & lbi, ubi, lbj, ubj, &
534 & fscl, fmin, fmax, &
535# ifdef MASKING
536 & extract(ng) % rmask, &
537# endif
538# ifdef CHECKSUM
539 & extract(ng) % f, &
540 & checksum = fhash)
541# else
542 & extract(ng) % f)
543# endif
544 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
545 exit_flag=2
546 ioerror=status
547 EXIT
548 ELSE
549 IF (master) THEN
550 WRITE (stdout,30) 'Coriolis parameter at RHO-points: f',&
551 & ng, trim(ncname), fmin, fmax
552# ifdef CHECKSUM
553 WRITE (stdout,60) fhash
554# endif
555 END IF
556 END IF
557 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
558 CALL exchange_r2d_xtr_tile (ng, tile, &
559 & lbi, ubi, lbj, ubj, &
560 & extract(ng) % f)
561 END IF
562# ifdef DISTRIBUTE
563 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
564 & lbi, ubi, lbj, ubj, &
565 & nghostpoints, &
566 & ewperiodic(ng), nsperiodic(ng), &
567 & extract(ng) % f)
568# endif
569!
570! Read in coordinate transfomation metrics (m) associated with the
571! differential distances in XI.
572!
573 CASE ('pm')
574 gtype=r2dvar
575 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
576 & var_name(i), var_id(i), &
577 & 0, gtype, vsize, &
578 & lbi, ubi, lbj, ubj, &
579 & fscl, fmin, fmax, &
580# ifdef MASKING
581 & extract(ng) % rmask, &
582# endif
583# ifdef CHECKSUM
584 & extract(ng) % pm, &
585 & checksum = fhash)
586# else
587 & extract(ng) % pm)
588# endif
589 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
590 exit_flag=2
591 ioerror=status
592 EXIT
593 ELSE
594 IF (master) THEN
595 WRITE (stdout,30) 'reciprocal XI-grid spacing: pm', &
596 & ng, trim(ncname), fmin, fmax
597# ifdef CHECKSUM
598 WRITE (stdout,60) fhash
599# endif
600 END IF
601 END IF
602 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
603 CALL exchange_r2d_xtr_tile (ng, tile, &
604 & lbi, ubi, lbj, ubj, &
605 & extract(ng) % pm)
606 END IF
607# ifdef DISTRIBUTE
608 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
609 & lbi, ubi, lbj, ubj, &
610 & nghostpoints, &
611 & ewperiodic(ng), nsperiodic(ng), &
612 & extract(ng) % pm)
613# endif
614!
615! Read in coordinate transfomation metrics (n) associated with the
616! differential distances in ETA.
617!
618 CASE ('pn')
619 gtype=r2dvar
620 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
621 & var_name(i), var_id(i), &
622 & 0, gtype, vsize, &
623 & lbi, ubi, lbj, ubj, &
624 & fscl, fmin, fmax, &
625# ifdef MASKING
626 & extract(ng) % rmask, &
627# endif
628# ifdef CHECKSUM
629 & extract(ng) % pn, &
630 & checksum = fhash)
631# else
632 & extract(ng) % pn)
633# endif
634 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
635 exit_flag=2
636 ioerror=status
637 EXIT
638 ELSE
639 IF (master) THEN
640 WRITE (stdout,30) 'reciprocal ETA-grid spacing: pn', &
641 & ng, trim(ncname), fmin, fmax
642# ifdef CHECKSUM
643 WRITE (stdout,60) fhash
644# endif
645 END IF
646 END IF
647 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
648 CALL exchange_r2d_xtr_tile (ng, tile, &
649 & lbi, ubi, lbj, ubj, &
650 & extract(ng) % pn)
651 END IF
652# ifdef DISTRIBUTE
653 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
654 & lbi, ubi, lbj, ubj, &
655 & nghostpoints, &
656 & ewperiodic(ng), nsperiodic(ng), &
657 & extract(ng) % pn)
658# endif
659# if (defined CURVGRID && defined UV_ADV)
660!
661! Read in derivatives of inverse metrics factors: d(m)/d(eta).
662!
663 CASE ('dmde')
664 gtype=r2dvar
665 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
666 & var_name(i), var_id(i), &
667 & 0, gtype, vsize, &
668 & lbi, ubi, lbj, ubj, &
669 & fscl, fmin, fmax, &
670# ifdef MASKING
671 & extract(ng) % rmask, &
672# endif
673# ifdef CHECKSUM
674 & extract(ng) % dmde, &
675 & checksum = fhash)
676# else
677 & extract(ng) % dmde)
678# endif
679 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
680 exit_flag=2
681 ioerror=status
682 EXIT
683 ELSE
684 IF (master) THEN
685 WRITE (stdout,30) 'ETA-derivative of inverse metric '// &
686 & 'factor pm: dmde', &
687 & ng, trim(ncname), fmin, fmax
688# ifdef CHECKSUM
689 WRITE (stdout,60) fhash
690# endif
691 END IF
692 END IF
693 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
694 CALL exchange_r2d_xtr_tile (ng, tile, &
695 & lbi, ubi, lbj, ubj, &
696 & extract(ng) % dmde)
697 END IF
698# ifdef DISTRIBUTE
699 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
700 & lbi, ubi, lbj, ubj, &
701 & nghostpoints, &
702 & ewperiodic(ng), nsperiodic(ng), &
703 & extract(ng) % dmde)
704# endif
705!
706! Read in derivatives of inverse metrics factors: d(n)/d(xi).
707!
708 CASE ('dndx')
709 gtype=r2dvar
710 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
711 & var_name(i), var_id(i), &
712 & 0, gtype, vsize, &
713 & lbi, ubi, lbj, ubj, &
714 & fscl, fmin, fmax, &
715# ifdef MASKING
716 & extract(ng) % rmask, &
717# endif
718# ifdef CHECKSUM
719 & extract(ng) % dndx, &
720 & checksum = fhash)
721# else
722 & extract(ng) % dndx)
723# endif
724 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
725 exit_flag=2
726 ioerror=status
727 EXIT
728 ELSE
729 IF (master) THEN
730 WRITE (stdout,30) 'XI-derivative of inverse metric '// &
731 & 'factor pn: dndx', &
732 & ng, trim(ncname), fmin, fmax
733# ifdef CHECKSUM
734 WRITE (stdout,60) fhash
735# endif
736 END IF
737 END IF
738 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
739 CALL exchange_r2d_xtr_tile (ng, tile, &
740 & lbi, ubi, lbj, ubj, &
741 & extract(ng) % dndx)
742 END IF
743# ifdef DISTRIBUTE
744 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
745 & lbi, ubi, lbj, ubj, &
746 & nghostpoints, &
747 & ewperiodic(ng), nsperiodic(ng), &
748 & extract(ng) % dndx)
749# endif
750# endif
751!
752! Read in X-coordinates at PSI-points.
753!
754 CASE ('x_psi')
755 gtype=p2dvar
756 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
757 & var_name(i), var_id(i), &
758 & 0, gtype, vsize, &
759 & lbi, ubi, lbj, ubj, &
760 & fscl, fmin, fmax, &
761# ifdef MASKING
762 & extract(ng) % pmask, &
763# endif
764# ifdef CHECKSUM
765 & extract(ng) % xp, &
766 & checksum = fhash)
767# else
768 & extract(ng) % xp)
769# endif
770 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
771 exit_flag=2
772 ioerror=status
773 EXIT
774 ELSE
775 IF (master) THEN
776 WRITE (stdout,30) 'x-location of PSI-points: x_psi', &
777 & ng, trim(ncname), fmin, fmax
778# ifdef CHECKSUM
779 WRITE (stdout,60) fhash
780# endif
781 END IF
782 END IF
783# ifdef DISTRIBUTE
784 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
785 & lbi, ubi, lbj, ubj, &
786 & nghostpoints, &
787 & .false., .false., &
788 & extract(ng) % xp)
789# endif
790!
791! Read in Y-coordinates at PSI-points.
792!
793 CASE ('y_psi')
794 gtype=p2dvar
795 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
796 & var_name(i), var_id(i), &
797 & 0, gtype, vsize, &
798 & lbi, ubi, lbj, ubj, &
799 & fscl, fmin, fmax, &
800# ifdef MASKING
801 & extract(ng) % pmask, &
802# endif
803# ifdef CHECKSUM
804 & extract(ng) % yp, &
805 & checksum = fhash)
806# else
807 & extract(ng) % yp)
808# endif
809 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
810 exit_flag=2
811 ioerror=status
812 EXIT
813 ELSE
814 IF (master) THEN
815 WRITE (stdout,30) 'y-location of PSI-points: y-psi', &
816 & ng, trim(ncname), fmin, fmax
817# ifdef CHECKSUM
818 WRITE (stdout,60) fhash
819# endif
820 END IF
821 END IF
822# ifdef DISTRIBUTE
823 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
824 & lbi, ubi, lbj, ubj, &
825 & nghostpoints, &
826 & .false., .false., &
827 & extract(ng) % yp)
828# endif
829!
830! Read in X-coordinates at RHO-points.
831!
832 CASE ('x_rho')
833 gtype=r2dvar
834 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
835 & var_name(i), var_id(i), &
836 & 0, gtype, vsize, &
837 & lbi, ubi, lbj, ubj, &
838 & fscl, fmin, fmax, &
839# ifdef MASKING
840 & extract(ng) % rmask, &
841# endif
842# ifdef CHECKSUM
843 & extract(ng) % xr, &
844 & checksum = fhash)
845# else
846 & extract(ng) % xr)
847# endif
848 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
849 exit_flag=2
850 ioerror=status
851 EXIT
852 ELSE
853 IF (master) THEN
854 WRITE (stdout,30) 'x-location of RHO-points: x-rho', &
855 & ng, trim(ncname), fmin, fmax
856# ifdef CHECKSUM
857 WRITE (stdout,60) fhash
858# endif
859 END IF
860 END IF
861 IF (.not.spherical) THEN
862 extract(ng)%LonMin(ng)=fmin
863 extract(ng)%LonMax(ng)=fmax
864 END IF
865# ifdef DISTRIBUTE
866 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
867 & lbi, ubi, lbj, ubj, &
868 & nghostpoints, &
869 & .false., .false., &
870 & extract(ng) % xr)
871# endif
872!
873! Read in Y-coordinates at RHO-points.
874!
875 CASE ('y_rho')
876 gtype=r2dvar
877 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
878 & var_name(i), var_id(i), &
879 & 0, gtype, vsize, &
880 & lbi, ubi, lbj, ubj, &
881 & fscl, fmin, fmax, &
882# ifdef MASKING
883 & extract(ng) % rmask, &
884# endif
885# ifdef CHECKSUM
886 & extract(ng) % yr, &
887 & checksum = fhash)
888# else
889 & extract(ng) % yr)
890# endif
891 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
892 exit_flag=2
893 ioerror=status
894 EXIT
895 ELSE
896 IF (master) THEN
897 WRITE (stdout,30) 'y-location of RHO-points: y_rho', &
898 & ng, trim(ncname), fmin, fmax
899# ifdef CHECKSUM
900 WRITE (stdout,60) fhash
901# endif
902 END IF
903 END IF
904 IF (.not.spherical) THEN
905 extract(ng)%LatMin(ng)=fmin
906 extract(ng)%LatMax(ng)=fmax
907 END IF
908# ifdef DISTRIBUTE
909 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
910 & lbi, ubi, lbj, ubj, &
911 & nghostpoints, &
912 & .false., .false., &
913 & extract(ng) % yr)
914# endif
915!
916! Read in X-coordinates at U-points.
917!
918 CASE ('x_u')
919 gtype=u2dvar
920 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
921 & var_name(i), var_id(i), &
922 & 0, gtype, vsize, &
923 & lbi, ubi, lbj, ubj, &
924 & fscl, fmin, fmax, &
925# ifdef MASKING
926 & extract(ng) % umask, &
927# endif
928# ifdef CHECKSUM
929 & extract(ng) % xu, &
930 & checksum = fhash)
931# else
932 & extract(ng) % xu)
933# endif
934 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
935 exit_flag=2
936 ioerror=status
937 EXIT
938 ELSE
939 IF (master) THEN
940 WRITE (stdout,30) 'x-location of U-points: x_u', &
941 & ng, trim(ncname), fmin, fmax
942# ifdef CHECKSUM
943 WRITE (stdout,60) fhash
944# endif
945 END IF
946 END IF
947# ifdef DISTRIBUTE
948 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
949 & lbi, ubi, lbj, ubj, &
950 & nghostpoints, &
951 & .false., .false., &
952 & extract(ng) % xu)
953# endif
954!
955! Read in Y-coordinates at U-points.
956!
957 CASE ('y_u')
958 gtype=u2dvar
959 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
960 & var_name(i), var_id(i), &
961 & 0, gtype, vsize, &
962 & lbi, ubi, lbj, ubj, &
963 & fscl, fmin, fmax, &
964# ifdef MASKING
965 & extract(ng) % umask, &
966# endif
967# ifdef CHECKSUM
968 & extract(ng) % yu, &
969 & checksum = fhash)
970# else
971 & extract(ng) % yu)
972# endif
973 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
974 exit_flag=2
975 ioerror=status
976 EXIT
977 ELSE
978 IF (master) THEN
979 WRITE (stdout,30) 'y-location of U-points: y_u', &
980 & ng, trim(ncname), fmin, fmax
981# ifdef CHECKSUM
982 WRITE (stdout,60) fhash
983# endif
984 END IF
985 END IF
986# ifdef DISTRIBUTE
987 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
988 & lbi, ubi, lbj, ubj, &
989 & nghostpoints, &
990 & .false., .false., &
991 & extract(ng) % yu)
992# endif
993!
994! Read in X-coordinates at V-points.
995!
996 CASE ('x_v')
997 gtype=v2dvar
998 status=nf_fread2d_xtr(ng, model, ncname, grx(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 & extract(ng) % vmask, &
1005# endif
1006# ifdef CHECKSUM
1007 & extract(ng) % xv, &
1008 & checksum = fhash)
1009# else
1010 & extract(ng) % xv)
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) 'x-location of V-points: x_v', &
1019 & ng, trim(ncname), fmin, fmax
1020# ifdef CHECKSUM
1021 WRITE (stdout,60) fhash
1022# endif
1023 END IF
1024 END IF
1025# ifdef DISTRIBUTE
1026 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1027 & lbi, ubi, lbj, ubj, &
1028 & nghostpoints, &
1029 & .false., .false., &
1030 & extract(ng) % xv)
1031# endif
1032!
1033! Read in Y-coordinates at V-points.
1034!
1035 CASE ('y_v')
1036 gtype=v2dvar
1037 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
1038 & var_name(i), var_id(i), &
1039 & 0, gtype, vsize, &
1040 & lbi, ubi, lbj, ubj, &
1041 & fscl, fmin, fmax, &
1042# ifdef MASKING
1043 & extract(ng) % vmask, &
1044# endif
1045# ifdef CHECKSUM
1046 & extract(ng) % yv, &
1047 & checksum = fhash)
1048# else
1049 & extract(ng) % yv)
1050# endif
1051 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1052 exit_flag=2
1053 ioerror=status
1054 EXIT
1055 ELSE
1056 IF (master) THEN
1057 WRITE (stdout,30) 'y-location of V-points: y_v', &
1058 & ng, trim(ncname), fmin, fmax
1059# ifdef CHECKSUM
1060 WRITE (stdout,60) fhash
1061# endif
1062 END IF
1063 END IF
1064# ifdef DISTRIBUTE
1065 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1066 & lbi, ubi, lbj, ubj, &
1067 & nghostpoints, &
1068 & .false., .false., &
1069 & extract(ng) % yv)
1070# endif
1071!
1072! Read in longitude at PSI-points.
1073!
1074 CASE ('lon_psi')
1075 IF (spherical) THEN
1076 gtype=p2dvar
1077 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
1078 & var_name(i), var_id(i), &
1079 & 0, gtype, vsize, &
1080 & lbi, ubi, lbj, ubj, &
1081 & fscl, fmin, fmax, &
1082# ifdef MASKING
1083 & extract(ng) % pmask, &
1084# endif
1085# ifdef CHECKSUM
1086 & extract(ng) % lonp, &
1087 & checksum = fhash)
1088# else
1089 & extract(ng) % lonp)
1090# endif
1091 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1092 exit_flag=2
1093 ioerror=status
1094 EXIT
1095 ELSE
1096 IF (master) THEN
1097 WRITE (stdout,30) 'longitude of PSI-points: lon_psi', &
1098 & ng, trim(ncname), fmin, fmax
1099# ifdef CHECKSUM
1100 WRITE (stdout,60) fhash
1101# endif
1102 END IF
1103 END IF
1104# ifdef DISTRIBUTE
1105 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1106 & lbi, ubi, lbj, ubj, &
1107 & nghostpoints, &
1108 & .false., .false., &
1109 & extract(ng) % lonp)
1110# endif
1111 END IF
1112!
1113! Read in latitude at PSI-points.
1114!
1115 CASE ('lat_psi')
1116 IF (spherical) THEN
1117 gtype=p2dvar
1118 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
1119 & var_name(i), var_id(i), &
1120 & 0, gtype, vsize, &
1121 & lbi, ubi, lbj, ubj, &
1122 & fscl, fmin, fmax, &
1123# ifdef MASKING
1124 & extract(ng) % pmask, &
1125# endif
1126# ifdef CHECKSUM
1127 & extract(ng) % latp, &
1128 & checksum = fhash)
1129# else
1130 & extract(ng) % latp)
1131# endif
1132 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1133 exit_flag=2
1134 ioerror=status
1135 EXIT
1136 ELSE
1137 IF (master) THEN
1138 WRITE (stdout,30) 'latitude of PSI-points lat_psi', &
1139 & ng, trim(ncname), fmin, fmax
1140# ifdef CHECKSUM
1141 WRITE (stdout,60) fhash
1142# endif
1143 END IF
1144 END IF
1145# ifdef DISTRIBUTE
1146 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1147 & lbi, ubi, lbj, ubj, &
1148 & nghostpoints, &
1149 & .false., .false., &
1150 & extract(ng) % latp)
1151# endif
1152 END IF
1153!
1154! Read in longitude at RHO-points.
1155!
1156 CASE ('lon_rho')
1157 IF (spherical) THEN
1158 gtype=r2dvar
1159 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
1160 & var_name(i), var_id(i), &
1161 & 0, gtype, vsize, &
1162 & lbi, ubi, lbj, ubj, &
1163 & fscl, fmin, fmax, &
1164# ifdef MASKING
1165 & extract(ng) % rmask, &
1166# endif
1167# ifdef CHECKSUM
1168 & extract(ng) % lonr, &
1169 & checksum = fhash)
1170# else
1171 & extract(ng) % lonr)
1172# endif
1173 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1174 exit_flag=2
1175 ioerror=status
1176 EXIT
1177 ELSE
1178 IF (master) THEN
1179 WRITE (stdout,30) 'longitude of RHO-points: lon_rho', &
1180 & ng, trim(ncname), fmin, fmax
1181# ifdef CHECKSUM
1182 WRITE (stdout,60) fhash
1183# endif
1184 END IF
1185 END IF
1186 extract(ng)%LonMin(ng)=fmin
1187 extract(ng)%LonMax(ng)=fmax
1188
1189# ifdef DISTRIBUTE
1190 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1191 & lbi, ubi, lbj, ubj, &
1192 & nghostpoints, &
1193 & .false., .false., &
1194 & extract(ng) % lonr)
1195# endif
1196 END IF
1197!
1198! Read in latitude at RHO-points.
1199!
1200 CASE ('lat_rho')
1201 IF (spherical) THEN
1202 gtype=r2dvar
1203 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
1204 & var_name(i), var_id(i), &
1205 & 0, gtype, vsize, &
1206 & lbi, ubi, lbj, ubj, &
1207 & fscl, fmin, fmax, &
1208# ifdef MASKING
1209 & extract(ng) % rmask, &
1210# endif
1211# ifdef CHECKSUM
1212 & extract(ng) % latr, &
1213 & checksum = fhash)
1214# else
1215 & extract(ng) % latr)
1216# endif
1217 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1218 exit_flag=2
1219 ioerror=status
1220 EXIT
1221 ELSE
1222 IF (master) THEN
1223 WRITE (stdout,30) 'latitude of RHO-points lat_rho', &
1224 & ng, trim(ncname), fmin, fmax
1225# ifdef CHECKSUM
1226 WRITE (stdout,60) fhash
1227# endif
1228 END IF
1229 END IF
1230 extract(ng)%LatMin(ng)=fmin
1231 extract(ng)%LatMax(ng)=fmax
1232# ifdef DISTRIBUTE
1233 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1234 & lbi, ubi, lbj, ubj, &
1235 & nghostpoints, &
1236 & .false., .false., &
1237 & extract(ng) % latr)
1238# endif
1239 END IF
1240!
1241! Read in longitude at U-points.
1242!
1243 CASE ('lon_u')
1244 IF (spherical) THEN
1245 gtype=u2dvar
1246 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
1247 & var_name(i), var_id(i), &
1248 & 0, gtype, vsize, &
1249 & lbi, ubi, lbj, ubj, &
1250 & fscl, fmin, fmax, &
1251# ifdef MASKING
1252 & extract(ng) % umask, &
1253# endif
1254# ifdef CHECKSUM
1255 & extract(ng) % lonu, &
1256 & checksum = fhash)
1257# else
1258 & extract(ng) % lonu)
1259# endif
1260 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1261 exit_flag=2
1262 ioerror=status
1263 EXIT
1264 ELSE
1265 IF (master) THEN
1266 WRITE (stdout,30) 'longitude of U-points: lon_u', &
1267 & ng, trim(ncname), fmin, fmax
1268# ifdef CHECKSUM
1269 WRITE (stdout,60) fhash
1270# endif
1271 END IF
1272 END IF
1273# ifdef DISTRIBUTE
1274 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1275 & lbi, ubi, lbj, ubj, &
1276 & nghostpoints, &
1277 & .false., .false., &
1278 & extract(ng) % lonu)
1279# endif
1280 END IF
1281!
1282! Read in latitude at U-points.
1283!
1284 CASE ('lat_u')
1285 IF (spherical) THEN
1286 gtype=u2dvar
1287 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
1288 & var_name(i), var_id(i), &
1289 & 0, gtype, vsize, &
1290 & lbi, ubi, lbj, ubj, &
1291 & fscl, fmin, fmax, &
1292# ifdef MASKING
1293 & extract(ng) % umask, &
1294# endif
1295# ifdef CHECKSUM
1296 & extract(ng) % latu, &
1297 & checksum = fhash)
1298# else
1299 & extract(ng) % latu)
1300# endif
1301 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1302 exit_flag=2
1303 ioerror=status
1304 EXIT
1305 ELSE
1306 IF (master) THEN
1307 WRITE (stdout,30) 'latitude of U-points: lat_u', &
1308 & ng, trim(ncname), fmin, fmax
1309# ifdef CHECKSUM
1310 WRITE (stdout,60) fhash
1311# endif
1312 END IF
1313 END IF
1314# ifdef DISTRIBUTE
1315 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1316 & lbi, ubi, lbj, ubj, &
1317 & nghostpoints, &
1318 & .false., .false., &
1319 & extract(ng) % latu)
1320# endif
1321 END IF
1322!
1323! Read in longitude at V-points.
1324!
1325 CASE ('lon_v')
1326 IF (spherical) THEN
1327 gtype=v2dvar
1328 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
1329 & var_name(i), var_id(i), &
1330 & 0, gtype, vsize, &
1331 & lbi, ubi, lbj, ubj, &
1332 & fscl, fmin, fmax, &
1333# ifdef MASKING
1334 & extract(ng) % vmask, &
1335# endif
1336# ifdef CHECKSUM
1337 & extract(ng) % lonv, &
1338 & checksum = fhash)
1339# else
1340 & extract(ng) % lonv)
1341# endif
1342 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1343 exit_flag=2
1344 ioerror=status
1345 EXIT
1346 ELSE
1347 IF (master) THEN
1348 WRITE (stdout,30) 'longitude of V-points: lon_v', &
1349 & ng, trim(ncname), fmin, fmax
1350# ifdef CHECKSUM
1351 WRITE (stdout,60) fhash
1352# endif
1353 END IF
1354 END IF
1355# ifdef DISTRIBUTE
1356 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1357 & lbi, ubi, lbj, ubj, &
1358 & nghostpoints, &
1359 & .false., .false., &
1360 & extract(ng) % lonv)
1361# endif
1362 END IF
1363!
1364! Read in latitude at V-points.
1365!
1366 CASE ('lat_v')
1367 IF (spherical) THEN
1368 gtype=v2dvar
1369 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
1370 & var_name(i), var_id(i), &
1371 & 0, gtype, vsize, &
1372 & lbi, ubi, lbj, ubj, &
1373 & fscl, fmin, fmax, &
1374# ifdef MASKING
1375 & extract(ng) % vmask, &
1376# endif
1377# ifdef CHECKSUM
1378 & extract(ng) % latv, &
1379 & checksum = fhash)
1380# else
1381 & extract(ng) % latv)
1382# endif
1383 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1384 exit_flag=2
1385 ioerror=status
1386 EXIT
1387 ELSE
1388 IF (master) THEN
1389 WRITE (stdout,30) 'latitude of V-points: lat_v', &
1390 & ng, trim(ncname), fmin, fmax
1391# ifdef CHECKSUM
1392 WRITE (stdout,60) fhash
1393# endif
1394 END IF
1395 END IF
1396# ifdef DISTRIBUTE
1397 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1398 & lbi, ubi, lbj, ubj, &
1399 & nghostpoints, &
1400 & .false., .false., &
1401 & extract(ng) % latv)
1402# endif
1403 END IF
1404!
1405! Read in angle (radians) between XI-axis and EAST at RHO-points.
1406!
1407 CASE ('angle')
1408 gtype=r2dvar
1409 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%ncid, &
1410 & var_name(i), var_id(i), &
1411 & 0, gtype, vsize, &
1412 & lbi, ubi, lbj, ubj, &
1413 & fscl, fmin, fmax, &
1414# ifdef MASKING
1415 & extract(ng) % rmask, &
1416# endif
1417# ifdef CHECKSUM
1418 & extract(ng) % angler, &
1419 & checksum = fhash)
1420# else
1421 & extract(ng) % angler)
1422# endif
1423 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1424 exit_flag=2
1425 ioerror=status
1426 EXIT
1427 ELSE
1428 IF (master) THEN
1429 WRITE (stdout,30) 'angle between XI-axis and EAST: '// &
1430 & 'angler', &
1431 & ng, trim(ncname), fmin, fmax
1432# ifdef CHECKSUM
1433 WRITE (stdout,60) fhash
1434# endif
1435 END IF
1436 END IF
1437 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1438 CALL exchange_r2d_xtr_tile (ng, tile, &
1439 & lbi, ubi, lbj, ubj, &
1440 & extract(ng) % angler)
1441 END IF
1442# ifdef DISTRIBUTE
1443 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1444 & lbi, ubi, lbj, ubj, &
1445 & nghostpoints, &
1446 & ewperiodic(ng), nsperiodic(ng), &
1447 & extract(ng) % angler)
1448# endif
1449 END SELECT
1450 END DO
1451!
1452! Close GRID NetCDF file.
1453!
1454 CALL netcdf_close (ng, model, grx(ng)%ncid, ncname, .false.)
1455 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1456!
1457 10 FORMAT (/,' GET_EXTRACT_NF90 - unable to open grid NetCDF file:', &
1458 & 1x,a)
1459 20 FORMAT (/,' GET_EXTRACT_NF90 - unable to find grid variable: ', &
1460 & a,/,20x,'in grid NetCDF file: ',a)
1461 30 FORMAT (2x,'GET_EXTRACT_NF90 - ',a,/,22x, &
1462 & '(Grid = ',i2.2,', File: ',a,')',/,22x, &
1463 & '(Min = ', 1p,e15.8,0p,' Max = ',1p,e15.8,0p,')')
1464 40 FORMAT (/,' GET_EXTRACT_NF90 - error while reading variable: ', &
1465 & a,/,20x,'in grid NetCDF file: ',a)
1466 50 FORMAT (/,2x,'GET_EXTRACT_NF90 - Reading adjoint sensitivity', &
1467 & ' scope arrays from file:',/22x,a,/)
1468# ifdef CHECKSUM
1469 60 FORMAT (22x,'(CheckSum = ',i0,')')
1470# endif
1471!
1472 RETURN
1473 END SUBROUTINE get_extract_nf90
1474
1475# if defined PIO_LIB && defined DISTRIBUTE
1476!
1477!***********************************************************************
1478 SUBROUTINE get_extract_pio (ng, tile, model, &
1479 & LBi, UBi, LBj, UBj)
1480!***********************************************************************
1481!
1482! Imported variable declarations.
1483!
1484 integer, intent(in) :: ng, tile, model
1485 integer, intent(in) :: LBi, UBi, LBj, UBj
1486!
1487! Local variable declarations.
1488!
1489 integer :: cr, i, status, vindex
1490 integer :: Vsize(4)
1491# ifdef CHECKSUM
1492 integer(i8b) :: Fhash
1493# endif
1494!
1495 real(dp), parameter :: Fscl = 1.0_dp
1496
1497 real(r8) :: Fmax, Fmin
1498!
1499 character (len=256) :: ncname
1500
1501 character (len=*), parameter :: MyFile = &
1502 & __FILE__//", get_extract_pio"
1503!
1504 TYPE (IO_desc_t), pointer :: ioDesc
1505 TYPE (My_VarDesc) :: pioVar
1506!
1507 sourcefile=myfile
1508!
1509!-----------------------------------------------------------------------
1510! Inquire about the contents of grid NetCDF file: Inquire about
1511! the dimensions and variables. Check for consistency.
1512!-----------------------------------------------------------------------
1513!
1514 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1515 ncname=grx(ng)%name
1516!
1517! Open grid NetCDF file for reading.
1518!
1519 IF (grx(ng)%pioFile%fh.eq.-1) THEN
1520 CALL pio_netcdf_open (ng, model, ncname, 0, grx(ng)%pioFile)
1521 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1522 WRITE (stdout,10) trim(ncname)
1523 RETURN
1524 END IF
1525 END IF
1526!
1527! Inquire about the variables.
1528!
1529 CALL pio_netcdf_inq_var (ng, model, ncname, &
1530 & piofile = grx(ng)%pioFile)
1531 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1532!
1533!-----------------------------------------------------------------------
1534! Check if required variables are available.
1535!-----------------------------------------------------------------------
1536!
1537 IF (.not.find_string(var_name,n_var,'spherical',vindex)) THEN
1538 IF (master) WRITE (stdout,20) 'spherical', trim(ncname)
1539 exit_flag=2
1540 RETURN
1541 END IF
1542 IF (.not.find_string(var_name,n_var,'h',vindex)) THEN
1543 IF (master) WRITE (stdout,20) 'h', trim(ncname)
1544 exit_flag=2
1545 RETURN
1546 END IF
1547 IF (.not.find_string(var_name,n_var,'pm',vindex)) THEN
1548 IF (master) WRITE (stdout,20) 'pm', trim(ncname)
1549 exit_flag=2
1550 RETURN
1551 END IF
1552 IF (.not.find_string(var_name,n_var,'pn',vindex)) THEN
1553 IF (master) WRITE (stdout,20) 'pn', trim(ncname)
1554 exit_flag=2
1555 RETURN
1556 END IF
1557# if (defined CURVGRID && defined UV_ADV)
1558 IF (.not.find_string(var_name,n_var,'dndx',vindex)) THEN
1559 IF (master) WRITE (stdout,20) 'dndx', trim(ncname)
1560! exit_flag=2
1561! RETURN
1562 END IF
1563 IF (.not.find_string(var_name,n_var,'dmde',vindex)) THEN
1564 IF (master) WRITE (stdout,20) 'dmde', trim(ncname)
1565! exit_flag=2
1566! RETURN
1567 END IF
1568# endif
1569# ifdef CURVGRID
1570 IF (.not.find_string(var_name,n_var,'angle',vindex)) THEN
1571 IF (master) WRITE (stdout,20) 'angle', trim(ncname)
1572 exit_flag=2
1573 RETURN
1574 END IF
1575# endif
1576# ifdef MASKING
1577 IF (.not.find_string(var_name,n_var,'mask_rho',vindex)) THEN
1578 IF (master) WRITE (stdout,20) 'mask_rho', trim(ncname)
1579 exit_flag=2
1580 RETURN
1581 END IF
1582 IF (.not.find_string(var_name,n_var,'mask_u',vindex)) THEN
1583 IF (master) WRITE (stdout,20) 'mask_u', trim(ncname)
1584 exit_flag=2
1585 RETURN
1586 END IF
1587 IF (.not.find_string(var_name,n_var,'mask_v',vindex)) THEN
1588 IF (master) WRITE (stdout,20) 'mask_v', trim(ncname)
1589 exit_flag=2
1590 RETURN
1591 END IF
1592 IF (.not.find_string(var_name,n_var,'mask_psi',vindex)) THEN
1593 IF (master) WRITE (stdout,20) 'mask_psi', trim(ncname)
1594 exit_flag=2
1595 RETURN
1596 END IF
1597# endif
1598!
1599! Read in logical switch for spherical grid configuration.
1600!
1601 spherical=.false.
1602 IF (find_string(var_name,n_var,'spherical',vindex)) THEN
1603 CALL pio_netcdf_get_lvar (ng, model, ncname, &
1604 & 'spherical', spherical, &
1605 & piofile = grx(ng)%pioFile)
1606 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1607 END IF
1608!
1609!-----------------------------------------------------------------------
1610! Read in grid variables.
1611!-----------------------------------------------------------------------
1612!
1613! Set Vsize to zero to deativate interpolation of input data to model
1614! grid in "nf_fread2d".
1615!
1616 DO i=1,4
1617 vsize(i)=0
1618 END DO
1619!
1620! Scan the variable list and read in needed variables.
1621!
1622 IF (master) WRITE (stdout,'(1x)')
1623!
1624 DO i=1,n_var
1625
1626 SELECT CASE (trim(adjustl(var_name(i))))
1627!
1628! Read in bathymetry.
1629!
1630 CASE ('h')
1631 piovar%vd=var_desc(i)
1632 piovar%gtype=r2dvar
1633 IF (kind(extract(ng)%h).eq.8) THEN
1634 piovar%dkind=pio_double
1635 iodesc => iodesc_dp_r2dvar(ng)
1636 ELSE
1637 piovar%dkind=pio_real
1638 iodesc => iodesc_sp_r2dvar(ng)
1639 END IF
1640!
1641 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
1642 & var_name(i), piovar, &
1643 & 0, iodesc, vsize, &
1644 & lbi, ubi, lbj, ubj, &
1645 & fscl, fmin, fmax, &
1646# ifdef MASKING
1647 & extract(ng) % rmask, &
1648# endif
1649# ifdef CHECKSUM
1650 & extract(ng) % h, &
1651 & checksum = fhash)
1652# else
1653 & extract(ng) % h)
1654# endif
1655 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1656 exit_flag=2
1657 ioerror=status
1658 EXIT
1659 ELSE
1660# ifdef SINGLE_PRECISION
1661 extract(ng)%Hmin(ng)=real(fmin,dp)
1662 extract(ng)%Hmax(ng)=real(fmax,dp)
1663# else
1664 extract(ng)%Hmin(ng)=fmin
1665 extract(ng)%Hmax(ng)=fmax
1666# endif
1667 IF (master) THEN
1668 WRITE (stdout,30) 'bathymetry at RHO-points: h', &
1669 & ng, trim(ncname), fmin, fmax
1670# ifdef CHECKSUM
1671 WRITE (stdout,60) fhash
1672# endif
1673 END IF
1674 END IF
1675 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1676 CALL exchange_r2d_xtr_tile (ng, tile, &
1677 & lbi, ubi, lbj, ubj, &
1678 & extract(ng) % h)
1679 END IF
1680# ifdef DISTRIBUTE
1681 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1682 & lbi, ubi, lbj, ubj, &
1683 & nghostpoints, &
1684 & ewperiodic(ng), nsperiodic(ng), &
1685 & extract(ng) % h)
1686# endif
1687# ifdef MASKING
1688!
1689! Read in Land/Sea masking at RHO-points.
1690!
1691 CASE ('mask_rho')
1692 piovar%vd=var_desc(i)
1693 piovar%gtype=r2dvar
1694 IF (kind(extract(ng)%rmask).eq.8) THEN
1695 piovar%dkind=pio_double
1696 iodesc => iodesc_dp_r2dvar(ng)
1697 ELSE
1698 piovar%dkind=pio_real
1699 iodesc => iodesc_sp_r2dvar(ng)
1700 END IF
1701!
1702 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
1703 & var_name(i), piovar, &
1704 & 0, iodesc, vsize, &
1705 & lbi, ubi, lbj, ubj, &
1706 & fscl, fmin, fmax, &
1707 & extract(ng) % rmask, &
1708# ifdef CHECKSUM
1709 & extract(ng) % rmask, &
1710 & checksum = fhash)
1711# else
1712 & extract(ng) % rmask)
1713# endif
1714 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1715 exit_flag=2
1716 ioerror=status
1717 EXIT
1718 ELSE
1719 IF (master) THEN
1720 WRITE (stdout,30) 'mask on RHO-points: mask_rho', &
1721 & ng, trim(ncname), fmin, fmax
1722# ifdef CHECKSUM
1723 WRITE (stdout,60) fhash
1724# endif
1725 END IF
1726 END IF
1727 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1728 CALL exchange_r2d_xtr_tile (ng, tile, &
1729 & lbi, ubi, lbj, ubj, &
1730 & extract(ng) % rmask)
1731 END IF
1732# ifdef DISTRIBUTE
1733 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1734 & lbi, ubi, lbj, ubj, &
1735 & nghostpoints, &
1736 & ewperiodic(ng), nsperiodic(ng), &
1737 & extract(ng) % rmask)
1738# endif
1739!
1740! Read in Land/Sea masking at U-points.
1741!
1742 CASE ('mask_u')
1743 piovar%vd=var_desc(i)
1744 piovar%gtype=u2dvar
1745 IF (kind(extract(ng)%umask).eq.8) THEN
1746 piovar%dkind=pio_double
1747 iodesc => iodesc_dp_u2dvar(ng)
1748 ELSE
1749 piovar%dkind=pio_real
1750 iodesc => iodesc_sp_u2dvar(ng)
1751 END IF
1752!
1753 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
1754 & var_name(i), piovar, &
1755 & 0, iodesc, vsize, &
1756 & lbi, ubi, lbj, ubj, &
1757 & fscl, fmin, fmax, &
1758 & extract(ng) % umask, &
1759# ifdef CHECKSUM
1760 & extract(ng) % umask, &
1761 & checksum = fhash)
1762# else
1763 & extract(ng) % umask)
1764# endif
1765 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1766 exit_flag=2
1767 ioerror=status
1768 EXIT
1769 ELSE
1770 IF (master) THEN
1771 WRITE (stdout,30) 'mask on U-points: mask_u', &
1772 & ng, trim(ncname), fmin, fmax
1773# ifdef CHECKSUM
1774 WRITE (stdout,60) fhash
1775# endif
1776 END IF
1777 END IF
1778 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1779 CALL exchange_u2d_xtr_tile (ng, tile, &
1780 & lbi, ubi, lbj, ubj, &
1781 & extract(ng) % umask)
1782 END IF
1783# ifdef DISTRIBUTE
1784 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1785 & lbi, ubi, lbj, ubj, &
1786 & nghostpoints, &
1787 & ewperiodic(ng), nsperiodic(ng), &
1788 & extract(ng) % umask)
1789# endif
1790!
1791! Read in Land/Sea masking at V-points.
1792!
1793 CASE ('mask_v')
1794 piovar%vd=var_desc(i)
1795 piovar%gtype=v2dvar
1796 IF (kind(extract(ng)%vmask).eq.8) THEN
1797 piovar%dkind=pio_double
1798 iodesc => iodesc_dp_v2dvar(ng)
1799 ELSE
1800 piovar%dkind=pio_real
1801 iodesc => iodesc_sp_v2dvar(ng)
1802 END IF
1803!
1804 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
1805 & var_name(i), piovar, &
1806 & 0, iodesc, vsize, &
1807 & lbi, ubi, lbj, ubj, &
1808 & fscl, fmin, fmax, &
1809 & extract(ng) % vmask, &
1810# ifdef CHECKSUM
1811 & extract(ng) % vmask, &
1812 & checksum = fhash)
1813# else
1814 & extract(ng) % vmask)
1815# endif
1816 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1817 exit_flag=2
1818 ioerror=status
1819 EXIT
1820 ELSE
1821 IF (master) THEN
1822 WRITE (stdout,30) 'mask on V-points: mask_v', &
1823 & ng, trim(ncname), fmin, fmax
1824# ifdef CHECKSUM
1825 WRITE (stdout,60) fhash
1826# endif
1827 END IF
1828 END IF
1829 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1830 CALL exchange_v2d_xtr_tile (ng, tile, &
1831 & lbi, ubi, lbj, ubj, &
1832 & extract(ng) % vmask)
1833 END IF
1834# ifdef DISTRIBUTE
1835 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1836 & lbi, ubi, lbj, ubj, &
1837 & nghostpoints, &
1838 & ewperiodic(ng), nsperiodic(ng), &
1839 & extract(ng) % vmask)
1840# endif
1841!
1842! Read in Land/Sea masking at PSI-points.
1843!
1844 CASE ('mask_psi')
1845 piovar%vd=var_desc(i)
1846 piovar%gtype=p2dvar
1847 IF (kind(extract(ng)%pmask).eq.8) THEN
1848 piovar%dkind=pio_double
1849 iodesc => iodesc_dp_p2dvar(ng)
1850 ELSE
1851 piovar%dkind=pio_real
1852 iodesc => iodesc_sp_p2dvar(ng)
1853 END IF
1854!
1855 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
1856 & var_name(i), piovar, &
1857 & 0, iodesc, vsize, &
1858 & lbi, ubi, lbj, ubj, &
1859 & fscl, fmin, fmax, &
1860 & extract(ng) % pmask, &
1861# ifdef CHECKSUM
1862 & extract(ng) % pmask, &
1863 & checksum = fhash)
1864# else
1865 & extract(ng) % pmask)
1866# endif
1867 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1868 exit_flag=2
1869 ioerror=status
1870 EXIT
1871 ELSE
1872 IF (master) THEN
1873 WRITE (stdout,30) 'mask on PSI-points: mask_psi', &
1874 & ng, trim(ncname), fmin, fmax
1875# ifdef CHECKSUM
1876 WRITE (stdout,60) fhash
1877# endif
1878 END IF
1879 END IF
1880 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1881 CALL exchange_p2d_xtr_tile (ng, tile, &
1882 & lbi, ubi, lbj, ubj, &
1883 & extract(ng) % pmask)
1884 END IF
1885# ifdef DISTRIBUTE
1886 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1887 & lbi, ubi, lbj, ubj, &
1888 & nghostpoints, &
1889 & ewperiodic(ng), nsperiodic(ng), &
1890 & extract(ng) % pmask)
1891# endif
1892# endif
1893!
1894! Read in Coriolis parameter.
1895!
1896 CASE ('f')
1897 piovar%vd=var_desc(i)
1898 piovar%gtype=r2dvar
1899 IF (kind(extract(ng)%pn).eq.8) THEN
1900 piovar%dkind=pio_double
1901 iodesc => iodesc_dp_r2dvar(ng)
1902 ELSE
1903 piovar%dkind=pio_real
1904 iodesc => iodesc_sp_r2dvar(ng)
1905 END IF
1906!
1907 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
1908 & var_name(i), piovar, &
1909 & 0, iodesc, vsize, &
1910 & lbi, ubi, lbj, ubj, &
1911 & fscl, fmin, fmax, &
1912# ifdef MASKING
1913 & extract(ng) % rmask, &
1914# endif
1915# ifdef CHECKSUM
1916 & extract(ng) % f, &
1917 & checksum = fhash)
1918# else
1919 & extract(ng) % f)
1920# endif
1921 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1922 exit_flag=2
1923 ioerror=status
1924 EXIT
1925 ELSE
1926 IF (master) THEN
1927 WRITE (stdout,30) 'Coriolis parameter at RHO-points: f' &
1928 & ng, trim(ncname), fmin, fmax
1929# ifdef CHECKSUM
1930 WRITE (stdout,60) fhash
1931# endif
1932 END IF
1933 END IF
1934 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1935 CALL exchange_r2d_xtr_tile (ng, tile, &
1936 & lbi, ubi, lbj, ubj, &
1937 & extract(ng) % pn)
1938 END IF
1939# ifdef DISTRIBUTE
1940 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1941 & lbi, ubi, lbj, ubj, &
1942 & nghostpoints, &
1943 & ewperiodic(ng), nsperiodic(ng), &
1944 & extract(ng) % pn)
1945# endif
1946!
1947! Read in coordinate transfomation metrics (m) associated with the
1948! differential distances in XI.
1949!
1950 CASE ('pm')
1951 piovar%vd=var_desc(i)
1952 piovar%gtype=r2dvar
1953 IF (kind(extract(ng)%pn).eq.8) THEN
1954 piovar%dkind=pio_double
1955 iodesc => iodesc_dp_r2dvar(ng)
1956 ELSE
1957 piovar%dkind=pio_real
1958 iodesc => iodesc_sp_r2dvar(ng)
1959 END IF
1960!
1961 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
1962 & var_name(i), piovar, &
1963 & 0, iodesc, vsize, &
1964 & lbi, ubi, lbj, ubj, &
1965 & fscl, fmin, fmax, &
1966# ifdef MASKING
1967 & extract(ng) % rmask, &
1968# endif
1969# ifdef CHECKSUM
1970 & extract(ng) % pm, &
1971 & checksum = fhash)
1972# else
1973 & extract(ng) % pm)
1974# endif
1975 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1976 exit_flag=2
1977 ioerror=status
1978 EXIT
1979 ELSE
1980 IF (master) THEN
1981 WRITE (stdout,30) 'reciprocal XI-grid spacing: pm', &
1982 & ng, trim(ncname), fmin, fmax
1983# ifdef CHECKSUM
1984 WRITE (stdout,60) fhash
1985# endif
1986 END IF
1987 END IF
1988 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1989 CALL exchange_r2d_xtr_tile (ng, tile, &
1990 & lbi, ubi, lbj, ubj, &
1991 & extract(ng) % pn)
1992 END IF
1993# ifdef DISTRIBUTE
1994 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
1995 & lbi, ubi, lbj, ubj, &
1996 & nghostpoints, &
1997 & ewperiodic(ng), nsperiodic(ng), &
1998 & extract(ng) % pn)
1999# endif
2000!
2001! Read in coordinate transfomation metrics (n) associated with the
2002! differential distances in ETA.
2003!
2004 CASE ('pn')
2005 piovar%vd=var_desc(i)
2006 piovar%gtype=r2dvar
2007 IF (kind(extract(ng)%pn).eq.8) THEN
2008 piovar%dkind=pio_double
2009 iodesc => iodesc_dp_r2dvar(ng)
2010 ELSE
2011 piovar%dkind=pio_real
2012 iodesc => iodesc_sp_r2dvar(ng)
2013 END IF
2014!
2015 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2016 & var_name(i), piovar, &
2017 & 0, iodesc, vsize, &
2018 & lbi, ubi, lbj, ubj, &
2019 & fscl, fmin, fmax, &
2020# ifdef MASKING
2021 & extract(ng) % rmask, &
2022# endif
2023# ifdef CHECKSUM
2024 & extract(ng) % pn, &
2025 & checksum = fhash)
2026# else
2027 & extract(ng) % pn)
2028# endif
2029 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2030 exit_flag=2
2031 ioerror=status
2032 EXIT
2033 ELSE
2034 IF (master) THEN
2035 WRITE (stdout,30) 'reciprocal ETA-grid spacing: pn', &
2036 & ng, trim(ncname), fmin, fmax
2037# ifdef CHECKSUM
2038 WRITE (stdout,60) fhash
2039# endif
2040 END IF
2041 END IF
2042 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2043 CALL exchange_r2d_xtr_tile (ng, tile, &
2044 & lbi, ubi, lbj, ubj, &
2045 & extract(ng) % pn)
2046 END IF
2047# ifdef DISTRIBUTE
2048 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2049 & lbi, ubi, lbj, ubj, &
2050 & nghostpoints, &
2051 & ewperiodic(ng), nsperiodic(ng), &
2052 & extract(ng) % pn)
2053# endif
2054# if (defined CURVGRID && defined UV_ADV)
2055!
2056! Read in derivatives of inverse metrics factors: d(m)/d(eta).
2057!
2058 CASE ('dmde')
2059 piovar%vd=var_desc(i)
2060 piovar%gtype=r2dvar
2061 IF (kind(extract(ng)%dmde).eq.8) THEN
2062 piovar%dkind=pio_double
2063 iodesc => iodesc_dp_r2dvar(ng)
2064 ELSE
2065 piovar%dkind=pio_real
2066 iodesc => iodesc_sp_r2dvar(ng)
2067 END IF
2068!
2069 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2070 & var_name(i), piovar, &
2071 & 0, iodesc, vsize, &
2072 & lbi, ubi, lbj, ubj, &
2073 & fscl, fmin, fmax, &
2074# ifdef MASKING
2075 & extract(ng) % rmask, &
2076# endif
2077# ifdef CHECKSUM
2078 & extract(ng) % dmde, &
2079 & checksum = fhash)
2080# else
2081 & extract(ng) % dmde)
2082# endif
2083 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2084 exit_flag=2
2085 ioerror=status
2086 EXIT
2087 ELSE
2088 IF (master) THEN
2089 WRITE (stdout,30) 'ETA-derivative of inverse metric '// &
2090 & 'factor pm: dmde', &
2091 & ng, trim(ncname), fmin, fmax
2092# ifdef CHECKSUM
2093 WRITE (stdout,60) fhash
2094# endif
2095 END IF
2096 END IF
2097 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2098 CALL exchange_r2d_xtr_tile (ng, tile, &
2099 & lbi, ubi, lbj, ubj, &
2100 & extract(ng) % dmde)
2101 END IF
2102# ifdef DISTRIBUTE
2103 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2104 & lbi, ubi, lbj, ubj, &
2105 & nghostpoints, &
2106 & ewperiodic(ng), nsperiodic(ng), &
2107 & extract(ng) % dmde)
2108# endif
2109!
2110! Read in derivatives of inverse metrics factors: d(n)/d(xi).
2111!
2112 CASE ('dndx')
2113 piovar%vd=var_desc(i)
2114 piovar%gtype=r2dvar
2115 IF (kind(extract(ng)%dndx).eq.8) THEN
2116 piovar%dkind=pio_double
2117 iodesc => iodesc_dp_r2dvar(ng)
2118 ELSE
2119 piovar%dkind=pio_real
2120 iodesc => iodesc_sp_r2dvar(ng)
2121 END IF
2122!
2123 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2124 & var_name(i), piovar, &
2125 & 0, iodesc, vsize, &
2126 & lbi, ubi, lbj, ubj, &
2127 & fscl, fmin, fmax, &
2128# ifdef MASKING
2129 & extract(ng) % rmask, &
2130# endif
2131# ifdef CHECKSUM
2132 & extract(ng) % dndx, &
2133 & checksum = fhash)
2134# else
2135 & extract(ng) % dndx)
2136# endif
2137 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2138 exit_flag=2
2139 ioerror=status
2140 EXIT
2141 ELSE
2142 IF (master) THEN
2143 WRITE (stdout,30) 'XI-derivative of inverse metric '// &
2144 & 'factor pn: dndx', &
2145 & ng, trim(ncname), fmin, fmax
2146# ifdef CHECKSUM
2147 WRITE (stdout,60) fhash
2148# endif
2149 END IF
2150 END IF
2151 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2152 CALL exchange_r2d_xtr_tile (ng, tile, &
2153 & lbi, ubi, lbj, ubj, &
2154 & extract(ng) % dndx)
2155 END IF
2156# ifdef DISTRIBUTE
2157 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2158 & lbi, ubi, lbj, ubj, &
2159 & nghostpoints, &
2160 & ewperiodic(ng), nsperiodic(ng), &
2161 & extract(ng) % dndx)
2162# endif
2163# endif
2164!
2165! Read in X-coordinates at PSI-points.
2166!
2167 CASE ('x_psi')
2168 piovar%vd=var_desc(i)
2169 piovar%gtype=p2dvar
2170 IF (kind(extract(ng)%xp).eq.8) THEN
2171 piovar%dkind=pio_double
2172 iodesc => iodesc_dp_p2dvar(ng)
2173 ELSE
2174 piovar%dkind=pio_real
2175 iodesc => iodesc_sp_p2dvar(ng)
2176 END IF
2177!
2178 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2179 & var_name(i), piovar, &
2180 & 0, iodesc, vsize, &
2181 & lbi, ubi, lbj, ubj, &
2182 & fscl, fmin, fmax, &
2183# ifdef MASKING
2184 & extract(ng) % pmask, &
2185# endif
2186# ifdef CHECKSUM
2187 & extract(ng) % xp, &
2188 & checksum = fhash)
2189# else
2190 & extract(ng) % xp)
2191# endif
2192 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2193 exit_flag=2
2194 ioerror=status
2195 EXIT
2196 ELSE
2197 IF (master) THEN
2198 WRITE (stdout,30) 'x-location of PSI-points: x_psi', &
2199 & ng, trim(ncname), fmin, fmax
2200# ifdef CHECKSUM
2201 WRITE (stdout,60) fhash
2202# endif
2203 END IF
2204 END IF
2205# ifdef DISTRIBUTE
2206 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2207 & lbi, ubi, lbj, ubj, &
2208 & nghostpoints, &
2209 & .false., .false., &
2210 & extract(ng) % xp)
2211# endif
2212!
2213! Read in Y-coordinates at PSI-points.
2214!
2215 CASE ('y_psi')
2216 piovar%vd=var_desc(i)
2217 piovar%gtype=p2dvar
2218 IF (kind(extract(ng)%yp).eq.8) THEN
2219 piovar%dkind=pio_double
2220 iodesc => iodesc_dp_p2dvar(ng)
2221 ELSE
2222 piovar%dkind=pio_real
2223 iodesc => iodesc_sp_p2dvar(ng)
2224 END IF
2225!
2226 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2227 & var_name(i), piovar, &
2228 & 0, iodesc, vsize, &
2229 & lbi, ubi, lbj, ubj, &
2230 & fscl, fmin, fmax, &
2231# ifdef MASKING
2232 & extract(ng) % pmask, &
2233# endif
2234# ifdef CHECKSUM
2235 & extract(ng) % yp, &
2236 & checksum = fhash)
2237# else
2238 & extract(ng) % yp)
2239# endif
2240 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2241 exit_flag=2
2242 ioerror=status
2243 EXIT
2244 ELSE
2245 IF (master) THEN
2246 WRITE (stdout,30) 'y-location of PSI-points: y-psi', &
2247 & ng, trim(ncname), fmin, fmax
2248# ifdef CHECKSUM
2249 WRITE (stdout,60) fhash
2250# endif
2251 END IF
2252 END IF
2253# ifdef DISTRIBUTE
2254 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2255 & lbi, ubi, lbj, ubj, &
2256 & nghostpoints, &
2257 & .false., .false., &
2258 & extract(ng) % yp)
2259# endif
2260!
2261! Read in X-coordinates at RHO-points.
2262!
2263 CASE ('x_rho')
2264 piovar%vd=var_desc(i)
2265 piovar%gtype=r2dvar
2266 IF (kind(extract(ng)%xr).eq.8) THEN
2267 piovar%dkind=pio_double
2268 iodesc => iodesc_dp_r2dvar(ng)
2269 ELSE
2270 piovar%dkind=pio_real
2271 iodesc => iodesc_sp_r2dvar(ng)
2272 END IF
2273!
2274 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2275 & var_name(i), piovar, &
2276 & 0, iodesc, vsize, &
2277 & lbi, ubi, lbj, ubj, &
2278 & fscl, fmin, fmax, &
2279# ifdef MASKING
2280 & extract(ng) % rmask, &
2281# endif
2282# ifdef CHECKSUM
2283 & extract(ng) % xr, &
2284 & checksum = fhash)
2285# else
2286 & extract(ng) % xr)
2287# endif
2288 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2289 exit_flag=2
2290 ioerror=status
2291 EXIT
2292 ELSE
2293 IF (master) THEN
2294 WRITE (stdout,30) 'x-location of RHO-points: x-rho', &
2295 & ng, trim(ncname), fmin, fmax
2296# ifdef CHECKSUM
2297 WRITE (stdout,60) fhash
2298# endif
2299 END IF
2300 END IF
2301 IF (.not.spherical) THEN
2302 extract(ng)%LonMin(ng)=fmin
2303 extract(ng)%LonMax(ng)=fmax
2304 END IF
2305# ifdef DISTRIBUTE
2306 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2307 & lbi, ubi, lbj, ubj, &
2308 & nghostpoints, &
2309 & .false., .false., &
2310 & extract(ng) % xr)
2311# endif
2312!
2313! Read in Y-coordinates at RHO-points.
2314!
2315 CASE ('y_rho')
2316 piovar%vd=var_desc(i)
2317 piovar%gtype=r2dvar
2318 IF (kind(extract(ng)%yr).eq.8) THEN
2319 piovar%dkind=pio_double
2320 iodesc => iodesc_dp_r2dvar(ng)
2321 ELSE
2322 piovar%dkind=pio_real
2323 iodesc => iodesc_sp_r2dvar(ng)
2324 END IF
2325!
2326 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2327 & var_name(i), piovar, &
2328 & 0, iodesc, vsize, &
2329 & lbi, ubi, lbj, ubj, &
2330 & fscl, fmin, fmax, &
2331# ifdef MASKING
2332 & extract(ng) % rmask, &
2333# endif
2334# ifdef CHECKSUM
2335 & extract(ng) % yr, &
2336 & checksum = fhash)
2337# else
2338 & extract(ng) % yr)
2339# endif
2340 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2341 exit_flag=2
2342 ioerror=status
2343 EXIT
2344 ELSE
2345 IF (master) THEN
2346 WRITE (stdout,30) 'y-location of RHO-points: y_rho', &
2347 & ng, trim(ncname), fmin, fmax
2348# ifdef CHECKSUM
2349 WRITE (stdout,60) fhash
2350# endif
2351 END IF
2352 END IF
2353 IF (.not.spherical) THEN
2354 extract(ng)%LatMin(ng)=fmin
2355 extract(ng)%LatMax(ng)=fmax
2356 END IF
2357# ifdef DISTRIBUTE
2358 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2359 & lbi, ubi, lbj, ubj, &
2360 & nghostpoints, &
2361 & .false., .false., &
2362 & extract(ng) % yr)
2363# endif
2364!
2365! Read in X-coordinates at U-points.
2366!
2367 CASE ('x_u')
2368 piovar%vd=var_desc(i)
2369 piovar%gtype=u2dvar
2370 IF (kind(extract(ng)%xu).eq.8) THEN
2371 piovar%dkind=pio_double
2372 iodesc => iodesc_dp_u2dvar(ng)
2373 ELSE
2374 piovar%dkind=pio_real
2375 iodesc => iodesc_sp_u2dvar(ng)
2376 END IF
2377!
2378 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2379 & var_name(i), piovar, &
2380 & 0, iodesc, vsize, &
2381 & lbi, ubi, lbj, ubj, &
2382 & fscl, fmin, fmax, &
2383# ifdef MASKING
2384 & extract(ng) % umask, &
2385# endif
2386# ifdef CHECKSUM
2387 & extract(ng) % xu, &
2388 & checksum = fhash)
2389# else
2390 & extract(ng) % xu)
2391# endif
2392 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2393 exit_flag=2
2394 ioerror=status
2395 EXIT
2396 ELSE
2397 IF (master) THEN
2398 WRITE (stdout,30) 'x-location of U-points: x_u', &
2399 & ng, trim(ncname), fmin, fmax
2400# ifdef CHECKSUM
2401 WRITE (stdout,60) fhash
2402# endif
2403 END IF
2404 END IF
2405# ifdef DISTRIBUTE
2406 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2407 & lbi, ubi, lbj, ubj, &
2408 & nghostpoints, &
2409 & .false., .false., &
2410 & extract(ng) % xu)
2411# endif
2412!
2413! Read in Y-coordinates at U-points.
2414!
2415 CASE ('y_u')
2416 piovar%vd=var_desc(i)
2417 piovar%gtype=u2dvar
2418 IF (kind(extract(ng)%yu).eq.8) THEN
2419 piovar%dkind=pio_double
2420 iodesc => iodesc_dp_u2dvar(ng)
2421 ELSE
2422 piovar%dkind=pio_real
2423 iodesc => iodesc_sp_u2dvar(ng)
2424 END IF
2425!
2426 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2427 & var_name(i), piovar, &
2428 & 0, iodesc, vsize, &
2429 & lbi, ubi, lbj, ubj, &
2430 & fscl, fmin, fmax, &
2431# ifdef MASKING
2432 & extract(ng) % umask, &
2433# endif
2434# ifdef CHECKSUM
2435 & extract(ng) % yu, &
2436 & checksum = fhash)
2437# else
2438 & extract(ng) % yu)
2439# endif
2440 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2441 exit_flag=2
2442 ioerror=status
2443 EXIT
2444 ELSE
2445 IF (master) THEN
2446 WRITE (stdout,30) 'y-location of U-points: y_u', &
2447 & ng, trim(ncname), fmin, fmax
2448# ifdef CHECKSUM
2449 WRITE (stdout,60) fhash
2450# endif
2451 END IF
2452 END IF
2453# ifdef DISTRIBUTE
2454 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2455 & lbi, ubi, lbj, ubj, &
2456 & nghostpoints, &
2457 & .false., .false., &
2458 & extract(ng) % yu)
2459# endif
2460!
2461! Read in X-coordinates at V-points.
2462!
2463 CASE ('x_v')
2464 piovar%vd=var_desc(i)
2465 piovar%gtype=v2dvar
2466 IF (kind(extract(ng)%xv).eq.8) THEN
2467 piovar%dkind=pio_double
2468 iodesc => iodesc_dp_v2dvar(ng)
2469 ELSE
2470 piovar%dkind=pio_real
2471 iodesc => iodesc_sp_v2dvar(ng)
2472 END IF
2473!
2474 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2475 & var_name(i), piovar, &
2476 & 0, iodesc, vsize, &
2477 & lbi, ubi, lbj, ubj, &
2478 & fscl, fmin, fmax, &
2479# ifdef MASKING
2480 & extract(ng) % vmask, &
2481# endif
2482# ifdef CHECKSUM
2483 & extract(ng) % xv, &
2484 & checksum = fhash)
2485# else
2486 & extract(ng) % xv)
2487# endif
2488 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2489 exit_flag=2
2490 ioerror=status
2491 EXIT
2492 ELSE
2493 IF (master) THEN
2494 WRITE (stdout,30) 'x-location of V-points: x_v', &
2495 & ng, trim(ncname), fmin, fmax
2496# ifdef CHECKSUM
2497 WRITE (stdout,60) fhash
2498# endif
2499 END IF
2500 END IF
2501# ifdef DISTRIBUTE
2502 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2503 & lbi, ubi, lbj, ubj, &
2504 & nghostpoints, &
2505 & .false., .false., &
2506 & extract(ng) % xv)
2507# endif
2508!
2509! Read in Y-coordinates at V-points.
2510!
2511 CASE ('y_v')
2512 piovar%vd=var_desc(i)
2513 piovar%gtype=v2dvar
2514 IF (kind(extract(ng)%yv).eq.8) THEN
2515 piovar%dkind=pio_double
2516 iodesc => iodesc_dp_v2dvar(ng)
2517 ELSE
2518 piovar%dkind=pio_real
2519 iodesc => iodesc_sp_v2dvar(ng)
2520 END IF
2521!
2522 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2523 & var_name(i), piovar, &
2524 & 0, iodesc, vsize, &
2525 & lbi, ubi, lbj, ubj, &
2526 & fscl, fmin, fmax, &
2527# ifdef MASKING
2528 & extract(ng) % vmask, &
2529# endif
2530# ifdef CHECKSUM
2531 & extract(ng) % yv, &
2532 & checksum = fhash)
2533# else
2534 & extract(ng) % yv)
2535# endif
2536 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2537 exit_flag=2
2538 ioerror=status
2539 EXIT
2540 ELSE
2541 IF (master) THEN
2542 WRITE (stdout,30) 'y-location of V-points: y_v', &
2543 & ng, trim(ncname), fmin, fmax
2544# ifdef CHECKSUM
2545 WRITE (stdout,60) fhash
2546# endif
2547 END IF
2548 END IF
2549# ifdef DISTRIBUTE
2550 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2551 & lbi, ubi, lbj, ubj, &
2552 & nghostpoints, &
2553 & .false., .false., &
2554 & extract(ng) % yv)
2555# endif
2556!
2557! Read in longitude at PSI-points.
2558!
2559 CASE ('lon_psi')
2560 IF (spherical) THEN
2561 piovar%vd=var_desc(i)
2562 piovar%gtype=p2dvar
2563 IF (kind(extract(ng)%lonp).eq.8) THEN
2564 piovar%dkind=pio_double
2565 iodesc => iodesc_dp_p2dvar(ng)
2566 ELSE
2567 piovar%dkind=pio_real
2568 iodesc => iodesc_sp_p2dvar(ng)
2569 END IF
2570!
2571 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2572 & var_name(i), piovar, &
2573 & 0, iodesc, vsize, &
2574 & lbi, ubi, lbj, ubj, &
2575 & fscl, fmin, fmax, &
2576# ifdef MASKING
2577 & extract(ng) % pmask, &
2578# endif
2579# ifdef CHECKSUM
2580 & extract(ng) % lonp, &
2581 & checksum = fhash)
2582# else
2583 & extract(ng) % lonp)
2584# endif
2585 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2586 exit_flag=2
2587 ioerror=status
2588 EXIT
2589 ELSE
2590 IF (master) THEN
2591 WRITE (stdout,30) 'longitude of PSI-points: lon_psi', &
2592 & ng, trim(ncname), fmin, fmax
2593# ifdef CHECKSUM
2594 WRITE (stdout,60) fhash
2595# endif
2596 END IF
2597 END IF
2598# ifdef DISTRIBUTE
2599 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2600 & lbi, ubi, lbj, ubj, &
2601 & nghostpoints, &
2602 & .false., .false., &
2603 & extract(ng) % lonp)
2604# endif
2605 END IF
2606!
2607! Read in latitude at PSI-points.
2608!
2609 CASE ('lat_psi')
2610 IF (spherical) THEN
2611 piovar%vd=var_desc(i)
2612 piovar%gtype=p2dvar
2613 IF (kind(extract(ng)%latp).eq.8) THEN
2614 piovar%dkind=pio_double
2615 iodesc => iodesc_dp_p2dvar(ng)
2616 ELSE
2617 piovar%dkind=pio_real
2618 iodesc => iodesc_sp_p2dvar(ng)
2619 END IF
2620!
2621 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2622 & var_name(i), piovar, &
2623 & 0, iodesc, vsize, &
2624 & lbi, ubi, lbj, ubj, &
2625 & fscl, fmin, fmax, &
2626# ifdef MASKING
2627 & extract(ng) % pmask, &
2628# endif
2629# ifdef CHECKSUM
2630 & extract(ng) % latp, &
2631 & checksum = fhash)
2632# else
2633 & extract(ng) % latp)
2634# endif
2635 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2636 exit_flag=2
2637 ioerror=status
2638 EXIT
2639 ELSE
2640 IF (master) THEN
2641 WRITE (stdout,30) 'latitude of PSI-points lat_psi', &
2642 & ng, trim(ncname), fmin, fmax
2643# ifdef CHECKSUM
2644 WRITE (stdout,60) fhash
2645# endif
2646 END IF
2647 END IF
2648# ifdef DISTRIBUTE
2649 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2650 & lbi, ubi, lbj, ubj, &
2651 & nghostpoints, &
2652 & .false., .false., &
2653 & extract(ng) % latp)
2654# endif
2655 END IF
2656!
2657! Read in longitude at RHO-points.
2658!
2659 CASE ('lon_rho')
2660 IF (spherical) THEN
2661 piovar%vd=var_desc(i)
2662 piovar%gtype=r2dvar
2663 IF (kind(extract(ng)%lonr).eq.8) THEN
2664 piovar%dkind=pio_double
2665 iodesc => iodesc_dp_r2dvar(ng)
2666 ELSE
2667 piovar%dkind=pio_real
2668 iodesc => iodesc_sp_r2dvar(ng)
2669 END IF
2670!
2671 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2672 & var_name(i), piovar, &
2673 & 0, iodesc, vsize, &
2674 & lbi, ubi, lbj, ubj, &
2675 & fscl, fmin, fmax, &
2676# ifdef MASKING
2677 & extract(ng) % rmask, &
2678# endif
2679# ifdef CHECKSUM
2680 & extract(ng) % lonr, &
2681 & checksum = fhash)
2682# else
2683 & extract(ng) % lonr)
2684# endif
2685 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2686 exit_flag=2
2687 ioerror=status
2688 EXIT
2689 ELSE
2690 IF (master) THEN
2691 WRITE (stdout,30) 'longitude of RHO-points: lon_rho', &
2692 & ng, trim(ncname), fmin, fmax
2693# ifdef CHECKSUM
2694 WRITE (stdout,60) fhash
2695# endif
2696 END IF
2697 END IF
2698 extract(ng)%LonMin(ng)=fmin
2699 extract(ng)%LonMax(ng)=fmax
2700# ifdef DISTRIBUTE
2701 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2702 & lbi, ubi, lbj, ubj, &
2703 & nghostpoints, &
2704 & .false., .false., &
2705 & extract(ng) % lonr)
2706# endif
2707 END IF
2708!
2709! Read in latitude at RHO-points.
2710!
2711 CASE ('lat_rho')
2712 IF (spherical) THEN
2713 piovar%vd=var_desc(i)
2714 piovar%gtype=r2dvar
2715 IF (kind(extract(ng)%latr).eq.8) THEN
2716 piovar%dkind=pio_double
2717 iodesc => iodesc_dp_r2dvar(ng)
2718 ELSE
2719 piovar%dkind=pio_real
2720 iodesc => iodesc_sp_r2dvar(ng)
2721 END IF
2722!
2723 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2724 & var_name(i), piovar, &
2725 & 0, iodesc, vsize, &
2726 & lbi, ubi, lbj, ubj, &
2727 & fscl, fmin, fmax, &
2728# ifdef MASKING
2729 & extract(ng) % rmask, &
2730# endif
2731# ifdef CHECKSUM
2732 & extract(ng) % latr, &
2733 & checksum = fhash)
2734# else
2735 & extract(ng) % latr)
2736# endif
2737 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2738 exit_flag=2
2739 ioerror=status
2740 EXIT
2741 ELSE
2742 IF (master) THEN
2743 WRITE (stdout,30) 'latitude of RHO-points lat_rho', &
2744 & ng, trim(ncname), fmin, fmax
2745# ifdef CHECKSUM
2746 WRITE (stdout,60) fhash
2747# endif
2748 END IF
2749 END IF
2750 extract(ng)%LatMin(ng)=fmin
2751 extract(ng)%LatMax(ng)=fmax
2752# ifdef DISTRIBUTE
2753 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2754 & lbi, ubi, lbj, ubj, &
2755 & nghostpoints, &
2756 & .false., .false., &
2757 & extract(ng) % latr)
2758# endif
2759 END IF
2760!
2761! Read in longitude at U-points.
2762!
2763 CASE ('lon_u')
2764 IF (spherical) THEN
2765 piovar%vd=var_desc(i)
2766 piovar%gtype=u2dvar
2767 IF (kind(extract(ng)%lonu).eq.8) THEN
2768 piovar%dkind=pio_double
2769 iodesc => iodesc_dp_u2dvar(ng)
2770 ELSE
2771 piovar%dkind=pio_real
2772 iodesc => iodesc_sp_u2dvar(ng)
2773 END IF
2774!
2775 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2776 & var_name(i), piovar, &
2777 & 0, iodesc, vsize, &
2778 & lbi, ubi, lbj, ubj, &
2779 & fscl, fmin, fmax, &
2780# ifdef MASKING
2781 & extract(ng) % umask, &
2782# endif
2783# ifdef CHECKSUM
2784 & extract(ng) % lonu, &
2785 & checksum = fhash)
2786# else
2787 & extract(ng) % lonu)
2788# endif
2789 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2790 exit_flag=2
2791 ioerror=status
2792 EXIT
2793 ELSE
2794 IF (master) THEN
2795 WRITE (stdout,30) 'longitude of U-points: lon_u', &
2796 & ng, trim(ncname), fmin, fmax
2797# ifdef CHECKSUM
2798 WRITE (stdout,60) fhash
2799# endif
2800 END IF
2801 END IF
2802# ifdef DISTRIBUTE
2803 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2804 & lbi, ubi, lbj, ubj, &
2805 & nghostpoints, &
2806 & .false., .false., &
2807 & extract(ng) % lonu)
2808# endif
2809 END IF
2810!
2811! Read in latitude at U-points.
2812!
2813 CASE ('lat_u')
2814 IF (spherical) THEN
2815 piovar%vd=var_desc(i)
2816 piovar%gtype=u2dvar
2817 IF (kind(extract(ng)%latu).eq.8) THEN
2818 piovar%dkind=pio_double
2819 iodesc => iodesc_dp_u2dvar(ng)
2820 ELSE
2821 piovar%dkind=pio_real
2822 iodesc => iodesc_sp_u2dvar(ng)
2823 END IF
2824!
2825 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2826 & var_name(i), piovar, &
2827 & 0, iodesc, vsize, &
2828 & lbi, ubi, lbj, ubj, &
2829 & fscl, fmin, fmax, &
2830# ifdef MASKING
2831 & extract(ng) % umask, &
2832# endif
2833# ifdef CHECKSUM
2834 & extract(ng) % latu, &
2835 & checksum = fhash)
2836# else
2837 & extract(ng) % latu)
2838# endif
2839 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2840 exit_flag=2
2841 ioerror=status
2842 EXIT
2843 ELSE
2844 IF (master) THEN
2845 WRITE (stdout,30) 'latitude of U-points: lat_u', &
2846 & ng, trim(ncname), fmin, fmax
2847# ifdef CHECKSUM
2848 WRITE (stdout,60) fhash
2849# endif
2850 END IF
2851 END IF
2852# ifdef DISTRIBUTE
2853 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2854 & lbi, ubi, lbj, ubj, &
2855 & nghostpoints, &
2856 & .false., .false., &
2857 & extract(ng) % latu)
2858# endif
2859 END IF
2860!
2861! Read in longitude at V-points.
2862!
2863 CASE ('lon_v')
2864 IF (spherical) THEN
2865 piovar%vd=var_desc(i)
2866 piovar%gtype=v2dvar
2867 IF (kind(extract(ng)%lonv).eq.8) THEN
2868 piovar%dkind=pio_double
2869 iodesc => iodesc_dp_v2dvar(ng)
2870 ELSE
2871 piovar%dkind=pio_real
2872 iodesc => iodesc_sp_v2dvar(ng)
2873 END IF
2874!
2875 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2876 & var_name(i), piovar, &
2877 & 0, iodesc, vsize, &
2878 & lbi, ubi, lbj, ubj, &
2879 & fscl, fmin, fmax, &
2880# ifdef MASKING
2881 & extract(ng) % vmask, &
2882# endif
2883# ifdef CHECKSUM
2884 & extract(ng) % lonv, &
2885 & checksum = fhash)
2886# else
2887 & extract(ng) % lonv)
2888# endif
2889 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2890 exit_flag=2
2891 ioerror=status
2892 EXIT
2893 ELSE
2894 IF (master) THEN
2895 WRITE (stdout,30) 'longitude of V-points: lon_v', &
2896 & ng, trim(ncname), fmin, fmax
2897# ifdef CHECKSUM
2898 WRITE (stdout,60) fhash
2899# endif
2900 END IF
2901 END IF
2902# ifdef DISTRIBUTE
2903 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2904 & lbi, ubi, lbj, ubj, &
2905 & nghostpoints, &
2906 & .false., .false., &
2907 & extract(ng) % lonv)
2908# endif
2909 END IF
2910!
2911! Read in latitude at V-points.
2912!
2913 CASE ('lat_v')
2914 IF (spherical) THEN
2915 piovar%vd=var_desc(i)
2916 piovar%gtype=v2dvar
2917 IF (kind(extract(ng)%latv).eq.8) THEN
2918 piovar%dkind=pio_double
2919 iodesc => iodesc_dp_v2dvar(ng)
2920 ELSE
2921 piovar%dkind=pio_real
2922 iodesc => iodesc_sp_v2dvar(ng)
2923 END IF
2924!
2925 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2926 & var_name(i), piovar, &
2927 & 0, iodesc, vsize, &
2928 & lbi, ubi, lbj, ubj, &
2929 & fscl, fmin, fmax, &
2930# ifdef MASKING
2931 & extract(ng) % vmask, &
2932# endif
2933# ifdef CHECKSUM
2934 & extract(ng) % latv, &
2935 & checksum = fhash)
2936# else
2937 & extract(ng) % latv)
2938# endif
2939 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2940 exit_flag=2
2941 ioerror=status
2942 EXIT
2943 ELSE
2944 IF (master) THEN
2945 WRITE (stdout,30) 'latitude of V-points: lat_v', &
2946 & ng, trim(ncname), fmin, fmax
2947# ifdef CHECKSUM
2948 WRITE (stdout,60) fhash
2949# endif
2950 END IF
2951 END IF
2952# ifdef DISTRIBUTE
2953 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
2954 & lbi, ubi, lbj, ubj, &
2955 & nghostpoints, &
2956 & .false., .false., &
2957 & extract(ng) % latv)
2958# endif
2959 END IF
2960!
2961! Read in angle (radians) between XI-axis and EAST at RHO-points.
2962!
2963 CASE ('angle')
2964 piovar%vd=var_desc(i)
2965 piovar%gtype=r2dvar
2966 IF (kind(extract(ng)%angler).eq.8) THEN
2967 piovar%dkind=pio_double
2968 iodesc => iodesc_dp_r2dvar(ng)
2969 ELSE
2970 piovar%dkind=pio_real
2971 iodesc => iodesc_sp_r2dvar(ng)
2972 END IF
2973!
2974 status=nf_fread2d_xtr(ng, model, ncname, grx(ng)%pioFile, &
2975 & var_name(i), piovar, &
2976 & 0, iodesc, vsize, &
2977 & lbi, ubi, lbj, ubj, &
2978 & fscl, fmin, fmax, &
2979# ifdef MASKING
2980 & extract(ng) % rmask, &
2981# endif
2982# ifdef CHECKSUM
2983 & extract(ng) % angler, &
2984 & checksum = fhash)
2985# else
2986 & extract(ng) % angler)
2987# endif
2988 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2989 exit_flag=2
2990 ioerror=status
2991 EXIT
2992 ELSE
2993 IF (master) THEN
2994 WRITE (stdout,30) 'angle between XI-axis and EAST: '// &
2995 & 'angler', &
2996 & ng, trim(ncname), fmin, fmax
2997# ifdef CHECKSUM
2998 WRITE (stdout,60) fhash
2999# endif
3000 END IF
3001 END IF
3002 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3003 CALL exchange_r2d_xtr_tile (ng, tile, &
3004 & lbi, ubi, lbj, ubj, &
3005 & extract(ng) % angler)
3006 END IF
3007# ifdef DISTRIBUTE
3008 CALL mp_exchange2d_xtr (ng, tile, model, 1, &
3009 & lbi, ubi, lbj, ubj, &
3010 & nghostpoints, &
3011 & ewperiodic(ng), nsperiodic(ng), &
3012 & extract(ng) % angler)
3013# endif
3014 END SELECT
3015 END DO
3016!
3017! Close GRID NetCDF file.
3018!
3019 CALL pio_netcdf_close (ng, model, grx(ng)%pioFile, ncname, .false.)
3020 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3021!
3022 10 FORMAT (/,' GET_EXTRACT_PIO - unable to open grid NetCDF file:', &
3023 & 1x,a)
3024 20 FORMAT (/,' GET_EXTRACT_PIO - unable to find grid variable: ',a, &
3025 & /,19x,'in grid NetCDF file: ',a)
3026 30 FORMAT (2x,'GET_EXTRACT_PIO - ',a,/,22x, &
3027 & '(Grid = ',i2.2,', File: ',a,')',/,22x, &
3028 & '(Min = ', 1p,e15.8,0p,' Max = ',1p,e15.8,0p,')')
3029 40 FORMAT (/,' GET_EXTRACT_PIO - error while reading variable: ',a, &
3030 & /,12x,'in grid NetCDF file: ',a)
3031 50 FORMAT (/,2x,'GET_EXTRACT_PIO - Reading adjoint sensitivity', &
3032 & ' scope arrays from file:',/22x,a,/)
3033# ifdef CHECKSUM
3034 60 FORMAT (22x,'(CheckSum = ',i0,')')
3035# endif
3036!
3037 RETURN
3038 END SUBROUTINE get_extract_pio
3039# endif
3040#endif
3041 END MODULE get_extract_mod
mod_netcdf::netcdf_get_lvar
Definition mod_netcdf.F:65
mod_pio_netcdf::pio_netcdf_get_lvar
Definition mod_pio_netcdf.F:72
exchange_2d_xtr_mod
Definition exchange_2d_xtr.F:2
extract_field_mod
Definition extract_field.F:2
get_extract_mod
Definition get_extract.F:2
mod_extract
Definition mod_extract.F:2
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::ioerror
integer ioerror
Definition mod_iounits.F:313
mod_iounits::grx
type(t_io), dimension(:), allocatable grx
Definition mod_iounits.F:219
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_iounits::sourcefile
character(len=256) sourcefile
Definition mod_iounits.F:317
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_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_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::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::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
mp_exchange_mod
Definition mp_exchange.F:2
nf_fread2d_xtr_mod
Definition nf_fread2d_xtr.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