ROMS
Loading...
Searching...
No Matches
get_state.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE get_state_mod
3!
4!git $Id$
5!================================================== Hernan G. Arango ===
6! Copyright (c) 2002-2025 The ROMS Group !
7! Licensed under a MIT/X style license !
8! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine reads in requested model state from specified NetCDF !
12! file. It is usually used to read initial conditions. !
13! !
14! On Input: !
15! !
16! ng Nested grid number (integer) !
17! model Calling model identifier (integer) !
18! msg Message index for StateMsg (string) !
19! S File structure, TYPE(T_IO). !
20! IniRec Time record to read (integer) !
21! Tindex State variable time index to load (integer) !
22! !
23!=======================================================================
24!
25 USE mod_param
26 USE mod_parallel
27#if defined ADJUST_BOUNDARY
28 USE mod_boundary
29#endif
30 USE mod_grid
31#if defined ICE_MODEL && defined SOLVE3D
32 USE mod_ice
33#endif
34 USE mod_iounits
35#if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
36 USE mod_forces
37#endif
38#ifdef FOUR_DVAR
39 USE mod_fourdvar
40#endif
41#if defined GLS_MIXING || defined MY25_MIXING || defined LMD_MIXING || \
42 defined four_dvar
43 USE mod_mixing
44#endif
45 USE mod_ncparam
46 USE mod_ocean
47 USE mod_scalars
48#if defined SEDIMENT || defined BBL_MODEL
49 USE mod_sedbed
50 USE mod_sediment
51#endif
52 USE mod_stepping
53 USE mod_strings
54!
55 USE dateclock_mod, ONLY : time_string
56 USE checkvars_mod, ONLY : checkvars
57 USE lbc_mod, ONLY : lbc_getatt
58#ifdef DISTRIBUTE
59 USE mp_exchange_mod, ONLY : mp_exchange2d
60# ifdef SOLVE3D
61 USE mp_exchange_mod, ONLY : mp_exchange3d
62# endif
63#endif
64#ifdef ADJUST_BOUNDARY
65 USE nf_fread2d_bry_mod, ONLY : nf_fread2d_bry
66# ifdef SOLVE3D
67 USE nf_fread3d_bry_mod, ONLY : nf_fread3d_bry
68# endif
69#endif
70 USE nf_fread2d_mod, ONLY : nf_fread2d
71 USE nf_fread3d_mod, ONLY : nf_fread3d
72#ifdef SOLVE3D
73 USE nf_fread4d_mod, ONLY : nf_fread4d
74#endif
75 USE strings_mod, ONLY : find_string
76 USE strings_mod, ONLY : founderror
77!
78 implicit none
79!
80 PUBLIC :: get_state
81 PRIVATE :: get_state_nf90
82#if defined PIO_LIB && defined DISTRIBUTE
83 PRIVATE :: get_state_pio
84#endif
85!
86 CONTAINS
87!
88!***********************************************************************
89 SUBROUTINE get_state (ng, model, msg, S, IniRec, Tindex)
90!***********************************************************************
91!
92! Imported variable declarations.
93!
94 integer, intent(in) :: ng, model, msg, tindex
95
96 integer, intent(inout) :: inirec
97!
98 TYPE(t_io), intent(inout) :: s
99!
100! Local variable declarations.
101!
102 integer :: tile
103#ifdef ADJUST_BOUNDARY
104 integer :: iorj, lbij, ubij
105#endif
106 integer :: lbi, ubi, lbj, ubj
107!
108 character (len=*), parameter :: myfile = &
109 & __FILE__
110!
111!-----------------------------------------------------------------------
112! Write out history fields according to IO type.
113!-----------------------------------------------------------------------
114!
115#ifdef DISTRIBUTE
116 tile=myrank
117#else
118 tile=-1
119#endif
120!
121#ifdef ADJUST_BOUNDARY
122 lbij=bounds(ng)%LBij
123 ubij=bounds(ng)%UBij
124 iorj=iobounds(ng)%IorJ
125#endif
126 lbi=bounds(ng)%LBi(tile)
127 ubi=bounds(ng)%UBi(tile)
128 lbj=bounds(ng)%LBj(tile)
129 ubj=bounds(ng)%UBj(tile)
130!
131 SELECT CASE (s%IOtype)
132 CASE (io_nf90)
133 CALL get_state_nf90 (ng, model, msg, s, inirec, tindex, &
134#ifdef ADJUST_BOUNDARY
135 & iorj, lbij, ubij, &
136#endif
137 & lbi, ubi, lbj, ubj)
138
139#if defined PIO_LIB && defined DISTRIBUTE
140 CASE (io_pio)
141 CALL get_state_pio (ng, model, msg, s, inirec, tindex, &
142# ifdef ADJUST_BOUNDARY
143 & iorj, lbij, ubij, &
144# endif
145 & lbi, ubi, lbj, ubj)
146#endif
147 CASE DEFAULT
148 IF (master) WRITE (stdout,10) s%IOtype
149 exit_flag=2
150 END SELECT
151 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
152!
153 10 FORMAT (' GET_STATE - Illegal input file type, io_type = ',i0, &
154 & /,13x,'Check KeyWord ''INP_LIB'' in ''roms.in''.')
155!
156 RETURN
157 END SUBROUTINE get_state
158!
159!***********************************************************************
160 SUBROUTINE get_state_nf90 (ng, model, msg, S, IniRec, Tindex, &
161#ifdef ADJUST_BOUNDARY
162 & IorJ, LBij, UBij, &
163#endif
164 & LBi, UBi, LBj, UBj)
165
166!***********************************************************************
167!
168 USE mod_netcdf
169!
170! Imported variable declarations.
171!
172 integer, intent(in) :: ng, model, msg, tindex
173#ifdef ADJUST_BOUNDARY
174 integer, intent(in) :: iorj, lbij, ubij
175#endif
176 integer, intent(in) :: lbi, ubi, lbj, ubj
177
178 integer, intent(inout) :: inirec
179!
180 TYPE(t_io), intent(inout) :: s
181!
182! Local variable declarations.
183!
184 logical :: perfect2d, perfect3d, foundit
185#if defined ADJUST_BOUNDARY || \
186 defined adjust_wstress || defined adjust_stflux
187 logical :: get_adjust
188#endif
189 logical, dimension(NV) :: get_var, have_var
190!
191 integer :: idmod, inprec, gtype, i, ifield, itrc, lstr, lend
192 integer :: nrec, mysize, ncinpid, nvatts, nvdim, status, varid
193 integer :: vsize(4), start(4), total(4)
194 integer(i8b) :: fhash
195!
196 real(dp), parameter :: fscl = 1.0_r8
197
198 real(dp) :: inptime, tmax, my_dstart, scale, time_scale
199 real(r8) :: fmax, fmin
200
201 real(dp), allocatable :: timevar(:)
202!
203 character (len= 5) :: string
204 character (len= 15) :: tstring, attnam, tvarnam
205 character (len= 22) :: t_code
206 character (len= 40) :: tunits
207 character (len=256) :: ncname
208
209 character (len=*), parameter :: myfile = &
210 & __FILE__//", get_state_nf90"
211!
212 sourcefile=myfile
213!
214!-----------------------------------------------------------------------
215! Determine variables to read and their availability.
216!-----------------------------------------------------------------------
217!
218 ncname=trim(s%name)
219!
220! Set model identification string.
221!
222 IF (model.eq.inlm.or.(model.eq.0)) THEN
223 string='NLM: ' ! nonlinear model, restart
224 idmod=inlm
225 ELSE IF (model.eq.itlm) THEN
226 string='TLM: ' ! tangent linear model
227 idmod=itlm
228 ELSE IF (model.eq.irpm) THEN
229 string='RPM: ' ! representer model
230 idmod=irpm
231 ELSE IF (model.eq.iadm) THEN
232 string='ADM: ' ! adjoint model
233 idmod=iadm
234 ELSE IF (model.eq.5) THEN
235 string='NLM: ' ! surface forcing and
236 idmod=inlm ! OBC increments
237 ELSE IF (model.eq.6) THEN
238 string='TLM: ' ! tangent linear error
239 idmod=itlm ! forcing (time covariance)
240 ELSE IF (model.eq.7) THEN
241 string='FRC: ' ! impulse forcing
242 idmod=inlm
243 ELSE IF (model.eq.8) THEN
244 string='TLM: ' ! v-space increments
245 idmod=itlm ! I4D-Var
246 ELSE IF (model.eq.9) THEN
247 string='NLM: ' ! nonlinear model
248 idmod=inlm ! background state
249 ELSE IF (model.eq.10) THEN
250 string='STD: ' ! standard deviation
251 idmod=inlm ! initial conditions
252 ELSE IF (model.eq.11) THEN
253 string='STD: ' ! standard deviation
254 idmod=inlm ! model error
255 ELSE IF (model.eq.12) THEN
256 string='STD: ' ! standard deviation
257 idmod=inlm ! boundary conditions
258 ELSE IF (model.eq.13) THEN
259 string='STD: ' ! standard deviation
260 idmod=inlm ! surface forcing
261 ELSE IF (model.eq.14) THEN
262 string='NRM: ' ! normalization factors
263 idmod=inlm ! initial conditions
264 ELSE IF (model.eq.15) THEN
265 string='NRM: ' ! normalization factors
266 idmod=inlm ! model error
267 ELSE IF (model.eq.16) THEN
268 string='NRM: ' ! normalization factor
269 idmod=inlm ! boundary conditions
270 ELSE IF (model.eq.17) THEN
271 string='NRM: ' ! normalization factor
272 idmod=inlm ! surface forcing
273 END IF
274
275#ifdef PROFILE
276!
277! Turn on time wall clock.
278!
279 CALL wclock_on (ng, idmod, 80, __line__, myfile)
280#endif
281!
282! Set switch to process variables for nonlinear model perfect restart.
283!
284 perfect2d=.false.
285 perfect3d=.false.
286#ifdef PERFECT_RESTART
287 IF (((model.eq.0).or.(model.eq.inlm)).and.(nrrec(ng).ne.0)) THEN
288 perfect2d=.true.
289 perfect3d=.true.
290 END IF
291#endif
292 perfectrst(ng)=perfect2d.or.perfect3d
293!
294! Set Vsize to zero to deactivate interpolation of input data to model
295! grid in "nf_fread2d" and "nf_fread3d".
296!
297 DO i=1,4
298 vsize(i)=0
299 END DO
300!
301!-----------------------------------------------------------------------
302! Open input NetCDF file and check time variable.
303!-----------------------------------------------------------------------
304!
305! Open input NetCDF file.
306!
307 CALL netcdf_open (ng, idmod, ncname, 0, ncinpid)
308 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
309 IF (master) WRITE (stdout,10) string, trim(ncname)
310 RETURN
311 END IF
312!
313! Determine variables to read.
314!
315 CALL checkvars (ng, model, ncname, ncinpid, string, &
316 & nrec, nv, tvarnam, get_var, have_var)
317 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
318 sourcefile=myfile
319
320#if defined DEBUGGING || defined NO_LBC_ATT
321!
322! Lateral boundary conditions attribute not checked in restart file.
323!
324 IF (((model.eq.0).or.(model.eq.inlm)).and.(nrrec(ng).ne.0)) THEN
325 IF (master) WRITE (stdout,20) string, 'NLM_LBC', trim(ncname)
326 END IF
327#else
328!
329! If restart, read in lateral boundary conditions global attribute
330! from restart file and check keyword strings with structure vlues
331! for consistency.
332!
333 IF (((model.eq.0).or.(model.eq.inlm)).and.(nrrec(ng).ne.0)) THEN
334 CALL lbc_getatt (ng, model, ncinpid, ncname, 'NLM_LBC', lbc)
335 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
336 END IF
337#endif
338!
339! Inquire about the input time variable.
340!
341 CALL netcdf_inq_var (ng, idmod, ncname, &
342 & ncid = ncinpid, &
343 & myvarname = trim(tvarnam), &
344 & varid = varid, &
345 & nvardim = nvdim, &
346 & nvaratt = nvatts)
347 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
348!
349! Allocate input time variable and read its value(s). Recall that
350! input time variable is a one-dimensional array with one or several
351! values.
352!
353 mysize=var_dsize(1)
354 IF (.not.allocated(timevar)) allocate (timevar(mysize))
355 CALL netcdf_get_time (ng, idmod, ncname, trim(tvarnam), &
356 & rclock%DateNumber, timevar, &
357 & ncid = ncinpid)
358 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
359!
360! If using the latest time record from input NetCDF file as the
361! initialization record, assign input time.
362!
363 IF (lastrec(ng)) THEN
364 tmax=-1.0_r8
365 DO i=1,mysize
366 IF (timevar(i).gt.tmax) THEN
367 tmax=timevar(i)
368 inirec=i
369 END IF
370 END DO
371 inptime=tmax
372 inprec=inirec
373 ELSE
374 IF ((inirec.ne.0).and.(inirec.gt.mysize)) THEN
375 IF (master) WRITE (stdout,30) string, inirec, trim(ncname), &
376 & mysize
377 exit_flag=2
378 RETURN
379 END IF
380 IF (inirec.ne.0) THEN
381 inprec=inirec
382 ELSE
383 inprec=1
384 END IF
385 inptime=timevar(inprec)
386 END IF
387 IF (allocated(timevar)) deallocate ( timevar )
388!
389! Set input time scale by looking at the "units" attribute.
390!
391 time_scale=0.0_dp
392 DO i=1,nvatts
393 IF (trim(var_aname(i)).eq.'units') THEN
394 IF (index(trim(var_achar(i)),'day').ne.0) THEN
395 time_scale=day2sec
396 ELSE IF (index(trim(var_achar(i)),'second').ne.0) THEN
397 time_scale=1.0_dp
398 END IF
399 END IF
400 END DO
401 IF (time_scale.gt.0.0_r8) THEN
402 inptime=inptime*time_scale
403 END IF
404!
405! Set starting time index and time clock in days. Notice that the
406! global time variables and indices are only over-written when
407! processing initial conditions (msg = 1).
408!
409 IF ((model.eq.0).or.(model.eq.inlm).or. &
410 & (model.eq.itlm).or.(model.eq.irpm)) THEN
411#ifdef GENERIC_DSTART
412 IF (initime(ng).lt.0.0_dp) THEN
413 my_dstart=dstart ! ROMS input script
414 ELSE
415 my_dstart=initime(ng)/86400.0_dp ! NLM IC time is known
416 END IF
417 IF (((model.eq.itlm).or.(model.eq.irpm)).and.(msg.eq.1).and. &
418 & (inptime.ne.(my_dstart*day2sec))) THEN
419 inptime=my_dstart*day2sec
420 END IF
421#else
422 IF (((model.eq.itlm).or.(model.eq.irpm)).and.(msg.eq.1).and. &
423 & (inptime.ne.(dstart*day2sec))) THEN
424 inptime=dstart*day2sec
425 END IF
426#endif
427 IF (msg.eq.1) THEN ! processing initial conditions
428 time(ng)=inptime
429 tdays(ng)=time(ng)*sec2day
430 ntstart(ng)=nint((time(ng)-dstart*day2sec)/dt(ng))+1
431 IF (ntstart(ng).lt.1) ntstart(ng)=1
432 ntend(ng)=ntstart(ng)+ntimes(ng)-1
433 IF (perfectrst(ng)) THEN
434 ntfirst(ng)=1
435 ELSE
436 ntfirst(ng)=ntstart(ng)
437 END IF
438 END IF
439#ifdef WEAK_CONSTRAINT
440 IF (msg.eq.4) THEN
441 forcetime(ng)=time(ng)
442 END IF
443#endif
444 ELSE IF (model.eq.iadm) THEN
445 IF ((msg.eq.1).and.(inptime.eq.0.0_r8)) THEN
446 inptime=time(ng)
447 ELSE IF (msg.ne.1) THEN
448 time(ng)=inptime
449 tdays(ng)=time(ng)*sec2day
450 END IF
451 ntstart(ng)=ntimes(ng)+1
452 ntend(ng)=1
453 ntfirst(ng)=ntend(ng)
454 END IF
455 CALL time_string (time(ng), time_code(ng))
456!
457! Over-write "IniRec" to the actual initial record processed.
458!
459 IF (model.eq.inlm) THEN
460 inirec=inprec
461 END IF
462!
463! Set current input time, io_time . Notice that the model time,
464! time(ng), is reset above. This is a THREADPRIVATE variable in
465! shared-memory and this routine is only processed by the MASTER
466! thread since it is an I/O routine. Therefore, we need to update
467! time(ng) somewhere else in a parallel region. This will be done
468! with io_time variable.
469!
470 io_time=inptime
471!
472! Report information.
473!
474 lstr=scan(ncname,'/',back=.true.)+1
475 lend=len_trim(ncname)
476 IF (master) THEN
477 IF ((10.le.model).and.(model.le.17)) THEN
478 t_code=' ' ! time is meaningless for these fields
479 ELSE
480 CALL time_string (inptime, t_code)
481 END IF
482 WRITE (tstring,'(f15.4)') tdays(ng)
483#if defined I4DVAR || defined I4DVAR_ANA_SENSITIVITY || \
484 defined weak_constraint
485 WRITE (stdout,40) string, trim(statemsg(msg)), &
486 & t_code, ng, ', Outer=', outer, &
487 & trim(adjustl(tstring)), ncname(lstr:lend), &
488 & inprec, tindex
489#else
490 IF (erend.gt.erstr) THEN
491 WRITE (stdout,40) string, trim(statemsg(msg)), &
492 & t_code, ng, ', Iter=', nrun, &
493 & trim(adjustl(tstring)), ncname(lstr:lend), &
494 & inprec, tindex
495 ELSE
496 WRITE (stdout,50) string, trim(statemsg(msg)), &
497 & t_code, ng, trim(adjustl(tstring)), &
498 & ncname(lstr:lend), inprec, tindex
499 END IF
500#endif
501 END IF
502
503#ifdef NONLINEAR
504!
505!-----------------------------------------------------------------------
506! Read in nonlinear state variables. If applicable, read in perfect
507! restart variables.
508!-----------------------------------------------------------------------
509!
510 nlm_state: IF ((model.eq.inlm).or.(model.eq.0)) THEN
511
512# ifdef PERFECT_RESTART
513!
514! Read in time-stepping indices.
515!
516 IF ((model.eq.0).and.(nrrec(ng).ne.0)) THEN
517# ifdef SOLVE3D
518 CALL netcdf_get_ivar (ng, idmod, ncname, 'nstp', &
519 & nstp(ng:), &
520 & ncid = ncinpid, &
521 & start = (/inprec/), &
522 & total = (/1/))
523 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
524
525 CALL netcdf_get_ivar (ng, idmod, ncname, 'nrhs', &
526 & nrhs(ng:), &
527 & ncid = ncinpid, &
528 & start = (/inprec/), &
529 & total = (/1/))
530 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
531
532 CALL netcdf_get_ivar (ng, idmod, ncname, 'nnew', &
533 & nnew(ng:), &
534 & ncid = ncinpid, &
535 & start = (/inprec/), &
536 & total = (/1/))
537 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
538# endif
539 CALL netcdf_get_ivar (ng, idmod, ncname, 'kstp', &
540 & kstp(ng:), &
541 & ncid = ncinpid, &
542 & start = (/inprec/), &
543 & total = (/1/))
544 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
545
546 CALL netcdf_get_ivar (ng, idmod, ncname, 'krhs', &
547 & krhs(ng:), &
548 & ncid = ncinpid, &
549 & start = (/inprec/), &
550 & total = (/1/))
551 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
552
553 CALL netcdf_get_ivar (ng, idmod, ncname, 'knew', &
554 & knew(ng:), &
555 & ncid = ncinpid, &
556 & start = (/inprec/), &
557 & total = (/1/))
558 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
559 END IF
560# endif
561# if defined SEDIMENT && defined SED_MORPH
562!
563! Read in time-evolving bathymetry (m).
564!
565 IF (get_var(idbath)) THEN
566 foundit=find_string(var_name, n_var, trim(vname(1,idbath)), &
567 & varid)
568 IF (foundit) THEN
569 gtype=var_flag(varid)*r2dvar
570 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
571 & vname(1,idbath), varid, &
572 & inprec, gtype, vsize, &
573 & lbi, ubi, lbj, ubj, &
574 & fscl, fmin, fmax, &
575# ifdef MASKING
576 & grid(ng) % rmask, &
577# endif
578# ifdef CHECKSUM
579 & grid(ng) % h, &
580 & checksum = fhash)
581# else
582 & grid(ng) % h)
583# endif
584 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
585 IF (master) THEN
586 WRITE (stdout,60) string, trim(vname(1,idbath)), &
587 & inprec, trim(ncname)
588 END IF
589 exit_flag=2
590 ioerror=status
591 RETURN
592 ELSE
593 IF (master) THEN
594# ifdef CHECKSUM
595 WRITE (stdout,70) trim(vname(2,idbath)), fmin, fmax, &
596 & fhash
597# else
598 WRITE (stdout,70) trim(vname(2,idbath)), fmin, fmax
599# endif
600
601 END IF
602 END IF
603 ELSE
604 IF (master) THEN
605 WRITE (stdout,80) string, trim(vname(1,idbath)), &
606 & trim(ncname)
607 END IF
608 exit_flag=4
609 IF (founderror(exit_flag, nf90_noerr, &
610 & __line__, myfile)) THEN
611 RETURN
612 END IF
613 END IF
614 END IF
615# endif
616!
617! Read in nonlinear free-surface (m).
618!
619 IF (get_var(idfsur)) THEN
620 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
621 & varid)
622 IF (foundit) THEN
623 IF (perfect2d) THEN
624 gtype=var_flag(varid)*r3dvar
625 ELSE
626 gtype=var_flag(varid)*r2dvar
627 END IF
628 IF (perfect2d) THEN
629 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
630 & vname(1,idfsur), varid, &
631 & inprec, gtype, vsize, &
632 & lbi, ubi, lbj, ubj, 1, 3, &
633 & fscl, fmin, fmax, &
634# ifdef MASKING
635 & grid(ng) % rmask, &
636# endif
637# ifdef CHECKSUM
638 & ocean(ng) % zeta, &
639 & checksum = fhash)
640# else
641 & ocean(ng) % zeta)
642# endif
643 ELSE
644 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
645 & vname(1,idfsur), varid, &
646 & inprec, gtype, vsize, &
647 & lbi, ubi, lbj, ubj, &
648 & fscl, fmin, fmax, &
649# ifdef MASKING
650 & grid(ng) % rmask, &
651# endif
652# ifdef CHECKSUM
653 & ocean(ng) % zeta(:,:,tindex), &
654 & checksum = fhash)
655# else
656 & ocean(ng) % zeta(:,:,tindex))
657# endif
658 END IF
659 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
660 IF (master) THEN
661 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
662 & inprec, trim(ncname)
663 END IF
664 exit_flag=2
665 ioerror=status
666 RETURN
667 ELSE
668 IF (master) THEN
669# ifdef CHECKSUM
670 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
671 & fhash
672# else
673 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
674# endif
675
676 END IF
677 END IF
678 ELSE
679 IF (master) THEN
680 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
681 & trim(ncname)
682 END IF
683 exit_flag=4
684 IF (founderror(exit_flag, nf90_noerr, &
685 & __line__, myfile)) THEN
686 RETURN
687 END IF
688 END IF
689 END IF
690!
691! Read in nonlinear RHS of free-surface.
692!
693 IF (get_var(idrzet).and.perfect2d) THEN
694 foundit=find_string(var_name, n_var, trim(vname(1,idrzet)), &
695 & varid)
696 IF (foundit) THEN
697 gtype=var_flag(varid)*r3dvar
698 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
699 & vname(1,idrzet), varid, &
700 & inprec, gtype, vsize, &
701 & lbi, ubi, lbj, ubj, 1, 2, &
702 & fscl, fmin, fmax, &
703# ifdef MASKING
704 & grid(ng) % rmask, &
705# endif
706# ifdef CHECKSUM
707 & ocean(ng) % rzeta, &
708 & checksum = fhash)
709# else
710 & ocean(ng) % rzeta)
711# endif
712 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
713 IF (master) THEN
714 WRITE (stdout,60) string, trim(vname(1,idrzet)), &
715 & inprec, trim(ncname)
716 END IF
717 exit_flag=2
718 ioerror=status
719 RETURN
720 ELSE
721 IF (master) THEN
722# ifdef CHECKSUM
723 WRITE (stdout,70) trim(vname(2,idrzet)), fmin, fmax, &
724 & fhash
725# else
726 WRITE (stdout,70) trim(vname(2,idrzet)), fmin, fmax
727# endif
728
729 END IF
730 END IF
731 ELSE
732 IF (master) THEN
733 WRITE (stdout,80) string, trim(vname(1,idrzet)), &
734 & trim(ncname)
735 END IF
736 exit_flag=4
737 IF (founderror(exit_flag, nf90_noerr, &
738 & __line__, myfile)) THEN
739 RETURN
740 END IF
741 END IF
742 END IF
743!
744! Read in nonlinear 2D U-momentum component (m/s).
745!
746 IF (get_var(idubar)) THEN
747 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
748 & varid)
749 IF (foundit) THEN
750 IF (perfect2d) THEN
751 gtype=var_flag(varid)*u3dvar
752 ELSE
753 gtype=var_flag(varid)*u2dvar
754 END IF
755 IF (perfect2d) THEN
756 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
757 & vname(1,idubar), varid, &
758 & inprec, gtype, vsize, &
759 & lbi, ubi, lbj, ubj, 1, 3, &
760 & fscl, fmin, fmax, &
761# ifdef MASKING
762 & grid(ng) % umask, &
763# endif
764# ifdef CHECKSUM
765 & ocean(ng) % ubar, &
766 & checksum = fhash)
767# else
768 & ocean(ng) % ubar)
769# endif
770 ELSE
771 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
772 & vname(1,idubar), varid, &
773 & inprec, gtype, vsize, &
774 & lbi, ubi, lbj, ubj, &
775 & fscl, fmin, fmax, &
776# ifdef MASKING
777 & grid(ng) % umask, &
778# endif
779# ifdef CHECKSUM
780 & ocean(ng) % ubar(:,:,tindex), &
781 & checksum = fhash)
782# else
783 & ocean(ng) % ubar(:,:,tindex))
784# endif
785 END IF
786 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
787 IF (master) THEN
788 WRITE (stdout,60) string, trim(vname(1,idubar)), &
789 & inprec, trim(ncname)
790 END IF
791 exit_flag=2
792 ioerror=status
793 RETURN
794 ELSE
795 IF (master) THEN
796# ifdef CHECKSUM
797 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
798 & fhash
799# else
800 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
801# endif
802
803 END IF
804 END IF
805 ELSE
806 IF (master) THEN
807 WRITE (stdout,80) string, trim(vname(1,idubar)), &
808 & trim(ncname)
809 END IF
810 exit_flag=4
811 IF (founderror(exit_flag, nf90_noerr, &
812 & __line__, myfile)) THEN
813 RETURN
814 END IF
815 END IF
816 END IF
817!
818! Read in nonlinear RHS of 2D U-momentum component.
819!
820 IF (get_var(idru2d).and.perfect2d) THEN
821 foundit=find_string(var_name, n_var, trim(vname(1,idru2d)), &
822 & varid)
823 IF (foundit) THEN
824 gtype=var_flag(varid)*u3dvar
825 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
826 & vname(1,idru2d), varid, &
827 & inprec, gtype, vsize, &
828 & lbi, ubi, lbj, ubj, 1, 2, &
829 & fscl, fmin, fmax, &
830# ifdef MASKING
831 & grid(ng) % umask, &
832# endif
833# ifdef CHECKSUM
834 & ocean(ng) % rubar, &
835 & checksum = fhash)
836# else
837 & ocean(ng) % rubar)
838# endif
839 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
840 IF (master) THEN
841 WRITE (stdout,60) string, trim(vname(1,idru2d)), &
842 & inprec, trim(ncname)
843 END IF
844 exit_flag=2
845 ioerror=status
846 RETURN
847 ELSE
848 IF (master) THEN
849# ifdef CHECKSUM
850 WRITE (stdout,70) trim(vname(2,idru2d)), fmin, fmax, &
851 & fhash
852# else
853 WRITE (stdout,70) trim(vname(2,idru2d)), fmin, fmax
854# endif
855
856 END IF
857 END IF
858 ELSE
859 IF (master) THEN
860 WRITE (stdout,80) string, trim(vname(1,idru2d)), &
861 & trim(ncname)
862 END IF
863 exit_flag=4
864 IF (founderror(exit_flag, nf90_noerr, &
865 & __line__, myfile)) THEN
866 RETURN
867 END IF
868 END IF
869 END IF
870!
871! Read in nonlinear 2D V-momentum component (m/s).
872!
873 IF (get_var(idvbar)) THEN
874 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
875 & varid)
876 IF (foundit) THEN
877 IF (perfect2d) THEN
878 gtype=var_flag(varid)*v3dvar
879 ELSE
880 gtype=var_flag(varid)*v2dvar
881 END IF
882 IF (perfect2d) THEN
883 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
884 & vname(1,idvbar), varid, &
885 & inprec, gtype, vsize, &
886 & lbi, ubi, lbj, ubj, 1, 3, &
887 & fscl, fmin, fmax, &
888# ifdef MASKING
889 & grid(ng) % vmask, &
890# endif
891# ifdef CHECKSUM
892 & ocean(ng) % vbar, &
893 & checksum = fhash)
894# else
895 & ocean(ng) % vbar)
896# endif
897 ELSE
898 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
899 & vname(1,idvbar), varid, &
900 & inprec, gtype, vsize, &
901 & lbi, ubi, lbj, ubj, &
902 & fscl, fmin, fmax, &
903# ifdef MASKING
904 & grid(ng) % vmask, &
905# endif
906# ifdef CHECKSUM
907 & ocean(ng) % vbar(:,:,tindex), &
908 & checksum = fhash)
909# else
910 & ocean(ng) % vbar(:,:,tindex))
911# endif
912 END IF
913 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
914 IF (master) THEN
915 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
916 & inprec, trim(ncname)
917 END IF
918 exit_flag=2
919 ioerror=status
920 RETURN
921 ELSE
922 IF (master) THEN
923# ifdef CHECKSUM
924 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
925 & fhash
926# else
927 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
928# endif
929
930 END IF
931 END IF
932 ELSE
933 IF (master) THEN
934 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
935 & trim(ncname)
936 END IF
937 exit_flag=4
938 IF (founderror(exit_flag, nf90_noerr, &
939 & __line__, myfile)) THEN
940 RETURN
941 END IF
942 END IF
943 END IF
944!
945! Read in nonlinear RHS 2D V-momentum component.
946!
947 IF (get_var(idrv2d).and.perfect2d) THEN
948 foundit=find_string(var_name, n_var, trim(vname(1,idrv2d)), &
949 & varid)
950 IF (foundit) THEN
951 gtype=var_flag(varid)*v3dvar
952 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
953 & vname(1,idrv2d), varid, &
954 & inprec, gtype, vsize, &
955 & lbi, ubi, lbj, ubj, 1, 2, &
956 & fscl, fmin, fmax, &
957# ifdef MASKING
958 & grid(ng) % vmask, &
959# endif
960# ifdef CHECKSUM
961 & ocean(ng) % rvbar, &
962 & checksum = fhash)
963# else
964 & ocean(ng) % rvbar)
965# endif
966 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
967 IF (master) THEN
968 WRITE (stdout,60) string, trim(vname(1,idrv2d)), &
969 & inprec, trim(ncname)
970 END IF
971 exit_flag=2
972 ioerror=status
973 RETURN
974 ELSE
975 IF (master) THEN
976# ifdef CHECKSUM
977 WRITE (stdout,70) trim(vname(2,idrv2d)), fmin, fmax, &
978 & fhash
979# else
980 WRITE (stdout,70) trim(vname(2,idrv2d)), fmin, fmax
981# endif
982
983 END IF
984 END IF
985 ELSE
986 IF (master) THEN
987 WRITE (stdout,80) string, trim(vname(1,idrv2d)), &
988 & trim(ncname)
989 END IF
990 exit_flag=4
991 IF (founderror(exit_flag, nf90_noerr, &
992 & __line__, myfile)) THEN
993 RETURN
994 END IF
995 END IF
996 END IF
997
998# ifdef SOLVE3D
999!
1000! Read in nonlinear 3D U-momentum component (m/s).
1001!
1002 IF (get_var(iduvel)) THEN
1003 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
1004 & varid)
1005 IF (foundit) THEN
1006 gtype=var_flag(varid)*u3dvar
1007 IF (perfect3d) THEN
1008 status=nf_fread4d(ng, idmod, ncname, ncinpid, &
1009 & vname(1,iduvel), varid, &
1010 & inprec, gtype, vsize, &
1011 & lbi, ubi, lbj, ubj, 1, n(ng), 1, 2, &
1012 & fscl, fmin, fmax, &
1013# ifdef MASKING
1014 & grid(ng) % umask, &
1015# endif
1016# ifdef CHECKSUM
1017 & ocean(ng) % u, &
1018 & checksum = fhash)
1019# else
1020 & ocean(ng) % u)
1021# endif
1022 ELSE
1023 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
1024 & vname(1,iduvel), varid, &
1025 & inprec, gtype, vsize, &
1026 & lbi, ubi, lbj, ubj, 1, n(ng), &
1027 & fscl, fmin, fmax, &
1028# ifdef MASKING
1029 & grid(ng) % umask, &
1030# endif
1031# ifdef CHECKSUM
1032 & ocean(ng) % u(:,:,:,tindex), &
1033 & checksum = fhash)
1034# else
1035 & ocean(ng) % u(:,:,:,tindex))
1036# endif
1037 END IF
1038 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1039 IF (master) THEN
1040 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
1041 & inprec, trim(ncname)
1042 END IF
1043 exit_flag=2
1044 ioerror=status
1045 RETURN
1046 ELSE
1047 IF (master) THEN
1048# ifdef CHECKSUM
1049 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
1050 & fhash
1051# else
1052 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
1053# endif
1054 END IF
1055 END IF
1056 ELSE
1057 IF (master) THEN
1058 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
1059 & trim(ncname)
1060 END IF
1061 exit_flag=4
1062 IF (founderror(exit_flag, nf90_noerr, &
1063 & __line__, myfile)) THEN
1064 RETURN
1065 END IF
1066 END IF
1067 END IF
1068!
1069! Read in nonlinear RHS of 3D U-momentum component.
1070!
1071 IF (get_var(idru3d).and.perfect3d) THEN
1072 foundit=find_string(var_name, n_var, trim(vname(1,idru3d)), &
1073 & varid)
1074 IF (foundit) THEN
1075 gtype=var_flag(varid)*u3dvar
1076 status=nf_fread4d(ng, idmod, ncname, ncinpid, &
1077 & vname(1,idru3d), varid, &
1078 & inprec, gtype, vsize, &
1079 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, &
1080 & fscl, fmin, fmax, &
1081# ifdef MASKING
1082 & grid(ng) % umask, &
1083# endif
1084# ifdef CHECKSUM
1085 & ocean(ng) % ru, &
1086 & checksum = fhash)
1087# else
1088 & ocean(ng) % ru)
1089# endif
1090 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1091 IF (master) THEN
1092 WRITE (stdout,60) string, trim(vname(1,idru3d)), &
1093 & inprec, trim(ncname)
1094 END IF
1095 exit_flag=2
1096 ioerror=status
1097 RETURN
1098 ELSE
1099 IF (master) THEN
1100# ifdef CHECKSUM
1101 WRITE (stdout,70) trim(vname(2,idru3d)), fmin, fmax, &
1102 & fhash
1103# else
1104 WRITE (stdout,70) trim(vname(2,idru3d)), fmin, fmax
1105# endif
1106 END IF
1107 END IF
1108 ELSE
1109 IF (master) THEN
1110 WRITE (stdout,80) string, trim(vname(1,idru3d)), &
1111 & trim(ncname)
1112 END IF
1113 exit_flag=4
1114 IF (founderror(exit_flag, nf90_noerr, &
1115 & __line__, myfile)) THEN
1116 RETURN
1117 END IF
1118 END IF
1119 END IF
1120!
1121! Read in nonlinear 3D V-momentum component (m/s).
1122!
1123 IF (get_var(idvvel)) THEN
1124 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
1125 & varid)
1126 IF (foundit) THEN
1127 gtype=var_flag(varid)*v3dvar
1128 IF (perfect3d) THEN
1129 status=nf_fread4d(ng, idmod, ncname, ncinpid, &
1130 & vname(1,idvvel), varid, &
1131 & inprec, gtype, vsize, &
1132 & lbi, ubi, lbj, ubj, 1, n(ng), 1, 2, &
1133 & fscl, fmin, fmax, &
1134# ifdef MASKING
1135 & grid(ng) % vmask, &
1136# endif
1137# ifdef CHECKSUM
1138 & ocean(ng) % v, &
1139 & checksum = fhash)
1140# else
1141 & ocean(ng) % v)
1142# endif
1143 ELSE
1144 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
1145 & vname(1,idvvel), varid, &
1146 & inprec, gtype, vsize, &
1147 & lbi, ubi, lbj, ubj, 1, n(ng), &
1148 & fscl, fmin, fmax, &
1149# ifdef MASKING
1150 & grid(ng) % vmask, &
1151# endif
1152# ifdef CHECKSUM
1153 & ocean(ng) % v(:,:,:,tindex), &
1154 & checksum = fhash)
1155# else
1156 & ocean(ng) % v(:,:,:,tindex))
1157# endif
1158 END IF
1159 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1160 IF (master) THEN
1161 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
1162 & inprec, trim(ncname)
1163 END IF
1164 exit_flag=2
1165 ioerror=status
1166 RETURN
1167 ELSE
1168 IF (master) THEN
1169# ifdef CHECKSUM
1170 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
1171 & fhash
1172# else
1173 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
1174# endif
1175
1176 END IF
1177 END IF
1178 ELSE
1179 IF (master) THEN
1180 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
1181 & trim(ncname)
1182 END IF
1183 exit_flag=4
1184 IF (founderror(exit_flag, nf90_noerr, &
1185 & __line__, myfile)) THEN
1186 RETURN
1187 END IF
1188 END IF
1189 END IF
1190!
1191! Read in nonlinear RHS of 3D V-momentum component.
1192!
1193 IF (get_var(idrv3d).and.perfect3d) THEN
1194 foundit=find_string(var_name, n_var, trim(vname(1,idrv3d)), &
1195 & varid)
1196 IF (foundit) THEN
1197 gtype=var_flag(varid)*v3dvar
1198 status=nf_fread4d(ng, idmod, ncname, ncinpid, &
1199 & vname(1,idrv3d), varid, &
1200 & inprec, gtype, vsize, &
1201 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, &
1202 & fscl, fmin, fmax, &
1203# ifdef MASKING
1204 & grid(ng) % vmask, &
1205# endif
1206# ifdef CHECKSUM
1207 & ocean(ng) % rv, &
1208 & checksum = fhash)
1209# else
1210 & ocean(ng) % rv)
1211# endif
1212 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1213 IF (master) THEN
1214 WRITE (stdout,60) string, trim(vname(1,idrv3d)), &
1215 & inprec, trim(ncname)
1216 END IF
1217 exit_flag=2
1218 ioerror=status
1219 RETURN
1220 ELSE
1221 IF (master) THEN
1222# ifdef CHECKSUM
1223 WRITE (stdout,70) trim(vname(2,idrv3d)), fmin, fmax, &
1224 & fhash
1225# else
1226 WRITE (stdout,70) trim(vname(2,idrv3d)), fmin, fmax
1227# endif
1228
1229 END IF
1230 END IF
1231 ELSE
1232 IF (master) THEN
1233 WRITE (stdout,80) string, trim(vname(1,idrv3d)), &
1234 & trim(ncname)
1235 END IF
1236 exit_flag=4
1237 IF (founderror(exit_flag, nf90_noerr, &
1238 & __line__, myfile)) THEN
1239 RETURN
1240 END IF
1241 END IF
1242 END IF
1243!
1244! Read in nonlinear tracer type variables.
1245!
1246 DO itrc=1,nt(ng)
1247 IF (get_var(idtvar(itrc))) THEN
1248 foundit=find_string(var_name, n_var, &
1249 & trim(vname(1,idtvar(itrc))), varid)
1250 IF (foundit) THEN
1251 gtype=var_flag(varid)*r3dvar
1252 IF (perfect3d) THEN
1253 status=nf_fread4d(ng, idmod, ncname, ncinpid, &
1254 & vname(1,idtvar(itrc)), varid, &
1255 & inprec, gtype, vsize, &
1256 & lbi, ubi, lbj, ubj, 1, n(ng), 1, 2, &
1257 & fscl, fmin, fmax, &
1258# ifdef MASKING
1259 & grid(ng) % rmask, &
1260# endif
1261# ifdef CHECKSUM
1262 & ocean(ng) % t(:,:,:,:,itrc), &
1263 & checksum = fhash)
1264# else
1265 & ocean(ng) % t(:,:,:,:,itrc))
1266# endif
1267 ELSE
1268 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
1269 & vname(1,idtvar(itrc)), varid, &
1270 & inprec, gtype, vsize, &
1271 & lbi, ubi, lbj, ubj, 1, n(ng), &
1272 & fscl, fmin, fmax, &
1273# ifdef MASKING
1274 & grid(ng) % rmask, &
1275# endif
1276# ifdef CHECKSUM
1277 & ocean(ng) % t(:,:,:,tindex,itrc), &
1278 & checksum = fhash)
1279# else
1280 & ocean(ng) % t(:,:,:,tindex,itrc))
1281# endif
1282 END IF
1283 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1284 IF (master) THEN
1285 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
1286 & inprec, trim(ncname)
1287 END IF
1288 exit_flag=2
1289 ioerror=status
1290 RETURN
1291 ELSE
1292 IF (master) THEN
1293# ifdef CHECKSUM
1294 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
1295 & fmin, fmax, fhash
1296# else
1297 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
1298 & fmin, fmax
1299# endif
1300 END IF
1301 END IF
1302 ELSE
1303 IF (master) THEN
1304 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
1305 & trim(ncname)
1306 END IF
1307 exit_flag=4
1308 IF (founderror(exit_flag, nf90_noerr, &
1309 & __line__, myfile)) THEN
1310 RETURN
1311 END IF
1312 END IF
1313 END IF
1314 END DO
1315
1316# if defined GLS_MIXING || defined MY25_MIXING || defined LMD_MIXING
1317!
1318! Read in vertical viscosity.
1319!
1320 IF (have_var(idvvis)) THEN
1321 foundit=find_string(var_name, n_var, trim(vname(1,idvvis)), &
1322 & varid)
1323 IF (foundit) THEN
1324 gtype=var_flag(varid)*w3dvar
1325 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
1326 & vname(1,idvvis), varid, &
1327 & inprec, gtype, vsize, &
1328 & lbi, ubi, lbj, ubj, 0, n(ng), &
1329 & fscl, fmin,fmax, &
1330# ifdef MASKING
1331 & grid(ng) % rmask, &
1332# endif
1333# ifdef CHECKSUM
1334 & mixing(ng) % AKv, &
1335 & checksum = fhash)
1336# else
1337 & mixing(ng) % AKv)
1338# endif
1339 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1340 IF (master) THEN
1341 WRITE (stdout,60) string, trim(vname(1,idvvis)), &
1342 & inprec, trim(ncname)
1343 END IF
1344 exit_flag=2
1345 ioerror=status
1346 RETURN
1347 ELSE
1348 IF (master) THEN
1349# ifdef CHECKSUM
1350 WRITE (stdout,70) trim(vname(2,idvvis)), fmin, fmax, &
1351 & fhash
1352# else
1353 WRITE (stdout,70) trim(vname(2,idvvis)), fmin, fmax
1354# endif
1355
1356 END IF
1357 END IF
1358# ifdef DISTRIBUTE
1359 CALL mp_exchange3d (ng, myrank, idmod, 1, &
1360 & lbi, ubi, lbj, ubj, 0, n(ng), &
1361 & nghostpoints, &
1362 & ewperiodic(ng), nsperiodic(ng), &
1363 & mixing(ng) % AKv)
1364# endif
1365 ELSE
1366 IF (master) THEN
1367 WRITE (stdout,80) string, trim(vname(1,idvvis)), &
1368 & trim(ncname)
1369 END IF
1370 exit_flag=4
1371 IF (founderror(exit_flag, nf90_noerr, &
1372 & __line__, myfile)) THEN
1373 RETURN
1374 END IF
1375 END IF
1376 END IF
1377!
1378! Read in temperature vertical diffusion.
1379!
1380 IF (have_var(idtdif)) THEN
1381 foundit=find_string(var_name, n_var, trim(vname(1,idtdif)), &
1382 & varid)
1383 IF (foundit) THEN
1384 gtype=var_flag(varid)*w3dvar
1385 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
1386 & vname(1,idtdif), varid, &
1387 & inprec, gtype, vsize, &
1388 & lbi, ubi, lbj, ubj, 0, n(ng), &
1389 & fscl, fmin,fmax, &
1390# ifdef MASKING
1391 & grid(ng) % rmask, &
1392# endif
1393# ifdef CHECKSUM
1394 & mixing(ng) % AKt(:,:,:,itemp), &
1395 & checksum = fhash)
1396# else
1397 & mixing(ng) % AKt(:,:,:,itemp))
1398# endif
1399 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1400 IF (master) THEN
1401 WRITE (stdout,60) string, trim(vname(1,idtdif)), &
1402 & inprec, trim(ncname)
1403 END IF
1404 exit_flag=2
1405 ioerror=status
1406 RETURN
1407 ELSE
1408 IF (master) THEN
1409# ifdef CHECKSUM
1410 WRITE (stdout,70) trim(vname(2,idtdif)), fmin, fmax, &
1411 & fhash
1412# else
1413 WRITE (stdout,70) trim(vname(2,idtdif)), fmin, fmax
1414# endif
1415
1416 END IF
1417 END IF
1418# ifdef DISTRIBUTE
1419 CALL mp_exchange3d (ng, myrank, idmod, 1, &
1420 & lbi, ubi, lbj, ubj, 0, n(ng), &
1421 & nghostpoints, &
1422 & ewperiodic(ng), nsperiodic(ng), &
1423 & mixing(ng) % AKt(:,:,:,itemp))
1424# endif
1425 ELSE
1426 IF (master) THEN
1427 WRITE (stdout,80) string, trim(vname(1,idtdif)), &
1428 & trim(ncname)
1429 END IF
1430 exit_flag=4
1431 IF (founderror(exit_flag, nf90_noerr, &
1432 & __line__, myfile)) THEN
1433 RETURN
1434 END IF
1435 END IF
1436 END IF
1437# ifdef SALINITY
1438!
1439! Read in salinity vertical diffusion.
1440!
1441 IF (have_var(idsdif)) THEN
1442 foundit=find_string(var_name, n_var, trim(vname(1,idsdif)), &
1443 & varid)
1444 IF (foundit) THEN
1445 gtype=var_flag(varid)*w3dvar
1446 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
1447 & vname(1,idsdif), varid, &
1448 & inprec, gtype, vsize, &
1449 & lbi, ubi, lbj, ubj, 0, n(ng), &
1450 & fscl, fmin,fmax, &
1451# ifdef MASKING
1452 & grid(ng) % rmask, &
1453# endif
1454# ifdef CHECKSUM
1455 & mixing(ng) % AKt(:,:,:,isalt), &
1456 & checksum = fhash)
1457# else
1458 & mixing(ng) % AKt(:,:,:,isalt))
1459# endif
1460 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1461 IF (master) THEN
1462 WRITE (stdout,60) string, trim(vname(1,idsdif)), &
1463 & inprec, trim(ncname)
1464 END IF
1465 exit_flag=2
1466 ioerror=status
1467 RETURN
1468 ELSE
1469 IF (master) THEN
1470# ifdef CHECKSUM
1471 WRITE (stdout,70) trim(vname(2,idsdif)), fmin, fmax, &
1472 & fhash
1473# else
1474 WRITE (stdout,70) trim(vname(2,idsdif)), fmin, fmax
1475# endif
1476
1477 END IF
1478 END IF
1479# ifdef DISTRIBUTE
1480 CALL mp_exchange3d (ng, myrank, idmod, 1, &
1481 & lbi, ubi, lbj, ubj, 0, n(ng), &
1482 & nghostpoints, &
1483 & ewperiodic(ng), nsperiodic(ng), &
1484 & mixing(ng) % AKt(:,:,:,isalt))
1485# endif
1486 ELSE
1487 IF (master) THEN
1488 WRITE (stdout,80) string, trim(vname(1,idsdif)), &
1489 & trim(ncname)
1490 END IF
1491 exit_flag=4
1492 IF (founderror(exit_flag, nf90_noerr, &
1493 & __line__, myfile)) THEN
1494 RETURN
1495 END IF
1496 END IF
1497 END IF
1498# endif
1499# endif
1500# if defined LMD_SKPP
1501!
1502! Read in Hsbl
1503!
1504 IF (have_var(idhsbl).and.perfect3d) THEN
1505 foundit=find_string(var_name, n_var, trim(vname(1,idhsbl)), &
1506 & varid)
1507 IF (foundit) THEN
1508 gtype=var_flag(varid)*r2dvar
1509 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
1510 & vname(1,idhsbl), varid, &
1511 & inprec, gtype, vsize, &
1512 & lbi, ubi, lbj, ubj, &
1513 & fscl, fmin, fmax, &
1514# ifdef MASKING
1515 & grid(ng) % rmask, &
1516# endif
1517# ifdef CHECKSUM
1518 & mixing(ng) % Hsbl, &
1519 & checksum = fhash)
1520# else
1521 & mixing(ng) % Hsbl)
1522# endif
1523 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1524 IF (master) THEN
1525 WRITE (stdout,60) string, trim(vname(1,idhsbl)), &
1526 & inprec, trim(ncname)
1527 END IF
1528 exit_flag=2
1529 ioerror=status
1530 RETURN
1531 ELSE
1532 IF (master) THEN
1533# ifdef CHECKSUM
1534 WRITE (stdout,70) trim(vname(2,idhsbl)), fmin, fmax, &
1535 & fhash
1536# else
1537 WRITE (stdout,70) trim(vname(2,idhsbl)), fmin, fmax
1538# endif
1539
1540 END IF
1541 END IF
1542 ELSE
1543 IF (master) THEN
1544 WRITE (stdout,80) string, trim(vname(1,idhsbl)), &
1545 & trim(ncname)
1546 END IF
1547 exit_flag=4
1548 IF (founderror(exit_flag, nf90_noerr, &
1549 & __line__, myfile)) THEN
1550 RETURN
1551 END IF
1552 END IF
1553 END IF
1554# endif
1555# if defined LMD_BKPP
1556!
1557! Read in Hbbl
1558!
1559 IF (have_var(idhbbl).and.perfect3d) THEN
1560 foundit=find_string(var_name, n_var, trim(vname(1,idhbbl)), &
1561 & varid)
1562 IF (foundit) THEN
1563 gtype=var_flag(varid)*r2dvar
1564 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
1565 & vname(1,idhbbl), varid, &
1566 & inprec, gtype, vsize, &
1567 & lbi, ubi, lbj, ubj, &
1568 & fscl, fmin, fmax, &
1569# ifdef MASKING
1570 & grid(ng) % rmask, &
1571# endif
1572# ifdef CHECKSUM
1573 & mixing(ng) % Hbbl, &
1574 & checksum = fhash)
1575# else
1576 & mixing(ng) % Hbbl)
1577# endif
1578 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1579 IF (master) THEN
1580 WRITE (stdout,60) string, trim(vname(1,idhbbl)), &
1581 & inprec, trim(ncname)
1582 END IF
1583 exit_flag=2
1584 ioerror=status
1585 RETURN
1586 ELSE
1587 IF (master) THEN
1588# ifdef CHECKSUM
1589 WRITE (stdout,70) trim(vname(2,idhbbl)), fmin, fmax, &
1590 & fhash
1591# else
1592 WRITE (stdout,70) trim(vname(2,idhbbl)), fmin, fmax
1593# endif
1594
1595 END IF
1596 END IF
1597 ELSE
1598 IF (master) THEN
1599 WRITE (stdout,80) string, trim(vname(1,idhbbl)), &
1600 & trim(ncname)
1601 END IF
1602 exit_flag=4
1603 IF (founderror(exit_flag, nf90_noerr, &
1604 & __line__, myfile)) THEN
1605 RETURN
1606 END IF
1607 END IF
1608 END IF
1609# endif
1610# if defined LMD_NONLOCAL && defined PERFECT_RESTART
1611!
1612! Read in Ghats
1613!
1614 DO itrc=1,nat
1615 IF (have_var(idghat(itrc))) THEN
1616 foundit=find_string(var_name, n_var, &
1617 & trim(vname(1,idghat(itrc))), varid)
1618 IF (foundit) THEN
1619 gtype=var_flag(varid)*w3dvar
1620 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
1621 & vname(1,idghat(itrc)), varid, &
1622 & inprec, gtype, vsize, &
1623 & lbi, ubi, lbj, ubj, 0, n(ng), &
1624 & fscl, fmin,fmax, &
1625# ifdef MASKING
1626 & grid(ng) % rmask, &
1627# endif
1628# ifdef CHECKSUM
1629 & mixing(ng) % Ghats(:,:,:,itrc), &
1630 & checksum = fhash)
1631# else
1632 & mixing(ng) % Ghats(:,:,:,itrc))
1633# endif
1634 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1635 IF (master) THEN
1636 WRITE (stdout,60) string, trim(vname(1,idghat(itrc))), &
1637 & inprec, trim(ncname)
1638 END IF
1639 exit_flag=2
1640 ioerror=status
1641 RETURN
1642 ELSE
1643 IF (master) THEN
1644# ifdef CHECKSUM
1645 WRITE (stdout,70) trim(vname(2,idghat(itrc))), &
1646 & fmin, fmax, fhash
1647# else
1648 WRITE (stdout,70) trim(vname(2,idghat(itrc))), &
1649 & fmin, fmax
1650# endif
1651 END IF
1652 END IF
1653 ELSE
1654 IF (master) THEN
1655 WRITE (stdout,80) string, trim(vname(1,idghat(itrc))), &
1656 & trim(ncname)
1657 END IF
1658 exit_flag=4
1659 IF (founderror(exit_flag, nf90_noerr, &
1660 & __line__, myfile)) THEN
1661 RETURN
1662 END IF
1663 END IF
1664 END IF
1665 END DO
1666# endif
1667# if defined GLS_MIXING || defined MY25_MIXING
1668!
1669! Read in turbulent kinetic energy.
1670!
1671 IF (get_var(idmtke).and.perfect3d) THEN
1672 foundit=find_string(var_name, n_var, trim(vname(1,idmtke)), &
1673 & varid)
1674 IF (foundit) THEN
1675 gtype=var_flag(varid)*w3dvar
1676 status=nf_fread4d(ng, idmod, ncname, ncinpid, &
1677 & vname(1,idmtke), varid, &
1678 & inprec, gtype, vsize, &
1679 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, &
1680 & fscl, fmin, fmax, &
1681# ifdef MASKING
1682 & grid(ng) % rmask, &
1683# endif
1684# ifdef CHECKSUM
1685 & mixing(ng) % tke, &
1686 & checksum = fhash)
1687# else
1688 & mixing(ng) % tke)
1689# endif
1690 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1691 IF (master) THEN
1692 WRITE (stdout,60) string, trim(vname(1,idmtke)), &
1693 & inprec, trim(ncname)
1694 END IF
1695 exit_flag=2
1696 ioerror=status
1697 RETURN
1698 ELSE
1699 IF (master) THEN
1700# ifdef CHECKSUM
1701 WRITE (stdout,70) trim(vname(2,idmtke)), fmin, fmax, &
1702 & fhash
1703# else
1704 WRITE (stdout,70) trim(vname(2,idmtke)), fmin, fmax
1705# endif
1706
1707 END IF
1708 END IF
1709 ELSE
1710 IF (master) THEN
1711 WRITE (stdout,80) string, trim(vname(1,idmtke)), &
1712 & trim(ncname)
1713 END IF
1714 exit_flag=4
1715 IF (founderror(exit_flag, nf90_noerr, &
1716 & __line__, myfile)) THEN
1717 RETURN
1718 END IF
1719 END IF
1720 END IF
1721!
1722! Read in turbulent kinetic energy time length scale.
1723!
1724 IF (get_var(idmtls).and.perfect3d) THEN
1725 foundit=find_string(var_name, n_var, trim(vname(1,idmtls)), &
1726 & varid)
1727 IF (foundit) THEN
1728 gtype=var_flag(varid)*w3dvar
1729 status=nf_fread4d(ng, idmod, ncname, ncinpid, &
1730 & vname(1,idmtls), varid, &
1731 & inprec, gtype, vsize, &
1732 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, &
1733 & fscl, fmin, fmax, &
1734# ifdef MASKING
1735 & grid(ng) % rmask, &
1736# endif
1737# ifdef CHECKSUM
1738 & mixing(ng) % gls, &
1739 & checksum = fhash)
1740# else
1741 & mixing(ng) % gls)
1742# endif
1743 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1744 IF (master) THEN
1745 WRITE (stdout,60) string, trim(vname(1,idmtls)), &
1746 & inprec, trim(ncname)
1747 END IF
1748 exit_flag=2
1749 ioerror=status
1750 RETURN
1751 ELSE
1752 IF (master) THEN
1753# ifdef CHECKSUM
1754 WRITE (stdout,70) trim(vname(2,idmtls)), fmin, fmax, &
1755 & fhash
1756# else
1757 WRITE (stdout,70) trim(vname(2,idmtls)), fmin, fmax
1758# endif
1759
1760 END IF
1761 END IF
1762 ELSE
1763 IF (master) THEN
1764 WRITE (stdout,80) string, trim(vname(1,idmtls)), &
1765 & trim(ncname)
1766 END IF
1767 exit_flag=4
1768 IF (founderror(exit_flag, nf90_noerr, &
1769 & __line__, myfile)) THEN
1770 RETURN
1771 END IF
1772 END IF
1773 END IF
1774!
1775! Read in vertical mixing turbulent length scale.
1776!
1777 IF (get_var(idvmls).and.perfect3d) THEN
1778 foundit=find_string(var_name, n_var, trim(vname(1,idvmls)), &
1779 & varid)
1780 IF (foundit) THEN
1781 gtype=var_flag(varid)*w3dvar
1782 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
1783 & vname(1,idvmls), varid, &
1784 & inprec, gtype, vsize, &
1785 & lbi, ubi, lbj, ubj, 0, n(ng), &
1786 & fscl, fmin, fmax, &
1787# ifdef MASKING
1788 & grid(ng) % rmask, &
1789# endif
1790# ifdef CHECKSUM
1791 & mixing(ng) % Lscale, &
1792 & checksum = fhash)
1793# else
1794 & mixing(ng) % Lscale)
1795# endif
1796 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1797 IF (master) THEN
1798 WRITE (stdout,60) string, trim(vname(1,idvmls)), &
1799 & inprec, trim(ncname)
1800 END IF
1801 exit_flag=2
1802 ioerror=status
1803 RETURN
1804 ELSE
1805 IF (master) THEN
1806# ifdef CHECKSUM
1807 WRITE (stdout,70) trim(vname(2,idvmls)), fmin, fmax, &
1808 & fhash
1809# else
1810 WRITE (stdout,70) trim(vname(2,idvmls)), fmin, fmax
1811# endif
1812
1813 END IF
1814 END IF
1815 ELSE
1816 IF (master) THEN
1817 WRITE (stdout,80) string, trim(vname(1,idvmls)), &
1818 & trim(ncname)
1819 END IF
1820 exit_flag=4
1821 IF (founderror(exit_flag, nf90_noerr, &
1822 & __line__, myfile)) THEN
1823 RETURN
1824 END IF
1825 END IF
1826 END IF
1827!
1828! Read in turbulent kinetic energy vertical diffusion coefficient.
1829!
1830 IF (get_var(idvmkk).and.perfect3d) THEN
1831 foundit=find_string(var_name, n_var, trim(vname(1,idvmkk)), &
1832 & varid)
1833 IF (foundit) THEN
1834 gtype=var_flag(varid)*w3dvar
1835 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
1836 & vname(1,idvmkk), varid, &
1837 & inprec, gtype, vsize, &
1838 & lbi, ubi, lbj, ubj, 0, n(ng), &
1839 & fscl, fmin, fmax, &
1840# ifdef MASKING
1841 & grid(ng) % rmask, &
1842# endif
1843# ifdef CHECKSUM
1844 & mixing(ng) % Akk, &
1845 & checksum = fhash)
1846# else
1847 & mixing(ng) % Akk)
1848# endif
1849 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1850 IF (master) THEN
1851 WRITE (stdout,60) string, trim(vname(1,idvmkk)), &
1852 & inprec, trim(ncname)
1853 END IF
1854 exit_flag=2
1855 ioerror=status
1856 RETURN
1857 ELSE
1858 IF (master) THEN
1859# ifdef CHECKSUM
1860 WRITE (stdout,70) trim(vname(2,idvmkk)), fmin, fmax, &
1861 & fhash
1862# else
1863 WRITE (stdout,70) trim(vname(2,idvmkk)), fmin, fmax
1864# endif
1865
1866 END IF
1867 END IF
1868 ELSE
1869 IF (master) THEN
1870 WRITE (stdout,80) string, trim(vname(1,idvmkk)), &
1871 & trim(ncname)
1872 END IF
1873 exit_flag=4
1874 IF (founderror(exit_flag, nf90_noerr, &
1875 & __line__, myfile)) THEN
1876 RETURN
1877 END IF
1878 END IF
1879 END IF
1880# ifdef GLS_MIXING
1881!
1882! Read in turbulent length scale vertical diffusion coefficient.
1883!
1884 IF (get_var(idvmkp).and.perfect3d) THEN
1885 foundit=find_string(var_name, n_var, trim(vname(1,idvmkp)), &
1886 & varid)
1887 IF (foundit) THEN
1888 gtype=var_flag(varid)*w3dvar
1889 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
1890 & vname(1,idvmkp), varid, &
1891 & inprec, gtype, vsize, &
1892 & lbi, ubi, lbj, ubj, 0, n(ng), &
1893 & fscl, fmin, fmax, &
1894# ifdef MASKING
1895 & grid(ng) % rmask, &
1896# endif
1897# ifdef CHECKSUM
1898 & mixing(ng) % Akp, &
1899 & checksum = fhash)
1900# else
1901 & mixing(ng) % Akp)
1902# endif
1903 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1904 IF (master) THEN
1905 WRITE (stdout,60) string, trim(vname(1,idvmkp)), &
1906 & inprec, trim(ncname)
1907 END IF
1908 exit_flag=2
1909 ioerror=status
1910 RETURN
1911 ELSE
1912 IF (master) THEN
1913# ifdef CHECKSUM
1914 WRITE (stdout,70) trim(vname(2,idvmkp)), fmin, fmax, &
1915 & fhash
1916# else
1917 WRITE (stdout,70) trim(vname(2,idvmkp)), fmin, fmax
1918# endif
1919
1920 END IF
1921 END IF
1922 ELSE
1923 IF (master) THEN
1924 WRITE (stdout,80) string, trim(vname(1,idvmkp)), &
1925 & trim(ncname)
1926 END IF
1927 exit_flag=4
1928 IF (founderror(exit_flag, nf90_noerr, &
1929 & __line__, myfile)) THEN
1930 RETURN
1931 END IF
1932 END IF
1933 END IF
1934# endif
1935# endif
1936# ifdef SEDIMENT
1937!
1938! Read in nonlinear sediment fraction of each size class in each bed
1939! layer.
1940!
1941 DO i=1,nst
1942 IF (get_var(idfrac(i))) THEN
1943 foundit=find_string(var_name, n_var, &
1944 & trim(vname(1,idfrac(i))), varid)
1945 IF (foundit) THEN
1946 gtype=var_flag(varid)*b3dvar
1947 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
1948 & vname(1,idfrac(i)), varid, &
1949 & inprec, gtype, vsize, &
1950 & lbi, ubi, lbj, ubj, 1, nbed, &
1951 & fscl, fmin, fmax, &
1952# ifdef MASKING
1953 & grid(ng) % rmask, &
1954# endif
1955# ifdef CHECKSUM
1956 & sedbed(ng) % bed_frac(:,:,:,i), &
1957 & checksum = fhash)
1958# else
1959 & sedbed(ng) % bed_frac(:,:,:,i))
1960# endif
1961 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1962 IF (master) THEN
1963 WRITE (stdout,60) string, trim(vname(1,idfrac(i))), &
1964 & inprec, trim(ncname)
1965 END IF
1966 exit_flag=2
1967 ioerror=status
1968 RETURN
1969 ELSE
1970 IF (master) THEN
1971# ifdef CHECKSUM
1972 WRITE (stdout,70) trim(vname(2,idfrac(i))), &
1973 & fmin, fmax, fhash
1974# else
1975 WRITE (stdout,70) trim(vname(2,idfrac(i))), &
1976 & fmin, fmax
1977# endif
1978
1979 END IF
1980 END IF
1981 ELSE
1982 IF (master) THEN
1983 WRITE (stdout,80) string, trim(vname(1,idfrac(i))), &
1984 & trim(ncname)
1985 END IF
1986 exit_flag=4
1987 IF (founderror(exit_flag, nf90_noerr, &
1988 & __line__, myfile)) THEN
1989 RETURN
1990 END IF
1991 END IF
1992 END IF
1993!
1994! Read in nonlinear sediment mass of each size class in each bed layer.
1995!
1996 IF (get_var(idbmas(i))) THEN
1997 foundit=find_string(var_name, n_var, &
1998 & trim(vname(1,idbmas(i))), varid)
1999 IF (foundit) THEN
2000 gtype=var_flag(varid)*b3dvar
2001 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
2002 & vname(1,idbmas(i)), varid, &
2003 & inprec, gtype, vsize, &
2004 & lbi, ubi, lbj, ubj, 1, nbed, &
2005 & fscl, fmin, fmax, &
2006# ifdef MASKING
2007 & grid(ng) % rmask, &
2008# endif
2009# ifdef CHECKSUM
2010 & sedbed(ng) % bed_mass(:,:,:,tindex,i), &
2011 & checksum = fhash)
2012# else
2013 & sedbed(ng) % bed_mass(:,:,:,tindex,i))
2014# endif
2015 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2016 IF (master) THEN
2017 WRITE (stdout,60) string, trim(vname(1,idbmas(i))), &
2018 & inprec, trim(ncname)
2019 END IF
2020 exit_flag=2
2021 ioerror=status
2022 RETURN
2023 ELSE
2024 IF (master) THEN
2025# ifdef CHECKSUM
2026 WRITE (stdout,70) trim(vname(2,idbmas(i))), &
2027 & fmin, fmax, fhash
2028# else
2029 WRITE (stdout,70) trim(vname(2,idbmas(i))), &
2030 & fmin, fmax
2031# endif
2032
2033 END IF
2034 END IF
2035 ELSE
2036 IF (master) THEN
2037 WRITE (stdout,80) string, trim(vname(1,idbmas(i))), &
2038 & trim(ncname)
2039 END IF
2040 exit_flag=4
2041 IF (founderror(exit_flag, nf90_noerr, &
2042 & __line__, myfile)) THEN
2043 RETURN
2044 END IF
2045 END IF
2046 END IF
2047 END DO
2048!
2049! Read in nonlinear sediment properties in each bed layer.
2050!
2051 DO i=1,mbedp
2052 IF (get_var(idsbed(i))) THEN
2053 foundit=find_string(var_name, n_var, &
2054 & trim(vname(1,idsbed(i))), varid)
2055 IF (foundit) THEN
2056 gtype=var_flag(varid)*b3dvar
2057 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
2058 & vname(1,idsbed(i)), varid, &
2059 & inprec, gtype, vsize, &
2060 & lbi, ubi, lbj, ubj, 1, nbed, &
2061 & fscl, fmin, fmax, &
2062# ifdef MASKING
2063 & grid(ng) % rmask, &
2064# endif
2065# ifdef CHECKSUM
2066 & sedbed(ng) % bed(:,:,:,i), &
2067 & checksum = fhash)
2068# else
2069 & sedbed(ng) % bed(:,:,:,i))
2070# endif
2071 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2072 IF (master) THEN
2073 WRITE (stdout,60) string, trim(vname(1,idsbed(i))), &
2074 & inprec, trim(ncname)
2075 END IF
2076 exit_flag=2
2077 ioerror=status
2078 RETURN
2079 ELSE
2080 IF (master) THEN
2081# ifdef CHECKSUM
2082 WRITE (stdout,70) trim(vname(2,idsbed(i))), &
2083 & fmin, fmax, fhash
2084# else
2085 WRITE (stdout,70) trim(vname(2,idsbed(i))), &
2086 & fmin, fmax
2087# endif
2088
2089 END IF
2090 END IF
2091 ELSE
2092 IF (master) THEN
2093 WRITE (stdout,80) string, trim(vname(1,idsbed(i))), &
2094 & trim(ncname)
2095 END IF
2096 exit_flag=4
2097 IF (founderror(exit_flag, nf90_noerr, &
2098 & __line__, myfile)) THEN
2099 RETURN
2100 END IF
2101 END IF
2102 END IF
2103 END DO
2104
2105# ifdef BEDLOAD
2106!
2107! Read in nonlinear sediment fraction of bed load.
2108!
2109 DO i=1,nst
2110 IF (get_var(idubld(i))) THEN
2111 foundit=find_string(var_name, n_var, &
2112 & trim(vname(1,idubld(i))), varid)
2113 IF (foundit) THEN
2114 gtype=var_flag(varid)*u2dvar
2115 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
2116 & vname(1,idubld(i)), varid, &
2117 & inprec, gtype, vsize, &
2118 & lbi, ubi, lbj, ubj, &
2119 & fscl, fmin, fmax, &
2120# ifdef MASKING
2121 & grid(ng) % umask, &
2122# endif
2123# ifdef CHECKSUM
2124 & sedbed(ng) % bedldu(:,:,i), &
2125 & checksum = fhash)
2126# else
2127 & sedbed(ng) % bedldu(:,:,i))
2128# endif
2129 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2130 IF (master) THEN
2131 WRITE (stdout,60) string, trim(vname(1,idubld(i))), &
2132 & inprec, trim(ncname)
2133 END IF
2134 exit_flag=2
2135 ioerror=status
2136 RETURN
2137 ELSE
2138 IF (master) THEN
2139# ifdef CHECKSUM
2140 WRITE (stdout,70) trim(vname(2,idubld(i))), &
2141 & fmin, fmax, fhash
2142# else
2143 WRITE (stdout,70) trim(vname(2,idubld(i))), &
2144 & fmin, fmax
2145# endif
2146
2147 END IF
2148 END IF
2149 ELSE
2150 IF (master) THEN
2151 WRITE (stdout,80) string, trim(vname(1,idubld(i))), &
2152 & trim(ncname)
2153 END IF
2154 exit_flag=4
2155 IF (founderror(exit_flag, nf90_noerr, &
2156 & __line__, myfile)) THEN
2157 RETURN
2158 END IF
2159 END IF
2160 END IF
2161!
2162 IF (get_var(idvbld(i))) THEN
2163 foundit=find_string(var_name, n_var, &
2164 & trim(vname(1,idvbld(i))), varid)
2165 IF (foundit) THEN
2166 gtype=var_flag(varid)*v2dvar
2167 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
2168 & vname(1,idvbld(i)), varid, &
2169 & inprec, gtype, vsize, &
2170 & lbi, ubi, lbj, ubj, &
2171 & fscl, fmin, fmax, &
2172# ifdef MASKING
2173 & grid(ng) % vmask, &
2174# endif
2175# ifdef CHECKSUM
2176 & sedbed(ng) % bedldv(:,:,i), &
2177 & checksum = fhash)
2178# else
2179 & sedbed(ng) % bedldv(:,:,i))
2180# endif
2181 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2182 IF (master) THEN
2183 WRITE (stdout,60) string, trim(vname(1,idvbld(i))), &
2184 & inprec, trim(ncname)
2185 END IF
2186 exit_flag=2
2187 ioerror=status
2188 RETURN
2189 ELSE
2190 IF (master) THEN
2191# ifdef CHECKSUM
2192 WRITE (stdout,70) trim(vname(2,idvbld(i))), &
2193 & fmin, fmax, fhash
2194# else
2195 WRITE (stdout,70) trim(vname(2,idvbld(i))), &
2196 & fmin, fmax
2197# endif
2198
2199 END IF
2200 END IF
2201 ELSE
2202 IF (master) THEN
2203 WRITE (stdout,80) string, trim(vname(1,idvbld(i))), &
2204 & trim(ncname)
2205 END IF
2206 exit_flag=4
2207 IF (founderror(exit_flag, nf90_noerr, &
2208 & __line__, myfile)) THEN
2209 RETURN
2210 END IF
2211 END IF
2212 END IF
2213 END DO
2214# endif
2215# endif
2216
2217# if defined SEDIMENT || defined BBL_MODEL
2218!
2219! Read in nonlinear sediment properties in exposed bed layer.
2220!
2221 DO i=1,mbotp
2222 IF (get_var(idbott(i)).and.have_var(idbott(i))) THEN
2223 foundit=find_string(var_name, n_var, &
2224 & trim(vname(1,idbott(i))), varid)
2225 IF (foundit) THEN
2226 gtype=var_flag(varid)*r2dvar
2227 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
2228 & vname(1,idbott(i)), varid, &
2229 & inprec, gtype, vsize, &
2230 & lbi, ubi, lbj, ubj, &
2231 & fscl, fmin, fmax, &
2232# ifdef MASKING
2233 & grid(ng) % rmask, &
2234# endif
2235# ifdef CHECKSUM
2236 & sedbed(ng) % bottom(:,:,i), &
2237 & checksum = fhash)
2238# else
2239 & sedbed(ng) % bottom(:,:,i))
2240# endif
2241 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2242 IF (master) THEN
2243 WRITE (stdout,60) string, trim(vname(1,idbott(i))), &
2244 & inprec, trim(ncname)
2245 END IF
2246 exit_flag=2
2247 ioerror=status
2248 RETURN
2249 ELSE
2250 IF (master) THEN
2251# ifdef CHECKSUM
2252 WRITE (stdout,70) trim(vname(2,idbott(i))), &
2253 & fmin, fmax, fhash
2254# else
2255 WRITE (stdout,70) trim(vname(2,idbott(i))), &
2256 & fmin, fmax
2257# endif
2258
2259 END IF
2260 END IF
2261 ELSE
2262 IF (master) THEN
2263 WRITE (stdout,80) string, trim(vname(1,idbott(i))), &
2264 & trim(ncname)
2265 END IF
2266 exit_flag=4
2267 IF (founderror(exit_flag, nf90_noerr, &
2268 & __line__, myfile)) THEN
2269 RETURN
2270 END IF
2271 END IF
2272 END IF
2273 END DO
2274# endif
2275# ifdef ICE_MODEL
2276!
2277! Read sea ice model state variables.
2278!
2279 DO i=1,nices
2280 IF (isice(i).gt.0) THEN
2281 ifield=isice(i)
2282 IF (get_var(ifield)) THEN
2283 foundit=find_string(var_name, n_var, &
2284 & trim(vname(1,ifield)), varid)
2285 IF (foundit) THEN
2286 SELECT CASE (i)
2287 CASE (isuice)
2288 gtype=var_flag(varid)*u2dvar
2289 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
2290 & vname(1,ifield), varid, &
2291 & inprec, gtype, vsize, &
2292 & lbi, ubi, lbj, ubj, &
2293 & fscl, fmin, fmax, &
2294# ifdef MASKING
2295 & grid(ng) % umask, &
2296# endif
2297# ifdef CHECKSUM
2298 & ice(ng) % Si(:,:,tindex,i), &
2299 & checksum = fhash)
2300# else
2301 & ice(ng) % Si(:,:,tindex,i))
2302# endif
2303 CASE (isvice)
2304 gtype=var_flag(varid)*v2dvar
2305 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
2306 & vname(1,ifield), varid, &
2307 & inprec, gtype, vsize, &
2308 & lbi, ubi, lbj, ubj, &
2309 & fscl, fmin, fmax, &
2310# ifdef MASKING
2311 & grid(ng) % vmask, &
2312# endif
2313# ifdef CHECKSUM
2314 & ice(ng) % Si(:,:,tindex,i), &
2315 & checksum = fhash)
2316# else
2317 & ice(ng) % Si(:,:,tindex,i))
2318# endif
2319 CASE DEFAULT
2320 gtype=var_flag(varid)*r2dvar
2321 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
2322 & vname(1,ifield), varid, &
2323 & inprec, gtype, vsize, &
2324 & lbi, ubi, lbj, ubj, &
2325 & fscl, fmin, fmax, &
2326# ifdef MASKING
2327 & grid(ng) % rmask, &
2328# endif
2329# ifdef CHECKSUM
2330 & ice(ng) % Si(:,:,tindex,i), &
2331 & checksum = fhash)
2332# else
2333 & ice(ng) % Si(:,:,tindex,i))
2334# endif
2335 END SELECT
2336!
2337 IF (founderror(status, nf90_noerr, __line__, &
2338 & myfile)) THEN
2339 IF (master) THEN
2340 WRITE (stdout,60) string, trim(vname(1,ifield)), &
2341 & inprec, trim(ncname)
2342 END IF
2343 exit_flag=2
2344 ioerror=status
2345 RETURN
2346 ELSE
2347 IF (master) THEN
2348# ifdef CHECKSUM
2349 WRITE (stdout,70) trim(vname(2,ifield)), &
2350 & fmin, fmax, fhash
2351# else
2352 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
2353# endif
2354 END IF
2355 END IF
2356 END IF
2357 ELSE
2358 IF (master) THEN
2359 WRITE (stdout,80) string, trim(vname(1,ifield)), &
2360 & trim(ncname)
2361 END IF
2362 exit_flag=4
2363 IF (founderror(exit_flag, nf90_noerr, &
2364 & __line__, myfile)) THEN
2365 RETURN
2366 END IF
2367 END IF
2368 END IF
2369 END DO
2370# endif
2371# endif
2372 END IF nlm_state
2373#endif
2374
2375#if defined TANGENT || defined TL_IOMS
2376!
2377!-----------------------------------------------------------------------
2378! Read in tangent linear state variables.
2379!-----------------------------------------------------------------------
2380!
2381 tlm_state: IF ((model.eq.itlm).or.(model.eq.irpm)) THEN
2382
2383# if defined ADJUST_BOUNDARY || \
2384 defined adjust_wstress || defined adjust_stflux
2385 IF (inner.eq.0.and.model.eq.irpm) THEN
2386 get_adjust=.false.
2387 ELSE
2388 get_adjust=.true.
2389 END IF
2390# endif
2391!
2392! Read in tangent linear free-surface (m).
2393!
2394 IF (get_var(idfsur)) THEN
2395 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
2396 & varid)
2397 IF (foundit) THEN
2398 gtype=var_flag(varid)*r2dvar
2399 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
2400 & vname(1,idfsur), varid, &
2401 & inprec, gtype, vsize, &
2402 & lbi, ubi, lbj, ubj, &
2403 & fscl, fmin, fmax, &
2404# ifdef MASKING
2405 & grid(ng) % rmask, &
2406# endif
2407# ifdef CHECKSUM
2408 & ocean(ng) % tl_zeta(:,:,tindex), &
2409 & checksum = fhash)
2410# else
2411 & ocean(ng) % tl_zeta(:,:,tindex))
2412# endif
2413 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2414 IF (master) THEN
2415 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
2416 & inprec, trim(ncname)
2417 END IF
2418 exit_flag=2
2419 ioerror=status
2420 RETURN
2421 ELSE
2422 IF (master) THEN
2423# ifdef CHECKSUM
2424 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
2425 & fhash
2426# else
2427 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
2428# endif
2429 END IF
2430 END IF
2431 ELSE
2432 IF (master) THEN
2433 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
2434 & trim(ncname)
2435 END IF
2436 exit_flag=4
2437 IF (founderror(exit_flag, nf90_noerr, &
2438 & __line__, myfile)) THEN
2439 RETURN
2440 END IF
2441 END IF
2442 END IF
2443
2444# ifdef ADJUST_BOUNDARY
2445!
2446! Read in free-surface open boundaries adjustments.
2447!
2448 IF (get_var(idsbry(isfsur)).and.get_adjust.and. &
2449 & any(lobc(:,isfsur,ng))) THEN
2450 ifield=idsbry(isfsur)
2451 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
2452 & varid)
2453 IF (foundit) THEN
2454 status=nf_fread2d_bry(ng, idmod, ncname, ncinpid, &
2455 & vname(1,ifield), varid, &
2456 & inprec, r2dvar, &
2457 & lbij, ubij, nbrec(ng), &
2458 & fscl, fmin, fmax, &
2459# ifdef CHECKSUM
2460 & boundary(ng) % tl_zeta_obc(:,:,:, &
2461 & tindex), &
2462 & checksum = fhash)
2463# else
2464 & boundary(ng) % tl_zeta_obc(:,:,:, &
2465 & tindex))
2466# endif
2467 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2468 IF (master) THEN
2469 WRITE (stdout,60) string, trim(vname(1,ifield)), &
2470 & inprec, trim(ncname)
2471 END IF
2472 exit_flag=2
2473 ioerror=status
2474 RETURN
2475 ELSE
2476 IF (master) THEN
2477# ifdef CHECKSUM
2478 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
2479 & fhash
2480# else
2481 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
2482# endif
2483 END IF
2484 END IF
2485 ELSE
2486 IF (master) THEN
2487 WRITE (stdout,80) string, trim(vname(1,ifield)), &
2488 & trim(ncname)
2489 END IF
2490 exit_flag=4
2491 IF (founderror(exit_flag, nf90_noerr, &
2492 & __line__, myfile)) THEN
2493 RETURN
2494 END IF
2495 END IF
2496 END IF
2497# endif
2498!
2499! Read in tangent linear 2D U-momentum component (m/s).
2500!
2501 IF (get_var(idubar)) THEN
2502 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
2503 & varid)
2504 IF (foundit) THEN
2505 gtype=var_flag(varid)*u2dvar
2506 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
2507 & vname(1,idubar), varid, &
2508 & inprec, gtype, vsize, &
2509 & lbi, ubi, lbj, ubj, &
2510 & fscl, fmin, fmax, &
2511# ifdef MASKING
2512 & grid(ng) % umask, &
2513# endif
2514# ifdef CHECKSUM
2515 & ocean(ng) % tl_ubar(:,:,tindex), &
2516 & checksum = fhash)
2517# else
2518 & ocean(ng) % tl_ubar(:,:,tindex))
2519# endif
2520 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2521 IF (master) THEN
2522 WRITE (stdout,60) string, trim(vname(1,idubar)), &
2523 & inprec, trim(ncname)
2524 END IF
2525 exit_flag=2
2526 ioerror=status
2527 RETURN
2528 ELSE
2529 IF (master) THEN
2530# ifdef CHECKSUM
2531 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
2532 & fhash
2533# else
2534 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
2535# endif
2536 END IF
2537 END IF
2538 ELSE
2539 IF (master) THEN
2540 WRITE (stdout,80) string, trim(vname(1,idubar)), &
2541 & trim(ncname)
2542 END IF
2543 exit_flag=4
2544 IF (founderror(exit_flag, nf90_noerr, &
2545 & __line__, myfile)) THEN
2546 RETURN
2547 END IF
2548 END IF
2549 END IF
2550
2551# ifdef ADJUST_BOUNDARY
2552!
2553! Read in 2D U-momentum component open boundaries adjustments.
2554!
2555 IF (get_var(idsbry(isubar)).and.get_adjust.and. &
2556 & any(lobc(:,isubar,ng))) THEN
2557 ifield=idsbry(isubar)
2558 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
2559 & varid)
2560 IF (foundit) THEN
2561 status=nf_fread2d_bry(ng, idmod, ncname, ncinpid, &
2562 & vname(1,ifield), varid, &
2563 & inprec, u2dvar, &
2564 & lbij, ubij, nbrec(ng), &
2565 & fscl, fmin, fmax, &
2566# ifdef CHECKSUM
2567 & boundary(ng) % tl_ubar_obc(:,:,:, &
2568 & tindex), &
2569 & checksum = fhash)
2570# else
2571 & boundary(ng) % tl_ubar_obc(:,:,:, &
2572 & tindex))
2573# endif
2574 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2575 IF (master) THEN
2576 WRITE (stdout,60) string, trim(vname(1,ifield)), &
2577 & inprec, trim(ncname)
2578 END IF
2579 exit_flag=2
2580 ioerror=status
2581 RETURN
2582 ELSE
2583 IF (master) THEN
2584# ifdef CHECKSUM
2585 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
2586 & fhash
2587# else
2588 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
2589# endif
2590 END IF
2591 END IF
2592 ELSE
2593 IF (master) THEN
2594 WRITE (stdout,80) string, trim(vname(1,ifield)), &
2595 & trim(ncname)
2596 END IF
2597 exit_flag=4
2598 IF (founderror(exit_flag, nf90_noerr, &
2599 & __line__, myfile)) THEN
2600 RETURN
2601 END IF
2602 END IF
2603 END IF
2604# endif
2605!
2606! Read in tangent linear 2D V-momentum component.
2607!
2608 IF (get_var(idvbar)) THEN
2609 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
2610 & varid)
2611 IF (foundit) THEN
2612 gtype=var_flag(varid)*v2dvar
2613 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
2614 & vname(1,idvbar), varid, &
2615 & inprec, gtype, vsize, &
2616 & lbi, ubi, lbj, ubj, &
2617 & fscl, fmin, fmax, &
2618# ifdef MASKING
2619 & grid(ng) % vmask, &
2620# endif
2621# ifdef CHECKSUM
2622 & ocean(ng) % tl_vbar(:,:,tindex), &
2623 & checksum = fhash)
2624# else
2625 & ocean(ng) % tl_vbar(:,:,tindex))
2626# endif
2627 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2628 IF (master) THEN
2629 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
2630 & inprec, trim(ncname)
2631 END IF
2632 exit_flag=2
2633 ioerror=status
2634 RETURN
2635 ELSE
2636 IF (master) THEN
2637# ifdef CHECKSUM
2638 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
2639 & fhash
2640# else
2641 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
2642# endif
2643 END IF
2644 END IF
2645 ELSE
2646 IF (master) THEN
2647 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
2648 & trim(ncname)
2649 END IF
2650 exit_flag=4
2651 IF (founderror(exit_flag, nf90_noerr, &
2652 & __line__, myfile)) THEN
2653 RETURN
2654 END IF
2655 END IF
2656 END IF
2657
2658# ifdef ADJUST_BOUNDARY
2659!
2660! Read in 2D V-momentum component open boundaries adjustments.
2661!
2662 IF (get_var(idsbry(isvbar)).and.get_adjust.and. &
2663 & any(lobc(:,isvbar,ng))) THEN
2664 ifield=idsbry(isvbar)
2665 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
2666 & varid)
2667 IF (foundit) THEN
2668 status=nf_fread2d_bry(ng, idmod, ncname, ncinpid, &
2669 & vname(1,ifield), varid, &
2670 & inprec, v2dvar, &
2671 & lbij, ubij, nbrec(ng), &
2672 & fscl, fmin, fmax, &
2673# ifdef CHECKSUM
2674 & boundary(ng) % tl_vbar_obc(:,:,:, &
2675 & tindex), &
2676 & checksum = fhash)
2677# else
2678 & boundary(ng) % tl_vbar_obc(:,:,:, &
2679 & tindex))
2680# endif
2681 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2682 IF (master) THEN
2683 WRITE (stdout,60) string, trim(vname(1,ifield)), &
2684 & inprec, trim(ncname)
2685 END IF
2686 exit_flag=2
2687 ioerror=status
2688 RETURN
2689 ELSE
2690 IF (master) THEN
2691# ifdef CHECKSUM
2692 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
2693 & fhash
2694# else
2695 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
2696# endif
2697 END IF
2698 END IF
2699 ELSE
2700 IF (master) THEN
2701 WRITE (stdout,80) string, trim(vname(1,ifield)), &
2702 & trim(ncname)
2703 END IF
2704 exit_flag=4
2705 IF (founderror(exit_flag, nf90_noerr, &
2706 & __line__, myfile)) THEN
2707 RETURN
2708 END IF
2709 END IF
2710 END IF
2711# endif
2712# ifdef ADJUST_WSTRESS
2713!
2714! Read in tangent linear surface U-momentum stress.
2715!
2716 IF (get_var(idusms).and.get_adjust) THEN
2717 foundit=find_string(var_name, n_var, trim(vname(1,idusms)), &
2718 & varid)
2719 IF (foundit) THEN
2720 gtype=var_flag(varid)*u3dvar
2721 scale=1.0_dp
2722 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
2723 & vname(1,idusms), varid, &
2724 & inprec, gtype, vsize, &
2725 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
2726 & scale, fmin, fmax, &
2727# ifdef MASKING
2728 & grid(ng) % umask, &
2729# endif
2730# ifdef CHECKSUM
2731 & forces(ng) % tl_ustr(:,:,:,tindex), &
2732 & checksum = fhash)
2733# else
2734 & forces(ng) % tl_ustr(:,:,:,tindex))
2735# endif
2736 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2737 IF (master) THEN
2738 WRITE (stdout,60) string, trim(vname(1,idusms)), &
2739 & inprec, trim(ncname)
2740 END IF
2741 exit_flag=2
2742 ioerror=status
2743 RETURN
2744 ELSE
2745 IF (master) THEN
2746# ifdef CHECKSUM
2747 WRITE (stdout,70) trim(vname(2,idusms))// &
2748 & ', adjusted tl_ustr', fmin, fmax, &
2749 & fhash
2750# else
2751 WRITE (stdout,70) trim(vname(2,idusms))// &
2752 & ', adjusted tl_ustr', fmin, fmax
2753# endif
2754 END IF
2755 END IF
2756 ELSE
2757 IF (master) THEN
2758 WRITE (stdout,80) string, trim(vname(1,idusms)), &
2759 & trim(ncname)
2760 END IF
2761 exit_flag=4
2762 IF (founderror(exit_flag, nf90_noerr, &
2763 & __line__, myfile)) THEN
2764 RETURN
2765 END IF
2766 END IF
2767 END IF
2768!
2769! Read in tangent linear surface V-momentum stress.
2770!
2771 IF (get_var(idvsms).and.get_adjust) THEN
2772 foundit=find_string(var_name, n_var, trim(vname(1,idvsms)), &
2773 & varid)
2774 IF (foundit) THEN
2775 gtype=var_flag(varid)*v3dvar
2776 scale=1.0_dp
2777 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
2778 & vname(1,idvsms), varid, &
2779 & inprec, gtype, vsize, &
2780 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
2781 & scale, fmin, fmax, &
2782# ifdef MASKING
2783 & grid(ng) % vmask, &
2784# endif
2785# ifdef CHECKSUM
2786 & forces(ng) % tl_vstr(:,:,:,tindex), &
2787 & checksum = fhash)
2788# else
2789 & forces(ng) % tl_vstr(:,:,:,tindex))
2790# endif
2791 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2792 IF (master) THEN
2793 WRITE (stdout,60) string, trim(vname(1,idvsms)), &
2794 & inprec, trim(ncname)
2795 END IF
2796 exit_flag=2
2797 ioerror=status
2798 RETURN
2799 ELSE
2800 IF (master) THEN
2801# ifdef CHECKSUM
2802 WRITE (stdout,70) trim(vname(2,idvsms))// &
2803 & ', adjusted tl_vstr', fmin, fmax, &
2804 & fhash
2805# else
2806 WRITE (stdout,70) trim(vname(2,idvsms))// &
2807 & ', adjusted tl_vstr', fmin, fmax
2808# endif
2809 END IF
2810 END IF
2811 ELSE
2812 IF (master) THEN
2813 WRITE (stdout,80) string, trim(vname(1,idvsms)), &
2814 & trim(ncname)
2815 END IF
2816 exit_flag=4
2817 IF (founderror(exit_flag, nf90_noerr, &
2818 & __line__, myfile)) THEN
2819 RETURN
2820 END IF
2821 END IF
2822 END IF
2823# endif
2824# ifdef SOLVE3D
2825!
2826! Read in tangent linear 3D U-momentum component.
2827
2828!
2829 IF (get_var(iduvel)) THEN
2830 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
2831 & varid)
2832 IF (foundit) THEN
2833 gtype=var_flag(varid)*u3dvar
2834 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
2835 & vname(1,iduvel), varid, &
2836 & inprec, gtype, vsize, &
2837 & lbi, ubi, lbj, ubj, 1, n(ng), &
2838 & fscl, fmin, fmax, &
2839# ifdef MASKING
2840 & grid(ng) % umask, &
2841# endif
2842# ifdef CHECKSUM
2843 & ocean(ng) % tl_u(:,:,:,tindex), &
2844 & checksum = fhash)
2845# else
2846 & ocean(ng) % tl_u(:,:,:,tindex))
2847# endif
2848 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2849 IF (master) THEN
2850 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
2851 & inprec, trim(ncname)
2852 END IF
2853 exit_flag=2
2854 ioerror=status
2855 RETURN
2856 ELSE
2857 IF (master) THEN
2858# ifdef CHECKSUM
2859 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
2860 & fhash
2861# else
2862 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
2863# endif
2864 END IF
2865 END IF
2866 ELSE
2867 IF (master) THEN
2868 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
2869 & trim(ncname)
2870 END IF
2871 exit_flag=4
2872 IF (founderror(exit_flag, nf90_noerr, &
2873 & __line__, myfile)) THEN
2874 RETURN
2875 END IF
2876 END IF
2877 END IF
2878
2879# ifdef ADJUST_BOUNDARY
2880!
2881! Read in 3D U-momentum component open boundaries adjustments.
2882!
2883 IF (get_var(idsbry(isuvel)).and.get_adjust.and. &
2884 & any(lobc(:,isuvel,ng))) THEN
2885 ifield=idsbry(isuvel)
2886 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
2887 & varid)
2888 IF (foundit) THEN
2889 status=nf_fread3d_bry(ng, idmod, ncname, ncinpid, &
2890 & vname(1,ifield), varid, &
2891 & inprec, u3dvar, &
2892 & lbij, ubij, 1, n(ng), nbrec(ng), &
2893 & fscl, fmin, fmax, &
2894# ifdef CHECKSUM
2895 & boundary(ng) % tl_u_obc(:,:,:,:, &
2896 & tindex), &
2897 & checksum = fhash)
2898# else
2899 & boundary(ng) % tl_u_obc(:,:,:,:, &
2900 & tindex))
2901# endif
2902 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2903 IF (master) THEN
2904 WRITE (stdout,60) string, trim(vname(1,ifield)), &
2905 & inprec, trim(ncname)
2906 END IF
2907 exit_flag=2
2908 ioerror=status
2909 RETURN
2910 ELSE
2911 IF (master) THEN
2912# ifdef CHECKSUM
2913 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
2914 & fhash
2915# else
2916 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
2917# endif
2918 END IF
2919 END IF
2920 ELSE
2921 IF (master) THEN
2922 WRITE (stdout,80) string, trim(vname(1,ifield)), &
2923 & trim(ncname)
2924 END IF
2925 exit_flag=4
2926 IF (founderror(exit_flag, nf90_noerr, &
2927 & __line__, myfile)) THEN
2928 RETURN
2929 END IF
2930 END IF
2931 END IF
2932# endif
2933!
2934! Read in tangent linear 3D V-momentum component.
2935!
2936 IF (get_var(idvvel)) THEN
2937 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
2938 & varid)
2939 IF (foundit) THEN
2940 gtype=var_flag(varid)*v3dvar
2941 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
2942 & vname(1,idvvel), varid, &
2943 & inprec, gtype, vsize, &
2944 & lbi, ubi, lbj, ubj, 1, n(ng), &
2945 & fscl, fmin, fmax, &
2946# ifdef MASKING
2947 & grid(ng) % vmask, &
2948# endif
2949# ifdef CHECKSUM
2950 & ocean(ng) % tl_v(:,:,:,tindex), &
2951 & checksum = fhash)
2952# else
2953 & ocean(ng) % tl_v(:,:,:,tindex))
2954# endif
2955 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2956 IF (master) THEN
2957 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
2958 & inprec, trim(ncname)
2959 END IF
2960 exit_flag=2
2961 ioerror=status
2962 RETURN
2963 ELSE
2964 IF (master) THEN
2965# ifdef CHECKSUM
2966 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
2967 & fhash
2968# else
2969 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
2970# endif
2971 END IF
2972 END IF
2973 ELSE
2974 IF (master) THEN
2975 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
2976 & trim(ncname)
2977 END IF
2978 exit_flag=4
2979 IF (founderror(exit_flag, nf90_noerr, &
2980 & __line__, myfile)) THEN
2981 RETURN
2982 END IF
2983 END IF
2984 END IF
2985
2986# ifdef ADJUST_BOUNDARY
2987!
2988! Read in 3D V-momentum component open boundaries adjustments.
2989!
2990 IF (get_var(idsbry(isvvel)).and.get_adjust.and. &
2991 & any(lobc(:,isvvel,ng))) THEN
2992 ifield=idsbry(isvvel)
2993 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
2994 & varid)
2995 IF (foundit) THEN
2996 status=nf_fread3d_bry(ng, idmod, ncname, ncinpid, &
2997 & vname(1,ifield), varid, &
2998 & inprec, v3dvar, &
2999 & lbij, ubij, 1, n(ng), nbrec(ng), &
3000 & fscl, fmin, fmax, &
3001# ifdef CHECKSUM
3002 & boundary(ng) % tl_v_obc(:,:,:,:, &
3003 & tindex), &
3004 & checksum = fhash)
3005# else
3006 & boundary(ng) % tl_v_obc(:,:,:,:, &
3007 & tindex))
3008# endif
3009 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3010 IF (master) THEN
3011 WRITE (stdout,60) string, trim(vname(1,ifield)), &
3012 & inprec, trim(ncname)
3013 END IF
3014 exit_flag=2
3015 ioerror=status
3016 RETURN
3017 ELSE
3018 IF (master) THEN
3019# ifdef CHECKSUM
3020 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
3021 & fhash
3022# else
3023 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
3024# endif
3025 END IF
3026 END IF
3027 ELSE
3028 IF (master) THEN
3029 WRITE (stdout,80) string, trim(vname(1,ifield)), &
3030 & trim(ncname)
3031 END IF
3032 exit_flag=4
3033 IF (founderror(exit_flag, nf90_noerr, &
3034 & __line__, myfile)) THEN
3035 RETURN
3036 END IF
3037 END IF
3038 END IF
3039# endif
3040!
3041! Read in tangent linear tracer type variables.
3042!
3043 DO itrc=1,nt(ng)
3044 IF (get_var(idtvar(itrc))) THEN
3045 foundit=find_string(var_name, n_var, &
3046 & trim(vname(1,idtvar(itrc))), varid)
3047 IF (foundit) THEN
3048 gtype=var_flag(varid)*r3dvar
3049 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
3050 & vname(1,idtvar(itrc)), varid, &
3051 & inprec, gtype, vsize, &
3052 & lbi, ubi, lbj, ubj, 1, n(ng), &
3053 & fscl, fmin, fmax, &
3054# ifdef MASKING
3055 & grid(ng) % rmask, &
3056# endif
3057# ifdef CHECKSUM
3058 & ocean(ng) % tl_t(:,:,:,tindex,itrc), &
3059 & checksum = fhash)
3060# else
3061 & ocean(ng) % tl_t(:,:,:,tindex,itrc))
3062# endif
3063 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3064 IF (master) THEN
3065 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
3066 & inprec, trim(ncname)
3067 END IF
3068 exit_flag=2
3069 ioerror=status
3070 RETURN
3071 ELSE
3072 IF (master) THEN
3073# ifdef CHECKSUM
3074 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
3075 & fmin, fmax, fhash
3076# else
3077 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
3078 & fmin, fmax
3079# endif
3080 END IF
3081 END IF
3082 ELSE
3083 IF (master) THEN
3084 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
3085 & trim(ncname)
3086 END IF
3087 exit_flag=4
3088 IF (founderror(exit_flag, nf90_noerr, &
3089 & __line__, myfile)) THEN
3090 RETURN
3091 END IF
3092 END IF
3093 END IF
3094 END DO
3095
3096# ifdef ADJUST_BOUNDARY
3097!
3098! Read in 3D tracers open boundaries adjustments.
3099!
3100 DO itrc=1,nt(ng)
3101 IF (get_var(idsbry(istvar(itrc))).and.get_adjust.and. &
3102 & any(lobc(:,istvar(itrc),ng))) THEN
3103 ifield=idsbry(istvar(itrc))
3104 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
3105 & varid)
3106 IF (foundit) THEN
3107 status=nf_fread3d_bry(ng, idmod, ncname, ncinpid, &
3108 & vname(1,ifield), varid, &
3109 & inprec, r3dvar, &
3110 & lbij, ubij, 1, n(ng), nbrec(ng), &
3111 & fscl, fmin, fmax, &
3112# ifdef CHECKSUM
3113 & boundary(ng) % tl_t_obc(:,:,:,:, &
3114 & tindex,itrc), &
3115 & checksum = fhash)
3116# else
3117 & boundary(ng) % tl_t_obc(:,:,:,:, &
3118 & tindex,itrc))
3119# endif
3120 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3121 IF (master) THEN
3122 WRITE (stdout,60) string, trim(vname(1,ifield)), &
3123 & inprec, trim(ncname)
3124 END IF
3125 exit_flag=2
3126 ioerror=status
3127 RETURN
3128 ELSE
3129 IF (master) THEN
3130# ifdef CHECKSUM
3131 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
3132 & fhash
3133# else
3134 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
3135# endif
3136 END IF
3137 END IF
3138 ELSE
3139 IF (master) THEN
3140 WRITE (stdout,80) string, trim(vname(1,ifield)), &
3141 & trim(ncname)
3142 END IF
3143 exit_flag=4
3144 IF (founderror(exit_flag, nf90_noerr, &
3145 & __line__, myfile)) THEN
3146 RETURN
3147 END IF
3148 END IF
3149 END IF
3150 END DO
3151# endif
3152# ifdef ADJUST_STFLUX
3153!
3154! Read in tangent linear surface tracers flux.
3155!
3156 DO itrc=1,nt(ng)
3157 IF (get_var(idtsur(itrc)).and.get_adjust.and. &
3158 & lstflux(itrc,ng)) THEN
3159 foundit=find_string(var_name, n_var, &
3160 & trim(vname(1,idtsur(itrc))), varid)
3161 IF (foundit) THEN
3162 gtype=var_flag(varid)*r3dvar
3163 scale=1.0_dp
3164 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
3165 & vname(1,idtsur(itrc)), varid, &
3166 & inprec, gtype, vsize, &
3167 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
3168 & scale, fmin, fmax, &
3169# ifdef MASKING
3170 & grid(ng) % rmask, &
3171# endif
3172# ifdef CHECKSUM
3173 & forces(ng)% tl_tflux(:,:,:, &
3174 & tindex,itrc), &
3175 & checksum = fhash)
3176# else
3177 & forces(ng)% tl_tflux(:,:,:, &
3178 & tindex,itrc))
3179# endif
3180 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3181 IF (master) THEN
3182 WRITE (stdout,60) string, trim(vname(1,idtsur(itrc))),&
3183 & inprec, trim(ncname)
3184 END IF
3185 exit_flag=2
3186 ioerror=status
3187 RETURN
3188 ELSE
3189 IF (master) THEN
3190# ifdef CHECKSUM
3191 WRITE (stdout,70) trim(vname(2,idtsur(itrc)))// &
3192 & ', adjusted tl_tflux', fmin, fmax, &
3193 & fhash
3194# else
3195 WRITE (stdout,70) trim(vname(2,idtsur(itrc)))// &
3196 & ', adjusted tl_tflux', fmin, fmax
3197# endif
3198 END IF
3199 END IF
3200 ELSE
3201 IF (master) THEN
3202 WRITE (stdout,80) string, trim(vname(1,idtsur(itrc))), &
3203 & trim(ncname)
3204 END IF
3205 exit_flag=4
3206 IF (founderror(exit_flag, nf90_noerr, &
3207 & __line__, myfile)) THEN
3208 RETURN
3209 END IF
3210 END IF
3211 END IF
3212 END DO
3213# endif
3214# ifdef SEDIMENT
3215!
3216! Read in tangent linear sediment fraction of each size class in each
3217! bed layer.
3218!
3219 DO i=1,nst
3220 IF (get_var(idfrac(i))) THEN
3221 foundit=find_string(var_name, n_var, &
3222 & trim(vname(1,idfrac(i))), varid)
3223 IF (foundit) THEN
3224 gtype=var_flag(varid)*b3dvar
3225 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
3226 & vname(1,idfrac(i)), varid, &
3227 & inprec, gtype, vsize, &
3228 & lbi, ubi, lbj, ubj, 1, nbed, &
3229 & fscl, fmin, fmax, &
3230# ifdef MASKING
3231 & grid(ng) % rmask, &
3232# endif
3233# ifdef CHECKSUM
3234 & sedbed(ng) % tl_bed_frac(:,:,:,i), &
3235 & checksum = fhash)
3236# else
3237 & sedbed(ng) % tl_bed_frac(:,:,:,i))
3238# endif
3239 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3240 IF (master) THEN
3241 WRITE (stdout,60) string, trim(vname(1,idfrac(i))), &
3242 & inprec, trim(ncname)
3243 END IF
3244 exit_flag=2
3245 ioerror=status
3246 RETURN
3247 ELSE
3248 IF (master) THEN
3249# ifdef CHECKSUM
3250 WRITE (stdout,70) trim(vname(2,idfrac(i))), &
3251 & fmin, fmax, fhash
3252# else
3253 WRITE (stdout,70) trim(vname(2,idfrac(i))), &
3254 & fmin, fmax
3255# endif
3256 END IF
3257 END IF
3258 ELSE
3259 IF (master) THEN
3260 WRITE (stdout,80) string, trim(vname(1,idfrac(i))), &
3261 & trim(ncname)
3262 END IF
3263 exit_flag=4
3264 IF (founderror(exit_flag, nf90_noerr, &
3265 & __line__, myfile)) THEN
3266 RETURN
3267 END IF
3268 END IF
3269 END IF
3270!
3271! Read in tangent linear sediment mass of each size class in each
3272! bed layer.
3273!
3274 IF (get_var(idbmas(i))) THEN
3275 foundit=find_string(var_name, n_var, &
3276 & trim(vname(1,idbmas(i))), varid)
3277 IF (foundit) THEN
3278 gtype=var_flag(varid)*b3dvar
3279 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
3280 & vname(1,idbmas(i)), varid, &
3281 & inprec, gtype, vsize, &
3282 & lbi, ubi, lbj, ubj, 1, nbed, &
3283 & fscl, fmin, fmax, &
3284# ifdef MASKING
3285 & grid(ng) % rmask, &
3286# endif
3287# ifdef CHECKSUM
3288 & sedbed(ng) % tl_bed_mass(:,:,:, &
3289 & tindex,i), &
3290 & checksum = fhash)
3291# else
3292 & sedbed(ng) % tl_bed_mass(:,:,:, &
3293 & tindex,i))
3294# endif
3295 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3296 IF (master) THEN
3297 WRITE (stdout,60) string, trim(vname(1,idbmas(i))), &
3298 & inprec, trim(ncname)
3299 END IF
3300 exit_flag=2
3301 ioerror=status
3302 RETURN
3303 ELSE
3304 IF (master) THEN
3305# ifdef CHECKSUM
3306 WRITE (stdout,70) trim(vname(2,idbmas(i))), &
3307 & fmin, fmax, fhash
3308# else
3309 WRITE (stdout,70) trim(vname(2,idbmas(i))), &
3310 & fmin, fmax
3311# endif
3312 END IF
3313 END IF
3314 ELSE
3315 IF (master) THEN
3316 WRITE (stdout,80) string, trim(vname(1,idbmas(i))), &
3317 & trim(ncname)
3318 END IF
3319 exit_flag=4
3320 IF (founderror(exit_flag, nf90_noerr, &
3321 & __line__, myfile)) THEN
3322 RETURN
3323 END IF
3324 END IF
3325 END IF
3326 END DO
3327!
3328! Read in tangent linear sediment properties in each bed layer.
3329!
3330 DO i=1,mbedp
3331 IF (get_var(idsbed(i))) THEN
3332 foundit=find_string(var_name, n_var, &
3333 & trim(vname(1,idsbed(i))), varid)
3334 IF (foundit) THEN
3335 gtype=var_flag(varid)*b3dvar
3336 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
3337 & vname(1,idsbed(i)), varid, &
3338 & inprec, gtype, vsize, &
3339 & lbi, ubi, lbj, ubj, 1, nbed, &
3340 & fscl, fmin, fmax, &
3341# ifdef MASKING
3342 & grid(ng) % rmask, &
3343# endif
3344# ifdef CHECKSUM
3345 & sedbed(ng) % tl_bed(:,:,:,i), &
3346 & checksum = fhash)
3347# else
3348 & sedbed(ng) % tl_bed(:,:,:,i))
3349# endif
3350 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3351 IF (master) THEN
3352 WRITE (stdout,60) string, trim(vname(1,idsbed(i))), &
3353 & inprec, trim(ncname)
3354 END IF
3355 exit_flag=2
3356 ioerror=status
3357 RETURN
3358 ELSE
3359 IF (master) THEN
3360# ifdef CHECKSUM
3361 WRITE (stdout,70) trim(vname(2,idsbed(i))), &
3362 & fmin, fmax, fhash
3363# else
3364 WRITE (stdout,70) trim(vname(2,idsbed(i))), &
3365 & fmin, fmax
3366# endif
3367 END IF
3368 END IF
3369 ELSE
3370 IF (master) THEN
3371 WRITE (stdout,80) string, trim(vname(1,idsbed(i))), &
3372 & trim(ncname)
3373 END IF
3374 exit_flag=4
3375 IF (founderror(exit_flag, nf90_noerr, &
3376 & __line__, myfile)) THEN
3377 RETURN
3378 END IF
3379 END IF
3380 END IF
3381 END DO
3382
3383# ifdef BEDLOAD
3384!
3385! Read in tangent linear sediment fraction of bed load.
3386!
3387 DO i=1,nst
3388 IF (get_var(idubld(i))) THEN
3389 foundit=find_string(var_name, n_var, &
3390 & trim(vname(1,idubld(i))), varid)
3391 IF (foundit) THEN
3392 gtype=var_flag(varid)*u2dvar
3393 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
3394 & vname(1,idubld(i)), varid, &
3395 & inprec, gtype, vsize, &
3396 & lbi, ubi, lbj, ubj, &
3397 & fscl, fmin, fmax, &
3398# ifdef MASKING
3399 & grid(ng) % umask, &
3400# endif
3401# ifdef CHECKSUM
3402 & sedbed(ng) % tl_bedldu(:,:,i), &
3403 & checksum = fhash)
3404# else
3405 & sedbed(ng) % tl_bedldu(:,:,i))
3406# endif
3407 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3408 IF (master) THEN
3409 WRITE (stdout,60) string, trim(vname(1,idubld(i))), &
3410 & inprec, trim(ncname)
3411 END IF
3412 exit_flag=2
3413 ioerror=status
3414 RETURN
3415 ELSE
3416 IF (master) THEN
3417# ifdef CHECKSUM
3418 WRITE (stdout,70) trim(vname(2,idubld(i))), &
3419 & fmin, fmax, fhash
3420# else
3421 WRITE (stdout,70) trim(vname(2,idubld(i))), &
3422 & fmin, fmax
3423# endif
3424 END IF
3425 END IF
3426 ELSE
3427 IF (master) THEN
3428 WRITE (stdout,80) string, trim(vname(1,idubld(i))), &
3429 & trim(ncname)
3430 END IF
3431 exit_flag=4
3432 IF (founderror(exit_flag, nf90_noerr, &
3433 & __line__, myfile)) THEN
3434 RETURN
3435 END IF
3436 END IF
3437 END IF
3438!
3439 IF (get_var(idvbld(i))) THEN
3440 foundit=find_string(var_name, n_var, &
3441 & trim(vname(1,idvbld(i))), varid)
3442 IF (foundit) THEN
3443 gtype=var_flag(varid)*v2dvar
3444 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
3445 & vname(1,idvbld(i)), varid, &
3446 & inprec, gtype, vsize, &
3447 & lbi, ubi, lbj, ubj, &
3448 & fscl, fmin, fmax, &
3449# ifdef MASKING
3450 & grid(ng) % vmask, &
3451# endif
3452# ifdef CHECKSUM
3453 & sedbed(ng) % tl_bedldv(:,:,i), &
3454 & checksum = fhash)
3455# else
3456 & sedbed(ng) % tl_bedldv(:,:,i))
3457# endif
3458 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3459 IF (master) THEN
3460 WRITE (stdout,60) string, trim(vname(1,idvbld(i))), &
3461 & inprec, trim(ncname)
3462 END IF
3463 exit_flag=2
3464 ioerror=status
3465 RETURN
3466 ELSE
3467 IF (master) THEN
3468# ifdef CHECKSUM
3469 WRITE (stdout,70) trim(vname(2,idvbld(i))), &
3470 & fmin, fmax, fhash
3471# else
3472 WRITE (stdout,70) trim(vname(2,idvbld(i))), &
3473 & fmin, fmax
3474# endif
3475 END IF
3476 END IF
3477 ELSE
3478 IF (master) THEN
3479 WRITE (stdout,80) string, trim(vname(1,idvbld(i))), &
3480 & trim(ncname)
3481 END IF
3482 exit_flag=4
3483 IF (founderror(exit_flag, nf90_noerr, &
3484 & __line__, myfile)) THEN
3485 RETURN
3486 END IF
3487 END IF
3488 END IF
3489 END DO
3490# endif
3491# endif
3492
3493# if defined SEDIMENT || defined BBL_MODEL
3494!
3495! Read in tangent linear sediment properties in exposed bed layer.
3496!
3497 DO i=1,mbotp
3498 IF (get_var(idbott(i)).and.have_var(idbott(i))) THEN
3499 foundit=find_string(var_name, n_var, &
3500 & trim(vname(1,idbott(i))), varid)
3501 IF (foundit) THEN
3502 gtype=var_flag(varid)*r2dvar
3503 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
3504 & vname(1,idbott(i)), varid, &
3505 & inprec, gtype, vsize, &
3506 & lbi, ubi, lbj, ubj, &
3507 & fscl, fmin, fmax, &
3508# ifdef MASKING
3509 & grid(ng) % rmask, &
3510# endif
3511# ifdef CHECKSUM
3512 & sedbed(ng) % tl_bottom(:,:,i), &
3513 & checksum = fhash)
3514# else
3515 & sedbed(ng) % tl_bottom(:,:,i))
3516# endif
3517 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3518 IF (master) THEN
3519 WRITE (stdout,60) string, trim(vname(1,idbott(i))), &
3520 & inprec, trim(ncname)
3521 END IF
3522 exit_flag=2
3523 ioerror=status
3524 RETURN
3525 ELSE
3526 IF (master) THEN
3527# ifdef CHECKSUM
3528 WRITE (stdout,70) trim(vname(2,idbott(i))), &
3529 & fmin, fmax, fhash
3530# else
3531 WRITE (stdout,70) trim(vname(2,idbott(i))), &
3532 & fmin, fmax
3533# endif
3534 END IF
3535 END IF
3536 ELSE
3537 IF (master) THEN
3538 WRITE (stdout,80) string, trim(vname(1,idbott(i))), &
3539 & trim(ncname)
3540 END IF
3541 exit_flag=4
3542 IF (founderror(exit_flag, nf90_noerr, &
3543 & __line__, myfile)) THEN
3544 RETURN
3545 END IF
3546 END IF
3547 END IF
3548 END DO
3549# endif
3550# endif
3551 END IF tlm_state
3552#endif
3553
3554#ifdef ADJOINT
3555!
3556!-----------------------------------------------------------------------
3557! Read in adjoint state variables.
3558!-----------------------------------------------------------------------
3559!
3560 adm_state: IF (model.eq.iadm) THEN
3561!
3562! Read in adjoint free-surface.
3563!
3564 IF (get_var(idfsur)) THEN
3565 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
3566 & varid)
3567 IF (foundit) THEN
3568 gtype=var_flag(varid)*r2dvar
3569 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
3570 & vname(1,idfsur), varid, &
3571 & inprec, gtype, vsize, &
3572 & lbi, ubi, lbj, ubj, &
3573 & fscl, fmin, fmax, &
3574# ifdef MASKING
3575 & grid(ng) % rmask, &
3576# endif
3577# ifdef CHECKSUM
3578 & ocean(ng) % ad_zeta(:,:,tindex), &
3579 & checksum = fhash)
3580# else
3581 & ocean(ng) % ad_zeta(:,:,tindex))
3582# endif
3583 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3584 IF (master) THEN
3585 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
3586 & inprec, trim(ncname)
3587 END IF
3588 exit_flag=2
3589 ioerror=status
3590 RETURN
3591 ELSE
3592 IF (master) THEN
3593# ifdef CHECKSUM
3594 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
3595 & fhash
3596# else
3597 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
3598# endif
3599 END IF
3600 END IF
3601 ELSE
3602 IF (master) THEN
3603 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
3604 & trim(ncname)
3605 END IF
3606 exit_flag=4
3607 IF (founderror(exit_flag, nf90_noerr, &
3608 & __line__, myfile)) THEN
3609 RETURN
3610 END IF
3611 END IF
3612 END IF
3613
3614# ifdef ADJUST_BOUNDARY
3615!
3616! Read in adjoint free-surface open boundaries adjustments.
3617!
3618 IF (get_var(idsbry(isfsur)).and. &
3619 & any(lobc(:,isfsur,ng))) THEN
3620 ifield=idsbry(isfsur)
3621 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
3622 & varid)
3623 IF (foundit) THEN
3624 status=nf_fread2d_bry(ng, idmod, ncname, ncinpid, &
3625 & vname(1,ifield), varid, &
3626 & inprec, r2dvar, &
3627 & lbij, ubij, nbrec(ng), &
3628 & fscl, fmin, fmax, &
3629# ifdef CHECKSUM
3630 & boundary(ng) % ad_zeta_obc(:,:,:, &
3631 & tindex), &
3632 & checksum = fhash)
3633# else
3634 & boundary(ng) % ad_zeta_obc(:,:,:, &
3635 & tindex))
3636# endif
3637 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3638 IF (master) THEN
3639 WRITE (stdout,60) string, trim(vname(1,ifield)), &
3640 & inprec, trim(ncname)
3641 END IF
3642 exit_flag=2
3643 ioerror=status
3644 RETURN
3645 ELSE
3646 IF (master) THEN
3647# ifdef CHECKSUM
3648 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
3649 & fhash
3650# else
3651 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
3652# endif
3653 END IF
3654 END IF
3655 ELSE
3656 IF (master) THEN
3657 WRITE (stdout,80) string, trim(vname(1,ifield)), &
3658 & trim(ncname)
3659 END IF
3660 exit_flag=4
3661 IF (founderror(exit_flag, nf90_noerr, &
3662 & __line__, myfile)) THEN
3663 RETURN
3664 END IF
3665 END IF
3666 END IF
3667# endif
3668!
3669! Read in adjoint 2D U-momentum component.
3670!
3671 IF (get_var(idubar)) THEN
3672 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
3673 & varid)
3674 IF (foundit) THEN
3675 gtype=var_flag(varid)*u2dvar
3676 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
3677 & vname(1,idubar), varid, &
3678 & inprec, gtype, vsize, &
3679 & lbi, ubi, lbj, ubj, &
3680 & fscl, fmin, fmax, &
3681# ifdef MASKING
3682 & grid(ng) % umask, &
3683# endif
3684# ifdef CHECKSUM
3685 & ocean(ng) % ad_ubar(:,:,tindex), &
3686 & checksum = fhash)
3687# else
3688 & ocean(ng) % ad_ubar(:,:,tindex))
3689# endif
3690 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3691 IF (master) THEN
3692 WRITE (stdout,60) string, trim(vname(1,idubar)), &
3693 & inprec, trim(ncname)
3694 END IF
3695 exit_flag=2
3696 ioerror=status
3697 RETURN
3698 ELSE
3699 IF (master) THEN
3700# ifdef CHECKSUM
3701 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
3702 & fhash
3703# else
3704 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
3705# endif
3706 END IF
3707 END IF
3708 ELSE
3709 IF (master) THEN
3710 WRITE (stdout,80) string, trim(vname(1,idubar)), &
3711 & trim(ncname)
3712 END IF
3713 exit_flag=4
3714 IF (founderror(exit_flag, nf90_noerr, &
3715 & __line__, myfile)) THEN
3716 RETURN
3717 END IF
3718 END IF
3719 END IF
3720
3721# ifdef ADJUST_BOUNDARY
3722!
3723! Read in 2D adjoint U-momentum component open boundaries adjustments.
3724!
3725 IF (get_var(idsbry(isubar)).and. &
3726 & any(lobc(:,isubar,ng))) THEN
3727 ifield=idsbry(isubar)
3728 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
3729 & varid)
3730 IF (foundit) THEN
3731 status=nf_fread2d_bry(ng, idmod, ncname, ncinpid, &
3732 & vname(1,ifield), varid, &
3733 & inprec, u2dvar, &
3734 & lbij, ubij, nbrec(ng), &
3735 & fscl, fmin, fmax, &
3736# ifdef CHECKSUM
3737 & boundary(ng) % ad_ubar_obc(:,:,:, &
3738 & tindex), &
3739 & checksum = fhash)
3740# else
3741 & boundary(ng) % ad_ubar_obc(:,:,:, &
3742 & tindex))
3743# endif
3744 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3745 IF (master) THEN
3746 WRITE (stdout,60) string, trim(vname(1,ifield)), &
3747 & inprec, trim(ncname)
3748 END IF
3749 exit_flag=2
3750 ioerror=status
3751 RETURN
3752 ELSE
3753 IF (master) THEN
3754# ifdef CHECKSUM
3755 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
3756 & fhash
3757# else
3758 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
3759# endif
3760 END IF
3761 END IF
3762 ELSE
3763 IF (master) THEN
3764 WRITE (stdout,80) string, trim(vname(1,ifield)), &
3765 & trim(ncname)
3766 END IF
3767 exit_flag=4
3768 IF (founderror(exit_flag, nf90_noerr, &
3769 & __line__, myfile)) THEN
3770 RETURN
3771 END IF
3772 END IF
3773 END IF
3774# endif
3775!
3776! Read in adjoint 2D V-momentum component.
3777!
3778 IF (get_var(idvbar)) THEN
3779 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
3780 & varid)
3781 IF (foundit) THEN
3782 gtype=var_flag(varid)*v2dvar
3783 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
3784 & vname(1,idvbar), varid, &
3785 & inprec, gtype, vsize, &
3786 & lbi, ubi, lbj, ubj, &
3787 & fscl, fmin, fmax, &
3788# ifdef MASKING
3789 & grid(ng) % vmask, &
3790# endif
3791# ifdef CHECKSUM
3792 & ocean(ng) % ad_vbar(:,:,tindex), &
3793 & checksum = fhash)
3794# else
3795 & ocean(ng) % ad_vbar(:,:,tindex))
3796# endif
3797 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3798 IF (master) THEN
3799 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
3800 & inprec, trim(ncname)
3801 END IF
3802 exit_flag=2
3803 ioerror=status
3804 RETURN
3805 ELSE
3806 IF (master) THEN
3807# ifdef CHECKSUM
3808 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
3809 & fhash
3810# else
3811 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
3812# endif
3813 END IF
3814 END IF
3815 ELSE
3816 IF (master) THEN
3817 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
3818 & trim(ncname)
3819 END IF
3820 exit_flag=4
3821 IF (founderror(exit_flag, nf90_noerr, &
3822 & __line__, myfile)) THEN
3823 RETURN
3824 END IF
3825 END IF
3826 END IF
3827
3828# ifdef ADJUST_BOUNDARY
3829!
3830! Read in 2D V-momentum component open boundaries adjustments.
3831!
3832 IF (get_var(idsbry(isvbar)).and. &
3833 & any(lobc(:,isvbar,ng))) THEN
3834 ifield=idsbry(isvbar)
3835 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
3836 & varid)
3837 IF (foundit) THEN
3838 status=nf_fread2d_bry(ng, idmod, ncname, ncinpid, &
3839 & vname(1,ifield), varid, &
3840 & inprec, v2dvar, &
3841 & lbij, ubij, nbrec(ng), &
3842 & fscl, fmin, fmax, &
3843# ifdef CHECKSUM
3844 & boundary(ng) % ad_vbar_obc(:,:,:, &
3845 & tindex), &
3846 & checksum = fhash)
3847# else
3848 & boundary(ng) % ad_vbar_obc(:,:,:, &
3849 & tindex))
3850# endif
3851 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3852 IF (master) THEN
3853 WRITE (stdout,60) string, trim(vname(1,ifield)), &
3854 & inprec, trim(ncname)
3855 END IF
3856 exit_flag=2
3857 ioerror=status
3858 RETURN
3859 ELSE
3860 IF (master) THEN
3861# ifdef CHECKSUM
3862 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
3863 & fhash
3864# else
3865 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
3866# endif
3867
3868 END IF
3869 END IF
3870 ELSE
3871 IF (master) THEN
3872 WRITE (stdout,80) string, trim(vname(1,ifield)), &
3873 & trim(ncname)
3874 END IF
3875 exit_flag=4
3876 IF (founderror(exit_flag, nf90_noerr, &
3877 & __line__, myfile)) THEN
3878 RETURN
3879 END IF
3880 END IF
3881 END IF
3882# endif
3883# ifdef ADJUST_WSTRESS
3884!
3885! Read in adjoint linear surface U-momentum stress.
3886!
3887 IF (get_var(idusms)) THEN
3888 foundit=find_string(var_name, n_var, trim(vname(1,idusms)), &
3889 & varid)
3890 IF (foundit) THEN
3891 gtype=var_flag(varid)*u3dvar
3892 scale=1.0_dp
3893 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
3894 & vname(1,idusms), varid, &
3895 & inprec, gtype, vsize, &
3896 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
3897 & scale, fmin, fmax, &
3898# ifdef MASKING
3899 & grid(ng) % umask, &
3900# endif
3901# ifdef CHECKSUM
3902 & forces(ng) % ad_ustr(:,:,:,tindex), &
3903 & checksum = fhash)
3904# else
3905 & forces(ng) % ad_ustr(:,:,:,tindex))
3906# endif
3907 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3908 IF (master) THEN
3909 WRITE (stdout,60) string, trim(vname(1,idusms)), &
3910 & inprec, trim(ncname)
3911 END IF
3912 exit_flag=2
3913 ioerror=status
3914 RETURN
3915 ELSE
3916 IF (master) THEN
3917# ifdef CHECKSUM
3918 WRITE (stdout,70) trim(vname(2,idusms))// &
3919 & ', adjusted ad_ustr', fmin, fmax, &
3920 & fhash
3921# else
3922 WRITE (stdout,70) trim(vname(2,idusms))// &
3923 & ', adjusted ad_ustr', fmin, fmax
3924# endif
3925 END IF
3926 END IF
3927 ELSE
3928 IF (master) THEN
3929 WRITE (stdout,80) string, trim(vname(1,idusms)), &
3930 & trim(ncname)
3931 END IF
3932 exit_flag=4
3933 IF (founderror(exit_flag, nf90_noerr, &
3934 & __line__, myfile)) THEN
3935 RETURN
3936 END IF
3937 END IF
3938 END IF
3939!
3940! Read in adjoint linear surface V-momentum stress.
3941!
3942 IF (get_var(idvsms)) THEN
3943 foundit=find_string(var_name, n_var, trim(vname(1,idvsms)), &
3944 & varid)
3945 IF (foundit) THEN
3946 gtype=var_flag(varid)*v3dvar
3947 scale=1.0_dp
3948 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
3949 & vname(1,idvsms), varid, &
3950 & inprec, gtype, vsize, &
3951 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
3952 & scale, fmin, fmax, &
3953# ifdef MASKING
3954 & grid(ng) % vmask, &
3955# endif
3956# ifdef CHECKSUM
3957 & forces(ng) % ad_vstr(:,:,:,tindex), &
3958 & checksum = fhash)
3959# else
3960 & forces(ng) % ad_vstr(:,:,:,tindex))
3961# endif
3962 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3963 IF (master) THEN
3964 WRITE (stdout,60) string, trim(vname(1,idvsms)), &
3965 & inprec, trim(ncname)
3966 END IF
3967 exit_flag=2
3968 ioerror=status
3969 RETURN
3970 ELSE
3971 IF (master) THEN
3972# ifdef CHECKSUM
3973 WRITE (stdout,70) trim(vname(2,idvsms))// &
3974 & ', adjusted ad_vstr', fmin, fmax, &
3975 & fhash
3976# else
3977 WRITE (stdout,70) trim(vname(2,idvsms))// &
3978 & ', adjusted ad_vstr', fmin, fmax
3979# endif
3980 END IF
3981 END IF
3982 ELSE
3983 IF (master) THEN
3984 WRITE (stdout,80) string, trim(vname(1,idvsms)), &
3985 & trim(ncname)
3986 END IF
3987 exit_flag=4
3988 IF (founderror(exit_flag, nf90_noerr, &
3989 & __line__, myfile)) THEN
3990 RETURN
3991 END IF
3992 END IF
3993 END IF
3994# endif
3995# ifdef SOLVE3D
3996!
3997! Read in adjoint 3D U-momentum component.
3998!
3999 IF (get_var(iduvel)) THEN
4000 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
4001 & varid)
4002 IF (foundit) THEN
4003 gtype=var_flag(varid)*u3dvar
4004 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
4005 & vname(1,iduvel), varid, &
4006 & inprec, gtype, vsize, &
4007 & lbi, ubi, lbj, ubj, 1, n(ng), &
4008 & fscl, fmin, fmax, &
4009# ifdef MASKING
4010 & grid(ng) % umask, &
4011# endif
4012# ifdef CHECKSUM
4013 & ocean(ng) % ad_u(:,:,:,tindex), &
4014 & checksum = fhash)
4015# else
4016 & ocean(ng) % ad_u(:,:,:,tindex))
4017# endif
4018 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4019 IF (master) THEN
4020 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
4021 & inprec, trim(ncname)
4022 END IF
4023 exit_flag=2
4024 ioerror=status
4025 RETURN
4026 ELSE
4027 IF (master) THEN
4028# ifdef CHECKSUM
4029 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
4030 & fhash
4031# else
4032 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
4033# endif
4034
4035 END IF
4036 END IF
4037 ELSE
4038 IF (master) THEN
4039 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
4040 & trim(ncname)
4041 END IF
4042 exit_flag=4
4043 IF (founderror(exit_flag, nf90_noerr, &
4044 & __line__, myfile)) THEN
4045 RETURN
4046 END IF
4047 END IF
4048 END IF
4049
4050# ifdef ADJUST_BOUNDARY
4051!
4052! Read in adjoint 3D U-momentum component open boundaries adjustments.
4053!
4054 IF (get_var(idsbry(isuvel)).and. &
4055 & any(lobc(:,isuvel,ng))) THEN
4056 ifield=idsbry(isuvel)
4057 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
4058 & varid)
4059 IF (foundit) THEN
4060 status=nf_fread3d_bry(ng, idmod, ncname, ncinpid, &
4061 & vname(1,ifield), varid, &
4062 & inprec, u3dvar, &
4063 & lbij, ubij, 1, n(ng), nbrec(ng), &
4064 & fscl, fmin, fmax, &
4065# ifdef CHECKSUM
4066 & boundary(ng) % ad_u_obc(:,:,:,:, &
4067 & tindex), &
4068 & checksum = fhash)
4069# else
4070 & boundary(ng) % ad_u_obc(:,:,:,:, &
4071 & tindex))
4072# endif
4073 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4074 IF (master) THEN
4075 WRITE (stdout,60) string, trim(vname(1,ifield)), &
4076 & inprec, trim(ncname)
4077 END IF
4078 exit_flag=2
4079 ioerror=status
4080 RETURN
4081 ELSE
4082 IF (master) THEN
4083# ifdef CHECKSUM
4084 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
4085 & fhash
4086# else
4087 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
4088# endif
4089 END IF
4090 END IF
4091 ELSE
4092 IF (master) THEN
4093 WRITE (stdout,80) string, trim(vname(1,ifield)), &
4094 & trim(ncname)
4095 END IF
4096 exit_flag=4
4097 IF (founderror(exit_flag, nf90_noerr, &
4098 & __line__, myfile)) THEN
4099 RETURN
4100 END IF
4101 END IF
4102 END IF
4103# endif
4104!
4105! Read in adjoint 3D V-momentum component.
4106!
4107 IF (get_var(idvvel)) THEN
4108 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
4109 & varid)
4110 IF (foundit) THEN
4111 gtype=var_flag(varid)*v3dvar
4112 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
4113 & vname(1,idvvel), varid, &
4114 & inprec, gtype, vsize, &
4115 & lbi, ubi, lbj, ubj, 1, n(ng), &
4116 & fscl, fmin, fmax, &
4117# ifdef MASKING
4118 & grid(ng) % vmask, &
4119# endif
4120# ifdef CHECKSUM
4121 & ocean(ng) % ad_v(:,:,:,tindex), &
4122 & checksum = fhash)
4123# else
4124 & ocean(ng) % ad_v(:,:,:,tindex))
4125# endif
4126 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4127 IF (master) THEN
4128 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
4129 & inprec, trim(ncname)
4130 END IF
4131 exit_flag=2
4132 ioerror=status
4133 RETURN
4134 ELSE
4135 IF (master) THEN
4136# ifdef CHECKSUM
4137 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
4138 & fhash
4139# else
4140 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
4141# endif
4142
4143 END IF
4144 END IF
4145 ELSE
4146 IF (master) THEN
4147 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
4148 & trim(ncname)
4149 END IF
4150 exit_flag=4
4151 IF (founderror(exit_flag, nf90_noerr, &
4152 & __line__, myfile)) THEN
4153 RETURN
4154 END IF
4155 END IF
4156 END IF
4157
4158# ifdef ADJUST_BOUNDARY
4159!
4160! Read in 3D V-momentum component open boundaries adjustments.
4161!
4162 IF (get_var(idsbry(isvvel)).and. &
4163 & any(lobc(:,isvvel,ng))) THEN
4164 ifield=idsbry(isvvel)
4165 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
4166 & varid)
4167 IF (foundit) THEN
4168 status=nf_fread3d_bry(ng, idmod, ncname, ncinpid, &
4169 & vname(1,ifield), varid, &
4170 & inprec, v3dvar, &
4171 & lbij, ubij, 1, n(ng), nbrec(ng), &
4172 & fscl, fmin, fmax, &
4173# ifdef CHECKSUM
4174 & boundary(ng) % ad_v_obc(:,:,:,:, &
4175 & tindex), &
4176 & checksum = fhash)
4177# else
4178 & boundary(ng) % ad_v_obc(:,:,:,:, &
4179 & tindex))
4180# endif
4181 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4182 IF (master) THEN
4183 WRITE (stdout,60) string, trim(vname(1,ifield)), &
4184 & inprec, trim(ncname)
4185 END IF
4186 exit_flag=2
4187 ioerror=status
4188 RETURN
4189 ELSE
4190 IF (master) THEN
4191# ifdef CHECKSUM
4192 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
4193 & fhash
4194# else
4195 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
4196# endif
4197 END IF
4198 END IF
4199 ELSE
4200 IF (master) THEN
4201 WRITE (stdout,80) string, trim(vname(1,ifield)), &
4202 & trim(ncname)
4203 END IF
4204 exit_flag=4
4205 IF (founderror(exit_flag, nf90_noerr, &
4206 & __line__, myfile)) THEN
4207 RETURN
4208 END IF
4209 END IF
4210 END IF
4211# endif
4212!
4213! Read in adjoint tracer type variables.
4214!
4215 DO itrc=1,nt(ng)
4216 IF (get_var(idtvar(itrc))) THEN
4217 foundit=find_string(var_name, n_var, &
4218 & trim(vname(1,idtvar(itrc))), varid)
4219 IF (foundit) THEN
4220 gtype=var_flag(varid)*r3dvar
4221 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
4222 & vname(1,idtvar(itrc)), varid, &
4223 & inprec, gtype, vsize, &
4224 & lbi, ubi, lbj, ubj, 1, n(ng), &
4225 & fscl, fmin, fmax, &
4226# ifdef MASKING
4227 & grid(ng) % rmask, &
4228# endif
4229# ifdef CHECKSUM
4230 & ocean(ng) % ad_t(:,:,:,tindex,itrc), &
4231 & checksum = fhash)
4232# else
4233 & ocean(ng) % ad_t(:,:,:,tindex,itrc))
4234# endif
4235 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4236 IF (master) THEN
4237 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
4238 & inprec, trim(ncname)
4239 END IF
4240 exit_flag=2
4241 ioerror=status
4242 RETURN
4243 ELSE
4244 IF (master) THEN
4245# ifdef CHECKSUM
4246 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
4247 & fmin, fmin, fhash
4248# else
4249 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
4250 & fmin, fmax
4251# endif
4252 END IF
4253 END IF
4254 ELSE
4255 IF (master) THEN
4256 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
4257 & trim(ncname)
4258 END IF
4259 exit_flag=4
4260 IF (founderror(exit_flag, nf90_noerr, &
4261 & __line__, myfile)) THEN
4262 RETURN
4263 END IF
4264 END IF
4265 END IF
4266 END DO
4267
4268# ifdef ADJUST_BOUNDARY
4269!
4270! Read in adjoint 3D tracers open boundaries adjustments.
4271!
4272 DO itrc=1,nt(ng)
4273 IF (get_var(idsbry(istvar(itrc))).and. &
4274 & any(lobc(:,istvar(itrc),ng))) THEN
4275 ifield=idsbry(istvar(itrc))
4276 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
4277 & varid)
4278 IF (foundit) THEN
4279 status=nf_fread3d_bry(ng, idmod, ncname, ncinpid, &
4280 & vname(1,ifield), varid, &
4281 & inprec, r3dvar, &
4282 & lbij, ubij, 1, n(ng), nbrec(ng), &
4283 & fscl, fmin, fmax, &
4284# ifdef CHECKSUM
4285 & boundary(ng) % ad_t_obc(:,:,:,:, &
4286 & tindex,itrc), &
4287 & checksum = fhash)
4288# else
4289 & boundary(ng) % ad_t_obc(:,:,:,:, &
4290 & tindex,itrc))
4291# endif
4292 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4293 IF (master) THEN
4294 WRITE (stdout,60) string, trim(vname(1,ifield)), &
4295 & inprec, trim(ncname)
4296 END IF
4297 exit_flag=2
4298 ioerror=status
4299 RETURN
4300 ELSE
4301 IF (master) THEN
4302# ifdef CHECKSUM
4303 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
4304 & fhash
4305# else
4306 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
4307# endif
4308 END IF
4309 END IF
4310 ELSE
4311 IF (master) THEN
4312 WRITE (stdout,80) string, trim(vname(1,ifield)), &
4313 & trim(ncname)
4314 END IF
4315 exit_flag=4
4316 IF (founderror(exit_flag, nf90_noerr, &
4317 & __line__, myfile)) THEN
4318 RETURN
4319 END IF
4320 END IF
4321 END IF
4322 END DO
4323# endif
4324# ifdef ADJUST_STFLUX
4325!
4326! Read in adjoint surface tracers flux.
4327!
4328 DO itrc=1,nt(ng)
4329 IF (get_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
4330 foundit=find_string(var_name, n_var, &
4331 & trim(vname(1,idtsur(itrc))), varid)
4332 IF (foundit) THEN
4333 gtype=var_flag(varid)*r3dvar
4334 scale=1.0_dp
4335 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
4336 & vname(1,idtsur(itrc)), varid, &
4337 & inprec, gtype, vsize, &
4338 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
4339 & scale, fmin, fmax, &
4340# ifdef MASKING
4341 & grid(ng) % rmask, &
4342# endif
4343# ifdef CHECKSUM
4344 & forces(ng) % ad_tflux(:,:,:, &
4345 & tindex,itrc), &
4346 & checksum = fhash)
4347# else
4348 & forces(ng) % ad_tflux(:,:,:, &
4349 & tindex,itrc))
4350# endif
4351 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4352 IF (master) THEN
4353 WRITE (stdout,60) string, trim(vname(1,idtsur(itrc))),&
4354 & inprec, trim(ncname)
4355 END IF
4356 exit_flag=2
4357 ioerror=status
4358 RETURN
4359 ELSE
4360 IF (master) THEN
4361# ifdef CHECKSUM
4362 WRITE (stdout,70) trim(vname(2,idtsur(itrc)))// &
4363 & ', adjusted ad_tflux', fmin, fmax, &
4364 & fhash
4365# else
4366 WRITE (stdout,70) trim(vname(2,idtsur(itrc)))// &
4367 & ', adjusted ad_tflux', fmin, fmax
4368# endif
4369 END IF
4370 END IF
4371 ELSE
4372 IF (master) THEN
4373 WRITE (stdout,80) string, trim(vname(1,idtsur(itrc))), &
4374 & trim(ncname)
4375 END IF
4376 exit_flag=4
4377 IF (founderror(exit_flag, nf90_noerr, &
4378 & __line__, myfile)) THEN
4379 RETURN
4380 END IF
4381 END IF
4382 END IF
4383 END DO
4384# endif
4385# ifdef SEDIMENT
4386!
4387! Read in adjoint sediment fraction of each size class in each bed
4388! layer.
4389!
4390 DO i=1,nst
4391 IF (get_var(idfrac(i))) THEN
4392 foundit=find_string(var_name, n_var, &
4393 & trim(vname(1,idfrac(i))), varid)
4394 IF (foundit) THEN
4395 gtype=var_flag(varid)*b3dvar
4396 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
4397 & vname(1,idfrac(i)), varid, &
4398 & inprec, gtype, vsize, &
4399 & lbi, ubi, lbj, ubj, 1, nbed, &
4400 & fscl, fmin, fmax, &
4401# ifdef MASKING
4402 & grid(ng) % rmask, &
4403# endif
4404# ifdef CHECKSUM
4405 & sedbed(ng) % ad_bed_frac(:,:,:,i), &
4406 & checksum = fhash)
4407# else
4408 & sedbed(ng) % ad_bed_frac(:,:,:,i))
4409# endif
4410 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4411 IF (master) THEN
4412 WRITE (stdout,60) string, trim(vname(1,idfrac(i))), &
4413 & inprec, trim(ncname)
4414 END IF
4415 exit_flag=2
4416 ioerror=status
4417 RETURN
4418 ELSE
4419 IF (master) THEN
4420# ifdef CHECKSUM
4421 WRITE (stdout,70) trim(vname(2,idfrac(i))), &
4422 & fmin, fmax, fhash
4423# else
4424 WRITE (stdout,70) trim(vname(2,idfrac(i))), &
4425 & fmin, fmax
4426# endif
4427 END IF
4428 END IF
4429 ELSE
4430 IF (master) THEN
4431 WRITE (stdout,80) string, trim(vname(1,idfrac(i))), &
4432 & trim(ncname)
4433 END IF
4434 exit_flag=4
4435 IF (founderror(exit_flag, nf90_noerr, &
4436 & __line__, myfile)) THEN
4437 RETURN
4438 END IF
4439 END IF
4440 END IF
4441!
4442! Read in adjoint sediment mass of each size class in each bed layer.
4443!
4444 IF (get_var(idbmas(i))) THEN
4445 foundit=find_string(var_name, n_var,
4446 & trim(vname(1,idbmas(i))), varid)
4447 IF (foundit) THEN
4448 gtype=var_flag(varid)*b3dvar
4449 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
4450 & vname(1,idbmas(i)), varid, &
4451 & inprec, gtype, vsize, &
4452 & lbi, ubi, lbj, ubj, 1, nbed, &
4453 & fscl, fmin, fmax, &
4454# ifdef MASKING
4455 & grid(ng) % rmask, &
4456# endif
4457# ifdef CHECKSUM
4458 & sedbed(ng) % ad_bed_mass(:,:,:, &
4459 tindex,i), &
4460 & checksum = fhash)
4461# else
4462 & sedbed(ng) % ad_bed_mass(:,:,:, &
4463 & tindex,i))
4464# endif
4465 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4466 IF (master) THEN
4467 WRITE (stdout,60) string, trim(vname(1,idbmas(i))), &
4468 & inprec, trim(ncname)
4469 END IF
4470 exit_flag=2
4471 ioerror=status
4472 RETURN
4473 ELSE
4474 IF (master) THEN
4475# ifdef CHECKSUM
4476 WRITE (stdout,70) trim(vname(2,idbmas(i))), &
4477 & fmin, fmax, fhash
4478# else
4479 WRITE (stdout,70) trim(vname(2,idbmas(i))), &
4480 & fmin, fmax
4481# endif
4482 END IF
4483 END IF
4484 ELSE
4485 IF (master) THEN
4486 WRITE (stdout,80) string, trim(vname(1,idbmas(i))), &
4487 & trim(ncname)
4488 END IF
4489 exit_flag=4
4490 IF (founderror(exit_flag, nf90_noerr, &
4491 & __line__, myfile)) THEN
4492 RETURN
4493 END IF
4494 END IF
4495 END IF
4496 END DO
4497!
4498! Read in adjoint sediment properties in each bed layer.
4499!
4500 DO i=1,mbedp
4501 IF (get_var(idsbed(i))) THEN
4502 foundit=find_string(var_name, n_var, &
4503 & trim(vname(1,idsbed(i))), varid)
4504 IF (foundit) THEN
4505 gtype=var_flag(varid)*b3dvar
4506 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
4507 & vname(1,idsbed(i)), varid, &
4508 & inprec, gtype, vsize, &
4509 & lbi, ubi, lbj, ubj, 1, nbed, &
4510 & fscl, fmin, fmax, &
4511# ifdef MASKING
4512 & grid(ng) % rmask, &
4513# endif
4514# ifdef CHECKSUM
4515 & sedbed(ng) % ad_bed(:,:,:,i), &
4516 & checksum = fhash)
4517# else
4518 & sedbed(ng) % ad_bed(:,:,:,i))
4519# endif
4520 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4521 IF (master) THEN
4522 WRITE (stdout,60) string, trim(vname(1,idsbed(i))), &
4523 & inprec, trim(ncname)
4524 END IF
4525 exit_flag=2
4526 ioerror=status
4527 RETURN
4528 ELSE
4529 IF (master) THEN
4530# ifdef CHECKSUM
4531 WRITE (stdout,70) trim(vname(2,idsbed(i))), &
4532 & fmin, fmax, fhash
4533# else
4534 WRITE (stdout,70) trim(vname(2,idsbed(i))), &
4535 & fmin, fmax
4536# endif
4537 END IF
4538 END IF
4539 ELSE
4540 IF (master) THEN
4541 WRITE (stdout,80) string, trim(vname(1,idsbed(i))), &
4542 & trim(ncname)
4543 END IF
4544 exit_flag=4
4545 IF (founderror(exit_flag, nf90_noerr, &
4546 & __line__, myfile)) THEN
4547 RETURN
4548 END IF
4549 END IF
4550 END IF
4551 END DO
4552# ifdef BEDLOAD
4553!
4554! Read in adjoint sediment fraction of bed load.
4555!
4556 DO i=1,nst
4557 IF (get_var(idubld(i))) THEN
4558 foundit=find_string(var_name, n_var, &
4559 & trim(vname(1,idubld(i))), varid)
4560 IF (foundit) THEN
4561 gtype=var_flag(varid)*u2dvar
4562 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
4563 & vname(1,idubld(i)), varid, &
4564 & inprec, gtype, vsize, &
4565 & lbi, ubi, lbj, ubj, &
4566 & fscl, fmin, fmax, &
4567# ifdef MASKING
4568 & grid(ng) % umask, &
4569# endif
4570# ifdef CHECKSUM
4571 & sedbed(ng) % ad_bedldu(:,:,i), &
4572 & checksum = fhash)
4573# else
4574 & sedbed(ng) % ad_bedldu(:,:,i))
4575# endif
4576 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4577 IF (master) THEN
4578 WRITE (stdout,60) string, trim(vname(1,idubld(i))), &
4579 & inprec, trim(ncname)
4580 END IF
4581 exit_flag=2
4582 ioerror=status
4583 RETURN
4584 ELSE
4585 IF (master) THEN
4586# ifdef CHECKSUM
4587 WRITE (stdout,70) trim(vname(2,idubld(i))), &
4588 & fmin, fmax, fhash
4589# else
4590 WRITE (stdout,70) trim(vname(2,idubld(i))), &
4591 & fmin, fmax
4592# endif
4593 END IF
4594 END IF
4595 ELSE
4596 IF (master) THEN
4597 WRITE (stdout,80) string, trim(vname(1,idubld(i))), &
4598 & trim(ncname)
4599 END IF
4600 exit_flag=4
4601 IF (founderror(exit_flag, nf90_noerr, &
4602 & __line__, myfile)) THEN
4603 RETURN
4604 END IF
4605 END IF
4606 END IF
4607!
4608 IF (get_var(idvbld(i))) THEN
4609 foundit=find_string(var_name, n_var, &
4610 & trim(vname(1,idvbld(i))), varid)
4611 IF (foundit) THEN
4612 gtype=var_flag(varid)*v2dvar
4613 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
4614 & vname(1,idvbld(i)), varid, &
4615 & inprec, gtype, vsize, &
4616 & lbi, ubi, lbj, ubj, &
4617 & fscl, fmin, fmax, &
4618# ifdef MASKING
4619 & grid(ng) % vmask, &
4620# endif
4621# ifdef CHECKSUM
4622 & sedbed(ng) % ad_bedldv(:,:,i), &
4623 & checksum = fhash)
4624# else
4625 & sedbed(ng) % ad_bedldv(:,:,i))
4626# endif
4627 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4628 IF (master) THEN
4629 WRITE (stdout,60) string, trim(vname(1,idvbld(i))), &
4630 & inprec, trim(ncname)
4631 END IF
4632 exit_flag=2
4633 ioerror=status
4634 RETURN
4635 ELSE
4636 IF (master) THEN
4637# ifdef CHECKSUM
4638 WRITE (stdout,70) trim(vname(2,idvbld(i))), &
4639 & fmin, fmax, fhash
4640# else
4641 WRITE (stdout,70) trim(vname(2,idvbld(i))), &
4642 & fmin, fmax
4643# endif
4644 END IF
4645 END IF
4646 ELSE
4647 IF (master) THEN
4648 WRITE (stdout,80) string, trim(vname(1,idvbld(i))), &
4649 & trim(ncname)
4650 END IF
4651 exit_flag=4
4652 IF (founderror(exit_flag, nf90_noerr, &
4653 & __line__, myfile)) THEN
4654 RETURN
4655 END IF
4656 END IF
4657 END IF
4658 END DO
4659# endif
4660# endif
4661# if defined SEDIMENT || defined BBL_MODEL
4662!
4663! Read in adjoint sediment properties in exposed bed layer.
4664!
4665 DO i=1,mbotp
4666 IF (get_var(idbott(i)).and.have_var(idbott(i))) THEN
4667 foundit=find_string(var_name, n_var, &
4668 & trim(vname(1,idbott(i))), varid)
4669 IF (foundit) THEN
4670 gtype=var_flag(varid)*r2dvar
4671 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
4672 & vname(1,idbott(i)), varid, &
4673 & inprec, gtype, vsize, &
4674 & lbi, ubi, lbj, ubj, &
4675 & fscl, fmin, fmax, &
4676# ifdef MASKING
4677 & grid(ng) % rmask, &
4678# endif
4679# ifdef CHECKSUM
4680 & sedbed(ng) % ad_bottom(:,:,i), &
4681 & checksum = fhash)
4682# else
4683 & sedbed(ng) % ad_bottom(:,:,i))
4684# endif
4685 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4686 IF (master) THEN
4687 WRITE (stdout,60) string, trim(vname(1,idbott(i))), &
4688 & inprec, trim(ncname)
4689 END IF
4690 exit_flag=2
4691 ioerror=status
4692 RETURN
4693 ELSE
4694 IF (master) THEN
4695# ifdef CHECKSUM
4696 WRITE (stdout,70) trim(vname(2,idbott(i))), &
4697 & fmin, fmax, fhash
4698# else
4699 WRITE (stdout,70) trim(vname(2,idbott(i))), &
4700 & fmin, fmax
4701# endif
4702 END IF
4703 END IF
4704 ELSE
4705 IF (master) THEN
4706 WRITE (stdout,80) string, trim(vname(1,idbott(i))), &
4707 & trim(ncname)
4708 END IF
4709 exit_flag=4
4710 IF (founderror(exit_flag, nf90_noerr, &
4711 & __line__, myfile)) THEN
4712 RETURN
4713 END IF
4714 END IF
4715 END IF
4716 END DO
4717# endif
4718# endif
4719 END IF adm_state
4720#endif
4721
4722#ifdef FOUR_DVAR
4723!
4724!-----------------------------------------------------------------------
4725! Read in error covariance normalization (nondimensional) factors.
4726!-----------------------------------------------------------------------
4727!
4728 nrm_state: IF ((model.eq.14).or. &
4729 & (model.eq.15).or. &
4730 & (model.eq.16).or. &
4731 & (model.eq.17)) THEN
4732!
4733! Read in free-surface normalization factor.
4734!
4735 IF (get_var(idfsur).and.((model.eq.14).or.(model.eq.15))) THEN
4736 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
4737 & varid)
4738 IF (foundit) THEN
4739 gtype=var_flag(varid)*r2dvar
4740 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
4741 & vname(1,idfsur), varid, &
4742 & inprec, gtype, vsize, &
4743 & lbi, ubi, lbj, ubj, &
4744 & fscl, fmin, fmax, &
4745# ifdef MASKING
4746 & grid(ng) % rmask, &
4747# endif
4748# ifdef CHECKSUM
4749 & ocean(ng) % b_zeta(:,:,tindex), &
4750 & checksum = fhash)
4751# else
4752 & ocean(ng) % b_zeta(:,:,tindex))
4753# endif
4754 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4755 IF (master) THEN
4756 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
4757 & inprec, trim(ncname)
4758 END IF
4759 exit_flag=2
4760 ioerror=status
4761 RETURN
4762 ELSE
4763 IF (master) THEN
4764# ifdef CHECKSUM
4765 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
4766 & fhash
4767# else
4768 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
4769# endif
4770
4771 END IF
4772 END IF
4773# ifdef DISTRIBUTE
4774 CALL mp_exchange2d (ng, myrank, idmod, 1, &
4775 & lbi, ubi, lbj, ubj, &
4776 & nghostpoints, &
4777 & ewperiodic(ng), nsperiodic(ng), &
4778 & ocean(ng) % b_zeta(:,:,tindex))
4779# endif
4780 ELSE
4781 IF (master) THEN
4782 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
4783 & trim(ncname)
4784 END IF
4785 exit_flag=4
4786 IF (founderror(exit_flag, nf90_noerr, &
4787 & __line__, myfile)) THEN
4788 RETURN
4789 END IF
4790 END IF
4791 END IF
4792!
4793! Read in 2D U-momentum component normalization factor.
4794!
4795 IF (get_var(idubar).and.((model.eq.14).or.(model.eq.15))) THEN
4796 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
4797 & varid)
4798 IF (foundit) THEN
4799 gtype=var_flag(varid)*u2dvar
4800 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
4801 & vname(1,idubar), varid, &
4802 & inprec, gtype, vsize, &
4803 & lbi, ubi, lbj, ubj, &
4804 & fscl, fmin, fmax, &
4805# ifdef MASKING
4806 & grid(ng) % umask, &
4807# endif
4808# ifdef CHECKSUM
4809 & ocean(ng) % b_ubar(:,:,tindex), &
4810 & checksum = fhash)
4811# else
4812 & ocean(ng) % b_ubar(:,:,tindex))
4813# endif
4814 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4815 IF (master) THEN
4816 WRITE (stdout,60) string, trim(vname(1,idubar)), &
4817 & inprec, trim(ncname)
4818 END IF
4819 exit_flag=2
4820 ioerror=status
4821 RETURN
4822 ELSE
4823 IF (master) THEN
4824# ifdef CHECKSUM
4825 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
4826 & fhash
4827# else
4828 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
4829# endif
4830 END IF
4831 END IF
4832# ifdef DISTRIBUTE
4833 CALL mp_exchange2d (ng, myrank, idmod, 1, &
4834 & lbi, ubi, lbj, ubj, &
4835 & nghostpoints, &
4836 & ewperiodic(ng), nsperiodic(ng), &
4837 & ocean(ng) % b_ubar(:,:,tindex))
4838# endif
4839 ELSE
4840 IF (master) THEN
4841 WRITE (stdout,80) string, trim(vname(1,idubar)), &
4842 & trim(ncname)
4843 END IF
4844 exit_flag=4
4845 IF (founderror(exit_flag, nf90_noerr, &
4846 & __line__, myfile)) THEN
4847 RETURN
4848 END IF
4849 END IF
4850 END IF
4851!
4852! Read in 2D V-momentum component normalization factor.
4853!
4854 IF (get_var(idvbar).and.((model.eq.14).or.(model.eq.15))) THEN
4855 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
4856 & varid)
4857 IF (foundit) THEN
4858 gtype=var_flag(varid)*v2dvar
4859 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
4860 & vname(1,idvbar), varid, &
4861 & inprec, gtype, vsize, &
4862 & lbi, ubi, lbj, ubj, &
4863 & fscl, fmin, fmax, &
4864# ifdef MASKING
4865 & grid(ng) % vmask, &
4866# endif
4867# ifdef CHECKSUM
4868 & ocean(ng) % b_vbar(:,:,tindex), &
4869 & checksum = fhash)
4870# else
4871 & ocean(ng) % b_vbar(:,:,tindex))
4872# endif
4873 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4874 IF (master) THEN
4875 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
4876 & inprec, trim(ncname)
4877 END IF
4878 exit_flag=2
4879 ioerror=status
4880 RETURN
4881 ELSE
4882 IF (master) THEN
4883# ifdef CHECKSUM
4884 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
4885 & fhash
4886# else
4887 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
4888# endif
4889 END IF
4890 END IF
4891# ifdef DISTRIBUTE
4892 CALL mp_exchange2d (ng, myrank, idmod, 1, &
4893 & lbi, ubi, lbj, ubj, &
4894 & nghostpoints, &
4895 & ewperiodic(ng), nsperiodic(ng), &
4896 & ocean(ng) % b_vbar(:,:,tindex))
4897# endif
4898 ELSE
4899 IF (master) THEN
4900 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
4901 & trim(ncname)
4902 END IF
4903 exit_flag=4
4904 IF (founderror(exit_flag, nf90_noerr, &
4905 & __line__, myfile)) THEN
4906 RETURN
4907 END IF
4908
4909 END IF
4910 END IF
4911
4912# ifdef SOLVE3D
4913!
4914! Read in 3D U-momentum component normalization factor.
4915!
4916 IF (get_var(iduvel).and.((model.eq.14).or.(model.eq.15))) THEN
4917 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
4918 & varid)
4919 IF (foundit) THEN
4920 gtype=var_flag(varid)*u3dvar
4921 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
4922 & vname(1,iduvel), varid, &
4923 & inprec, gtype, vsize, &
4924 & lbi, ubi, lbj, ubj, 1, n(ng), &
4925 & fscl, fmin, fmax, &
4926# ifdef MASKING
4927 & grid(ng) % umask, &
4928# endif
4929# ifdef CHECKSUM
4930 & ocean(ng) % b_u(:,:,:,tindex), &
4931 & checksum = fhash)
4932# else
4933 & ocean(ng) % b_u(:,:,:,tindex))
4934# endif
4935 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4936 IF (master) THEN
4937 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
4938 & inprec, trim(ncname)
4939 END IF
4940 exit_flag=2
4941 ioerror=status
4942 RETURN
4943 ELSE
4944 IF (master) THEN
4945# ifdef CHECKSUM
4946 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
4947 & fhash
4948# else
4949 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
4950# endif
4951 END IF
4952 END IF
4953# ifdef DISTRIBUTE
4954 CALL mp_exchange3d (ng, myrank, idmod, 1, &
4955 & lbi, ubi, lbj, ubj, 1, n(ng), &
4956 & nghostpoints, &
4957 & ewperiodic(ng), nsperiodic(ng), &
4958 & ocean(ng) % b_u(:,:,:,tindex))
4959# endif
4960 ELSE
4961 IF (master) THEN
4962 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
4963 & trim(ncname)
4964 END IF
4965 exit_flag=4
4966 IF (founderror(exit_flag, nf90_noerr, &
4967 & __line__, myfile)) THEN
4968 RETURN
4969 END IF
4970
4971 END IF
4972 END IF
4973!
4974! Read in 3D V-momentum component normalization factor.
4975!
4976 IF (get_var(idvvel).and.((model.eq.14).or.(model.eq.15))) THEN
4977 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
4978 & varid)
4979 IF (foundit) THEN
4980 gtype=var_flag(varid)*v3dvar
4981 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
4982 & vname(1,idvvel), varid, &
4983 & inprec, gtype, vsize, &
4984 & lbi, ubi, lbj, ubj, 1, n(ng), &
4985 & fscl, fmin, fmax, &
4986# ifdef MASKING
4987 & grid(ng) % vmask, &
4988# endif
4989# ifdef CHECKSUM
4990 & ocean(ng) % b_v(:,:,:,tindex), &
4991 & checksum = fhash)
4992# else
4993 & ocean(ng) % b_v(:,:,:,tindex))
4994# endif
4995 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4996 IF (master) THEN
4997 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
4998 & inprec, trim(ncname)
4999 END IF
5000 exit_flag=2
5001 ioerror=status
5002 RETURN
5003 ELSE
5004 IF (master) THEN
5005# ifdef CHECKSUM
5006 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
5007 & fhash
5008# else
5009 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
5010# endif
5011 END IF
5012 END IF
5013# ifdef DISTRIBUTE
5014 CALL mp_exchange3d (ng, myrank, idmod, 1, &
5015 & lbi, ubi, lbj, ubj, 1, n(ng), &
5016 & nghostpoints, &
5017 & ewperiodic(ng), nsperiodic(ng), &
5018 & ocean(ng) % b_v(:,:,:,tindex))
5019# endif
5020 ELSE
5021 IF (master) THEN
5022 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
5023 & trim(ncname)
5024 END IF
5025 exit_flag=4
5026 IF (founderror(exit_flag, nf90_noerr, &
5027 & __line__, myfile)) THEN
5028 RETURN
5029 END IF
5030
5031 END IF
5032 END IF
5033!
5034! Read in tracer type variables normalization factor.
5035!
5036 DO itrc=1,nt(ng)
5037 IF (get_var(idtvar(itrc)).and. &
5038 & ((model.eq.14).or.(model.eq.15))) THEN
5039 foundit=find_string(var_name, n_var, &
5040 & trim(vname(1,idtvar(itrc))), varid)
5041 IF (foundit) THEN
5042 gtype=var_flag(varid)*r3dvar
5043 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
5044 & vname(1,idtvar(itrc)), varid, &
5045 & inprec, gtype, vsize, &
5046 & lbi, ubi, lbj, ubj, 1, n(ng), &
5047 & fscl, fmin, fmax, &
5048# ifdef MASKING
5049 & grid(ng) % rmask, &
5050# endif
5051# ifdef CHECKSUM
5052 & ocean(ng) % b_t(:,:,:,tindex,itrc), &
5053 & checksum = fhash)
5054# else
5055 & ocean(ng) % b_t(:,:,:,tindex,itrc))
5056# endif
5057 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5058 IF (master) THEN
5059 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
5060 & inprec, trim(ncname)
5061 END IF
5062 exit_flag=2
5063 ioerror=status
5064 RETURN
5065 ELSE
5066 IF (master) THEN
5067# ifdef CHECKSUM
5068 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
5069 & fmin, fmax, fhash
5070# else
5071 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
5072 & fmin, fmax
5073# endif
5074 END IF
5075 END IF
5076# ifdef DISTRIBUTE
5077 CALL mp_exchange3d (ng, myrank, idmod, 1, &
5078 & lbi, ubi, lbj, ubj, 1, n(ng), &
5079 & nghostpoints, &
5080 & ewperiodic(ng), nsperiodic(ng), &
5081 & ocean(ng) % b_t(:,:,:,tindex,itrc))
5082# endif
5083 ELSE
5084 IF (master) THEN
5085 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
5086 & trim(ncname)
5087 END IF
5088 exit_flag=4
5089 IF (founderror(exit_flag, nf90_noerr, &
5090 & __line__, myfile)) THEN
5091 RETURN
5092 END IF
5093 END IF
5094 END IF
5095 END DO
5096# endif
5097# ifdef ADJUST_BOUNDARY
5098!
5099! Read in free-surface open boundaries normalization factor.
5100!
5101 IF (get_var(idsbry(isfsur)).and.(model.eq.16).and. &
5102 & any(lobc(:,isfsur,ng))) THEN
5103 CALL netcdf_get_fvar (ng, idmod, ncname, &
5104 & vname(1,idsbry(isfsur)), &
5105 & boundary(ng) % b_zeta_obc(lbij:,:), &
5106 & ncid = ncinpid, &
5107 & start = (/1,1,inprec/), &
5108 & total = (/iorj,4,1/), &
5109 & min_val = fmin, &
5110 & max_val = fmax)
5111 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5112 IF (master) THEN
5113 WRITE (stdout,75) trim(vname(1,idsbry(isfsur))), &
5114 & fmin, fmax
5115 END IF
5116 END IF
5117!
5118! Read in 2D U-momentum component open boundaries normalization factor.
5119!
5120 IF (get_var(idsbry(isubar)).and.(model.eq.16).and. &
5121 & any(lobc(:,isubar,ng))) THEN
5122 CALL netcdf_get_fvar (ng, idmod, ncname, &
5123 & vname(1,idsbry(isubar)), &
5124 & boundary(ng) % b_ubar_obc(lbij:,:), &
5125 & ncid = ncinpid, &
5126 & start = (/1,1,inprec/), &
5127 & total = (/iorj,4,1/), &
5128 & min_val = fmin, &
5129 & max_val = fmax)
5130 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5131 IF (master) THEN
5132 WRITE (stdout,75) trim(vname(1,idsbry(isubar))), &
5133 & fmin, fmax
5134 END IF
5135 END IF
5136!
5137! Read in 2D V-momentum component open boundaries normalization factor.
5138!
5139 IF (get_var(idsbry(isvbar)).and.(model.eq.16).and. &
5140 & any(lobc(:,isvbar,ng))) THEN
5141 CALL netcdf_get_fvar (ng, idmod, ncname, &
5142 & vname(1,idsbry(isvbar)), &
5143 & boundary(ng) % b_vbar_obc(lbij:,:), &
5144 & ncid = ncinpid, &
5145 & start = (/1,1,inprec/), &
5146 & total = (/iorj,4,1/), &
5147 & min_val = fmin, &
5148 & max_val = fmax)
5149 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5150 IF (master) THEN
5151 WRITE (stdout,75) trim(vname(1,idsbry(isvbar))), &
5152 & fmin, fmax
5153 END IF
5154 END IF
5155
5156# ifdef SOLVE3D
5157!
5158! Read in 3D U-momentum component open boundaries normalization factor.
5159!
5160 IF (get_var(idsbry(isuvel)).and.(model.eq.16).and. &
5161 & any(lobc(:,isuvel,ng))) THEN
5162 CALL netcdf_get_fvar (ng, idmod, ncname, &
5163 & vname(1,idsbry(isuvel)), &
5164 & boundary(ng) % b_u_obc(lbij:,:,:), &
5165 & ncid = ncinpid, &
5166 & start = (/1,1,1,inprec/), &
5167 & total = (/iorj,n(ng),4,1/), &
5168 & min_val = fmin, &
5169 & max_val = fmax)
5170 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5171 IF (master) THEN
5172 WRITE (stdout,75) trim(vname(1,idsbry(isuvel))), &
5173 & fmin, fmax
5174 END IF
5175 END IF
5176!
5177! Read in 3D V-momentum component open boundaries normalization factor.
5178!
5179 IF (get_var(idsbry(isvvel)).and.(model.eq.16).and. &
5180 & any(lobc(:,isvvel,ng))) THEN
5181 CALL netcdf_get_fvar (ng, idmod, ncname, &
5182 & vname(1,idsbry(isvvel)), &
5183 & boundary(ng) % b_v_obc(lbij:,:,:), &
5184 & ncid = ncinpid, &
5185 & start = (/1,1,1,inprec/), &
5186 & total = (/iorj,n(ng),4/), &
5187 & min_val = fmin, &
5188 & max_val = fmax)
5189 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5190 IF (master) THEN
5191 WRITE (stdout,75) trim(vname(1,idsbry(isvvel))), &
5192 & fmin, fmax
5193 END IF
5194 END IF
5195!
5196! Read in 3D tracers open boundaries normalization factor.
5197!
5198 DO itrc=1,nt(ng)
5199 IF (get_var(idsbry(istvar(itrc))).and.(model.eq.16).and. &
5200 & any(lobc(:,istvar(itrc),ng))) THEN
5201 CALL netcdf_get_fvar (ng, idmod, ncname, &
5202 & vname(1,idsbry(istvar(itrc))), &
5203 & boundary(ng) % b_t_obc(lbij:,:,:, &
5204 & itrc), &
5205 & ncid = ncinpid, &
5206 & start =(/1,1,1,inprec/), &
5207 & total =(/iorj,n(ng),4,1/), &
5208 & min_val = fmin, &
5209 & max_val = fmax)
5210 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5211 IF (master) THEN
5212 WRITE (stdout,75) trim(vname(1,idsbry(istvar(itrc)))), &
5213 & fmin, fmax
5214 END IF
5215 END IF
5216 END DO
5217# endif
5218# endif
5219# ifdef ADJUST_WSTRESS
5220!
5221! Read in surface U-momentum stress normalization factors.
5222!
5223 IF (get_var(idusms).and.(model.eq.17)) THEN
5224 foundit=find_string(var_name, n_var, trim(vname(1,idusms)), &
5225 & varid)
5226 IF (foundit) THEN
5227 gtype=var_flag(varid)*u2dvar
5228 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
5229 & vname(1,idusms), varid, &
5230 & inprec, gtype, vsize, &
5231 & lbi, ubi, lbj, ubj, &
5232 & fscl, fmin, fmax, &
5233# ifdef MASKING
5234 & grid(ng) % umask, &
5235# endif
5236# ifdef CHECKSUM
5237 & forces(ng) % b_sustr, &
5238 & checksum = fhash)
5239# else
5240 & forces(ng) % b_sustr)
5241# endif
5242 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5243 IF (master) THEN
5244 WRITE (stdout,60) string, trim(vname(1,idusms)), &
5245 & inprec, trim(ncname)
5246 END IF
5247 exit_flag=2
5248 ioerror=status
5249 RETURN
5250 ELSE
5251 IF (master) THEN
5252# ifdef CHECKSUM
5253 WRITE (stdout,70) trim(vname(2,idusms)), fmin, fmax, &
5254 & fhash
5255# else
5256 WRITE (stdout,70) trim(vname(2,idusms)), fmin, fmax
5257# endif
5258 END IF
5259 END IF
5260# ifdef DISTRIBUTE
5261 CALL mp_exchange2d (ng, myrank, idmod, 1, &
5262 & lbi, ubi, lbj, ubj, &
5263 & nghostpoints, &
5264 & ewperiodic(ng), nsperiodic(ng), &
5265 & forces(ng) % b_sustr)
5266# endif
5267 ELSE
5268 IF (master) THEN
5269 WRITE (stdout,80) string, trim(vname(1,idusms)), &
5270 & trim(ncname)
5271 END IF
5272 exit_flag=4
5273 IF (founderror(exit_flag, nf90_noerr, &
5274 & __line__, myfile)) THEN
5275 RETURN
5276 END IF
5277 END IF
5278 END IF
5279!
5280! Read in surface V-momentum stress normalization factors.
5281!
5282 IF (get_var(idvsms).and.(model.eq.17)) THEN
5283 foundit=find_string(var_name, n_var, trim(vname(1,idvsms)), &
5284 & varid)
5285 IF (foundit) THEN
5286 gtype=var_flag(varid)*v2dvar
5287 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
5288 & vname(1,idvsms), varid, &
5289 & inprec, gtype, vsize, &
5290 & lbi, ubi, lbj, ubj, &
5291 & fscl, fmin, fmax, &
5292# ifdef MASKING
5293 & grid(ng) % vmask, &
5294# endif
5295# ifdef CHECKSUM
5296 & forces(ng) % b_svstr, &
5297 & checksum = fhash)
5298# else
5299 & forces(ng) % b_svstr)
5300# endif
5301 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5302 IF (master) THEN
5303 WRITE (stdout,60) string, trim(vname(1,idvsms)), &
5304 & inprec, trim(ncname)
5305 END IF
5306 exit_flag=2
5307 ioerror=status
5308 RETURN
5309 ELSE
5310 IF (master) THEN
5311# ifdef CHECKSUM
5312 WRITE (stdout,70) trim(vname(2,idvsms)), fmin, fmax, &
5313 & fhash
5314# else
5315 WRITE (stdout,70) trim(vname(2,idvsms)), fmin, fmax
5316# endif
5317 END IF
5318 END IF
5319# ifdef DISTRIBUTE
5320 CALL mp_exchange2d (ng, myrank, idmod, 1, &
5321 & lbi, ubi, lbj, ubj, &
5322 & nghostpoints, &
5323 & ewperiodic(ng), nsperiodic(ng), &
5324 & forces(ng) % b_svstr)
5325# endif
5326 ELSE
5327 IF (master) THEN
5328 WRITE (stdout,80) string, trim(vname(1,idvsms)), &
5329 & trim(ncname)
5330 END IF
5331 exit_flag=4
5332 IF (founderror(exit_flag, nf90_noerr, &
5333 & __line__, myfile)) THEN
5334 RETURN
5335 END IF
5336
5337 END IF
5338 END IF
5339# endif
5340# if defined ADJUST_STFLUX && defined SOLVE3D
5341!
5342! Read in surface tracer flux normalization factors.
5343!
5344 DO itrc=1,nt(ng)
5345 IF (get_var(idtsur(itrc)).and.(model.eq.17).and. &
5346 & lstflux(itrc,ng)) THEN
5347 foundit=find_string(var_name, n_var, &
5348 & trim(vname(1,idtsur(itrc))), varid)
5349 IF (foundit) THEN
5350 gtype=var_flag(varid)*r2dvar
5351 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
5352 & vname(1,idtsur(itrc)), varid, &
5353 & inprec, gtype, vsize, &
5354 & lbi, ubi, lbj, ubj, &
5355 & fscl, fmin, fmax, &
5356# ifdef MASKING
5357 & grid(ng) % rmask, &
5358# endif
5359# ifdef CHECKSUM
5360 & forces(ng) % b_stflx(:,:,itrc), &
5361 & checksum = fhash)
5362# else
5363 & forces(ng) % b_stflx(:,:,itrc))
5364# endif
5365 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5366 IF (master) THEN
5367 WRITE (stdout,60) string, trim(vname(1,idtsur(itrc))),&
5368 & inprec, trim(ncname)
5369 END IF
5370 exit_flag=2
5371 ioerror=status
5372 RETURN
5373 ELSE
5374 IF (master) THEN
5375# ifdef CHECKSUM
5376 WRITE (stdout,70) trim(vname(2,idtsur(itrc))), &
5377 & fmin, fmax, fhash
5378# else
5379 WRITE (stdout,70) trim(vname(2,idtsur(itrc))), &
5380 & fmin, fmax
5381# endif
5382 END IF
5383 END IF
5384# ifdef DISTRIBUTE
5385 CALL mp_exchange2d (ng, myrank, idmod, 1, &
5386 & lbi, ubi, lbj, ubj, &
5387 & nghostpoints, &
5388 & ewperiodic(ng), nsperiodic(ng), &
5389 & forces(ng) % b_stflx(:,:,itrc))
5390# endif
5391 ELSE
5392 IF (master) THEN
5393 WRITE (stdout,80) string, trim(vname(1,idtsur(itrc))), &
5394 & trim(ncname)
5395 END IF
5396 exit_flag=4
5397 IF (founderror(exit_flag, nf90_noerr, &
5398 & __line__, myfile)) THEN
5399 RETURN
5400 END IF
5401 END IF
5402 END IF
5403 END DO
5404# endif
5405 END IF nrm_state
5406#endif
5407
5408#if defined FOUR_DVAR || (defined HESSIAN_SV && defined BNORM)
5409!
5410!-----------------------------------------------------------------------
5411! Read in error covariance standard deviation factors.
5412!-----------------------------------------------------------------------
5413!
5414 std_state: IF ((model.eq.10).or. &
5415 & (model.eq.11).or. &
5416 & (model.eq.12).or. &
5417 & (model.eq.13)) THEN
5418!
5419! Read in free-surface standard deviation.
5420!
5421 IF (get_var(idfsur).and.((model.eq.10).or.(model.eq.11))) THEN
5422 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
5423 & varid)
5424 IF (foundit) THEN
5425 gtype=var_flag(varid)*r2dvar
5426 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
5427 & vname(1,idfsur), varid, &
5428 & inprec, gtype, vsize, &
5429 & lbi, ubi, lbj, ubj, &
5430 & fscl, fmin, fmax, &
5431# ifdef MASKING
5432 & grid(ng) % rmask, &
5433# endif
5434# ifdef CHECKSUM
5435 & ocean(ng) % e_zeta(:,:,tindex), &
5436 & checksum = fhash)
5437# else
5438 & ocean(ng) % e_zeta(:,:,tindex))
5439# endif
5440 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5441 IF (master) THEN
5442 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
5443 & inprec, trim(ncname)
5444 END IF
5445 exit_flag=2
5446 ioerror=status
5447 RETURN
5448 ELSE
5449 IF (master) THEN
5450# ifdef CHECKSUM
5451 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
5452 & fhash
5453# else
5454 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
5455# endif
5456 END IF
5457 END IF
5458# ifdef DISTRIBUTE
5459 CALL mp_exchange2d (ng, myrank, idmod, 1, &
5460 & lbi, ubi, lbj, ubj, &
5461 & nghostpoints, &
5462 & ewperiodic(ng), nsperiodic(ng), &
5463 & ocean(ng) % e_zeta(:,:,tindex))
5464# endif
5465 ELSE
5466 IF (master) THEN
5467 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
5468 & trim(ncname)
5469 END IF
5470 exit_flag=4
5471 IF (founderror(exit_flag, nf90_noerr, &
5472 & __line__, myfile)) THEN
5473 RETURN
5474 END IF
5475
5476 END IF
5477 END IF
5478!
5479! Read in 2D U-momentum component standard deviation.
5480!
5481 IF (get_var(idubar).and.((model.eq.10).or.(model.eq.11))) THEN
5482 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
5483 & varid)
5484 IF (foundit) THEN
5485 gtype=var_flag(varid)*u2dvar
5486 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
5487 & vname(1,idubar), varid, &
5488 & inprec, gtype, vsize, &
5489 & lbi, ubi, lbj, ubj, &
5490 & fscl, fmin, fmax, &
5491# ifdef MASKING
5492 & grid(ng) % umask, &
5493# endif
5494# ifdef CHECKSUM
5495 & ocean(ng) % e_ubar(:,:,tindex), &
5496 & checksum = fhash)
5497# else
5498 & ocean(ng) % e_ubar(:,:,tindex))
5499# endif
5500 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5501 IF (master) THEN
5502 WRITE (stdout,60) string, trim(vname(1,idubar)), &
5503 & inprec, trim(ncname)
5504 END IF
5505 exit_flag=2
5506 ioerror=status
5507 RETURN
5508 ELSE
5509 IF (master) THEN
5510# ifdef CHECKSUM
5511 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
5512 & fhash
5513# else
5514 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
5515# endif
5516 END IF
5517 END IF
5518# ifdef DISTRIBUTE
5519 CALL mp_exchange2d (ng, myrank, idmod, 1, &
5520 & lbi, ubi, lbj, ubj, &
5521 & nghostpoints, &
5522 & ewperiodic(ng), nsperiodic(ng), &
5523 & ocean(ng) % e_ubar(:,:,tindex))
5524# endif
5525 ELSE
5526 IF (master) THEN
5527 WRITE (stdout,80) string, trim(vname(1,idubar)), &
5528 & trim(ncname)
5529 END IF
5530 exit_flag=4
5531 IF (founderror(exit_flag, nf90_noerr, &
5532 & __line__, myfile)) THEN
5533 RETURN
5534 END IF
5535 END IF
5536 END IF
5537!
5538! Read in 2D V-momentum component standard deviation.
5539!
5540 IF (get_var(idvbar).and.((model.eq.10).or.(model.eq.11))) THEN
5541 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
5542 & varid)
5543 IF (foundit) THEN
5544 gtype=var_flag(varid)*v2dvar
5545 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
5546 & vname(1,idvbar), varid, &
5547 & inprec, gtype, vsize, &
5548 & lbi, ubi, lbj, ubj, &
5549 & fscl, fmin, fmax, &
5550# ifdef MASKING
5551 & grid(ng) % vmask, &
5552# endif
5553# ifdef CHECKSUM
5554 & ocean(ng) % e_vbar(:,:,tindex), &
5555 & checksum = fhash)
5556# else
5557 & ocean(ng) % e_vbar(:,:,tindex))
5558# endif
5559 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5560 IF (master) THEN
5561 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
5562 & inprec, trim(ncname)
5563 END IF
5564 exit_flag=2
5565 ioerror=status
5566 RETURN
5567 ELSE
5568 IF (master) THEN
5569# ifdef CHECKSUM
5570 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
5571 & fhash
5572# else
5573 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
5574# endif
5575
5576 END IF
5577 END IF
5578# ifdef DISTRIBUTE
5579 CALL mp_exchange2d (ng, myrank, idmod, 1, &
5580 & lbi, ubi, lbj, ubj, &
5581 & nghostpoints, &
5582 & ewperiodic(ng), nsperiodic(ng), &
5583 & ocean(ng) % e_vbar(:,:,tindex))
5584# endif
5585 ELSE
5586 IF (master) THEN
5587 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
5588 & trim(ncname)
5589 END IF
5590 exit_flag=4
5591 IF (founderror(exit_flag, nf90_noerr, &
5592 & __line__, myfile)) THEN
5593 RETURN
5594 END IF
5595
5596 END IF
5597 END IF
5598
5599# ifdef SOLVE3D
5600!
5601! Read in 3D U-momentum component standard deviation.
5602!
5603 IF (get_var(iduvel).and.((model.eq.10).or.(model.eq.11))) THEN
5604 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
5605 & varid)
5606 IF (foundit) THEN
5607 gtype=var_flag(varid)*u3dvar
5608 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
5609 & vname(1,iduvel), varid, &
5610 & inprec, gtype, vsize, &
5611 & lbi, ubi, lbj, ubj, 1, n(ng), &
5612 & fscl, fmin, fmax, &
5613# ifdef MASKING
5614 & grid(ng) % umask, &
5615# endif
5616# ifdef CHECKSUM
5617 & ocean(ng) % e_u(:,:,:,tindex), &
5618 & checksum = fhash)
5619# else
5620 & ocean(ng) % e_u(:,:,:,tindex))
5621# endif
5622 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5623 IF (master) THEN
5624 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
5625 & inprec, trim(ncname)
5626 END IF
5627 exit_flag=2
5628 ioerror=status
5629 RETURN
5630 ELSE
5631 IF (master) THEN
5632# ifdef CHECKSUM
5633 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
5634 & fhash
5635# else
5636 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
5637# endif
5638 END IF
5639 END IF
5640# ifdef DISTRIBUTE
5641 CALL mp_exchange3d (ng, myrank, idmod, 1, &
5642 & lbi, ubi, lbj, ubj, 1, n(ng), &
5643 & nghostpoints, &
5644 & ewperiodic(ng), nsperiodic(ng), &
5645 & ocean(ng) % e_u(:,:,:,tindex))
5646# endif
5647 ELSE
5648 IF (master) THEN
5649 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
5650 & trim(ncname)
5651 END IF
5652 exit_flag=4
5653 IF (founderror(exit_flag, nf90_noerr, &
5654 & __line__, myfile)) THEN
5655 RETURN
5656 END IF
5657 END IF
5658 END IF
5659!
5660! Read in 3D V-momentum standard deviation.
5661!
5662 IF (get_var(idvvel).and.((model.eq.10).or.(model.eq.11))) THEN
5663 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
5664 & varid)
5665 IF (foundit) THEN
5666 gtype=var_flag(varid)*v3dvar
5667 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
5668 & vname(1,idvvel), varid, &
5669 & inprec, gtype, vsize, &
5670 & lbi, ubi, lbj, ubj, 1, n(ng), &
5671 & fscl, fmin, fmax, &
5672# ifdef MASKING
5673 & grid(ng) % vmask, &
5674# endif
5675# ifdef CHECKSUM
5676 & ocean(ng) % e_v(:,:,:,tindex), &
5677 & checksum = fhash)
5678# else
5679 & ocean(ng) % e_v(:,:,:,tindex))
5680# endif
5681 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5682 IF (master) THEN
5683 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
5684 & inprec, trim(ncname)
5685 END IF
5686 exit_flag=2
5687 ioerror=status
5688 RETURN
5689 ELSE
5690 IF (master) THEN
5691# ifdef CHECKSUM
5692 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
5693 & fhash
5694# else
5695 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
5696# endif
5697 END IF
5698 END IF
5699# ifdef DISTRIBUTE
5700 CALL mp_exchange3d (ng, myrank, idmod, 1, &
5701 & lbi, ubi, lbj, ubj, 1, n(ng), &
5702 & nghostpoints, &
5703 & ewperiodic(ng), nsperiodic(ng), &
5704 & ocean(ng) % e_v(:,:,:,tindex))
5705# endif
5706 ELSE
5707 IF (master) THEN
5708 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
5709 & trim(ncname)
5710 END IF
5711 exit_flag=4
5712 IF (founderror(exit_flag, nf90_noerr, &
5713 & __line__, myfile)) THEN
5714 RETURN
5715 END IF
5716
5717 END IF
5718 END IF
5719!
5720! Read in tracer type variables standard deviation.
5721!
5722 DO itrc=1,nt(ng)
5723 IF (get_var(idtvar(itrc)).and. &
5724 & ((model.eq.10).or.(model.eq.11))) THEN
5725 foundit=find_string(var_name, n_var, &
5726 & trim(vname(1,idtvar(itrc))), varid)
5727 IF (foundit) THEN
5728 gtype=var_flag(varid)*r3dvar
5729 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
5730 & vname(1,idtvar(itrc)), varid, &
5731 & inprec, gtype, vsize, &
5732 & lbi, ubi, lbj, ubj, 1, n(ng), &
5733 & fscl, fmin, fmax, &
5734# ifdef MASKING
5735 & grid(ng) % rmask, &
5736# endif
5737# ifdef CHECKSUM
5738 & ocean(ng) % e_t(:,:,:,tindex,itrc), &
5739 & checksum = fhash)
5740# else
5741 & ocean(ng) % e_t(:,:,:,tindex,itrc))
5742# endif
5743 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5744 IF (master) THEN
5745 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
5746 & inprec, trim(ncname)
5747 END IF
5748 exit_flag=2
5749 ioerror=status
5750 RETURN
5751 ELSE
5752 IF (master) THEN
5753# ifdef CHECKSUM
5754 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
5755 & fmin, fmax, fhash
5756# else
5757 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
5758 & fmin, fmax
5759# endif
5760 END IF
5761 END IF
5762# ifdef DISTRIBUTE
5763 CALL mp_exchange3d (ng, myrank, idmod, 1, &
5764 & lbi, ubi, lbj, ubj, 1, n(ng), &
5765 & nghostpoints, &
5766 & ewperiodic(ng), nsperiodic(ng), &
5767 & ocean(ng) % e_t(:,:,:,tindex,itrc))
5768# endif
5769 ELSE
5770 IF (master) THEN
5771 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
5772 & trim(ncname)
5773 END IF
5774 exit_flag=4
5775 IF (founderror(exit_flag, nf90_noerr, &
5776 & __line__, myfile)) THEN
5777 RETURN
5778 END IF
5779 END IF
5780 END IF
5781 END DO
5782# endif
5783!
5784! Read in convolution horizontal diffusion coefficients.
5785!
5786 IF (have_var(idkhor).and.((model.eq.10).or.(model.eq.11))) THEN
5787 foundit=find_string(var_name, n_var, trim(vname(1,idkhor)), &
5788 & varid)
5789 IF (foundit) THEN
5790 gtype=var_flag(varid)*r2dvar
5791 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
5792 & vname(1,idkhor), varid, &
5793 & inprec, gtype, vsize, &
5794 & lbi, ubi, lbj, ubj, &
5795 & fscl, khmin(ng), khmax(ng), &
5796# ifdef MASKING
5797 & grid(ng) % rmask, &
5798# endif
5799# ifdef CHECKSUM
5800 & mixing(ng) % Kh, &
5801 & checksum = fhash)
5802# else
5803 & mixing(ng) % Kh)
5804# endif
5805 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5806 IF (master) THEN
5807 WRITE (stdout,60) string, trim(vname(1,idkhor)), &
5808 & inprec, trim(ncname)
5809 END IF
5810 exit_flag=2
5811 ioerror=status
5812 RETURN
5813 ELSE
5814 IF (master) THEN
5815# ifdef CHECKSUM
5816 WRITE (stdout,70) trim(vname(2,idkhor)), &
5817 & khmin(ng), khmax(ng), fhash
5818# else
5819 WRITE (stdout,70) trim(vname(2,idkhor)), &
5820 & khmin(ng), khmax(ng)
5821# endif
5822 END IF
5823 END IF
5824# ifdef DISTRIBUTE
5825 CALL mp_exchange2d (ng, myrank, idmod, 1, &
5826 & lbi, ubi, lbj, ubj, &
5827 & nghostpoints, &
5828 & ewperiodic(ng), nsperiodic(ng), &
5829 & mixing(ng) % Kh)
5830# endif
5831 ELSE
5832 IF (master) THEN
5833 WRITE (stdout,80) string, trim(vname(1,idkhor)), &
5834 & trim(ncname)
5835 END IF
5836 exit_flag=4
5837 IF (founderror(exit_flag, nf90_noerr, &
5838 & __line__, myfile)) THEN
5839 RETURN
5840 END IF
5841 END IF
5842 END IF
5843
5844# ifdef SOLVE3D
5845!
5846! Read in convolution vertical diffusion coefficient.
5847!
5848 IF (have_var(idkver).and.((model.eq.10).or.(model.eq.11))) THEN
5849 foundit=find_string(var_name, n_var, trim(vname(1,idkver)), &
5850 & varid)
5851 IF (foundit) THEN
5852 gtype=var_flag(varid)*w3dvar
5853 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
5854 & vname(1,idkver), varid, &
5855 & inprec, gtype, vsize, &
5856 & lbi, ubi, lbj, ubj, 0, n(ng), &
5857 & fscl, kvmin(ng), kvmax(ng), &
5858# ifdef MASKING
5859 & grid(ng) % rmask, &
5860# endif
5861# ifdef CHECKSUM
5862 & mixing(ng) % Kv, &
5863 & checksum = fhash)
5864# else
5865 & mixing(ng) % Kv)
5866# endif
5867 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5868 IF (master) THEN
5869 WRITE (stdout,60) string, trim(vname(1,idkver)), &
5870 & inprec, trim(ncname)
5871 END IF
5872 exit_flag=2
5873 ioerror=status
5874 RETURN
5875 ELSE
5876 IF (master) THEN
5877# ifdef CHECKSUM
5878 WRITE (stdout,70) trim(vname(2,idkver)), &
5879 & kvmin(ng), kvmax, fhash
5880# else
5881 WRITE (stdout,70) trim(vname(2,idkver)), &
5882 & kvmin(ng), kvmax, fhash
5883# endif
5884 END IF
5885 END IF
5886# ifdef DISTRIBUTE
5887 CALL mp_exchange3d (ng, myrank, idmod, 1, &
5888 & lbi, ubi, lbj, ubj, 0, n(ng), &
5889 & nghostpoints, &
5890 & ewperiodic(ng), nsperiodic(ng), &
5891 & mixing(ng) % Kv)
5892# endif
5893 ELSE
5894 IF (master) THEN
5895 WRITE (stdout,80) string, trim(vname(1,idkver)), &
5896 & trim(ncname)
5897 END IF
5898 exit_flag=4
5899 IF (founderror(exit_flag, nf90_noerr, &
5900 & __line__, myfile)) THEN
5901 RETURN
5902 END IF
5903 END IF
5904 END IF
5905# endif
5906# ifdef ADJUST_BOUNDARY
5907!
5908! Read in free-surface open boundaries standard deviation.
5909!
5910 IF (get_var(idsbry(isfsur)).and.(model.eq.12).and. &
5911 & any(lobc(:,isfsur,ng))) THEN
5912 CALL netcdf_get_fvar (ng, idmod, ncname, &
5913 & vname(1,idsbry(isfsur)), &
5914 & boundary(ng) % e_zeta_obc(lbij:,:), &
5915 & ncid = ncinpid, &
5916 & start = (/1,1,inprec/), &
5917 & total = (/iorj,4,1/), &
5918 & min_val = fmin, &
5919 & max_val = fmax)
5920 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5921 IF (master) THEN
5922 WRITE (stdout,75) trim(vname(1,idsbry(isfsur))), &
5923 & fmin, fmax
5924 END IF
5925 END IF
5926!
5927! Read in 2D U-momentum component open boundaries standard deviation.
5928!
5929 IF (get_var(idsbry(isubar)).and.(model.eq.12).and. &
5930 & any(lobc(:,isubar,ng))) THEN
5931 CALL netcdf_get_fvar (ng, idmod, ncname, &
5932 & vname(1,idsbry(isubar)), &
5933 & boundary(ng) % e_ubar_obc(lbij:,:), &
5934 & ncid = ncinpid, &
5935 & start = (/1,1,inprec/), &
5936 & total = (/iorj,4,1/), &
5937 & min_val = fmin, &
5938 & max_val = fmax)
5939 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5940 IF (master) THEN
5941 WRITE (stdout,75) trim(vname(1,idsbry(isubar))), &
5942 & fmin, fmax
5943 END IF
5944 END IF
5945!
5946! Read in 2D V-momentum component open boundaries standard deviation.
5947!
5948 IF (get_var(idsbry(isvbar)).and.(model.eq.12).and. &
5949 & any(lobc(:,isvbar,ng))) THEN
5950 CALL netcdf_get_fvar (ng, idmod, ncname, &
5951 & vname(1,idsbry(isvbar)), &
5952 & boundary(ng) % e_vbar_obc(lbij:,:), &
5953 & ncid = ncinpid, &
5954 & start = (/1,1,inprec/), &
5955 & total = (/iorj,4,1/), &
5956 & min_val = fmin, &
5957 & max_val = fmax)
5958 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5959 IF (master) THEN
5960 WRITE (stdout,75) trim(vname(1,idsbry(isvbar))), &
5961 & fmin, fmax
5962 END IF
5963 END IF
5964
5965# ifdef SOLVE3D
5966!
5967! Read in 3D U-momentum component open boundaries standard deviation.
5968!
5969 IF (get_var(idsbry(isuvel)).and.(model.eq.12).and. &
5970 & any(lobc(:,isuvel,ng))) THEN
5971 CALL netcdf_get_fvar (ng, idmod, ncname, &
5972 & vname(1,idsbry(isuvel)), &
5973 & boundary(ng) % e_u_obc(lbij:,:,:), &
5974 & ncid = ncinpid, &
5975 & start = (/1,1,1,inprec/), &
5976 & total = (/iorj,n(ng),4,1/), &
5977 & min_val = fmin, &
5978 & max_val = fmax)
5979 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5980 IF (master) THEN
5981 WRITE (stdout,75) trim(vname(1,idsbry(isuvel))), &
5982 & fmin, fmax
5983 END IF
5984 END IF
5985!
5986! Read in 3D V-momentum component open boundaries standard deviation.
5987!
5988 IF (get_var(idsbry(isvvel)).and.(model.eq.12).and. &
5989 & any(lobc(:,isvvel,ng))) THEN
5990 CALL netcdf_get_fvar (ng, idmod, ncname, &
5991 & vname(1,idsbry(isvvel)), &
5992 & boundary(ng) % e_v_obc(lbij:,:,:), &
5993 & ncid = ncinpid, &
5994 & start = (/1,1,1,inprec/), &
5995 & total = (/iorj,n(ng),4,1/), &
5996 & min_val = fmin, &
5997 & max_val = fmax)
5998 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5999 IF (master) THEN
6000 WRITE (stdout,75) trim(vname(1,idsbry(isvvel))), &
6001 & fmin, fmax
6002 END IF
6003 END IF
6004!
6005! Read in 3D tracers open boundaries standard deviation.
6006!
6007 DO itrc=1,nt(ng)
6008 IF (get_var(idsbry(istvar(itrc))).and.(model.eq.12).and. &
6009 & any(lobc(:,istvar(itrc),ng))) THEN
6010 CALL netcdf_get_fvar (ng, idmod, ncname, &
6011 & vname(1,idsbry(istvar(itrc))), &
6012 & boundary(ng) % e_t_obc(lbij:,:,:, &
6013 & itrc), &
6014 & ncid = ncinpid, &
6015 & start =(/1,1,1,inprec/), &
6016 & total =(/iorj,n(ng),4,1/), &
6017 & min_val = fmin, &
6018 & max_val = fmax)
6019 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6020 IF (master) THEN
6021 WRITE (stdout,75) trim(vname(1,idsbry(istvar(itrc)))), &
6022 & fmin, fmax
6023 END IF
6024 END IF
6025 END DO
6026# endif
6027# endif
6028# ifdef ADJUST_WSTRESS
6029!
6030! Read in surface U-momentum stress standard deviation.
6031!
6032 IF (get_var(idusms).and.(model.eq.13)) THEN
6033 foundit=find_string(var_name, n_var, trim(vname(1,idusms)), &
6034 & varid)
6035 IF (foundit) THEN
6036 gtype=var_flag(varid)*u2dvar
6037 scale=1.0_dp/rho0 ! N/m2 (Pa) to m2/s2
6038 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
6039 & vname(1,idusms), varid, &
6040 & inprec, gtype, vsize, &
6041 & lbi, ubi, lbj, ubj, &
6042 & scale, fmin, fmax, &
6043# ifdef MASKING
6044 & grid(ng) % umask, &
6045# endif
6046# ifdef CHECKSUM
6047 & forces(ng) % e_sustr, &
6048 & checksum = fhash)
6049# else
6050 & forces(ng) % e_sustr)
6051# endif
6052 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6053 IF (master) THEN
6054 WRITE (stdout,60) string, trim(vname(1,idusms)), &
6055 & inprec, trim(ncname)
6056 END IF
6057 exit_flag=2
6058 ioerror=status
6059 RETURN
6060 ELSE
6061 IF (master) THEN
6062# ifdef CHECKSUM
6063 WRITE (stdout,70) trim(vname(2,idusms)), fmin, fmax, &
6064 & fhash
6065# else
6066 WRITE (stdout,70) trim(vname(2,idusms)), fmin, fmax
6067# endif
6068 END IF
6069 END IF
6070# ifdef DISTRIBUTE
6071 CALL mp_exchange2d (ng, myrank, idmod, 1, &
6072 & lbi, ubi, lbj, ubj, &
6073 & nghostpoints, &
6074 & ewperiodic(ng), nsperiodic(ng), &
6075 & forces(ng) % e_sustr)
6076# endif
6077 ELSE
6078 IF (master) THEN
6079 WRITE (stdout,80) string, trim(vname(1,idusms)), &
6080 & trim(ncname)
6081 END IF
6082 exit_flag=4
6083 IF (founderror(exit_flag, nf90_noerr, &
6084 & __line__, myfile)) THEN
6085 RETURN
6086 END IF
6087 END IF
6088 END IF
6089!
6090! Read in surface V-momentum stress standard deviation.
6091!
6092 IF (get_var(idvsms).and.(model.eq.13)) THEN
6093 foundit=find_string(var_name, n_var, trim(vname(1,idvsms)), &
6094 & varid)
6095 IF (foundit) THEN
6096 gtype=var_flag(varid)*v2dvar
6097 scale=1.0_dp/rho0 ! N/m2 (Pa) to m2/s2
6098 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
6099 & vname(1,idvsms), varid, &
6100 & inprec, gtype, vsize, &
6101 & lbi, ubi, lbj, ubj, &
6102 & scale, fmin, fmax, &
6103# ifdef MASKING
6104 & grid(ng) % vmask, &
6105# endif
6106# ifdef CHECKSUM
6107 & forces(ng) % e_svstr, &
6108 & checksum = fhash)
6109# else
6110 & forces(ng) % e_svstr)
6111# endif
6112 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6113 IF (master) THEN
6114 WRITE (stdout,60) string, trim(vname(1,idvsms)), &
6115 & inprec, trim(ncname)
6116 END IF
6117 exit_flag=2
6118 ioerror=status
6119 RETURN
6120 ELSE
6121 IF (master) THEN
6122# ifdef CHECKSUM
6123 WRITE (stdout,70) trim(vname(2,idvsms)), fmin, fmax, &
6124 & fhash
6125# else
6126 WRITE (stdout,70) trim(vname(2,idvsms)), fmin, fmax
6127# endif
6128 END IF
6129 END IF
6130# ifdef DISTRIBUTE
6131 CALL mp_exchange2d (ng, myrank, idmod, 1, &
6132 & lbi, ubi, lbj, ubj, &
6133 & nghostpoints, &
6134 & ewperiodic(ng), nsperiodic(ng), &
6135 & forces(ng) % e_svstr)
6136# endif
6137 ELSE
6138 IF (master) THEN
6139 WRITE (stdout,80) string, trim(vname(1,idvsms)), &
6140 & trim(ncname)
6141 END IF
6142 exit_flag=4
6143 IF (founderror(exit_flag, nf90_noerr, &
6144 & __line__, myfile)) THEN
6145 RETURN
6146 END IF
6147 END IF
6148 END IF
6149# endif
6150# if defined ADJUST_STFLUX && defined SOLVE3D
6151!
6152! Read in surface tracer flux standard deviations.
6153!
6154 DO itrc=1,nt(ng)
6155 IF (get_var(idtsur(itrc)).and.(model.eq.13).and. &
6156 & lstflux(itrc,ng)) THEN
6157 foundit=find_string(var_name, n_var, &
6158 & trim(vname(1,idtsur(itrc))), varid)
6159 IF (foundit) THEN
6160 gtype=var_flag(varid)*r2dvar
6161 IF (itrc.eq.itemp) THEN
6162 scale=1.0_dp/(rho0*cp) ! W/m2 to Celsius m/s
6163 ELSE
6164 scale=1.0_dp
6165 END IF
6166 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
6167 & vname(1,idtsur(itrc)), varid, &
6168 & inprec, gtype, vsize, &
6169 & lbi, ubi, lbj, ubj, &
6170 & scale, fmin, fmax, &
6171# ifdef MASKING
6172 & grid(ng) % rmask, &
6173# endif
6174# ifdef CHECKSUM
6175 & forces(ng) % e_stflx(:,:,itrc), &
6176 & checksum = fhash)
6177# else
6178 & forces(ng) % e_stflx(:,:,itrc))
6179# endif
6180 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6181 IF (master) THEN
6182 WRITE (stdout,60) string, trim(vname(1,idtsur(itrc))),&
6183 & inprec, trim(ncname)
6184 END IF
6185 exit_flag=2
6186 ioerror=status
6187 RETURN
6188 ELSE
6189 IF (master) THEN
6190# ifdef CHECKSUM
6191 WRITE (stdout,70) trim(vname(2,idtsur(itrc))), &
6192 & fmin, fmax, fhash
6193# else
6194 WRITE (stdout,70) trim(vname(2,idtsur(itrc))), &
6195 & fmin, fmax
6196# endif
6197 END IF
6198 END IF
6199# ifdef DISTRIBUTE
6200 CALL mp_exchange2d (ng, myrank, idmod, 1, &
6201 & lbi, ubi, lbj, ubj, &
6202 & nghostpoints, &
6203 & ewperiodic(ng), nsperiodic(ng), &
6204 & forces(ng) % e_stflx(:,:,itrc))
6205# endif
6206 ELSE
6207 IF (master) THEN
6208 WRITE (stdout,80) string, trim(vname(1,idtsur(itrc))), &
6209 & trim(ncname)
6210 END IF
6211 exit_flag=4
6212 IF (founderror(exit_flag, nf90_noerr, &
6213 & __line__, myfile)) THEN
6214 RETURN
6215 END IF
6216 END IF
6217 END IF
6218 END DO
6219# endif
6220 END IF std_state
6221#endif
6222
6223#if defined IMPULSE
6224!
6225!-----------------------------------------------------------------------
6226! Read in adjoint model or tangent linear model impulse forcing terms.
6227!-----------------------------------------------------------------------
6228!
6229 frc_state: IF (model.eq.7) THEN
6230!
6231! Set number of records available.
6232!
6233 nrecfrc(ng)=nrec
6234!
6235! Read in next impulse forcing time to process.
6236!
6237 CALL netcdf_get_time (ng, idmod, ncname, trim(tvarnam), &
6238 & rclock%DateNumber, frctime(ng:), &
6239 & ncid = ncinpid, &
6240 & start = (/inprec/), &
6241 & total = (/1/))
6242 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6243!
6244! Read in free-surface impulse forcing.
6245!
6246 IF (get_var(idfsur)) THEN
6247 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
6248 & varid)
6249 IF (foundit) THEN
6250 gtype=var_flag(varid)*r2dvar
6251 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
6252 & vname(1,idfsur), varid, &
6253 & inprec, gtype, vsize, &
6254 & lbi, ubi, lbj, ubj, &
6255 & fscl, fmin, fmax, &
6256# ifdef MASKING
6257 & grid(ng) % rmask, &
6258# endif
6259# ifdef CHECKSUM
6260 & ocean(ng) % f_zeta, &
6261 & checksum = fhash)
6262# else
6263 & ocean(ng) % f_zeta)
6264# endif
6265 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6266 IF (master) THEN
6267 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
6268 & inprec, trim(ncname)
6269 END IF
6270 exit_flag=2
6271 ioerror=status
6272 RETURN
6273 ELSE
6274 IF (master) THEN
6275# ifdef CHECKSUM
6276 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
6277 & fhash
6278# else
6279 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
6280# endif
6281 END IF
6282 END IF
6283 ELSE
6284 IF (master) THEN
6285 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
6286 & trim(ncname)
6287 END IF
6288 exit_flag=4
6289 IF (founderror(exit_flag, nf90_noerr, &
6290 & __line__, myfile)) THEN
6291 RETURN
6292 END IF
6293 END IF
6294 END IF
6295
6296# ifndef SOLVE3D
6297!
6298! Read in 2D U-momentum impulse forcing.
6299!
6300 IF (get_var(idubar)) THEN
6301 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
6302 & varid)
6303 IF (foundit) THEN
6304 gtype=var_flag(varid)*u2dvar
6305 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
6306 & vname(1,idubar), varid, &
6307 & inprec, gtype, vsize, &
6308 & lbi, ubi, lbj, ubj, &
6309 & fscl, fmin, fmax, &
6310# ifdef MASKING
6311 & grid(ng) % umask, &
6312# endif
6313# ifdef CHECKSUM
6314 & ocean(ng) % f_ubar, &
6315 & checksum = fhash)
6316# else
6317 & ocean(ng) % f_ubar)
6318# endif
6319 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6320 IF (master) THEN
6321 WRITE (stdout,60) string, trim(vname(1,idubar)), &
6322 & inprec, trim(ncname)
6323 END IF
6324 exit_flag=2
6325 ioerror=status
6326 RETURN
6327 ELSE
6328 IF (master) THEN
6329# ifdef CHECKSUM
6330 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
6331 & fhash
6332# else
6333 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
6334# endif
6335 END IF
6336 END IF
6337 ELSE
6338 IF (master) THEN
6339 WRITE (stdout,80) string, trim(vname(1,idubar)), &
6340 & trim(ncname)
6341 END IF
6342 exit_flag=4
6343 IF (founderror(exit_flag, nf90_noerr, &
6344 & __line__, myfile)) THEN
6345 RETURN
6346 END IF
6347 END IF
6348 END IF
6349!
6350! Read in 2D V-momentum impulse forcing.
6351!
6352 IF (get_var(idvbar)) THEN
6353 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
6354 & varid)
6355 IF (foundit) THEN
6356 gtype=var_flag(varid)*v2dvar
6357 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
6358 & vname(1,idvbar), varid, &
6359 & inprec, gtype, vsize, &
6360 & lbi, ubi, lbj, ubj, &
6361 & fscl, fmin, fmax, &
6362# ifdef MASKING
6363 & grid(ng) % vmask, &
6364# endif
6365# ifdef CHECKSUM
6366 & ocean(ng) % f_vbar, &
6367 & checksum = fhash)
6368# else
6369 & ocean(ng) % f_vbar)
6370# endif
6371 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6372 IF (master) THEN
6373 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
6374 & inprec, trim(ncname)
6375 END IF
6376 exit_flag=2
6377 ioerror=status
6378 RETURN
6379 ELSE
6380 IF (master) THEN
6381# ifdef CHECKSUM
6382 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
6383 & fhash
6384# else
6385 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
6386# endif
6387 END IF
6388 END IF
6389 ELSE
6390 IF (master) THEN
6391 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
6392 & trim(ncname)
6393 END IF
6394 exit_flag=4
6395 IF (founderror(exit_flag, nf90_noerr, &
6396 & __line__, myfile)) THEN
6397 RETURN
6398 END IF
6399 END IF
6400 END IF
6401# endif
6402# ifdef SOLVE3D
6403!
6404! Read in 3D U-momentum impulse forcing.
6405!
6406 IF (get_var(iduvel)) THEN
6407 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
6408 & varid)
6409 IF (foundit) THEN
6410 gtype=var_flag(varid)*u3dvar
6411 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
6412 & vname(1,iduvel), varid, &
6413 & inprec, gtype, vsize, &
6414 & lbi, ubi, lbj, ubj, 1, n(ng), &
6415 & fscl, fmin, fmax, &
6416# ifdef MASKING
6417 & grid(ng) % umask, &
6418# endif
6419# ifdef CHECKSUM
6420 & ocean(ng) % f_u, &
6421 & checksum = fhash)
6422# else
6423 & ocean(ng) % f_u)
6424# endif
6425 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6426 IF (master) THEN
6427 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
6428 & inprec, trim(ncname)
6429 END IF
6430 exit_flag=2
6431 ioerror=status
6432 RETURN
6433 ELSE
6434 IF (master) THEN
6435# ifdef CHECKSUM
6436 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
6437 & fhash
6438# else
6439 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
6440# endif
6441 END IF
6442 END IF
6443 ELSE
6444 IF (master) THEN
6445 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
6446 & trim(ncname)
6447 END IF
6448 exit_flag=4
6449 IF (founderror(exit_flag, nf90_noerr, &
6450 & __line__, myfile)) THEN
6451 RETURN
6452 END IF
6453 END IF
6454 END IF
6455!
6456! Read in 3D V-momentum impulse forcing.
6457!
6458 IF (get_var(idvvel)) THEN
6459 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
6460 & varid)
6461 IF (foundit) THEN
6462 gtype=var_flag(varid)*v3dvar
6463 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
6464 & vname(1,idvvel), varid, &
6465 & inprec, gtype, vsize, &
6466 & lbi, ubi, lbj, ubj, 1, n(ng), &
6467 & fscl, fmin, fmax, &
6468# ifdef MASKING
6469 & grid(ng) % vmask, &
6470# endif
6471# ifdef CHECKSUM
6472 & ocean(ng) % f_v, &
6473 & checksum = fhash)
6474# else
6475 & ocean(ng) % f_v)
6476# endif
6477 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6478 IF (master) THEN
6479 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
6480 & inprec, trim(ncname)
6481 END IF
6482 exit_flag=2
6483 ioerror=status
6484 RETURN
6485 ELSE
6486 IF (master) THEN
6487# ifdef CHECKSUM
6488 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
6489 & fhash
6490# else
6491 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
6492# endif
6493 END IF
6494 END IF
6495 ELSE
6496 IF (master) THEN
6497 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
6498 & trim(ncname)
6499 END IF
6500 exit_flag=4
6501 IF (founderror(exit_flag, nf90_noerr, &
6502 & __line__, myfile)) THEN
6503 RETURN
6504 END IF
6505 END IF
6506 END IF
6507!
6508! Read in tracer variables impulse forcing.
6509!
6510 DO itrc=1,nt(ng)
6511 IF (get_var(idtvar(itrc))) THEN
6512 foundit=find_string(var_name, n_var, &
6513 & trim(vname(1,idtvar(itrc))), varid)
6514 IF (foundit) THEN
6515 gtype=var_flag(varid)*r3dvar
6516 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
6517 & vname(1,idtvar(itrc)), varid, &
6518 & inprec, gtype, vsize, &
6519 & lbi, ubi, lbj, ubj, 1, n(ng), &
6520 & fscl, fmin, fmax, &
6521# ifdef MASKING
6522 & grid(ng) % rmask, &
6523# endif
6524# ifdef CHECKSUM
6525 & ocean(ng) % f_t(:,:,:,itrc), &
6526 & checksum = fhash)
6527# else
6528 & ocean(ng) % f_t(:,:,:,itrc))
6529# endif
6530 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6531 IF (master) THEN
6532 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
6533 & inprec, trim(ncname)
6534 END IF
6535 exit_flag=2
6536 ioerror=status
6537 RETURN
6538 ELSE
6539 IF (master) THEN
6540# ifdef CHECKSUM
6541 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
6542 & fmin, fmax, fhash
6543# else
6544 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
6545 & fmin, fmax
6546# endif
6547 END IF
6548 END IF
6549 ELSE
6550 IF (master) THEN
6551 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
6552 & trim(ncname)
6553 END IF
6554 exit_flag=4
6555 IF (founderror(exit_flag, nf90_noerr, &
6556 & __line__, myfile)) THEN
6557 RETURN
6558 END IF
6559 END IF
6560 END IF
6561 END DO
6562# endif
6563 END IF frc_state
6564#endif
6565
6566#if (defined RBL4DVAR || \
6567 defined rbl4dvar_ana_sensitivity || \
6568 defined rbl4dvar_fct_sensitivity || \
6569 defined tl_rbl4dvar) && \
6570 (defined adjust_boundary || \
6571 defined adjust_stflux || \
6572 defined adjust_wstress)
6573!
6574!-----------------------------------------------------------------------
6575! Read in tangent linear forcing corrections.
6576!-----------------------------------------------------------------------
6577!
6578 tlm_forcing: IF (model.eq.5) THEN
6579!
6580! Set switch to process surface forcing and/or open boundaries during
6581! 4D-Var minimization.
6582!
6583 get_adjust=.true.
6584
6585# ifdef ADJUST_BOUNDARY
6586!
6587! Read in free-surface open boundaries adjustments.
6588!
6589 IF (get_var(idsbry(isfsur)).and.get_adjust.and. &
6590 & any(lobc(:,isfsur,ng))) THEN
6591 ifield=idsbry(isfsur)
6592 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
6593 & varid)
6594 IF (foundit) THEN
6595 status=nf_fread2d_bry(ng, idmod, ncname, ncinpid, &
6596 & vname(1,ifield), varid, &
6597 & inprec, r2dvar, &
6598 & lbij, ubij, nbrec(ng), &
6599 & fscl, fmin, fmax, &
6600# ifdef CHECKSUM
6601 & boundary(ng) % tl_zeta_obc(:,:,:, &
6602 & tindex), &
6603 & checksum = fhash)
6604# else
6605 & boundary(ng) % tl_zeta_obc(:,:,:, &
6606 & tindex))
6607# endif
6608 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6609 IF (master) THEN
6610 WRITE (stdout,60) string, trim(vname(1,ifield)), &
6611 & inprec, trim(ncname)
6612 END IF
6613 exit_flag=2
6614 ioerror=status
6615 RETURN
6616 ELSE
6617 IF (master) THEN
6618# ifdef CHECKSUM
6619 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
6620 & fhash
6621# else
6622 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
6623# endif
6624 END IF
6625 END IF
6626 ELSE
6627 IF (master) THEN
6628 WRITE (stdout,80) string, trim(vname(1,ifield)), &
6629 & trim(ncname)
6630 END IF
6631 exit_flag=4
6632 IF (founderror(exit_flag, nf90_noerr, &
6633 & __line__, myfile)) THEN
6634 RETURN
6635 END IF
6636 END IF
6637 END IF
6638!
6639! Read in 2D U-momentum component open boundaries adjustments.
6640!
6641 IF (get_var(idsbry(isubar)).and.get_adjust.and. &
6642 & any(lobc(:,isubar,ng))) THEN
6643 ifield=idsbry(isubar)
6644 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
6645 & varid)
6646 IF (foundit) THEN
6647 status=nf_fread2d_bry(ng, idmod, ncname, ncinpid, &
6648 & vname(1,ifield), varid, &
6649 & inprec, u2dvar, &
6650 & lbij, ubij, nbrec(ng), &
6651 & fscl, fmin, fmax, &
6652# ifdef CHECKSUM
6653 & boundary(ng) % tl_ubar_obc(:,:,:, &
6654 & tindex), &
6655 & checksum = fhash)
6656# else
6657 & boundary(ng) % tl_ubar_obc(:,:,:, &
6658 & tindex))
6659# endif
6660 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6661 IF (master) THEN
6662 WRITE (stdout,60) string, trim(vname(1,ifield)), &
6663 & inprec, trim(ncname)
6664 END IF
6665 exit_flag=2
6666 ioerror=status
6667 RETURN
6668 ELSE
6669 IF (master) THEN
6670# ifdef CHECKSUM
6671 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
6672 & fhash
6673# else
6674 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
6675# endif
6676 END IF
6677 END IF
6678 ELSE
6679 IF (master) THEN
6680 WRITE (stdout,80) string, trim(vname(1,ifield)), &
6681 & trim(ncname)
6682 END IF
6683 exit_flag=4
6684 IF (founderror(exit_flag, nf90_noerr, &
6685 & __line__, myfile)) THEN
6686 RETURN
6687 END IF
6688 END IF
6689 END IF
6690!
6691! Read in 2D V-momentum component open boundaries adjustments.
6692!
6693 IF (get_var(idsbry(isvbar)).and.get_adjust.and. &
6694 & any(lobc(:,isvbar,ng))) THEN
6695 ifield=idsbry(isvbar)
6696 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
6697 & varid)
6698 IF (foundit) THEN
6699 status=nf_fread2d_bry(ng, idmod, ncname, ncinpid, &
6700 & vname(1,ifield), varid, &
6701 & inprec, v2dvar, &
6702 & lbij, ubij, nbrec(ng), &
6703 & fscl, fmin, fmax, &
6704# ifdef CHECKSUM
6705 & boundary(ng) % tl_vbar_obc(:,:,:, &
6706 & tindex), &
6707 & checksum = fhash)
6708# else
6709 & boundary(ng) % tl_vbar_obc(:,:,:, &
6710 & tindex))
6711# endif
6712 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6713 IF (master) THEN
6714 WRITE (stdout,60) string, trim(vname(1,ifield)), &
6715 & inprec, trim(ncname)
6716 END IF
6717 exit_flag=2
6718 ioerror=status
6719 RETURN
6720 ELSE
6721 IF (master) THEN
6722# ifdef CHECKSUM
6723 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
6724 & fhash
6725# else
6726 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
6727# endif
6728 END IF
6729 END IF
6730 ELSE
6731 IF (master) THEN
6732 WRITE (stdout,80) string, trim(vname(1,ifield)), &
6733 & trim(ncname)
6734 END IF
6735 exit_flag=4
6736 IF (founderror(exit_flag, nf90_noerr, &
6737 & __line__, myfile)) THEN
6738 RETURN
6739 END IF
6740 END IF
6741 END IF
6742
6743# ifdef SOLVE3D
6744!
6745! Read in 3D U-momentum component open boundaries adjustments.
6746!
6747 IF (get_var(idsbry(isuvel)).and.get_adjust.and. &
6748 & any(lobc(:,isuvel,ng))) THEN
6749 ifield=idsbry(isuvel)
6750 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
6751 & varid)
6752 IF (foundit) THEN
6753 status=nf_fread3d_bry(ng, idmod, ncname, ncinpid, &
6754 & vname(1,ifield), varid, &
6755 & inprec, u3dvar, &
6756 & lbij, ubij, 1, n(ng), nbrec(ng), &
6757 & fscl, fmin, fmax, &
6758# ifdef CHECKSUM
6759 & boundary(ng) % tl_u_obc(:,:,:,:, &
6760 & tindex), &
6761 & checksum = fhash)
6762# else
6763 & boundary(ng) % tl_u_obc(:,:,:,:, &
6764 & tindex))
6765# endif
6766 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6767 IF (master) THEN
6768 WRITE (stdout,60) string, trim(vname(1,ifield)), &
6769 & inprec, trim(ncname)
6770 END IF
6771 exit_flag=2
6772 ioerror=status
6773 RETURN
6774 ELSE
6775 IF (master) THEN
6776# ifdef CHECKSUM
6777 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
6778 & fhash
6779# else
6780 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
6781# endif
6782 END IF
6783 END IF
6784 ELSE
6785 IF (master) THEN
6786 WRITE (stdout,80) string, trim(vname(1,ifield)), &
6787 & trim(ncname)
6788 END IF
6789 exit_flag=4
6790 IF (founderror(exit_flag, nf90_noerr, &
6791 & __line__, myfile)) THEN
6792 RETURN
6793 END IF
6794 END IF
6795 END IF
6796!
6797! Read in 3D V-momentum component open boundaries adjustments.
6798!
6799 IF (get_var(idsbry(isvvel)).and.get_adjust.and. &
6800 & any(lobc(:,isvvel,ng))) THEN
6801 ifield=idsbry(isvvel)
6802 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
6803 & varid)
6804 IF (foundit) THEN
6805 status=nf_fread3d_bry(ng, idmod, ncname, ncinpid, &
6806 & vname(1,ifield), varid, &
6807 & inprec, v3dvar, &
6808 & lbij, ubij, 1, n(ng), nbrec(ng), &
6809 & fscl, fmin, fmax, &
6810# ifdef CHECKSUM
6811 & boundary(ng) % tl_v_obc(:,:,:,:, &
6812 & tindex), &
6813 & checksum = fhash)
6814# else
6815 & boundary(ng) % tl_v_obc(:,:,:,:, &
6816 & tindex))
6817# endif
6818 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6819 IF (master) THEN
6820 WRITE (stdout,60) string, trim(vname(1,ifield)), &
6821 & inprec, trim(ncname)
6822 END IF
6823 exit_flag=2
6824 ioerror=status
6825 RETURN
6826 ELSE
6827 IF (master) THEN
6828# ifdef CHECKSUM
6829 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
6830 & fhash
6831# else
6832 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
6833# endif
6834
6835 END IF
6836 END IF
6837 ELSE
6838 IF (master) THEN
6839 WRITE (stdout,80) string, trim(vname(1,ifield)), &
6840 & trim(ncname)
6841 END IF
6842 exit_flag=4
6843 IF (founderror(exit_flag, nf90_noerr, &
6844 & __line__, myfile)) THEN
6845 RETURN
6846 END IF
6847 END IF
6848 END IF
6849!
6850! Read in 3D tracers open boundaries adjustments.
6851!
6852 DO itrc=1,nt(ng)
6853 IF (get_var(idsbry(istvar(itrc))).and.get_adjust.and. &
6854 & any(lobc(:,istvar(itrc),ng))) THEN
6855 ifield=idsbry(istvar(itrc))
6856 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
6857 & varid)
6858 IF (foundit) THEN
6859 status=nf_fread3d_bry(ng, idmod, ncname, ncinpid, &
6860 & vname(1,ifield), varid, &
6861 & inprec, r3dvar, &
6862 & lbij, ubij, 1, n(ng), nbrec(ng), &
6863 & fscl, fmin, fmax, &
6864# ifdef CHECKSUM
6865 & boundary(ng) % tl_t_obc(:,:,:,:, &
6866 & tindex,itrc), &
6867 & checksum = fhash)
6868# else
6869 & boundary(ng) % tl_t_obc(:,:,:,:, &
6870 & tindex,itrc))
6871# endif
6872 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6873 IF (master) THEN
6874 WRITE (stdout,60) string, trim(vname(1,ifield)), &
6875 & inprec, trim(ncname)
6876 END IF
6877 exit_flag=2
6878 ioerror=status
6879 RETURN
6880 ELSE
6881 IF (master) THEN
6882# ifdef CHECKSUM
6883 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
6884 & fhash
6885# else
6886 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
6887# endif
6888 END IF
6889 END IF
6890 ELSE
6891 IF (master) THEN
6892 WRITE (stdout,80) string, trim(vname(1,ifield)), &
6893 & trim(ncname)
6894 END IF
6895 exit_flag=4
6896 IF (founderror(exit_flag, nf90_noerr, &
6897 & __line__, myfile)) THEN
6898 RETURN
6899 END IF
6900 END IF
6901 END IF
6902 END DO
6903# endif
6904# endif
6905# ifdef ADJUST_WSTRESS
6906!
6907! Read in tangent linear surface U-momentum stress.
6908!
6909 IF (get_var(idusms).and.get_adjust) THEN
6910 foundit=find_string(var_name, n_var, trim(vname(1,idusms)), &
6911 & varid)
6912 IF (foundit) THEN
6913 gtype=var_flag(varid)*u3dvar
6914 scale=1.0_dp
6915 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
6916 & vname(1,idusms), varid, &
6917 & inprec, gtype, vsize, &
6918 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
6919 & scale, fmin, fmax, &
6920# ifdef MASKING
6921 & grid(ng) % umask, &
6922# endif
6923# ifdef CHECKSUM
6924 & forces(ng) % tl_ustr(:,:,:,tindex), &
6925 & checksum = fhash)
6926# else
6927 & forces(ng) % tl_ustr(:,:,:,tindex))
6928# endif
6929 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6930 IF (master) THEN
6931 WRITE (stdout,60) string, trim(vname(1,idusms)), &
6932 & inprec, trim(ncname)
6933 END IF
6934 exit_flag=2
6935 ioerror=status
6936 RETURN
6937 ELSE
6938 IF (master) THEN
6939# ifdef CHECKSUM
6940 WRITE (stdout,70) trim(vname(2,idusms))// &
6941 & ', adjusted tl_ustr', fmin, fmax, &
6942 & fhash
6943# else
6944 WRITE (stdout,70) trim(vname(2,idusms))// &
6945 & ', adjusted tl_ustr', fmin, fmax
6946# endif
6947 END IF
6948 END IF
6949 ELSE
6950 IF (master) THEN
6951 WRITE (stdout,80) string, trim(vname(1,idusms)), &
6952 & trim(ncname)
6953 END IF
6954 exit_flag=4
6955 IF (founderror(exit_flag, nf90_noerr, &
6956 & __line__, myfile)) THEN
6957 RETURN
6958 END IF
6959 END IF
6960 END IF
6961!
6962! Read in tangent linear surface V-momentum stress.
6963!
6964 IF (get_var(idvsms).and.get_adjust) THEN
6965 foundit=find_string(var_name, n_var, trim(vname(1,idvsms)), &
6966 & varid)
6967 IF (foundit) THEN
6968 gtype=var_flag(varid)*v3dvar
6969 scale=1.0_dp
6970 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
6971 & vname(1,idvsms), varid, &
6972 & inprec, gtype, vsize, &
6973 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
6974 & scale, fmin, fmax, &
6975# ifdef MASKING
6976 & grid(ng) % vmask, &
6977# endif
6978# ifdef CHECKSUM
6979 & forces(ng) % tl_vstr(:,:,:,tindex), &
6980 & checksum = fhash)
6981# else
6982 & forces(ng) % tl_vstr(:,:,:,tindex))
6983# endif
6984 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
6985 IF (master) THEN
6986 WRITE (stdout,60) string, trim(vname(1,idvsms)), &
6987 & inprec, trim(ncname)
6988 END IF
6989 exit_flag=2
6990 ioerror=status
6991 RETURN
6992 ELSE
6993 IF (master) THEN
6994# ifdef CHECKSUM
6995 WRITE (stdout,70) trim(vname(2,idvsms))// &
6996 & ', adjusted tl_vstr', fmin, fmax, &
6997 & fhash
6998# else
6999 WRITE (stdout,70) trim(vname(2,idvsms))// &
7000 & ', adjusted tl_vstr', fmin, fmax
7001# endif
7002 END IF
7003 END IF
7004 ELSE
7005 IF (master) THEN
7006 WRITE (stdout,80) string, trim(vname(1,idvsms)), &
7007 & trim(ncname)
7008 END IF
7009 exit_flag=4
7010 IF (founderror(exit_flag, nf90_noerr, &
7011 & __line__, myfile)) THEN
7012 RETURN
7013 END IF
7014 END IF
7015 END IF
7016# endif
7017# if defined ADJUST_STFLUX && defined SOLVE3D
7018!
7019! Read in tangent linear surface tracers flux.
7020!
7021 DO itrc=1,nt(ng)
7022 IF (get_var(idtsur(itrc)).and.get_adjust.and. &
7023 & lstflux(itrc,ng)) THEN
7024 foundit=find_string(var_name, n_var, &
7025 & trim(vname(1,idtsur(itrc))), varid)
7026 IF (foundit) THEN
7027 gtype=var_flag(varid)*r3dvar
7028 scale=1.0_dp
7029 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
7030 & vname(1,idtsur(itrc)), varid, &
7031 & inprec, gtype, vsize, &
7032 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
7033 & scale, fmin, fmax, &
7034# ifdef MASKING
7035 & grid(ng) % rmask, &
7036# endif
7037# ifdef CHECKSUM
7038 & forces(ng)% tl_tflux(:,:,:, &
7039 & tindex,itrc), &
7040 & checksum = fhash)
7041# else
7042 & forces(ng)% tl_tflux(:,:,:, &
7043 & tindex,itrc))
7044# endif
7045 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
7046 IF (master) THEN
7047 WRITE (stdout,60) string, trim(vname(1,idtsur(itrc))),&
7048 & inprec, trim(ncname)
7049 END IF
7050 exit_flag=2
7051 ioerror=status
7052 RETURN
7053 ELSE
7054 IF (master) THEN
7055# ifdef CHECKSUM
7056 WRITE (stdout,70) trim(vname(2,idtsur(itrc)))// &
7057 & ', adjusted tl_tflux', fmin, fmax, &
7058 & fhash
7059# else
7060 WRITE (stdout,70) trim(vname(2,idtsur(itrc)))// &
7061 & ', adjusted tl_tflux', fmin, fmax
7062# endif
7063 END IF
7064 END IF
7065 ELSE
7066 IF (master) THEN
7067 WRITE (stdout,80) string, trim(vname(1,idtsur(itrc))), &
7068 & trim(ncname)
7069 END IF
7070 exit_flag=4
7071 IF (founderror(exit_flag, nf90_noerr, &
7072 & __line__, myfile)) THEN
7073 RETURN
7074 END IF
7075 END IF
7076 END IF
7077 END DO
7078# endif
7079 END IF tlm_forcing
7080#endif
7081!
7082#if defined TIME_CONV
7083!
7084!-----------------------------------------------------------------------
7085! Read in tangent linear model error forcing terms used in the time
7086! convolutions.
7087!-----------------------------------------------------------------------
7088!
7089 tcs_state: IF (model.eq.6) THEN
7090!
7091! Set number of records available.
7092!
7093 nrecfrc(ng)=nrec
7094!
7095! Read in next impulse forcing time to process.
7096!
7097 CALL netcdf_get_time (ng, idmod, ncname, trim(tvarnam), &
7098 & rclock%DateNumber, forcetime(ng:), &
7099 & ncid = ncinpid, &
7100 & start = (/inprec/), &
7101 & total = (/1/))
7102 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7103!
7104! Read in free-surface forcing.
7105!
7106 IF (get_var(idfsur)) THEN
7107 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
7108 & varid)
7109 IF (foundit) THEN
7110 gtype=var_flag(varid)*r2dvar
7111 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
7112 & vname(1,idfsur), varid, &
7113 & inprec, gtype, vsize, &
7114 & lbi, ubi, lbj, ubj, &
7115 & fscl, fmin, fmax, &
7116# ifdef MASKING
7117 & grid(ng) % rmask, &
7118# endif
7119# ifdef CHECKSUM
7120 & ocean(ng) % tl_zeta(:,:,tindex), &
7121 & checksum = fhash)
7122# else
7123 & ocean(ng) % tl_zeta(:,:,tindex))
7124# endif
7125 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
7126 IF (master) THEN
7127 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
7128 & inprec, trim(ncname)
7129 END IF
7130 exit_flag=2
7131 ioerror=status
7132 RETURN
7133 ELSE
7134 IF (master) THEN
7135# ifdef CHECKSUM
7136 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
7137 & fhash
7138# else
7139 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
7140# endif
7141
7142 END IF
7143 END IF
7144 ELSE
7145 IF (master) THEN
7146 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
7147 & trim(ncname)
7148 END IF
7149 exit_flag=4
7150 IF (founderror(exit_flag, nf90_noerr, &
7151 & __line__, myfile)) THEN
7152 RETURN
7153 END IF
7154 END IF
7155 END IF
7156
7157# ifndef SOLVE3D
7158!
7159! Read in 2D momentum forcing in the XI-direction.
7160!
7161 IF (get_var(idubar)) THEN
7162 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
7163 & varid)
7164 IF (foundit) THEN
7165 gtype=var_flag(varid)*u2dvar
7166 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
7167 & vname(1,idubar), varid, &
7168 & inprec, gtype, vsize, &
7169 & lbi, ubi, lbj, ubj, &
7170 & fscl, fmin, fmax, &
7171# ifdef MASKING
7172 & grid(ng) % umask, &
7173# endif
7174# ifdef CHECKSUM
7175 & ocean(ng) % tl_ubar(:,:,tindex), &
7176 & checksum = fhash)
7177# else
7178 & ocean(ng) % tl_ubar(:,:,tindex))
7179# endif
7180 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
7181 IF (master) THEN
7182 WRITE (stdout,60) string, trim(vname(1,idubar)), &
7183 & inprec, trim(ncname)
7184 END IF
7185 exit_flag=2
7186 ioerror=status
7187 RETURN
7188 ELSE
7189 IF (master) THEN
7190# ifdef CHECKSUM
7191 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
7192 & fhash
7193# else
7194 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
7195# endif
7196 END IF
7197 END IF
7198 ELSE
7199 IF (master) THEN
7200 WRITE (stdout,80) string, trim(vname(1,idubar)), &
7201 & trim(ncname)
7202 END IF
7203 exit_flag=4
7204 IF (founderror(exit_flag, nf90_noerr, &
7205 & __line__, myfile)) THEN
7206 RETURN
7207 END IF
7208 END IF
7209 END IF
7210!
7211! Read in 2D momentum forcing in the ETA-direction.
7212!
7213 IF (get_var(idvbar)) THEN
7214 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
7215 & varid)
7216 IF (foundit) THEN
7217 gtype=var_flag(varid)*v2dvar
7218 status=nf_fread2d(ng, idmod, ncname, ncinpid, &
7219 & vname(1,idvbar), varid, &
7220 & inprec, gtype, vsize, &
7221 & lbi, ubi, lbj, ubj, &
7222 & fscl, fmin, fmax, &
7223# ifdef MASKING
7224 & grid(ng) % vmask, &
7225# endif
7226# ifdef CHECKSUM
7227 & ocean(ng) % tl_vbar(:,:,tindex), &
7228 & checksum = fhash)
7229# else
7230 & ocean(ng) % tl_vbar(:,:,tindex))
7231# endif
7232 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
7233 IF (master) THEN
7234 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
7235 & inprec, trim(ncname)
7236 END IF
7237 exit_flag=2
7238 ioerror=status
7239 RETURN
7240 ELSE
7241 IF (master) THEN
7242# ifdef CHECKSUM
7243 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
7244 & fhash
7245# else
7246 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
7247# endif
7248 END IF
7249 END IF
7250 ELSE
7251 IF (master) THEN
7252 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
7253 & trim(ncname)
7254 END IF
7255 exit_flag=4
7256 IF (founderror(exit_flag, nf90_noerr, &
7257 & __line__, myfile)) THEN
7258 RETURN
7259 END IF
7260 END IF
7261 END IF
7262# endif
7263# ifdef SOLVE3D
7264!
7265! Read in 3D momentum forcing in the XI-direction.
7266!
7267 IF (get_var(iduvel)) THEN
7268 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
7269 & varid)
7270 IF (foundit) THEN
7271 gtype=var_flag(varid)*u3dvar
7272 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
7273 & vname(1,iduvel), varid, &
7274 & inprec, gtype, vsize, &
7275 & lbi, ubi, lbj, ubj, 1, n(ng), &
7276 & fscl, fmin, fmax, &
7277# ifdef MASKING
7278 & grid(ng) % umask, &
7279# endif
7280# ifdef CHECKSUM
7281 & ocean(ng) % tl_u(:,:,:,tindex), &
7282 & checksum = fhash)
7283# else
7284 & ocean(ng) % tl_u(:,:,:,tindex))
7285# endif
7286 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
7287 IF (master) THEN
7288 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
7289 & inprec, trim(ncname)
7290 END IF
7291 exit_flag=2
7292 ioerror=status
7293 RETURN
7294 ELSE
7295 IF (master) THEN
7296# ifdef CHECKSUM
7297 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
7298 & fhash
7299# else
7300 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
7301# endif
7302 END IF
7303 END IF
7304 ELSE
7305 IF (master) THEN
7306 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
7307 & trim(ncname)
7308 END IF
7309 exit_flag=4
7310 IF (founderror(exit_flag, nf90_noerr, &
7311 & __line__, myfile)) THEN
7312 RETURN
7313 END IF
7314 END IF
7315 END IF
7316!
7317! Read in 3D momentum forcing in the ETA-direction.
7318!
7319 IF (get_var(idvvel)) THEN
7320 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
7321 & varid)
7322 IF (foundit) THEN
7323 gtype=var_flag(varid)*v3dvar
7324 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
7325 & vname(1,idvvel), varid, &
7326 & inprec, gtype, vsize, &
7327 & lbi, ubi, lbj, ubj, 1, n(ng), &
7328 & fscl, fmin, fmax, &
7329# ifdef MASKING
7330 & grid(ng) % vmask, &
7331# endif
7332# ifdef CHECKSUM
7333 & ocean(ng) % tl_v(:,:,:,tindex), &
7334 & checksum = fhash)
7335# else
7336 & ocean(ng) % tl_v(:,:,:,tindex))
7337# endif
7338 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
7339 IF (master) THEN
7340 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
7341 & inprec, trim(ncname)
7342 END IF
7343 exit_flag=2
7344 ioerror=status
7345 RETURN
7346 ELSE
7347 IF (master) THEN
7348# ifdef CHECKSUM
7349 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
7350 & fhash
7351# else
7352 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
7353# endif
7354 END IF
7355 END IF
7356 ELSE
7357 IF (master) THEN
7358 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
7359 & trim(ncname)
7360 END IF
7361 exit_flag=4
7362 IF (founderror(exit_flag, nf90_noerr, &
7363 & __line__, myfile)) THEN
7364 RETURN
7365 END IF
7366 END IF
7367 END IF
7368!
7369! Read in tracer type variables.
7370!
7371 DO itrc=1,nt(ng)
7372 IF (get_var(idtvar(itrc))) THEN
7373 foundit=find_string(var_name, n_var, &
7374 & trim(vname(1,idtvar(itrc))), varid)
7375 IF (foundit) THEN
7376 gtype=var_flag(varid)*r3dvar
7377 status=nf_fread3d(ng, idmod, ncname, ncinpid, &
7378 & vname(1,idtvar(itrc)), varid, &
7379 & inprec, gtype, vsize, &
7380 & lbi, ubi, lbj, ubj, 1, n(ng), &
7381 & fscl, fmin, fmax, &
7382# ifdef MASKING
7383 & grid(ng) % rmask, &
7384# endif
7385# ifdef CHECKSUM
7386 & ocean(ng) % tl_t(:,:,:,tindex,itrc), &
7387 & checksum = fhash)
7388# else
7389 & ocean(ng) % tl_t(:,:,:,tindex,itrc))
7390# endif
7391 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
7392 IF (master) THEN
7393 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
7394 & inprec, trim(ncname)
7395 END IF
7396 exit_flag=2
7397 ioerror=status
7398 RETURN
7399 ELSE
7400 IF (master) THEN
7401# ifdef CHECKSUM
7402 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
7403 & fmin, fmax, fhash
7404# else
7405 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
7406 & fmin, fmax
7407# endif
7408 END IF
7409 END IF
7410 ELSE
7411 IF (master) THEN
7412 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
7413 & trim(ncname)
7414 END IF
7415 exit_flag=4
7416 IF (founderror(exit_flag, nf90_noerr, &
7417 & __line__, myfile)) THEN
7418 RETURN
7419 END IF
7420 END IF
7421 END IF
7422 END DO
7423# endif
7424 END IF tcs_state
7425#endif
7426!
7427!-----------------------------------------------------------------------
7428! Close input NetCDF file.
7429!-----------------------------------------------------------------------
7430!
7431 CALL netcdf_close (ng, idmod, ncinpid, ncname, .false.)
7432
7433#ifdef PROFILE
7434!
7435! Turn off time wall clock.
7436!
7437 CALL wclock_off (ng, idmod, 80, __line__, myfile)
7438#endif
7439!
7440 10 FORMAT (/,2x,'GET_STATE_NF90 - ',a,'unable to open input NetCDF', &
7441 & ' file: ',a)
7442 20 FORMAT (/,2x,'GET_STATE_NF90 - ',a,'Warning - NetCDF global', &
7443 & ' attribute:',a, &
7444 & /,19x,'for lateral boundary conditions not checked', &
7445 & /,19x,'in file: ',a)
7446 30 FORMAT (/,2x,'GET_STATE_NF90 - ',a,'requested input time', &
7447 & ' record = ',i0,/,19x,'not found in input NetCDF: ',a,/, &
7448 & 19x,'number of available records = ',i0)
7449 40 FORMAT (/,2x,'GET_STATE_NF90 - ',a,a,t75,a, &
7450 & /,22x,'(Grid ',i2.2,a,i4.4, ', t = ',a, &
7451 & ', File: ',a, ', Rec=',i4.4,', Index=',i1,')')
7452 50 FORMAT (/,2x,'GET_STATE_NF90 - ',a,a,t75,a, &
7453 & /,22x,'(Grid ',i2.2, ', t = ',a, &
7454 & ', File: ',a,', Rec=',i4.4, ', Index=',i1,')')
7455 60 FORMAT (/,2x,'GET_STATE_NF90 - ',a,'error while reading', &
7456 & ' variable: ',a,2x,'at time record = ',i0, &
7457 & /,19x,'in input NetCDF file: ',a)
7458#ifdef CHECKSUM
7459 70 FORMAT (19x,'- ',a,/,22x,'(Min = ',1p,e15.8, &
7460 & ' Max = ',1p,e15.8,' CheckSum = ',i0,')')
7461#else
7462 70 FORMAT (19x,'- ',a,/,22x,'(Min = ',1p,e15.8, &
7463 & ' Max = ',1p,e15.8,')')
7464#endif
7465 75 FORMAT (19x,'- ',a,/,22x,'(Min = ',1p,e15.8, &
7466 & ' Max = ',1p,e15.8,')')
7467 80 FORMAT (/,2x,'GET_STATE_NF90 - ',a,'cannot find variable: ',a, &
7468 & /,19x,'in input NetCDF file: ',a)
7469!
7470 RETURN
7471 END SUBROUTINE get_state_nf90
7472
7473#if defined PIO_LIB && defined DISTRIBUTE
7474!
7475!***********************************************************************
7476 SUBROUTINE get_state_pio (ng, model, msg, S, IniRec, Tindex, &
7477# ifdef ADJUST_BOUNDARY
7478 & IorJ, LBij, UBij, &
7479# endif
7480 & LBi, UBi, LBj, UBj)
7481
7482!***********************************************************************
7483!
7484 USE mod_pio_netcdf
7485!
7486! Imported variable declarations.
7487!
7488 integer, intent(in) :: ng, model, msg, tindex
7489# ifdef ADJUST_BOUNDARY
7490 integer, intent(in) :: iorj, lbij, ubij
7491# endif
7492 integer, intent(in) :: lbi, ubi, lbj, ubj
7493
7494 integer, intent(inout) :: inirec
7495!
7496 TYPE(t_io), intent(inout) :: s
7497!
7498! Local variable declarations.
7499!
7500 logical :: perfect2d, perfect3d, foundit
7501# if defined ADJUST_BOUNDARY || \
7502 defined adjust_wstress || defined adjust_stflux
7503 logical :: get_adjust
7504# endif
7505 logical, dimension(NV) :: get_var, have_var
7506!
7507 integer :: idmod, inprec, i, ifield, itrc, lstr, lend
7508 integer :: nrec, mysize, nvatts, nvdim, status, vindex
7509 integer :: vsize(4), start(4), total(4)
7510 integer(i8b) :: fhash
7511!
7512 real(dp), parameter :: fscl = 1.0_r8
7513
7514 real(dp) :: inptime, tmax, my_dstart, scale, time_scale
7515 real(r8) :: fmax, fmin
7516
7517 real(dp), allocatable :: timevar(:)
7518!
7519 character (len= 5) :: string
7520 character (len= 15) :: tstring, attnam, tvarnam
7521 character (len= 22) :: t_code
7522 character (len= 40) :: tunits
7523 character (len=256) :: ncname
7524
7525 character (len=*), parameter :: myfile = &
7526 & __FILE__//", get_state_pio"
7527!
7528 TYPE (io_desc_t), pointer :: iodesc
7529
7530 TYPE (file_desc_t) :: piofile
7531 TYPE (var_desc_t) :: piovar
7532 TYPE (my_vardesc) :: my_piovar
7533!
7534 sourcefile=myfile
7535!
7536!-----------------------------------------------------------------------
7537! Determine variables to read and their availability.
7538!-----------------------------------------------------------------------
7539!
7540 ncname=trim(s%name)
7541!
7542! Set model identification string.
7543!
7544 IF (model.eq.inlm.or.(model.eq.0)) THEN
7545 string='NLM: ' ! nonlinear model, restart
7546 idmod=inlm
7547 ELSE IF (model.eq.itlm) THEN
7548 string='TLM: ' ! tangent linear model
7549 idmod=itlm
7550 ELSE IF (model.eq.irpm) THEN
7551 string='RPM: ' ! representer model
7552 idmod=irpm
7553 ELSE IF (model.eq.iadm) THEN
7554 string='ADM: ' ! adjoint model
7555 idmod=iadm
7556 ELSE IF (model.eq.5) THEN
7557 string='NLM: ' ! surface forcing and
7558 idmod=inlm ! OBC increments
7559 ELSE IF (model.eq.6) THEN
7560 string='TLM: ' ! tangent linear error
7561 idmod=itlm ! forcing (time covariance)
7562 ELSE IF (model.eq.7) THEN
7563 string='FRC: ' ! impulse forcing
7564 idmod=inlm
7565 ELSE IF (model.eq.8) THEN
7566 string='TLM: ' ! v-space increments
7567 idmod=itlm ! I4D-Var
7568 ELSE IF (model.eq.9) THEN
7569 string='NLM: ' ! nonlinear model
7570 idmod=inlm ! background state
7571 ELSE IF (model.eq.10) THEN
7572 string='STD: ' ! standard deviation
7573 idmod=inlm ! initial conditions
7574 ELSE IF (model.eq.11) THEN
7575 string='STD: ' ! standard deviation
7576 idmod=inlm ! model error
7577 ELSE IF (model.eq.12) THEN
7578 string='STD: ' ! standard deviation
7579 idmod=inlm ! boundary conditions
7580 ELSE IF (model.eq.13) THEN
7581 string='STD: ' ! standard deviation
7582 idmod=inlm ! surface forcing
7583 ELSE IF (model.eq.14) THEN
7584 string='NRM: ' ! normalization factors
7585 idmod=inlm ! initial conditions
7586 ELSE IF (model.eq.15) THEN
7587 string='NRM: ' ! normalization factors
7588 idmod=inlm ! model error
7589 ELSE IF (model.eq.16) THEN
7590 string='NRM: ' ! normalization factor
7591 idmod=inlm ! boundary conditions
7592 ELSE IF (model.eq.17) THEN
7593 string='NRM: ' ! normalization factor
7594 idmod=inlm ! surface forcing
7595 END IF
7596
7597# ifdef PROFILE
7598!
7599! Turn on time wall clock.
7600!
7601 CALL wclock_on (ng, idmod, 80, __line__, myfile)
7602# endif
7603!
7604! Set switch to process variables for nonlinear model perfect restart.
7605!
7606 perfect2d=.false.
7607 perfect3d=.false.
7608# ifdef PERFECT_RESTART
7609 IF (((model.eq.0).or.(model.eq.inlm)).and.(nrrec(ng).ne.0)) THEN
7610 perfect2d=.true.
7611 perfect3d=.true.
7612 END IF
7613# endif
7614 perfectrst(ng)=perfect2d.or.perfect3d
7615!
7616! Set Vsize to zero to deactivate interpolation of input data to model
7617! grid in "nf_fread2d" and "nf_fread3d".
7618!
7619 DO i=1,4
7620 vsize(i)=0
7621 END DO
7622!
7623!-----------------------------------------------------------------------
7624! Open input NetCDF file and check time variable.
7625!-----------------------------------------------------------------------
7626!
7627! Open input NetCDF file.
7628!
7629 CALL pio_netcdf_open (ng, idmod, ncname, 0, piofile)
7630 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
7631 IF (master) WRITE (stdout,10) string, trim(ncname)
7632 RETURN
7633 END IF
7634!
7635! Determine variables to read.
7636!
7637 CALL checkvars (ng, model, ncname, piofile, string, nrec, nv, &
7638 & tvarnam, get_var, have_var)
7639 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7640 sourcefile=myfile
7641
7642# if defined DEBUGGING || defined NO_LBC_ATT
7643!
7644! Lateral boundary conditions attribute not checked in restart file.
7645!
7646 IF (((model.eq.0).or.(model.eq.inlm)).and.(nrrec(ng).ne.0)) THEN
7647 IF (master) WRITE (stdout,20) string, 'NLM_LBC', trim(ncname)
7648 END IF
7649# else
7650!
7651! If restart, read in lateral boundary conditions global attribute
7652! from restart file and check keyword strings with structure vlues
7653! for consistency.
7654!
7655 IF (((model.eq.0).or.(model.eq.inlm)).and.(nrrec(ng).ne.0)) THEN
7656 CALL lbc_getatt (ng, model, piofile, ncname, 'NLM_LBC', lbc)
7657 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7658 END IF
7659# endif
7660!
7661! Inquire about the input time variable.
7662!
7663 CALL pio_netcdf_inq_var (ng, idmod, ncname, &
7664 & piofile = piofile, &
7665 & myvarname = trim(tvarnam), &
7666 & piovar = piovar, &
7667 & nvardim = nvdim, &
7668 & nvaratt = nvatts)
7669 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7670!
7671! Allocate input time variable and read its value(s). Recall that
7672! input time variable is a one-dimensional array with one or several
7673! values.
7674!
7675 mysize=var_dsize(1)
7676 IF (.not.allocated(timevar)) allocate (timevar(mysize))
7677 CALL pio_netcdf_get_time (ng, idmod, ncname, trim(tvarnam), &
7678 & rclock%DateNumber, timevar, &
7679 & piofile = piofile)
7680 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7681!
7682! If using the latest time record from input NetCDF file as the
7683! initialization record, assign input time.
7684!
7685 IF (lastrec(ng)) THEN
7686 tmax=-1.0_r8
7687 DO i=1,mysize
7688 IF (timevar(i).gt.tmax) THEN
7689 tmax=timevar(i)
7690 inirec=i
7691 END IF
7692 END DO
7693 inptime=tmax
7694 inprec=inirec
7695 ELSE
7696 IF ((inirec.ne.0).and.(inirec.gt.mysize)) THEN
7697 IF (master) WRITE (stdout,30) string, inirec, trim(ncname), &
7698 & mysize
7699 exit_flag=2
7700 RETURN
7701 END IF
7702 IF (inirec.ne.0) THEN
7703 inprec=inirec
7704 ELSE
7705 inprec=1
7706 END IF
7707 inptime=timevar(inprec)
7708 END IF
7709 IF (allocated(timevar)) deallocate ( timevar )
7710!
7711! Set input time scale by looking at the "units" attribute.
7712!
7713 time_scale=0.0_dp
7714 DO i=1,nvatts
7715 IF (trim(var_aname(i)).eq.'units') THEN
7716 IF (index(trim(var_achar(i)),'day').ne.0) THEN
7717 time_scale=day2sec
7718 ELSE IF (index(trim(var_achar(i)),'second').ne.0) THEN
7719 time_scale=1.0_dp
7720 END IF
7721 END IF
7722 END DO
7723 IF (time_scale.gt.0.0_r8) THEN
7724 inptime=inptime*time_scale
7725 END IF
7726!
7727! Set starting time index and time clock in days. Notice that the
7728! global time variables and indices are only over-written when
7729! processing initial conditions (msg = 1).
7730!
7731 IF ((model.eq.0).or.(model.eq.inlm).or. &
7732 & (model.eq.itlm).or.(model.eq.irpm)) THEN
7733# ifdef GENERIC_DSTART
7734 IF (initime(ng).lt.0.0_dp) THEN
7735 my_dstart=dstart ! ROMS input script
7736 ELSE
7737 my_dstart=initime(ng)/86400.0_dp ! NLM IC time is known
7738 END IF
7739 IF (((model.eq.itlm).or.(model.eq.irpm)).and.(msg.eq.1).and. &
7740 & (inptime.ne.(my_dstart*day2sec))) THEN
7741 inptime=my_dstart*day2sec
7742 END IF
7743# else
7744 IF (((model.eq.itlm).or.(model.eq.irpm)).and.(msg.eq.1).and. &
7745 & (inptime.ne.(dstart*day2sec))) THEN
7746 inptime=dstart*day2sec
7747 END IF
7748# endif
7749 IF (msg.eq.1) THEN ! processing initial conditions
7750 time(ng)=inptime
7751 tdays(ng)=time(ng)*sec2day
7752 ntstart(ng)=nint((time(ng)-dstart*day2sec)/dt(ng))+1
7753 IF (ntstart(ng).lt.1) ntstart(ng)=1
7754 ntend(ng)=ntstart(ng)+ntimes(ng)-1
7755 IF (perfectrst(ng)) THEN
7756 ntfirst(ng)=1
7757 ELSE
7758 ntfirst(ng)=ntstart(ng)
7759 END IF
7760 END IF
7761# ifdef WEAK_CONSTRAINT
7762 IF (msg.eq.4) THEN
7763 forcetime(ng)=time(ng)
7764 END IF
7765# endif
7766 ELSE IF (model.eq.iadm) THEN
7767 IF ((msg.eq.1).and.(inptime.eq.0.0_r8)) THEN
7768 inptime=time(ng)
7769 ELSE IF (msg.ne.1) THEN
7770 time(ng)=inptime
7771 tdays(ng)=time(ng)*sec2day
7772 END IF
7773 ntstart(ng)=ntimes(ng)+1
7774 ntend(ng)=1
7775 ntfirst(ng)=ntend(ng)
7776 END IF
7777 CALL time_string (time(ng), time_code(ng))
7778!
7779! Over-write "IniRec" to the actual initial record processed.
7780!
7781 IF (model.eq.inlm) THEN
7782 inirec=inprec
7783 END IF
7784!
7785! Set current input time, io_time . Notice that the model time,
7786! time(ng), is reset above. This is a THREADPRIVATE variable in
7787! shared-memory and this routine is only processed by the MASTER
7788! thread since it is an I/O routine. Therefore, we need to update
7789! time(ng) somewhere else in a parallel region. This will be done
7790! with io_time variable.
7791!
7792 io_time=inptime
7793!
7794! Report information.
7795!
7796 lstr=scan(ncname,'/',back=.true.)+1
7797 lend=len_trim(ncname)
7798 IF (master) THEN
7799 IF ((10.le.model).and.(model.le.17)) THEN
7800 t_code=' ' ! time is meaningless for these fields
7801 ELSE
7802 CALL time_string (inptime, t_code)
7803 END IF
7804 WRITE (tstring,'(f15.4)') tdays(ng)
7805# if defined I4DVAR || defined I4DVAR_ANA_SENSITIVITY || \
7806 defined weak_constraint
7807 WRITE (stdout,40) string, trim(statemsg(msg)), &
7808 & t_code, ng, ', Outer=', outer, &
7809 & trim(adjustl(tstring)), ncname(lstr:lend), &
7810 & inprec, tindex
7811# else
7812 IF (erend.gt.erstr) THEN
7813 WRITE (stdout,40) string, trim(statemsg(msg)), &
7814 & t_code, ng, ', Iter=', nrun, &
7815 & trim(adjustl(tstring)), ncname(lstr:lend), &
7816 & inprec, tindex
7817 ELSE
7818 WRITE (stdout,50) string, trim(statemsg(msg)), &
7819 & t_code, ng, trim(adjustl(tstring)), &
7820 & ncname(lstr:lend), inprec, tindex
7821 END IF
7822# endif
7823 END IF
7824
7825# ifdef NONLINEAR
7826!
7827!-----------------------------------------------------------------------
7828! Read in nonlinear state variables. If applicable, read in perfect
7829! restart variables.
7830!-----------------------------------------------------------------------
7831!
7832 nlm_state: IF ((model.eq.inlm).or.(model.eq.0)) THEN
7833
7834# ifdef PERFECT_RESTART
7835!
7836! Read in time-stepping indices.
7837!
7838 IF ((model.eq.0).and.(nrrec(ng).ne.0)) THEN
7839# ifdef SOLVE3D
7840 CALL pio_netcdf_get_ivar (ng, idmod, ncname, &
7841 & 'nstp', nstp(ng:), &
7842 & piofile = piofile, &
7843 & start = (/inprec/), &
7844 & total = (/1/))
7845 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7846
7847 CALL pio_netcdf_get_ivar (ng, idmod, ncname, &
7848 & 'nrhs', nrhs(ng:), &
7849 & piofile = piofile, &
7850 & start = (/inprec/), &
7851 & total = (/1/))
7852 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7853
7854 CALL pio_netcdf_get_ivar (ng, idmod, ncname, &
7855 & 'nnew', nnew(ng:), &
7856 & piofile = piofile, &
7857 & start = (/inprec/), &
7858 & total = (/1/))
7859 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7860# endif
7861 CALL pio_netcdf_get_ivar (ng, idmod, ncname, &
7862 & 'kstp', kstp(ng:), &
7863 & piofile = piofile, &
7864 & start = (/inprec/), &
7865 & total = (/1/))
7866 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7867
7868 CALL pio_netcdf_get_ivar (ng, idmod, ncname, &
7869 & 'krhs', krhs(ng:), &
7870 & piofile = piofile, &
7871 & start = (/inprec/), &
7872 & total = (/1/))
7873 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7874
7875 CALL pio_netcdf_get_ivar (ng, idmod, ncname, &
7876 & 'knew', knew(ng:), &
7877 & piofile = piofile, &
7878 & start = (/inprec/), &
7879 & total = (/1/))
7880 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7881 END IF
7882# endif
7883# if defined SEDIMENT && defined SED_MORPH
7884!
7885! Read in time-evolving bathymetry (m).
7886!
7887 IF (get_var(idbath)) THEN
7888 foundit=find_string(var_name, n_var, trim(vname(1,idbath)), &
7889 & vindex)
7890 IF (foundit) THEN
7891 my_piovar%vd=var_desc(vindex)
7892 my_piovar%gtype=r2dvar
7893 IF (kind(grid(ng)%h).eq.8) THEN
7894 my_piovar%dkind=pio_double
7895 iodesc => iodesc_dp_r2dvar(ng)
7896 ELSE
7897 my_piovar%dkind=pio_real
7898 iodesc => iodesc_sp_r2dvar(ng)
7899 END IF
7900!
7901 status=nf_fread2d(ng, idmod, ncname, piofile, &
7902 & vname(1,idbath), my_piovar, &
7903 & inprec, iodesc, vsize, &
7904 & lbi, ubi, lbj, ubj, &
7905 & fscl, fmin, fmax, &
7906# ifdef MASKING
7907 & grid(ng) % rmask, &
7908# endif
7909# ifdef CHECKSUM
7910 & grid(ng) % h, &
7911 & checksum = fhash)
7912# else
7913 & grid(ng) % h)
7914# endif
7915 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7916 IF (master) THEN
7917 WRITE (stdout,60) string, trim(vname(1,idbath)), &
7918 & inprec, trim(ncname)
7919 END IF
7920 exit_flag=2
7921 ioerror=status
7922 RETURN
7923 ELSE
7924 IF (master) THEN
7925# ifdef CHECKSUM
7926 WRITE (stdout,70) trim(vname(2,idbath)), fmin, fmax, &
7927 & fhash
7928# else
7929 WRITE (stdout,70) trim(vname(2,idbath)), fmin, fmax
7930# endif
7931
7932 END IF
7933 END IF
7934 ELSE
7935 IF (master) THEN
7936 WRITE (stdout,80) string, trim(vname(1,idbath)), &
7937 & trim(ncname)
7938 END IF
7939 exit_flag=4
7940 IF (founderror(exit_flag, pio_noerr, &
7941 & __line__, myfile)) THEN
7942 RETURN
7943 END IF
7944 END IF
7945 END IF
7946# endif
7947!
7948! Read in nonlinear free-surface (m).
7949!
7950 IF (get_var(idfsur)) THEN
7951 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
7952 & vindex)
7953 IF (foundit) THEN
7954 my_piovar%vd=var_desc(vindex)
7955 my_piovar%gtype=r2dvar
7956 IF (perfect2d) THEN
7957 IF (kind(ocean(ng)%zeta).eq.8) THEN
7958 my_piovar%dkind=pio_double
7959 iodesc => iodesc_dp_rzeta(ng)
7960 ELSE
7961 my_piovar%dkind=pio_real
7962 iodesc => iodesc_sp_rzeta(ng)
7963 END IF
7964!
7965 status=nf_fread3d(ng, idmod, ncname, piofile, &
7966 & vname(1,idfsur), my_piovar, &
7967 & inprec, iodesc, vsize, &
7968 & lbi, ubi, lbj, ubj, 1, 3, &
7969 & fscl, fmin, fmax, &
7970# ifdef MASKING
7971 & grid(ng) % rmask, &
7972# endif
7973# ifdef CHECKSUM
7974 & ocean(ng) % zeta, &
7975 & checksum = fhash)
7976# else
7977 & ocean(ng) % zeta)
7978# endif
7979 ELSE
7980 IF (kind(ocean(ng)%zeta).eq.8) THEN
7981 my_piovar%dkind=pio_double
7982 iodesc => iodesc_dp_r2dvar(ng)
7983 ELSE
7984 my_piovar%dkind=pio_real
7985 iodesc => iodesc_sp_r2dvar(ng)
7986 END IF
7987!
7988 status=nf_fread2d(ng, idmod, ncname, piofile, &
7989 & vname(1,idfsur), my_piovar, &
7990 & inprec, iodesc, vsize, &
7991 & lbi, ubi, lbj, ubj, &
7992 & fscl, fmin, fmax, &
7993# ifdef MASKING
7994 & grid(ng) % rmask, &
7995# endif
7996# ifdef CHECKSUM
7997 & ocean(ng) % zeta(:,:,tindex), &
7998 & checksum = fhash)
7999# else
8000 & ocean(ng) % zeta(:,:,tindex))
8001# endif
8002 END IF
8003 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8004 IF (master) THEN
8005 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
8006 & inprec, trim(ncname)
8007 END IF
8008 exit_flag=2
8009 ioerror=status
8010 RETURN
8011 ELSE
8012 IF (master) THEN
8013# ifdef CHECKSUM
8014 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
8015 & fhash
8016# else
8017 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
8018# endif
8019
8020 END IF
8021 END IF
8022 ELSE
8023 IF (master) THEN
8024 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
8025 & trim(ncname)
8026 END IF
8027 exit_flag=4
8028 IF (founderror(exit_flag, pio_noerr, &
8029 & __line__, myfile)) THEN
8030 RETURN
8031 END IF
8032 END IF
8033 END IF
8034!
8035! Read in nonlinear RHS of free-surface.
8036!
8037 IF (get_var(idrzet).and.perfect2d) THEN
8038 foundit=find_string(var_name, n_var, trim(vname(1,idrzet)), &
8039 & vindex)
8040 IF (foundit) THEN
8041 my_piovar%vd=var_desc(vindex)
8042 my_piovar%gtype=r2dvar
8043 IF (kind(ocean(ng)%rzeta).eq.8) THEN
8044 my_piovar%dkind=pio_double
8045 iodesc => iodesc_dp_rzeta(ng)
8046 ELSE
8047 my_piovar%dkind=pio_real
8048 iodesc => iodesc_sp_rzeta(ng)
8049 END IF
8050!
8051 status=nf_fread3d(ng, idmod, ncname, piofile, &
8052 & vname(1,idrzet), my_piovar, &
8053 & inprec, iodesc, vsize, &
8054 & lbi, ubi, lbj, ubj, 1, 2, &
8055 & fscl, fmin, fmax, &
8056# ifdef MASKING
8057 & grid(ng) % rmask, &
8058# endif
8059# ifdef CHECKSUM
8060 & ocean(ng) % rzeta, &
8061 & checksum = fhash)
8062# else
8063 & ocean(ng) % rzeta)
8064# endif
8065 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8066 IF (master) THEN
8067 WRITE (stdout,60) string, trim(vname(1,idrzet)), &
8068 & inprec, trim(ncname)
8069 END IF
8070 exit_flag=2
8071 ioerror=status
8072 RETURN
8073 ELSE
8074 IF (master) THEN
8075# ifdef CHECKSUM
8076 WRITE (stdout,70) trim(vname(2,idrzet)), fmin, fmax, &
8077 & fhash
8078# else
8079 WRITE (stdout,70) trim(vname(2,idrzet)), fmin, fmax
8080# endif
8081
8082 END IF
8083 END IF
8084 ELSE
8085 IF (master) THEN
8086 WRITE (stdout,80) string, trim(vname(1,idrzet)), &
8087 & trim(ncname)
8088 END IF
8089 exit_flag=4
8090 IF (founderror(exit_flag, pio_noerr, &
8091 & __line__, myfile)) THEN
8092 RETURN
8093 END IF
8094 END IF
8095 END IF
8096!
8097! Read in nonlinear 2D U-momentum component (m/s).
8098!
8099 IF (get_var(idubar)) THEN
8100 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
8101 & vindex)
8102 IF (foundit) THEN
8103 my_piovar%vd=var_desc(vindex)
8104 my_piovar%gtype=u2dvar
8105 IF (perfect2d) THEN
8106 IF (kind(ocean(ng)%ubar).eq.8) THEN
8107 my_piovar%dkind=pio_double
8108 iodesc => iodesc_dp_ubar(ng)
8109 ELSE
8110 my_piovar%dkind=pio_real
8111 iodesc => iodesc_sp_ubar(ng)
8112 END IF
8113!
8114 status=nf_fread3d(ng, idmod, ncname, piofile, &
8115 & vname(1,idubar), my_piovar, &
8116 & inprec, iodesc, vsize, &
8117 & lbi, ubi, lbj, ubj, 1, 3, &
8118 & fscl, fmin, fmax, &
8119# ifdef MASKING
8120 & grid(ng) % umask, &
8121# endif
8122# ifdef CHECKSUM
8123 & ocean(ng) % ubar, &
8124 & checksum = fhash)
8125# else
8126 & ocean(ng) % ubar)
8127# endif
8128 ELSE
8129 IF (kind(ocean(ng)%ubar).eq.8) THEN
8130 my_piovar%dkind=pio_double
8131 iodesc => iodesc_dp_u2dvar(ng)
8132 ELSE
8133 my_piovar%dkind=pio_real
8134 iodesc => iodesc_sp_u2dvar(ng)
8135 END IF
8136!
8137 status=nf_fread2d(ng, idmod, ncname, piofile, &
8138 & vname(1,idubar), my_piovar, &
8139 & inprec, iodesc, vsize, &
8140 & lbi, ubi, lbj, ubj, &
8141 & fscl, fmin, fmax, &
8142# ifdef MASKING
8143 & grid(ng) % umask, &
8144# endif
8145# ifdef CHECKSUM
8146 & ocean(ng) % ubar(:,:,tindex), &
8147 & checksum = fhash)
8148# else
8149 & ocean(ng) % ubar(:,:,tindex))
8150# endif
8151 END IF
8152 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8153 IF (master) THEN
8154 WRITE (stdout,60) string, trim(vname(1,idubar)), &
8155 & inprec, trim(ncname)
8156 END IF
8157 exit_flag=2
8158 ioerror=status
8159 RETURN
8160 ELSE
8161 IF (master) THEN
8162# ifdef CHECKSUM
8163 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
8164 & fhash
8165# else
8166 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
8167# endif
8168
8169 END IF
8170 END IF
8171 ELSE
8172 IF (master) THEN
8173 WRITE (stdout,80) string, trim(vname(1,idubar)), &
8174 & trim(ncname)
8175 END IF
8176 exit_flag=4
8177 IF (founderror(exit_flag, pio_noerr, &
8178 & __line__, myfile)) THEN
8179 RETURN
8180 END IF
8181 END IF
8182 END IF
8183!
8184! Read in nonlinear RHS of 2D U-momentum component.
8185!
8186 IF (get_var(idru2d).and.perfect2d) THEN
8187 foundit=find_string(var_name, n_var, trim(vname(1,idru2d)), &
8188 & vindex)
8189 IF (foundit) THEN
8190 my_piovar%vd=var_desc(vindex)
8191 my_piovar%gtype=u2dvar
8192 IF (kind(ocean(ng)%rubar).eq.8) THEN
8193 my_piovar%dkind=pio_double
8194 iodesc => iodesc_dp_rubar(ng)
8195 ELSE
8196 my_piovar%dkind=pio_real
8197 iodesc => iodesc_sp_rubar(ng)
8198 END IF
8199!
8200 status=nf_fread3d(ng, idmod, ncname, piofile, &
8201 & vname(1,idru2d), my_piovar, &
8202 & inprec, iodesc, vsize, &
8203 & lbi, ubi, lbj, ubj, 1, 2, &
8204 & fscl, fmin, fmax, &
8205# ifdef MASKING
8206 & grid(ng) % umask, &
8207# endif
8208# ifdef CHECKSUM
8209 & ocean(ng) % rubar, &
8210 & checksum = fhash)
8211# else
8212 & ocean(ng) % rubar)
8213# endif
8214 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8215 IF (master) THEN
8216 WRITE (stdout,60) string, trim(vname(1,idru2d)), &
8217 & inprec, trim(ncname)
8218 END IF
8219 exit_flag=2
8220 ioerror=status
8221 RETURN
8222 ELSE
8223 IF (master) THEN
8224# ifdef CHECKSUM
8225 WRITE (stdout,70) trim(vname(2,idru2d)), fmin, fmax, &
8226 & fhash
8227# else
8228 WRITE (stdout,70) trim(vname(2,idru2d)), fmin, fmax
8229# endif
8230
8231 END IF
8232 END IF
8233 ELSE
8234 IF (master) THEN
8235 WRITE (stdout,80) string, trim(vname(1,idru2d)), &
8236 & trim(ncname)
8237 END IF
8238 exit_flag=4
8239 IF (founderror(exit_flag, pio_noerr, &
8240 & __line__, myfile)) THEN
8241 RETURN
8242 END IF
8243 END IF
8244 END IF
8245!
8246! Read in nonlinear 2D V-momentum component (m/s).
8247!
8248 IF (get_var(idvbar)) THEN
8249 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
8250 & vindex)
8251 IF (foundit) THEN
8252 my_piovar%vd=var_desc(vindex)
8253 my_piovar%gtype=v2dvar
8254
8255 IF (perfect2d) THEN
8256 IF (kind(ocean(ng)%vbar).eq.8) THEN
8257 my_piovar%dkind=pio_double
8258 iodesc => iodesc_dp_vbar(ng)
8259 ELSE
8260 my_piovar%dkind=pio_real
8261 iodesc => iodesc_sp_vbar(ng)
8262 END IF
8263!
8264 status=nf_fread3d(ng, idmod, ncname, piofile, &
8265 & vname(1,idvbar), my_piovar, &
8266 & inprec, iodesc, vsize, &
8267 & lbi, ubi, lbj, ubj, 1, 3, &
8268 & fscl, fmin, fmax, &
8269# ifdef MASKING
8270 & grid(ng) % vmask, &
8271# endif
8272# ifdef CHECKSUM
8273 & ocean(ng) % vbar, &
8274 & checksum = fhash)
8275# else
8276 & ocean(ng) % vbar)
8277# endif
8278 ELSE
8279 IF (kind(ocean(ng)%vbar).eq.8) THEN
8280 my_piovar%dkind=pio_double
8281 iodesc => iodesc_dp_v2dvar(ng)
8282 ELSE
8283 my_piovar%dkind=pio_real
8284 iodesc => iodesc_sp_v2dvar(ng)
8285 END IF
8286!
8287 status=nf_fread2d(ng, idmod, ncname, piofile, &
8288 & vname(1,idvbar), my_piovar, &
8289 & inprec, iodesc, vsize, &
8290 & lbi, ubi, lbj, ubj, &
8291 & fscl, fmin, fmax, &
8292# ifdef MASKING
8293 & grid(ng) % vmask, &
8294# endif
8295# ifdef CHECKSUM
8296 & ocean(ng) % vbar(:,:,tindex), &
8297 & checksum = fhash)
8298# else
8299 & ocean(ng) % vbar(:,:,tindex))
8300# endif
8301 END IF
8302 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8303 IF (master) THEN
8304 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
8305 & inprec, trim(ncname)
8306 END IF
8307 exit_flag=2
8308 ioerror=status
8309 RETURN
8310 ELSE
8311 IF (master) THEN
8312# ifdef CHECKSUM
8313 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
8314 & fhash
8315# else
8316 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
8317# endif
8318
8319 END IF
8320 END IF
8321 ELSE
8322 IF (master) THEN
8323 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
8324 & trim(ncname)
8325 END IF
8326 exit_flag=4
8327 IF (founderror(exit_flag, pio_noerr, &
8328 & __line__, myfile)) THEN
8329 RETURN
8330 END IF
8331 END IF
8332 END IF
8333!
8334! Read in nonlinear RHS 2D V-momentum component.
8335!
8336 IF (get_var(idrv2d).and.perfect2d) THEN
8337 foundit=find_string(var_name, n_var, trim(vname(1,idrv2d)), &
8338 & vindex)
8339 IF (foundit) THEN
8340 my_piovar%vd=var_desc(vindex)
8341 my_piovar%gtype=v2dvar
8342 IF (kind(ocean(ng)%rvbar).eq.8) THEN
8343 my_piovar%dkind=pio_double
8344 iodesc => iodesc_dp_rvbar(ng)
8345 ELSE
8346 my_piovar%dkind=pio_real
8347 iodesc => iodesc_sp_rvbar(ng)
8348 END IF
8349!
8350 status=nf_fread3d(ng, idmod, ncname, piofile, &
8351 & vname(1,idrv2d), my_piovar, &
8352 & inprec, iodesc, vsize, &
8353 & lbi, ubi, lbj, ubj, 1, 2, &
8354 & fscl, fmin, fmax, &
8355# ifdef MASKING
8356 & grid(ng) % vmask, &
8357# endif
8358# ifdef CHECKSUM
8359 & ocean(ng) % rvbar, &
8360 & checksum = fhash)
8361# else
8362 & ocean(ng) % rvbar)
8363# endif
8364 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8365 IF (master) THEN
8366 WRITE (stdout,60) string, trim(vname(1,idrv2d)), &
8367 & inprec, trim(ncname)
8368 END IF
8369 exit_flag=2
8370 ioerror=status
8371 RETURN
8372 ELSE
8373 IF (master) THEN
8374# ifdef CHECKSUM
8375 WRITE (stdout,70) trim(vname(2,idrv2d)), fmin, fmax, &
8376 & fhash
8377# else
8378 WRITE (stdout,70) trim(vname(2,idrv2d)), fmin, fmax
8379# endif
8380
8381 END IF
8382 END IF
8383 ELSE
8384 IF (master) THEN
8385 WRITE (stdout,80) string, trim(vname(1,idrv2d)), &
8386 & trim(ncname)
8387 END IF
8388 exit_flag=4
8389 IF (founderror(exit_flag, pio_noerr, &
8390 & __line__, myfile)) THEN
8391 RETURN
8392 END IF
8393 END IF
8394 END IF
8395
8396# ifdef SOLVE3D
8397!
8398! Read in nonlinear 3D U-momentum component (m/s).
8399!
8400 IF (get_var(iduvel)) THEN
8401 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
8402 & vindex)
8403 IF (foundit) THEN
8404 my_piovar%vd=var_desc(vindex)
8405 my_piovar%gtype=u3dvar
8406 IF (perfect3d) THEN
8407 IF (kind(ocean(ng)%u).eq.8) THEN
8408 my_piovar%dkind=pio_double
8409 iodesc => iodesc_dp_uvel(ng)
8410 ELSE
8411 my_piovar%dkind=pio_real
8412 iodesc => iodesc_sp_uvel(ng)
8413 END IF
8414!
8415 status=nf_fread4d(ng, idmod, ncname, piofile, &
8416 & vname(1,iduvel), my_piovar, &
8417 & inprec, iodesc, vsize, &
8418 & lbi, ubi, lbj, ubj, 1, n(ng), 1, 2, &
8419 & fscl, fmin, fmax, &
8420# ifdef MASKING
8421 & grid(ng) % umask, &
8422# endif
8423# ifdef CHECKSUM
8424 & ocean(ng) % u, &
8425 & checksum = fhash)
8426# else
8427 & ocean(ng) % u)
8428# endif
8429 ELSE
8430 IF (kind(ocean(ng)%u).eq.8) THEN
8431 my_piovar%dkind=pio_double
8432 iodesc => iodesc_dp_u3dvar(ng)
8433 ELSE
8434 my_piovar%dkind=pio_real
8435 iodesc => iodesc_sp_u3dvar(ng)
8436 END IF
8437!
8438 status=nf_fread3d(ng, idmod, ncname, piofile, &
8439 & vname(1,iduvel), my_piovar, &
8440 & inprec, iodesc, vsize, &
8441 & lbi, ubi, lbj, ubj, 1, n(ng), &
8442 & fscl, fmin, fmax, &
8443# ifdef MASKING
8444 & grid(ng) % umask, &
8445# endif
8446# ifdef CHECKSUM
8447 & ocean(ng) % u(:,:,:,tindex), &
8448 & checksum = fhash)
8449# else
8450 & ocean(ng) % u(:,:,:,tindex))
8451# endif
8452 END IF
8453 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8454 IF (master) THEN
8455 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
8456 & inprec, trim(ncname)
8457 END IF
8458 exit_flag=2
8459 ioerror=status
8460 RETURN
8461 ELSE
8462 IF (master) THEN
8463# ifdef CHECKSUM
8464 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
8465 & fhash
8466# else
8467 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
8468# endif
8469 END IF
8470 END IF
8471 ELSE
8472 IF (master) THEN
8473 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
8474 & trim(ncname)
8475 END IF
8476 exit_flag=4
8477 IF (founderror(exit_flag, pio_noerr, &
8478 & __line__, myfile)) THEN
8479 RETURN
8480 END IF
8481 END IF
8482 END IF
8483!
8484! Read in nonlinear RHS of 3D U-momentum component.
8485!
8486 IF (get_var(idru3d).and.perfect3d) THEN
8487 foundit=find_string(var_name, n_var, trim(vname(1,idru3d)), &
8488 & vindex)
8489 IF (foundit) THEN
8490 my_piovar%vd=var_desc(vindex)
8491 my_piovar%gtype=u3dvar
8492 IF (kind(ocean(ng)%ru).eq.8) THEN
8493 my_piovar%dkind=pio_double
8494 iodesc => iodesc_dp_ruvel(ng)
8495 ELSE
8496 my_piovar%dkind=pio_real
8497 iodesc => iodesc_sp_ruvel(ng)
8498 END IF
8499!
8500 status=nf_fread4d(ng, idmod, ncname, piofile, &
8501 & vname(1,idru3d), my_piovar, &
8502 & inprec, iodesc, vsize, &
8503 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, &
8504 & fscl, fmin, fmax, &
8505# ifdef MASKING
8506 & grid(ng) % umask, &
8507# endif
8508# ifdef CHECKSUM
8509 & ocean(ng) % ru, &
8510 & checksum = fhash)
8511# else
8512 & ocean(ng) % ru)
8513# endif
8514 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8515 IF (master) THEN
8516 WRITE (stdout,60) string, trim(vname(1,idru3d)), &
8517 & inprec, trim(ncname)
8518 END IF
8519 exit_flag=2
8520 ioerror=status
8521 RETURN
8522 ELSE
8523 IF (master) THEN
8524# ifdef CHECKSUM
8525 WRITE (stdout,70) trim(vname(2,idru3d)), fmin, fmax, &
8526 & fhash
8527# else
8528 WRITE (stdout,70) trim(vname(2,idru3d)), fmin, fmax
8529# endif
8530 END IF
8531 END IF
8532 ELSE
8533 IF (master) THEN
8534 WRITE (stdout,80) string, trim(vname(1,idru3d)), &
8535 & trim(ncname)
8536 END IF
8537 exit_flag=4
8538 IF (founderror(exit_flag, pio_noerr, &
8539 & __line__, myfile)) THEN
8540 RETURN
8541 END IF
8542 END IF
8543 END IF
8544!
8545! Read in nonlinear 3D V-momentum component (m/s).
8546!
8547 IF (get_var(idvvel)) THEN
8548 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
8549 & vindex)
8550 IF (foundit) THEN
8551 my_piovar%vd=var_desc(vindex)
8552 my_piovar%gtype=v3dvar
8553 IF (perfect3d) THEN
8554 IF (kind(ocean(ng)%v).eq.8) THEN
8555 my_piovar%dkind=pio_double
8556 iodesc => iodesc_dp_vvel(ng)
8557 ELSE
8558 my_piovar%dkind=pio_real
8559 iodesc => iodesc_sp_vvel(ng)
8560 END IF
8561!
8562 status=nf_fread4d(ng, idmod, ncname, piofile, &
8563 & vname(1,idvvel), my_piovar, &
8564 & inprec, iodesc, vsize, &
8565 & lbi, ubi, lbj, ubj, 1, n(ng), 1, 2, &
8566 & fscl, fmin, fmax, &
8567# ifdef MASKING
8568 & grid(ng) % vmask, &
8569# endif
8570# ifdef CHECKSUM
8571 & ocean(ng) % v, &
8572 & checksum = fhash)
8573# else
8574 & ocean(ng) % v)
8575# endif
8576 ELSE
8577 IF (kind(ocean(ng)%v).eq.8) THEN
8578 my_piovar%dkind=pio_double
8579 iodesc => iodesc_dp_v3dvar(ng)
8580 ELSE
8581 my_piovar%dkind=pio_real
8582 iodesc => iodesc_sp_v3dvar(ng)
8583 END IF
8584!
8585 status=nf_fread3d(ng, idmod, ncname, piofile, &
8586 & vname(1,idvvel), my_piovar, &
8587 & inprec, iodesc, vsize, &
8588 & lbi, ubi, lbj, ubj, 1, n(ng), &
8589 & fscl, fmin, fmax, &
8590# ifdef MASKING
8591 & grid(ng) % vmask, &
8592# endif
8593# ifdef CHECKSUM
8594 & ocean(ng) % v(:,:,:,tindex), &
8595 & checksum = fhash)
8596# else
8597 & ocean(ng) % v(:,:,:,tindex))
8598# endif
8599 END IF
8600 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8601 IF (master) THEN
8602 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
8603 & inprec, trim(ncname)
8604 END IF
8605 exit_flag=2
8606 ioerror=status
8607 RETURN
8608 ELSE
8609 IF (master) THEN
8610# ifdef CHECKSUM
8611 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
8612 & fhash
8613# else
8614 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
8615# endif
8616
8617 END IF
8618 END IF
8619 ELSE
8620 IF (master) THEN
8621 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
8622 & trim(ncname)
8623 END IF
8624 exit_flag=4
8625 IF (founderror(exit_flag, pio_noerr, &
8626 & __line__, myfile)) THEN
8627 RETURN
8628 END IF
8629 END IF
8630 END IF
8631!
8632! Read in nonlinear RHS of 3D V-momentum component.
8633!
8634 IF (get_var(idrv3d).and.perfect3d) THEN
8635 foundit=find_string(var_name, n_var, trim(vname(1,idrv3d)), &
8636 & vindex)
8637 IF (foundit) THEN
8638 my_piovar%vd=var_desc(vindex)
8639 my_piovar%dkind=pio_frst
8640 my_piovar%gtype=v3dvar
8641 IF (kind(ocean(ng)%rv).eq.8) THEN
8642 my_piovar%dkind=pio_double
8643 iodesc => iodesc_dp_rvvel(ng)
8644 ELSE
8645 my_piovar%dkind=pio_real
8646 iodesc => iodesc_sp_rvvel(ng)
8647 END IF
8648!
8649 status=nf_fread4d(ng, idmod, ncname, piofile, &
8650 & vname(1,idrv3d), my_piovar, &
8651 & inprec, iodesc, vsize, &
8652 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, &
8653 & fscl, fmin, fmax, &
8654# ifdef MASKING
8655 & grid(ng) % vmask, &
8656# endif
8657# ifdef CHECKSUM
8658 & ocean(ng) % rv, &
8659 & checksum = fhash)
8660# else
8661 & ocean(ng) % rv)
8662# endif
8663 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8664 IF (master) THEN
8665 WRITE (stdout,60) string, trim(vname(1,idrv3d)), &
8666 & inprec, trim(ncname)
8667 END IF
8668 exit_flag=2
8669 ioerror=status
8670 RETURN
8671 ELSE
8672 IF (master) THEN
8673# ifdef CHECKSUM
8674 WRITE (stdout,70) trim(vname(2,idrv3d)), fmin, fmax, &
8675 & fhash
8676# else
8677 WRITE (stdout,70) trim(vname(2,idrv3d)), fmin, fmax
8678# endif
8679
8680 END IF
8681 END IF
8682 ELSE
8683 IF (master) THEN
8684 WRITE (stdout,80) string, trim(vname(1,idrv3d)), &
8685 & trim(ncname)
8686 END IF
8687 exit_flag=4
8688 IF (founderror(exit_flag, pio_noerr, &
8689 & __line__, myfile)) THEN
8690 RETURN
8691 END IF
8692 END IF
8693 END IF
8694!
8695! Read in nonlinear tracer type variables.
8696!
8697 DO itrc=1,nt(ng)
8698 IF (get_var(idtvar(itrc))) THEN
8699 foundit=find_string(var_name, n_var, &
8700 & trim(vname(1,idtvar(itrc))), vindex)
8701 IF (foundit) THEN
8702 my_piovar%vd=var_desc(vindex)
8703 my_piovar%gtype=r3dvar
8704 IF (perfect3d) THEN
8705 IF (kind(ocean(ng)%u).eq.8) THEN
8706 my_piovar%dkind=pio_double
8707 iodesc => iodesc_dp_trcvar(ng)
8708 ELSE
8709 my_piovar%dkind=pio_real
8710 iodesc => iodesc_sp_trcvar(ng)
8711 END IF
8712!
8713 status=nf_fread4d(ng, idmod, ncname, piofile, &
8714 & vname(1,idtvar(itrc)), my_piovar, &
8715 & inprec, iodesc, vsize, &
8716 & lbi, ubi, lbj, ubj, 1, n(ng), 1, 2, &
8717 & fscl, fmin, fmax, &
8718# ifdef MASKING
8719 & grid(ng) % rmask, &
8720# endif
8721# ifdef CHECKSUM
8722 & ocean(ng) % t(:,:,:,:,itrc), &
8723 & checksum = fhash)
8724# else
8725 & ocean(ng) % t(:,:,:,:,itrc))
8726# endif
8727 ELSE
8728 IF (kind(ocean(ng)%t).eq.8) THEN
8729 my_piovar%dkind=pio_double
8730 iodesc => iodesc_dp_r3dvar(ng)
8731 ELSE
8732 my_piovar%dkind=pio_real
8733 iodesc => iodesc_sp_r3dvar(ng)
8734 END IF
8735!
8736 status=nf_fread3d(ng, idmod, ncname, piofile, &
8737 & vname(1,idtvar(itrc)), my_piovar, &
8738 & inprec, iodesc, vsize, &
8739 & lbi, ubi, lbj, ubj, 1, n(ng), &
8740 & fscl, fmin, fmax, &
8741# ifdef MASKING
8742 & grid(ng) % rmask, &
8743# endif
8744# ifdef CHECKSUM
8745 & ocean(ng) % t(:,:,:,tindex,itrc), &
8746 & checksum = fhash)
8747# else
8748 & ocean(ng) % t(:,:,:,tindex,itrc))
8749# endif
8750 END IF
8751 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8752 IF (master) THEN
8753 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
8754 & inprec, trim(ncname)
8755 END IF
8756 exit_flag=2
8757 ioerror=status
8758 RETURN
8759 ELSE
8760 IF (master) THEN
8761# ifdef CHECKSUM
8762 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
8763 & fmin, fmax, fhash
8764# else
8765 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
8766 & fmin, fmax
8767# endif
8768 END IF
8769 END IF
8770 ELSE
8771 IF (master) THEN
8772 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
8773 & trim(ncname)
8774 END IF
8775 exit_flag=4
8776 IF (founderror(exit_flag, pio_noerr, &
8777 & __line__, myfile)) THEN
8778 RETURN
8779 END IF
8780 END IF
8781 END IF
8782 END DO
8783
8784# if defined GLS_MIXING || defined MY25_MIXING || defined LMD_MIXING
8785!
8786! Read in vertical viscosity.
8787!
8788 IF (have_var(idvvis)) THEN
8789 foundit=find_string(var_name, n_var, trim(vname(1,idvvis)), &
8790 & vindex)
8791 IF (foundit) THEN
8792 my_piovar%vd=var_desc(vindex)
8793 my_piovar%gtype=w3dvar
8794 IF (kind(mixing(ng)%AKv).eq.8) THEN
8795 my_piovar%dkind=pio_double
8796 iodesc => iodesc_dp_w3dvar(ng)
8797 ELSE
8798 my_piovar%dkind=pio_real
8799 iodesc => iodesc_sp_w3dvar(ng)
8800 END IF
8801!
8802 status=nf_fread3d(ng, idmod, ncname, piofile, &
8803 & vname(1,idvvis), my_piovar, &
8804 & inprec, iodesc, vsize, &
8805 & lbi, ubi, lbj, ubj, 0, n(ng), &
8806 & fscl, fmin,fmax, &
8807# ifdef MASKING
8808 & grid(ng) % rmask, &
8809# endif
8810# ifdef CHECKSUM
8811 & mixing(ng) % AKv, &
8812 & checksum = fhash)
8813# else
8814 & mixing(ng) % AKv)
8815# endif
8816 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8817 IF (master) THEN
8818 WRITE (stdout,60) string, trim(vname(1,idvvis)), &
8819 & inprec, trim(ncname)
8820 END IF
8821 exit_flag=2
8822 ioerror=status
8823 RETURN
8824 ELSE
8825 IF (master) THEN
8826# ifdef CHECKSUM
8827 WRITE (stdout,70) trim(vname(2,idvvis)), fmin, fmax, &
8828 & fhash
8829# else
8830 WRITE (stdout,70) trim(vname(2,idvvis)), fmin, fmax
8831# endif
8832
8833 END IF
8834 END IF
8835# ifdef DISTRIBUTE
8836 CALL mp_exchange3d (ng, myrank, idmod, 1, &
8837 & lbi, ubi, lbj, ubj, 0, n(ng), &
8838 & nghostpoints, &
8839 & ewperiodic(ng), nsperiodic(ng), &
8840 & mixing(ng) % AKv)
8841# endif
8842 ELSE
8843 IF (master) THEN
8844 WRITE (stdout,80) string, trim(vname(1,idvvis)), &
8845 & trim(ncname)
8846 END IF
8847 exit_flag=4
8848 IF (founderror(exit_flag, pio_noerr, &
8849 & __line__, myfile)) THEN
8850 RETURN
8851 END IF
8852 END IF
8853 END IF
8854!
8855! Read in temperature vertical diffusion.
8856!
8857 IF (have_var(idtdif)) THEN
8858 foundit=find_string(var_name, n_var, trim(vname(1,idtdif)), &
8859 & vindex)
8860 IF (foundit) THEN
8861 my_piovar%vd=var_desc(vindex)
8862 my_piovar%gtype=w3dvar
8863 IF (kind(mixing(ng)%AKt).eq.8) THEN
8864 my_piovar%dkind=pio_double
8865 iodesc => iodesc_dp_w3dvar(ng)
8866 ELSE
8867 my_piovar%dkind=pio_real
8868 iodesc => iodesc_sp_w3dvar(ng)
8869 END IF
8870!
8871 status=nf_fread3d(ng, idmod, ncname, piofile, &
8872 & vname(1,idtdif), my_piovar, &
8873 & inprec, iodesc, vsize, &
8874 & lbi, ubi, lbj, ubj, 0, n(ng), &
8875 & fscl, fmin,fmax, &
8876# ifdef MASKING
8877 & grid(ng) % rmask, &
8878# endif
8879# ifdef CHECKSUM
8880 & mixing(ng) % AKt(:,:,:,itemp), &
8881 & checksum = fhash)
8882# else
8883 & mixing(ng) % AKt(:,:,:,itemp))
8884# endif
8885 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8886 IF (master) THEN
8887 WRITE (stdout,60) string, trim(vname(1,idtdif)), &
8888 & inprec, trim(ncname)
8889 END IF
8890 exit_flag=2
8891 ioerror=status
8892 RETURN
8893 ELSE
8894 IF (master) THEN
8895# ifdef CHECKSUM
8896 WRITE (stdout,70) trim(vname(2,idtdif)), fmin, fmax, &
8897 & fhash
8898# else
8899 WRITE (stdout,70) trim(vname(2,idtdif)), fmin, fmax
8900# endif
8901
8902 END IF
8903 END IF
8904# ifdef DISTRIBUTE
8905 CALL mp_exchange3d (ng, myrank, idmod, 1, &
8906 & lbi, ubi, lbj, ubj, 0, n(ng), &
8907 & nghostpoints, &
8908 & ewperiodic(ng), nsperiodic(ng), &
8909 & mixing(ng) % AKt(:,:,:,itemp))
8910# endif
8911 ELSE
8912 IF (master) THEN
8913 WRITE (stdout,80) string, trim(vname(1,idtdif)), &
8914 & trim(ncname)
8915 END IF
8916 exit_flag=4
8917 IF (founderror(exit_flag, pio_noerr, &
8918 & __line__, myfile)) THEN
8919 RETURN
8920 END IF
8921 END IF
8922 END IF
8923
8924# ifdef SALINITY
8925!
8926! Read in salinity vertical diffusion.
8927!
8928 IF (have_var(idsdif)) THEN
8929 foundit=find_string(var_name, n_var, trim(vname(1,idsdif)), &
8930 & vindex)
8931 IF (foundit) THEN
8932 my_piovar%vd=var_desc(vindex)
8933 my_piovar%gtype=w3dvar
8934 IF (kind(mixing(ng)%AKt).eq.8) THEN
8935 my_piovar%dkind=pio_double
8936 iodesc => iodesc_dp_w3dvar(ng)
8937 ELSE
8938 my_piovar%dkind=pio_real
8939 iodesc => iodesc_sp_w3dvar(ng)
8940 END IF
8941!
8942 status=nf_fread3d(ng, idmod, ncname, piofile, &
8943 & vname(1,idsdif), my_piovar, &
8944 & inprec, iodesc, vsize, &
8945 & lbi, ubi, lbj, ubj, 0, n(ng), &
8946 & fscl, fmin,fmax, &
8947# ifdef MASKING
8948 & grid(ng) % rmask, &
8949# endif
8950# ifdef CHECKSUM
8951 & mixing(ng) % AKt(:,:,:,isalt), &
8952 & checksum = fhash)
8953# else
8954 & mixing(ng) % AKt(:,:,:,isalt))
8955# endif
8956 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8957 IF (master) THEN
8958 WRITE (stdout,60) string, trim(vname(1,idsdif)), &
8959 & inprec, trim(ncname)
8960 END IF
8961 exit_flag=2
8962 ioerror=status
8963 RETURN
8964 ELSE
8965 IF (master) THEN
8966# ifdef CHECKSUM
8967 WRITE (stdout,70) trim(vname(2,idsdif)), fmin, fmax, &
8968 & fhash
8969# else
8970 WRITE (stdout,70) trim(vname(2,idsdif)), fmin, fmax
8971# endif
8972
8973 END IF
8974 END IF
8975# ifdef DISTRIBUTE
8976 CALL mp_exchange3d (ng, myrank, idmod, 1, &
8977 & lbi, ubi, lbj, ubj, 0, n(ng), &
8978 & nghostpoints, &
8979 & ewperiodic(ng), nsperiodic(ng), &
8980 & mixing(ng) % AKt(:,:,:,isalt))
8981# endif
8982 ELSE
8983 IF (master) THEN
8984 WRITE (stdout,80) string, trim(vname(1,idsdif)), &
8985 & trim(ncname)
8986 END IF
8987 exit_flag=4
8988 IF (founderror(exit_flag, pio_noerr, &
8989 & __line__, myfile)) THEN
8990 RETURN
8991 END IF
8992 END IF
8993 END IF
8994# endif
8995# endif
8996# if defined LMD_SKPP
8997!
8998! Read in Hsbl
8999!
9000 IF (have_var(idhsbl).and.perfect3d) THEN
9001 foundit=find_string(var_name, n_var, trim(vname(1,idhsbl)), &
9002 & vindex)
9003 IF (foundit) THEN
9004 my_piovar%vd=var_desc(vindex)
9005 my_piovar%dkind=pio_frst
9006 my_piovar%gtype=r2dvar
9007 IF (kind(mixing(ng)%Hsbl).eq.8) THEN
9008 my_piovar%dkind=pio_double
9009 iodesc => iodesc_dp_r2dvar(ng)
9010 ELSE
9011 my_piovar%dkind=pio_real
9012 iodesc => iodesc_sp_r2dvar(ng)
9013 END IF
9014!
9015 status=nf_fread2d(ng, idmod, ncname, piofile, &
9016 & vname(1,idhsbl), my_piovar, &
9017 & inprec, iodesc, vsize, &
9018 & lbi, ubi, lbj, ubj, &
9019 & fscl, fmin, fmax, &
9020# ifdef MASKING
9021 & grid(ng) % rmask, &
9022# endif
9023# ifdef CHECKSUM
9024 & mixing(ng) % Hsbl, &
9025 & checksum = fhash)
9026# else
9027 & mixing(ng) % Hsbl)
9028# endif
9029 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9030 IF (master) THEN
9031 WRITE (stdout,60) string, trim(vname(1,idhsbl)), &
9032 & inprec, trim(ncname)
9033 END IF
9034 exit_flag=2
9035 ioerror=status
9036 RETURN
9037 ELSE
9038 IF (master) THEN
9039# ifdef CHECKSUM
9040 WRITE (stdout,70) trim(vname(2,idhsbl)), fmin, fmax, &
9041 & fhash
9042# else
9043 WRITE (stdout,70) trim(vname(2,idhsbl)), fmin, fmax
9044# endif
9045
9046 END IF
9047 END IF
9048 ELSE
9049 IF (master) THEN
9050 WRITE (stdout,80) string, trim(vname(1,idhsbl)), &
9051 & trim(ncname)
9052 END IF
9053 exit_flag=4
9054 IF (founderror(exit_flag, pio_noerr, &
9055 & __line__, myfile)) THEN
9056 RETURN
9057 END IF
9058 END IF
9059 END IF
9060# endif
9061# if defined LMD_BKPP
9062!
9063! Read in Hbbl
9064!
9065 IF (have_var(idhbbl).and.perfect3d) THEN
9066 foundit=find_string(var_name, n_var, trim(vname(1,idhbbl)), &
9067 & vindex)
9068 IF (foundit) THEN
9069 my_piovar%vd=var_desc(vindex)
9070 my_piovar%dkind=pio_frst
9071 my_piovar%gtype=r2dvar
9072 IF (kind(mixing(ng)%Hbbl).eq.8) THEN
9073 my_piovar%dkind=pio_double
9074 iodesc => iodesc_dp_r2dvar(ng)
9075 ELSE
9076 my_piovar%dkind=pio_real
9077 iodesc => iodesc_sp_r2dvar(ng)
9078 END IF
9079!
9080 status=nf_fread2d(ng, idmod, ncname, piofile, &
9081 & vname(1,idhbbl), my_piovar, &
9082 & inprec, iodesc, vsize, &
9083 & lbi, ubi, lbj, ubj, &
9084 & fscl, fmin, fmax, &
9085# ifdef MASKING
9086 & grid(ng) % rmask, &
9087# endif
9088# ifdef CHECKSUM
9089 & mixing(ng) % Hbbl, &
9090 & checksum = fhash)
9091# else
9092 & mixing(ng) % Hbbl)
9093# endif
9094 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9095 IF (master) THEN
9096 WRITE (stdout,60) string, trim(vname(1,idhbbl)), &
9097 & inprec, trim(ncname)
9098 END IF
9099 exit_flag=2
9100 ioerror=status
9101 RETURN
9102 ELSE
9103 IF (master) THEN
9104# ifdef CHECKSUM
9105 WRITE (stdout,70) trim(vname(2,idhbbl)), fmin, fmax, &
9106 & fhash
9107# else
9108 WRITE (stdout,70) trim(vname(2,idhbbl)), fmin, fmax
9109# endif
9110
9111 END IF
9112 END IF
9113 ELSE
9114 IF (master) THEN
9115 WRITE (stdout,80) string, trim(vname(1,idhbbl)), &
9116 & trim(ncname)
9117 END IF
9118 exit_flag=4
9119 IF (founderror(exit_flag, pio_noerr, &
9120 & __line__, myfile)) THEN
9121 RETURN
9122 END IF
9123 END IF
9124 END IF
9125# endif
9126# if defined LMD_NONLOCAL && defined PERFECT_RESTART
9127!
9128! Read in Ghats
9129!
9130 DO itrc=1,nat
9131 IF (have_var(idghat(itrc))) THEN
9132 foundit=find_string(var_name, n_var, &
9133 & trim(vname(1,idghat(itrc))), vindex)
9134 IF (foundit) THEN
9135 my_piovar%vd=var_desc(vindex)
9136 my_piovar%gtype=w3dvar
9137 IF (kind(mixing(ng)%Ghats).eq.8) THEN
9138 my_piovar%dkind=pio_double
9139 iodesc => iodesc_dp_w3dvar(ng)
9140 ELSE
9141 my_piovar%dkind=pio_real
9142 iodesc => iodesc_sp_w3dvar(ng)
9143 END IF
9144!
9145 status=nf_fread3d(ng, idmod, ncname, piofile, &
9146 & vname(1,idghat(itrc)), my_piovar, &
9147 & inprec, iodesc, vsize, &
9148 & lbi, ubi, lbj, ubj, 0, n(ng), &
9149 & fscl, fmin,fmax, &
9150# ifdef MASKING
9151 & grid(ng) % rmask, &
9152# endif
9153# ifdef CHECKSUM
9154 & mixing(ng) % Ghats(:,:,:,itrc), &
9155 & checksum = fhash)
9156# else
9157 & mixing(ng) % Ghats(:,:,:,itrc))
9158# endif
9159 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9160 IF (master) THEN
9161 WRITE (stdout,60) string, trim(vname(1,idghat(itrc))), &
9162 & inprec, trim(ncname)
9163 END IF
9164 exit_flag=2
9165 ioerror=status
9166 RETURN
9167 ELSE
9168 IF (master) THEN
9169# ifdef CHECKSUM
9170 WRITE (stdout,70) trim(vname(2,idghat(itrc))), &
9171 & fmin, fmax, fhash
9172# else
9173 WRITE (stdout,70) trim(vname(2,idghat(itrc))), &
9174 & fmin, fmax
9175# endif
9176 END IF
9177 END IF
9178 ELSE
9179 IF (master) THEN
9180 WRITE (stdout,80) string, trim(vname(1,idghat(itrc))), &
9181 & trim(ncname)
9182 END IF
9183 exit_flag=4
9184 IF (founderror(exit_flag, pio_noerr, &
9185 & __line__, myfile)) THEN
9186 RETURN
9187 END IF
9188 END IF
9189 END IF
9190 END DO
9191# endif
9192# if defined GLS_MIXING || defined MY25_MIXING
9193!
9194! Read in turbulent kinetic energy.
9195!
9196 IF (get_var(idmtke).and.perfect3d) THEN
9197 foundit=find_string(var_name, n_var, trim(vname(1,idmtke)), &
9198 & vindex)
9199 IF (foundit) THEN
9200 my_piovar%vd=var_desc(vindex)
9201 my_piovar%dkind=pio_frst
9202 my_piovar%gtype=w3dvar
9203 IF (kind(mixing(ng)%tke).eq.8) THEN
9204 my_piovar%dkind=pio_double
9205 iodesc => iodesc_dp_tkevar(ng)
9206 ELSE
9207 my_piovar%dkind=pio_real
9208 iodesc => iodesc_sp_tkevar(ng)
9209 END IF
9210!
9211 status=nf_fread4d(ng, idmod, ncname, piofile, &
9212 & vname(1,idmtke), my_piovar, &
9213 & inprec, iodesc, vsize, &
9214 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, &
9215 & fscl, fmin, fmax, &
9216# ifdef MASKING
9217 & grid(ng) % rmask, &
9218# endif
9219# ifdef CHECKSUM
9220 & mixing(ng) % tke, &
9221 & checksum = fhash)
9222# else
9223 & mixing(ng) % tke)
9224# endif
9225 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9226 IF (master) THEN
9227 WRITE (stdout,60) string, trim(vname(1,idmtke)), &
9228 & inprec, trim(ncname)
9229 END IF
9230 exit_flag=2
9231 ioerror=status
9232 RETURN
9233 ELSE
9234 IF (master) THEN
9235# ifdef CHECKSUM
9236 WRITE (stdout,70) trim(vname(2,idmtke)), fmin, fmax, &
9237 & fhash
9238# else
9239 WRITE (stdout,70) trim(vname(2,idmtke)), fmin, fmax
9240# endif
9241
9242 END IF
9243 END IF
9244 ELSE
9245 IF (master) THEN
9246 WRITE (stdout,80) string, trim(vname(1,idmtke)), &
9247 & trim(ncname)
9248 END IF
9249 exit_flag=4
9250 IF (founderror(exit_flag, pio_noerr, &
9251 & __line__, myfile)) THEN
9252 RETURN
9253 END IF
9254 END IF
9255 END IF
9256!
9257! Read in turbulent kinetic energy time length scale.
9258!
9259 IF (get_var(idmtls).and.perfect3d) THEN
9260 foundit=find_string(var_name, n_var, trim(vname(1,idmtls)), &
9261 & vindex)
9262 IF (foundit) THEN
9263 my_piovar%vd=var_desc(vindex)
9264 my_piovar%gtype=w3dvar
9265 IF (kind(mixing(ng)%gls).eq.8) THEN
9266 my_piovar%dkind=pio_double
9267 iodesc => iodesc_dp_tkevar(ng)
9268 ELSE
9269 my_piovar%dkind=pio_real
9270 iodesc => iodesc_sp_tkevar(ng)
9271 END IF
9272!
9273 status=nf_fread4d(ng, idmod, ncname, piofile, &
9274 & vname(1,idmtls), my_piovar, &
9275 & inprec, iodesc, vsize, &
9276 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, &
9277 & fscl, fmin, fmax, &
9278# ifdef MASKING
9279 & grid(ng) % rmask, &
9280# endif
9281# ifdef CHECKSUM
9282 & mixing(ng) % gls, &
9283 & checksum = fhash)
9284# else
9285 & mixing(ng) % gls)
9286# endif
9287 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9288 IF (master) THEN
9289 WRITE (stdout,60) string, trim(vname(1,idmtls)), &
9290 & inprec, trim(ncname)
9291 END IF
9292 exit_flag=2
9293 ioerror=status
9294 RETURN
9295 ELSE
9296 IF (master) THEN
9297# ifdef CHECKSUM
9298 WRITE (stdout,70) trim(vname(2,idmtls)), fmin, fmax, &
9299 & fhash
9300# else
9301 WRITE (stdout,70) trim(vname(2,idmtls)), fmin, fmax
9302# endif
9303
9304 END IF
9305 END IF
9306 ELSE
9307 IF (master) THEN
9308 WRITE (stdout,80) string, trim(vname(1,idmtls)), &
9309 & trim(ncname)
9310 END IF
9311 exit_flag=4
9312 IF (founderror(exit_flag, pio_noerr, &
9313 & __line__, myfile)) THEN
9314 RETURN
9315 END IF
9316 END IF
9317 END IF
9318!
9319! Read in vertical mixing turbulent length scale.
9320!
9321 IF (get_var(idvmls).and.perfect3d) THEN
9322 foundit=find_string(var_name, n_var, trim(vname(1,idvmls)), &
9323 & vindex)
9324 IF (foundit) THEN
9325 my_piovar%vd=var_desc(vindex)
9326 my_piovar%dkind=pio_frst
9327 my_piovar%gtype=w3dvar
9328 IF (kind(mixing(ng)%Lscale).eq.8) THEN
9329 my_piovar%dkind=pio_double
9330 iodesc => iodesc_dp_w3dvar(ng)
9331 ELSE
9332 my_piovar%dkind=pio_real
9333 iodesc => iodesc_sp_w3dvar(ng)
9334 END IF
9335!
9336 status=nf_fread3d(ng, idmod, ncname, piofile, &
9337 & vname(1,idvmls), my_piovar, &
9338 & inprec, iodesc, vsize, &
9339 & lbi, ubi, lbj, ubj, 0, n(ng), &
9340 & fscl, fmin, fmax, &
9341# ifdef MASKING
9342 & grid(ng) % rmask, &
9343# endif
9344# ifdef CHECKSUM
9345 & mixing(ng) % Lscale, &
9346 & checksum = fhash)
9347# else
9348 & mixing(ng) % Lscale)
9349# endif
9350 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9351 IF (master) THEN
9352 WRITE (stdout,60) string, trim(vname(1,idvmls)), &
9353 & inprec, trim(ncname)
9354 END IF
9355 exit_flag=2
9356 ioerror=status
9357 RETURN
9358 ELSE
9359 IF (master) THEN
9360# ifdef CHECKSUM
9361 WRITE (stdout,70) trim(vname(2,idvmls)), fmin, fmax, &
9362 & fhash
9363# else
9364 WRITE (stdout,70) trim(vname(2,idvmls)), fmin, fmax
9365# endif
9366
9367 END IF
9368 END IF
9369 ELSE
9370 IF (master) THEN
9371 WRITE (stdout,80) string, trim(vname(1,idvmls)), &
9372 & trim(ncname)
9373 END IF
9374 exit_flag=4
9375 IF (founderror(exit_flag, pio_noerr, &
9376 & __line__, myfile)) THEN
9377 RETURN
9378 END IF
9379 END IF
9380 END IF
9381!
9382! Read in turbulent kinetic energy vertical diffusion coefficient.
9383!
9384 IF (get_var(idvmkk).and.perfect3d) THEN
9385 foundit=find_string(var_name, n_var, trim(vname(1,idvmkk)), &
9386 & vindex)
9387 IF (foundit) THEN
9388 my_piovar%vd=var_desc(vindex)
9389 my_piovar%gtype=w3dvar
9390 IF (kind(mixing(ng)%Akk).eq.8) THEN
9391 my_piovar%dkind=pio_double
9392 iodesc => iodesc_dp_w3dvar(ng)
9393 ELSE
9394 my_piovar%dkind=pio_real
9395 iodesc => iodesc_sp_w3dvar(ng)
9396 END IF
9397!
9398 status=nf_fread3d(ng, idmod, ncname, piofile, &
9399 & vname(1,idvmkk), my_piovar, &
9400 & inprec, iodesc, vsize, &
9401 & lbi, ubi, lbj, ubj, 0, n(ng), &
9402 & fscl, fmin, fmax, &
9403# ifdef MASKING
9404 & grid(ng) % rmask, &
9405# endif
9406# ifdef CHECKSUM
9407 & mixing(ng) % Akk, &
9408 & checksum = fhash)
9409# else
9410 & mixing(ng) % Akk)
9411# endif
9412 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9413 IF (master) THEN
9414 WRITE (stdout,60) string, trim(vname(1,idvmkk)), &
9415 & inprec, trim(ncname)
9416 END IF
9417 exit_flag=2
9418 ioerror=status
9419 RETURN
9420 ELSE
9421 IF (master) THEN
9422# ifdef CHECKSUM
9423 WRITE (stdout,70) trim(vname(2,idvmkk)), fmin, fmax, &
9424 & fhash
9425# else
9426 WRITE (stdout,70) trim(vname(2,idvmkk)), fmin, fmax
9427# endif
9428
9429 END IF
9430 END IF
9431 ELSE
9432 IF (master) THEN
9433 WRITE (stdout,80) string, trim(vname(1,idvmkk)), &
9434 & trim(ncname)
9435 END IF
9436 exit_flag=4
9437 IF (founderror(exit_flag, pio_noerr, &
9438 & __line__, myfile)) THEN
9439 RETURN
9440 END IF
9441 END IF
9442 END IF
9443
9444# ifdef GLS_MIXING
9445!
9446! Read in turbulent length scale vertical diffusion coefficient.
9447!
9448 IF (get_var(idvmkp).and.perfect3d) THEN
9449 foundit=find_string(var_name, n_var, trim(vname(1,idvmkp)), &
9450 & vindex)
9451 IF (foundit) THEN
9452 my_piovar%vd=var_desc(vindex)
9453 my_piovar%gtype=w3dvar
9454 IF (kind(mixing(ng)%Akp).eq.8) THEN
9455 my_piovar%dkind=pio_double
9456 iodesc => iodesc_dp_w3dvar(ng)
9457 ELSE
9458 my_piovar%dkind=pio_real
9459 iodesc => iodesc_sp_w3dvar(ng)
9460 END IF
9461!
9462 status=nf_fread3d(ng, idmod, ncname, piofile, &
9463 & vname(1,idvmkp), my_piovar, &
9464 & inprec, iodesc, vsize, &
9465 & lbi, ubi, lbj, ubj, 0, n(ng), &
9466 & fscl, fmin, fmax, &
9467# ifdef MASKING
9468 & grid(ng) % rmask, &
9469# endif
9470# ifdef CHECKSUM
9471 & mixing(ng) % Akp, &
9472 & checksum = fhash)
9473# else
9474 & mixing(ng) % Akp)
9475# endif
9476 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9477 IF (master) THEN
9478 WRITE (stdout,60) string, trim(vname(1,idvmkp)), &
9479 & inprec, trim(ncname)
9480 END IF
9481 exit_flag=2
9482 ioerror=status
9483 RETURN
9484 ELSE
9485 IF (master) THEN
9486# ifdef CHECKSUM
9487 WRITE (stdout,70) trim(vname(2,idvmkp)), fmin, fmax, &
9488 & fhash
9489# else
9490 WRITE (stdout,70) trim(vname(2,idvmkp)), fmin, fmax
9491# endif
9492
9493 END IF
9494 END IF
9495 ELSE
9496 IF (master) THEN
9497 WRITE (stdout,80) string, trim(vname(1,idvmkp)), &
9498 & trim(ncname)
9499 END IF
9500 exit_flag=4
9501 IF (founderror(exit_flag, pio_noerr, &
9502 & __line__, myfile)) THEN
9503 RETURN
9504 END IF
9505 END IF
9506 END IF
9507# endif
9508# endif
9509# ifdef SEDIMENT
9510!
9511! Read in nonlinear sediment fraction of each size class in each bed
9512! layer.
9513!
9514 DO i=1,nst
9515 IF (get_var(idfrac(i))) THEN
9516 foundit=find_string(var_name, n_var, &
9517 & trim(vname(1,idfrac(i))), vindex)
9518 IF (foundit) THEN
9519 my_piovar%vd=var_desc(vindex)
9520 my_piovar%gtype=b3dvar
9521 IF (kind(sedbed(ng)%bed_frac).eq.8) THEN
9522 my_piovar%dkind=pio_double
9523 iodesc => iodesc_dp_b3dvar(ng)
9524 ELSE
9525 my_piovar%dkind=pio_real
9526 iodesc => iodesc_sp_b3dvar(ng)
9527 END IF
9528!
9529 status=nf_fread3d(ng, idmod, ncname, piofile, &
9530 & vname(1,idfrac(i)), my_piovar, &
9531 & inprec, iodesc, vsize, &
9532 & lbi, ubi, lbj, ubj, 1, nbed, &
9533 & fscl, fmin, fmax, &
9534# ifdef MASKING
9535 & grid(ng) % rmask, &
9536# endif
9537# ifdef CHECKSUM
9538 & sedbed(ng) % bed_frac(:,:,:,i), &
9539 & checksum = fhash)
9540# else
9541 & sedbed(ng) % bed_frac(:,:,:,i))
9542# endif
9543 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9544 IF (master) THEN
9545 WRITE (stdout,60) string, trim(vname(1,idfrac(i))), &
9546 & inprec, trim(ncname)
9547 END IF
9548 exit_flag=2
9549 ioerror=status
9550 RETURN
9551 ELSE
9552 IF (master) THEN
9553# ifdef CHECKSUM
9554 WRITE (stdout,70) trim(vname(2,idfrac(i))), &
9555 & fmin, fmax, fhash
9556# else
9557 WRITE (stdout,70) trim(vname(2,idfrac(i))), &
9558 & fmin, fmax
9559# endif
9560
9561 END IF
9562 END IF
9563 ELSE
9564 IF (master) THEN
9565 WRITE (stdout,80) string, trim(vname(1,idfrac(i))), &
9566 & trim(ncname)
9567 END IF
9568 exit_flag=4
9569 IF (founderror(exit_flag, pio_noerr, &
9570 & __line__, myfile)) THEN
9571 RETURN
9572 END IF
9573 END IF
9574 END IF
9575!
9576! Read in nonlinear sediment mass of each size class in each bed layer.
9577!
9578 IF (get_var(idbmas(i))) THEN
9579 foundit=find_string(var_name, n_var, &
9580 & trim(vname(1,idbmas(i))), vindex)
9581 IF (foundit) THEN
9582 my_piovar%vd=var_desc(vindex)
9583 my_piovar%gtype=b3dvar
9584 IF (kind(sedbed(ng)%bed_mass).eq.8) THEN
9585 my_piovar%dkind=pio_double
9586 iodesc => iodesc_dp_b3dvar(ng)
9587 ELSE
9588 my_piovar%dkind=pio_real
9589 iodesc => iodesc_sp_b3dvar(ng)
9590 END IF
9591!
9592 status=nf_fread3d(ng, idmod, ncname, piofile, &
9593 & vname(1,idbmas(i)), my_piovar, &
9594 & inprec, iodesc, vsize, &
9595 & lbi, ubi, lbj, ubj, 1, nbed, &
9596 & fscl, fmin, fmax, &
9597# ifdef MASKING
9598 & grid(ng) % rmask, &
9599# endif
9600# ifdef CHECKSUM
9601 & sedbed(ng) % bed_mass(:,:,:,tindex,i), &
9602 & checksum = fhash)
9603# else
9604 & sedbed(ng) % bed_mass(:,:,:,tindex,i))
9605# endif
9606 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9607 IF (master) THEN
9608 WRITE (stdout,60) string, trim(vname(1,idbmas(i))), &
9609 & inprec, trim(ncname)
9610 END IF
9611 exit_flag=2
9612 ioerror=status
9613 RETURN
9614 ELSE
9615 IF (master) THEN
9616# ifdef CHECKSUM
9617 WRITE (stdout,70) trim(vname(2,idbmas(i))), &
9618 & fmin, fmax, fhash
9619# else
9620 WRITE (stdout,70) trim(vname(2,idbmas(i))), &
9621 & fmin, fmax
9622# endif
9623
9624 END IF
9625 END IF
9626 ELSE
9627 IF (master) THEN
9628 WRITE (stdout,80) string, trim(vname(1,idbmas(i))), &
9629 & trim(ncname)
9630 END IF
9631 exit_flag=4
9632 IF (founderror(exit_flag, pio_noerr, &
9633 & __line__, myfile)) THEN
9634 RETURN
9635 END IF
9636 END IF
9637 END IF
9638 END DO
9639!
9640! Read in nonlinear sediment properties in each bed layer.
9641!
9642 DO i=1,mbedp
9643 IF (get_var(idsbed(i))) THEN
9644 foundit=find_string(var_name, n_var, &
9645 & trim(vname(1,idsbed(i))), vindex)
9646 IF (foundit) THEN
9647 my_piovar%vd=var_desc(vindex)
9648 my_piovar%gtype=b3dvar
9649 IF (kind(sedbed(ng)%bed).eq.8) THEN
9650 my_piovar%dkind=pio_double
9651 iodesc => iodesc_dp_b3dvar(ng)
9652 ELSE
9653 my_piovar%dkind=pio_real
9654 iodesc => iodesc_sp_b3dvar(ng)
9655 END IF
9656!
9657 status=nf_fread3d(ng, idmod, ncname, piofile, &
9658 & vname(1,idsbed(i)), my_piovar, &
9659 & inprec, iodesc, vsize, &
9660 & lbi, ubi, lbj, ubj, 1, nbed, &
9661 & fscl, fmin, fmax, &
9662# ifdef MASKING
9663 & grid(ng) % rmask, &
9664# endif
9665# ifdef CHECKSUM
9666 & sedbed(ng) % bed(:,:,:,i), &
9667 & checksum = fhash)
9668# else
9669 & sedbed(ng) % bed(:,:,:,i))
9670# endif
9671 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9672 IF (master) THEN
9673 WRITE (stdout,60) string, trim(vname(1,idsbed(i))), &
9674 & inprec, trim(ncname)
9675 END IF
9676 exit_flag=2
9677 ioerror=status
9678 RETURN
9679 ELSE
9680 IF (master) THEN
9681# ifdef CHECKSUM
9682 WRITE (stdout,70) trim(vname(2,idsbed(i))), &
9683 & fmin, fmax, fhash
9684# else
9685 WRITE (stdout,70) trim(vname(2,idsbed(i))), &
9686 & fmin, fmax
9687# endif
9688
9689 END IF
9690 END IF
9691 ELSE
9692 IF (master) THEN
9693 WRITE (stdout,80) string, trim(vname(1,idsbed(i))), &
9694 & trim(ncname)
9695 END IF
9696 exit_flag=4
9697 IF (founderror(exit_flag, pio_noerr, &
9698 & __line__, myfile)) THEN
9699 RETURN
9700 END IF
9701 END IF
9702 END IF
9703 END DO
9704
9705# ifdef BEDLOAD
9706!
9707! Read in nonlinear sediment fraction of bed load.
9708!
9709 DO i=1,nst
9710 IF (get_var(idubld(i))) THEN
9711 foundit=find_string(var_name, n_var, &
9712 & trim(vname(1,idubld(i))), vindex)
9713 IF (foundit) THEN
9714 my_piovar%vd=var_desc(vindex)
9715 my_piovar%gtype=u2dvar
9716 IF (kind(sedbed(ng)%bedldu).eq.8) THEN
9717 my_piovar%dkind=pio_double
9718 iodesc => iodesc_dp_u2dvar(ng)
9719 ELSE
9720 my_piovar%dkind=pio_real
9721 iodesc => iodesc_sp_u2dvar(ng)
9722 END IF
9723!
9724 status=nf_fread2d(ng, idmod, ncname, piofile, &
9725 & vname(1,idubld(i)), my_piovar, &
9726 & inprec, iodesc, vsize, &
9727 & lbi, ubi, lbj, ubj, &
9728 & fscl, fmin, fmax, &
9729# ifdef MASKING
9730 & grid(ng) % umask, &
9731# endif
9732# ifdef CHECKSUM
9733 & sedbed(ng) % bedldu(:,:,i), &
9734 & checksum = fhash)
9735# else
9736 & sedbed(ng) % bedldu(:,:,i))
9737# endif
9738 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9739 IF (master) THEN
9740 WRITE (stdout,60) string, trim(vname(1,idubld(i))), &
9741 & inprec, trim(ncname)
9742 END IF
9743 exit_flag=2
9744 ioerror=status
9745 RETURN
9746 ELSE
9747 IF (master) THEN
9748# ifdef CHECKSUM
9749 WRITE (stdout,70) trim(vname(2,idubld(i))), &
9750 & fmin, fmax, fhash
9751# else
9752 WRITE (stdout,70) trim(vname(2,idubld(i))), &
9753 & fmin, fmax
9754# endif
9755
9756 END IF
9757 END IF
9758 ELSE
9759 IF (master) THEN
9760 WRITE (stdout,80) string, trim(vname(1,idubld(i))), &
9761 & trim(ncname)
9762 END IF
9763 exit_flag=4
9764 IF (founderror(exit_flag, pio_noerr, &
9765 & __line__, myfile)) THEN
9766 RETURN
9767 END IF
9768 END IF
9769 END IF
9770!
9771 IF (get_var(idvbld(i))) THEN
9772 foundit=find_string(var_name, n_var, &
9773 & trim(vname(1,idvbld(i))), vindex)
9774 IF (foundit) THEN
9775 my_piovar%vd=var_desc(vindex)
9776 my_piovar%gtype=v2dvar
9777 IF (kind(sedbed(ng)%bedldv).eq.8) THEN
9778 my_piovar%dkind=pio_double
9779 iodesc => iodesc_dp_v2dvar(ng)
9780 ELSE
9781 my_piovar%dkind=pio_real
9782 iodesc => iodesc_sp_v2dvar(ng)
9783 END IF
9784!
9785 status=nf_fread2d(ng, idmod, ncname, piofile, &
9786 & vname(1,idvbld(i)), my_piovar, &
9787 & inprec, iodesc, vsize, &
9788 & lbi, ubi, lbj, ubj, &
9789 & fscl, fmin, fmax, &
9790# ifdef MASKING
9791 & grid(ng) % vmask, &
9792# endif
9793# ifdef CHECKSUM
9794 & sedbed(ng) % bedldv(:,:,i), &
9795 & checksum = fhash)
9796# else
9797 & sedbed(ng) % bedldv(:,:,i))
9798# endif
9799 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9800 IF (master) THEN
9801 WRITE (stdout,60) string, trim(vname(1,idvbld(i))), &
9802 & inprec, trim(ncname)
9803 END IF
9804 exit_flag=2
9805 ioerror=status
9806 RETURN
9807 ELSE
9808 IF (master) THEN
9809# ifdef CHECKSUM
9810 WRITE (stdout,70) trim(vname(2,idvbld(i))), &
9811 & fmin, fmax, fhash
9812# else
9813 WRITE (stdout,70) trim(vname(2,idvbld(i))), &
9814 & fmin, fmax
9815# endif
9816
9817 END IF
9818 END IF
9819 ELSE
9820 IF (master) THEN
9821 WRITE (stdout,80) string, trim(vname(1,idvbld(i))), &
9822 & trim(ncname)
9823 END IF
9824 exit_flag=4
9825 IF (founderror(exit_flag, pio_noerr, &
9826 & __line__, myfile)) THEN
9827 RETURN
9828 END IF
9829 END IF
9830 END IF
9831 END DO
9832# endif
9833# endif
9834
9835# if defined SEDIMENT || defined BBL_MODEL
9836!
9837! Read in nonlinear sediment properties in exposed bed layer.
9838!
9839 DO i=1,mbotp
9840 IF (get_var(idbott(i)).and.have_var(idbott(i))) THEN
9841 foundit=find_string(var_name, n_var, &
9842 & trim(vname(1,idbott(i))), vindex)
9843 IF (foundit) THEN
9844 my_piovar%vd=var_desc(vindex)
9845 my_piovar%gtype=r2dvar
9846 IF (kind(sedbed(ng)%bottom).eq.8) THEN
9847 my_piovar%dkind=pio_double
9848 iodesc => iodesc_dp_r2dvar(ng)
9849 ELSE
9850 my_piovar%dkind=pio_real
9851 iodesc => iodesc_sp_r2dvar(ng)
9852 END IF
9853!
9854 status=nf_fread2d(ng, idmod, ncname, piofile, &
9855 & vname(1,idbott(i)), my_piovar, &
9856 & inprec, iodesc, vsize, &
9857 & lbi, ubi, lbj, ubj, &
9858 & fscl, fmin, fmax, &
9859# ifdef MASKING
9860 & grid(ng) % rmask, &
9861# endif
9862# ifdef CHECKSUM
9863 & sedbed(ng) % bottom(:,:,i), &
9864 & checksum = fhash)
9865# else
9866 & sedbed(ng) % bottom(:,:,i))
9867# endif
9868 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9869 IF (master) THEN
9870 WRITE (stdout,60) string, trim(vname(1,idbott(i))), &
9871 & inprec, trim(ncname)
9872 END IF
9873 exit_flag=2
9874 ioerror=status
9875 RETURN
9876 ELSE
9877 IF (master) THEN
9878# ifdef CHECKSUM
9879 WRITE (stdout,70) trim(vname(2,idbott(i))), &
9880 & fmin, fmax, fhash
9881# else
9882 WRITE (stdout,70) trim(vname(2,idbott(i))), &
9883 & fmin, fmax
9884# endif
9885
9886 END IF
9887 END IF
9888 ELSE
9889 IF (master) THEN
9890 WRITE (stdout,80) string, trim(vname(1,idbott(i))), &
9891 & trim(ncname)
9892 END IF
9893 exit_flag=4
9894 IF (founderror(exit_flag, pio_noerr, &
9895 & __line__, myfile)) THEN
9896 RETURN
9897 END IF
9898 END IF
9899 END IF
9900 END DO
9901# endif
9902# ifdef ICE_MODEL
9903!
9904! Read sea ice model state variables.
9905!
9906 DO i=1,nices
9907 IF (isice(i).gt.0) THEN
9908 ifield=isice(i)
9909 IF (get_var(ifield)) THEN
9910 foundit=find_string(var_name, n_var, &
9911 & trim(vname(1,ifield)), vindex)
9912 IF (foundit) THEN
9913 my_piovar%vd=var_desc(vindex)
9914 SELECT CASE (i)
9915 CASE (isuice)
9916 my_piovar%gtype=u2dvar
9917 IF (kind(ice(ng)%Si).eq.8) THEN
9918 my_piovar%dkind=pio_double
9919 iodesc => iodesc_dp_u2dvar(ng)
9920 ELSE
9921 my_piovar%dkind=pio_real
9922 iodesc => iodesc_sp_u2dvar(ng)
9923 END IF
9924!
9925 status=nf_fread2d(ng, idmod, ncname, piofile, &
9926 & vname(1,ifield), my_piovar, &
9927 & inprec, iodesc, vsize, &
9928 & lbi, ubi, lbj, ubj, &
9929 & fscl, fmin, fmax, &
9930# ifdef MASKING
9931 & grid(ng) % umask, &
9932# endif
9933# ifdef CHECKSUM
9934 & ice(ng) % Si(:,:,tindex,i), &
9935 & checksum = fhash)
9936# else
9937 & ice(ng) % Si(:,:,tindex,i))
9938# endif
9939 CASE (isvice)
9940 my_piovar%gtype=v2dvar
9941 IF (kind(ice(ng)%Si).eq.8) THEN
9942 my_piovar%dkind=pio_double
9943 iodesc => iodesc_dp_v2dvar(ng)
9944 ELSE
9945 my_piovar%dkind=pio_real
9946 iodesc => iodesc_sp_v2dvar(ng)
9947 END IF
9948!
9949 status=nf_fread2d(ng, idmod, ncname, piofile, &
9950 & vname(1,ifield), my_piovar, &
9951 & inprec, iodesc, vsize, &
9952 & lbi, ubi, lbj, ubj, &
9953 & fscl, fmin, fmax, &
9954# ifdef MASKING
9955 & grid(ng) % vmask, &
9956# endif
9957# ifdef CHECKSUM
9958 & ice(ng) % Si(:,:,tindex,i), &
9959 & checksum = fhash)
9960# else
9961 & ice(ng) % Si(:,:,tindex,i))
9962# endif
9963 CASE DEFAULT
9964 my_piovar%gtype=r2dvar
9965 IF (kind(ice(ng)%Si).eq.8) THEN
9966 my_piovar%dkind=pio_double
9967 iodesc => iodesc_dp_r2dvar(ng)
9968 ELSE
9969 my_piovar%dkind=pio_real
9970 iodesc => iodesc_sp_r2dvar(ng)
9971 END IF
9972!
9973 status=nf_fread2d(ng, idmod, ncname, piofile, &
9974 & vname(1,ifield), my_piovar, &
9975 & inprec, iodesc, vsize, &
9976 & lbi, ubi, lbj, ubj, &
9977 & fscl, fmin, fmax, &
9978# ifdef MASKING
9979 & grid(ng) % rmask, &
9980# endif
9981# ifdef CHECKSUM
9982 & ice(ng) % Si(:,:,tindex,i), &
9983 & checksum = fhash)
9984# else
9985 & ice(ng) % Si(:,:,tindex,i))
9986# endif
9987 END SELECT
9988!
9989 IF (founderror(status, pio_noerr, &
9990 & __line__, myfile)) THEN
9991 IF (master) THEN
9992 WRITE (stdout,60) string, trim(vname(1,ifield)), &
9993 & inprec, trim(ncname)
9994 END IF
9995 exit_flag=2
9996 ioerror=status
9997 RETURN
9998 ELSE
9999 IF (master) THEN
10000# ifdef CHECKSUM
10001 WRITE (stdout,70) trim(vname(2,ifield)), &
10002 & fmin, fmax, fhash
10003# else
10004 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
10005# endif
10006 END IF
10007 END IF
10008 END IF
10009 ELSE
10010 IF (master) THEN
10011 WRITE (stdout,80) string, trim(vname(1,ifield)), &
10012 & trim(ncname)
10013 END IF
10014 exit_flag=4
10015 IF (founderror(exit_flag, pio_noerr, &
10016 & __line__, myfile)) THEN
10017 RETURN
10018 END IF
10019 END IF
10020 END IF
10021 END DO
10022# endif
10023# endif
10024 END IF nlm_state
10025# endif
10026
10027# if defined TANGENT || defined TL_IOMS
10028!
10029!-----------------------------------------------------------------------
10030! Read in tangent linear state variables.
10031!-----------------------------------------------------------------------
10032!
10033 tlm_state: IF ((model.eq.itlm).or.(model.eq.irpm)) THEN
10034
10035# if defined ADJUST_BOUNDARY || \
10036 defined adjust_wstress || defined adjust_stflux
10037 IF (inner.eq.0.and.model.eq.irpm) THEN
10038 get_adjust=.false.
10039 ELSE
10040 get_adjust=.true.
10041 END IF
10042# endif
10043!
10044! Read in tangent linear free-surface (m).
10045!
10046 IF (get_var(idfsur)) THEN
10047 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
10048 & vindex)
10049 IF (foundit) THEN
10050 my_piovar%vd=var_desc(vindex)
10051 my_piovar%gtype=r2dvar
10052 IF (kind(ocean(ng)%tl_zeta).eq.8) THEN
10053 my_piovar%dkind=pio_double
10054 iodesc => iodesc_dp_r2dvar(ng)
10055 ELSE
10056 my_piovar%dkind=pio_real
10057 iodesc => iodesc_sp_r2dvar(ng)
10058 END IF
10059!
10060 status=nf_fread2d(ng, idmod, ncname, piofile, &
10061 & vname(1,idfsur), my_piovar, &
10062 & inprec, iodesc, vsize, &
10063 & lbi, ubi, lbj, ubj, &
10064 & fscl, fmin, fmax, &
10065# ifdef MASKING
10066 & grid(ng) % rmask, &
10067# endif
10068# ifdef CHECKSUM
10069 & ocean(ng) % tl_zeta(:,:,tindex), &
10070 & checksum = fhash)
10071# else
10072 & ocean(ng) % tl_zeta(:,:,tindex))
10073# endif
10074 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10075 IF (master) THEN
10076 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
10077 & inprec, trim(ncname)
10078 END IF
10079 exit_flag=2
10080 ioerror=status
10081 RETURN
10082 ELSE
10083 IF (master) THEN
10084# ifdef CHECKSUM
10085 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
10086 & fhash
10087# else
10088 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
10089# endif
10090 END IF
10091 END IF
10092 ELSE
10093 IF (master) THEN
10094 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
10095 & trim(ncname)
10096 END IF
10097 exit_flag=4
10098 IF (founderror(exit_flag, pio_noerr, &
10099 & __line__, myfile)) THEN
10100 RETURN
10101 END IF
10102 END IF
10103 END IF
10104
10105# ifdef ADJUST_BOUNDARY
10106!
10107! Read in free-surface open boundaries adjustments.
10108!
10109 IF (get_var(idsbry(isfsur)).and.get_adjust.and. &
10110 & any(lobc(:,isfsur,ng))) THEN
10111 ifield=idsbry(isfsur)
10112 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
10113 & vindex)
10114 IF (foundit) THEN
10115 my_piovar%vd=var_desc(vindex)
10116 my_piovar%gtype=r2dobc
10117 IF (kind(boundary(ng)%tl_zeta_obc).eq.8) THEN
10118 my_piovar%dkind=pio_double
10119 iodesc => iodesc_dp_r2dobc(ng)
10120 ELSE
10121 my_piovar%dkind=pio_real
10122 iodesc => iodesc_sp_r2dobc(ng)
10123 END IF
10124!
10125 status=nf_fread2d_bry(ng, idmod, ncname, piofile, &
10126 & vname(1,ifield), my_piovar, &
10127 & inprec, iodesc, &
10128 & lbij, ubij, nbrec(ng), &
10129 & fscl, fmin, fmax, &
10130# ifdef CHECKSUM
10131 & boundary(ng) % tl_zeta_obc(:,:,:, &
10132 & tindex), &
10133 & checksum = fhash)
10134# else
10135 & boundary(ng) % tl_zeta_obc(:,:,:, &
10136 & tindex))
10137# endif
10138 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10139 IF (master) THEN
10140 WRITE (stdout,60) string, trim(vname(1,ifield)), &
10141 & inprec, trim(ncname)
10142 END IF
10143 exit_flag=2
10144 ioerror=status
10145 RETURN
10146 ELSE
10147 IF (master) THEN
10148# ifdef CHECKSUM
10149 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
10150 & fhash
10151# else
10152 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
10153# endif
10154 END IF
10155 END IF
10156 ELSE
10157 IF (master) THEN
10158 WRITE (stdout,80) string, trim(vname(1,ifield)), &
10159 & trim(ncname)
10160 END IF
10161 exit_flag=4
10162 IF (founderror(exit_flag, pio_noerr, &
10163 & __line__, myfile)) THEN
10164 RETURN
10165 END IF
10166 END IF
10167 END IF
10168# endif
10169!
10170! Read in tangent linear 2D U-momentum component (m/s).
10171!
10172 IF (get_var(idubar)) THEN
10173 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
10174 & vindex)
10175 IF (foundit) THEN
10176 my_piovar%vd=var_desc(vindex)
10177 my_piovar%gtype=u2dvar
10178 IF (kind(ocean(ng)%tl_ubar).eq.8) THEN
10179 my_piovar%dkind=pio_double
10180 iodesc => iodesc_dp_u2dvar(ng)
10181 ELSE
10182 my_piovar%dkind=pio_real
10183 iodesc => iodesc_sp_u2dvar(ng)
10184 END IF
10185!
10186 status=nf_fread2d(ng, idmod, ncname, piofile, &
10187 & vname(1,idubar), my_piovar, &
10188 & inprec, iodesc, vsize, &
10189 & lbi, ubi, lbj, ubj, &
10190 & fscl, fmin, fmax, &
10191# ifdef MASKING
10192 & grid(ng) % umask, &
10193# endif
10194# ifdef CHECKSUM
10195 & ocean(ng) % tl_ubar(:,:,tindex), &
10196 & checksum = fhash)
10197# else
10198 & ocean(ng) % tl_ubar(:,:,tindex))
10199# endif
10200 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10201 IF (master) THEN
10202 WRITE (stdout,60) string, trim(vname(1,idubar)), &
10203 & inprec, trim(ncname)
10204 END IF
10205 exit_flag=2
10206 ioerror=status
10207 RETURN
10208 ELSE
10209 IF (master) THEN
10210# ifdef CHECKSUM
10211 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
10212 & fhash
10213# else
10214 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
10215# endif
10216 END IF
10217 END IF
10218 ELSE
10219 IF (master) THEN
10220 WRITE (stdout,80) string, trim(vname(1,idubar)), &
10221 & trim(ncname)
10222 END IF
10223 exit_flag=4
10224 IF (founderror(exit_flag, pio_noerr, &
10225 & __line__, myfile)) THEN
10226 RETURN
10227 END IF
10228 END IF
10229 END IF
10230
10231# ifdef ADJUST_BOUNDARY
10232!
10233! Read in 2D U-momentum component open boundaries adjustments.
10234!
10235 IF (get_var(idsbry(isubar)).and.get_adjust.and. &
10236 & any(lobc(:,isubar,ng))) THEN
10237 ifield=idsbry(isubar)
10238 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
10239 & vindex)
10240 IF (foundit) THEN
10241 my_piovar%vd=var_desc(vindex)
10242 my_piovar%gtype=u2dobc
10243 IF (kind(boundary(ng)%tl_ubar_obc).eq.8) THEN
10244 my_piovar%dkind=pio_double
10245 iodesc => iodesc_dp_u2dobc(ng)
10246 ELSE
10247 my_piovar%dkind=pio_real
10248 iodesc => iodesc_sp_u2dobc(ng)
10249 END IF
10250!
10251 status=nf_fread2d_bry(ng, idmod, ncname, piofile, &
10252 & vname(1,ifield), my_piovar, &
10253 & inprec, iodesc, &
10254 & lbij, ubij, nbrec(ng), &
10255 & fscl, fmin, fmax, &
10256# ifdef CHECKSUM
10257 & boundary(ng) % tl_ubar_obc(:,:,:, &
10258 & tindex), &
10259 & checksum = fhash)
10260# else
10261 & boundary(ng) % tl_ubar_obc(:,:,:, &
10262 & tindex))
10263# endif
10264 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10265 IF (master) THEN
10266 WRITE (stdout,60) string, trim(vname(1,ifield)), &
10267 & inprec, trim(ncname)
10268 END IF
10269 exit_flag=2
10270 ioerror=status
10271 RETURN
10272 ELSE
10273 IF (master) THEN
10274# ifdef CHECKSUM
10275 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
10276 & fhash
10277# else
10278 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
10279# endif
10280 END IF
10281 END IF
10282 ELSE
10283 IF (master) THEN
10284 WRITE (stdout,80) string, trim(vname(1,ifield)), &
10285 & trim(ncname)
10286 END IF
10287 exit_flag=4
10288 IF (founderror(exit_flag, pio_noerr, &
10289 & __line__, myfile)) THEN
10290 RETURN
10291 END IF
10292 END IF
10293 END IF
10294# endif
10295!
10296! Read in tangent linear 2D V-momentum component.
10297!
10298 IF (get_var(idvbar)) THEN
10299 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
10300 & vindex)
10301 IF (foundit) THEN
10302 my_piovar%vd=var_desc(vindex)
10303 my_piovar%gtype=v2dvar
10304 IF (kind(ocean(ng)%tl_vbar).eq.8) THEN
10305 my_piovar%dkind=pio_double
10306 iodesc => iodesc_dp_v2dvar(ng)
10307 ELSE
10308 my_piovar%dkind=pio_real
10309 iodesc => iodesc_sp_v2dvar(ng)
10310 END IF
10311!
10312 status=nf_fread2d(ng, idmod, ncname, piofile, &
10313 & vname(1,idvbar), my_piovar, &
10314 & inprec, iodesc, vsize, &
10315 & lbi, ubi, lbj, ubj, &
10316 & fscl, fmin, fmax, &
10317# ifdef MASKING
10318 & grid(ng) % vmask, &
10319# endif
10320# ifdef CHECKSUM
10321 & ocean(ng) % tl_vbar(:,:,tindex), &
10322 & checksum = fhash)
10323# else
10324 & ocean(ng) % tl_vbar(:,:,tindex))
10325# endif
10326 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10327 IF (master) THEN
10328 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
10329 & inprec, trim(ncname)
10330 END IF
10331 exit_flag=2
10332 ioerror=status
10333 RETURN
10334 ELSE
10335 IF (master) THEN
10336# ifdef CHECKSUM
10337 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
10338 & fhash
10339# else
10340 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
10341# endif
10342 END IF
10343 END IF
10344 ELSE
10345 IF (master) THEN
10346 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
10347 & trim(ncname)
10348 END IF
10349 exit_flag=4
10350 IF (founderror(exit_flag, pio_noerr, &
10351 & __line__, myfile)) THEN
10352 RETURN
10353 END IF
10354 END IF
10355 END IF
10356
10357# ifdef ADJUST_BOUNDARY
10358!
10359! Read in 2D V-momentum component open boundaries adjustments.
10360!
10361 IF (get_var(idsbry(isvbar)).and.get_adjust.and. &
10362 & any(lobc(:,isvbar,ng))) THEN
10363 ifield=idsbry(isvbar)
10364 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
10365 & vindex)
10366 IF (foundit) THEN
10367 my_piovar%vd=var_desc(vindex)
10368 my_piovar%gtype=v2dobc
10369 IF (kind(boundary(ng)%tl_vbar_obc).eq.8) THEN
10370 my_piovar%dkind=pio_double
10371 iodesc => iodesc_dp_v2dobc(ng)
10372 ELSE
10373 my_piovar%dkind=pio_real
10374 iodesc => iodesc_sp_v2dobc(ng)
10375 END IF
10376!
10377 status=nf_fread2d_bry(ng, idmod, ncname, piofile, &
10378 & vname(1,ifield), my_piovar, &
10379 & inprec, iodesc, &
10380 & lbij, ubij, nbrec(ng), &
10381 & fscl, fmin, fmax, &
10382# ifdef CHECKSUM
10383 & boundary(ng) % tl_vbar_obc(:,:,:, &
10384 & tindex), &
10385 & checksum = fhash)
10386# else
10387 & boundary(ng) % tl_vbar_obc(:,:,:, &
10388 & tindex))
10389# endif
10390 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10391 IF (master) THEN
10392 WRITE (stdout,60) string, trim(vname(1,ifield)), &
10393 & inprec, trim(ncname)
10394 END IF
10395 exit_flag=2
10396 ioerror=status
10397 RETURN
10398 ELSE
10399 IF (master) THEN
10400# ifdef CHECKSUM
10401 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
10402 & fhash
10403# else
10404 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
10405# endif
10406 END IF
10407 END IF
10408 ELSE
10409 IF (master) THEN
10410 WRITE (stdout,80) string, trim(vname(1,ifield)), &
10411 & trim(ncname)
10412 END IF
10413 exit_flag=4
10414 IF (founderror(exit_flag, pio_noerr, &
10415 & __line__, myfile)) THEN
10416 RETURN
10417 END IF
10418 END IF
10419 END IF
10420# endif
10421# ifdef ADJUST_WSTRESS
10422!
10423! Read in tangent linear surface U-momentum stress.
10424!
10425 IF (get_var(idusms).and.get_adjust) THEN
10426 foundit=find_string(var_name, n_var, trim(vname(1,idusms)), &
10427 & vindex)
10428 IF (foundit) THEN
10429 scale=1.0_dp
10430 my_piovar%vd=var_desc(vindex)
10431 my_piovar%gtype=u2dvar
10432 IF (kind(forces(ng)%tl_ustr).eq.8) THEN
10433 my_piovar%dkind=pio_double
10434 iodesc => iodesc_dp_u2dfrc(ng)
10435 ELSE
10436 my_piovar%dkind=pio_real
10437 iodesc => iodesc_sp_u2dfrc(ng)
10438 END IF
10439!
10440 status=nf_fread3d(ng, idmod, ncname, piofile, &
10441 & vname(1,idusms), my_piovar, &
10442 & inprec, iodesc, vsize, &
10443 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
10444 & scale, fmin, fmax, &
10445# ifdef MASKING
10446 & grid(ng) % umask, &
10447# endif
10448# ifdef CHECKSUM
10449 & forces(ng) % tl_ustr(:,:,:,tindex), &
10450 & checksum = fhash)
10451# else
10452 & forces(ng) % tl_ustr(:,:,:,tindex))
10453# endif
10454 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10455 IF (master) THEN
10456 WRITE (stdout,60) string, trim(vname(1,idusms)), &
10457 & inprec, trim(ncname)
10458 END IF
10459 exit_flag=2
10460 ioerror=status
10461 RETURN
10462 ELSE
10463 IF (master) THEN
10464# ifdef CHECKSUM
10465 WRITE (stdout,70) trim(vname(2,idusms))// &
10466 & ', adjusted tl_ustr', fmin, fmax, &
10467 & fhash
10468# else
10469 WRITE (stdout,70) trim(vname(2,idusms))// &
10470 & ', adjusted tl_ustr', fmin, fmax
10471# endif
10472 END IF
10473 END IF
10474 ELSE
10475 IF (master) THEN
10476 WRITE (stdout,80) string, trim(vname(1,idusms)), &
10477 & trim(ncname)
10478 END IF
10479 exit_flag=4
10480 IF (founderror(exit_flag, pio_noerr, &
10481 & __line__, myfile)) THEN
10482 RETURN
10483 END IF
10484 END IF
10485 END IF
10486!
10487! Read in tangent linear surface V-momentum stress.
10488!
10489 IF (get_var(idvsms).and.get_adjust) THEN
10490 foundit=find_string(var_name, n_var, trim(vname(1,idvsms)), &
10491 & vindex)
10492 IF (foundit) THEN
10493 scale=1.0_dp
10494 my_piovar%vd=var_desc(vindex)
10495 my_piovar%gtype=v2dvar
10496 IF (kind(forces(ng)%tl_vstr).eq.8) THEN
10497 my_piovar%dkind=pio_double
10498 iodesc => iodesc_dp_v2dfrc(ng)
10499 ELSE
10500 my_piovar%dkind=pio_real
10501 iodesc => iodesc_sp_v2dfrc(ng)
10502 END IF
10503!
10504 status=nf_fread3d(ng, idmod, ncname, piofile, &
10505 & vname(1,idvsms), my_piovar, &
10506 & inprec, iodesc, vsize, &
10507 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
10508 & scale, fmin, fmax, &
10509# ifdef MASKING
10510 & grid(ng) % vmask, &
10511# endif
10512# ifdef CHECKSUM
10513 & forces(ng) % tl_vstr(:,:,:,tindex), &
10514 & checksum = fhash)
10515# else
10516 & forces(ng) % tl_vstr(:,:,:,tindex))
10517# endif
10518 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10519 IF (master) THEN
10520 WRITE (stdout,60) string, trim(vname(1,idvsms)), &
10521 & inprec, trim(ncname)
10522 END IF
10523 exit_flag=2
10524 ioerror=status
10525 RETURN
10526 ELSE
10527 IF (master) THEN
10528# ifdef CHECKSUM
10529 WRITE (stdout,70) trim(vname(2,idvsms))// &
10530 & ', adjusted tl_vstr', fmin, fmax, &
10531 & fhash
10532# else
10533 WRITE (stdout,70) trim(vname(2,idvsms))// &
10534 & ', adjusted tl_vstr', fmin, fmax
10535# endif
10536 END IF
10537 END IF
10538 ELSE
10539 IF (master) THEN
10540 WRITE (stdout,80) string, trim(vname(1,idvsms)), &
10541 & trim(ncname)
10542 END IF
10543 exit_flag=4
10544 IF (founderror(exit_flag, pio_noerr, &
10545 & __line__, myfile)) THEN
10546 RETURN
10547 END IF
10548 END IF
10549 END IF
10550# endif
10551# ifdef SOLVE3D
10552!
10553! Read in tangent linear 3D U-momentum component.
10554
10555!
10556 IF (get_var(iduvel)) THEN
10557 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
10558 & vindex)
10559 IF (foundit) THEN
10560 my_piovar%vd=var_desc(vindex)
10561 my_piovar%gtype=u3dvar
10562 IF (kind(ocean(ng)%tl_u).eq.8) THEN
10563 my_piovar%dkind=pio_double
10564 iodesc => iodesc_dp_u3dvar(ng)
10565 ELSE
10566 my_piovar%dkind=pio_real
10567 iodesc => iodesc_sp_u3dvar(ng)
10568 END IF
10569!
10570 status=nf_fread3d(ng, idmod, ncname, piofile, &
10571 & vname(1,iduvel), my_piovar, &
10572 & inprec, iodesc, vsize, &
10573 & lbi, ubi, lbj, ubj, 1, n(ng), &
10574 & fscl, fmin, fmax, &
10575# ifdef MASKING
10576 & grid(ng) % umask, &
10577# endif
10578# ifdef CHECKSUM
10579 & ocean(ng) % tl_u(:,:,:,tindex), &
10580 & checksum = fhash)
10581# else
10582 & ocean(ng) % tl_u(:,:,:,tindex))
10583# endif
10584 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10585 IF (master) THEN
10586 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
10587 & inprec, trim(ncname)
10588 END IF
10589 exit_flag=2
10590 ioerror=status
10591 RETURN
10592 ELSE
10593 IF (master) THEN
10594# ifdef CHECKSUM
10595 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
10596 & fhash
10597# else
10598 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
10599# endif
10600 END IF
10601 END IF
10602 ELSE
10603 IF (master) THEN
10604 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
10605 & trim(ncname)
10606 END IF
10607 exit_flag=4
10608 IF (founderror(exit_flag, pio_noerr, &
10609 & __line__, myfile)) THEN
10610 RETURN
10611 END IF
10612 END IF
10613 END IF
10614
10615# ifdef ADJUST_BOUNDARY
10616!
10617! Read in 3D U-momentum component open boundaries adjustments.
10618!
10619 IF (get_var(idsbry(isuvel)).and.get_adjust.and. &
10620 & any(lobc(:,isuvel,ng))) THEN
10621 ifield=idsbry(isuvel)
10622 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
10623 & vindex)
10624 IF (foundit) THEN
10625 my_piovar%vd=var_desc(vindex)
10626 my_piovar%gtype=u3dobc
10627 IF (kind(boundary(ng)%tl_u_obc).eq.8) THEN
10628 my_piovar%dkind=pio_double
10629 iodesc => iodesc_dp_u3dobc(ng)
10630 ELSE
10631 my_piovar%dkind=pio_real
10632 iodesc => iodesc_sp_u3dobc(ng)
10633 END IF
10634!
10635 status=nf_fread3d_bry(ng, idmod, ncname, piofile, &
10636 & vname(1,ifield), my_piovar, &
10637 & inprec, iodesc, &
10638 & lbij, ubij, 1, n(ng), nbrec(ng), &
10639 & fscl, fmin, fmax, &
10640# ifdef CHECKSUM
10641 & boundary(ng) % tl_u_obc(:,:,:,:, &
10642 & tindex), &
10643 & checksum = fhash)
10644# else
10645 & boundary(ng) % tl_u_obc(:,:,:,:, &
10646 & tindex))
10647# endif
10648 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10649 IF (master) THEN
10650 WRITE (stdout,60) string, trim(vname(1,ifield)), &
10651 & inprec, trim(ncname)
10652 END IF
10653 exit_flag=2
10654 ioerror=status
10655 RETURN
10656 ELSE
10657 IF (master) THEN
10658# ifdef CHECKSUM
10659 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
10660 & fhash
10661# else
10662 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
10663# endif
10664 END IF
10665 END IF
10666 ELSE
10667 IF (master) THEN
10668 WRITE (stdout,80) string, trim(vname(1,ifield)), &
10669 & trim(ncname)
10670 END IF
10671 exit_flag=4
10672 IF (founderror(exit_flag, pio_noerr, &
10673 & __line__, myfile)) THEN
10674 RETURN
10675 END IF
10676 END IF
10677 END IF
10678# endif
10679!
10680! Read in tangent linear 3D V-momentum component.
10681!
10682 IF (get_var(idvvel)) THEN
10683 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
10684 & vindex)
10685 IF (foundit) THEN
10686 my_piovar%vd=var_desc(vindex)
10687 my_piovar%gtype=v3dvar
10688 IF (kind(ocean(ng)%tl_v).eq.8) THEN
10689 my_piovar%dkind=pio_double
10690 iodesc => iodesc_dp_v3dvar(ng)
10691 ELSE
10692 my_piovar%dkind=pio_real
10693 iodesc => iodesc_sp_v3dvar(ng)
10694 END IF
10695!
10696 status=nf_fread3d(ng, idmod, ncname, piofile, &
10697 & vname(1,idvvel), my_piovar, &
10698 & inprec, iodesc, vsize, &
10699 & lbi, ubi, lbj, ubj, 1, n(ng), &
10700 & fscl, fmin, fmax, &
10701# ifdef MASKING
10702 & grid(ng) % vmask, &
10703# endif
10704# ifdef CHECKSUM
10705 & ocean(ng) % tl_v(:,:,:,tindex), &
10706 & checksum = fhash)
10707# else
10708 & ocean(ng) % tl_v(:,:,:,tindex))
10709# endif
10710 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10711 IF (master) THEN
10712 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
10713 & inprec, trim(ncname)
10714 END IF
10715 exit_flag=2
10716 ioerror=status
10717 RETURN
10718 ELSE
10719 IF (master) THEN
10720# ifdef CHECKSUM
10721 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
10722 & fhash
10723# else
10724 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
10725# endif
10726 END IF
10727 END IF
10728 ELSE
10729 IF (master) THEN
10730 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
10731 & trim(ncname)
10732 END IF
10733 exit_flag=4
10734 IF (founderror(exit_flag, pio_noerr, &
10735 & __line__, myfile)) THEN
10736 RETURN
10737 END IF
10738 END IF
10739 END IF
10740
10741# ifdef ADJUST_BOUNDARY
10742!
10743! Read in 3D V-momentum component open boundaries adjustments.
10744!
10745 IF (get_var(idsbry(isvvel)).and.get_adjust.and. &
10746 & any(lobc(:,isvvel,ng))) THEN
10747 ifield=idsbry(isvvel)
10748 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
10749 & vindex)
10750 IF (foundit) THEN
10751 my_piovar%vd=var_desc(vindex)
10752 my_piovar%gtype=v3dobc
10753 IF (kind(boundary(ng)%tl_v_obc).eq.8) THEN
10754 my_piovar%dkind=pio_double
10755 iodesc => iodesc_dp_v3dobc(ng)
10756 ELSE
10757 my_piovar%dkind=pio_real
10758 iodesc => iodesc_sp_v3dobc(ng)
10759 END IF
10760!
10761 status=nf_fread3d_bry(ng, idmod, ncname, piofile, &
10762 & vname(1,ifield), my_piovar, &
10763 & inprec, iodesc, &
10764 & lbij, ubij, 1, n(ng), nbrec(ng), &
10765 & fscl, fmin, fmax, &
10766# ifdef CHECKSUM
10767 & boundary(ng) % tl_v_obc(:,:,:,:, &
10768 & tindex), &
10769 & checksum = fhash)
10770# else
10771 & boundary(ng) % tl_v_obc(:,:,:,:, &
10772 & tindex))
10773# endif
10774 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10775 IF (master) THEN
10776 WRITE (stdout,60) string, trim(vname(1,ifield)), &
10777 & inprec, trim(ncname)
10778 END IF
10779 exit_flag=2
10780 ioerror=status
10781 RETURN
10782 ELSE
10783 IF (master) THEN
10784# ifdef CHECKSUM
10785 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
10786 & fhash
10787# else
10788 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
10789# endif
10790 END IF
10791 END IF
10792 ELSE
10793 IF (master) THEN
10794 WRITE (stdout,80) string, trim(vname(1,ifield)), &
10795 & trim(ncname)
10796 END IF
10797 exit_flag=4
10798 IF (founderror(exit_flag, pio_noerr, &
10799 & __line__, myfile)) THEN
10800 RETURN
10801 END IF
10802 END IF
10803 END IF
10804# endif
10805!
10806! Read in tangent linear tracer type variables.
10807!
10808 DO itrc=1,nt(ng)
10809 IF (get_var(idtvar(itrc))) THEN
10810 foundit=find_string(var_name, n_var, &
10811 & trim(vname(1,idtvar(itrc))), vindex)
10812 IF (foundit) THEN
10813 my_piovar%vd=var_desc(vindex)
10814 my_piovar%gtype=r3dvar
10815 IF (kind(ocean(ng)%tl_t).eq.8) THEN
10816 my_piovar%dkind=pio_double
10817 iodesc => iodesc_dp_r3dvar(ng)
10818 ELSE
10819 my_piovar%dkind=pio_real
10820 iodesc => iodesc_sp_r3dvar(ng)
10821 END IF
10822!
10823 status=nf_fread3d(ng, idmod, ncname, piofile, &
10824 & vname(1,idtvar(itrc)), my_piovar, &
10825 & inprec, iodesc, vsize, &
10826 & lbi, ubi, lbj, ubj, 1, n(ng), &
10827 & fscl, fmin, fmax, &
10828# ifdef MASKING
10829 & grid(ng) % rmask, &
10830# endif
10831# ifdef CHECKSUM
10832 & ocean(ng) % tl_t(:,:,:,tindex,itrc), &
10833 & checksum = fhash)
10834# else
10835 & ocean(ng) % tl_t(:,:,:,tindex,itrc))
10836# endif
10837 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10838 IF (master) THEN
10839 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
10840 & inprec, trim(ncname)
10841 END IF
10842 exit_flag=2
10843 ioerror=status
10844 RETURN
10845 ELSE
10846 IF (master) THEN
10847# ifdef CHECKSUM
10848 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
10849 & fmin, fmax, fhash
10850# else
10851 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
10852 & fmin, fmax
10853# endif
10854 END IF
10855 END IF
10856 ELSE
10857 IF (master) THEN
10858 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
10859 & trim(ncname)
10860 END IF
10861 exit_flag=4
10862 IF (founderror(exit_flag, pio_noerr, &
10863 & __line__, myfile)) THEN
10864 RETURN
10865 END IF
10866 END IF
10867 END IF
10868 END DO
10869
10870# ifdef ADJUST_BOUNDARY
10871!
10872! Read in 3D tracers open boundaries adjustments.
10873!
10874 DO itrc=1,nt(ng)
10875 IF (get_var(idsbry(istvar(itrc))).and.get_adjust.and. &
10876 & any(lobc(:,istvar(itrc),ng))) THEN
10877 ifield=idsbry(istvar(itrc))
10878 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
10879 & vindex)
10880 IF (foundit) THEN
10881 my_piovar%vd=var_desc(vindex)
10882 my_piovar%gtype=r3dobc
10883 IF (kind(boundary(ng)%tl_t_obc).eq.8) THEN
10884 my_piovar%dkind=pio_double
10885 iodesc => iodesc_dp_r3dobc(ng)
10886 ELSE
10887 my_piovar%dkind=pio_real
10888 iodesc => iodesc_sp_r3dobc(ng)
10889 END IF
10890!
10891 status=nf_fread3d_bry(ng, idmod, ncname, piofile, &
10892 & vname(1,ifield), my_piovar, &
10893 & inprec, iodesc, &
10894 & lbij, ubij, 1, n(ng), nbrec(ng), &
10895 & fscl, fmin, fmax, &
10896# ifdef CHECKSUM
10897 & boundary(ng) % tl_t_obc(:,:,:,:, &
10898 & tindex,itrc), &
10899 & checksum = fhash)
10900# else
10901 & boundary(ng) % tl_t_obc(:,:,:,:, &
10902 & tindex,itrc))
10903# endif
10904 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10905 IF (master) THEN
10906 WRITE (stdout,60) string, trim(vname(1,ifield)), &
10907 & inprec, trim(ncname)
10908 END IF
10909 exit_flag=2
10910 ioerror=status
10911 RETURN
10912 ELSE
10913 IF (master) THEN
10914# ifdef CHECKSUM
10915 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
10916 & fhash
10917# else
10918 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
10919# endif
10920 END IF
10921 END IF
10922 ELSE
10923 IF (master) THEN
10924 WRITE (stdout,80) string, trim(vname(1,ifield)), &
10925 & trim(ncname)
10926 END IF
10927 exit_flag=4
10928 IF (founderror(exit_flag, pio_noerr, &
10929 & __line__, myfile)) THEN
10930 RETURN
10931 END IF
10932 END IF
10933 END IF
10934 END DO
10935# endif
10936# ifdef ADJUST_STFLUX
10937!
10938! Read in tangent linear surface tracers flux.
10939!
10940 DO itrc=1,nt(ng)
10941 IF (get_var(idtsur(itrc)).and.get_adjust.and. &
10942 & lstflux(itrc,ng)) THEN
10943 foundit=find_string(var_name, n_var, &
10944 & trim(vname(1,idtsur(itrc))), vindex)
10945 IF (foundit) THEN
10946 scale=1.0_dp
10947 my_piovar%vd=var_desc(vindex)
10948 my_piovar%gtype=r2dvar
10949 IF (kind(forces(ng)%tl_tflux).eq.8) THEN
10950 my_piovar%dkind=pio_double
10951 iodesc => iodesc_dp_r2dfrc(ng)
10952 ELSE
10953 my_piovar%dkind=pio_real
10954 iodesc => iodesc_sp_r2dfrc(ng)
10955 END IF
10956!
10957 status=nf_fread3d(ng, idmod, ncname, piofile, &
10958 & vname(1,idtsur(itrc)), my_piovar, &
10959 & inprec, iodesc, vsize, &
10960 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
10961 & scale, fmin, fmax, &
10962# ifdef MASKING
10963 & grid(ng) % rmask, &
10964# endif
10965# ifdef CHECKSUM
10966 & forces(ng)% tl_tflux(:,:,:, &
10967 & tindex,itrc), &
10968 & checksum = fhash)
10969# else
10970 & forces(ng)% tl_tflux(:,:,:, &
10971 & tindex,itrc))
10972# endif
10973 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
10974 IF (master) THEN
10975 WRITE (stdout,60) string, trim(vname(1,idtsur(itrc))),&
10976 & inprec, trim(ncname)
10977 END IF
10978 exit_flag=2
10979 ioerror=status
10980 RETURN
10981 ELSE
10982 IF (master) THEN
10983# ifdef CHECKSUM
10984 WRITE (stdout,70) trim(vname(2,idtsur(itrc)))// &
10985 & ', adjusted tl_tflux', fmin, fmax, &
10986 & fhash
10987# else
10988 WRITE (stdout,70) trim(vname(2,idtsur(itrc)))// &
10989 & ', adjusted tl_tflux', fmin, fmax
10990# endif
10991 END IF
10992 END IF
10993 ELSE
10994 IF (master) THEN
10995 WRITE (stdout,80) string, trim(vname(1,idtsur(itrc))), &
10996 & trim(ncname)
10997 END IF
10998 exit_flag=4
10999 IF (founderror(exit_flag, pio_noerr, &
11000 & __line__, myfile)) THEN
11001 RETURN
11002 END IF
11003 END IF
11004 END IF
11005 END DO
11006# endif
11007# ifdef SEDIMENT
11008!
11009! Read in tangent linear sediment fraction of each size class in each
11010! bed layer.
11011!
11012 DO i=1,nst
11013 IF (get_var(idfrac(i))) THEN
11014 foundit=find_string(var_name, n_var, &
11015 & trim(vname(1,idfrac(i))), vindex)
11016 IF (foundit) THEN
11017 my_piovar%vd=var_desc(vindex)
11018 my_piovar%gtype=b3dvar
11019 IF (kind(ocean(ng)%tl_bed_frac).eq.8) THEN
11020 my_piovar%dkind=pio_double
11021 iodesc => iodesc_dp_b3dvar(ng)
11022 ELSE
11023 my_piovar%dkind=pio_real
11024 iodesc => iodesc_sp_b3dvar(ng)
11025 END IF
11026!
11027 status=nf_fread3d(ng, idmod, ncname, piofile, &
11028 & vname(1,idfrac(i)), my_piovar, &
11029 & inprec, iodesc, vsize, &
11030 & lbi, ubi, lbj, ubj, 1, nbed, &
11031 & fscl, fmin, fmax, &
11032# ifdef MASKING
11033 & grid(ng) % rmask, &
11034# endif
11035# ifdef CHECKSUM
11036 & sedbed(ng) % tl_bed_frac(:,:,:,i), &
11037 & checksum = fhash)
11038# else
11039 & sedbed(ng) % tl_bed_frac(:,:,:,i))
11040# endif
11041 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11042 IF (master) THEN
11043 WRITE (stdout,60) string, trim(vname(1,idfrac(i))), &
11044 & inprec, trim(ncname)
11045 END IF
11046 exit_flag=2
11047 ioerror=status
11048 RETURN
11049 ELSE
11050 IF (master) THEN
11051# ifdef CHECKSUM
11052 WRITE (stdout,70) trim(vname(2,idfrac(i))), &
11053 & fmin, fmax, fhash
11054# else
11055 WRITE (stdout,70) trim(vname(2,idfrac(i))), &
11056 & fmin, fmax
11057# endif
11058 END IF
11059 END IF
11060 ELSE
11061 IF (master) THEN
11062 WRITE (stdout,80) string, trim(vname(1,idfrac(i))), &
11063 & trim(ncname)
11064 END IF
11065 exit_flag=4
11066 IF (founderror(exit_flag, pio_noerr, &
11067 & __line__, myfile)) THEN
11068 RETURN
11069 END IF
11070 END IF
11071 END IF
11072!
11073! Read in tangent linear sediment mass of each size class in each
11074! bed layer.
11075!
11076 IF (get_var(idbmas(i))) THEN
11077 foundit=find_string(var_name, n_var, &
11078 & trim(vname(1,idbmas(i))), vindex)
11079 IF (foundit) THEN
11080 my_piovar%vd=var_desc(vindex)
11081 my_piovar%gtype=b3dvar
11082 IF (kind(ocean(ng)%tl_bed_mass).eq.8) THEN
11083 my_piovar%dkind=pio_double
11084 iodesc => iodesc_dp_b3dvar(ng)
11085 ELSE
11086 my_piovar%dkind=pio_real
11087 iodesc => iodesc_sp_b3dvar(ng)
11088 END IF
11089!
11090 status=nf_fread3d(ng, idmod, ncname, piofile, &
11091 & vname(1,idbmas(i)), my_piovar, &
11092 & inprec, iodesc, vsize, &
11093 & lbi, ubi, lbj, ubj, 1, nbed, &
11094 & fscl, fmin, fmax, &
11095# ifdef MASKING
11096 & grid(ng) % rmask, &
11097# endif
11098# ifdef CHECKSUM
11099 & sedbed(ng) % tl_bed_mass(:,:,:, &
11100 & tindex,i), &
11101 & checksum = fhash)
11102# else
11103 & sedbed(ng) % tl_bed_mass(:,:,:, &
11104 & tindex,i))
11105# endif
11106 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11107 IF (master) THEN
11108 WRITE (stdout,60) string, trim(vname(1,idbmas(i))), &
11109 & inprec, trim(ncname)
11110 END IF
11111 exit_flag=2
11112 ioerror=status
11113 RETURN
11114 ELSE
11115 IF (master) THEN
11116# ifdef CHECKSUM
11117 WRITE (stdout,70) trim(vname(2,idbmas(i))), &
11118 & fmin, fmax, fhash
11119# else
11120 WRITE (stdout,70) trim(vname(2,idbmas(i))), &
11121 & fmin, fmax
11122# endif
11123 END IF
11124 END IF
11125 ELSE
11126 IF (master) THEN
11127 WRITE (stdout,80) string, trim(vname(1,idbmas(i))), &
11128 & trim(ncname)
11129 END IF
11130 exit_flag=4
11131 IF (founderror(exit_flag, pio_noerr, &
11132 & __line__, myfile)) THEN
11133 RETURN
11134 END IF
11135 END IF
11136 END IF
11137 END DO
11138!
11139! Read in tangent linear sediment properties in each bed layer.
11140!
11141 DO i=1,mbedp
11142 IF (get_var(idsbed(i))) THEN
11143 foundit=find_string(var_name, n_var, &
11144 & trim(vname(1,idsbed(i))), vindex)
11145 IF (foundit) THEN
11146 my_piovar%vd=var_desc(vindex)
11147 my_piovar%gtype=b3dvar
11148 IF (kind(ocean(ng)%tl_bed).eq.8) THEN
11149 my_piovar%dkind=pio_double
11150 iodesc => iodesc_dp_b3dvar(ng)
11151 ELSE
11152 my_piovar%dkind=pio_real
11153 iodesc => iodesc_sp_b3dvar(ng)
11154 END IF
11155!
11156 status=nf_fread3d(ng, idmod, ncname, piofile, &
11157 & vname(1,idsbed(i)), my_piovar, &
11158 & inprec, iodesc, vsize, &
11159 & lbi, ubi, lbj, ubj, 1, nbed, &
11160 & fscl, fmin, fmax, &
11161# ifdef MASKING
11162 & grid(ng) % rmask, &
11163# endif
11164# ifdef CHECKSUM
11165 & sedbed(ng) % tl_bed(:,:,:,i), &
11166 & checksum = fhash)
11167# else
11168 & sedbed(ng) % tl_bed(:,:,:,i))
11169# endif
11170 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11171 IF (master) THEN
11172 WRITE (stdout,60) string, trim(vname(1,idsbed(i))), &
11173 & inprec, trim(ncname)
11174 END IF
11175 exit_flag=2
11176 ioerror=status
11177 RETURN
11178 ELSE
11179 IF (master) THEN
11180# ifdef CHECKSUM
11181 WRITE (stdout,70) trim(vname(2,idsbed(i))), &
11182 & fmin, fmax, fhash
11183# else
11184 WRITE (stdout,70) trim(vname(2,idsbed(i))), &
11185 & fmin, fmax
11186# endif
11187 END IF
11188 END IF
11189 ELSE
11190 IF (master) THEN
11191 WRITE (stdout,80) string, trim(vname(1,idsbed(i))), &
11192 & trim(ncname)
11193 END IF
11194 exit_flag=4
11195 IF (founderror(exit_flag, pio_noerr, &
11196 & __line__, myfile)) THEN
11197 RETURN
11198 END IF
11199 END IF
11200 END IF
11201 END DO
11202
11203# ifdef BEDLOAD
11204!
11205! Read in tangent linear sediment fraction of bed load.
11206!
11207 DO i=1,nst
11208 IF (get_var(idubld(i))) THEN
11209 foundit=find_string(var_name, n_var, &
11210 & trim(vname(1,idubld(i))), vindex)
11211 IF (foundit) THEN
11212 my_piovar%vd=var_desc(vindex)
11213 my_piovar%gtype=u2dvar
11214 IF (kind(ocean(ng)%tl_bedldu).eq.8) THEN
11215 my_piovar%dkind=pio_double
11216 iodesc => iodesc_dp_u2dvar(ng)
11217 ELSE
11218 my_piovar%dkind=pio_real
11219 iodesc => iodesc_sp_u2dvar(ng)
11220 END IF
11221!
11222 status=nf_fread2d(ng, idmod, ncname, piofile, &
11223 & vname(1,idubld(i)), my_piovar, &
11224 & inprec, iodesc, vsize, &
11225 & lbi, ubi, lbj, ubj, &
11226 & fscl, fmin, fmax, &
11227# ifdef MASKING
11228 & grid(ng) % umask, &
11229# endif
11230# ifdef CHECKSUM
11231 & sedbed(ng) % tl_bedldu(:,:,i), &
11232 & checksum = fhash)
11233# else
11234 & sedbed(ng) % tl_bedldu(:,:,i))
11235# endif
11236 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11237 IF (master) THEN
11238 WRITE (stdout,60) string, trim(vname(1,idubld(i))), &
11239 & inprec, trim(ncname)
11240 END IF
11241 exit_flag=2
11242 ioerror=status
11243 RETURN
11244 ELSE
11245 IF (master) THEN
11246# ifdef CHECKSUM
11247 WRITE (stdout,70) trim(vname(2,idubld(i))), &
11248 & fmin, fmax, fhash
11249# else
11250 WRITE (stdout,70) trim(vname(2,idubld(i))), &
11251 & fmin, fmax
11252# endif
11253 END IF
11254 END IF
11255 ELSE
11256 IF (master) THEN
11257 WRITE (stdout,80) string, trim(vname(1,idubld(i))), &
11258 & trim(ncname)
11259 END IF
11260 exit_flag=4
11261 IF (founderror(exit_flag, pio_noerr, &
11262 & __line__, myfile)) THEN
11263 RETURN
11264 END IF
11265 END IF
11266 END IF
11267!
11268 IF (get_var(idvbld(i))) THEN
11269 foundit=find_string(var_name, n_var, &
11270 & trim(vname(1,idvbld(i))), vindex)
11271 IF (foundit) THEN
11272 my_piovar%vd=var_desc(vindex)
11273 my_piovar%gtype=v2dvar
11274 IF (kind(ocean(ng)%tl_bedldv).eq.8) THEN
11275 my_piovar%dkind=pio_double
11276 iodesc => iodesc_dp_v2dvar(ng)
11277 ELSE
11278 my_piovar%dkind=pio_real
11279 iodesc => iodesc_sp_v2dvar(ng)
11280 END IF
11281!
11282 status=nf_fread2d(ng, idmod, ncname, piofile, &
11283 & vname(1,idvbld(i)), my_piovar, &
11284 & inprec, iodesc, vsize, &
11285 & lbi, ubi, lbj, ubj, &
11286 & fscl, fmin, fmax, &
11287# ifdef MASKING
11288 & grid(ng) % vmask, &
11289# endif
11290# ifdef CHECKSUM
11291 & sedbed(ng) % tl_bedldv(:,:,i), &
11292 & checksum = fhash)
11293# else
11294 & sedbed(ng) % tl_bedldv(:,:,i))
11295# endif
11296 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11297 IF (master) THEN
11298 WRITE (stdout,60) string, trim(vname(1,idvbld(i))), &
11299 & inprec, trim(ncname)
11300 END IF
11301 exit_flag=2
11302 ioerror=status
11303 RETURN
11304 ELSE
11305 IF (master) THEN
11306# ifdef CHECKSUM
11307 WRITE (stdout,70) trim(vname(2,idvbld(i))), &
11308 & fmin, fmax, fhash
11309# else
11310 WRITE (stdout,70) trim(vname(2,idvbld(i))), &
11311 & fmin, fmax
11312# endif
11313 END IF
11314 END IF
11315 ELSE
11316 IF (master) THEN
11317 WRITE (stdout,80) string, trim(vname(1,idvbld(i))), &
11318 & trim(ncname)
11319 END IF
11320 exit_flag=4
11321 IF (founderror(exit_flag, pio_noerr, &
11322 & __line__, myfile)) THEN
11323 RETURN
11324 END IF
11325 END IF
11326 END IF
11327 END DO
11328# endif
11329# endif
11330
11331# if defined SEDIMENT || defined BBL_MODEL
11332!
11333! Read in tangent linear sediment properties in exposed bed layer.
11334!
11335 DO i=1,mbotp
11336 IF (get_var(idbott(i)).and.have_var(idbott(i))) THEN
11337 foundit=find_string(var_name, n_var, &
11338 & trim(vname(1,idbott(i))), vindex)
11339 IF (foundit) THEN
11340 my_piovar%vd=var_desc(vindex)
11341 my_piovar%gtype=r2dvar
11342 IF (kind(ocean(ng)%tl_bottom).eq.8) THEN
11343 my_piovar%dkind=pio_double
11344 iodesc => iodesc_dp_r2dvar(ng)
11345 ELSE
11346 my_piovar%dkind=pio_real
11347 iodesc => iodesc_sp_r2dvar(ng)
11348 END IF
11349!
11350 status=nf_fread2d(ng, idmod, ncname, piofile, &
11351 & vname(1,idbott(i)), my_piovar, &
11352 & inprec, iodesc, vsize, &
11353 & lbi, ubi, lbj, ubj, &
11354 & fscl, fmin, fmax, &
11355# ifdef MASKING
11356 & grid(ng) % rmask, &
11357# endif
11358# ifdef CHECKSUM
11359 & sedbed(ng) % tl_bottom(:,:,i), &
11360 & checksum = fhash)
11361# else
11362 & sedbed(ng) % tl_bottom(:,:,i))
11363# endif
11364 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11365 IF (master) THEN
11366 WRITE (stdout,60) string, trim(vname(1,idbott(i))), &
11367 & inprec, trim(ncname)
11368 END IF
11369 exit_flag=2
11370 ioerror=status
11371 RETURN
11372 ELSE
11373 IF (master) THEN
11374# ifdef CHECKSUM
11375 WRITE (stdout,70) trim(vname(2,idbott(i))), &
11376 & fmin, fmax, fhash
11377# else
11378 WRITE (stdout,70) trim(vname(2,idbott(i))), &
11379 & fmin, fmax
11380# endif
11381 END IF
11382 END IF
11383 ELSE
11384 IF (master) THEN
11385 WRITE (stdout,80) string, trim(vname(1,idbott(i))), &
11386 & trim(ncname)
11387 END IF
11388 exit_flag=4
11389 IF (founderror(exit_flag, pio_noerr, &
11390 & __line__, myfile)) THEN
11391 RETURN
11392 END IF
11393 END IF
11394 END IF
11395 END DO
11396# endif
11397# endif
11398 END IF tlm_state
11399# endif
11400
11401# ifdef ADJOINT
11402!
11403!-----------------------------------------------------------------------
11404! Read in adjoint state variables.
11405!-----------------------------------------------------------------------
11406!
11407 adm_state: IF (model.eq.iadm) THEN
11408!
11409! Read in adjoint free-surface.
11410!
11411 IF (get_var(idfsur)) THEN
11412 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
11413 & vindex)
11414 IF (foundit) THEN
11415 my_piovar%vd=var_desc(vindex)
11416 my_piovar%gtype=r2dvar
11417 IF (kind(ocean(ng)%ad_zeta).eq.8) THEN
11418 my_piovar%dkind=pio_double
11419 iodesc => iodesc_dp_r2dvar(ng)
11420 ELSE
11421 my_piovar%dkind=pio_real
11422 iodesc => iodesc_sp_r2dvar(ng)
11423 END IF
11424!
11425 status=nf_fread2d(ng, idmod, ncname, piofile, &
11426 & vname(1,idfsur), my_piovar, &
11427 & inprec, iodesc, vsize, &
11428 & lbi, ubi, lbj, ubj, &
11429 & fscl, fmin, fmax, &
11430# ifdef MASKING
11431 & grid(ng) % rmask, &
11432# endif
11433# ifdef CHECKSUM
11434 & ocean(ng) % ad_zeta(:,:,tindex), &
11435 & checksum = fhash)
11436# else
11437 & ocean(ng) % ad_zeta(:,:,tindex))
11438# endif
11439 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11440 IF (master) THEN
11441 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
11442 & inprec, trim(ncname)
11443 END IF
11444 exit_flag=2
11445 ioerror=status
11446 RETURN
11447 ELSE
11448 IF (master) THEN
11449# ifdef CHECKSUM
11450 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
11451 & fhash
11452# else
11453 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
11454# endif
11455 END IF
11456 END IF
11457 ELSE
11458 IF (master) THEN
11459 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
11460 & trim(ncname)
11461 END IF
11462 exit_flag=4
11463 IF (founderror(exit_flag, pio_noerr, &
11464 & __line__, myfile)) THEN
11465 RETURN
11466 END IF
11467 END IF
11468 END IF
11469
11470# ifdef ADJUST_BOUNDARY
11471!
11472! Read in adjoint free-surface open boundaries adjustments.
11473!
11474 IF (get_var(idsbry(isfsur)).and. &
11475 & any(lobc(:,isfsur,ng))) THEN
11476 ifield=idsbry(isfsur)
11477 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
11478 & vindex)
11479 IF (foundit) THEN
11480 my_piovar%vd=var_desc(vindex)
11481 my_piovar%gtype=r2dobc
11482 IF (kind(boundary(ng)%ad_zeta_obc).eq.8) THEN
11483 my_piovar%dkind=pio_double
11484 iodesc => iodesc_dp_r2dobc(ng)
11485 ELSE
11486 my_piovar%dkind=pio_real
11487 iodesc => iodesc_sp_r2dobc(ng)
11488 END IF
11489!
11490 status=nf_fread2d_bry(ng, idmod, ncname, piofile, &
11491 & vname(1,ifield), my_piovar, &
11492 & inprec, iodesc, &
11493 & lbij, ubij, nbrec(ng), &
11494 & fscl, fmin, fmax, &
11495# ifdef CHECKSUM
11496 & boundary(ng) % ad_zeta_obc(:,:,:, &
11497 & tindex), &
11498 & checksum = fhash)
11499# else
11500 & boundary(ng) % ad_zeta_obc(:,:,:, &
11501 & tindex))
11502# endif
11503 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11504 IF (master) THEN
11505 WRITE (stdout,60) string, trim(vname(1,ifield)), &
11506 & inprec, trim(ncname)
11507 END IF
11508 exit_flag=2
11509 ioerror=status
11510 RETURN
11511 ELSE
11512 IF (master) THEN
11513# ifdef CHECKSUM
11514 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
11515 & fhash
11516# else
11517 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
11518# endif
11519 END IF
11520 END IF
11521 ELSE
11522 IF (master) THEN
11523 WRITE (stdout,80) string, trim(vname(1,ifield)), &
11524 & trim(ncname)
11525 END IF
11526 exit_flag=4
11527 IF (founderror(exit_flag, pio_noerr, &
11528 & __line__, myfile)) THEN
11529 RETURN
11530 END IF
11531 END IF
11532 END IF
11533# endif
11534!
11535! Read in adjoint 2D U-momentum component.
11536!
11537 IF (get_var(idubar)) THEN
11538 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
11539 & vindex)
11540 IF (foundit) THEN
11541 my_piovar%vd=var_desc(vindex)
11542 my_piovar%gtype=u2dvar
11543 IF (kind(ocean(ng)%ad_ubar).eq.8) THEN
11544 my_piovar%dkind=pio_double
11545 iodesc => iodesc_dp_u2dvar(ng)
11546 ELSE
11547 my_piovar%dkind=pio_real
11548 iodesc => iodesc_sp_u2dvar(ng)
11549 END IF
11550!
11551 status=nf_fread2d(ng, idmod, ncname, piofile, &
11552 & vname(1,idubar), my_piovar, &
11553 & inprec, iodesc, vsize, &
11554 & lbi, ubi, lbj, ubj, &
11555 & fscl, fmin, fmax, &
11556# ifdef MASKING
11557 & grid(ng) % umask, &
11558# endif
11559# ifdef CHECKSUM
11560 & ocean(ng) % ad_ubar(:,:,tindex), &
11561 & checksum = fhash)
11562# else
11563 & ocean(ng) % ad_ubar(:,:,tindex))
11564# endif
11565 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11566 IF (master) THEN
11567 WRITE (stdout,60) string, trim(vname(1,idubar)), &
11568 & inprec, trim(ncname)
11569 END IF
11570 exit_flag=2
11571 ioerror=status
11572 RETURN
11573 ELSE
11574 IF (master) THEN
11575# ifdef CHECKSUM
11576 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
11577 & fhash
11578# else
11579 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
11580# endif
11581 END IF
11582 END IF
11583 ELSE
11584 IF (master) THEN
11585 WRITE (stdout,80) string, trim(vname(1,idubar)), &
11586 & trim(ncname)
11587 END IF
11588 exit_flag=4
11589 IF (founderror(exit_flag, pio_noerr, &
11590 & __line__, myfile)) THEN
11591 RETURN
11592 END IF
11593 END IF
11594 END IF
11595
11596# ifdef ADJUST_BOUNDARY
11597!
11598! Read in 2D adjoint U-momentum component open boundaries adjustments.
11599!
11600 IF (get_var(idsbry(isubar)).and. &
11601 & any(lobc(:,isubar,ng))) THEN
11602 ifield=idsbry(isubar)
11603 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
11604 & vindex)
11605 IF (foundit) THEN
11606 my_piovar%vd=var_desc(vindex)
11607 my_piovar%gtype=u2dobc
11608 IF (kind(boundary(ng)%ad_ubar_obc).eq.8) THEN
11609 my_piovar%dkind=pio_double
11610 iodesc => iodesc_dp_u2dobc(ng)
11611 ELSE
11612 my_piovar%dkind=pio_real
11613 iodesc => iodesc_sp_u2dobc(ng)
11614 END IF
11615!
11616 status=nf_fread2d_bry(ng, idmod, ncname, piofile, &
11617 & vname(1,ifield), my_piovar, &
11618 & inprec, iodesc, &
11619 & lbij, ubij, nbrec(ng), &
11620 & fscl, fmin, fmax, &
11621# ifdef CHECKSUM
11622 & boundary(ng) % ad_ubar_obc(:,:,:, &
11623 & tindex), &
11624 & checksum = fhash)
11625# else
11626 & boundary(ng) % ad_ubar_obc(:,:,:, &
11627 & tindex))
11628# endif
11629 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11630 IF (master) THEN
11631 WRITE (stdout,60) string, trim(vname(1,ifield)), &
11632 & inprec, trim(ncname)
11633 END IF
11634 exit_flag=2
11635 ioerror=status
11636 RETURN
11637 ELSE
11638 IF (master) THEN
11639# ifdef CHECKSUM
11640 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
11641 & fhash
11642# else
11643 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
11644# endif
11645 END IF
11646 END IF
11647 ELSE
11648 IF (master) THEN
11649 WRITE (stdout,80) string, trim(vname(1,ifield)), &
11650 & trim(ncname)
11651 END IF
11652 exit_flag=4
11653 IF (founderror(exit_flag, pio_noerr, &
11654 & __line__, myfile)) THEN
11655 RETURN
11656 END IF
11657 END IF
11658 END IF
11659# endif
11660!
11661! Read in adjoint 2D V-momentum component.
11662!
11663 IF (get_var(idvbar)) THEN
11664 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
11665 & vindex)
11666 IF (foundit) THEN
11667 my_piovar%vd=var_desc(vindex)
11668 my_piovar%gtype=v2dvar
11669 IF (kind(ocean(ng)%ad_vbar).eq.8) THEN
11670 my_piovar%dkind=pio_double
11671 iodesc => iodesc_dp_v2dvar(ng)
11672 ELSE
11673 my_piovar%dkind=pio_real
11674 iodesc => iodesc_sp_v2dvar(ng)
11675 END IF
11676!
11677 status=nf_fread2d(ng, idmod, ncname, piofile, &
11678 & vname(1,idvbar), my_piovar, &
11679 & inprec, iodesc, vsize, &
11680 & lbi, ubi, lbj, ubj, &
11681 & fscl, fmin, fmax, &
11682# ifdef MASKING
11683 & grid(ng) % vmask, &
11684# endif
11685# ifdef CHECKSUM
11686 & ocean(ng) % ad_vbar(:,:,tindex), &
11687 & checksum = fhash)
11688# else
11689 & ocean(ng) % ad_vbar(:,:,tindex))
11690# endif
11691 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11692 IF (master) THEN
11693 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
11694 & inprec, trim(ncname)
11695 END IF
11696 exit_flag=2
11697 ioerror=status
11698 RETURN
11699 ELSE
11700 IF (master) THEN
11701# ifdef CHECKSUM
11702 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
11703 & fhash
11704# else
11705 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
11706# endif
11707 END IF
11708 END IF
11709 ELSE
11710 IF (master) THEN
11711 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
11712 & trim(ncname)
11713 END IF
11714 exit_flag=4
11715 IF (founderror(exit_flag, pio_noerr, &
11716 & __line__, myfile)) THEN
11717 RETURN
11718 END IF
11719 END IF
11720 END IF
11721
11722# ifdef ADJUST_BOUNDARY
11723!
11724! Read in 2D V-momentum component open boundaries adjustments.
11725!
11726 IF (get_var(idsbry(isvbar)).and. &
11727 & any(lobc(:,isvbar,ng))) THEN
11728 ifield=idsbry(isvbar)
11729 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
11730 & vindex)
11731 IF (foundit) THEN
11732 my_piovar%vd=var_desc(vindex)
11733 my_piovar%gtype=v2dobc
11734 IF (kind(boundary(ng)%ad_vbar_obc).eq.8) THEN
11735 my_piovar%dkind=pio_double
11736 iodesc => iodesc_dp_v2dobc(ng)
11737 ELSE
11738 my_piovar%dkind=pio_real
11739 iodesc => iodesc_sp_v2dobc(ng)
11740 END IF
11741!
11742 status=nf_fread2d_bry(ng, idmod, ncname, piofile, &
11743 & vname(1,ifield), my_piovar, &
11744 & inprec, iodesc, &
11745 & lbij, ubij, nbrec(ng), &
11746 & fscl, fmin, fmax, &
11747# ifdef CHECKSUM
11748 & boundary(ng) % ad_vbar_obc(:,:,:, &
11749 & tindex), &
11750 & checksum = fhash)
11751# else
11752 & boundary(ng) % ad_vbar_obc(:,:,:, &
11753 & tindex))
11754# endif
11755 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11756 IF (master) THEN
11757 WRITE (stdout,60) string, trim(vname(1,ifield)), &
11758 & inprec, trim(ncname)
11759 END IF
11760 exit_flag=2
11761 ioerror=status
11762 RETURN
11763 ELSE
11764 IF (master) THEN
11765# ifdef CHECKSUM
11766 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
11767 & fhash
11768# else
11769 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
11770# endif
11771
11772 END IF
11773 END IF
11774 ELSE
11775 IF (master) THEN
11776 WRITE (stdout,80) string, trim(vname(1,ifield)), &
11777 & trim(ncname)
11778 END IF
11779 exit_flag=4
11780 IF (founderror(exit_flag, pio_noerr, &
11781 & __line__, myfile)) THEN
11782 RETURN
11783 END IF
11784 END IF
11785 END IF
11786# endif
11787# ifdef ADJUST_WSTRESS
11788!
11789! Read in adjoint linear surface U-momentum stress.
11790!
11791 IF (get_var(idusms)) THEN
11792 foundit=find_string(var_name, n_var, trim(vname(1,idusms)), &
11793 & vindex)
11794 IF (foundit) THEN
11795 scale=1.0_dp
11796 my_piovar%vd=var_desc(vindex)
11797 my_piovar%gtype=u2dvar
11798 IF (kind(forces(ng)%ad_ustr).eq.8) THEN
11799 my_piovar%dkind=pio_double
11800 iodesc => iodesc_dp_u2dfrc(ng)
11801 ELSE
11802 my_piovar%dkind=pio_real
11803 iodesc => iodesc_sp_u2dfrc(ng)
11804 END IF
11805!
11806 status=nf_fread3d(ng, idmod, ncname, piofile, &
11807 & vname(1,idusms), my_piovar, &
11808 & inprec, iodesc, vsize, &
11809 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
11810 & scale, fmin, fmax, &
11811# ifdef MASKING
11812 & grid(ng) % umask, &
11813# endif
11814# ifdef CHECKSUM
11815 & forces(ng) % ad_ustr(:,:,:,tindex), &
11816 & checksum = fhash)
11817# else
11818 & forces(ng) % ad_ustr(:,:,:,tindex))
11819# endif
11820 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11821 IF (master) THEN
11822 WRITE (stdout,60) string, trim(vname(1,idusms)), &
11823 & inprec, trim(ncname)
11824 END IF
11825 exit_flag=2
11826 ioerror=status
11827 RETURN
11828 ELSE
11829 IF (master) THEN
11830# ifdef CHECKSUM
11831 WRITE (stdout,70) trim(vname(2,idusms))// &
11832 & ', adjusted ad_ustr', fmin, fmax, &
11833 & fhash
11834# else
11835 WRITE (stdout,70) trim(vname(2,idusms))// &
11836 & ', adjusted ad_ustr', fmin, fmax
11837# endif
11838 END IF
11839 END IF
11840 ELSE
11841 IF (master) THEN
11842 WRITE (stdout,80) string, trim(vname(1,idusms)), &
11843 & trim(ncname)
11844 END IF
11845 exit_flag=4
11846 IF (founderror(exit_flag, pio_noerr, &
11847 & __line__, myfile)) THEN
11848 RETURN
11849 END IF
11850 END IF
11851 END IF
11852!
11853! Read in adjoint linear surface V-momentum stress.
11854!
11855 IF (get_var(idvsms)) THEN
11856 foundit=find_string(var_name, n_var, trim(vname(1,idvsms)), &
11857 & vindex)
11858 IF (foundit) THEN
11859 scale=1.0_dp
11860 my_piovar%vd=var_desc(vindex)
11861 my_piovar%gtype=v2dvar
11862 IF (kind(forces(ng)%ad_vstr).eq.8) THEN
11863 my_piovar%dkind=pio_double
11864 iodesc => iodesc_dp_v2dfrc(ng)
11865 ELSE
11866 my_piovar%dkind=pio_real
11867 iodesc => iodesc_sp_v2dfrc(ng)
11868 END IF
11869!
11870 status=nf_fread3d(ng, idmod, ncname, piofile, &
11871 & vname(1,idvsms), my_piovar, &
11872 & inprec, iodesc, vsize, &
11873 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
11874 & scale, fmin, fmax, &
11875# ifdef MASKING
11876 & grid(ng) % vmask, &
11877# endif
11878# ifdef CHECKSUM
11879 & forces(ng) % ad_vstr(:,:,:,tindex), &
11880 & checksum = fhash)
11881# else
11882 & forces(ng) % ad_vstr(:,:,:,tindex))
11883# endif
11884 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11885 IF (master) THEN
11886 WRITE (stdout,60) string, trim(vname(1,idvsms)), &
11887 & inprec, trim(ncname)
11888 END IF
11889 exit_flag=2
11890 ioerror=status
11891 RETURN
11892 ELSE
11893 IF (master) THEN
11894# ifdef CHECKSUM
11895 WRITE (stdout,70) trim(vname(2,idvsms))// &
11896 & ', adjusted ad_vstr', fmin, fmax, &
11897 & fhash
11898# else
11899 WRITE (stdout,70) trim(vname(2,idvsms))// &
11900 & ', adjusted ad_vstr', fmin, fmax
11901# endif
11902 END IF
11903 END IF
11904 ELSE
11905 IF (master) THEN
11906 WRITE (stdout,80) string, trim(vname(1,idvsms)), &
11907 & trim(ncname)
11908 END IF
11909 exit_flag=4
11910 IF (founderror(exit_flag, pio_noerr, &
11911 & __line__, myfile)) THEN
11912 RETURN
11913 END IF
11914 END IF
11915 END IF
11916# endif
11917# ifdef SOLVE3D
11918!
11919! Read in adjoint 3D U-momentum component.
11920!
11921 IF (get_var(iduvel)) THEN
11922 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
11923 & vindex)
11924 IF (foundit) THEN
11925 my_piovar%vd=var_desc(vindex)
11926 my_piovar%gtype=u3dvar
11927 IF (kind(ocean(ng)%ad_u).eq.8) THEN
11928 my_piovar%dkind=pio_double
11929 iodesc => iodesc_dp_u3dvar(ng)
11930 ELSE
11931 my_piovar%dkind=pio_real
11932 iodesc => iodesc_sp_u3dvar(ng)
11933 END IF
11934!
11935 status=nf_fread3d(ng, idmod, ncname, piofile, &
11936 & vname(1,iduvel), my_piovar, &
11937 & inprec, iodesc, vsize, &
11938 & lbi, ubi, lbj, ubj, 1, n(ng), &
11939 & fscl, fmin, fmax, &
11940# ifdef MASKING
11941 & grid(ng) % umask, &
11942# endif
11943# ifdef CHECKSUM
11944 & ocean(ng) % ad_u(:,:,:,tindex), &
11945 & checksum = fhash)
11946# else
11947 & ocean(ng) % ad_u(:,:,:,tindex))
11948# endif
11949 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
11950 IF (master) THEN
11951 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
11952 & inprec, trim(ncname)
11953 END IF
11954 exit_flag=2
11955 ioerror=status
11956 RETURN
11957 ELSE
11958 IF (master) THEN
11959# ifdef CHECKSUM
11960 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
11961 & fhash
11962# else
11963 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
11964# endif
11965
11966 END IF
11967 END IF
11968 ELSE
11969 IF (master) THEN
11970 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
11971 & trim(ncname)
11972 END IF
11973 exit_flag=4
11974 IF (founderror(exit_flag, pio_noerr, &
11975 & __line__, myfile)) THEN
11976 RETURN
11977 END IF
11978 END IF
11979 END IF
11980
11981# ifdef ADJUST_BOUNDARY
11982!
11983! Read in adjoint 3D U-momentum component open boundaries adjustments.
11984!
11985 IF (get_var(idsbry(isuvel)).and. &
11986 & any(lobc(:,isuvel,ng))) THEN
11987 ifield=idsbry(isuvel)
11988 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
11989 & vindex)
11990 IF (foundit) THEN
11991 my_piovar%vd=var_desc(vindex)
11992 my_piovar%gtype=u3dobc
11993 IF (kind(boundary(ng)%ad_u_obc).eq.8) THEN
11994 my_piovar%dkind=pio_double
11995 iodesc => iodesc_dp_u3dobc(ng)
11996 ELSE
11997 my_piovar%dkind=pio_real
11998 iodesc => iodesc_sp_u3dobc(ng)
11999 END IF
12000!
12001 status=nf_fread3d_bry(ng, idmod, ncname, piofile, &
12002 & vname(1,ifield), my_piovar, &
12003 & inprec, iodesc, &
12004 & lbij, ubij, 1, n(ng), nbrec(ng), &
12005 & fscl, fmin, fmax, &
12006# ifdef CHECKSUM
12007 & boundary(ng) % ad_u_obc(:,:,:,:, &
12008 & tindex), &
12009 & checksum = fhash)
12010# else
12011 & boundary(ng) % ad_u_obc(:,:,:,:, &
12012 & tindex))
12013# endif
12014 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12015 IF (master) THEN
12016 WRITE (stdout,60) string, trim(vname(1,ifield)), &
12017 & inprec, trim(ncname)
12018 END IF
12019 exit_flag=2
12020 ioerror=status
12021 RETURN
12022 ELSE
12023 IF (master) THEN
12024# ifdef CHECKSUM
12025 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
12026 & fhash
12027# else
12028 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
12029# endif
12030 END IF
12031 END IF
12032 ELSE
12033 IF (master) THEN
12034 WRITE (stdout,80) string, trim(vname(1,ifield)), &
12035 & trim(ncname)
12036 END IF
12037 exit_flag=4
12038 IF (founderror(exit_flag, pio_noerr, &
12039 & __line__, myfile)) THEN
12040 RETURN
12041 END IF
12042 END IF
12043 END IF
12044# endif
12045!
12046! Read in adjoint 3D V-momentum component.
12047!
12048 IF (get_var(idvvel)) THEN
12049 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
12050 & vindex)
12051 IF (foundit) THEN
12052 my_piovar%vd=var_desc(vindex)
12053 my_piovar%gtype=v3dvar
12054 IF (kind(ocean(ng)%ad_v).eq.8) THEN
12055 my_piovar%dkind=pio_double
12056 iodesc => iodesc_dp_v3dvar(ng)
12057 ELSE
12058 my_piovar%dkind=pio_real
12059 iodesc => iodesc_sp_v3dvar(ng)
12060 END IF
12061!
12062 status=nf_fread3d(ng, idmod, ncname, piofile, &
12063 & vname(1,idvvel), my_piovar, &
12064 & inprec, iodesc, vsize, &
12065 & lbi, ubi, lbj, ubj, 1, n(ng), &
12066 & fscl, fmin, fmax, &
12067# ifdef MASKING
12068 & grid(ng) % vmask, &
12069# endif
12070# ifdef CHECKSUM
12071 & ocean(ng) % ad_v(:,:,:,tindex), &
12072 & checksum = fhash)
12073# else
12074 & ocean(ng) % ad_v(:,:,:,tindex))
12075# endif
12076 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12077 IF (master) THEN
12078 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
12079 & inprec, trim(ncname)
12080 END IF
12081 exit_flag=2
12082 ioerror=status
12083 RETURN
12084 ELSE
12085 IF (master) THEN
12086# ifdef CHECKSUM
12087 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
12088 & fhash
12089# else
12090 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
12091# endif
12092
12093 END IF
12094 END IF
12095 ELSE
12096 IF (master) THEN
12097 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
12098 & trim(ncname)
12099 END IF
12100 exit_flag=4
12101 IF (founderror(exit_flag, pio_noerr, &
12102 & __line__, myfile)) THEN
12103 RETURN
12104 END IF
12105 END IF
12106 END IF
12107
12108# ifdef ADJUST_BOUNDARY
12109!
12110! Read in 3D V-momentum component open boundaries adjustments.
12111!
12112 IF (get_var(idsbry(isvvel)).and. &
12113 & any(lobc(:,isvvel,ng))) THEN
12114 ifield=idsbry(isvvel)
12115 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
12116 & vindex)
12117 IF (foundit) THEN
12118 my_piovar%vd=var_desc(vindex)
12119 my_piovar%gtype=v3dobc
12120 IF (kind(boundary(ng)%ad_v_obc).eq.8) THEN
12121 my_piovar%dkind=pio_double
12122 iodesc => iodesc_dp_v3dobc(ng)
12123 ELSE
12124 my_piovar%dkind=pio_real
12125 iodesc => iodesc_sp_v3dobc(ng)
12126 END IF
12127!
12128 status=nf_fread3d_bry(ng, idmod, ncname, piofile, &
12129 & vname(1,ifield), my_piovar, &
12130 & inprec, iodesc, &
12131 & lbij, ubij, 1, n(ng), nbrec(ng), &
12132 & fscl, fmin, fmax, &
12133# ifdef CHECKSUM
12134 & boundary(ng) % ad_v_obc(:,:,:,:, &
12135 & tindex), &
12136 & checksum = fhash)
12137# else
12138 & boundary(ng) % ad_v_obc(:,:,:,:, &
12139 & tindex))
12140# endif
12141 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12142 IF (master) THEN
12143 WRITE (stdout,60) string, trim(vname(1,ifield)), &
12144 & inprec, trim(ncname)
12145 END IF
12146 exit_flag=2
12147 ioerror=status
12148 RETURN
12149 ELSE
12150 IF (master) THEN
12151# ifdef CHECKSUM
12152 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
12153 & fhash
12154# else
12155 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
12156# endif
12157 END IF
12158 END IF
12159 ELSE
12160 IF (master) THEN
12161 WRITE (stdout,80) string, trim(vname(1,ifield)), &
12162 & trim(ncname)
12163 END IF
12164 exit_flag=4
12165 IF (founderror(exit_flag, pio_noerr, &
12166 & __line__, myfile)) THEN
12167 RETURN
12168 END IF
12169 END IF
12170 END IF
12171# endif
12172!
12173! Read in adjoint tracer type variables.
12174!
12175 DO itrc=1,nt(ng)
12176 IF (get_var(idtvar(itrc))) THEN
12177 foundit=find_string(var_name, n_var, &
12178 & trim(vname(1,idtvar(itrc))), vindex)
12179 IF (foundit) THEN
12180 my_piovar%vd=var_desc(vindex)
12181 my_piovar%gtype=r3dvar
12182 IF (kind(ocean(ng)%ad_t).eq.8) THEN
12183 my_piovar%dkind=pio_double
12184 iodesc => iodesc_dp_r3dvar(ng)
12185 ELSE
12186 my_piovar%dkind=pio_real
12187 iodesc => iodesc_sp_r3dvar(ng)
12188 END IF
12189!
12190 status=nf_fread3d(ng, idmod, ncname, piofile, &
12191 & vname(1,idtvar(itrc)), my_piovar, &
12192 & inprec, iodesc, vsize, &
12193 & lbi, ubi, lbj, ubj, 1, n(ng), &
12194 & fscl, fmin, fmax, &
12195# ifdef MASKING
12196 & grid(ng) % rmask, &
12197# endif
12198# ifdef CHECKSUM
12199 & ocean(ng) % ad_t(:,:,:,tindex,itrc), &
12200 & checksum = fhash)
12201# else
12202 & ocean(ng) % ad_t(:,:,:,tindex,itrc))
12203# endif
12204 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12205 IF (master) THEN
12206 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
12207 & inprec, trim(ncname)
12208 END IF
12209 exit_flag=2
12210 ioerror=status
12211 RETURN
12212 ELSE
12213 IF (master) THEN
12214# ifdef CHECKSUM
12215 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
12216 & fmin, fmin, fhash
12217# else
12218 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
12219 & fmin, fmax
12220# endif
12221 END IF
12222 END IF
12223 ELSE
12224 IF (master) THEN
12225 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
12226 & trim(ncname)
12227 END IF
12228 exit_flag=4
12229 IF (founderror(exit_flag, pio_noerr, &
12230 & __line__, myfile)) THEN
12231 RETURN
12232 END IF
12233 END IF
12234 END IF
12235 END DO
12236
12237# ifdef ADJUST_BOUNDARY
12238!
12239! Read in adjoint 3D tracers open boundaries adjustments.
12240!
12241 DO itrc=1,nt(ng)
12242 IF (get_var(idsbry(istvar(itrc))).and. &
12243 & any(lobc(:,istvar(itrc),ng))) THEN
12244 ifield=idsbry(istvar(itrc))
12245 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
12246 & vindex)
12247 IF (foundit) THEN
12248 my_piovar%vd=var_desc(vindex)
12249 my_piovar%gtype=r3dobc
12250 IF (kind(boundary(ng)%ad_t_obc).eq.8) THEN
12251 my_piovar%dkind=pio_double
12252 iodesc => iodesc_dp_r3dobc(ng)
12253 ELSE
12254 my_piovar%dkind=pio_real
12255 iodesc => iodesc_sp_r3dobc(ng)
12256 END IF
12257!
12258 status=nf_fread3d_bry(ng, idmod, ncname, piofile, &
12259 & vname(1,ifield), my_piovar, &
12260 & inprec, iodesc, &
12261 & lbij, ubij, 1, n(ng), nbrec(ng), &
12262 & fscl, fmin, fmax, &
12263# ifdef CHECKSUM
12264 & boundary(ng) % ad_t_obc(:,:,:,:, &
12265 & tindex,itrc), &
12266 & checksum = fhash)
12267# else
12268 & boundary(ng) % ad_t_obc(:,:,:,:, &
12269 & tindex,itrc))
12270# endif
12271 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12272 IF (master) THEN
12273 WRITE (stdout,60) string, trim(vname(1,ifield)), &
12274 & inprec, trim(ncname)
12275 END IF
12276 exit_flag=2
12277 ioerror=status
12278 RETURN
12279 ELSE
12280 IF (master) THEN
12281# ifdef CHECKSUM
12282 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
12283 & fhash
12284# else
12285 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
12286# endif
12287 END IF
12288 END IF
12289 ELSE
12290 IF (master) THEN
12291 WRITE (stdout,80) string, trim(vname(1,ifield)), &
12292 & trim(ncname)
12293 END IF
12294 exit_flag=4
12295 IF (founderror(exit_flag, pio_noerr, &
12296 & __line__, myfile)) THEN
12297 RETURN
12298 END IF
12299 END IF
12300 END IF
12301 END DO
12302# endif
12303# ifdef ADJUST_STFLUX
12304!
12305! Read in adjoint surface tracers flux.
12306!
12307 DO itrc=1,nt(ng)
12308 IF (get_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
12309 foundit=find_string(var_name, n_var, &
12310 & trim(vname(1,idtsur(itrc))), vindex)
12311 IF (foundit) THEN
12312 scale=1.0_dp
12313 my_piovar%vd=var_desc(vindex)
12314 my_piovar%gtype=r2dvar
12315 IF (kind(forces(ng)%ad_tflux).eq.8) THEN
12316 my_piovar%dkind=pio_double
12317 iodesc => iodesc_dp_r2dfrc(ng)
12318 ELSE
12319 my_piovar%dkind=pio_real
12320 iodesc => iodesc_sp_r2dfrc(ng)
12321 END IF
12322!
12323 status=nf_fread3d(ng, idmod, ncname, piofile, &
12324 & vname(1,idtsur(itrc)), my_piovar, &
12325 & inprec, iodesc, vsize, &
12326 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
12327 & scale, fmin, fmax, &
12328# ifdef MASKING
12329 & grid(ng) % rmask, &
12330# endif
12331# ifdef CHECKSUM
12332 & forces(ng) % ad_tflux(:,:,:, &
12333 & tindex,itrc), &
12334 & checksum = fhash)
12335# else
12336 & forces(ng) % ad_tflux(:,:,:, &
12337 & tindex,itrc))
12338# endif
12339 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12340 IF (master) THEN
12341 WRITE (stdout,60) string, trim(vname(1,idtsur(itrc))),&
12342 & inprec, trim(ncname)
12343 END IF
12344 exit_flag=2
12345 ioerror=status
12346 RETURN
12347 ELSE
12348 IF (master) THEN
12349# ifdef CHECKSUM
12350 WRITE (stdout,70) trim(vname(2,idtsur(itrc)))// &
12351 & ', adjusted ad_tflux', fmin, fmax, &
12352 & fhash
12353# else
12354 WRITE (stdout,70) trim(vname(2,idtsur(itrc)))// &
12355 & ', adjusted ad_tflux', fmin, fmax
12356# endif
12357 END IF
12358 END IF
12359 ELSE
12360 IF (master) THEN
12361 WRITE (stdout,80) string, trim(vname(1,idtsur(itrc))), &
12362 & trim(ncname)
12363 END IF
12364 exit_flag=4
12365 IF (founderror(exit_flag, pio_noerr, &
12366 & __line__, myfile)) THEN
12367 RETURN
12368 END IF
12369 END IF
12370 END IF
12371 END DO
12372# endif
12373# ifdef SEDIMENT
12374!
12375! Read in adjoint sediment fraction of each size class in each bed
12376! layer.
12377!
12378 DO i=1,nst
12379 IF (get_var(idfrac(i))) THEN
12380 foundit=find_string(var_name, n_var, &
12381 & trim(vname(1,idfrac(i))), vindex)
12382 IF (foundit) THEN
12383 my_piovar%vd=var_desc(vindex)
12384 my_piovar%gtype=b3dvar
12385 IF (kind(sedbed(ng)%ad_bed_frac).eq.8) THEN
12386 my_piovar%dkind=pio_double
12387 iodesc => iodesc_dp_b3dvar(ng)
12388 ELSE
12389 my_piovar%dkind=pio_real
12390 iodesc => iodesc_sp_b3dvar(ng)
12391 END IF
12392!
12393 status=nf_fread3d(ng, idmod, ncname, piofile, &
12394 & vname(1,idfrac(i)), my_piovar, &
12395 & inprec, iodesc, vsize, &
12396 & lbi, ubi, lbj, ubj, 1, nbed, &
12397 & fscl, fmin, fmax, &
12398# ifdef MASKING
12399 & grid(ng) % rmask, &
12400# endif
12401# ifdef CHECKSUM
12402 & sedbed(ng) % ad_bed_frac(:,:,:,i), &
12403 & checksum = fhash)
12404# else
12405 & sedbed(ng) % ad_bed_frac(:,:,:,i))
12406# endif
12407 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12408 IF (master) THEN
12409 WRITE (stdout,60) string, trim(vname(1,idfrac(i))), &
12410 & inprec, trim(ncname)
12411 END IF
12412 exit_flag=2
12413 ioerror=status
12414 RETURN
12415 ELSE
12416 IF (master) THEN
12417# ifdef CHECKSUM
12418 WRITE (stdout,70) trim(vname(2,idfrac(i))), &
12419 & fmin, fmax, fhash
12420# else
12421 WRITE (stdout,70) trim(vname(2,idfrac(i))), &
12422 & fmin, fmax
12423# endif
12424 END IF
12425 END IF
12426 ELSE
12427 IF (master) THEN
12428 WRITE (stdout,80) string, trim(vname(1,idfrac(i))), &
12429 & trim(ncname)
12430 END IF
12431 exit_flag=4
12432 IF (founderror(exit_flag, pio_noerr, &
12433 & __line__, myfile)) THEN
12434 RETURN
12435 END IF
12436 END IF
12437 END IF
12438!
12439! Read in adjoint sediment mass of each size class in each bed layer.
12440!
12441 IF (get_var(idbmas(i))) THEN
12442 foundit=find_string(var_name, n_var,
12443 & trim(vname(1,idbmas(i))), vindex)
12444 IF (foundit) THEN
12445 my_piovar%vd=var_desc(vindex)
12446 my_piovar%gtype=b3dvar
12447 IF (kind(sedbed(ng)%ad_bed_mass).eq.8) THEN
12448 my_piovar%dkind=pio_double
12449 iodesc => iodesc_dp_b3dvar(ng)
12450 ELSE
12451 my_piovar%dkind=pio_real
12452 iodesc => iodesc_sp_b3dvar(ng)
12453 END IF
12454!
12455 status=nf_fread3d(ng, idmod, ncname, piofile, &
12456 & vname(1,idbmas(i)), my_piovar, &
12457 & inprec, iodesc, vsize, &
12458 & lbi, ubi, lbj, ubj, 1, nbed, &
12459 & fscl, fmin, fmax, &
12460# ifdef MASKING
12461 & grid(ng) % rmask, &
12462# endif
12463# ifdef CHECKSUM
12464 & sedbed(ng) % ad_bed_mass(:,:,:, &
12465 tindex,i), &
12466 & checksum = fhash)
12467# else
12468 & sedbed(ng) % ad_bed_mass(:,:,:, &
12469 & tindex,i))
12470# endif
12471 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12472 IF (master) THEN
12473 WRITE (stdout,60) string, trim(vname(1,idbmas(i))), &
12474 & inprec, trim(ncname)
12475 END IF
12476 exit_flag=2
12477 ioerror=status
12478 RETURN
12479 ELSE
12480 IF (master) THEN
12481# ifdef CHECKSUM
12482 WRITE (stdout,70) trim(vname(2,idbmas(i))), &
12483 & fmin, fmax, fhash
12484# else
12485 WRITE (stdout,70) trim(vname(2,idbmas(i))), &
12486 & fmin, fmax
12487# endif
12488 END IF
12489 END IF
12490 ELSE
12491 IF (master) THEN
12492 WRITE (stdout,80) string, trim(vname(1,idbmas(i))), &
12493 & trim(ncname)
12494 END IF
12495 exit_flag=4
12496 IF (founderror(exit_flag, pio_noerr, &
12497 & __line__, myfile)) THEN
12498 RETURN
12499 END IF
12500 END IF
12501 END IF
12502 END DO
12503!
12504! Read in adjoint sediment properties in each bed layer.
12505!
12506 DO i=1,mbedp
12507 IF (get_var(idsbed(i))) THEN
12508 foundit=find_string(var_name, n_var, &
12509 & trim(vname(1,idsbed(i))), vindex)
12510 IF (foundit) THEN
12511 my_piovar%vd=var_desc(vindex)
12512 my_piovar%gtype=b3dvar
12513 IF (kind(sedbed(ng)%ad_bed).eq.8) THEN
12514 my_piovar%dkind=pio_double
12515 iodesc => iodesc_dp_b3dvar(ng)
12516 ELSE
12517 my_piovar%dkind=pio_real
12518 iodesc => iodesc_sp_b3dvar(ng)
12519 END IF
12520!
12521 status=nf_fread3d(ng, idmod, ncname, piofile, &
12522 & vname(1,idsbed(i)), my_piovar, &
12523 & inprec, iodesc, vsize, &
12524 & lbi, ubi, lbj, ubj, 1, nbed, &
12525 & fscl, fmin, fmax, &
12526# ifdef MASKING
12527 & grid(ng) % rmask, &
12528# endif
12529# ifdef CHECKSUM
12530 & sedbed(ng) % ad_bed(:,:,:,i), &
12531 & checksum = fhash)
12532# else
12533 & sedbed(ng) % ad_bed(:,:,:,i))
12534# endif
12535 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12536 IF (master) THEN
12537 WRITE (stdout,60) string, trim(vname(1,idsbed(i))), &
12538 & inprec, trim(ncname)
12539 END IF
12540 exit_flag=2
12541 ioerror=status
12542 RETURN
12543 ELSE
12544 IF (master) THEN
12545# ifdef CHECKSUM
12546 WRITE (stdout,70) trim(vname(2,idsbed(i))), &
12547 & fmin, fmax, fhash
12548# else
12549 WRITE (stdout,70) trim(vname(2,idsbed(i))), &
12550 & fmin, fmax
12551# endif
12552 END IF
12553 END IF
12554 ELSE
12555 IF (master) THEN
12556 WRITE (stdout,80) string, trim(vname(1,idsbed(i))), &
12557 & trim(ncname)
12558 END IF
12559 exit_flag=4
12560 IF (founderror(exit_flag, pio_noerr, &
12561 & __line__, myfile)) THEN
12562 RETURN
12563 END IF
12564 END IF
12565 END IF
12566 END DO
12567
12568# ifdef BEDLOAD
12569!
12570! Read in adjoint sediment fraction of bed load.
12571!
12572 DO i=1,nst
12573 IF (get_var(idubld(i))) THEN
12574 foundit=find_string(var_name, n_var, &
12575 & trim(vname(1,idubld(i))), vindex)
12576 IF (foundit) THEN
12577 my_piovar%vd=var_desc(vindex)
12578 my_piovar%gtype=u2dvar
12579 IF (kind(sedbed(ng)%ad_bedldu).eq.8) THEN
12580 my_piovar%dkind=pio_double
12581 iodesc => iodesc_dp_u2dvar(ng)
12582 ELSE
12583 my_piovar%dkind=pio_real
12584 iodesc => iodesc_sp_u2dvar(ng)
12585 END IF
12586!
12587 status=nf_fread2d(ng, idmod, ncname, piofile, &
12588 & vname(1,idubld(i)), my_piovar, &
12589 & inprec, iodesc, vsize, &
12590 & lbi, ubi, lbj, ubj, &
12591 & fscl, fmin, fmax, &
12592# ifdef MASKING
12593 & grid(ng) % umask, &
12594# endif
12595# ifdef CHECKSUM
12596 & sedbed(ng) % ad_bedldu(:,:,i), &
12597 & checksum = fhash)
12598# else
12599 & sedbed(ng) % ad_bedldu(:,:,i))
12600# endif
12601 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12602 IF (master) THEN
12603 WRITE (stdout,60) string, trim(vname(1,idubld(i))), &
12604 & inprec, trim(ncname)
12605 END IF
12606 exit_flag=2
12607 ioerror=status
12608 RETURN
12609 ELSE
12610 IF (master) THEN
12611# ifdef CHECKSUM
12612 WRITE (stdout,70) trim(vname(2,idubld(i))), &
12613 & fmin, fmax, fhash
12614# else
12615 WRITE (stdout,70) trim(vname(2,idubld(i))), &
12616 & fmin, fmax
12617# endif
12618 END IF
12619 END IF
12620 ELSE
12621 IF (master) THEN
12622 WRITE (stdout,80) string, trim(vname(1,idubld(i))), &
12623 & trim(ncname)
12624 END IF
12625 exit_flag=4
12626 IF (founderror(exit_flag, pio_noerr, &
12627 & __line__, myfile)) THEN
12628 RETURN
12629 END IF
12630 END IF
12631 END IF
12632!
12633 IF (get_var(idvbld(i))) THEN
12634 foundit=find_string(var_name, n_var, &
12635 & trim(vname(1,idvbld(i))), vindex)
12636 IF (foundit) THEN
12637 my_piovar%vd=var_desc(vindex)
12638 my_piovar%gtype=v2dvar
12639 IF (kind(sedbed(ng)%ad_bedldv).eq.8) THEN
12640 my_piovar%dkind=pio_double
12641 iodesc => iodesc_dp_v2dvar(ng)
12642 ELSE
12643 my_piovar%dkind=pio_real
12644 iodesc => iodesc_sp_v2dvar(ng)
12645 END IF
12646!
12647 status=nf_fread2d(ng, idmod, ncname, piofile, &
12648 & vname(1,idvbld(i)), my_piovar, &
12649 & inprec, iodesc, vsize, &
12650 & lbi, ubi, lbj, ubj, &
12651 & fscl, fmin, fmax, &
12652# ifdef MASKING
12653 & grid(ng) % vmask, &
12654# endif
12655# ifdef CHECKSUM
12656 & sedbed(ng) % ad_bedldv(:,:,i), &
12657 & checksum = fhash)
12658# else
12659 & sedbed(ng) % ad_bedldv(:,:,i))
12660# endif
12661 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12662 IF (master) THEN
12663 WRITE (stdout,60) string, trim(vname(1,idvbld(i))), &
12664 & inprec, trim(ncname)
12665 END IF
12666 exit_flag=2
12667 ioerror=status
12668 RETURN
12669 ELSE
12670 IF (master) THEN
12671# ifdef CHECKSUM
12672 WRITE (stdout,70) trim(vname(2,idvbld(i))), &
12673 & fmin, fmax, fhash
12674# else
12675 WRITE (stdout,70) trim(vname(2,idvbld(i))), &
12676 & fmin, fmax
12677# endif
12678 END IF
12679 END IF
12680 ELSE
12681 IF (master) THEN
12682 WRITE (stdout,80) string, trim(vname(1,idvbld(i))), &
12683 & trim(ncname)
12684 END IF
12685 exit_flag=4
12686 IF (founderror(exit_flag, pio_noerr, &
12687 & __line__, myfile)) THEN
12688 RETURN
12689 END IF
12690 END IF
12691 END IF
12692 END DO
12693# endif
12694# endif
12695# if defined SEDIMENT || defined BBL_MODEL
12696!
12697! Read in adjoint sediment properties in exposed bed layer.
12698!
12699 DO i=1,mbotp
12700 IF (get_var(idbott(i)).and.have_var(idbott(i))) THEN
12701 foundit=find_string(var_name, n_var, &
12702 & trim(vname(1,idbott(i))), vindex)
12703 IF (foundit) THEN
12704 my_piovar%vd=var_desc(vindex)
12705 my_piovar%gtype=r2dvar
12706 IF (kind(sedbed(ng)%tl_bottom).eq.8) THEN
12707 my_piovar%dkind=pio_double
12708 iodesc => iodesc_dp_r2dvar(ng)
12709 ELSE
12710 my_piovar%dkind=pio_real
12711 iodesc => iodesc_sp_r2dvar(ng)
12712 END IF
12713!
12714 status=nf_fread2d(ng, idmod, ncname, piofile, &
12715 & vname(1,idbott(i)), my_piovar, &
12716 & inprec, iodesc, vsize, &
12717 & lbi, ubi, lbj, ubj, &
12718 & fscl, fmin, fmax, &
12719# ifdef MASKING
12720 & grid(ng) % rmask, &
12721# endif
12722# ifdef CHECKSUM
12723 & sedbed(ng) % ad_bottom(:,:,i), &
12724 & checksum = fhash)
12725# else
12726 & sedbed(ng) % ad_bottom(:,:,i))
12727# endif
12728 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12729 IF (master) THEN
12730 WRITE (stdout,60) string, trim(vname(1,idbott(i))), &
12731 & inprec, trim(ncname)
12732 END IF
12733 exit_flag=2
12734 ioerror=status
12735 RETURN
12736 ELSE
12737 IF (master) THEN
12738# ifdef CHECKSUM
12739 WRITE (stdout,70) trim(vname(2,idbott(i))), &
12740 & fmin, fmax, fhash
12741# else
12742 WRITE (stdout,70) trim(vname(2,idbott(i))), &
12743 & fmin, fmax
12744# endif
12745 END IF
12746 END IF
12747 ELSE
12748 IF (master) THEN
12749 WRITE (stdout,80) string, trim(vname(1,idbott(i))), &
12750 & trim(ncname)
12751 END IF
12752 exit_flag=4
12753 IF (founderror(exit_flag, pio_noerr, &
12754 & __line__, myfile)) THEN
12755 RETURN
12756 END IF
12757 END IF
12758 END IF
12759 END DO
12760# endif
12761# endif
12762 END IF adm_state
12763# endif
12764
12765# ifdef FOUR_DVAR
12766!
12767!-----------------------------------------------------------------------
12768! Read in error covariance normalization (nondimensional) factors.
12769!-----------------------------------------------------------------------
12770!
12771 nrm_state: IF ((model.eq.14).or. &
12772 & (model.eq.15).or. &
12773 & (model.eq.16).or. &
12774 & (model.eq.17)) THEN
12775!
12776! Read in free-surface normalization factor.
12777!
12778 IF (get_var(idfsur).and.((model.eq.14).or.(model.eq.15))) THEN
12779 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
12780 & vindex)
12781 IF (foundit) THEN
12782 my_piovar%vd=var_desc(vindex)
12783 my_piovar%gtype=r2dvar
12784 IF (kind(ocean(ng)%b_zeta).eq.8) THEN
12785 my_piovar%dkind=pio_double
12786 iodesc => iodesc_dp_r2dvar(ng)
12787 ELSE
12788 my_piovar%dkind=pio_real
12789 iodesc => iodesc_sp_r2dvar(ng)
12790 END IF
12791!
12792 status=nf_fread2d(ng, idmod, ncname, piofile, &
12793 & vname(1,idfsur), my_piovar, &
12794 & inprec, iodesc, vsize, &
12795 & lbi, ubi, lbj, ubj, &
12796 & fscl, fmin, fmax, &
12797# ifdef MASKING
12798 & grid(ng) % rmask, &
12799# endif
12800# ifdef CHECKSUM
12801 & ocean(ng) % b_zeta(:,:,tindex), &
12802 & checksum = fhash)
12803# else
12804 & ocean(ng) % b_zeta(:,:,tindex))
12805# endif
12806 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12807 IF (master) THEN
12808 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
12809 & inprec, trim(ncname)
12810 END IF
12811 exit_flag=2
12812 ioerror=status
12813 RETURN
12814 ELSE
12815 IF (master) THEN
12816# ifdef CHECKSUM
12817 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
12818 & fhash
12819# else
12820 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
12821# endif
12822
12823 END IF
12824 END IF
12825# ifdef DISTRIBUTE
12826 CALL mp_exchange2d (ng, myrank, idmod, 1, &
12827 & lbi, ubi, lbj, ubj, &
12828 & nghostpoints, &
12829 & ewperiodic(ng), nsperiodic(ng), &
12830 & ocean(ng) % b_zeta(:,:,tindex))
12831# endif
12832 ELSE
12833 IF (master) THEN
12834 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
12835 & trim(ncname)
12836 END IF
12837 exit_flag=4
12838 IF (founderror(exit_flag, pio_noerr, &
12839 & __line__, myfile)) THEN
12840 RETURN
12841 END IF
12842 END IF
12843 END IF
12844!
12845! Read in 2D U-momentum component normalization factor.
12846!
12847 IF (get_var(idubar).and.((model.eq.14).or.(model.eq.15))) THEN
12848 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
12849 & vindex)
12850 IF (foundit) THEN
12851 my_piovar%vd=var_desc(vindex)
12852 my_piovar%gtype=u2dvar
12853 IF (kind(ocean(ng)%b_ubar).eq.8) THEN
12854 my_piovar%dkind=pio_double
12855 iodesc => iodesc_dp_u2dvar(ng)
12856 ELSE
12857 my_piovar%dkind=pio_real
12858 iodesc => iodesc_sp_u2dvar(ng)
12859 END IF
12860!
12861 status=nf_fread2d(ng, idmod, ncname, piofile, &
12862 & vname(1,idubar), my_piovar, &
12863 & inprec, iodesc, vsize, &
12864 & lbi, ubi, lbj, ubj, &
12865 & fscl, fmin, fmax, &
12866# ifdef MASKING
12867 & grid(ng) % umask, &
12868# endif
12869# ifdef CHECKSUM
12870 & ocean(ng) % b_ubar(:,:,tindex), &
12871 & checksum = fhash)
12872# else
12873 & ocean(ng) % b_ubar(:,:,tindex))
12874# endif
12875 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12876 IF (master) THEN
12877 WRITE (stdout,60) string, trim(vname(1,idubar)), &
12878 & inprec, trim(ncname)
12879 END IF
12880 exit_flag=2
12881 ioerror=status
12882 RETURN
12883 ELSE
12884 IF (master) THEN
12885# ifdef CHECKSUM
12886 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
12887 & fhash
12888# else
12889 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
12890# endif
12891 END IF
12892 END IF
12893# ifdef DISTRIBUTE
12894 CALL mp_exchange2d (ng, myrank, idmod, 1, &
12895 & lbi, ubi, lbj, ubj, &
12896 & nghostpoints, &
12897 & ewperiodic(ng), nsperiodic(ng), &
12898 & ocean(ng) % b_ubar(:,:,tindex))
12899# endif
12900 ELSE
12901 IF (master) THEN
12902 WRITE (stdout,80) string, trim(vname(1,idubar)), &
12903 & trim(ncname)
12904 END IF
12905 exit_flag=4
12906 IF (founderror(exit_flag, pio_noerr, &
12907 & __line__, myfile)) THEN
12908 RETURN
12909 END IF
12910 END IF
12911 END IF
12912!
12913! Read in 2D V-momentum component normalization factor.
12914!
12915 IF (get_var(idvbar).and.((model.eq.14).or.(model.eq.15))) THEN
12916 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
12917 & vindex)
12918 IF (foundit) THEN
12919 my_piovar%vd=var_desc(vindex)
12920 my_piovar%gtype=v2dvar
12921 IF (kind(ocean(ng)%b_vbar).eq.8) THEN
12922 my_piovar%dkind=pio_double
12923 iodesc => iodesc_dp_v2dvar(ng)
12924 ELSE
12925 my_piovar%dkind=pio_real
12926 iodesc => iodesc_sp_v2dvar(ng)
12927 END IF
12928!
12929 status=nf_fread2d(ng, idmod, ncname, piofile, &
12930 & vname(1,idvbar), my_piovar, &
12931 & inprec, iodesc, vsize, &
12932 & lbi, ubi, lbj, ubj, &
12933 & fscl, fmin, fmax, &
12934# ifdef MASKING
12935 & grid(ng) % vmask, &
12936# endif
12937# ifdef CHECKSUM
12938 & ocean(ng) % b_vbar(:,:,tindex), &
12939 & checksum = fhash)
12940# else
12941 & ocean(ng) % b_vbar(:,:,tindex))
12942# endif
12943 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
12944 IF (master) THEN
12945 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
12946 & inprec, trim(ncname)
12947 END IF
12948 exit_flag=2
12949 ioerror=status
12950 RETURN
12951 ELSE
12952 IF (master) THEN
12953# ifdef CHECKSUM
12954 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
12955 & fhash
12956# else
12957 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
12958# endif
12959 END IF
12960 END IF
12961# ifdef DISTRIBUTE
12962 CALL mp_exchange2d (ng, myrank, idmod, 1, &
12963 & lbi, ubi, lbj, ubj, &
12964 & nghostpoints, &
12965 & ewperiodic(ng), nsperiodic(ng), &
12966 & ocean(ng) % b_vbar(:,:,tindex))
12967# endif
12968 ELSE
12969 IF (master) THEN
12970 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
12971 & trim(ncname)
12972 END IF
12973 exit_flag=4
12974 IF (founderror(exit_flag, pio_noerr, &
12975 & __line__, myfile)) THEN
12976 RETURN
12977 END IF
12978
12979 END IF
12980 END IF
12981
12982# ifdef SOLVE3D
12983!
12984! Read in 3D U-momentum component normalization factor.
12985!
12986 IF (get_var(iduvel).and.((model.eq.14).or.(model.eq.15))) THEN
12987 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
12988 & vindex)
12989 IF (foundit) THEN
12990 my_piovar%vd=var_desc(vindex)
12991 my_piovar%gtype=u3dvar
12992 IF (kind(ocean(ng)%b_u).eq.8) THEN
12993 my_piovar%dkind=pio_double
12994 iodesc => iodesc_dp_u3dvar(ng)
12995 ELSE
12996 my_piovar%dkind=pio_real
12997 iodesc => iodesc_sp_u3dvar(ng)
12998 END IF
12999!
13000 status=nf_fread3d(ng, idmod, ncname, piofile, &
13001 & vname(1,iduvel), my_piovar, &
13002 & inprec, iodesc, vsize, &
13003 & lbi, ubi, lbj, ubj, 1, n(ng), &
13004 & fscl, fmin, fmax, &
13005# ifdef MASKING
13006 & grid(ng) % umask, &
13007# endif
13008# ifdef CHECKSUM
13009 & ocean(ng) % b_u(:,:,:,tindex), &
13010 & checksum = fhash)
13011# else
13012 & ocean(ng) % b_u(:,:,:,tindex))
13013# endif
13014 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13015 IF (master) THEN
13016 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
13017 & inprec, trim(ncname)
13018 END IF
13019 exit_flag=2
13020 ioerror=status
13021 RETURN
13022 ELSE
13023 IF (master) THEN
13024# ifdef CHECKSUM
13025 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
13026 & fhash
13027# else
13028 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
13029# endif
13030 END IF
13031 END IF
13032# ifdef DISTRIBUTE
13033 CALL mp_exchange3d (ng, myrank, idmod, 1, &
13034 & lbi, ubi, lbj, ubj, 1, n(ng), &
13035 & nghostpoints, &
13036 & ewperiodic(ng), nsperiodic(ng), &
13037 & ocean(ng) % b_u(:,:,:,tindex))
13038# endif
13039 ELSE
13040 IF (master) THEN
13041 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
13042 & trim(ncname)
13043 END IF
13044 exit_flag=4
13045 IF (founderror(exit_flag, pio_noerr, &
13046 & __line__, myfile)) THEN
13047 RETURN
13048 END IF
13049
13050 END IF
13051 END IF
13052!
13053! Read in 3D V-momentum component normalization factor.
13054!
13055 IF (get_var(idvvel).and.((model.eq.14).or.(model.eq.15))) THEN
13056 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
13057 & vindex)
13058 IF (foundit) THEN
13059 my_piovar%vd=var_desc(vindex)
13060 my_piovar%gtype=v3dvar
13061 IF (kind(ocean(ng)%b_v).eq.8) THEN
13062 my_piovar%dkind=pio_double
13063 iodesc => iodesc_dp_v3dvar(ng)
13064 ELSE
13065 my_piovar%dkind=pio_real
13066 iodesc => iodesc_sp_v3dvar(ng)
13067 END IF
13068!
13069 status=nf_fread3d(ng, idmod, ncname, piofile, &
13070 & vname(1,idvvel), my_piovar, &
13071 & inprec, iodesc, vsize, &
13072 & lbi, ubi, lbj, ubj, 1, n(ng), &
13073 & fscl, fmin, fmax, &
13074# ifdef MASKING
13075 & grid(ng) % vmask, &
13076# endif
13077# ifdef CHECKSUM
13078 & ocean(ng) % b_v(:,:,:,tindex), &
13079 & checksum = fhash)
13080# else
13081 & ocean(ng) % b_v(:,:,:,tindex))
13082# endif
13083 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13084 IF (master) THEN
13085 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
13086 & inprec, trim(ncname)
13087 END IF
13088 exit_flag=2
13089 ioerror=status
13090 RETURN
13091 ELSE
13092 IF (master) THEN
13093# ifdef CHECKSUM
13094 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
13095 & fhash
13096# else
13097 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
13098# endif
13099 END IF
13100 END IF
13101# ifdef DISTRIBUTE
13102 CALL mp_exchange3d (ng, myrank, idmod, 1, &
13103 & lbi, ubi, lbj, ubj, 1, n(ng), &
13104 & nghostpoints, &
13105 & ewperiodic(ng), nsperiodic(ng), &
13106 & ocean(ng) % b_v(:,:,:,tindex))
13107# endif
13108 ELSE
13109 IF (master) THEN
13110 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
13111 & trim(ncname)
13112 END IF
13113 exit_flag=4
13114 IF (founderror(exit_flag, pio_noerr, &
13115 & __line__, myfile)) THEN
13116 RETURN
13117 END IF
13118
13119 END IF
13120 END IF
13121!
13122! Read in tracer type variables normalization factor.
13123!
13124 DO itrc=1,nt(ng)
13125 IF (get_var(idtvar(itrc)).and. &
13126 & ((model.eq.14).or.(model.eq.15))) THEN
13127 foundit=find_string(var_name, n_var, &
13128 & trim(vname(1,idtvar(itrc))), vindex)
13129 IF (foundit) THEN
13130 my_piovar%vd=var_desc(vindex)
13131 my_piovar%gtype=r3dvar
13132 IF (kind(ocean(ng)%b_t).eq.8) THEN
13133 my_piovar%dkind=pio_double
13134 iodesc => iodesc_dp_r3dvar(ng)
13135 ELSE
13136 my_piovar%dkind=pio_real
13137 iodesc => iodesc_sp_r3dvar(ng)
13138 END IF
13139!
13140 status=nf_fread3d(ng, idmod, ncname, piofile, &
13141 & vname(1,idtvar(itrc)), my_piovar, &
13142 & inprec, iodesc, vsize, &
13143 & lbi, ubi, lbj, ubj, 1, n(ng), &
13144 & fscl, fmin, fmax, &
13145# ifdef MASKING
13146 & grid(ng) % rmask, &
13147# endif
13148# ifdef CHECKSUM
13149 & ocean(ng) % b_t(:,:,:,tindex,itrc), &
13150 & checksum = fhash)
13151# else
13152 & ocean(ng) % b_t(:,:,:,tindex,itrc))
13153# endif
13154 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13155 IF (master) THEN
13156 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
13157 & inprec, trim(ncname)
13158 END IF
13159 exit_flag=2
13160 ioerror=status
13161 RETURN
13162 ELSE
13163 IF (master) THEN
13164# ifdef CHECKSUM
13165 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
13166 & fmin, fmax, fhash
13167# else
13168 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
13169 & fmin, fmax
13170# endif
13171 END IF
13172 END IF
13173# ifdef DISTRIBUTE
13174 CALL mp_exchange3d (ng, myrank, idmod, 1, &
13175 & lbi, ubi, lbj, ubj, 1, n(ng), &
13176 & nghostpoints, &
13177 & ewperiodic(ng), nsperiodic(ng), &
13178 & ocean(ng) % b_t(:,:,:,tindex,itrc))
13179# endif
13180 ELSE
13181 IF (master) THEN
13182 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
13183 & trim(ncname)
13184 END IF
13185 exit_flag=4
13186 IF (founderror(exit_flag, pio_noerr, &
13187 & __line__, myfile)) THEN
13188 RETURN
13189 END IF
13190 END IF
13191 END IF
13192 END DO
13193# endif
13194# ifdef ADJUST_BOUNDARY
13195!
13196! Read in free-surface open boundaries normalization factor.
13197!
13198 IF (get_var(idsbry(isfsur)).and.(model.eq.16).and. &
13199 & any(lobc(:,isfsur,ng))) THEN
13200 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
13201 & vname(1,idsbry(isfsur)), &
13202 & boundary(ng) % b_zeta_obc(lbij:,:), &
13203 & piofile = piofile, &
13204 & start = (/1,1,inprec/), &
13205 & total = (/iorj,4,1/), &
13206 & min_val = fmin, &
13207 & max_val = fmax)
13208 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
13209 IF (master) THEN
13210 WRITE (stdout,75) trim(vname(1,idsbry(isfsur))), &
13211 & fmin, fmax
13212 END IF
13213 END IF
13214!
13215! Read in 2D U-momentum component open boundaries normalization factor.
13216!
13217 IF (get_var(idsbry(isubar)).and.(model.eq.16).and. &
13218 & any(lobc(:,isubar,ng))) THEN
13219 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
13220 & vname(1,idsbry(isubar)), &
13221 & boundary(ng) % b_ubar_obc(lbij:,:), &
13222 & piofile = piofile, &
13223 & start = (/1,1,inprec/), &
13224 & total = (/iorj,4,1/), &
13225 & min_val = fmin, &
13226 & max_val = fmax)
13227 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
13228 IF (master) THEN
13229 WRITE (stdout,75) trim(vname(1,idsbry(isubar))), &
13230 & fmin, fmax
13231 END IF
13232 END IF
13233!
13234! Read in 2D V-momentum component open boundaries normalization factor.
13235!
13236 IF (get_var(idsbry(isvbar)).and.(model.eq.16).and. &
13237 & any(lobc(:,isvbar,ng))) THEN
13238 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
13239 & vname(1,idsbry(isvbar)), &
13240 & boundary(ng) % b_vbar_obc(lbij:,:), &
13241 & piofile = piofile, &
13242 & start = (/1,1,inprec/), &
13243 & total = (/iorj,4,1/), &
13244 & min_val = fmin, &
13245 & max_val = fmax)
13246 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
13247 IF (master) THEN
13248 WRITE (stdout,75) trim(vname(1,idsbry(isvbar))), &
13249 & fmin, fmax
13250 END IF
13251 END IF
13252
13253# ifdef SOLVE3D
13254!
13255! Read in 3D U-momentum component open boundaries normalization factor.
13256!
13257 IF (get_var(idsbry(isuvel)).and.(model.eq.16).and. &
13258 & any(lobc(:,isuvel,ng))) THEN
13259 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
13260 & vname(1,idsbry(isuvel)), &
13261 & boundary(ng) % b_u_obc(lbij:,:,:), &
13262 & piofile = piofile, &
13263 & start = (/1,1,1,inprec/), &
13264 & total = (/iorj,n(ng),4,1/), &
13265 & min_val = fmin, &
13266 & max_val = fmax)
13267 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
13268 IF (master) THEN
13269 WRITE (stdout,75) trim(vname(1,idsbry(isuvel))), &
13270 & fmin, fmax
13271 END IF
13272 END IF
13273!
13274! Read in 3D V-momentum component open boundaries normalization factor.
13275!
13276 IF (get_var(idsbry(isvvel)).and.(model.eq.16).and. &
13277 & any(lobc(:,isvvel,ng))) THEN
13278 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
13279 & vname(1,idsbry(isvvel)), &
13280 & boundary(ng) % b_v_obc(lbij:,:,:), &
13281 & piofile = piofile, &
13282 & start = (/1,1,1,inprec/), &
13283 & total = (/iorj,n(ng),4,1/), &
13284 & min_val = fmin, &
13285 & max_val = fmax)
13286 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
13287 IF (master) THEN
13288 WRITE (stdout,75) trim(vname(1,idsbry(isvvel))), &
13289 & fmin, fmax
13290 END IF
13291 END IF
13292!
13293! Read in 3D tracers open boundaries normalization factor.
13294!
13295 DO itrc=1,nt(ng)
13296 IF (get_var(idsbry(istvar(itrc))).and.(model.eq.16).and. &
13297 & any(lobc(:,istvar(itrc),ng))) THEN
13298 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
13299 & vname(1,idsbry(istvar(itrc))), &
13300 & boundary(ng) % b_t_obc(lbij:,:,:, &
13301 & itrc), &
13302 & piofile = piofile, &
13303 & start =(/1,1,1,inprec/), &
13304 & total =(/iorj,n(ng),4,1/), &
13305 & min_val = fmin, &
13306 & max_val = fmax)
13307 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
13308 IF (master) THEN
13309 WRITE (stdout,75) trim(vname(1,idsbry(istvar(itrc)))), &
13310 & fmin, fmax
13311 END IF
13312 END IF
13313 END DO
13314# endif
13315# endif
13316# ifdef ADJUST_WSTRESS
13317!
13318! Read in surface U-momentum stress normalization factors.
13319!
13320 IF (get_var(idusms).and.(model.eq.17)) THEN
13321 foundit=find_string(var_name, n_var, trim(vname(1,idusms)), &
13322 & vindex)
13323 IF (foundit) THEN
13324 my_piovar%vd=var_desc(vindex)
13325 my_piovar%gtype=u2dvar
13326 IF (kind(forces(ng)%b_sustr).eq.8) THEN
13327 my_piovar%dkind=pio_double
13328 iodesc => iodesc_dp_u2dvar(ng)
13329 ELSE
13330 my_piovar%dkind=pio_real
13331 iodesc => iodesc_sp_u2dvar(ng)
13332 END IF
13333!
13334 status=nf_fread2d(ng, idmod, ncname, piofile, &
13335 & vname(1,idusms), my_piovar, &
13336 & inprec, iodesc, vsize, &
13337 & lbi, ubi, lbj, ubj, &
13338 & fscl, fmin, fmax, &
13339# ifdef MASKING
13340 & grid(ng) % umask, &
13341# endif
13342# ifdef CHECKSUM
13343 & forces(ng) % b_sustr, &
13344 & checksum = fhash)
13345# else
13346 & forces(ng) % b_sustr)
13347# endif
13348 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13349 IF (master) THEN
13350 WRITE (stdout,60) string, trim(vname(1,idusms)), &
13351 & inprec, trim(ncname)
13352 END IF
13353 exit_flag=2
13354 ioerror=status
13355 RETURN
13356 ELSE
13357 IF (master) THEN
13358# ifdef CHECKSUM
13359 WRITE (stdout,70) trim(vname(2,idusms)), fmin, fmax, &
13360 & fhash
13361# else
13362 WRITE (stdout,70) trim(vname(2,idusms)), fmin, fmax
13363# endif
13364 END IF
13365 END IF
13366# ifdef DISTRIBUTE
13367 CALL mp_exchange2d (ng, myrank, idmod, 1, &
13368 & lbi, ubi, lbj, ubj, &
13369 & nghostpoints, &
13370 & ewperiodic(ng), nsperiodic(ng), &
13371 & forces(ng) % b_sustr)
13372# endif
13373 ELSE
13374 IF (master) THEN
13375 WRITE (stdout,80) string, trim(vname(1,idusms)), &
13376 & trim(ncname)
13377 END IF
13378 exit_flag=4
13379 IF (founderror(exit_flag, pio_noerr, &
13380 & __line__, myfile)) THEN
13381 RETURN
13382 END IF
13383 END IF
13384 END IF
13385!
13386! Read in surface V-momentum stress normalization factors.
13387!
13388 IF (get_var(idvsms).and.(model.eq.17)) THEN
13389 foundit=find_string(var_name, n_var, trim(vname(1,idvsms)), &
13390 & vindex)
13391 IF (foundit) THEN
13392 my_piovar%vd=var_desc(vindex)
13393 my_piovar%gtype=v2dvar
13394 IF (kind(forces(ng)%b_svstr).eq.8) THEN
13395 my_piovar%dkind=pio_double
13396 iodesc => iodesc_dp_v2dvar(ng)
13397 ELSE
13398 my_piovar%dkind=pio_real
13399 iodesc => iodesc_sp_v2dvar(ng)
13400 END IF
13401!
13402 status=nf_fread2d(ng, idmod, ncname, piofile, &
13403 & vname(1,idvsms), my_piovar, &
13404 & inprec, iodesc, vsize, &
13405 & lbi, ubi, lbj, ubj, &
13406 & fscl, fmin, fmax, &
13407# ifdef MASKING
13408 & grid(ng) % vmask, &
13409# endif
13410# ifdef CHECKSUM
13411 & forces(ng) % b_svstr, &
13412 & checksum = fhash)
13413# else
13414 & forces(ng) % b_svstr)
13415# endif
13416 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13417 IF (master) THEN
13418 WRITE (stdout,60) string, trim(vname(1,idvsms)), &
13419 & inprec, trim(ncname)
13420 END IF
13421 exit_flag=2
13422 ioerror=status
13423 RETURN
13424 ELSE
13425 IF (master) THEN
13426# ifdef CHECKSUM
13427 WRITE (stdout,70) trim(vname(2,idvsms)), fmin, fmax, &
13428 & fhash
13429# else
13430 WRITE (stdout,70) trim(vname(2,idvsms)), fmin, fmax
13431# endif
13432 END IF
13433 END IF
13434# ifdef DISTRIBUTE
13435 CALL mp_exchange2d (ng, myrank, idmod, 1, &
13436 & lbi, ubi, lbj, ubj, &
13437 & nghostpoints, &
13438 & ewperiodic(ng), nsperiodic(ng), &
13439 & forces(ng) % b_svstr)
13440# endif
13441 ELSE
13442 IF (master) THEN
13443 WRITE (stdout,80) string, trim(vname(1,idvsms)), &
13444 & trim(ncname)
13445 END IF
13446 exit_flag=4
13447 IF (founderror(exit_flag, pio_noerr, &
13448 & __line__, myfile)) THEN
13449 RETURN
13450 END IF
13451
13452 END IF
13453 END IF
13454# endif
13455# if defined ADJUST_STFLUX && defined SOLVE3D
13456!
13457! Read in surface tracer flux normalization factors.
13458!
13459 DO itrc=1,nt(ng)
13460 IF (get_var(idtsur(itrc)).and.(model.eq.17).and. &
13461 & lstflux(itrc,ng)) THEN
13462 foundit=find_string(var_name, n_var, &
13463 & trim(vname(1,idtsur(itrc))), vindex)
13464 IF (foundit) THEN
13465 my_piovar%vd=var_desc(vindex)
13466 my_piovar%gtype=r2dvar
13467 IF (kind(forces(ng)%b_stflx).eq.8) THEN
13468 my_piovar%dkind=pio_double
13469 iodesc => iodesc_dp_r2dvar(ng)
13470 ELSE
13471 my_piovar%dkind=pio_real
13472 iodesc => iodesc_sp_r2dvar(ng)
13473 END IF
13474!
13475 status=nf_fread2d(ng, idmod, ncname, piofile, &
13476 & vname(1,idtsur(itrc)), my_piovar, &
13477 & inprec, iodesc, vsize, &
13478 & lbi, ubi, lbj, ubj, &
13479 & fscl, fmin, fmax, &
13480# ifdef MASKING
13481 & grid(ng) % rmask, &
13482# endif
13483# ifdef CHECKSUM
13484 & forces(ng) % b_stflx(:,:,itrc), &
13485 & checksum = fhash)
13486# else
13487 & forces(ng) % b_stflx(:,:,itrc))
13488# endif
13489 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13490 IF (master) THEN
13491 WRITE (stdout,60) string, trim(vname(1,idtsur(itrc))),&
13492 & inprec, trim(ncname)
13493 END IF
13494 exit_flag=2
13495 ioerror=status
13496 RETURN
13497 ELSE
13498 IF (master) THEN
13499# ifdef CHECKSUM
13500 WRITE (stdout,70) trim(vname(2,idtsur(itrc))), &
13501 & fmin, fmax, fhash
13502# else
13503 WRITE (stdout,70) trim(vname(2,idtsur(itrc))), &
13504 & fmin, fmax
13505# endif
13506 END IF
13507 END IF
13508# ifdef DISTRIBUTE
13509 CALL mp_exchange2d (ng, myrank, idmod, 1, &
13510 & lbi, ubi, lbj, ubj, &
13511 & nghostpoints, &
13512 & ewperiodic(ng), nsperiodic(ng), &
13513 & forces(ng) % b_stflx(:,:,itrc))
13514# endif
13515 ELSE
13516 IF (master) THEN
13517 WRITE (stdout,80) string, trim(vname(1,idtsur(itrc))), &
13518 & trim(ncname)
13519 END IF
13520 exit_flag=4
13521 IF (founderror(exit_flag, pio_noerr, &
13522 & __line__, myfile)) THEN
13523 RETURN
13524 END IF
13525 END IF
13526 END IF
13527 END DO
13528# endif
13529 END IF nrm_state
13530# endif
13531
13532# if defined FOUR_DVAR || (defined HESSIAN_SV && defined BNORM)
13533!
13534!-----------------------------------------------------------------------
13535! Read in error covariance standard deviation factors.
13536!-----------------------------------------------------------------------
13537!
13538 std_state: IF ((model.eq.10).or. &
13539 & (model.eq.11).or. &
13540 & (model.eq.12).or. &
13541 & (model.eq.13)) THEN
13542!
13543! Read in free-surface standard deviation.
13544!
13545 IF (get_var(idfsur).and.((model.eq.10).or.(model.eq.11))) THEN
13546 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
13547 & vindex)
13548 IF (foundit) THEN
13549 my_piovar%vd=var_desc(vindex)
13550 my_piovar%gtype=r2dvar
13551 IF (kind(ocean(ng)%e_zeta).eq.8) THEN
13552 my_piovar%dkind=pio_double
13553 iodesc => iodesc_dp_r2dvar(ng)
13554 ELSE
13555 my_piovar%dkind=pio_real
13556 iodesc => iodesc_sp_r2dvar(ng)
13557 END IF
13558!
13559 status=nf_fread2d(ng, idmod, ncname, piofile, &
13560 & vname(1,idfsur), my_piovar, &
13561 & inprec, iodesc, vsize, &
13562 & lbi, ubi, lbj, ubj, &
13563 & fscl, fmin, fmax, &
13564# ifdef MASKING
13565 & grid(ng) % rmask, &
13566# endif
13567# ifdef CHECKSUM
13568 & ocean(ng) % e_zeta(:,:,tindex), &
13569 & checksum = fhash)
13570# else
13571 & ocean(ng) % e_zeta(:,:,tindex))
13572# endif
13573 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13574 IF (master) THEN
13575 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
13576 & inprec, trim(ncname)
13577 END IF
13578 exit_flag=2
13579 ioerror=status
13580 RETURN
13581 ELSE
13582 IF (master) THEN
13583# ifdef CHECKSUM
13584 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
13585 & fhash
13586# else
13587 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
13588# endif
13589 END IF
13590 END IF
13591# ifdef DISTRIBUTE
13592 CALL mp_exchange2d (ng, myrank, idmod, 1, &
13593 & lbi, ubi, lbj, ubj, &
13594 & nghostpoints, &
13595 & ewperiodic(ng), nsperiodic(ng), &
13596 & ocean(ng) % e_zeta(:,:,tindex))
13597# endif
13598 ELSE
13599 IF (master) THEN
13600 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
13601 & trim(ncname)
13602 END IF
13603 exit_flag=4
13604 IF (founderror(exit_flag, pio_noerr, &
13605 & __line__, myfile)) THEN
13606 RETURN
13607 END IF
13608
13609 END IF
13610 END IF
13611!
13612! Read in 2D U-momentum component standard deviation.
13613!
13614 IF (get_var(idubar).and.((model.eq.10).or.(model.eq.11))) THEN
13615 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
13616 & vindex)
13617 IF (foundit) THEN
13618 my_piovar%vd=var_desc(vindex)
13619 my_piovar%gtype=u2dvar
13620 IF (kind(ocean(ng)%e_ubar).eq.8) THEN
13621 my_piovar%dkind=pio_double
13622 iodesc => iodesc_dp_u2dvar(ng)
13623 ELSE
13624 my_piovar%dkind=pio_real
13625 iodesc => iodesc_sp_u2dvar(ng)
13626 END IF
13627!
13628 status=nf_fread2d(ng, idmod, ncname, piofile, &
13629 & vname(1,idubar), my_piovar, &
13630 & inprec, iodesc, vsize, &
13631 & lbi, ubi, lbj, ubj, &
13632 & fscl, fmin, fmax, &
13633# ifdef MASKING
13634 & grid(ng) % umask, &
13635# endif
13636# ifdef CHECKSUM
13637 & ocean(ng) % e_ubar(:,:,tindex), &
13638 & checksum = fhash)
13639# else
13640 & ocean(ng) % e_ubar(:,:,tindex))
13641# endif
13642 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13643 IF (master) THEN
13644 WRITE (stdout,60) string, trim(vname(1,idubar)), &
13645 & inprec, trim(ncname)
13646 END IF
13647 exit_flag=2
13648 ioerror=status
13649 RETURN
13650 ELSE
13651 IF (master) THEN
13652# ifdef CHECKSUM
13653 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
13654 & fhash
13655# else
13656 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
13657# endif
13658 END IF
13659 END IF
13660# ifdef DISTRIBUTE
13661 CALL mp_exchange2d (ng, myrank, idmod, 1, &
13662 & lbi, ubi, lbj, ubj, &
13663 & nghostpoints, &
13664 & ewperiodic(ng), nsperiodic(ng), &
13665 & ocean(ng) % e_ubar(:,:,tindex))
13666# endif
13667 ELSE
13668 IF (master) THEN
13669 WRITE (stdout,80) string, trim(vname(1,idubar)), &
13670 & trim(ncname)
13671 END IF
13672 exit_flag=4
13673 IF (founderror(exit_flag, pio_noerr, &
13674 & __line__, myfile)) THEN
13675 RETURN
13676 END IF
13677 END IF
13678 END IF
13679!
13680! Read in 2D V-momentum component standard deviation.
13681!
13682 IF (get_var(idvbar).and.((model.eq.10).or.(model.eq.11))) THEN
13683 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
13684 & vindex)
13685 IF (foundit) THEN
13686 my_piovar%vd=var_desc(vindex)
13687 my_piovar%gtype=v2dvar
13688 IF (kind(ocean(ng)%e_vbar).eq.8) THEN
13689 my_piovar%dkind=pio_double
13690 iodesc => iodesc_dp_v2dvar(ng)
13691 ELSE
13692 my_piovar%dkind=pio_real
13693 iodesc => iodesc_sp_v2dvar(ng)
13694 END IF
13695!
13696 status=nf_fread2d(ng, idmod, ncname, piofile, &
13697 & vname(1,idvbar), my_piovar, &
13698 & inprec, iodesc, vsize, &
13699 & lbi, ubi, lbj, ubj, &
13700 & fscl, fmin, fmax, &
13701# ifdef MASKING
13702 & grid(ng) % vmask, &
13703# endif
13704# ifdef CHECKSUM
13705 & ocean(ng) % e_vbar(:,:,tindex), &
13706 & checksum = fhash)
13707# else
13708 & ocean(ng) % e_vbar(:,:,tindex))
13709# endif
13710 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13711 IF (master) THEN
13712 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
13713 & inprec, trim(ncname)
13714 END IF
13715 exit_flag=2
13716 ioerror=status
13717 RETURN
13718 ELSE
13719 IF (master) THEN
13720# ifdef CHECKSUM
13721 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
13722 & fhash
13723# else
13724 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
13725# endif
13726
13727 END IF
13728 END IF
13729# ifdef DISTRIBUTE
13730 CALL mp_exchange2d (ng, myrank, idmod, 1, &
13731 & lbi, ubi, lbj, ubj, &
13732 & nghostpoints, &
13733 & ewperiodic(ng), nsperiodic(ng), &
13734 & ocean(ng) % e_vbar(:,:,tindex))
13735# endif
13736 ELSE
13737 IF (master) THEN
13738 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
13739 & trim(ncname)
13740 END IF
13741 exit_flag=4
13742 IF (founderror(exit_flag, pio_noerr, &
13743 & __line__, myfile)) THEN
13744 RETURN
13745 END IF
13746
13747 END IF
13748 END IF
13749
13750# ifdef SOLVE3D
13751!
13752! Read in 3D U-momentum component standard deviation.
13753!
13754 IF (get_var(iduvel).and.((model.eq.10).or.(model.eq.11))) THEN
13755 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
13756 & vindex)
13757 IF (foundit) THEN
13758 my_piovar%vd=var_desc(vindex)
13759 my_piovar%gtype=u3dvar
13760 IF (kind(ocean(ng)%b_u).eq.8) THEN
13761 my_piovar%dkind=pio_double
13762 iodesc => iodesc_dp_u3dvar(ng)
13763 ELSE
13764 my_piovar%dkind=pio_real
13765 iodesc => iodesc_sp_u3dvar(ng)
13766 END IF
13767!
13768 status=nf_fread3d(ng, idmod, ncname, piofile, &
13769 & vname(1,iduvel), my_piovar, &
13770 & inprec, iodesc, vsize, &
13771 & lbi, ubi, lbj, ubj, 1, n(ng), &
13772 & fscl, fmin, fmax, &
13773# ifdef MASKING
13774 & grid(ng) % umask, &
13775# endif
13776# ifdef CHECKSUM
13777 & ocean(ng) % e_u(:,:,:,tindex), &
13778 & checksum = fhash)
13779# else
13780 & ocean(ng) % e_u(:,:,:,tindex))
13781# endif
13782 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13783 IF (master) THEN
13784 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
13785 & inprec, trim(ncname)
13786 END IF
13787 exit_flag=2
13788 ioerror=status
13789 RETURN
13790 ELSE
13791 IF (master) THEN
13792# ifdef CHECKSUM
13793 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
13794 & fhash
13795# else
13796 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
13797# endif
13798 END IF
13799 END IF
13800# ifdef DISTRIBUTE
13801 CALL mp_exchange3d (ng, myrank, idmod, 1, &
13802 & lbi, ubi, lbj, ubj, 1, n(ng), &
13803 & nghostpoints, &
13804 & ewperiodic(ng), nsperiodic(ng), &
13805 & ocean(ng) % e_u(:,:,:,tindex))
13806# endif
13807 ELSE
13808 IF (master) THEN
13809 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
13810 & trim(ncname)
13811 END IF
13812 exit_flag=4
13813 IF (founderror(exit_flag, pio_noerr, &
13814 & __line__, myfile)) THEN
13815 RETURN
13816 END IF
13817 END IF
13818 END IF
13819!
13820! Read in 3D V-momentum standard deviation.
13821!
13822 IF (get_var(idvvel).and.((model.eq.10).or.(model.eq.11))) THEN
13823 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
13824 & vindex)
13825 IF (foundit) THEN
13826 my_piovar%vd=var_desc(vindex)
13827 my_piovar%gtype=v3dvar
13828 IF (kind(ocean(ng)%e_v).eq.8) THEN
13829 my_piovar%dkind=pio_double
13830 iodesc => iodesc_dp_v3dvar(ng)
13831 ELSE
13832 my_piovar%dkind=pio_real
13833 iodesc => iodesc_sp_v3dvar(ng)
13834 END IF
13835!
13836 status=nf_fread3d(ng, idmod, ncname, piofile, &
13837 & vname(1,idvvel), my_piovar, &
13838 & inprec, iodesc, vsize, &
13839 & lbi, ubi, lbj, ubj, 1, n(ng), &
13840 & fscl, fmin, fmax, &
13841# ifdef MASKING
13842 & grid(ng) % vmask, &
13843# endif
13844# ifdef CHECKSUM
13845 & ocean(ng) % e_v(:,:,:,tindex), &
13846 & checksum = fhash)
13847# else
13848 & ocean(ng) % e_v(:,:,:,tindex))
13849# endif
13850 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13851 IF (master) THEN
13852 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
13853 & inprec, trim(ncname)
13854 END IF
13855 exit_flag=2
13856 ioerror=status
13857 RETURN
13858 ELSE
13859 IF (master) THEN
13860# ifdef CHECKSUM
13861 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
13862 & fhash
13863# else
13864 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
13865# endif
13866 END IF
13867 END IF
13868# ifdef DISTRIBUTE
13869 CALL mp_exchange3d (ng, myrank, idmod, 1, &
13870 & lbi, ubi, lbj, ubj, 1, n(ng), &
13871 & nghostpoints, &
13872 & ewperiodic(ng), nsperiodic(ng), &
13873 & ocean(ng) % e_v(:,:,:,tindex))
13874# endif
13875 ELSE
13876 IF (master) THEN
13877 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
13878 & trim(ncname)
13879 END IF
13880 exit_flag=4
13881 IF (founderror(exit_flag, pio_noerr, &
13882 & __line__, myfile)) THEN
13883 RETURN
13884 END IF
13885
13886 END IF
13887 END IF
13888!
13889! Read in tracer type variables standard deviation.
13890!
13891 DO itrc=1,nt(ng)
13892 IF (get_var(idtvar(itrc)).and. &
13893 & ((model.eq.10).or.(model.eq.11))) THEN
13894 foundit=find_string(var_name, n_var, &
13895 & trim(vname(1,idtvar(itrc))), vindex)
13896 IF (foundit) THEN
13897 my_piovar%vd=var_desc(vindex)
13898 my_piovar%gtype=r3dvar
13899 IF (kind(ocean(ng)%e_t).eq.8) THEN
13900 my_piovar%dkind=pio_double
13901 iodesc => iodesc_dp_r3dvar(ng)
13902 ELSE
13903 my_piovar%dkind=pio_real
13904 iodesc => iodesc_sp_r3dvar(ng)
13905 END IF
13906!
13907 status=nf_fread3d(ng, idmod, ncname, piofile, &
13908 & vname(1,idtvar(itrc)), my_piovar, &
13909 & inprec, iodesc, vsize, &
13910 & lbi, ubi, lbj, ubj, 1, n(ng), &
13911 & fscl, fmin, fmax, &
13912# ifdef MASKING
13913 & grid(ng) % rmask, &
13914# endif
13915# ifdef CHECKSUM
13916 & ocean(ng) % e_t(:,:,:,tindex,itrc), &
13917 & checksum = fhash)
13918# else
13919 & ocean(ng) % e_t(:,:,:,tindex,itrc))
13920# endif
13921 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13922 IF (master) THEN
13923 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
13924 & inprec, trim(ncname)
13925 END IF
13926 exit_flag=2
13927 ioerror=status
13928 RETURN
13929 ELSE
13930 IF (master) THEN
13931# ifdef CHECKSUM
13932 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
13933 & fmin, fmax, fhash
13934# else
13935 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
13936 & fmin, fmax
13937# endif
13938 END IF
13939 END IF
13940# ifdef DISTRIBUTE
13941 CALL mp_exchange3d (ng, myrank, idmod, 1, &
13942 & lbi, ubi, lbj, ubj, 1, n(ng), &
13943 & nghostpoints, &
13944 & ewperiodic(ng), nsperiodic(ng), &
13945 & ocean(ng) % e_t(:,:,:,tindex,itrc))
13946# endif
13947 ELSE
13948 IF (master) THEN
13949 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
13950 & trim(ncname)
13951 END IF
13952 exit_flag=4
13953 IF (founderror(exit_flag, pio_noerr, &
13954 & __line__, myfile)) THEN
13955 RETURN
13956 END IF
13957 END IF
13958 END IF
13959 END DO
13960# endif
13961!
13962! Read in convolution horizontal diffusion coefficients.
13963!
13964 IF (have_var(idkhor).and.((model.eq.10).or.(model.eq.11))) THEN
13965 foundit=find_string(var_name, n_var, trim(vname(1,idkhor)), &
13966 & vindex)
13967 IF (foundit) THEN
13968 my_piovar%vd=var_desc(vindex)
13969 my_piovar%gtype=r2dvar
13970 IF (kind(mixing(ng)%Kh).eq.8) THEN
13971 my_piovar%dkind=pio_double
13972 iodesc => iodesc_dp_r2dvar(ng)
13973 ELSE
13974 my_piovar%dkind=pio_real
13975 iodesc => iodesc_sp_r2dvar(ng)
13976 END IF
13977!
13978 status=nf_fread2d(ng, idmod, ncname, piofile, &
13979 & vname(1,idkhor), my_piovar, &
13980 & inprec, iodesc, vsize, &
13981 & lbi, ubi, lbj, ubj, &
13982 & fscl, khmin(ng), khmax(ng), &
13983# ifdef MASKING
13984 & grid(ng) % rmask, &
13985# endif
13986# ifdef CHECKSUM
13987 & mixing(ng) % Kh, &
13988 & checksum = fhash)
13989# else
13990 & mixing(ng) % Kh)
13991# endif
13992 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
13993 IF (master) THEN
13994 WRITE (stdout,60) string, trim(vname(1,idkhor)), &
13995 & inprec, trim(ncname)
13996 END IF
13997 exit_flag=2
13998 ioerror=status
13999 RETURN
14000 ELSE
14001 IF (master) THEN
14002# ifdef CHECKSUM
14003 WRITE (stdout,70) trim(vname(2,idkhor)), &
14004 & khmin(ng), khmax(ng), fhash
14005# else
14006 WRITE (stdout,70) trim(vname(2,idkhor)), &
14007 & khmin(ng), khmax(ng)
14008# endif
14009 END IF
14010 END IF
14011# ifdef DISTRIBUTE
14012 CALL mp_exchange2d (ng, myrank, idmod, 1, &
14013 & lbi, ubi, lbj, ubj, &
14014 & nghostpoints, &
14015 & ewperiodic(ng), nsperiodic(ng), &
14016 & mixing(ng) % Kh)
14017# endif
14018 ELSE
14019 IF (master) THEN
14020 WRITE (stdout,80) string, trim(vname(1,idkhor)), &
14021 & trim(ncname)
14022 END IF
14023 exit_flag=4
14024 IF (founderror(exit_flag, pio_noerr, &
14025 & __line__, myfile)) THEN
14026 RETURN
14027 END IF
14028 END IF
14029 END IF
14030
14031# ifdef SOLVE3D
14032!
14033! Read in convolution vertical diffusion coefficient.
14034!
14035 IF (have_var(idkver).and.((model.eq.10).or.(model.eq.11))) THEN
14036 foundit=find_string(var_name, n_var, trim(vname(1,idkver)), &
14037 & vindex)
14038 IF (foundit) THEN
14039 my_piovar%vd=var_desc(vindex)
14040 my_piovar%gtype=w3dvar
14041 IF (kind(mixing(ng)%Kv).eq.8) THEN
14042 my_piovar%dkind=pio_double
14043 iodesc => iodesc_dp_w3dvar(ng)
14044 ELSE
14045 my_piovar%dkind=pio_real
14046 iodesc => iodesc_sp_w3dvar(ng)
14047 END IF
14048!
14049 status=nf_fread3d(ng, idmod, ncname, piofile, &
14050 & vname(1,idkver), my_piovar, &
14051 & inprec, iodesc, vsize, &
14052 & lbi, ubi, lbj, ubj, 0, n(ng), &
14053 & fscl, kvmin(ng), kvmax(ng), &
14054# ifdef MASKING
14055 & grid(ng) % rmask, &
14056# endif
14057# ifdef CHECKSUM
14058 & mixing(ng) % Kv, &
14059 & checksum = fhash)
14060# else
14061 & mixing(ng) % Kv)
14062# endif
14063 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
14064 IF (master) THEN
14065 WRITE (stdout,60) string, trim(vname(1,idkver)), &
14066 & inprec, trim(ncname)
14067 END IF
14068 exit_flag=2
14069 ioerror=status
14070 RETURN
14071 ELSE
14072 IF (master) THEN
14073# ifdef CHECKSUM
14074 WRITE (stdout,70) trim(vname(2,idkver)), &
14075 & kvmin(ng), kvmax, fhash
14076# else
14077 WRITE (stdout,70) trim(vname(2,idkver)), &
14078 & kvmin(ng), kvmax, fhash
14079# endif
14080 END IF
14081 END IF
14082# ifdef DISTRIBUTE
14083 CALL mp_exchange3d (ng, myrank, idmod, 1, &
14084 & lbi, ubi, lbj, ubj, 0, n(ng), &
14085 & nghostpoints, &
14086 & ewperiodic(ng), nsperiodic(ng), &
14087 & mixing(ng) % Kv)
14088# endif
14089 ELSE
14090 IF (master) THEN
14091 WRITE (stdout,80) string, trim(vname(1,idkver)), &
14092 & trim(ncname)
14093 END IF
14094 exit_flag=4
14095 IF (founderror(exit_flag, pio_noerr, &
14096 & __line__, myfile)) THEN
14097 RETURN
14098 END IF
14099 END IF
14100 END IF
14101# endif
14102# ifdef ADJUST_BOUNDARY
14103!
14104! Read in free-surface open boundaries standard deviation.
14105!
14106 IF (get_var(idsbry(isfsur)).and.(model.eq.12).and. &
14107 & any(lobc(:,isfsur,ng))) THEN
14108 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
14109 & vname(1,idsbry(isfsur)), &
14110 & boundary(ng) % e_zeta_obc(lbij:,:), &
14111 & piofile = piofile, &
14112 & start = (/1,1,inprec/), &
14113 & total = (/iorj,4,1/), &
14114 & min_val = fmin, &
14115 & max_val = fmax)
14116 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
14117 IF (master) THEN
14118 WRITE (stdout,75) trim(vname(1,idsbry(isfsur))), &
14119 & fmin, fmax
14120 END IF
14121 END IF
14122!
14123! Read in 2D U-momentum component open boundaries standard deviation.
14124!
14125 IF (get_var(idsbry(isubar)).and.(model.eq.12).and. &
14126 & any(lobc(:,isubar,ng))) THEN
14127 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
14128 & vname(1,idsbry(isubar)), &
14129 & boundary(ng) % e_ubar_obc(lbij:,:), &
14130 & piofile = piofile, &
14131 & start = (/1,1,inprec/), &
14132 & total = (/iorj,4,1/), &
14133 & min_val = fmin, &
14134 & max_val = fmax)
14135 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
14136 IF (master) THEN
14137 WRITE (stdout,75) trim(vname(1,idsbry(isubar))), &
14138 & fmin, fmax
14139 END IF
14140 END IF
14141!
14142! Read in 2D V-momentum component open boundaries standard deviation.
14143!
14144 IF (get_var(idsbry(isvbar)).and.(model.eq.12).and. &
14145 & any(lobc(:,isvbar,ng))) THEN
14146 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
14147 & vname(1,idsbry(isvbar)), &
14148 & boundary(ng) % e_vbar_obc(lbij:,:), &
14149 & piofile = piofile, &
14150 & start = (/1,1,inprec/), &
14151 & total = (/iorj,4,1/), &
14152 & min_val = fmin, &
14153 & max_val = fmax)
14154 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
14155 IF (master) THEN
14156 WRITE (stdout,75) trim(vname(1,idsbry(isvbar))), &
14157 & fmin, fmax
14158 END IF
14159 END IF
14160
14161# ifdef SOLVE3D
14162!
14163! Read in 3D U-momentum component open boundaries standard deviation.
14164!
14165 IF (get_var(idsbry(isuvel)).and.(model.eq.12).and. &
14166 & any(lobc(:,isuvel,ng))) THEN
14167 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
14168 & vname(1,idsbry(isuvel)), &
14169 & boundary(ng) % e_u_obc(lbij:,:,:), &
14170 & piofile = piofile, &
14171 & start = (/1,1,1,inprec/), &
14172 & total = (/iorj,n(ng),4,1/), &
14173 & min_val = fmin, &
14174 & max_val = fmax)
14175 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
14176 IF (master) THEN
14177 WRITE (stdout,75) trim(vname(1,idsbry(isuvel))), &
14178 & fmin, fmax
14179 END IF
14180 END IF
14181!
14182! Read in 3D V-momentum component open boundaries standard deviation.
14183!
14184 IF (get_var(idsbry(isvvel)).and.(model.eq.12).and. &
14185 & any(lobc(:,isvvel,ng))) THEN
14186 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
14187 & vname(1,idsbry(isvvel)), &
14188 & boundary(ng) % e_v_obc(lbij:,:,:), &
14189 & piofile = piofile, &
14190 & start = (/1,1,1,inprec/), &
14191 & total = (/iorj,n(ng),4,1/), &
14192 & min_val = fmin, &
14193 & max_val = fmax)
14194 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
14195 IF (master) THEN
14196 WRITE (stdout,75) trim(vname(1,idsbry(isvvel))), &
14197 & fmin, fmax
14198 END IF
14199 END IF
14200!
14201! Read in 3D tracers open boundaries standard deviation.
14202!
14203 DO itrc=1,nt(ng)
14204 IF (get_var(idsbry(istvar(itrc))).and.(model.eq.12).and. &
14205 & any(lobc(:,istvar(itrc),ng))) THEN
14206 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
14207 & vname(1,idsbry(istvar(itrc))), &
14208 & boundary(ng) % e_t_obc(lbij:,:,:, &
14209 & itrc), &
14210 & piofile = piofile, &
14211 & start =(/1,1,1,inprec/), &
14212 & total =(/iorj,n(ng),4,1/), &
14213 & min_val = fmin, &
14214 & max_val = fmax)
14215 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
14216 IF (master) THEN
14217 WRITE (stdout,75) trim(vname(1,idsbry(istvar(itrc)))), &
14218 & fmin, fmax
14219 END IF
14220 END IF
14221 END DO
14222# endif
14223# endif
14224# ifdef ADJUST_WSTRESS
14225!
14226! Read in surface U-momentum stress standard deviation.
14227!
14228 IF (get_var(idusms).and.(model.eq.13)) THEN
14229 foundit=find_string(var_name, n_var, trim(vname(1,idusms)), &
14230 & vindex)
14231 IF (foundit) THEN
14232 scale=1.0_dp/rho0 ! N/m2 (Pa) to m2/s2
14233 my_piovar%vd=var_desc(vindex)
14234 my_piovar%gtype=u2dvar
14235 IF (kind(forces(ng)%e_sustr).eq.8) THEN
14236 my_piovar%dkind=pio_double
14237 iodesc => iodesc_dp_u2dvar(ng)
14238 ELSE
14239 my_piovar%dkind=pio_real
14240 iodesc => iodesc_sp_u2dvar(ng)
14241 END IF
14242!
14243 status=nf_fread2d(ng, idmod, ncname, piofile, &
14244 & vname(1,idusms), my_piovar, &
14245 & inprec, iodesc, vsize, &
14246 & lbi, ubi, lbj, ubj, &
14247 & scale, fmin, fmax, &
14248# ifdef MASKING
14249 & grid(ng) % umask, &
14250# endif
14251# ifdef CHECKSUM
14252 & forces(ng) % e_sustr, &
14253 & checksum = fhash)
14254# else
14255 & forces(ng) % e_sustr)
14256# endif
14257 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
14258 IF (master) THEN
14259 WRITE (stdout,60) string, trim(vname(1,idusms)), &
14260 & inprec, trim(ncname)
14261 END IF
14262 exit_flag=2
14263 ioerror=status
14264 RETURN
14265 ELSE
14266 IF (master) THEN
14267# ifdef CHECKSUM
14268 WRITE (stdout,70) trim(vname(2,idusms)), fmin, fmax, &
14269 & fhash
14270# else
14271 WRITE (stdout,70) trim(vname(2,idusms)), fmin, fmax
14272# endif
14273 END IF
14274 END IF
14275# ifdef DISTRIBUTE
14276 CALL mp_exchange2d (ng, myrank, idmod, 1, &
14277 & lbi, ubi, lbj, ubj, &
14278 & nghostpoints, &
14279 & ewperiodic(ng), nsperiodic(ng), &
14280 & forces(ng) % e_sustr)
14281# endif
14282 ELSE
14283 IF (master) THEN
14284 WRITE (stdout,80) string, trim(vname(1,idusms)), &
14285 & trim(ncname)
14286 END IF
14287 exit_flag=4
14288 IF (founderror(exit_flag, pio_noerr, &
14289 & __line__, myfile)) THEN
14290 RETURN
14291 END IF
14292 END IF
14293 END IF
14294!
14295! Read in surface V-momentum stress standard deviation.
14296!
14297 IF (get_var(idvsms).and.(model.eq.13)) THEN
14298 foundit=find_string(var_name, n_var, trim(vname(1,idvsms)), &
14299 & vindex)
14300 IF (foundit) THEN
14301 scale=1.0_dp/rho0 ! N/m2 (Pa) to m2/s2
14302 my_piovar%vd=var_desc(vindex)
14303 my_piovar%gtype=v2dvar
14304 IF (kind(forces(ng)%e_svstr).eq.8) THEN
14305 my_piovar%dkind=pio_double
14306 iodesc => iodesc_dp_v2dvar(ng)
14307 ELSE
14308 my_piovar%dkind=pio_real
14309 iodesc => iodesc_sp_v2dvar(ng)
14310 END IF
14311!
14312 status=nf_fread2d(ng, idmod, ncname, piofile, &
14313 & vname(1,idvsms), my_piovar, &
14314 & inprec, iodesc, vsize, &
14315 & lbi, ubi, lbj, ubj, &
14316 & scale, fmin, fmax, &
14317# ifdef MASKING
14318 & grid(ng) % vmask, &
14319# endif
14320# ifdef CHECKSUM
14321 & forces(ng) % e_svstr, &
14322 & checksum = fhash)
14323# else
14324 & forces(ng) % e_svstr)
14325# endif
14326 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
14327 IF (master) THEN
14328 WRITE (stdout,60) string, trim(vname(1,idvsms)), &
14329 & inprec, trim(ncname)
14330 END IF
14331 exit_flag=2
14332 ioerror=status
14333 RETURN
14334 ELSE
14335 IF (master) THEN
14336# ifdef CHECKSUM
14337 WRITE (stdout,70) trim(vname(2,idvsms)), fmin, fmax, &
14338 & fhash
14339# else
14340 WRITE (stdout,70) trim(vname(2,idvsms)), fmin, fmax
14341# endif
14342 END IF
14343 END IF
14344# ifdef DISTRIBUTE
14345 CALL mp_exchange2d (ng, myrank, idmod, 1, &
14346 & lbi, ubi, lbj, ubj, &
14347 & nghostpoints, &
14348 & ewperiodic(ng), nsperiodic(ng), &
14349 & forces(ng) % e_svstr)
14350# endif
14351 ELSE
14352 IF (master) THEN
14353 WRITE (stdout,80) string, trim(vname(1,idvsms)), &
14354 & trim(ncname)
14355 END IF
14356 exit_flag=4
14357 IF (founderror(exit_flag, pio_noerr, &
14358 & __line__, myfile)) THEN
14359 RETURN
14360 END IF
14361 END IF
14362 END IF
14363# endif
14364# if defined ADJUST_STFLUX && defined SOLVE3D
14365!
14366! Read in surface tracer flux standard deviations.
14367!
14368 DO itrc=1,nt(ng)
14369 IF (get_var(idtsur(itrc)).and.(model.eq.13).and. &
14370 & lstflux(itrc,ng)) THEN
14371 foundit=find_string(var_name, n_var, &
14372 & trim(vname(1,idtsur(itrc))), vindex)
14373 IF (foundit) THEN
14374 IF (itrc.eq.itemp) THEN
14375 scale=1.0_dp/(rho0*cp) ! W/m2 to Celsius m/s
14376 ELSE
14377 scale=1.0_dp
14378 END IF
14379 my_piovar%vd=var_desc(vindex)
14380 my_piovar%gtype=r2dvar
14381 IF (kind(forces(ng)%e_stflx).eq.8) THEN
14382 my_piovar%dkind=pio_double
14383 iodesc => iodesc_dp_r2dvar(ng)
14384 ELSE
14385 my_piovar%dkind=pio_real
14386 iodesc => iodesc_sp_r2dvar(ng)
14387 END IF
14388!
14389 status=nf_fread2d(ng, idmod, ncname, piofile, &
14390 & vname(1,idtsur(itrc)), my_piovar, &
14391 & inprec, iodesc, vsize, &
14392 & lbi, ubi, lbj, ubj, &
14393 & scale, fmin, fmax, &
14394# ifdef MASKING
14395 & grid(ng) % rmask, &
14396# endif
14397# ifdef CHECKSUM
14398 & forces(ng) % e_stflx(:,:,itrc), &
14399 & checksum = fhash)
14400# else
14401 & forces(ng) % e_stflx(:,:,itrc))
14402# endif
14403 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
14404 IF (master) THEN
14405 WRITE (stdout,60) string, trim(vname(1,idtsur(itrc))),&
14406 & inprec, trim(ncname)
14407 END IF
14408 exit_flag=2
14409 ioerror=status
14410 RETURN
14411 ELSE
14412 IF (master) THEN
14413# ifdef CHECKSUM
14414 WRITE (stdout,70) trim(vname(2,idtsur(itrc))), &
14415 & fmin, fmax, fhash
14416# else
14417 WRITE (stdout,70) trim(vname(2,idtsur(itrc))), &
14418 & fmin, fmax
14419# endif
14420 END IF
14421 END IF
14422# ifdef DISTRIBUTE
14423 CALL mp_exchange2d (ng, myrank, idmod, 1, &
14424 & lbi, ubi, lbj, ubj, &
14425 & nghostpoints, &
14426 & ewperiodic(ng), nsperiodic(ng), &
14427 & forces(ng) % e_stflx(:,:,itrc))
14428# endif
14429 ELSE
14430 IF (master) THEN
14431 WRITE (stdout,80) string, trim(vname(1,idtsur(itrc))), &
14432 & trim(ncname)
14433 END IF
14434 exit_flag=4
14435 IF (founderror(exit_flag, pio_noerr, &
14436 & __line__, myfile)) THEN
14437 RETURN
14438 END IF
14439 END IF
14440 END IF
14441 END DO
14442# endif
14443 END IF std_state
14444# endif
14445
14446# if defined IMPULSE
14447!
14448!-----------------------------------------------------------------------
14449! Read in adjoint model or tangent linear model impulse forcing terms.
14450!-----------------------------------------------------------------------
14451!
14452 frc_state: IF (model.eq.7) THEN
14453!
14454! Set number of records available.
14455!
14456 nrecfrc(ng)=nrec
14457!
14458! Read in next impulse forcing time to process.
14459!
14460 CALL pio_netcdf_get_time (ng, idmod, ncname, trim(tvarnam), &
14461 & rclock%DateNumber, frctime(ng:), &
14462 & piofile = piofile, &
14463 & start = (/inprec/), &
14464 & total = (/1/))
14465 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
14466!
14467! Read in free-surface impulse forcing.
14468!
14469 IF (get_var(idfsur)) THEN
14470 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
14471 & vindex)
14472 IF (foundit) THEN
14473 my_piovar%vd=var_desc(vindex)
14474 my_piovar%gtype=r2dvar
14475 IF (kind(ocean(ng)%f_zeta).eq.8) THEN
14476 my_piovar%dkind=pio_double
14477 iodesc => iodesc_dp_r2dvar(ng)
14478 ELSE
14479 my_piovar%dkind=pio_real
14480 iodesc => iodesc_sp_r2dvar(ng)
14481 END IF
14482!
14483 status=nf_fread2d(ng, idmod, ncname, piofile, &
14484 & vname(1,idfsur), my_piovar, &
14485 & inprec, iodesc, vsize, &
14486 & lbi, ubi, lbj, ubj, &
14487 & fscl, fmin, fmax, &
14488# ifdef MASKING
14489 & grid(ng) % rmask, &
14490# endif
14491# ifdef CHECKSUM
14492 & ocean(ng) % f_zeta, &
14493 & checksum = fhash)
14494# else
14495 & ocean(ng) % f_zeta)
14496# endif
14497 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
14498 IF (master) THEN
14499 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
14500 & inprec, trim(ncname)
14501 END IF
14502 exit_flag=2
14503 ioerror=status
14504 RETURN
14505 ELSE
14506 IF (master) THEN
14507# ifdef CHECKSUM
14508 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
14509 & fhash
14510# else
14511 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
14512# endif
14513 END IF
14514 END IF
14515 ELSE
14516 IF (master) THEN
14517 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
14518 & trim(ncname)
14519 END IF
14520 exit_flag=4
14521 IF (founderror(exit_flag, pio_noerr, &
14522 & __line__, myfile)) THEN
14523 RETURN
14524 END IF
14525 END IF
14526 END IF
14527
14528# ifndef SOLVE3D
14529!
14530! Read in 2D U-momentum impulse forcing.
14531!
14532 IF (get_var(idubar)) THEN
14533 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
14534 & vindex)
14535 IF (foundit) THEN
14536 my_piovar%vd=var_desc(vindex)
14537 my_piovar%gtype=u2dvar
14538 IF (kind(ocean(ng)%f_ubar).eq.8) THEN
14539 my_piovar%dkind=pio_double
14540 iodesc => iodesc_dp_u2dvar(ng)
14541 ELSE
14542 my_piovar%dkind=pio_real
14543 iodesc => iodesc_sp_u2dvar(ng)
14544 END IF
14545!
14546 status=nf_fread2d(ng, idmod, ncname, piofile, &
14547 & vname(1,idubar), my_piovar, &
14548 & inprec, iodesc, vsize, &
14549 & lbi, ubi, lbj, ubj, &
14550 & fscl, fmin, fmax, &
14551# ifdef MASKING
14552 & grid(ng) % umask, &
14553# endif
14554# ifdef CHECKSUM
14555 & ocean(ng) % f_ubar, &
14556 & checksum = fhash)
14557# else
14558 & ocean(ng) % f_ubar)
14559# endif
14560 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
14561 IF (master) THEN
14562 WRITE (stdout,60) string, trim(vname(1,idubar)), &
14563 & inprec, trim(ncname)
14564 END IF
14565 exit_flag=2
14566 ioerror=status
14567 RETURN
14568 ELSE
14569 IF (master) THEN
14570# ifdef CHECKSUM
14571 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
14572 & fhash
14573# else
14574 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
14575# endif
14576 END IF
14577 END IF
14578 ELSE
14579 IF (master) THEN
14580 WRITE (stdout,80) string, trim(vname(1,idubar)), &
14581 & trim(ncname)
14582 END IF
14583 exit_flag=4
14584 IF (founderror(exit_flag, pio_noerr, &
14585 & __line__, myfile)) THEN
14586 RETURN
14587 END IF
14588 END IF
14589 END IF
14590!
14591! Read in 2D V-momentum impulse forcing.
14592!
14593 IF (get_var(idvbar)) THEN
14594 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
14595 & vindex)
14596 IF (foundit) THEN
14597 my_piovar%vd=var_desc(vindex)
14598 my_piovar%gtype=v2dvar
14599 IF (kind(ocean(ng)%f_vbar).eq.8) THEN
14600 my_piovar%dkind=pio_double
14601 iodesc => iodesc_dp_v2dvar(ng)
14602 ELSE
14603 my_piovar%dkind=pio_real
14604 iodesc => iodesc_sp_v2dvar(ng)
14605 END IF
14606!
14607 status=nf_fread2d(ng, idmod, ncname, piofile, &
14608 & vname(1,idvbar), my_piovar, &
14609 & inprec, iodesc, vsize, &
14610 & lbi, ubi, lbj, ubj, &
14611 & fscl, fmin, fmax, &
14612# ifdef MASKING
14613 & grid(ng) % vmask, &
14614# endif
14615# ifdef CHECKSUM
14616 & ocean(ng) % f_vbar, &
14617 & checksum = fhash)
14618# else
14619 & ocean(ng) % f_vbar)
14620# endif
14621 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
14622 IF (master) THEN
14623 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
14624 & inprec, trim(ncname)
14625 END IF
14626 exit_flag=2
14627 ioerror=status
14628 RETURN
14629 ELSE
14630 IF (master) THEN
14631# ifdef CHECKSUM
14632 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
14633 & fhash
14634# else
14635 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
14636# endif
14637 END IF
14638 END IF
14639 ELSE
14640 IF (master) THEN
14641 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
14642 & trim(ncname)
14643 END IF
14644 exit_flag=4
14645 IF (founderror(exit_flag, pio_noerr, &
14646 & __line__, myfile)) THEN
14647 RETURN
14648 END IF
14649 END IF
14650 END IF
14651# endif
14652# ifdef SOLVE3D
14653!
14654! Read in 3D U-momentum impulse forcing.
14655!
14656 IF (get_var(iduvel)) THEN
14657 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
14658 & vindex)
14659 IF (foundit) THEN
14660 my_piovar%vd=var_desc(vindex)
14661 my_piovar%gtype=u3dvar
14662 IF (kind(ocean(ng)%f_u).eq.8) THEN
14663 my_piovar%dkind=pio_double
14664 iodesc => iodesc_dp_u3dvar(ng)
14665 ELSE
14666 my_piovar%dkind=pio_real
14667 iodesc => iodesc_sp_u3dvar(ng)
14668 END IF
14669!
14670 status=nf_fread3d(ng, idmod, ncname, piofile, &
14671 & vname(1,iduvel), my_piovar, &
14672 & inprec, iodesc, vsize, &
14673 & lbi, ubi, lbj, ubj, 1, n(ng), &
14674 & fscl, fmin, fmax, &
14675# ifdef MASKING
14676 & grid(ng) % umask, &
14677# endif
14678# ifdef CHECKSUM
14679 & ocean(ng) % f_u, &
14680 & checksum = fhash)
14681# else
14682 & ocean(ng) % f_u)
14683# endif
14684 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
14685 IF (master) THEN
14686 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
14687 & inprec, trim(ncname)
14688 END IF
14689 exit_flag=2
14690 ioerror=status
14691 RETURN
14692 ELSE
14693 IF (master) THEN
14694# ifdef CHECKSUM
14695 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
14696 & fhash
14697# else
14698 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
14699# endif
14700 END IF
14701 END IF
14702 ELSE
14703 IF (master) THEN
14704 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
14705 & trim(ncname)
14706 END IF
14707 exit_flag=4
14708 IF (founderror(exit_flag, pio_noerr, &
14709 & __line__, myfile)) THEN
14710 RETURN
14711 END IF
14712 END IF
14713 END IF
14714!
14715! Read in 3D V-momentum impulse forcing.
14716!
14717 IF (get_var(idvvel)) THEN
14718 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
14719 & vindex)
14720 IF (foundit) THEN
14721 my_piovar%vd=var_desc(vindex)
14722 my_piovar%gtype=v3dvar
14723 IF (kind(ocean(ng)%f_v).eq.8) THEN
14724 my_piovar%dkind=pio_double
14725 iodesc => iodesc_dp_v3dvar(ng)
14726 ELSE
14727 my_piovar%dkind=pio_real
14728 iodesc => iodesc_sp_v3dvar(ng)
14729 END IF
14730!
14731 status=nf_fread3d(ng, idmod, ncname, piofile, &
14732 & vname(1,idvvel), my_piovar, &
14733 & inprec, iodesc, vsize, &
14734 & lbi, ubi, lbj, ubj, 1, n(ng), &
14735 & fscl, fmin, fmax, &
14736# ifdef MASKING
14737 & grid(ng) % vmask, &
14738# endif
14739# ifdef CHECKSUM
14740 & ocean(ng) % f_v, &
14741 & checksum = fhash)
14742# else
14743 & ocean(ng) % f_v)
14744# endif
14745 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
14746 IF (master) THEN
14747 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
14748 & inprec, trim(ncname)
14749 END IF
14750 exit_flag=2
14751 ioerror=status
14752 RETURN
14753 ELSE
14754 IF (master) THEN
14755# ifdef CHECKSUM
14756 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
14757 & fhash
14758# else
14759 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
14760# endif
14761 END IF
14762 END IF
14763 ELSE
14764 IF (master) THEN
14765 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
14766 & trim(ncname)
14767 END IF
14768 exit_flag=4
14769 IF (founderror(exit_flag, pio_noerr, &
14770 & __line__, myfile)) THEN
14771 RETURN
14772 END IF
14773 END IF
14774 END IF
14775!
14776! Read in tracers variables impulse forcing.
14777!
14778 DO itrc=1,nt(ng)
14779 IF (get_var(idtvar(itrc))) THEN
14780 foundit=find_string(var_name, n_var, &
14781 & trim(vname(1,idtvar(itrc))), vindex)
14782 IF (foundit) THEN
14783 my_piovar%vd=var_desc(vindex)
14784 my_piovar%gtype=r3dvar
14785 IF (kind(ocean(ng)%f_t).eq.8) THEN
14786 my_piovar%dkind=pio_double
14787 iodesc => iodesc_dp_r3dvar(ng)
14788 ELSE
14789 my_piovar%dkind=pio_real
14790 iodesc => iodesc_sp_r3dvar(ng)
14791 END IF
14792!
14793 status=nf_fread3d(ng, idmod, ncname, piofile, &
14794 & vname(1,idtvar(itrc)), my_piovar, &
14795 & inprec, iodesc, vsize, &
14796 & lbi, ubi, lbj, ubj, 1, n(ng), &
14797 & fscl, fmin, fmax, &
14798# ifdef MASKING
14799 & grid(ng) % rmask, &
14800# endif
14801# ifdef CHECKSUM
14802 & ocean(ng) % f_t(:,:,:,itrc), &
14803 & checksum = fhash)
14804# else
14805 & ocean(ng) % f_t(:,:,:,itrc))
14806# endif
14807 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
14808 IF (master) THEN
14809 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
14810 & inprec, trim(ncname)
14811 END IF
14812 exit_flag=2
14813 ioerror=status
14814 RETURN
14815 ELSE
14816 IF (master) THEN
14817# ifdef CHECKSUM
14818 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
14819 & fmin, fmax, fhash
14820# else
14821 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
14822 & fmin, fmax
14823# endif
14824 END IF
14825 END IF
14826 ELSE
14827 IF (master) THEN
14828 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
14829 & trim(ncname)
14830 END IF
14831 exit_flag=4
14832 IF (founderror(exit_flag, pio_noerr, &
14833 & __line__, myfile)) THEN
14834 RETURN
14835 END IF
14836 END IF
14837 END IF
14838 END DO
14839# endif
14840 END IF frc_state
14841# endif
14842
14843# if (defined RBL4DVAR || \
14844 defined rbl4dvar_ana_sensitivity || \
14845 defined rbl4dvar_fct_sensitivity || \
14846 defined tl_rbl4dvar) && \
14847 (defined adjust_boundary || \
14848 defined adjust_stflux || \
14849 defined adjust_wstress)
14850!
14851!-----------------------------------------------------------------------
14852! Read in tangent linear forcing corrections.
14853!-----------------------------------------------------------------------
14854!
14855 tlm_forcing: IF (model.eq.5) THEN
14856!
14857! Set switch to process surface forcing and/or open boundaries during
14858! 4D-Var minimization.
14859!
14860 get_adjust=.true.
14861
14862# ifdef ADJUST_BOUNDARY
14863!
14864! Read in free-surface open boundaries adjustments.
14865!
14866 IF (get_var(idsbry(isfsur)).and.get_adjust.and. &
14867 & any(lobc(:,isfsur,ng))) THEN
14868 ifield=idsbry(isfsur)
14869 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
14870 & vindex)
14871 IF (foundit) THEN
14872 my_piovar%vd=var_desc(vindex)
14873 my_piovar%gtype=r2dobc
14874 IF (kind(boundary(ng)%tl_zeta_obc).eq.8) THEN
14875 my_piovar%dkind=pio_double
14876 iodesc => iodesc_dp_r2dobc(ng)
14877 ELSE
14878 my_piovar%dkind=pio_real
14879 iodesc => iodesc_sp_r2dobc(ng)
14880 END IF
14881!
14882 status=nf_fread2d_bry(ng, idmod, ncname, piofile, &
14883 & vname(1,ifield), my_piovar, &
14884 & inprec, iodesc, &
14885 & lbij, ubij, nbrec(ng), &
14886 & fscl, fmin, fmax, &
14887# ifdef CHECKSUM
14888 & boundary(ng) % tl_zeta_obc(:,:,:, &
14889 & tindex), &
14890 & checksum = fhash)
14891# else
14892 & boundary(ng) % tl_zeta_obc(:,:,:, &
14893 & tindex))
14894# endif
14895 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
14896 IF (master) THEN
14897 WRITE (stdout,60) string, trim(vname(1,ifield)), &
14898 & inprec, trim(ncname)
14899 END IF
14900 exit_flag=2
14901 ioerror=status
14902 RETURN
14903 ELSE
14904 IF (master) THEN
14905# ifdef CHECKSUM
14906 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
14907 & fhash
14908# else
14909 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
14910# endif
14911 END IF
14912 END IF
14913 ELSE
14914 IF (master) THEN
14915 WRITE (stdout,80) string, trim(vname(1,ifield)), &
14916 & trim(ncname)
14917 END IF
14918 exit_flag=4
14919 IF (founderror(exit_flag, pio_noerr, &
14920 & __line__, myfile)) THEN
14921 RETURN
14922 END IF
14923 END IF
14924 END IF
14925!
14926! Read in 2D U-momentum component open boundaries adjustments.
14927!
14928 IF (get_var(idsbry(isubar)).and.get_adjust.and. &
14929 & any(lobc(:,isubar,ng))) THEN
14930 ifield=idsbry(isubar)
14931 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
14932 & vindex)
14933 IF (foundit) THEN
14934 my_piovar%vd=var_desc(vindex)
14935 my_piovar%gtype=u2dobc
14936 IF (kind(boundary(ng)%tl_ubar_obc).eq.8) THEN
14937 my_piovar%dkind=pio_double
14938 iodesc => iodesc_dp_u2dobc(ng)
14939 ELSE
14940 my_piovar%dkind=pio_real
14941 iodesc => iodesc_sp_u2dobc(ng)
14942 END IF
14943!
14944 status=nf_fread2d_bry(ng, idmod, ncname, piofile, &
14945 & vname(1,ifield), my_piovar, &
14946 & inprec, iodesc, &
14947 & lbij, ubij, nbrec(ng), &
14948 & fscl, fmin, fmax, &
14949# ifdef CHECKSUM
14950 & boundary(ng) % tl_ubar_obc(:,:,:, &
14951 & tindex), &
14952 & checksum = fhash)
14953# else
14954 & boundary(ng) % tl_ubar_obc(:,:,:, &
14955 & tindex))
14956# endif
14957 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
14958 IF (master) THEN
14959 WRITE (stdout,60) string, trim(vname(1,ifield)), &
14960 & inprec, trim(ncname)
14961 END IF
14962 exit_flag=2
14963 ioerror=status
14964 RETURN
14965 ELSE
14966 IF (master) THEN
14967# ifdef CHECKSUM
14968 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
14969 & fhash
14970# else
14971 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
14972# endif
14973 END IF
14974 END IF
14975 ELSE
14976 IF (master) THEN
14977 WRITE (stdout,80) string, trim(vname(1,ifield)), &
14978 & trim(ncname)
14979 END IF
14980 exit_flag=4
14981 IF (founderror(exit_flag, pio_noerr, &
14982 & __line__, myfile)) THEN
14983 RETURN
14984 END IF
14985 END IF
14986 END IF
14987!
14988! Read in 2D V-momentum component open boundaries adjustments.
14989!
14990 IF (get_var(idsbry(isvbar)).and.get_adjust.and. &
14991 & any(lobc(:,isvbar,ng))) THEN
14992 ifield=idsbry(isvbar)
14993 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
14994 & vindex)
14995 IF (foundit) THEN
14996 my_piovar%vd=var_desc(vindex)
14997 my_piovar%gtype=v2dobc
14998 IF (kind(boundary(ng)%tl_vbar_obc).eq.8) THEN
14999 my_piovar%dkind=pio_double
15000 iodesc => iodesc_dp_v2dobc(ng)
15001 ELSE
15002 my_piovar%dkind=pio_real
15003 iodesc => iodesc_sp_v2dobc(ng)
15004 END IF
15005!
15006 status=nf_fread2d_bry(ng, idmod, ncname, piofile, &
15007 & vname(1,ifield), my_piovar, &
15008 & inprec, iodesc, &
15009 & lbij, ubij, nbrec(ng), &
15010 & fscl, fmin, fmax, &
15011# ifdef CHECKSUM
15012 & boundary(ng) % tl_vbar_obc(:,:,:, &
15013 & tindex), &
15014 & checksum = fhash)
15015# else
15016 & boundary(ng) % tl_vbar_obc(:,:,:, &
15017 & tindex))
15018# endif
15019 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15020 IF (master) THEN
15021 WRITE (stdout,60) string, trim(vname(1,ifield)), &
15022 & inprec, trim(ncname)
15023 END IF
15024 exit_flag=2
15025 ioerror=status
15026 RETURN
15027 ELSE
15028 IF (master) THEN
15029# ifdef CHECKSUM
15030 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
15031 & fhash
15032# else
15033 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
15034# endif
15035 END IF
15036 END IF
15037 ELSE
15038 IF (master) THEN
15039 WRITE (stdout,80) string, trim(vname(1,ifield)), &
15040 & trim(ncname)
15041 END IF
15042 exit_flag=4
15043 IF (founderror(exit_flag, pio_noerr, &
15044 & __line__, myfile)) THEN
15045 RETURN
15046 END IF
15047 END IF
15048 END IF
15049
15050# ifdef SOLVE3D
15051!
15052! Read in 3D U-momentum component open boundaries adjustments.
15053!
15054 IF (get_var(idsbry(isuvel)).and.get_adjust.and. &
15055 & any(lobc(:,isuvel,ng))) THEN
15056 ifield=idsbry(isuvel)
15057 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
15058 & vindex)
15059 IF (foundit) THEN
15060 my_piovar%vd=var_desc(vindex)
15061 my_piovar%gtype=u3dobc
15062 IF (kind(boundary(ng)%tl_u_obc).eq.8) THEN
15063 my_piovar%dkind=pio_double
15064 iodesc => iodesc_dp_u3dobc(ng)
15065 ELSE
15066 my_piovar%dkind=pio_real
15067 iodesc => iodesc_sp_u3dobc(ng)
15068 END IF
15069!
15070 status=nf_fread3d_bry(ng, idmod, ncname, piofile, &
15071 & vname(1,ifield), my_piovar, &
15072 & inprec, iodesc, &
15073 & lbij, ubij, 1, n(ng), nbrec(ng), &
15074 & fscl, fmin, fmax, &
15075# ifdef CHECKSUM
15076 & boundary(ng) % tl_u_obc(:,:,:,:, &
15077 & tindex), &
15078 & checksum = fhash)
15079# else
15080 & boundary(ng) % tl_u_obc(:,:,:,:, &
15081 & tindex))
15082# endif
15083 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15084 IF (master) THEN
15085 WRITE (stdout,60) string, trim(vname(1,ifield)), &
15086 & inprec, trim(ncname)
15087 END IF
15088 exit_flag=2
15089 ioerror=status
15090 RETURN
15091 ELSE
15092 IF (master) THEN
15093# ifdef CHECKSUM
15094 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
15095 & fhash
15096# else
15097 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
15098# endif
15099 END IF
15100 END IF
15101 ELSE
15102 IF (master) THEN
15103 WRITE (stdout,80) string, trim(vname(1,ifield)), &
15104 & trim(ncname)
15105 END IF
15106 exit_flag=4
15107 IF (founderror(exit_flag, pio_noerr, &
15108 & __line__, myfile)) THEN
15109 RETURN
15110 END IF
15111 END IF
15112 END IF
15113!
15114! Read in 3D V-momentum component open boundaries adjustments.
15115!
15116 IF (get_var(idsbry(isvvel)).and.get_adjust.and. &
15117 & any(lobc(:,isvvel,ng))) THEN
15118 ifield=idsbry(isvvel)
15119 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
15120 & vindex)
15121 IF (foundit) THEN
15122 my_piovar%vd=var_desc(vindex)
15123 my_piovar%gtype=v3dobc
15124 IF (kind(boundary(ng)%tl_v_obc).eq.8) THEN
15125 my_piovar%dkind=pio_double
15126 iodesc => iodesc_dp_v3dobc(ng)
15127 ELSE
15128 my_piovar%dkind=pio_real
15129 iodesc => iodesc_sp_v3dobc(ng)
15130 END IF
15131!
15132 status=nf_fread3d_bry(ng, idmod, ncname, piofile, &
15133 & vname(1,ifield), my_piovar, &
15134 & inprec, iodesc, &
15135 & lbij, ubij, 1, n(ng), nbrec(ng), &
15136 & fscl, fmin, fmax, &
15137# ifdef CHECKSUM
15138 & boundary(ng) % tl_v_obc(:,:,:,:, &
15139 & tindex), &
15140 & checksum = fhash)
15141# else
15142 & boundary(ng) % tl_v_obc(:,:,:,:, &
15143 & tindex))
15144# endif
15145 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15146 IF (master) THEN
15147 WRITE (stdout,60) string, trim(vname(1,ifield)), &
15148 & inprec, trim(ncname)
15149 END IF
15150 exit_flag=2
15151 ioerror=status
15152 RETURN
15153 ELSE
15154 IF (master) THEN
15155# ifdef CHECKSUM
15156 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
15157 & fhash
15158# else
15159 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
15160# endif
15161
15162 END IF
15163 END IF
15164 ELSE
15165 IF (master) THEN
15166 WRITE (stdout,80) string, trim(vname(1,ifield)), &
15167 & trim(ncname)
15168 END IF
15169 exit_flag=4
15170 IF (founderror(exit_flag, pio_noerr, &
15171 & __line__, myfile)) THEN
15172 RETURN
15173 END IF
15174 END IF
15175 END IF
15176!
15177! Read in 3D tracers open boundaries adjustments.
15178!
15179 DO itrc=1,nt(ng)
15180 IF (get_var(idsbry(istvar(itrc))).and.get_adjust.and. &
15181 & any(lobc(:,istvar(itrc),ng))) THEN
15182 ifield=idsbry(istvar(itrc))
15183 foundit=find_string(var_name, n_var, trim(vname(1,ifield)), &
15184 & vindex)
15185 IF (foundit) THEN
15186 my_piovar%vd=var_desc(vindex)
15187 my_piovar%gtype=r3dobc
15188 IF (kind(boundary(ng)%tl_t_obc).eq.8) THEN
15189 my_piovar%dkind=pio_double
15190 iodesc => iodesc_dp_r3dobc(ng)
15191 ELSE
15192 my_piovar%dkind=pio_real
15193 iodesc => iodesc_sp_r3dobc(ng)
15194 END IF
15195!
15196 status=nf_fread3d_bry(ng, idmod, ncname, piofile, &
15197 & vname(1,ifield), my_piovar, &
15198 & inprec, iodesc, &
15199 & lbij, ubij, 1, n(ng), nbrec(ng), &
15200 & fscl, fmin, fmax, &
15201# ifdef CHECKSUM
15202 & boundary(ng) % tl_t_obc(:,:,:,:, &
15203 & tindex,itrc), &
15204 & checksum = fhash)
15205# else
15206 & boundary(ng) % tl_t_obc(:,:,:,:, &
15207 & tindex,itrc))
15208# endif
15209 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15210 IF (master) THEN
15211 WRITE (stdout,60) string, trim(vname(1,ifield)), &
15212 & inprec, trim(ncname)
15213 END IF
15214 exit_flag=2
15215 ioerror=status
15216 RETURN
15217 ELSE
15218 IF (master) THEN
15219# ifdef CHECKSUM
15220 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax, &
15221 & fhash
15222# else
15223 WRITE (stdout,70) trim(vname(2,ifield)), fmin, fmax
15224# endif
15225 END IF
15226 END IF
15227 ELSE
15228 IF (master) THEN
15229 WRITE (stdout,80) string, trim(vname(1,ifield)), &
15230 & trim(ncname)
15231 END IF
15232 exit_flag=4
15233 IF (founderror(exit_flag, pio_noerr, &
15234 & __line__, myfile)) THEN
15235 RETURN
15236 END IF
15237 END IF
15238 END IF
15239 END DO
15240# endif
15241# endif
15242# ifdef ADJUST_WSTRESS
15243!
15244! Read in tangent linear surface U-momentum stress.
15245!
15246 IF (get_var(idusms).and.get_adjust) THEN
15247 foundit=find_string(var_name, n_var, trim(vname(1,idusms)), &
15248 & vindex)
15249 IF (foundit) THEN
15250 scale=1.0_dp
15251 my_piovar%vd=var_desc(vindex)
15252 my_piovar%gtype=u2dvar
15253 IF (kind(forces(ng)%tl_ustr).eq.8) THEN
15254 my_piovar%dkind=pio_double
15255 iodesc => iodesc_dp_u2dfrc(ng)
15256 ELSE
15257 my_piovar%dkind=pio_real
15258 iodesc => iodesc_sp_u2dfrc(ng)
15259 END IF
15260!
15261 status=nf_fread3d(ng, idmod, ncname, piofile, &
15262 & vname(1,idusms), my_piovar, &
15263 & inprec, iodesc, vsize, &
15264 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
15265 & scale, fmin, fmax, &
15266# ifdef MASKING
15267 & grid(ng) % umask, &
15268# endif
15269# ifdef CHECKSUM
15270 & forces(ng) % tl_ustr(:,:,:,tindex), &
15271 & checksum = fhash)
15272# else
15273 & forces(ng) % tl_ustr(:,:,:,tindex))
15274# endif
15275 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15276 IF (master) THEN
15277 WRITE (stdout,60) string, trim(vname(1,idusms)), &
15278 & inprec, trim(ncname)
15279 END IF
15280 exit_flag=2
15281 ioerror=status
15282 RETURN
15283 ELSE
15284 IF (master) THEN
15285# ifdef CHECKSUM
15286 WRITE (stdout,70) trim(vname(2,idusms))// &
15287 & ', adjusted tl_ustr', fmin, fmax, &
15288 & fhash
15289# else
15290 WRITE (stdout,70) trim(vname(2,idusms))// &
15291 & ', adjusted tl_ustr', fmin, fmax
15292# endif
15293 END IF
15294 END IF
15295 ELSE
15296 IF (master) THEN
15297 WRITE (stdout,80) string, trim(vname(1,idusms)), &
15298 & trim(ncname)
15299 END IF
15300 exit_flag=4
15301 IF (founderror(exit_flag, pio_noerr, &
15302 & __line__, myfile)) THEN
15303 RETURN
15304 END IF
15305 END IF
15306 END IF
15307!
15308! Read in tangent linear surface V-momentum stress.
15309!
15310 IF (get_var(idvsms).and.get_adjust) THEN
15311 foundit=find_string(var_name, n_var, trim(vname(1,idvsms)), &
15312 & vindex)
15313 IF (foundit) THEN
15314 scale=1.0_dp
15315 my_piovar%vd=var_desc(vindex)
15316 my_piovar%gtype=v2dvar
15317 IF (kind(forces(ng)%tl_vstr).eq.8) THEN
15318 my_piovar%dkind=pio_double
15319 iodesc => iodesc_dp_v2dfrc(ng)
15320 ELSE
15321 my_piovar%dkind=pio_real
15322 iodesc => iodesc_sp_v2dfrc(ng)
15323 END IF
15324!
15325 status=nf_fread3d(ng, idmod, ncname, piofile, &
15326 & vname(1,idvsms), my_piovar, &
15327 & inprec, iodesc, vsize, &
15328 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
15329 & scale, fmin, fmax, &
15330# ifdef MASKING
15331 & grid(ng) % vmask, &
15332# endif
15333# ifdef CHECKSUM
15334 & forces(ng) % tl_vstr(:,:,:,tindex), &
15335 & checksum = fhash)
15336# else
15337 & forces(ng) % tl_vstr(:,:,:,tindex))
15338# endif
15339 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15340 IF (master) THEN
15341 WRITE (stdout,60) string, trim(vname(1,idvsms)), &
15342 & inprec, trim(ncname)
15343 END IF
15344 exit_flag=2
15345 ioerror=status
15346 RETURN
15347 ELSE
15348 IF (master) THEN
15349# ifdef CHECKSUM
15350 WRITE (stdout,70) trim(vname(2,idvsms))// &
15351 & ', adjusted tl_vstr', fmin, fmax, &
15352 & fhash
15353# else
15354 WRITE (stdout,70) trim(vname(2,idvsms))// &
15355 & ', adjusted tl_vstr', fmin, fmax
15356# endif
15357 END IF
15358 END IF
15359 ELSE
15360 IF (master) THEN
15361 WRITE (stdout,80) string, trim(vname(1,idvsms)), &
15362 & trim(ncname)
15363 END IF
15364 exit_flag=4
15365 IF (founderror(exit_flag, pio_noerr, &
15366 & __line__, myfile)) THEN
15367 RETURN
15368 END IF
15369 END IF
15370 END IF
15371# endif
15372# if defined ADJUST_STFLUX && defined SOLVE3D
15373!
15374! Read in tangent linear surface tracers flux.
15375!
15376 DO itrc=1,nt(ng)
15377 IF (get_var(idtsur(itrc)).and.get_adjust.and. &
15378 & lstflux(itrc,ng)) THEN
15379 foundit=find_string(var_name, n_var, &
15380 & trim(vname(1,idtsur(itrc))), vindex)
15381 IF (foundit) THEN
15382 scale=1.0_dp
15383 my_piovar%vd=var_desc(vindex)
15384 my_piovar%gtype=r2dvar
15385 IF (kind(forces(ng)%tl_tflux).eq.8) THEN
15386 my_piovar%dkind=pio_double
15387 iodesc => iodesc_dp_r2dfrc(ng)
15388 ELSE
15389 my_piovar%dkind=pio_real
15390 iodesc => iodesc_sp_r2dfrc(ng)
15391 END IF
15392!
15393 status=nf_fread3d(ng, idmod, ncname, piofile, &
15394 & vname(1,idtsur(itrc)), my_piovar, &
15395 & inprec, iodesc, vsize, &
15396 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
15397 & scale, fmin, fmax, &
15398# ifdef MASKING
15399 & grid(ng) % rmask, &
15400# endif
15401# ifdef CHECKSUM
15402 & forces(ng)% tl_tflux(:,:,:, &
15403 & tindex,itrc), &
15404 & checksum = fhash)
15405# else
15406 & forces(ng)% tl_tflux(:,:,:, &
15407 & tindex,itrc))
15408# endif
15409 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15410 IF (master) THEN
15411 WRITE (stdout,60) string, trim(vname(1,idtsur(itrc))),&
15412 & inprec, trim(ncname)
15413 END IF
15414 exit_flag=2
15415 ioerror=status
15416 RETURN
15417 ELSE
15418 IF (master) THEN
15419# ifdef CHECKSUM
15420 WRITE (stdout,70) trim(vname(2,idtsur(itrc)))// &
15421 & ', adjusted tl_tflux', fmin, fmax, &
15422 & fhash
15423# else
15424 WRITE (stdout,70) trim(vname(2,idtsur(itrc)))// &
15425 & ', adjusted tl_tflux', fmin, fmax
15426# endif
15427 END IF
15428 END IF
15429 ELSE
15430 IF (master) THEN
15431 WRITE (stdout,80) string, trim(vname(1,idtsur(itrc))), &
15432 & trim(ncname)
15433 END IF
15434 exit_flag=4
15435 IF (founderror(exit_flag, pio_noerr, &
15436 & __line__, myfile)) THEN
15437 RETURN
15438 END IF
15439 END IF
15440 END IF
15441 END DO
15442# endif
15443 END IF tlm_forcing
15444# endif
15445!
15446# if defined TIME_CONV
15447!
15448!-----------------------------------------------------------------------
15449! Read in tangent linear model error forcing terms used in the time
15450! convolutions.
15451!-----------------------------------------------------------------------
15452!
15453 tcs_state: IF (model.eq.6) THEN
15454!
15455! Set number of records available.
15456!
15457 nrecfrc(ng)=nrec
15458!
15459! Read in next impulse forcing time to process.
15460!
15461 CALL pio_netcdf_get_time (ng, idmod, ncname, trim(tvarnam), &
15462 & rclock%DateNumber, forcetime(ng:), &
15463 & piofile = piofile, &
15464 & start = (/inprec/), &
15465 & total = (/1/))
15466 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
15467!
15468! Read in free-surface forcing.
15469!
15470 IF (get_var(idfsur)) THEN
15471 foundit=find_string(var_name, n_var, trim(vname(1,idfsur)), &
15472 & vindex)
15473 IF (foundit) THEN
15474 my_piovar%vd=var_desc(vindex)
15475 my_piovar%gtype=r2dvar
15476 IF (kind(ocean(ng)%tl_zeta).eq.8) THEN
15477 my_piovar%dkind=pio_double
15478 iodesc => iodesc_dp_r2dvar(ng)
15479 ELSE
15480 my_piovar%dkind=pio_real
15481 iodesc => iodesc_sp_r2dvar(ng)
15482 END IF
15483!
15484 status=nf_fread2d(ng, idmod, ncname, piofile, &
15485 & vname(1,idfsur), my_piovar, &
15486 & inprec, iodesc, vsize, &
15487 & lbi, ubi, lbj, ubj, &
15488 & fscl, fmin, fmax, &
15489# ifdef MASKING
15490 & grid(ng) % rmask, &
15491# endif
15492# ifdef CHECKSUM
15493 & ocean(ng) % tl_zeta(:,:,tindex), &
15494 & checksum = fhash)
15495# else
15496 & ocean(ng) % tl_zeta(:,:,tindex))
15497# endif
15498 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15499 IF (master) THEN
15500 WRITE (stdout,60) string, trim(vname(1,idfsur)), &
15501 & inprec, trim(ncname)
15502 END IF
15503 exit_flag=2
15504 ioerror=status
15505 RETURN
15506 ELSE
15507 IF (master) THEN
15508# ifdef CHECKSUM
15509 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax, &
15510 & fhash
15511# else
15512 WRITE (stdout,70) trim(vname(2,idfsur)), fmin, fmax
15513# endif
15514
15515 END IF
15516 END IF
15517 ELSE
15518 IF (master) THEN
15519 WRITE (stdout,80) string, trim(vname(1,idfsur)), &
15520 & trim(ncname)
15521 END IF
15522 exit_flag=4
15523 IF (founderror(exit_flag, pio_noerr, &
15524 & __line__, myfile)) THEN
15525 RETURN
15526 END IF
15527 END IF
15528 END IF
15529
15530# ifndef SOLVE3D
15531!
15532! Read in 2D momentum forcing in the XI-direction.
15533!
15534 IF (get_var(idubar)) THEN
15535 foundit=find_string(var_name, n_var, trim(vname(1,idubar)), &
15536 & vindex)
15537 IF (foundit) THEN
15538 my_piovar%vd=var_desc(vindex)
15539 my_piovar%gtype=u2dvar
15540 IF (kind(ocean(ng)%tl_ubar).eq.8) THEN
15541 my_piovar%dkind=pio_double
15542 iodesc => iodesc_dp_u2dvar(ng)
15543 ELSE
15544 my_piovar%dkind=pio_real
15545 iodesc => iodesc_sp_u2dvar(ng)
15546 END IF
15547!
15548 status=nf_fread2d(ng, idmod, ncname, piofile, &
15549 & vname(1,idubar), my_piovar, &
15550 & inprec, iodesc, vsize, &
15551 & lbi, ubi, lbj, ubj, &
15552 & fscl, fmin, fmax, &
15553# ifdef MASKING
15554 & grid(ng) % umask, &
15555# endif
15556# ifdef CHECKSUM
15557 & ocean(ng) % tl_ubar(:,:,tindex), &
15558 & checksum = fhash)
15559# else
15560 & ocean(ng) % tl_ubar(:,:,tindex))
15561# endif
15562 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15563 IF (master) THEN
15564 WRITE (stdout,60) string, trim(vname(1,idubar)), &
15565 & inprec, trim(ncname)
15566 END IF
15567 exit_flag=2
15568 ioerror=status
15569 RETURN
15570 ELSE
15571 IF (master) THEN
15572# ifdef CHECKSUM
15573 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax, &
15574 & fhash
15575# else
15576 WRITE (stdout,70) trim(vname(2,idubar)), fmin, fmax
15577# endif
15578 END IF
15579 END IF
15580 ELSE
15581 IF (master) THEN
15582 WRITE (stdout,80) string, trim(vname(1,idubar)), &
15583 & trim(ncname)
15584 END IF
15585 exit_flag=4
15586 IF (founderror(exit_flag, pio_noerr, &
15587 & __line__, myfile)) THEN
15588 RETURN
15589 END IF
15590 END IF
15591 END IF
15592!
15593! Read in 2D momentum forcing in the ETA-direction.
15594!
15595 IF (get_var(idvbar)) THEN
15596 foundit=find_string(var_name, n_var, trim(vname(1,idvbar)), &
15597 & vindex)
15598 IF (foundit) THEN
15599 my_piovar%vd=var_desc(vindex)
15600 my_piovar%gtype=v2dvar
15601 IF (kind(ocean(ng)%tl_vbar).eq.8) THEN
15602 my_piovar%dkind=pio_double
15603 iodesc => iodesc_dp_v2dvar(ng)
15604 ELSE
15605 my_piovar%dkind=pio_real
15606 iodesc => iodesc_sp_v2dvar(ng)
15607 END IF
15608!
15609 status=nf_fread2d(ng, idmod, ncname, piofile, &
15610 & vname(1,idvbar), my_piovar, &
15611 & inprec, iodesc, vsize, &
15612 & lbi, ubi, lbj, ubj, &
15613 & fscl, fmin, fmax, &
15614# ifdef MASKING
15615 & grid(ng) % vmask, &
15616# endif
15617# ifdef CHECKSUM
15618 & ocean(ng) % tl_vbar(:,:,tindex), &
15619 & checksum = fhash)
15620# else
15621 & ocean(ng) % tl_vbar(:,:,tindex))
15622# endif
15623 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15624 IF (master) THEN
15625 WRITE (stdout,60) string, trim(vname(1,idvbar)), &
15626 & inprec, trim(ncname)
15627 END IF
15628 exit_flag=2
15629 ioerror=status
15630 RETURN
15631 ELSE
15632 IF (master) THEN
15633# ifdef CHECKSUM
15634 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax, &
15635 & fhash
15636# else
15637 WRITE (stdout,70) trim(vname(2,idvbar)), fmin, fmax
15638# endif
15639 END IF
15640 END IF
15641 ELSE
15642 IF (master) THEN
15643 WRITE (stdout,80) string, trim(vname(1,idvbar)), &
15644 & trim(ncname)
15645 END IF
15646 exit_flag=4
15647 IF (founderror(exit_flag, pio_noerr, &
15648 & __line__, myfile)) THEN
15649 RETURN
15650 END IF
15651 END IF
15652 END IF
15653# endif
15654# ifdef SOLVE3D
15655!
15656! Read in 3D momentum forcing in the XI-direction.
15657!
15658 IF (get_var(iduvel)) THEN
15659 foundit=find_string(var_name, n_var, trim(vname(1,iduvel)), &
15660 & vindex)
15661 IF (foundit) THEN
15662 my_piovar%vd=var_desc(vindex)
15663 my_piovar%gtype=u3dvar
15664 IF (kind(ocean(ng)%tl_u).eq.8) THEN
15665 my_piovar%dkind=pio_double
15666 iodesc => iodesc_dp_u3dvar(ng)
15667 ELSE
15668 my_piovar%dkind=pio_real
15669 iodesc => iodesc_sp_u3dvar(ng)
15670 END IF
15671!
15672 status=nf_fread3d(ng, idmod, ncname, piofile, &
15673 & vname(1,iduvel), my_piovar, &
15674 & inprec, iodesc, vsize, &
15675 & lbi, ubi, lbj, ubj, 1, n(ng), &
15676 & fscl, fmin, fmax, &
15677# ifdef MASKING
15678 & grid(ng) % umask, &
15679# endif
15680# ifdef CHECKSUM
15681 & ocean(ng) % tl_u(:,:,:,tindex), &
15682 & checksum = fhash)
15683# else
15684 & ocean(ng) % tl_u(:,:,:,tindex))
15685# endif
15686 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15687 IF (master) THEN
15688 WRITE (stdout,60) string, trim(vname(1,iduvel)), &
15689 & inprec, trim(ncname)
15690 END IF
15691 exit_flag=2
15692 ioerror=status
15693 RETURN
15694 ELSE
15695 IF (master) THEN
15696# ifdef CHECKSUM
15697 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax, &
15698 & fhash
15699# else
15700 WRITE (stdout,70) trim(vname(2,iduvel)), fmin, fmax
15701# endif
15702 END IF
15703 END IF
15704 ELSE
15705 IF (master) THEN
15706 WRITE (stdout,80) string, trim(vname(1,iduvel)), &
15707 & trim(ncname)
15708 END IF
15709 exit_flag=4
15710 IF (founderror(exit_flag, pio_noerr, &
15711 & __line__, myfile)) THEN
15712 RETURN
15713 END IF
15714 END IF
15715 END IF
15716!
15717! Read in 3D momentum forcing in the ETA-direction.
15718!
15719 IF (get_var(idvvel)) THEN
15720 foundit=find_string(var_name, n_var, trim(vname(1,idvvel)), &
15721 & vindex)
15722 IF (foundit) THEN
15723 my_piovar%vd=var_desc(vindex)
15724 my_piovar%gtype=v3dvar
15725 IF (kind(ocean(ng)%tl_v).eq.8) THEN
15726 my_piovar%dkind=pio_double
15727 iodesc => iodesc_dp_v3dvar(ng)
15728 ELSE
15729 my_piovar%dkind=pio_real
15730 iodesc => iodesc_sp_v3dvar(ng)
15731 END IF
15732!
15733 status=nf_fread3d(ng, idmod, ncname, piofile, &
15734 & vname(1,idvvel), my_piovar, &
15735 & inprec, iodesc, vsize, &
15736 & lbi, ubi, lbj, ubj, 1, n(ng), &
15737 & fscl, fmin, fmax, &
15738# ifdef MASKING
15739 & grid(ng) % vmask, &
15740# endif
15741# ifdef CHECKSUM
15742 & ocean(ng) % tl_v(:,:,:,tindex), &
15743 & checksum = fhash)
15744# else
15745 & ocean(ng) % tl_v(:,:,:,tindex))
15746# endif
15747 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15748 IF (master) THEN
15749 WRITE (stdout,60) string, trim(vname(1,idvvel)), &
15750 & inprec, trim(ncname)
15751 END IF
15752 exit_flag=2
15753 ioerror=status
15754 RETURN
15755 ELSE
15756 IF (master) THEN
15757# ifdef CHECKSUM
15758 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax, &
15759 & fhash
15760# else
15761 WRITE (stdout,70) trim(vname(2,idvvel)), fmin, fmax
15762# endif
15763 END IF
15764 END IF
15765 ELSE
15766 IF (master) THEN
15767 WRITE (stdout,80) string, trim(vname(1,idvvel)), &
15768 & trim(ncname)
15769 END IF
15770 exit_flag=4
15771 IF (founderror(exit_flag, pio_noerr, &
15772 & __line__, myfile)) THEN
15773 RETURN
15774 END IF
15775 END IF
15776 END IF
15777!
15778! Read in tracer type variables.
15779!
15780 DO itrc=1,nt(ng)
15781 IF (get_var(idtvar(itrc))) THEN
15782 foundit=find_string(var_name, n_var, &
15783 & trim(vname(1,idtvar(itrc))), vindex)
15784 IF (foundit) THEN
15785 my_piovar%vd=var_desc(vindex)
15786 my_piovar%gtype=r3dvar
15787 IF (kind(ocean(ng)%tl_t).eq.8) THEN
15788 my_piovar%dkind=pio_double
15789 iodesc => iodesc_dp_r3dvar(ng)
15790 ELSE
15791 my_piovar%dkind=pio_real
15792 iodesc => iodesc_sp_r3dvar(ng)
15793 END IF
15794!
15795 status=nf_fread3d(ng, idmod, ncname, piofile, &
15796 & vname(1,idtvar(itrc)), my_piovar, &
15797 & inprec, iodesc, vsize, &
15798 & lbi, ubi, lbj, ubj, 1, n(ng), &
15799 & fscl, fmin, fmax, &
15800# ifdef MASKING
15801 & grid(ng) % rmask, &
15802# endif
15803# ifdef CHECKSUM
15804 & ocean(ng) % tl_t(:,:,:,tindex,itrc), &
15805 & checksum = fhash)
15806# else
15807 & ocean(ng) % tl_t(:,:,:,tindex,itrc))
15808# endif
15809 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
15810 IF (master) THEN
15811 WRITE (stdout,60) string, trim(vname(1,idtvar(itrc))),&
15812 & inprec, trim(ncname)
15813 END IF
15814 exit_flag=2
15815 ioerror=status
15816 RETURN
15817 ELSE
15818 IF (master) THEN
15819# ifdef CHECKSUM
15820 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
15821 & fmin, fmax, fhash
15822# else
15823 WRITE (stdout,70) trim(vname(2,idtvar(itrc))), &
15824 & fmin, fmax
15825# endif
15826 END IF
15827 END IF
15828 ELSE
15829 IF (master) THEN
15830 WRITE (stdout,80) string, trim(vname(1,idtvar(itrc))), &
15831 & trim(ncname)
15832 END IF
15833 exit_flag=4
15834 IF (founderror(exit_flag, pio_noerr, &
15835 & __line__, myfile)) THEN
15836 RETURN
15837 END IF
15838 END IF
15839 END IF
15840 END DO
15841# endif
15842 END IF tcs_state
15843# endif
15844!
15845!-----------------------------------------------------------------------
15846! Close input NetCDF file.
15847!-----------------------------------------------------------------------
15848!
15849 CALL pio_netcdf_close (ng, idmod, piofile, ncname, .false.)
15850
15851# ifdef PROFILE
15852!
15853! Turn off time wall clock.
15854!
15855 CALL wclock_off (ng, idmod, 80, __line__, myfile)
15856# endif
15857!
15858 10 FORMAT (/,2x,'GET_STATE_PIO - ',a,'unable to open input NetCDF', &
15859 & ' file: ',a)
15860 20 FORMAT (/,2x,'GET_STATE_PIO - ',a,'Warning - NetCDF global', &
15861 & ' attribute:',a, &
15862 & /,19x,'for lateral boundary conditions not checked', &
15863 & /,19x,'in file: ',a)
15864 30 FORMAT (/,2x,'GET_STATE_PIO - ',a,'requested input time', &
15865 & ' record = ',i0,/,19x,'not found in input NetCDF: ',a,/, &
15866 & 19x,'number of available records = ',i0)
15867 40 FORMAT (/,2x,'GET_STATE_PIO - ',a,a,t75,a, &
15868 & /,22x,'(Grid ',i2.2,a,i4.4, ', t = ',a, &
15869 & ', File: ',a, ', Rec=',i4.4,', Index=',i1,')')
15870 50 FORMAT (/,2x,'GET_STATE_PIO - ',a,a,t75,a, &
15871 & /,22x,'(Grid ',i2.2, ', t = ',a, &
15872 & ', File: ',a,', Rec=',i4.4, ', Index=',i1,')')
15873 60 FORMAT (/,2x,'GET_STATE_PIO - ',a,'error while reading', &
15874 & ' variable: ',a,2x,'at time record = ',i0, &
15875 & /,19x,'in input NetCDF file: ',a)
15876#ifdef CHECKSUM
15877 70 FORMAT (19x,'- ',a,/,22x,'(Min = ',1p,e15.8, &
15878 & ' Max = ',1p,e15.8,' CheckSum = ',i0,')')
15879#else
15880 70 FORMAT (19x,'- ',a,/,22x,'(Min = ',1p,e15.8, &
15881 & ' Max = ',1p,e15.8,')')
15882#endif
15883 75 FORMAT (19x,'- ',a,/,22x,'(Min = ',1p,e15.8, &
15884 & ' Max = ',1p,e15.8,')')
15885 80 FORMAT (/,2x,'GET_STATE_PIO - ',a,'cannot find variable: ',a, &
15886 & /,19x,'in input NetCDF file: ',a)
15887!
15888 RETURN
15889 END SUBROUTINE get_state_pio
15890#endif
15891 END MODULE get_state_mod
checkvars_mod::checkvars
Definition checkvars.F:63
lbc_mod::lbc_getatt
Definition lbc.F:28
mod_netcdf::netcdf_get_fvar
Definition mod_netcdf.F:45
mod_netcdf::netcdf_get_ivar
Definition mod_netcdf.F:59
mod_netcdf::netcdf_get_time
Definition mod_netcdf.F:77
mod_pio_netcdf::pio_netcdf_get_fvar
Definition mod_pio_netcdf.F:52
mod_pio_netcdf::pio_netcdf_get_ivar
Definition mod_pio_netcdf.F:66
mod_pio_netcdf::pio_netcdf_get_time
Definition mod_pio_netcdf.F:89
nf_fread2d_bry_mod::nf_fread2d_bry
Definition nf_fread2d_bry.F:70
nf_fread2d_mod::nf_fread2d
Definition nf_fread2d.F:69
nf_fread3d_bry_mod::nf_fread3d_bry
Definition nf_fread3d_bry.F:71
nf_fread3d_mod::nf_fread3d
Definition nf_fread3d.F:69
nf_fread4d_mod::nf_fread4d
Definition nf_fread4d.F:71
checkvars_mod
Definition checkvars.F:2
dateclock_mod
Definition dateclock.F:2
dateclock_mod::time_string
subroutine, public time_string(mytime, date_string)
Definition dateclock.F:1272
get_state_mod
Definition get_state.F:2
get_state_mod::get_state
subroutine, public get_state(ng, model, msg, s, inirec, tindex)
Definition get_state.F:90
get_state_mod::get_state_pio
subroutine, private get_state_pio(ng, model, msg, s, inirec, tindex, iorj, lbij, ubij, lbi, ubi, lbj, ubj)
Definition get_state.F:7481
get_state_mod::get_state_nf90
subroutine, private get_state_nf90(ng, model, msg, s, inirec, tindex, iorj, lbij, ubij, lbi, ubi, lbj, ubj)
Definition get_state.F:165
lbc_mod
Definition lbc.F:2
mod_boundary
Definition mod_boundary.F:2
mod_boundary::boundary
type(t_boundary), dimension(:), allocatable boundary
Definition mod_boundary.F:746
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
mod_fourdvar
Definition mod_fourdvar.F:2
mod_fourdvar::kvmax
real(r8), dimension(:), allocatable kvmax
Definition mod_fourdvar.F:637
mod_fourdvar::khmin
real(r8), dimension(:), allocatable khmin
Definition mod_fourdvar.F:634
mod_fourdvar::forcetime
real(r8), dimension(:), allocatable forcetime
Definition mod_fourdvar.F:918
mod_fourdvar::kvmin
real(r8), dimension(:), allocatable kvmin
Definition mod_fourdvar.F:636
mod_fourdvar::khmax
real(r8), dimension(:), allocatable khmax
Definition mod_fourdvar.F:635
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_ice
Definition ice_mod.h:1
mod_ice::isvice
integer, parameter isvice
Definition ice_mod.h:147
mod_ice::ice
type(t_ice), dimension(:), allocatable ice
Definition ice_mod.h:283
mod_ice::isice
integer, dimension(nices) isice
Definition ice_mod.h:135
mod_ice::isuice
integer, parameter isuice
Definition ice_mod.h:146
mod_ice::nices
integer, parameter nices
Definition ice_mod.h:130
mod_iounits
Definition mod_iounits.F:2
mod_iounits::ioerror
integer ioerror
Definition mod_iounits.F:313
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::idvmls
integer idvmls
Definition mod_ncparam.F:374
mod_ncparam::io_nf90
integer, parameter io_nf90
Definition mod_ncparam.F:95
mod_ncparam::idrv3d
integer idrv3d
Definition mod_ncparam.F:282
mod_ncparam::idubar
integer idubar
Definition mod_ncparam.F:325
mod_ncparam::idvvel
integer idvvel
Definition mod_ncparam.F:381
mod_ncparam::idhsbl
integer idhsbl
Definition mod_ncparam.F:213
mod_ncparam::idvsms
integer idvsms
Definition mod_ncparam.F:377
mod_ncparam::nv
integer, parameter nv
Definition mod_ncparam.F:105
mod_ncparam::isvvel
integer isvvel
Definition mod_ncparam.F:507
mod_ncparam::idsbry
integer, dimension(:), allocatable idsbry
Definition mod_ncparam.F:523
mod_ncparam::io_pio
integer, parameter io_pio
Definition mod_ncparam.F:96
mod_ncparam::isvbar
integer isvbar
Definition mod_ncparam.F:505
mod_ncparam::idsdif
integer idsdif
Definition mod_ncparam.F:290
mod_ncparam::idtsur
integer, dimension(:), allocatable idtsur
Definition mod_ncparam.F:453
mod_ncparam::idru2d
integer idru2d
Definition mod_ncparam.F:278
mod_ncparam::idvmkp
integer idvmkp
Definition mod_ncparam.F:376
mod_ncparam::idtdif
integer idtdif
Definition mod_ncparam.F:306
mod_ncparam::idfsur
integer idfsur
Definition mod_ncparam.F:206
mod_ncparam::idtvar
integer, dimension(:), allocatable idtvar
Definition mod_ncparam.F:568
mod_ncparam::istvar
integer, dimension(:), allocatable istvar
Definition mod_ncparam.F:520
mod_ncparam::idhbbl
integer idhbbl
Definition mod_ncparam.F:212
mod_ncparam::isuvel
integer isuvel
Definition mod_ncparam.F:506
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
mod_ncparam::idbath
integer idbath
Definition mod_ncparam.F:194
mod_ncparam::idmtke
integer idmtke
Definition mod_ncparam.F:237
mod_ncparam::iduvel
integer iduvel
Definition mod_ncparam.F:343
mod_ncparam::idghat
integer, dimension(2) idghat
Definition mod_ncparam.F:209
mod_ncparam::idkver
integer idkver
Definition mod_ncparam.F:218
mod_ncparam::vname
character(len=maxlen), dimension(6, 0:nv) vname
Definition mod_ncparam.F:591
mod_ncparam::isubar
integer isubar
Definition mod_ncparam.F:504
mod_ncparam::idru3d
integer idru3d
Definition mod_ncparam.F:279
mod_ncparam::idusms
integer idusms
Definition mod_ncparam.F:339
mod_ncparam::idvmkk
integer idvmkk
Definition mod_ncparam.F:375
mod_ncparam::idvvis
integer idvvis
Definition mod_ncparam.F:382
mod_ncparam::idrzet
integer idrzet
Definition mod_ncparam.F:286
mod_ncparam::idmtls
integer idmtls
Definition mod_ncparam.F:238
mod_ncparam::idkhor
integer idkhor
Definition mod_ncparam.F:217
mod_ncparam::idrv2d
integer idrv2d
Definition mod_ncparam.F:281
mod_ncparam::idvbar
integer idvbar
Definition mod_ncparam.F:360
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::var_achar
character(len=1024), dimension(nvara) var_achar
Definition mod_netcdf.F:183
mod_netcdf::var_flag
integer, dimension(mvars) var_flag
Definition mod_netcdf.F:162
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::n_var
integer n_var
Definition mod_netcdf.F:152
mod_netcdf::var_dsize
integer, dimension(nvard) var_dsize
Definition mod_netcdf.F:177
mod_netcdf::var_aname
character(len=100), dimension(nvara) var_aname
Definition mod_netcdf.F:181
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_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_parallel::myrank
integer myrank
Definition mod_parallel.F:157
mod_param
Definition mod_param.F:2
mod_param::nat
integer nat
Definition mod_param.F:499
mod_param::u2dobc
integer, parameter u2dobc
Definition mod_param.F:729
mod_param::v3dobc
integer, parameter v3dobc
Definition mod_param.F:733
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::nbed
integer nbed
Definition mod_param.F:517
mod_param::r2dobc
integer, parameter r2dobc
Definition mod_param.F:728
mod_param::irpm
integer, parameter irpm
Definition mod_param.F:664
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::bounds
type(t_bounds), dimension(:), allocatable bounds
Definition mod_param.F:232
mod_param::b3dvar
integer, parameter b3dvar
Definition mod_param.F:725
mod_param::r3dvar
integer, parameter r3dvar
Definition mod_param.F:721
mod_param::r3dobc
integer, parameter r3dobc
Definition mod_param.F:731
mod_param::v2dobc
integer, parameter v2dobc
Definition mod_param.F:730
mod_param::iobounds
type(t_iobounds), dimension(:), allocatable iobounds
Definition mod_param.F:282
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_param::iadm
integer, parameter iadm
Definition mod_param.F:665
mod_param::u3dobc
integer, parameter u3dobc
Definition mod_param.F:732
mod_param::lbc
type(t_lbc), dimension(:,:,:), allocatable lbc
Definition mod_param.F:375
mod_param::u3dvar
integer, parameter u3dvar
Definition mod_param.F:722
mod_param::u2dvar
integer, parameter u2dvar
Definition mod_param.F:718
mod_param::itlm
integer, parameter itlm
Definition mod_param.F:663
mod_param::w3dvar
integer, parameter w3dvar
Definition mod_param.F:724
mod_param::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_param::v2dvar
integer, parameter v2dvar
Definition mod_param.F:719
mod_param::nst
integer nst
Definition mod_param.F:521
mod_param::v3dvar
integer, parameter v3dvar
Definition mod_param.F:723
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::iodesc_sp_w3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_w3dvar
Definition mod_pio_netcdf.F:212
mod_pio_netcdf::iodesc_sp_v2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dobc
Definition mod_pio_netcdf.F:217
mod_pio_netcdf::iodesc_dp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dvar
Definition mod_pio_netcdf.F:248
mod_pio_netcdf::iodesc_sp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dvar
Definition mod_pio_netcdf.F:210
mod_pio_netcdf::iodesc_dp_v2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dobc
Definition mod_pio_netcdf.F:256
mod_pio_netcdf::iodesc_sp_u2dfrc
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dfrc
Definition mod_pio_netcdf.F:228
mod_pio_netcdf::iodesc_dp_v3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dobc
Definition mod_pio_netcdf.F:260
mod_pio_netcdf::iodesc_dp_tkevar
type(io_desc_t), dimension(:), pointer iodesc_dp_tkevar
Definition mod_pio_netcdf.F:388
mod_pio_netcdf::iodesc_sp_trcvar
type(io_desc_t), dimension(:), pointer iodesc_sp_trcvar
Definition mod_pio_netcdf.F:373
mod_pio_netcdf::iodesc_dp_b3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_b3dvar
Definition mod_pio_netcdf.F:241
mod_pio_netcdf::iodesc_sp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dvar
Definition mod_pio_netcdf.F:195
mod_pio_netcdf::iodesc_dp_u3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dobc
Definition mod_pio_netcdf.F:259
mod_pio_netcdf::iodesc_sp_r3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dobc
Definition mod_pio_netcdf.F:219
mod_pio_netcdf::iodesc_dp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dvar
Definition mod_pio_netcdf.F:249
mod_pio_netcdf::iodesc_dp_u2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dobc
Definition mod_pio_netcdf.F:255
mod_pio_netcdf::iodesc_sp_r2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dobc
Definition mod_pio_netcdf.F:215
mod_pio_netcdf::iodesc_dp_ubar
type(io_desc_t), dimension(:), pointer iodesc_dp_ubar
Definition mod_pio_netcdf.F:381
mod_pio_netcdf::var_desc
type(var_desc_t), dimension(:), pointer var_desc
Definition mod_pio_netcdf.F:437
mod_pio_netcdf::iodesc_sp_tkevar
type(io_desc_t), dimension(:), pointer iodesc_sp_tkevar
Definition mod_pio_netcdf.F:371
mod_pio_netcdf::iodesc_sp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
Definition mod_pio_netcdf.F:194
mod_pio_netcdf::iodesc_dp_ruvel
type(io_desc_t), dimension(:), pointer iodesc_dp_ruvel
Definition mod_pio_netcdf.F:385
mod_pio_netcdf::pio_frst
integer, parameter pio_frst
Definition mod_pio_netcdf.F:574
mod_pio_netcdf::iodesc_dp_rzeta
type(io_desc_t), dimension(:), pointer iodesc_dp_rzeta
Definition mod_pio_netcdf.F:380
mod_pio_netcdf::iodesc_sp_rzeta
type(io_desc_t), dimension(:), pointer iodesc_sp_rzeta
Definition mod_pio_netcdf.F:363
mod_pio_netcdf::iodesc_sp_u3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dobc
Definition mod_pio_netcdf.F:220
mod_pio_netcdf::iodesc_dp_u2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dfrc
Definition mod_pio_netcdf.F:267
mod_pio_netcdf::iodesc_dp_uvel
type(io_desc_t), dimension(:), pointer iodesc_dp_uvel
Definition mod_pio_netcdf.F:391
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::iodesc_dp_r2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dobc
Definition mod_pio_netcdf.F:254
mod_pio_netcdf::iodesc_sp_b3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_b3dvar
Definition mod_pio_netcdf.F:202
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::iodesc_sp_rvvel
type(io_desc_t), dimension(:), pointer iodesc_sp_rvvel
Definition mod_pio_netcdf.F:369
mod_pio_netcdf::iodesc_sp_u2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dobc
Definition mod_pio_netcdf.F:216
mod_pio_netcdf::iodesc_dp_rvvel
type(io_desc_t), dimension(:), pointer iodesc_dp_rvvel
Definition mod_pio_netcdf.F:386
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_v2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dfrc
Definition mod_pio_netcdf.F:268
mod_pio_netcdf::iodesc_dp_vvel
type(io_desc_t), dimension(:), pointer iodesc_dp_vvel
Definition mod_pio_netcdf.F:392
mod_pio_netcdf::iodesc_dp_rvbar
type(io_desc_t), dimension(:), pointer iodesc_dp_rvbar
Definition mod_pio_netcdf.F:379
mod_pio_netcdf::iodesc_dp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dvar
Definition mod_pio_netcdf.F:250
mod_pio_netcdf::iodesc_sp_vbar
type(io_desc_t), dimension(:), pointer iodesc_sp_vbar
Definition mod_pio_netcdf.F:365
mod_pio_netcdf::iodesc_dp_vbar
type(io_desc_t), dimension(:), pointer iodesc_dp_vbar
Definition mod_pio_netcdf.F:382
mod_pio_netcdf::iodesc_sp_v2dfrc
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dfrc
Definition mod_pio_netcdf.F:229
mod_pio_netcdf::iodesc_sp_rvbar
type(io_desc_t), dimension(:), pointer iodesc_sp_rvbar
Definition mod_pio_netcdf.F:362
mod_pio_netcdf::iodesc_dp_w3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_w3dvar
Definition mod_pio_netcdf.F:251
mod_pio_netcdf::iodesc_dp_r2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dfrc
Definition mod_pio_netcdf.F:264
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_sp_vvel
type(io_desc_t), dimension(:), pointer iodesc_sp_vvel
Definition mod_pio_netcdf.F:375
mod_pio_netcdf::iodesc_sp_ubar
type(io_desc_t), dimension(:), pointer iodesc_sp_ubar
Definition mod_pio_netcdf.F:364
mod_pio_netcdf::iodesc_sp_uvel
type(io_desc_t), dimension(:), pointer iodesc_sp_uvel
Definition mod_pio_netcdf.F:374
mod_pio_netcdf::iodesc_sp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dvar
Definition mod_pio_netcdf.F:211
mod_pio_netcdf::iodesc_sp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dvar
Definition mod_pio_netcdf.F:209
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_ruvel
type(io_desc_t), dimension(:), pointer iodesc_sp_ruvel
Definition mod_pio_netcdf.F:368
mod_pio_netcdf::iodesc_dp_r3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dobc
Definition mod_pio_netcdf.F:258
mod_pio_netcdf::iodesc_dp_rubar
type(io_desc_t), dimension(:), pointer iodesc_dp_rubar
Definition mod_pio_netcdf.F:378
mod_pio_netcdf::iodesc_sp_rubar
type(io_desc_t), dimension(:), pointer iodesc_sp_rubar
Definition mod_pio_netcdf.F:361
mod_pio_netcdf::iodesc_sp_v3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dobc
Definition mod_pio_netcdf.F:221
mod_pio_netcdf::iodesc_sp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dvar
Definition mod_pio_netcdf.F:196
mod_pio_netcdf::iodesc_sp_r2dfrc
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dfrc
Definition mod_pio_netcdf.F:225
mod_pio_netcdf::iodesc_dp_trcvar
type(io_desc_t), dimension(:), pointer iodesc_dp_trcvar
Definition mod_pio_netcdf.F:390
mod_scalars
Definition mod_scalars.F:2
mod_scalars::day2sec
real(dp), parameter day2sec
Definition mod_scalars.F:816
mod_scalars::nrrec
integer, dimension(:), allocatable nrrec
Definition mod_scalars.F:1171
mod_scalars::ntimes
integer, dimension(:), allocatable ntimes
Definition mod_scalars.F:336
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
mod_scalars::lobc
logical, dimension(:,:,:), allocatable lobc
Definition mod_scalars.F:1127
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::lstflux
logical, dimension(:,:), allocatable lstflux
Definition mod_scalars.F:1156
mod_scalars::erend
integer erend
Definition mod_scalars.F:352
mod_scalars::lastrec
logical, dimension(:), allocatable lastrec
Definition mod_scalars.F:1183
mod_scalars::nfrec
integer, dimension(:), allocatable nfrec
Definition mod_scalars.F:1148
mod_scalars::cp
real(dp) cp
Definition mod_scalars.F:456
mod_scalars::tdays
real(dp), dimension(:), allocatable tdays
Definition mod_scalars.F:261
mod_scalars::frctime
real(dp), dimension(:), allocatable frctime
Definition mod_scalars.F:279
mod_scalars::dstart
real(dp) dstart
Definition mod_scalars.F:281
mod_scalars::rclock
type(t_clock) rclock
Definition mod_scalars.F:120
mod_scalars::sec2day
real(dp), parameter sec2day
Definition mod_scalars.F:817
mod_scalars::ntend
integer, dimension(:), allocatable ntend
Definition mod_scalars.F:379
mod_scalars::time_code
character(len=22), dimension(:), allocatable time_code
Definition mod_scalars.F:292
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::isalt
integer isalt
Definition mod_scalars.F:127
mod_scalars::nrecfrc
integer, dimension(:), allocatable nrecfrc
Definition mod_scalars.F:388
mod_scalars::itemp
integer itemp
Definition mod_scalars.F:126
mod_scalars::erstr
integer erstr
Definition mod_scalars.F:351
mod_scalars::perfectrst
logical, dimension(:), allocatable perfectrst
Definition mod_scalars.F:244
mod_scalars::ntfirst
integer, dimension(:), allocatable ntfirst
Definition mod_scalars.F:377
mod_scalars::time
real(dp), dimension(:), allocatable time
Definition mod_scalars.F:262
mod_scalars::rho0
real(dp) rho0
Definition mod_scalars.F:787
mod_scalars::ntstart
integer, dimension(:), allocatable ntstart
Definition mod_scalars.F:378
mod_scalars::nrun
integer nrun
Definition mod_scalars.F:355
mod_scalars::nbrec
integer, dimension(:), allocatable nbrec
Definition mod_scalars.F:1119
mod_scalars::inner
integer inner
Definition mod_scalars.F:360
mod_scalars::io_time
real(dp) io_time
Definition mod_scalars.F:285
mod_scalars::initime
real(dp), dimension(:), allocatable initime
Definition mod_scalars.F:276
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
mod_scalars::outer
integer outer
Definition mod_scalars.F:361
mod_sedbed
Definition sedbed_mod.h:1
mod_sedbed::sedbed
type(t_sedbed), dimension(:), allocatable sedbed
Definition sedbed_mod.h:157
mod_sediment
Definition sediment_mod.h:1
mod_sediment::idubld
integer, dimension(:), allocatable idubld
Definition sediment_mod.h:160
mod_sediment::mbotp
integer, parameter mbotp
Definition sediment_mod.h:106
mod_sediment::idsbed
integer, dimension(mbedp) idsbed
Definition sediment_mod.h:103
mod_sediment::idfrac
integer, dimension(:), allocatable idfrac
Definition sediment_mod.h:159
mod_sediment::idbott
integer, dimension(mbotp) idbott
Definition sediment_mod.h:112
mod_sediment::idvbld
integer, dimension(:), allocatable idvbld
Definition sediment_mod.h:161
mod_sediment::idbmas
integer, dimension(:), allocatable idbmas
Definition sediment_mod.h:158
mod_sediment::mbedp
integer, parameter mbedp
Definition sediment_mod.h:99
mod_stepping
Definition mod_stepping.F:2
mod_stepping::kstp
integer, dimension(:), allocatable kstp
Definition mod_stepping.F:66
mod_stepping::knew
integer, dimension(:), allocatable knew
Definition mod_stepping.F:64
mod_stepping::nrhs
integer, dimension(:), allocatable nrhs
Definition mod_stepping.F:70
mod_stepping::nnew
integer, dimension(:), allocatable nnew
Definition mod_stepping.F:69
mod_stepping::krhs
integer, dimension(:), allocatable krhs
Definition mod_stepping.F:65
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71
mod_strings
Definition mod_strings.F:2
mod_strings::statemsg
character(len=48), dimension(18) statemsg
Definition mod_strings.F:142
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
mp_exchange_mod::mp_exchange3d
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:2037
nf_fread2d_bry_mod
Definition nf_fread2d_bry.F:2
nf_fread2d_mod
Definition nf_fread2d.F:2
nf_fread3d_bry_mod
Definition nf_fread3d_bry.F:2
nf_fread3d_mod
Definition nf_fread3d.F:2
nf_fread4d_mod
Definition nf_fread4d.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
mod_iounits::t_io
Definition mod_iounits.F:164
wclock_off
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
wclock_on
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3