ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
tl_def_his_mod Module Reference

Functions/Subroutines

subroutine, public tl_def_his (ng, ldef)
 
subroutine, private tl_def_his_nf90 (ng, model, ldef)
 
subroutine, private tl_def_his_pio (ng, ldef)
 

Function/Subroutine Documentation

◆ tl_def_his()

subroutine, public tl_def_his_mod::tl_def_his ( integer, intent(in) ng,
logical, intent(in) ldef )

Definition at line 50 of file tl_def_his.F.

51!***********************************************************************
52!
53! Imported variable declarations.
54!
55 logical, intent(in) :: ldef
56!
57 integer, intent(in) :: ng
58!
59! Local variable declarations.
60!
61 character (len=*), parameter :: MyFile = &
62 & __FILE__
63!
64!-----------------------------------------------------------------------
65! Create a new history file according to IO type.
66!-----------------------------------------------------------------------
67!
68 SELECT CASE (tlm(ng)%IOtype)
69 CASE (io_nf90)
70 CALL tl_def_his_nf90 (ng, itlm, ldef)
71
72# if defined PIO_LIB && defined DISTRIBUTE
73 CASE (io_pio)
74 CALL tl_def_his_pio (ng, itlm, ldef)
75# endif
76 CASE DEFAULT
77 IF (master) WRITE (stdout,10) tlm(ng)%IOtype
78 exit_flag=3
79 END SELECT
80 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
81!
82 10 FORMAT (' TL_DEF_HIS - Illegal output file type, io_type = ',i0, &
83 & /,14x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
84!
85 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_param::itlm, mod_parallel::master, mod_scalars::noerror, mod_iounits::stdout, tl_def_his_nf90(), tl_def_his_pio(), and mod_iounits::tlm.

Referenced by i4dvar_mod::increment(), rp_output(), and tl_output().

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

◆ tl_def_his_nf90()

subroutine, private tl_def_his_mod::tl_def_his_nf90 ( integer, intent(in) ng,
integer, intent(in) model,
logical, intent(in) ldef )
private

Definition at line 89 of file tl_def_his.F.

90!***********************************************************************
91!
92 USE mod_netcdf
93!
94! Imported variable declarations.
95!
96 integer, intent(in) :: ng, model
97!
98 logical, intent(in) :: ldef
99!
100! Local variable declarations.
101!
102 logical :: got_var(NV)
103!
104 integer, parameter :: Natt = 25
105
106 integer :: i, j, ifield, itrc, nvd3, nvd4
107 integer :: recdim, status, varid
108# ifdef ADJUST_BOUNDARY
109 integer :: IorJdim, brecdim
110# endif
111# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
112 integer :: frecdim
113# endif
114 integer :: DimIDs(nDimID)
115 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
116# ifdef ADJUST_BOUNDARY
117 integer :: t2dobc(4)
118# endif
119
120# ifdef SOLVE3D
121 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
122# ifdef ADJUST_BOUNDARY
123 integer :: t3dobc(5)
124# endif
125# ifdef ADJUST_STFLUX
126 integer :: t3dfrc(4)
127# endif
128# endif
129# ifdef ADJUST_WSTRESS
130 integer :: u3dfrc(4), v3dfrc(4)
131# endif
132!
133 real(r8) :: Aval(6)
134!
135 character (len=256) :: ncname
136 character (len=MaxLen) :: Vinfo(Natt)
137!
138 character (len=*), parameter :: MyFile = &
139 & __FILE__//", tl_def_his_nf90"
140!
141 sourcefile=myfile
142!
143!-----------------------------------------------------------------------
144! Set and report file name.
145!-----------------------------------------------------------------------
146!
147 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
148 ncname=tlm(ng)%name
149!
150 IF (master) THEN
151 IF (ldef) THEN
152 WRITE (stdout,10) ng, trim(ncname)
153 ELSE
154 WRITE (stdout,20) ng, trim(ncname)
155 END IF
156 END IF
157!
158!=======================================================================
159! Create a new tangent linear history file.
160!=======================================================================
161!
162 define : IF (ldef) THEN
163 CALL netcdf_create (ng, model, trim(ncname), tlm(ng)%ncid)
164 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
165 IF (master) WRITE (stdout,30) trim(ncname)
166 RETURN
167 END IF
168!
169!-----------------------------------------------------------------------
170! Define file dimensions.
171!-----------------------------------------------------------------------
172!
173 dimids=0
174!
175 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'xi_rho', &
176 & iobounds(ng)%xi_rho, dimids( 1))
177 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
178
179 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'xi_u', &
180 & iobounds(ng)%xi_u, dimids( 2))
181 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
182
183 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'xi_v', &
184 & iobounds(ng)%xi_v, dimids( 3))
185 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
186
187 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'xi_psi', &
188 & iobounds(ng)%xi_psi, dimids( 4))
189 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
190
191 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'eta_rho', &
192 & iobounds(ng)%eta_rho, dimids( 5))
193 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
194
195 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'eta_u', &
196 & iobounds(ng)%eta_u, dimids( 6))
197 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
198
199 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'eta_v', &
200 & iobounds(ng)%eta_v, dimids( 7))
201 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
202
203 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'eta_psi', &
204 & iobounds(ng)%eta_psi, dimids( 8))
205 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
206
207# ifdef ADJUST_BOUNDARY
208 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'IorJ', &
209 & iobounds(ng)%IorJ, iorjdim)
210 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
211# endif
212
213# if defined WRITE_WATER && defined MASKING
214 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'xy_rho', &
215 & iobounds(ng)%xy_rho, dimids(17))
216 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
217
218 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'xy_u', &
219 & iobounds(ng)%xy_u, dimids(18))
220 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
221
222 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'xy_v', &
223 & iobounds(ng)%xy_v, dimids(19))
224 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
225# endif
226
227# ifdef SOLVE3D
228# if defined WRITE_WATER && defined MASKING
229 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'xyz_rho', &
230 & iobounds(ng)%xy_rho*n(ng), dimids(20))
231 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
232
233 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'xyz_u', &
234 & iobounds(ng)%xy_u*n(ng), dimids(21))
235 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
236
237 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'xyz_v', &
238 & iobounds(ng)%xy_v*n(ng), dimids(22))
239 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
240
241 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'xyz_w', &
242 & iobounds(ng)%xy_rho*(n(ng)+1), dimids(23))
243 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
244# endif
245
246 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'N', &
247 & n(ng), dimids( 9))
248 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
249
250 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 's_rho', &
251 & n(ng), dimids( 9))
252 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
253
254 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 's_w', &
255 & n(ng)+1, dimids(10))
256 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
257
258 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'tracer', &
259 & nt(ng), dimids(11))
260 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
261
262# ifdef SEDIMENT
263 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'NST', &
264 & nst, dimids(32))
265 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
266
267 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'Nbed', &
268 & nbed, dimids(16))
269 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
270
271# if defined WRITE_WATER && defined MASKING
272 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'xybed', &
273 & iobounds(ng)%xy_rho*nbed, dimids(24))
274 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
275# endif
276# endif
277
278# ifdef ECOSIM
279 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'Nbands', &
280 & nbands, dimids(33))
281 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
282
283 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'Nphy', &
284 & nphy, dimids(25))
285 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
286
287 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'Nbac', &
288 & nbac, dimids(26))
289 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
290
291 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'Ndom', &
292 & ndom, dimids(27))
293 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
294
295 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'Nfec', &
296 & nfec, dimids(28))
297 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
298# endif
299# endif
300
301 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'boundary', &
302 & 4, dimids(14))
303 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
304
305# ifdef FOUR_DVAR
306 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'Nstate', &
307 & nstatevar(ng), dimids(29))
308 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
309# endif
310
311# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
312 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'frc_adjust', &
313 & nfrec(ng), dimids(30))
314 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
315# endif
316
317# ifdef ADJUST_BOUNDARY
318 status=def_dim(ng, model, tlm(ng)%ncid, ncname, 'obc_adjust', &
319 & nbrec(ng), dimids(31))
320 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
321# endif
322
323 status=def_dim(ng, model, tlm(ng)%ncid, ncname, &
324 & trim(adjustl(vname(5,idtime))), &
325 & nf90_unlimited, dimids(12))
326 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
327
328 recdim=dimids(12)
329# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
330 frecdim=dimids(30)
331# endif
332# ifdef ADJUST_BOUNDARY
333 brecdim=dimids(31)
334# endif
335!
336! Set number of dimensions for output variables.
337!
338# if defined WRITE_WATER && defined MASKING
339 nvd3=2
340 nvd4=2
341# else
342 nvd3=3
343 nvd4=4
344# endif
345!
346! Define dimension vectors for staggered tracer type variables.
347!
348# if defined WRITE_WATER && defined MASKING
349 t2dgrd(1)=dimids(17)
350 t2dgrd(2)=dimids(12)
351# ifdef SOLVE3D
352 t3dgrd(1)=dimids(20)
353 t3dgrd(2)=dimids(12)
354# endif
355# else
356 t2dgrd(1)=dimids( 1)
357 t2dgrd(2)=dimids( 5)
358 t2dgrd(3)=dimids(12)
359# ifdef SOLVE3D
360 t3dgrd(1)=dimids( 1)
361 t3dgrd(2)=dimids( 5)
362 t3dgrd(3)=dimids( 9)
363 t3dgrd(4)=dimids(12)
364# endif
365# ifdef ADJUST_STFLUX
366 t3dfrc(1)=dimids( 1)
367 t3dfrc(2)=dimids( 5)
368 t3dfrc(3)=frecdim
369 t3dfrc(4)=dimids(12)
370# endif
371# endif
372# ifdef ADJUST_BOUNDARY
373 t2dobc(1)=iorjdim
374 t2dobc(2)=dimids(14)
375 t2dobc(3)=brecdim
376 t2dobc(4)=dimids(12)
377# ifdef SOLVE3D
378 t3dobc(1)=iorjdim
379 t3dobc(2)=dimids( 9)
380 t3dobc(3)=dimids(14)
381 t3dobc(4)=brecdim
382 t3dobc(5)=dimids(12)
383# endif
384# endif
385!
386! Define dimension vectors for staggered u-momentum type variables.
387!
388# if defined WRITE_WATER && defined MASKING
389 u2dgrd(1)=dimids(18)
390 u2dgrd(2)=dimids(12)
391# ifdef SOLVE3D
392 u3dgrd(1)=dimids(21)
393 u3dgrd(2)=dimids(12)
394# endif
395# else
396 u2dgrd(1)=dimids( 2)
397 u2dgrd(2)=dimids( 6)
398 u2dgrd(3)=dimids(12)
399# ifdef SOLVE3D
400 u3dgrd(1)=dimids( 2)
401 u3dgrd(2)=dimids( 6)
402 u3dgrd(3)=dimids( 9)
403 u3dgrd(4)=dimids(12)
404# endif
405# ifdef ADJUST_WSTRESS
406 u3dfrc(1)=dimids( 2)
407 u3dfrc(2)=dimids( 6)
408 u3dfrc(3)=frecdim
409 u3dfrc(4)=dimids(12)
410# endif
411# endif
412!
413! Define dimension vectors for staggered v-momentum type variables.
414!
415# if defined WRITE_WATER && defined MASKING
416 v2dgrd(1)=dimids(19)
417 v2dgrd(2)=dimids(12)
418# ifdef SOLVE3D
419 v3dgrd(1)=dimids(22)
420 v3dgrd(2)=dimids(12)
421# endif
422# else
423 v2dgrd(1)=dimids( 3)
424 v2dgrd(2)=dimids( 7)
425 v2dgrd(3)=dimids(12)
426# ifdef SOLVE3D
427 v3dgrd(1)=dimids( 3)
428 v3dgrd(2)=dimids( 7)
429 v3dgrd(3)=dimids( 9)
430 v3dgrd(4)=dimids(12)
431# endif
432# ifdef ADJUST_WSTRESS
433 v3dfrc(1)=dimids( 3)
434 v3dfrc(2)=dimids( 7)
435 v3dfrc(3)=frecdim
436 v3dfrc(4)=dimids(12)
437# endif
438# endif
439# ifdef SOLVE3D
440!
441! Define dimension vector for staggered w-momentum type variables.
442!
443# if defined WRITE_WATER && defined MASKING
444 w3dgrd(1)=dimids(23)
445 w3dgrd(2)=dimids(12)
446# else
447 w3dgrd(1)=dimids( 1)
448 w3dgrd(2)=dimids( 5)
449 w3dgrd(3)=dimids(10)
450 w3dgrd(4)=dimids(12)
451# endif
452# endif
453!
454! Initialize unlimited time record dimension.
455!
456 tlm(ng)%Rindex=0
457!
458! Initialize local information variable arrays.
459!
460 DO i=1,natt
461 DO j=1,len(vinfo(1))
462 vinfo(i)(j:j)=' '
463 END DO
464 END DO
465 DO i=1,6
466 aval(i)=0.0_r8
467 END DO
468!
469!-----------------------------------------------------------------------
470! Define time-recordless information variables.
471!-----------------------------------------------------------------------
472!
473 CALL def_info (ng, model, tlm(ng)%ncid, ncname, dimids)
474 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
475!
476!-----------------------------------------------------------------------
477! Define time-varying variables.
478!-----------------------------------------------------------------------
479!
480! Define model time.
481!
482 vinfo( 1)=vname(1,idtime)
483 vinfo( 2)=vname(2,idtime)
484 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
485 vinfo( 4)=trim(rclock%calendar)
486 vinfo(14)=vname(4,idtime)
487 vinfo(21)=vname(6,idtime)
488 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idtime), &
489 & nf_type, 1, (/recdim/), aval, vinfo, ncname, &
490 & setparaccess = .false.)
491 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
492
493# ifdef PROPAGATOR
494!
495! Define Ritz eigenvalues and Ritz eigenvectors Euclidean norm.
496!
497 vinfo( 1)='Ritz_rvalue'
498 vinfo( 2)='real Ritz eigenvalues'
499 status=def_var(ng, model, tlm(ng)%ncid, varid, nf_type, &
500 & 1, (/recdim/), aval, vinfo, ncname, &
501 & setparaccess = .false.)
502 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
503
504# if defined FT_EIGENMODES
505 vinfo( 1)='Ritz_ivalue'
506 vinfo( 2)='imaginary Ritz eigenvalues'
507 status=def_var(ng, model, tlm(ng)%ncid, varid, nf_type, &
508 & 1, (/recdim/), aval, vinfo, ncname, &
509 & setparaccess = .false.)
510 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
511# endif
512
513 vinfo( 1)='Ritz_norm'
514 vinfo( 2)='Ritz eigenvectors Euclidean norm'
515 status=def_var(ng, model, tlm(ng)%ncid, varid, nf_type, &
516 & 1, (/recdim/), aval, vinfo, ncname, &
517 & setparaccess = .false.)
518 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
519# endif
520# ifdef ADJUST_WSTRESS
521!
522! Define surface U-momentum stress. Notice that the stress has its
523! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
524! at other times in addition to initialization time.
525!
526 vinfo( 1)=vname(1,idusms)
527 WRITE (vinfo( 2),40) trim(vname(2,idusms))
528 vinfo( 3)='meter2 second-2'
529 vinfo(16)=vname(1,idtime)
530# if defined WRITE_WATER && defined MASKING
531 vinfo(20)='mask_u'
532# endif
533 vinfo(22)='coordinates'
534 aval(5)=real(iinfo(1,idusms,ng),r8)
535 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idusms), &
536 & nf_fout, nvd4, u3dfrc, aval, vinfo, ncname)
537 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
538!
539! Define surface V-momentum stress.
540!
541 vinfo( 1)=vname(1,idvsms)
542 WRITE (vinfo( 2),40) trim(vname(2,idvsms))
543 vinfo( 3)='meter2 second-2'
544 vinfo(16)=vname(1,idtime)
545# if defined WRITE_WATER && defined MASKING
546 vinfo(20)='mask_v'
547# endif
548 vinfo(22)='coordinates'
549 aval(5)=real(iinfo(1,idvsms,ng),r8)
550 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idvsms), &
551 & nf_fout, nvd4, v3dfrc, aval, vinfo, ncname)
552 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
553# endif
554# if defined FORCING_SV || defined STOCHASTIC_OPT || \
555 defined hessian_so || defined hessian_fsv
556!
557! Define surface U-momentum stress.
558!
559 IF (hout(idusms,ng)) THEN
560 vinfo( 1)=vname(1,idusms)
561 WRITE (vinfo( 2),40) trim(vname(2,idusms))
562 vinfo( 3)=vname(3,idusms)
563 vinfo(14)=vname(4,idusms)
564 vinfo(16)=vname(1,idtime)
565# if defined WRITE_WATER && defined MASKING
566 vinfo(20)='mask_u'
567# endif
568 vinfo(21)=vname(6,idusms)
569 vinfo(22)='coordinates'
570 aval(5)=real(iinfo(1,idusms,ng),r8)
571 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idusms), &
572 & nf_fout, nvd3, u2dgrd, aval, vinfo, ncname)
573 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
574 END IF
575!
576! Define surface V-momentum stress.
577!
578 IF (hout(idvsms,ng)) THEN
579 vinfo( 1)=vname(1,idvsms)
580 WRITE (vinfo( 2),40) trim(vname(2,idvsms))
581 vinfo( 3)=vname(3,idvsms)
582 vinfo(14)=vname(4,idvsms)
583 vinfo(16)=vname(1,idtime)
584# if defined WRITE_WATER && defined MASKING
585 vinfo(20)='mask_v'
586# endif
587 vinfo(21)=vname(6,idvsms)
588 vinfo(22)='coordinates'
589 aval(5)=real(iinfo(1,idvsms,ng),r8)
590 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idvsms), &
591 & nf_fout, nvd3, v2dgrd, aval, vinfo, ncname)
592 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
593 END IF
594!
595! Define surface tracer fluxes.
596!
597 DO itrc=1,nt(ng)
598 IF (hout(idtsur(itrc),ng)) THEN
599 vinfo( 1)=vname(1,idtsur(itrc))
600 WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
601 vinfo( 3)=vname(3,idtsur(itrc))
602 IF (itrc.eq.itemp) THEN
603 vinfo(11)='upward flux, cooling'
604 vinfo(12)='downward flux, heating'
605 ELSE IF (itrc.eq.isalt) THEN
606 vinfo(11)='upward flux, freshening (net precipitation)'
607 vinfo(12)='downward flux, salting (net evaporation)'
608 END IF
609 vinfo(14)=vname(4,idtsur(itrc))
610 vinfo(16)=vname(1,idtime)
611# if defined WRITE_WATER && defined MASKING
612 vinfo(20)='mask_rho'
613# endif
614 vinfo(21)=vname(6,idtsur(itrc))
615 vinfo(22)='coordinates'
616 aval(5)=real(iinfo(1,idtsur(itrc),ng),r8)
617 status=def_var(ng, model, tlm(ng)%ncid, &
618 & tlm(ng)%Vid(idtsur(itrc)), nf_fout, &
619 & nvd3, t2dgrd, aval, vinfo, ncname)
620 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
621 END IF
622 END DO
623# endif
624# if defined ADJUST_STFLUX && defined SOLVE3D
625!
626! Define surface net heat flux. Notice that different tracer fluxes
627! are written at their own fixed time-dimension (of size Nfrec) to
628! allow 4DVAR adjustments at other times in addition to initial time.
629!
630 DO itrc=1,nt(ng)
631 IF (lstflux(itrc,ng)) THEN
632 vinfo( 1)=vname(1,idtsur(itrc))
633 WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
634 IF (itrc.eq.itemp) THEN
635 vinfo( 3)='Celsius meter second-1'
636 vinfo(11)='upward flux, cooling'
637 vinfo(12)='downward flux, heating'
638 ELSE IF (itrc.eq.isalt) THEN
639 vinfo( 3)='meter second-1'
640 vinfo(11)='upward flux, freshening (net precipitation)'
641 vinfo(12)='downward flux, salting (net evaporation)'
642 END IF
643 vinfo(16)=vname(1,idtime)
644# if defined WRITE_WATER && defined MASKING
645 vinfo(20)='mask_rho'
646# endif
647 vinfo(22)='coordinates'
648 aval(5)=real(iinfo(1,idtsur(itrc),ng),r8)
649 status=def_var(ng, model, tlm(ng)%ncid, &
650 & tlm(ng)%Vid(idtsur(itrc)), nf_fout, &
651 & nvd4, t3dfrc, aval, vinfo, ncname)
652 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
653 END IF
654 END DO
655# endif
656# ifdef SOLVE3D
657!
658! Define time-varying depth of RHO-points.
659!
660 IF (hout(idpthr,ng)) THEN
661 vinfo( 1)=vname(1,idpthr)
662 WRITE (vinfo( 2),40) trim(vname(2,idpthr))
663 vinfo( 3)=vname(3,idpthr)
664 vinfo(14)=vname(4,idpthr)
665 vinfo(16)=vname(1,idtime)
666# if defined WRITE_WATER && defined MASKING
667 vinfo(20)='mask_rho'
668# endif
669 vinfo(21)=vname(6,idpthr)
670 vinfo(22)='coordinates'
671 aval(5)=real(iinfo(1,idpthr,ng),r8)
672 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idpthr), &
673 & nf_fout, nvd4, t3dgrd, aval, vinfo, ncname, &
674 & setfillval = .false.)
675 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
676 END IF
677!
678! Define time-varying depth of W-points.
679!
680 IF (hout(idpthw,ng)) THEN
681 vinfo( 1)=vname(1,idpthw)
682 WRITE (vinfo( 2),40) trim(vname(2,idpthw))
683 vinfo( 3)=vname(3,idpthw)
684 vinfo(14)=vname(4,idpthw)
685 vinfo(16)=vname(1,idtime)
686# if defined WRITE_WATER && defined MASKING
687 vinfo(20)='mask_rho'
688# endif
689 vinfo(21)=vname(6,idpthw)
690 vinfo(22)='coordinates'
691 aval(5)=real(iinfo(1,idpthw,ng),r8)
692 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idpthw), &
693 & nf_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
694 & setfillval = .false.)
695 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
696 END IF
697# endif
698!
699! Define free-surface.
700!
701 IF (hout(idfsur,ng)) THEN
702 vinfo( 1)=vname(1,idfsur)
703 WRITE (vinfo( 2),40) trim(vname(2,idfsur))
704 vinfo( 3)=vname(3,idfsur)
705 vinfo(14)=vname(4,idfsur)
706 vinfo(16)=vname(1,idtime)
707# if !defined WET_DRY && (defined WRITE_WATER && defined MASKING)
708 vinfo(20)='mask_rho'
709# endif
710 vinfo(21)=vname(6,idfsur)
711 vinfo(22)='coordinates'
712 aval(5)=real(iinfo(1,idfsur,ng),r8)
713 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idfsur), &
714# ifdef WET_DRY
715 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname, &
716 & setfillval = .false.)
717# else
718 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
719# endif
720 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
721
722# if defined FORWARD_WRITE && defined FORWARD_RHS
723 vinfo( 1)=vname(1,idrzet)
724 WRITE (vinfo( 2),40) trim(vname(2,idrzet))
725 vinfo( 3)=vname(3,idrzet)
726 vinfo(14)=vname(4,idrzet)
727 vinfo(16)=vname(1,idtime)
728# if defined WRITE_WATER && defined MASKING
729 vinfo(20)='mask_rho'
730# endif
731 vinfo(21)=vname(6,idrzet)
732 vinfo(22)='coordinates'
733 aval(5)=real(r2dvar,r8)
734 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idrzet), &
735 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
736 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
737# endif
738 END IF
739# ifdef ADJUST_BOUNDARY
740!
741! Define free-surface open boundaries.
742!
743 IF (any(lobc(:,isfsur,ng))) THEN
744 ifield=idsbry(isfsur)
745 vinfo( 1)=vname(1,ifield)
746 WRITE (vinfo( 2),40) trim(vname(2,ifield))
747 vinfo( 3)=vname(3,ifield)
748 vinfo(14)=vname(4,ifield)
749 vinfo(16)=vname(1,idtime)
750 vinfo(21)=vname(6,ifield)
751 aval(5)=real(iinfo(1,ifield,ng),r8)
752 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(ifield), &
753 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
754 & setfillval = .false.)
755 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
756 END IF
757# endif
758!
759! Define 2D U-momentum component.
760!
761 IF (hout(idubar,ng)) THEN
762 vinfo( 1)=vname(1,idubar)
763 WRITE (vinfo( 2),40) trim(vname(2,idubar))
764 vinfo( 3)=vname(3,idubar)
765 vinfo(14)=vname(4,idubar)
766 vinfo(16)=vname(1,idtime)
767# if defined WRITE_WATER && defined MASKING
768 vinfo(20)='mask_u'
769# endif
770 vinfo(21)=vname(6,idubar)
771 vinfo(22)='coordinates'
772 aval(5)=real(iinfo(1,idubar,ng),r8)
773 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idubar), &
774 & nf_fout, nvd3, u2dgrd, aval, vinfo, ncname)
775 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
776
777# ifdef FORWARD_WRITE
778# ifdef FORWARD_RHS
779 vinfo( 1)=vname(1,idru2d)
780 WRITE (vinfo( 2),40) trim(vname(2,idru2d))
781 vinfo( 3)=vname(3,idru2d)
782 vinfo(14)=vname(4,idru2d)
783 vinfo(16)=vname(1,idtime)
784# if defined WRITE_WATER && defined MASKING
785 vinfo(20)='mask_u'
786# endif
787 vinfo(21)=vname(6,idru2d)
788 vinfo(22)='coordinates'
789 aval(5)=real(u2dvar,r8)
790
791 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idru2d), &
792 & nf_fout, nvd3, u2dgrd, aval, vinfo, ncname)
793 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
794# endif
795# ifdef SOLVE3D
796# ifdef FORWARD_RHS
797 vinfo( 1)=vname(1,idruct)
798 WRITE (vinfo( 2),40) trim(vname(2,idruct))
799 vinfo( 3)=vname(3,idruct)
800 vinfo(14)=vname(4,idruct)
801 vinfo(16)=vname(1,idtime)
802# if defined WRITE_WATER && defined MASKING
803 vinfo(20)='mask_u'
804# endif
805 vinfo(21)=vname(6,idruct)
806 vinfo(22)='coordinates'
807 aval(5)=real(u2dvar,r8)
808 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idruct), &
809 & nf_fout, nvd3, u2dgrd, aval, vinfo, ncname)
810 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
811# endif
812
813 vinfo( 1)=vname(1,idufx1)
814 WRITE (vinfo( 2),40) trim(vname(2,idufx1))
815 vinfo( 3)=vname(3,idufx1)
816 vinfo(14)=vname(4,idufx1)
817 vinfo(16)=vname(1,idtime)
818# if defined WRITE_WATER && defined MASKING
819 vinfo(20)='mask_u'
820# endif
821 vinfo(21)=vname(6,idufx1)
822 vinfo(22)='coordinates'
823 aval(5)=real(u2dvar,r8)
824 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idufx1), &
825 & nf_fout, nvd3, u2dgrd, aval, vinfo, ncname)
826 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
827
828 vinfo( 1)=vname(1,idufx2)
829 WRITE (vinfo( 2),40) trim(vname(2,idufx2))
830 vinfo( 3)=vname(3,idufx2)
831 vinfo(14)=vname(4,idufx2)
832 vinfo(16)=vname(1,idtime)
833# if defined WRITE_WATER && defined MASKING
834 vinfo(20)='mask_u'
835# endif
836 vinfo(21)=vname(6,idufx2)
837 vinfo(22)='coordinates'
838 aval(5)=real(u2dvar,r8)
839 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idufx2), &
840 & nf_fout, nvd3, u2dgrd, aval, vinfo, ncname)
841 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
842# endif
843# endif
844 END IF
845# ifdef ADJUST_BOUNDARY
846!
847! Define 2D U-momentum component open boundaries.
848!
849 IF (any(lobc(:,isubar,ng))) THEN
850 ifield=idsbry(isubar)
851 vinfo( 1)=vname(1,ifield)
852 WRITE (vinfo( 2),40) trim(vname(2,ifield))
853 vinfo( 3)=vname(3,ifield)
854 vinfo(14)=vname(4,ifield)
855 vinfo(16)=vname(1,idtime)
856 vinfo(21)=vname(6,ifield)
857 aval(5)=real(iinfo(1,ifield,ng),r8)
858 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(ifield), &
859 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
860 & setfillval = .false.)
861 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
862 END IF
863# endif
864!
865! Define 2D V-momentum component.
866!
867 IF (hout(idvbar,ng)) THEN
868 vinfo( 1)=vname(1,idvbar)
869 WRITE (vinfo( 2),40) trim(vname(2,idvbar))
870 vinfo( 3)=vname(3,idvbar)
871 vinfo(14)=vname(4,idvbar)
872 vinfo(16)=vname(1,idtime)
873# if defined WRITE_WATER && defined MASKING
874 vinfo(20)='mask_v'
875# endif
876 vinfo(21)=vname(6,idvbar)
877 vinfo(22)='coordinates'
878 aval(5)=real(iinfo(1,idvbar,ng),r8)
879 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idvbar), &
880 & nf_fout, nvd3, v2dgrd, aval, vinfo, ncname)
881 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
882
883# ifdef FORWARD_WRITE
884# ifdef FORWARD_RHS
885 vinfo( 1)=vname(1,idrv2d)
886 WRITE (vinfo( 2),40) trim(vname(2,idrv2d))
887 vinfo( 3)=vname(3,idrv2d)
888 vinfo(14)=vname(4,idrv2d)
889 vinfo(16)=vname(1,idtime)
890# if defined WRITE_WATER && defined MASKING
891 vinfo(20)='mask_v'
892# endif
893 vinfo(21)=vname(6,idrv2d)
894 vinfo(22)='coordinates'
895 aval(5)=real(v2dvar,r8)
896 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idrv2d), &
897 & nf_fout, nvd3, v2dgrd, aval, vinfo, ncname)
898 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
899# endif
900# ifdef SOLVE3D
901# ifdef FORWARD_RHS
902 vinfo( 1)=vname(1,idrvct)
903 WRITE (vinfo( 2),40) trim(vname(2,idrvct))
904 vinfo( 3)=vname(3,idrvct)
905 vinfo(14)=vname(4,idrvct)
906 vinfo(16)=vname(1,idtime)
907# if defined WRITE_WATER && defined MASKING
908 vinfo(20)='mask_v'
909# endif
910 vinfo(21)=vname(6,idrvct)
911 vinfo(22)='coordinates'
912 aval(5)=real(v2dvar,r8)
913 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idrvct), &
914 & nf_fout, nvd3, v2dgrd, aval, vinfo, ncname)
915 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
916# endif
917
918 vinfo( 1)=vname(1,idvfx1)
919 WRITE (vinfo( 2),40) trim(vname(2,idvfx1))
920 vinfo( 3)=vname(3,idvfx1)
921 vinfo(14)=vname(4,idvfx1)
922 vinfo(16)=vname(1,idtime)
923# if defined WRITE_WATER && defined MASKING
924 vinfo(20)='mask_v'
925# endif
926 vinfo(21)=vname(6,idvfx1)
927 vinfo(22)='coordinates'
928 aval(5)=real(v2dvar,r8)
929 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idvfx1), &
930 & nf_fout, nvd3, v2dgrd, aval, vinfo, ncname)
931 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
932
933 vinfo( 1)=vname(1,idvfx2)
934 WRITE (vinfo( 2),40) trim(vname(2,idvfx2))
935 vinfo( 3)=vname(3,idvfx2)
936 vinfo(14)=vname(4,idvfx2)
937 vinfo(16)=vname(1,idtime)
938# if defined WRITE_WATER && defined MASKING
939 vinfo(20)='mask_v'
940# endif
941 vinfo(21)=vname(6,idvfx2)
942 vinfo(22)='coordinates'
943 aval(5)=real(v2dvar,r8)
944 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idvfx2), &
945 & nf_fout, nvd3, v2dgrd, aval, vinfo, ncname)
946 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
947# endif
948# endif
949 END IF
950# ifdef ADJUST_BOUNDARY
951!
952! Define 2D V-momentum component open boundaries.
953!
954 IF (any(lobc(:,isvbar,ng))) THEN
955 ifield=idsbry(isvbar)
956 vinfo( 1)=vname(1,ifield)
957 WRITE (vinfo( 2),40) trim(vname(2,ifield))
958 vinfo( 3)=vname(3,ifield)
959 vinfo(14)=vname(4,ifield)
960 vinfo(16)=vname(1,idtime)
961 vinfo(21)=vname(6,ifield)
962 aval(5)=real(iinfo(1,ifield,ng),r8)
963 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(ifield), &
964 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
965 & setfillval = .false.)
966 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
967 END IF
968# endif
969# ifdef SOLVE3D
970!
971! Define 3D U-momentum component.
972!
973 IF (hout(iduvel,ng)) THEN
974 vinfo( 1)=vname(1,iduvel)
975 WRITE (vinfo( 2),40) trim(vname(2,iduvel))
976 vinfo( 3)=vname(3,iduvel)
977 vinfo(14)=vname(4,iduvel)
978 vinfo(16)=vname(1,idtime)
979# if defined WRITE_WATER && defined MASKING
980 vinfo(20)='mask_u'
981# endif
982 vinfo(21)=vname(6,iduvel)
983 vinfo(22)='coordinates'
984 aval(5)=real(iinfo(1,iduvel,ng),r8)
985 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(iduvel), &
986 & nf_fout, nvd4, u3dgrd, aval, vinfo, ncname)
987 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
988
989# if defined FORWARD_WRITE && defined FORWARD_RHS
990 vinfo( 1)=vname(1,idru3d)
991 WRITE (vinfo( 2),40) trim(vname(2,idru3d))
992 vinfo( 3)=vname(3,idru3d)
993 vinfo(14)=vname(4,idru3d)
994 vinfo(16)=vname(1,idtime)
995# if defined WRITE_WATER && defined MASKING
996 vinfo(20)='mask_u'
997# endif
998 vinfo(21)=vname(6,idru3d)
999 vinfo(22)='coordinates'
1000 aval(5)=real(u3dvar,r8)
1001 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idru3d), &
1002 & nf_fout, nvd4, u3dgrd, aval, vinfo, ncname)
1003 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1004# endif
1005 END IF
1006# ifdef ADJUST_BOUNDARY
1007!
1008! Define 3D U-momentum component open boundaries.
1009!
1010 IF (any(lobc(:,isuvel,ng))) THEN
1011 ifield=idsbry(isuvel)
1012 vinfo( 1)=vname(1,ifield)
1013 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1014 vinfo( 3)=vname(3,ifield)
1015 vinfo(14)=vname(4,ifield)
1016 vinfo(16)=vname(1,idtime)
1017 vinfo(21)=vname(6,ifield)
1018 aval(5)=real(iinfo(1,ifield,ng),r8)
1019 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(ifield), &
1020 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
1021 & setfillval = .false.)
1022 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1023 END IF
1024# endif
1025!
1026! Define 3D V-momentum component.
1027!
1028 IF (hout(idvvel,ng)) THEN
1029 vinfo( 1)=vname(1,idvvel)
1030 WRITE (vinfo( 2),40) trim(vname(2,idvvel))
1031 vinfo( 3)=vname(3,idvvel)
1032 vinfo(14)=vname(4,idvvel)
1033 vinfo(16)=vname(1,idtime)
1034# if defined WRITE_WATER && defined MASKING
1035 vinfo(20)='mask_v'
1036# endif
1037 vinfo(21)=vname(6,idvvel)
1038 vinfo(22)='coordinates'
1039 aval(5)=real(iinfo(1,idvvel,ng),r8)
1040 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idvvel), &
1041 & nf_fout, nvd4, v3dgrd, aval, vinfo, ncname)
1042 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1043
1044# if defined FORWARD_WRITE && defined FORWARD_RHS
1045 vinfo( 1)=vname(1,idrv3d)
1046 WRITE (vinfo( 2),40) trim(vname(2,idrv3d))
1047 vinfo( 3)=vname(3,idrv3d)
1048 vinfo(14)=vname(4,idrv3d)
1049 vinfo(16)=vname(1,idtime)
1050# if defined WRITE_WATER && defined MASKING
1051 vinfo(20)='mask_v'
1052# endif
1053 vinfo(21)=vname(6,idrv3d)
1054 vinfo(22)='coordinates'
1055 aval(5)=real(v3dvar,r8)
1056 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idrv3d), &
1057 & nf_fout, nvd4, v3dgrd, aval, vinfo, ncname)
1058 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1059# endif
1060 END IF
1061# ifdef ADJUST_BOUNDARY
1062!
1063! Define 3D V-momentum component open boundaries.
1064!
1065 IF (any(lobc(:,isvvel,ng))) THEN
1066 ifield=idsbry(isvvel)
1067 vinfo( 1)=vname(1,ifield)
1068 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1069 vinfo( 3)=vname(3,ifield)
1070 vinfo(14)=vname(4,ifield)
1071 vinfo(16)=vname(1,idtime)
1072 vinfo(21)=vname(6,ifield)
1073 aval(5)=real(iinfo(1,ifield,ng),r8)
1074 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(ifield), &
1075 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
1076 & setfillval = .false.)
1077 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1078 END IF
1079# endif
1080# ifdef UV_DESTAGGERED
1081!
1082! Define 3D Eastward momentum at RHO-points, A-grid.
1083!
1084 IF (hout(idu3de,ng)) THEN
1085 vinfo( 1)=vname(1,idu3de)
1086 vinfo( 2)=vname(2,idu3de)
1087 vinfo( 3)=vname(3,idu3de)
1088 vinfo(14)=vname(4,idu3de)
1089 vinfo(16)=vname(1,idtime)
1090# if defined WRITE_WATER && defined MASKING
1091 vinfo(20)='mask_rho'
1092# endif
1093 vinfo(21)=vname(6,idu3de)
1094 vinfo(22)='coordinates'
1095 aval(5)=real(iinfo(1,idu3de,ng),r8)
1096 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idu3de), &
1097 & nf_fout, nvd4, t3dgrd, aval, vinfo, ncname)
1098 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1099 END IF
1100!
1101! Define 3D Northward momentum at RHO-points, A-grid.
1102!
1103 IF (hout(idv3dn,ng)) THEN
1104 vinfo( 1)=vname(1,idv3dn)
1105 vinfo( 2)=vname(2,idv3dn)
1106 vinfo( 3)=vname(3,idv3dn)
1107 vinfo(14)=vname(4,idv3dn)
1108 vinfo(16)=vname(1,idtime)
1109# if defined WRITE_WATER && defined MASKING
1110 vinfo(20)='mask_rho'
1111# endif
1112 vinfo(21)=vname(6,idv3dn)
1113 vinfo(22)='coordinates'
1114 aval(5)=real(iinfo(1,idv3dn,ng),r8)
1115 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idv3dn), &
1116 & nf_fout, nvd4, t3dgrd, aval, vinfo, ncname)
1117 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1118 END IF
1119# endif
1120!
1121! Define tracer type variables.
1122!
1123 DO itrc=1,nt(ng)
1124 IF (hout(idtvar(itrc),ng)) THEN
1125 vinfo( 1)=vname(1,idtvar(itrc))
1126 WRITE (vinfo( 2),40) trim(vname(2,idtvar(itrc)))
1127 vinfo( 3)=vname(3,idtvar(itrc))
1128 vinfo(14)=vname(4,idtvar(itrc))
1129 vinfo(16)=vname(1,idtime)
1130# ifdef SEDIMENT_NOT_YET
1131 DO i=1,nst
1132 IF (itrc.eq.idsed(i)) THEN
1133 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
1134 END IF
1135 END DO
1136# endif
1137# if defined WRITE_WATER && defined MASKING
1138 vinfo(20)='mask_rho'
1139# endif
1140 vinfo(21)=vname(6,idtvar(itrc))
1141 vinfo(22)='coordinates'
1142 aval(5)=real(r3dvar,r8)
1143 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Tid(itrc), &
1144 & nf_fout, nvd4, t3dgrd, aval, vinfo, ncname)
1145 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1146 END IF
1147 END DO
1148# ifdef ADJUST_BOUNDARY
1149!
1150! Define tracer type variables open boundaries.
1151!
1152 DO itrc=1,nt(ng)
1153 IF (any(lobc(:,istvar(itrc),ng))) THEN
1154 ifield=idsbry(istvar(itrc))
1155 vinfo( 1)=vname(1,ifield)
1156 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1157 vinfo( 3)=vname(3,ifield)
1158 vinfo(14)=vname(4,ifield)
1159 vinfo(16)=vname(1,idtime)
1160# ifdef SEDIMENT
1161 DO i=1,nst
1162 IF (itrc.eq.idsed(i)) THEN
1163 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
1164 END IF
1165 END DO
1166# endif
1167 vinfo(21)=vname(6,ifield)
1168 aval(5)=real(iinfo(1,ifield,ng),r8)
1169 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(ifield),&
1170 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
1171 & setfillval = .false.)
1172 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1173 END IF
1174 END DO
1175# endif
1176!
1177! Define density anomaly.
1178!
1179 IF (hout(iddano,ng)) THEN
1180 vinfo( 1)=vname(1,iddano)
1181 WRITE (vinfo( 2),40) trim(vname(2,iddano))
1182 vinfo( 3)=vname(3,iddano)
1183 vinfo(14)=vname(4,iddano)
1184 vinfo(16)=vname(1,idtime)
1185# if defined WRITE_WATER && defined MASKING
1186 vinfo(20)='mask_rho'
1187# endif
1188 vinfo(21)=vname(6,iddano)
1189 vinfo(22)='coordinates'
1190 aval(5)=real(iinfo(1,iddano,ng),r8)
1191 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(iddano), &
1192 & nf_fout, nvd4, t3dgrd, aval, vinfo, ncname)
1193 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1194 END IF
1195
1196# if defined FORWARD_MIXING && \
1197 (defined bvf_mixing || defined gls_mixing || \
1198 defined lmd_mixing || defined my25_mixing)
1199!
1200! Define vertical viscosity coefficient.
1201!
1202 IF (hout(idvvis,ng)) THEN
1203 vinfo( 1)=vname(1,idvvis)
1204 WRITE (vinfo( 2),40) trim(vname(2,idvvis))
1205 vinfo( 3)=vname(3,idvvis)
1206 vinfo(14)=vname(4,idvvis)
1207 vinfo(16)=vname(1,idtime)
1208 vinfo(21)=vname(6,idvvis)
1209 vinfo(22)='coordinates'
1210 aval(5)=real(iinfo(1,idvvis,ng),r8)
1211 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idvvis), &
1212 & nf_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
1213 & setfillval = .false.)
1214 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1215 END IF
1216!
1217! Define vertical diffusion coefficient for potential temperature.
1218!
1219 IF (hout(idtdif,ng)) THEN
1220 vinfo( 1)=vname(1,idtdif)
1221 WRITE (vinfo( 2),40) trim(vname(2,idtdif))
1222 vinfo( 3)=vname(3,idtdif)
1223 vinfo(14)=vname(4,idtdif)
1224 vinfo(16)=vname(1,idtime)
1225 vinfo(21)=vname(6,idtdif)
1226 vinfo(22)='coordinates'
1227 aval(5)=real(iinfo(1,idtdif,ng),r8)
1228 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idtdif), &
1229 & nf_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
1230 & setfillval = .false.)
1231 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1232 END IF
1233# ifdef SALINITY
1234!
1235! Define vertical diffusion coefficient for salinity.
1236!
1237 IF (hout(idsdif,ng)) THEN
1238 vinfo( 1)=vname(1,idsdif)
1239 WRITE (vinfo( 2),40) trim(vname(2,idsdif))
1240 vinfo( 3)=vname(3,idsdif)
1241 vinfo(14)=vname(4,idsdif)
1242 vinfo(16)=vname(1,idtime)
1243 vinfo(21)=vname(6,idsdif)
1244 vinfo(22)='coordinates'
1245 aval(5)=real(iinfo(1,idsdif,ng),r8)
1246 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idsdif), &
1247 & nf_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
1248 & setfillval = .false.)
1249 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1250 END IF
1251# endif
1252# if defined GLS_MIXING_NOT_YET || defined MY25_MIXING_NOT_YET
1253!
1254! Define turbulent kinetic energy.
1255!
1256 IF (hout(idmtke,ng)) THEN
1257 vinfo( 1)=vname(1,idmtke)
1258 WRITE (vinfo( 2),40) trim(vname(2,idmtke))
1259 vinfo( 3)=vname(3,idmtke)
1260 vinfo(14)=vname(4,idmtke)
1261 vinfo(16)=vname(1,idtime)
1262 vinfo(21)=vname(6,idmtke)
1263 vinfo(22)='coordinates'
1264 aval(5)=real(iinfo(1,idmtke,ng),r8)
1265 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idmtke), &
1266 & nf_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
1267 & setfillval = .false.)
1268 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1269
1270 vinfo( 1)=vname(1,idvmkk)
1271 WRITE (vinfo( 2),40) trim(vname(2,idvmkk))
1272 vinfo( 3)=vname(3,idvmkk)
1273 vinfo(14)=vname(4,idvmkk)
1274 vinfo(16)=vname(1,idtime)
1275# if defined WRITE_WATER && defined MASKING
1276 vinfo(20)='mask_rho'
1277# endif
1278 vinfo(21)=vname(6,idvmkk)
1279 vinfo(22)='coordinates'
1280 aval(5)=real(iinfo(1,idvmkk,ng),r8)
1281 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idvmkk), &
1282 & nf_fout, nvd4, w3dgrd, aval, vinfo, ncname)
1283 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1284 END IF
1285!
1286! Define turbulent kinetic energy time length scale.
1287!
1288 IF (hout(idmtls,ng)) THEN
1289 vinfo( 1)=vname(1,idmtls)
1290 WRITE (vinfo( 2),40) trim(vname(2,idmtls))
1291 vinfo( 3)=vname(3,idmtls)
1292 vinfo(14)=vname(4,idmtls)
1293 vinfo(16)=vname(1,idtime)
1294 vinfo(21)=vname(6,idmtls)
1295 vinfo(22)='coordinates'
1296 aval(5)=real(iinfo(1,idmtls,ng),r8)
1297 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idmtls), &
1298 & nf_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
1299 & setfillval = .false.)
1300 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1301
1302 vinfo( 1)=vname(1,idvmls)
1303 WRITE (vinfo( 2),40) trim(vname(2,idvmls))
1304 vinfo( 3)=vname(3,idvmls)
1305 vinfo(14)=vname(4,idvmls)
1306 vinfo(16)=vname(1,idtime)
1307# if defined WRITE_WATER && defined MASKING
1308 vinfo(20)='mask_rho'
1309# endif
1310 vinfo(21)=vname(6,idvmls)
1311 vinfo(22)='coordinates'
1312 aval(5)=real(iinfo(1,idvmls,ng),r8)
1313 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idvmls), &
1314 & nf_fout, nvd4, w3dgrd, aval, vinfo, ncname)
1315 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1316
1317# ifdef GLS_MIXING_NOT_YET
1318 vinfo( 1)=vname(1,idvmkp)
1319 WRITE (vinfo( 2),40) trim(vname(2,idvmkp))
1320 vinfo( 3)=vname(3,idvmkp)
1321 vinfo(14)=vname(4,idvmkp)
1322 vinfo(16)=vname(1,idtime)
1323# if defined WRITE_WATER && defined MASKING
1324 vinfo(20)='mask_rho'
1325# endif
1326 vinfo(21)=vname(6,idvmkp)
1327 vinfo(22)='coordinates'
1328 aval(5)=real(iinfo(1,idvmkp,ng),r8)
1329 status=def_var(ng, model, tlm(ng)%ncid, tlm(ng)%Vid(idvmkp), &
1330 & nf_fout, nvd4, w3dgrd, aval, vinfo, ncname)
1331 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1332# endif
1333 END IF
1334# endif
1335# endif
1336# endif
1337!
1338!-----------------------------------------------------------------------
1339! Leave definition mode.
1340!-----------------------------------------------------------------------
1341!
1342 CALL netcdf_enddef (ng, model, ncname, tlm(ng)%ncid)
1343 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1344!
1345!-----------------------------------------------------------------------
1346! Write out time-recordless, information variables.
1347!-----------------------------------------------------------------------
1348!
1349 CALL wrt_info (ng, model, tlm(ng)%ncid, ncname)
1350 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1351 END IF define
1352!
1353!=======================================================================
1354! Open an existing tangent file, check its contents, and prepare for
1355! appending data.
1356!=======================================================================
1357!
1358 query : IF (.not.ldef) THEN
1359 ncname=tlm(ng)%name
1360!
1361! Open tangent linear history file for read/write.
1362!
1363 CALL netcdf_open (ng, model, ncname, 1, tlm(ng)%ncid)
1364 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1365 WRITE (stdout,60) trim(ncname)
1366 RETURN
1367 END IF
1368!
1369! Inquire about the dimensions and check for consistency.
1370!
1371 CALL netcdf_check_dim (ng, model, ncname, &
1372 & ncid = tlm(ng)%ncid)
1373 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1374!
1375! Inquire about the variables.
1376!
1377 CALL netcdf_inq_var (ng, model, ncname, &
1378 & ncid = tlm(ng)%ncid)
1379 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1380!
1381! Initialize logical switches.
1382!
1383 DO i=1,nv
1384 got_var(i)=.false.
1385 END DO
1386!
1387! Scan variable list from input NetCDF and activate switches for
1388! tangent variables. Get variable IDs.
1389!
1390 DO i=1,n_var
1391 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
1392 got_var(idtime)=.true.
1393 tlm(ng)%Vid(idtime)=var_id(i)
1394# ifdef SOLVE3D
1395 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idpthr))) THEN
1396 got_var(idpthr)=.true.
1397 tlm(ng)%Vid(idpthr)=var_id(i)
1398 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idpthw))) THEN
1399 got_var(idpthw)=.true.
1400 tlm(ng)%Vid(idpthw)=var_id(i)
1401# endif
1402 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
1403 got_var(idfsur)=.true.
1404 tlm(ng)%Vid(idfsur)=var_id(i)
1405 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
1406 got_var(idubar)=.true.
1407 tlm(ng)%Vid(idubar)=var_id(i)
1408 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
1409 got_var(idvbar)=.true.
1410 tlm(ng)%Vid(idvbar)=var_id(i)
1411# ifdef ADJUST_BOUNDARY
1412 ELSE IF (trim(var_name(i)).eq. &
1413 & trim(vname(1,idsbry(isfsur)))) THEN
1414 got_var(idsbry(isfsur))=.true.
1415 tlm(ng)%Vid(idsbry(isfsur))=var_id(i)
1416 ELSE IF (trim(var_name(i)).eq. &
1417 & trim(vname(1,idsbry(isubar)))) THEN
1418 got_var(idsbry(isubar))=.true.
1419 tlm(ng)%Vid(idsbry(isubar))=var_id(i)
1420 ELSE IF (trim(var_name(i)).eq. &
1421 & trim(vname(1,idsbry(isvbar)))) THEN
1422 got_var(idsbry(isvbar))=.true.
1423 tlm(ng)%Vid(idsbry(isvbar))=var_id(i)
1424# endif
1425# ifdef FORWARD_WRITE
1426# ifdef FORWARD_RHS
1427 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idrzet))) THEN
1428 got_var(idrzet)=.true.
1429 tlm(ng)%Vid(idrzet)=var_id(i)
1430 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idru2d))) THEN
1431 got_var(idru2d)=.true.
1432 tlm(ng)%Vid(idru2d)=var_id(i)
1433 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idrv2d))) THEN
1434 got_var(idrv2d)=.true.
1435 tlm(ng)%Vid(idrv2d)=var_id(i)
1436# endif
1437# ifdef SOLVE3D
1438# ifdef FORWARD_RHS
1439 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idruct))) THEN
1440 got_var(idruct)=.true.
1441 tlm(ng)%Vid(idruct)=var_id(i)
1442 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idrvct))) THEN
1443 got_var(idrvct)=.true.
1444 tlm(ng)%Vid(idrvct)=var_id(i)
1445# endif
1446 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idufx1))) THEN
1447 got_var(idufx1)=.true.
1448 tlm(ng)%Vid(idufx1)=var_id(i)
1449 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idufx2))) THEN
1450 got_var(idufx2)=.true.
1451 tlm(ng)%Vid(idufx2)=var_id(i)
1452 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvfx1))) THEN
1453 got_var(idvfx1)=.true.
1454 tlm(ng)%Vid(idvfx1)=var_id(i)
1455 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvfx2))) THEN
1456 got_var(idvfx2)=.true.
1457 tlm(ng)%Vid(idvfx2)=var_id(i)
1458# ifdef FORWARD_RHS
1459 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idru3d))) THEN
1460 got_var(idru3d)=.true.
1461 tlm(ng)%Vid(idru3d)=var_id(i)
1462 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idrv3d))) THEN
1463 got_var(idrv3d)=.true.
1464 tlm(ng)%Vid(idrv3d)=var_id(i)
1465# endif
1466# endif
1467# endif
1468# ifdef SOLVE3D
1469 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
1470 got_var(iduvel)=.true.
1471 tlm(ng)%Vid(iduvel)=var_id(i)
1472 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
1473 got_var(idvvel)=.true.
1474 tlm(ng)%Vid(idvvel)=var_id(i)
1475# ifdef ADJUST_BOUNDARY
1476 ELSE IF (trim(var_name(i)).eq. &
1477 & trim(vname(1,idsbry(isuvel)))) THEN
1478 got_var(idsbry(isuvel))=.true.
1479 tlm(ng)%Vid(idsbry(isuvel))=var_id(i)
1480 ELSE IF (trim(var_name(i)).eq. &
1481 & trim(vname(1,idsbry(isvvel)))) THEN
1482 got_var(idsbry(isvvel))=.true.
1483 tlm(ng)%Vid(idsbry(isvvel))=var_id(i)
1484# endif
1485# ifdef UV_DESTAGGERED
1486 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idu3de))) THEN
1487 got_var(idu3de)=.true.
1488 tlm(ng)%Vid(idu3de)=var_id(i)
1489 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idv3dn))) THEN
1490 got_var(idv3dn)=.true.
1491 tlm(ng)%Vid(idv3dn)=var_id(i)
1492# endif
1493 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iddano))) THEN
1494 got_var(iddano)=.true.
1495 tlm(ng)%Vid(iddano)=var_id(i)
1496# if defined FORWARD_MIXING && \
1497 (defined bvf_mixing || defined gls_mixing || \
1498 defined lmd_mixing || defined my25_mixing)
1499 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvis))) THEN
1500 got_var(idvvis)=.true.
1501 tlm(ng)%Vid(idvvis)=var_id(i)
1502 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idtdif))) THEN
1503 got_var(idtdif)=.true.
1504 tlm(ng)%Vid(idtdif)=var_id(i)
1505# ifdef SALINITY
1506 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idsdif))) THEN
1507 got_var(idsdif)=.true.
1508 tlm(ng)%Vid(idsdif)=var_id(i)
1509# endif
1510# if defined GLS_MIXING_NOT_YET || defined MY25_MIXING_NOT_YET
1511 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idmtke))) THEN
1512 got_var(idmtke)=.true.
1513 tlm(ng)%Vid(idmtke)=var_id(i)
1514 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvmkk))) THEN
1515 got_var(idvmkk)=.true.
1516 tlm(ng)%Vid(idvmkk)=var_id(i)
1517 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idmtls))) THEN
1518 got_var(idmtls)=.true.
1519 tlm(ng)%Vid(idmtls)=var_id(i)
1520 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvmls))) THEN
1521 got_var(idvmls)=.true.
1522 tlm(ng)%Vid(idvmls)=var_id(i)
1523# ifdef GLS_MIXING_NOT_YET
1524 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvmkp))) THEN
1525 got_var(idvmkp)=.true.
1526 tlm(ng)%Vid(idvmkp)=var_id(i)
1527# endif
1528# endif
1529# endif
1530# endif
1531# ifdef ADJUST_WSTRESS
1532 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
1533 got_var(idusms)=.true.
1534 tlm(ng)%Vid(idusms)=var_id(i)
1535 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
1536 got_var(idvsms)=.true.
1537 tlm(ng)%Vid(idvsms)=var_id(i)
1538# endif
1539 END IF
1540# ifdef SOLVE3D
1541 DO itrc=1,nt(ng)
1542 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
1543 got_var(idtvar(itrc))=.true.
1544 tlm(ng)%Tid(itrc)=var_id(i)
1545# ifdef ADJUST_BOUNDARY
1546 ELSE IF (trim(var_name(i)).eq. &
1547 & trim(vname(1,idsbry(istvar(itrc))))) THEN
1548 got_var(idsbry(istvar(itrc)))=.true.
1549 tlm(ng)%Vid(idsbry(istvar(itrc)))=var_id(i)
1550# endif
1551# ifdef ADJUST_STFLUX
1552 ELSE IF (trim(var_name(i)).eq. &
1553 & trim(vname(1,idtsur(itrc)))) THEN
1554 got_var(idtsur(itrc))=.true.
1555 tlm(ng)%Vid(idtsur(itrc))=var_id(i)
1556# endif
1557 END IF
1558 END DO
1559# endif
1560 END DO
1561!
1562! Check if tangent variables are available in input NetCDF file.
1563!
1564 IF (.not.got_var(idtime)) THEN
1565 IF (master) WRITE (stdout,70) trim(vname(1,idtime)), &
1566 & trim(ncname)
1567 exit_flag=3
1568 RETURN
1569 END IF
1570# ifdef SOLVE3D
1571 IF (.not.got_var(idpthr).and.hout(idpthr,ng)) THEN
1572 IF (master) WRITE (stdout,70) trim(vname(1,idpthr)), &
1573 & trim(ncname)
1574 exit_flag=3
1575 RETURN
1576 END IF
1577 IF (.not.got_var(idpthw).and.hout(idpthw,ng)) THEN
1578 IF (master) WRITE (stdout,70) trim(vname(1,idpthw)), &
1579 & trim(ncname)
1580 exit_flag=3
1581 RETURN
1582 END IF
1583# endif
1584 IF (.not.got_var(idfsur).and.hout(idfsur,ng)) THEN
1585 IF (master) WRITE (stdout,70) trim(vname(1,idfsur)), &
1586 & trim(ncname)
1587 exit_flag=3
1588 RETURN
1589 END IF
1590 IF (.not.got_var(idubar).and.hout(idubar,ng)) THEN
1591 IF (master) WRITE (stdout,70) trim(vname(1,idubar)), &
1592 & trim(ncname)
1593 exit_flag=3
1594 RETURN
1595 END IF
1596 IF (.not.got_var(idvbar).and.hout(idvbar,ng)) THEN
1597 IF (master) WRITE (stdout,70) trim(vname(1,idvbar)), &
1598 & trim(ncname)
1599 exit_flag=3
1600 RETURN
1601 END IF
1602# ifdef ADJUST_BOUNDARY
1603 IF (.not.got_var(idsbry(isfsur))) THEN
1604 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isfsur))), &
1605 & trim(ncname)
1606 exit_flag=3
1607 RETURN
1608 END IF
1609 IF (.not.got_var(idsbry(isubar))) THEN
1610 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isubar))), &
1611 & trim(ncname)
1612 exit_flag=3
1613 RETURN
1614 END IF
1615 IF (.not.got_var(idsbry(isvbar))) THEN
1616 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvbar))), &
1617 & trim(ncname)
1618 exit_flag=3
1619 RETURN
1620 END IF
1621# endif
1622# ifdef FORWARD_WRITE
1623# ifdef FORWARD_RHS
1624 IF (.not.got_var(idrzet)) THEN
1625 IF (master) WRITE (stdout,70) trim(vname(1,idrzet)), &
1626 & trim(ncname)
1627 exit_flag=3
1628 RETURN
1629 END IF
1630 IF (.not.got_var(idru2d)) THEN
1631 IF (master) WRITE (stdout,70) trim(vname(1,idru2d)), &
1632 & trim(ncname)
1633 exit_flag=3
1634 RETURN
1635 END IF
1636 IF (.not.got_var(idrv2d)) THEN
1637 IF (master) WRITE (stdout,70) trim(vname(1,idrv2d)), &
1638 & trim(ncname)
1639 exit_flag=3
1640 RETURN
1641 END IF
1642# endif
1643# ifdef SOLVE3D
1644# ifdef FORWARD_RHS
1645 IF (.not.got_var(idruct)) THEN
1646 IF (master) WRITE (stdout,70) trim(vname(1,idruct)), &
1647 & trim(ncname)
1648 exit_flag=3
1649 RETURN
1650 END IF
1651 IF (.not.got_var(idrvct)) THEN
1652 IF (master) WRITE (stdout,70) trim(vname(1,idrvct)), &
1653 & trim(ncname)
1654 exit_flag=3
1655 RETURN
1656 END IF
1657# endif
1658 IF (.not.got_var(idufx1)) THEN
1659 IF (master) WRITE (stdout,70) trim(vname(1,idufx1)), &
1660 & trim(ncname)
1661 exit_flag=3
1662 RETURN
1663 END IF
1664 IF (.not.got_var(idufx2)) THEN
1665 IF (master) WRITE (stdout,70) trim(vname(1,idufx2)), &
1666 & trim(ncname)
1667 exit_flag=3
1668 RETURN
1669 END IF
1670 IF (.not.got_var(idvfx1)) THEN
1671 IF (master) WRITE (stdout,70) trim(vname(1,idvfx1)), &
1672 & trim(ncname)
1673 exit_flag=3
1674 RETURN
1675 END IF
1676 IF (.not.got_var(idvfx2)) THEN
1677 IF (master) WRITE (stdout,70) trim(vname(1,idvfx2)), &
1678 & trim(ncname)
1679 exit_flag=3
1680 RETURN
1681 END IF
1682# ifdef FORWARD_RHS
1683 IF (.not.got_var(idru3d)) THEN
1684 IF (master) WRITE (stdout,70) trim(vname(1,idru3d)), &
1685 & trim(ncname)
1686 exit_flag=3
1687 RETURN
1688 END IF
1689 IF (.not.got_var(idrv3d)) THEN
1690 IF (master) WRITE (stdout,70) trim(vname(1,idrv3d)), &
1691 & trim(ncname)
1692 exit_flag=3
1693 RETURN
1694 END IF
1695# endif
1696# endif
1697# endif
1698# ifdef SOLVE3D
1699 IF (.not.got_var(iduvel).and.hout(iduvel,ng)) THEN
1700 IF (master) WRITE (stdout,70) trim(vname(1,iduvel)), &
1701 & trim(ncname)
1702 exit_flag=3
1703 RETURN
1704 END IF
1705 IF (.not.got_var(idvvel).and.hout(idvvel,ng)) THEN
1706 IF (master) WRITE (stdout,70) trim(vname(1,idvvel)), &
1707 & trim(ncname)
1708 exit_flag=3
1709 RETURN
1710 END IF
1711# ifdef ADJUST_BOUNDARY
1712 IF (.not.got_var(idsbry(isuvel))) THEN
1713 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isuvel))), &
1714 & trim(ncname)
1715 exit_flag=3
1716 RETURN
1717 END IF
1718 IF (.not.got_var(idsbry(isvvel))) THEN
1719 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvvel))), &
1720 & trim(ncname)
1721 exit_flag=3
1722 RETURN
1723 END IF
1724# endif
1725# ifdef UV_DESTAGGERED
1726 IF (.not.got_var(idu3de).and.hout(idu3de,ng)) THEN
1727 IF (master) WRITE (stdout,70) trim(vname(1,idu3de)), &
1728 & trim(ncname)
1729 exit_flag=3
1730 RETURN
1731 END IF
1732 IF (.not.got_var(idv3dn).and.hout(idv3dn,ng)) THEN
1733 IF (master) WRITE (stdout,70) trim(vname(1,idv3dn)), &
1734 & trim(ncname)
1735 exit_flag=3
1736 RETURN
1737 END IF
1738# endif
1739 IF (.not.got_var(iddano).and.hout(iddano,ng)) THEN
1740 IF (master) WRITE (stdout,70) trim(vname(1,iddano)), &
1741 & trim(ncname)
1742 exit_flag=3
1743 RETURN
1744 END IF
1745# if defined FORWARD_MIXING && \
1746 (defined bvf_mixing || defined gls_mixing || \
1747 defined lmd_mixing || defined my25_mixing)
1748 IF (.not.got_var(idvvis).and.hout(idvvis,ng)) THEN
1749 IF (master) WRITE (stdout,70) trim(vname(1,idvvis)), &
1750 & trim(ncname)
1751 exit_flag=3
1752 RETURN
1753 END IF
1754 IF (.not.got_var(idtdif).and.hout(idtdif,ng)) THEN
1755 IF (master) WRITE (stdout,70) trim(vname(1,idtdif)), &
1756 & trim(ncname)
1757 exit_flag=3
1758 RETURN
1759 END IF
1760# ifdef SALINITY
1761 IF (.not.got_var(idsdif).and.hout(idsdif,ng)) THEN
1762 IF (master) WRITE (stdout,70) trim(vname(1,idsdif)), &
1763 & trim(ncname)
1764 exit_flag=3
1765 RETURN
1766 END IF
1767# endif
1768# if defined GLS_MIXING_NOT_YET || defined MY25_MIXING_NOT_YET
1769 IF (.not.got_var(idmtke).and.hout(idmtke,ng)) THEN
1770 IF (master) WRITE (stdout,70) trim(vname(1,idmtke)), &
1771 & trim(ncname)
1772 exit_flag=3
1773 RETURN
1774 END IF
1775 IF (.not.got_var(idvmkk).and.hout(idvmkk,ng)) THEN
1776 IF (master) WRITE (stdout,70) trim(vname(1,idvmkk)), &
1777 & trim(ncname)
1778 exit_flag=3
1779 RETURN
1780 END IF
1781 IF (.not.got_var(idmtls).and.hout(idmtls,ng)) THEN
1782 IF (master) WRITE (stdout,70) trim(vname(1,idmtls)), &
1783 & trim(ncname)
1784 exit_flag=3
1785 RETURN
1786 END IF
1787 IF (.not.got_var(idvmls).and.hout(idvmls,ng)) THEN
1788 IF (master) WRITE (stdout,70) trim(vname(1,idvmls)), &
1789 & trim(ncname)
1790 exit_flag=3
1791 RETURN
1792 END IF
1793# ifdef GSL_MIXING
1794 IF (.not.got_var(idvmkp).and.hout(idvmkp,ng)) THEN
1795 IF (master) WRITE (stdout,70) trim(vname(1,idvmkp)), &
1796 & trim(ncname)
1797 exit_flag=3
1798 RETURN
1799 END IF
1800# endif
1801# endif
1802# endif
1803# endif
1804# ifdef ADJUST_WSTRESS
1805 IF (.not.got_var(idusms).and.hout(idusms,ng)) THEN
1806 IF (master) WRITE (stdout,70) trim(vname(1,idusms)), &
1807 & trim(ncname)
1808 exit_flag=3
1809 RETURN
1810 END IF
1811 IF (.not.got_var(idvsms).and.hout(idvsms,ng)) THEN
1812 IF (master) WRITE (stdout,70) trim(vname(1,idvsms)), &
1813 & trim(ncname)
1814 exit_flag=3
1815 RETURN
1816 END IF
1817# endif
1818# ifdef SOLVE3D
1819 DO itrc=1,nt(ng)
1820 IF (.not.got_var(idtvar(itrc)).and.hout(idtvar(itrc),ng)) THEN
1821 IF (master) WRITE (stdout,70) trim(vname(1,idtvar(itrc))), &
1822 & trim(ncname)
1823 exit_flag=3
1824 RETURN
1825 END IF
1826# ifdef ADJUST_BOUNDARY
1827 IF (.not.got_var(idsbry(istvar(itrc)))) THEN
1828 IF (master) WRITE (stdout,70) &
1829 & trim(vname(1,idsbry(istvar(itrc)))), &
1830 & trim(ncname)
1831 exit_flag=3
1832 RETURN
1833 END IF
1834# endif
1835# ifdef ADJUST_STFLUX
1836 IF (.not.got_var(idtsur(itrc)).and.hout(idtsur(itrc),ng).and. &
1837 & lstflux(itrc,ng)) THEN
1838 IF (master) WRITE (stdout,70) trim(vname(1,idtsur(itrc))), &
1839 & trim(ncname)
1840 exit_flag=3
1841 RETURN
1842 END IF
1843# endif
1844 END DO
1845# endif
1846!
1847! Set unlimited time record dimension to the appropriate value.
1848!
1849 IF (ndeftlm(ng).gt.0) THEN
1850 tlm(ng)%Rindex=((ntstart(ng)-1)- &
1851 & ndeftlm(ng)*((ntstart(ng)-1)/ndeftlm(ng)))/ &
1852 & ntlm(ng)
1853 ELSE
1854 tlm(ng)%Rindex=(ntstart(ng)-1)/ntlm(ng)
1855 END IF
1856 tlm(ng)%Rindex=min(tlm(ng)%Rindex,rec_size)
1857 END IF query
1858!
1859 10 FORMAT (2x,'TL_DEF_HIS_NF90 - creating tangent file,',t56, &
1860 & 'Grid ',i2.2,': ',a)
1861 20 FORMAT (2x,'TL_DEF_HIS_NF90 - inquiring tangent file,',t56, &
1862 & 'Grid ',i2.2,': ',a)
1863 30 FORMAT (/,' TL_DEF_HIS_NF90 - unable to create tangent NetCDF', &
1864 & ' file: ',a)
1865 40 FORMAT ('tangent linear',1x,a)
1866 50 FORMAT (1pe11.4,1x,'millimeter')
1867 60 FORMAT (/,' TL_DEF_HIS_NF90 - unable to open tangent NetCDF', &
1868 & ' file: ',a)
1869 70 FORMAT (/,' TL_DEF_HIS_NF90 - unable to find variable: ',a,2x, &
1870 & ' in tangent NetCDF file: ',a)
1871!
1872 RETURN
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::netcdf_check_dim
subroutine, public netcdf_check_dim(ng, model, ncname, ncid)
Definition mod_netcdf.F:538
mod_netcdf::netcdf_open
subroutine, public netcdf_open(ng, model, ncname, omode, ncid)
Definition mod_netcdf.F:9293
mod_netcdf::nf_fout
integer, parameter nf_fout
Definition mod_netcdf.F:188
mod_netcdf::netcdf_enddef
subroutine, public netcdf_enddef(ng, model, ncname, ncid)
Definition mod_netcdf.F:9220
mod_netcdf::var_name
character(len=100), dimension(mvars) var_name
Definition mod_netcdf.F:169
mod_netcdf::var_id
integer, dimension(mvars) var_id
Definition mod_netcdf.F:160
mod_netcdf::n_var
integer n_var
Definition mod_netcdf.F:152
mod_netcdf::nf_type
integer, parameter nf_type
Definition mod_netcdf.F:198
mod_netcdf::rec_size
integer rec_size
Definition mod_netcdf.F:156
mod_netcdf::netcdf_create
subroutine, public netcdf_create(ng, model, ncname, ncid)
Definition mod_netcdf.F:9089
mod_netcdf::netcdf_inq_var
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)
Definition mod_netcdf.F:1371

References mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::hout, mod_ncparam::iddano, mod_ncparam::idfsur, mod_ncparam::idmtke, mod_ncparam::idmtls, mod_ncparam::idpthr, mod_ncparam::idpthw, mod_ncparam::idru2d, mod_ncparam::idru3d, mod_ncparam::idruct, mod_ncparam::idrv2d, mod_ncparam::idrv3d, mod_ncparam::idrvct, mod_ncparam::idrzet, mod_ncparam::idsbry, mod_ncparam::idsdif, mod_sediment::idsed, mod_ncparam::idtdif, mod_ncparam::idtime, mod_ncparam::idtsur, mod_ncparam::idtvar, mod_ncparam::idu3de, mod_ncparam::idubar, mod_ncparam::idufx1, mod_ncparam::idufx2, mod_ncparam::idusms, mod_ncparam::iduvel, mod_ncparam::idv3dn, mod_ncparam::idvbar, mod_ncparam::idvfx1, mod_ncparam::idvfx2, mod_ncparam::idvmkk, mod_ncparam::idvmkp, mod_ncparam::idvmls, mod_ncparam::idvsms, mod_ncparam::idvvel, mod_ncparam::idvvis, mod_ncparam::iinfo, mod_param::iobounds, mod_scalars::isalt, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::itemp, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_netcdf::n_var, mod_biology::nbac, mod_biology::nbands, mod_param::nbed, mod_scalars::nbrec, mod_scalars::ndeftlm, mod_biology::ndom, mod_netcdf::netcdf_check_dim(), mod_netcdf::netcdf_create(), mod_netcdf::netcdf_enddef(), mod_netcdf::netcdf_inq_var(), mod_netcdf::netcdf_open(), mod_netcdf::nf_fout, mod_netcdf::nf_type, mod_biology::nfec, mod_scalars::nfrec, mod_scalars::noerror, mod_biology::nphy, mod_param::nst, mod_fourdvar::nstatevar, mod_param::nt, mod_scalars::ntlm, mod_scalars::ntstart, mod_ncparam::nv, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::rclock, mod_netcdf::rec_size, mod_sediment::sd50, mod_iounits::sourcefile, mod_iounits::stdout, mod_iounits::tlm, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, mod_netcdf::var_id, mod_netcdf::var_name, and mod_ncparam::vname.

Referenced by tl_def_his().

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

◆ tl_def_his_pio()

subroutine, private tl_def_his_mod::tl_def_his_pio ( integer, intent(in) ng,
logical, intent(in) ldef )
private

Definition at line 1878 of file tl_def_his.F.

1879!***********************************************************************
1880!
1881 USE mod_pio_netcdf
1882!
1883! Imported variable declarations.
1884!
1885 integer, intent(in) :: ng
1886
1887 logical, intent(in) :: ldef
1888!
1889! Local variable declarations.
1890!
1891 logical :: got_var(NV)
1892!
1893 integer, parameter :: Natt = 25
1894
1895 integer :: i, j, ifield, itrc, nvd3, nvd4
1896 integer :: recdim, status, varid
1897# ifdef ADJUST_BOUNDARY
1898 integer :: IorJdim, brecdim
1899# endif
1900# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1901 integer :: frecdim
1902# endif
1903 integer :: DimIDs(nDimID)
1904 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
1905# ifdef ADJUST_BOUNDARY
1906 integer :: t2dobc(4)
1907# endif
1908
1909# ifdef SOLVE3D
1910 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
1911# ifdef ADJUST_BOUNDARY
1912 integer :: t3dobc(5)
1913# endif
1914# ifdef ADJUST_STFLUX
1915 integer :: t3dfrc(4)
1916# endif
1917# endif
1918# ifdef ADJUST_WSTRESS
1919 integer :: u3dfrc(4), v3dfrc(4)
1920# endif
1921!
1922 real(r8) :: Aval(6)
1923!
1924 character (len=256) :: ncname
1925 character (len=MaxLen) :: Vinfo(Natt)
1926!
1927 character (len=*), parameter :: MyFile = &
1928 & __FILE__//", tl_def_his_pio"
1929!
1930 TYPE (Var_desc_t) :: varDesc
1931!
1932 sourcefile=myfile
1933!
1934!-----------------------------------------------------------------------
1935! Set and report file name.
1936!-----------------------------------------------------------------------
1937!
1938 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1939 ncname=tlm(ng)%name
1940!
1941 IF (master) THEN
1942 IF (ldef) THEN
1943 WRITE (stdout,10) ng, trim(ncname)
1944 ELSE
1945 WRITE (stdout,20) ng, trim(ncname)
1946 END IF
1947 END IF
1948!
1949!=======================================================================
1950! Create a new tangent linear history file.
1951!=======================================================================
1952!
1953 define : IF (ldef) THEN
1954 CALL pio_netcdf_create (ng, model, trim(ncname), tlm(ng)%pioFile)
1955 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1956 IF (master) WRITE (stdout,30) trim(ncname)
1957 RETURN
1958 END IF
1959!
1960!-----------------------------------------------------------------------
1961! Define file dimensions.
1962!-----------------------------------------------------------------------
1963!
1964 dimids=0
1965!
1966 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'xi_rho', &
1967 & iobounds(ng)%xi_rho, dimids( 1))
1968 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1969
1970 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'xi_u', &
1971 & iobounds(ng)%xi_u, dimids( 2))
1972 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1973
1974 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'xi_v', &
1975 & iobounds(ng)%xi_v, dimids( 3))
1976 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1977
1978 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'xi_psi', &
1979 & iobounds(ng)%xi_psi, dimids( 4))
1980 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1981
1982 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'eta_rho', &
1983 & iobounds(ng)%eta_rho, dimids( 5))
1984 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1985
1986 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'eta_u', &
1987 & iobounds(ng)%eta_u, dimids( 6))
1988 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1989
1990 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'eta_v', &
1991 & iobounds(ng)%eta_v, dimids( 7))
1992 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1993
1994 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'eta_psi', &
1995 & iobounds(ng)%eta_psi, dimids( 8))
1996 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1997
1998# ifdef ADJUST_BOUNDARY
1999 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'IorJ', &
2000 & iobounds(ng)%IorJ, iorjdim)
2001 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2002# endif
2003
2004# if defined WRITE_WATER && defined MASKING
2005 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'xy_rho', &
2006 & iobounds(ng)%xy_rho, dimids(17))
2007 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2008
2009 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'xy_u', &
2010 & iobounds(ng)%xy_u, dimids(18))
2011 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2012
2013 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'xy_v', &
2014 & iobounds(ng)%xy_v, dimids(19))
2015 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2016# endif
2017
2018# ifdef SOLVE3D
2019# if defined WRITE_WATER && defined MASKING
2020 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'xyz_rho', &
2021 & iobounds(ng)%xy_rho*n(ng), dimids(20))
2022 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2023
2024 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'xyz_u', &
2025 & iobounds(ng)%xy_u*n(ng), dimids(21))
2026 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2027
2028 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'xyz_v', &
2029 & iobounds(ng)%xy_v*n(ng), dimids(22))
2030 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2031
2032 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'xyz_w', &
2033 & iobounds(ng)%xy_rho*(n(ng)+1), dimids(23))
2034 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2035# endif
2036
2037 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'N', &
2038 & n(ng), dimids( 9))
2039 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2040
2041 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 's_rho', &
2042 & n(ng), dimids( 9))
2043 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2044
2045 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 's_w', &
2046 & n(ng)+1, dimids(10))
2047 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2048
2049 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'tracer', &
2050 & nt(ng), dimids(11))
2051 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2052
2053# ifdef SEDIMENT
2054 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'NST', &
2055 & nst, dimids(32))
2056 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2057
2058 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'Nbed', &
2059 & nbed, dimids(16))
2060 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2061
2062# if defined WRITE_WATER && defined MASKING
2063 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'xybed', &
2064 & iobounds(ng)%xy_rho*nbed, dimids(24))
2065 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2066# endif
2067# endif
2068
2069# ifdef ECOSIM
2070 status=def_dim(ng, inlm, tlm(ng)%pioFile, ncname, 'Nbands', &
2071 & nbands, dimids(33))
2072 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2073
2074 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'Nphy', &
2075 & nphy, dimids(25))
2076 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2077
2078 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'Nbac', &
2079 & nbac, dimids(26))
2080 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2081
2082 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'Ndom', &
2083 & ndom, dimids(27))
2084 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2085
2086 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'Nfec', &
2087 & nfec, dimids(28))
2088 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2089# endif
2090# endif
2091
2092 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'boundary', &
2093 & 4, dimids(14))
2094 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2095
2096# ifdef FOUR_DVAR
2097 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'Nstate', &
2098 & nstatevar(ng), dimids(29))
2099 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2100# endif
2101
2102# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
2103 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'frc_adjust',&
2104 & nfrec(ng), dimids(30))
2105 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2106# endif
2107
2108# ifdef ADJUST_BOUNDARY
2109 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, 'obc_adjust',&
2110 & nbrec(ng), dimids(31))
2111 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2112# endif
2113
2114 status=def_dim(ng, model, tlm(ng)%pioFile, ncname, &
2115 & trim(adjustl(vname(5,idtime))), &
2116 & nf90_unlimited, dimids(12))
2117 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2118
2119 recdim=dimids(12)
2120# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
2121 frecdim=dimids(30)
2122# endif
2123# ifdef ADJUST_BOUNDARY
2124 brecdim=dimids(31)
2125# endif
2126!
2127! Set number of dimensions for output variables.
2128!
2129# if defined WRITE_WATER && defined MASKING
2130 nvd3=2
2131 nvd4=2
2132# else
2133 nvd3=3
2134 nvd4=4
2135# endif
2136!
2137! Define dimension vectors for staggered tracer type variables.
2138!
2139# if defined WRITE_WATER && defined MASKING
2140 t2dgrd(1)=dimids(17)
2141 t2dgrd(2)=dimids(12)
2142# ifdef SOLVE3D
2143 t3dgrd(1)=dimids(20)
2144 t3dgrd(2)=dimids(12)
2145# endif
2146# else
2147 t2dgrd(1)=dimids( 1)
2148 t2dgrd(2)=dimids( 5)
2149 t2dgrd(3)=dimids(12)
2150# ifdef SOLVE3D
2151 t3dgrd(1)=dimids( 1)
2152 t3dgrd(2)=dimids( 5)
2153 t3dgrd(3)=dimids( 9)
2154 t3dgrd(4)=dimids(12)
2155# endif
2156# ifdef ADJUST_STFLUX
2157 t3dfrc(1)=dimids( 1)
2158 t3dfrc(2)=dimids( 5)
2159 t3dfrc(3)=frecdim
2160 t3dfrc(4)=dimids(12)
2161# endif
2162# endif
2163# ifdef ADJUST_BOUNDARY
2164 t2dobc(1)=iorjdim
2165 t2dobc(2)=dimids(14)
2166 t2dobc(3)=brecdim
2167 t2dobc(4)=dimids(12)
2168# ifdef SOLVE3D
2169 t3dobc(1)=iorjdim
2170 t3dobc(2)=dimids( 9)
2171 t3dobc(3)=dimids(14)
2172 t3dobc(4)=brecdim
2173 t3dobc(5)=dimids(12)
2174# endif
2175# endif
2176!
2177! Define dimension vectors for staggered u-momentum type variables.
2178!
2179# if defined WRITE_WATER && defined MASKING
2180 u2dgrd(1)=dimids(18)
2181 u2dgrd(2)=dimids(12)
2182# ifdef SOLVE3D
2183 u3dgrd(1)=dimids(21)
2184 u3dgrd(2)=dimids(12)
2185# endif
2186# else
2187 u2dgrd(1)=dimids( 2)
2188 u2dgrd(2)=dimids( 6)
2189 u2dgrd(3)=dimids(12)
2190# ifdef SOLVE3D
2191 u3dgrd(1)=dimids( 2)
2192 u3dgrd(2)=dimids( 6)
2193 u3dgrd(3)=dimids( 9)
2194 u3dgrd(4)=dimids(12)
2195# endif
2196# ifdef ADJUST_WSTRESS
2197 u3dfrc(1)=dimids( 2)
2198 u3dfrc(2)=dimids( 6)
2199 u3dfrc(3)=frecdim
2200 u3dfrc(4)=dimids(12)
2201# endif
2202# endif
2203!
2204! Define dimension vectors for staggered v-momentum type variables.
2205!
2206# if defined WRITE_WATER && defined MASKING
2207 v2dgrd(1)=dimids(19)
2208 v2dgrd(2)=dimids(12)
2209# ifdef SOLVE3D
2210 v3dgrd(1)=dimids(22)
2211 v3dgrd(2)=dimids(12)
2212# endif
2213# else
2214 v2dgrd(1)=dimids( 3)
2215 v2dgrd(2)=dimids( 7)
2216 v2dgrd(3)=dimids(12)
2217# ifdef SOLVE3D
2218 v3dgrd(1)=dimids( 3)
2219 v3dgrd(2)=dimids( 7)
2220 v3dgrd(3)=dimids( 9)
2221 v3dgrd(4)=dimids(12)
2222# endif
2223# ifdef ADJUST_WSTRESS
2224 v3dfrc(1)=dimids( 3)
2225 v3dfrc(2)=dimids( 7)
2226 v3dfrc(3)=frecdim
2227 v3dfrc(4)=dimids(12)
2228# endif
2229# endif
2230# ifdef SOLVE3D
2231!
2232! Define dimension vector for staggered w-momentum type variables.
2233!
2234# if defined WRITE_WATER && defined MASKING
2235 w3dgrd(1)=dimids(23)
2236 w3dgrd(2)=dimids(12)
2237# else
2238 w3dgrd(1)=dimids( 1)
2239 w3dgrd(2)=dimids( 5)
2240 w3dgrd(3)=dimids(10)
2241 w3dgrd(4)=dimids(12)
2242# endif
2243# endif
2244!
2245! Initialize unlimited time record dimension.
2246!
2247 tlm(ng)%Rindex=0
2248!
2249! Initialize local information variable arrays.
2250!
2251 DO i=1,natt
2252 DO j=1,len(vinfo(1))
2253 vinfo(i)(j:j)=' '
2254 END DO
2255 END DO
2256 DO i=1,6
2257 aval(i)=0.0_r8
2258 END DO
2259!
2260!-----------------------------------------------------------------------
2261! Define time-recordless information variables.
2262!-----------------------------------------------------------------------
2263!
2264 CALL def_info (ng, model, tlm(ng)%pioFile, ncname, dimids)
2265 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2266!
2267!-----------------------------------------------------------------------
2268! Define time-varying variables.
2269!-----------------------------------------------------------------------
2270!
2271! Define model time.
2272!
2273 vinfo( 1)=vname(1,idtime)
2274 vinfo( 2)=vname(2,idtime)
2275 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
2276 vinfo( 4)=trim(rclock%calendar)
2277 vinfo(14)=vname(4,idtime)
2278 vinfo(21)=vname(6,idtime)
2279 tlm(ng)%pioVar(idtime)%dkind=pio_tout
2280 tlm(ng)%pioVar(idtime)%gtype=0
2281!
2282 status=def_var(ng, model, tlm(ng)%pioFile, &
2283 & tlm(ng)%pioVar(idtime)%vd, pio_tout, &
2284 & 1, (/recdim/), aval, vinfo, ncname, &
2285 & setparaccess = .false.)
2286 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2287
2288# ifdef PROPAGATOR
2289!
2290! Define Ritz eigenvalues and Ritz eigenvectors Euclidean norm.
2291!
2292 vinfo( 1)='Ritz_rvalue'
2293 vinfo( 2)='real Ritz eigenvalues'
2294 status=def_var(ng, model, tlm(ng)%pioFile, vardesc, pio_type, &
2295 & 1, (/recdim/), aval, vinfo, ncname, &
2296 & setparaccess = .false.)
2297 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2298!
2299# if defined FT_EIGENMODES
2300 vinfo( 1)='Ritz_ivalue'
2301 vinfo( 2)='imaginary Ritz eigenvalues'
2302 status=def_var(ng, model, tlm(ng)%pioFile, vardesc, pio_type, &
2303 & 1, (/recdim/), aval, vinfo, ncname, &
2304 & setparaccess = .false.)
2305 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2306!
2307# endif
2308
2309 vinfo( 1)='Ritz_norm'
2310 vinfo( 2)='Ritz eigenvectors Euclidean norm'
2311 status=def_var(ng, model, tlm(ng)%pioFile, vardesc, pio_type, &
2312 & 1, (/recdim/), aval, vinfo, ncname, &
2313 & setparaccess = .false.)
2314 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2315# endif
2316# ifdef ADJUST_WSTRESS
2317!
2318! Define surface U-momentum stress. Notice that the stress has its
2319! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
2320! at other times in addition to initialization time.
2321!
2322 vinfo( 1)=vname(1,idusms)
2323 WRITE (vinfo( 2),40) trim(vname(2,idusms))
2324 vinfo( 3)='meter2 second-2'
2325 vinfo(16)=vname(1,idtime)
2326# if defined WRITE_WATER && defined MASKING
2327 vinfo(20)='mask_u'
2328# endif
2329 vinfo(22)='coordinates'
2330 aval(5)=real(iinfo(1,idusms,ng),r8)
2331 tlm(ng)%pioVar(idusms)%dkind=pio_fout
2332 tlm(ng)%pioVar(idusms)%gtype=u2dvar
2333!
2334 status=def_var(ng, model, tlm(ng)%pioFile, &
2335 & tlm(ng)%pioVar(idusms)%vd, &
2336 & pio_fout, nvd4, u3dfrc, aval, vinfo, ncname)
2337 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2338!
2339! Define surface V-momentum stress.
2340!
2341 vinfo( 1)=vname(1,idvsms)
2342 WRITE (vinfo( 2),40) trim(vname(2,idvsms))
2343 vinfo( 3)='meter2 second-2'
2344 vinfo(16)=vname(1,idtime)
2345# if defined WRITE_WATER && defined MASKING
2346 vinfo(20)='mask_v'
2347# endif
2348 vinfo(22)='coordinates'
2349 aval(5)=real(iinfo(1,idvsms,ng),r8)
2350 tlm(ng)%pioVar(idvsms)%dkind=pio_fout
2351 tlm(ng)%pioVar(idvsms)%gtype=v2dvar
2352!
2353 status=def_var(ng, model, tlm(ng)%pioFile, &
2354 & tlm(ng)%pioVar(idvsms)%vd, &
2355 & pio_fout, nvd4, v3dfrc, aval, vinfo, ncname)
2356 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2357# endif
2358# if defined FORCING_SV || defined STOCHASTIC_OPT || \
2359 defined hessian_so || defined hessian_fsv
2360!
2361! Define surface U-momentum stress.
2362!
2363 IF (hout(idusms,ng)) THEN
2364 vinfo( 1)=vname(1,idusms)
2365 WRITE (vinfo( 2),40) trim(vname(2,idusms))
2366 vinfo( 3)=vname(3,idusms)
2367 vinfo(14)=vname(4,idusms)
2368 vinfo(16)=vname(1,idtime)
2369# if defined WRITE_WATER && defined MASKING
2370 vinfo(20)='mask_u'
2371# endif
2372 vinfo(21)=vname(6,idusms)
2373 vinfo(22)='coordinates'
2374 aval(5)=real(iinfo(1,idusms,ng),r8)
2375 tlm(ng)%pioVar(idusms)%dkind=pio_fout
2376 tlm(ng)%pioVar(idusms)%gtype=u2dvar
2377!
2378 status=def_var(ng, model, tlm(ng)%pioFile, &
2379 & tlm(ng)%pioVar(idusms)%vd, &
2380 & pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
2381 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2382 END IF
2383!
2384! Define surface V-momentum stress.
2385!
2386 IF (hout(idvsms,ng)) THEN
2387 vinfo( 1)=vname(1,idvsms)
2388 WRITE (vinfo( 2),40) trim(vname(2,idvsms))
2389 vinfo( 3)=vname(3,idvsms)
2390 vinfo(14)=vname(4,idvsms)
2391 vinfo(16)=vname(1,idtime)
2392# if defined WRITE_WATER && defined MASKING
2393 vinfo(20)='mask_v'
2394# endif
2395 vinfo(21)=vname(6,idvsms)
2396 vinfo(22)='coordinates'
2397 aval(5)=real(iinfo(1,idvsms,ng),r8)
2398 tlm(ng)%pioVar(idvsms)%dkind=pio_fout
2399 tlm(ng)%pioVar(idvsms)%gtype=v2dvar
2400!
2401 status=def_var(ng, model, tlm(ng)%pioFile, &
2402 & tlm(ng)%pioVar(idvsms)%vd, &
2403 & pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
2404 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2405 END IF
2406!
2407! Define surface tracer fluxes.
2408!
2409 DO itrc=1,nt(ng)
2410 IF (hout(idtsur(itrc),ng)) THEN
2411 vinfo( 1)=vname(1,idtsur(itrc))
2412 WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
2413 vinfo( 3)=vname(3,idtsur(itrc))
2414 IF (itrc.eq.itemp) THEN
2415 vinfo(11)='upward flux, cooling'
2416 vinfo(12)='downward flux, heating'
2417 ELSE IF (itrc.eq.isalt) THEN
2418 vinfo(11)='upward flux, freshening (net precipitation)'
2419 vinfo(12)='downward flux, salting (net evaporation)'
2420 END IF
2421 vinfo(14)=vname(4,idtsur(itrc))
2422 vinfo(16)=vname(1,idtime)
2423# if defined WRITE_WATER && defined MASKING
2424 vinfo(20)='mask_rho'
2425# endif
2426 vinfo(21)=vname(6,idtsur(itrc))
2427 vinfo(22)='coordinates'
2428 aval(5)=real(iinfo(1,idtsur(itrc),ng),r8)
2429 tlm(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
2430 tlm(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
2431!
2432 status=def_var(ng, model, tlm(ng)%pioFile, &
2433 & tlm(ng)%pioVar(idtsur(itrc))%vd, &
2434 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
2435 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2436 END IF
2437 END DO
2438# endif
2439# if defined ADJUST_STFLUX && defined SOLVE3D
2440!
2441! Define surface net heat flux. Notice that different tracer fluxes
2442! are written at their own fixed time-dimension (of size Nfrec) to
2443! allow 4DVAR adjustments at other times in addition to initial time.
2444!
2445 DO itrc=1,nt(ng)
2446 IF (lstflux(itrc,ng)) THEN
2447 vinfo( 1)=vname(1,idtsur(itrc))
2448 WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
2449 IF (itrc.eq.itemp) THEN
2450 vinfo( 3)='Celsius meter second-1'
2451 vinfo(11)='upward flux, cooling'
2452 vinfo(12)='downward flux, heating'
2453 ELSE IF (itrc.eq.isalt) THEN
2454 vinfo( 3)='meter second-1'
2455 vinfo(11)='upward flux, freshening (net precipitation)'
2456 vinfo(12)='downward flux, salting (net evaporation)'
2457 END IF
2458 vinfo(16)=vname(1,idtime)
2459# if defined WRITE_WATER && defined MASKING
2460 vinfo(20)='mask_rho'
2461# endif
2462 vinfo(22)='coordinates'
2463 aval(5)=real(iinfo(1,idtsur(itrc),ng),r8)
2464 tlm(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
2465 tlm(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
2466!
2467 status=def_var(ng, model, tlm(ng)%pioFile, &
2468 & tlm(ng)%pioVar(idtsur(itrc))%vd, &
2469 & pio_fout, nvd4, t3dfrc, aval, vinfo, ncname)
2470 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2471 END IF
2472 END DO
2473# endif
2474# ifdef SOLVE3D
2475!
2476! Define time-varying depth of RHO-points.
2477!
2478 IF (hout(idpthr,ng)) THEN
2479 vinfo( 1)=vname(1,idpthr)
2480 WRITE (vinfo( 2),40) trim(vname(2,idpthr))
2481 vinfo( 3)=vname(3,idpthr)
2482 vinfo(14)=vname(4,idpthr)
2483 vinfo(16)=vname(1,idtime)
2484# if defined WRITE_WATER && defined MASKING
2485 vinfo(20)='mask_rho'
2486# endif
2487 vinfo(21)=vname(6,idpthr)
2488 vinfo(22)='coordinates'
2489 aval(5)=real(iinfo(1,idpthr,ng),r8)
2490 tlm(ng)%pioVar(idpthr)%dkind=pio_fout
2491 tlm(ng)%pioVar(idpthr)%gtype=r3dvar
2492!
2493 status=def_var(ng, model, tlm(ng)%pioFile, &
2494 & tlm(ng)%pioVar(idpthr)%vd, &
2495 & pio_fout, nvd4, t3dgrd, aval, vinfo, ncname, &
2496 & setfillval = .false.)
2497 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2498 END IF
2499!
2500! Define time-varying depth of W-points.
2501!
2502 IF (hout(idpthw,ng)) THEN
2503 vinfo( 1)=vname(1,idpthw)
2504 WRITE (vinfo( 2),40) trim(vname(2,idpthw))
2505 vinfo( 3)=vname(3,idpthw)
2506 vinfo(14)=vname(4,idpthw)
2507 vinfo(16)=vname(1,idtime)
2508# if defined WRITE_WATER && defined MASKING
2509 vinfo(20)='mask_rho'
2510# endif
2511 vinfo(21)=vname(6,idpthw)
2512 vinfo(22)='coordinates'
2513 aval(5)=real(iinfo(1,idpthw,ng),r8)
2514 tlm(ng)%pioVar(idpthw)%dkind=pio_fout
2515 tlm(ng)%pioVar(idpthw)%gtype=w3dvar
2516!
2517 status=def_var(ng, model, tlm(ng)%pioFile, &
2518 & tlm(ng)%pioVar(idpthw)%vd, &
2519 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
2520 & setfillval = .false.)
2521 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2522 END IF
2523# endif
2524!
2525! Define free-surface.
2526!
2527 IF (hout(idfsur,ng)) THEN
2528 vinfo( 1)=vname(1,idfsur)
2529 WRITE (vinfo( 2),40) trim(vname(2,idfsur))
2530 vinfo( 3)=vname(3,idfsur)
2531 vinfo(14)=vname(4,idfsur)
2532 vinfo(16)=vname(1,idtime)
2533# if !defined WET_DRY && (defined WRITE_WATER && defined MASKING)
2534 vinfo(20)='mask_rho'
2535# endif
2536 vinfo(21)=vname(6,idfsur)
2537 vinfo(22)='coordinates'
2538 aval(5)=real(iinfo(1,idfsur,ng),r8)
2539 tlm(ng)%pioVar(idfsur)%dkind=pio_fout
2540 tlm(ng)%pioVar(idfsur)%gtype=r2dvar
2541!
2542 status=def_var(ng, model, tlm(ng)%pioFile, &
2543 & tlm(ng)%pioVar(idfsur)%vd, &
2544# ifdef WET_DRY
2545 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname, &
2546 & setfillval = .false.)
2547# else
2548 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
2549# endif
2550 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2551
2552# if defined FORWARD_WRITE && defined FORWARD_RHS
2553!
2554 vinfo( 1)=vname(1,idrzet)
2555 WRITE (vinfo( 2),40) trim(vname(2,idrzet))
2556 vinfo( 3)=vname(3,idrzet)
2557 vinfo(14)=vname(4,idrzet)
2558 vinfo(16)=vname(1,idtime)
2559# if defined WRITE_WATER && defined MASKING
2560 vinfo(20)='mask_rho'
2561# endif
2562 vinfo(21)=vname(6,idrzet)
2563 vinfo(22)='coordinates'
2564 aval(5)=real(r2dvar,r8)
2565 tlm(ng)%pioVar(idrzet)%dkind=pio_fout
2566 tlm(ng)%pioVar(idrzet)%gtype=r2dvar
2567!
2568 status=def_var(ng, model, tlm(ng)%pioFile, &
2569 & tlm(ng)%pioVar(idrzet)%vd, &
2570 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
2571 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2572# endif
2573 END IF
2574
2575# ifdef ADJUST_BOUNDARY
2576!
2577! Define free-surface open boundaries.
2578!
2579 IF (any(lobc(:,isfsur,ng))) THEN
2580 ifield=idsbry(isfsur)
2581 vinfo( 1)=vname(1,ifield)
2582 WRITE (vinfo( 2),40) trim(vname(2,ifield))
2583 vinfo( 3)=vname(3,ifield)
2584 vinfo(14)=vname(4,ifield)
2585 vinfo(16)=vname(1,idtime)
2586 vinfo(21)=vname(6,ifield)
2587 aval(5)=real(iinfo(1,ifield,ng),r8)
2588 tlm(ng)%pioVar(ifield)%dkind=pio_fout
2589 tlm(ng)%pioVar(ifield)%gtype=r2dobc
2590!
2591 status=def_var(ng, model, tlm(ng)%pioFile, &
2592 & tlm(ng)%pioVar(ifield)%vd, &
2593 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
2594 & setfillval = .false.)
2595 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2596 END IF
2597# endif
2598!
2599! Define 2D U-momentum component.
2600!
2601 IF (hout(idubar,ng)) THEN
2602 vinfo( 1)=vname(1,idubar)
2603 WRITE (vinfo( 2),40) trim(vname(2,idubar))
2604 vinfo( 3)=vname(3,idubar)
2605 vinfo(14)=vname(4,idubar)
2606 vinfo(16)=vname(1,idtime)
2607# if defined WRITE_WATER && defined MASKING
2608 vinfo(20)='mask_u'
2609# endif
2610 vinfo(21)=vname(6,idubar)
2611 vinfo(22)='coordinates'
2612 aval(5)=real(iinfo(1,idubar,ng),r8)
2613 tlm(ng)%pioVar(idubar)%dkind=pio_fout
2614 tlm(ng)%pioVar(idubar)%gtype=u2dvar
2615!
2616 status=def_var(ng, model, tlm(ng)%pioFile, &
2617 & tlm(ng)%pioVar(idubar)%vd, &
2618 & pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
2619 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2620
2621# ifdef FORWARD_WRITE
2622# ifdef FORWARD_RHS
2623!
2624 vinfo( 1)=vname(1,idru2d)
2625 WRITE (vinfo( 2),40) trim(vname(2,idru2d))
2626 vinfo( 3)=vname(3,idru2d)
2627 vinfo(14)=vname(4,idru2d)
2628 vinfo(16)=vname(1,idtime)
2629# if defined WRITE_WATER && defined MASKING
2630 vinfo(20)='mask_u'
2631# endif
2632 vinfo(21)=vname(6,idru2d)
2633 vinfo(22)='coordinates'
2634 aval(5)=real(u2dvar,r8)
2635 tlm(ng)%pioVar(idru2d)%dkind=pio_fout
2636 tlm(ng)%pioVar(idru2d)%gtype=u2dvar
2637!
2638 status=def_var(ng, model, tlm(ng)%pioFile, &
2639 & tlm(ng)%pioVar(idru2d)%vd, &
2640 & pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
2641 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2642# endif
2643# ifdef SOLVE3D
2644# ifdef FORWARD_RHS
2645!
2646 vinfo( 1)=vname(1,idruct)
2647 WRITE (vinfo( 2),40) trim(vname(2,idruct))
2648 vinfo( 3)=vname(3,idruct)
2649 vinfo(14)=vname(4,idruct)
2650 vinfo(16)=vname(1,idtime)
2651# if defined WRITE_WATER && defined MASKING
2652 vinfo(20)='mask_u'
2653# endif
2654 vinfo(21)=vname(6,idruct)
2655 vinfo(22)='coordinates'
2656 aval(5)=real(u2dvar,r8)
2657 tlm(ng)%pioVar(idruct)%dkind=pio_fout
2658 tlm(ng)%pioVar(idruct)%gtype=u2dvar
2659!
2660 status=def_var(ng, model, tlm(ng)%pioFile, &
2661 & tlm(ng)%pioVar(idruct)%vd, &
2662 & pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
2663 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2664# endif
2665!
2666 vinfo( 1)=vname(1,idufx1)
2667 WRITE (vinfo( 2),40) trim(vname(2,idufx1))
2668 vinfo( 3)=vname(3,idufx1)
2669 vinfo(14)=vname(4,idufx1)
2670 vinfo(16)=vname(1,idtime)
2671# if defined WRITE_WATER && defined MASKING
2672 vinfo(20)='mask_u'
2673# endif
2674 vinfo(21)=vname(6,idufx1)
2675 vinfo(22)='coordinates'
2676 aval(5)=real(u2dvar,r8)
2677 tlm(ng)%pioVar(idufx1)%dkind=pio_fout
2678 tlm(ng)%pioVar(idufx1)%gtype=u2dvar
2679!
2680 status=def_var(ng, model, tlm(ng)%pioFile, &
2681 & tlm(ng)%pioVar(idufx1)%vd, &
2682 & pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
2683 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2684!
2685 vinfo( 1)=vname(1,idufx2)
2686 WRITE (vinfo( 2),40) trim(vname(2,idufx2))
2687 vinfo( 3)=vname(3,idufx2)
2688 vinfo(14)=vname(4,idufx2)
2689 vinfo(16)=vname(1,idtime)
2690# if defined WRITE_WATER && defined MASKING
2691 vinfo(20)='mask_u'
2692# endif
2693 vinfo(21)=vname(6,idufx2)
2694 vinfo(22)='coordinates'
2695 aval(5)=real(u2dvar,r8)
2696 tlm(ng)%pioVar(idufx2)%dkind=pio_fout
2697 tlm(ng)%pioVar(idufx2)%gtype=u2dvar
2698!
2699 status=def_var(ng, model, tlm(ng)%pioFile, &
2700 & tlm(ng)%pioVar(idufx2)%vd, &
2701 & pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
2702 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2703# endif
2704# endif
2705 END IF
2706
2707# ifdef ADJUST_BOUNDARY
2708!
2709! Define 2D U-momentum component open boundaries.
2710!
2711 IF (any(lobc(:,isubar,ng))) THEN
2712 ifield=idsbry(isubar)
2713 vinfo( 1)=vname(1,ifield)
2714 WRITE (vinfo( 2),40) trim(vname(2,ifield))
2715 vinfo( 3)=vname(3,ifield)
2716 vinfo(14)=vname(4,ifield)
2717 vinfo(16)=vname(1,idtime)
2718 vinfo(21)=vname(6,ifield)
2719 aval(5)=real(iinfo(1,ifield,ng),r8)
2720 tlm(ng)%pioVar(ifield)%dkind=pio_fout
2721 tlm(ng)%pioVar(ifield)%gtype=u2dobc
2722!
2723 status=def_var(ng, model, tlm(ng)%pioFile, &
2724 & tlm(ng)%pioVar(ifield)%vd, &
2725 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
2726 & setfillval = .false.)
2727 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2728 END IF
2729# endif
2730!
2731! Define 2D V-momentum component.
2732!
2733 IF (hout(idvbar,ng)) THEN
2734 vinfo( 1)=vname(1,idvbar)
2735 WRITE (vinfo( 2),40) trim(vname(2,idvbar))
2736 vinfo( 3)=vname(3,idvbar)
2737 vinfo(14)=vname(4,idvbar)
2738 vinfo(16)=vname(1,idtime)
2739# if defined WRITE_WATER && defined MASKING
2740 vinfo(20)='mask_v'
2741# endif
2742 vinfo(21)=vname(6,idvbar)
2743 vinfo(22)='coordinates'
2744 aval(5)=real(iinfo(1,idvbar,ng),r8)
2745 tlm(ng)%pioVar(idvbar)%dkind=pio_fout
2746 tlm(ng)%pioVar(idvbar)%gtype=v2dvar
2747!
2748 status=def_var(ng, model, tlm(ng)%pioFile, &
2749 & tlm(ng)%pioVar(idvbar)%vd, &
2750 & pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
2751 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2752
2753# ifdef FORWARD_WRITE
2754# ifdef FORWARD_RHS
2755!
2756 vinfo( 1)=vname(1,idrv2d)
2757 WRITE (vinfo( 2),40) trim(vname(2,idrv2d))
2758 vinfo( 3)=vname(3,idrv2d)
2759 vinfo(14)=vname(4,idrv2d)
2760 vinfo(16)=vname(1,idtime)
2761# if defined WRITE_WATER && defined MASKING
2762 vinfo(20)='mask_v'
2763# endif
2764 vinfo(21)=vname(6,idrv2d)
2765 vinfo(22)='coordinates'
2766 aval(5)=real(v2dvar,r8)
2767 tlm(ng)%pioVar(idrv2d)%dkind=pio_fout
2768 tlm(ng)%pioVar(idrv2d)%gtype=v2dvar
2769!
2770 status=def_var(ng, model, tlm(ng)%pioFile, &
2771 & tlm(ng)%pioVar(idrv2d)%vd, &
2772 & pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
2773 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2774# endif
2775# ifdef SOLVE3D
2776# ifdef FORWARD_RHS
2777!
2778 vinfo( 1)=vname(1,idrvct)
2779 WRITE (vinfo( 2),40) trim(vname(2,idrvct))
2780 vinfo( 3)=vname(3,idrvct)
2781 vinfo(14)=vname(4,idrvct)
2782 vinfo(16)=vname(1,idtime)
2783# if defined WRITE_WATER && defined MASKING
2784 vinfo(20)='mask_v'
2785# endif
2786 vinfo(21)=vname(6,idrvct)
2787 vinfo(22)='coordinates'
2788 aval(5)=real(v2dvar,r8)
2789 tlm(ng)%pioVar(idrvct)%dkind=pio_fout
2790 tlm(ng)%pioVar(idrvct)%gtype=v2dvar
2791!
2792 status=def_var(ng, model, tlm(ng)%pioFile, &
2793 & tlm(ng)%pioVar(idrvct)%vd, &
2794 & pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
2795 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2796# endif
2797!
2798 vinfo( 1)=vname(1,idvfx1)
2799 WRITE (vinfo( 2),40) trim(vname(2,idvfx1))
2800 vinfo( 3)=vname(3,idvfx1)
2801 vinfo(14)=vname(4,idvfx1)
2802 vinfo(16)=vname(1,idtime)
2803# if defined WRITE_WATER && defined MASKING
2804 vinfo(20)='mask_v'
2805# endif
2806 vinfo(21)=vname(6,idvfx1)
2807 vinfo(22)='coordinates'
2808 aval(5)=real(v2dvar,r8)
2809 tlm(ng)%pioVar(idvfx1)%dkind=pio_fout
2810 tlm(ng)%pioVar(idvfx1)%gtype=v2dvar
2811!
2812 status=def_var(ng, model, tlm(ng)%pioFile, &
2813 & tlm(ng)%pioVar(idvfx1)%vd, &
2814 & pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
2815 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2816!
2817 vinfo( 1)=vname(1,idvfx2)
2818 WRITE (vinfo( 2),40) trim(vname(2,idvfx2))
2819 vinfo( 3)=vname(3,idvfx2)
2820 vinfo(14)=vname(4,idvfx2)
2821 vinfo(16)=vname(1,idtime)
2822# if defined WRITE_WATER && defined MASKING
2823 vinfo(20)='mask_v'
2824# endif
2825 vinfo(21)=vname(6,idvfx2)
2826 vinfo(22)='coordinates'
2827 aval(5)=real(v2dvar,r8)
2828 tlm(ng)%pioVar(idvfx2)%dkind=pio_fout
2829 tlm(ng)%pioVar(idvfx2)%gtype=v2dvar
2830!
2831 status=def_var(ng, model, tlm(ng)%pioFile, &
2832 & tlm(ng)%pioVar(idvfx2)%vd, &
2833 & pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
2834 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2835# endif
2836# endif
2837 END IF
2838
2839# ifdef ADJUST_BOUNDARY
2840!
2841! Define 2D V-momentum component open boundaries.
2842!
2843 IF (any(lobc(:,isvbar,ng))) THEN
2844 ifield=idsbry(isvbar)
2845 vinfo( 1)=vname(1,ifield)
2846 WRITE (vinfo( 2),40) trim(vname(2,ifield))
2847 vinfo( 3)=vname(3,ifield)
2848 vinfo(14)=vname(4,ifield)
2849 vinfo(16)=vname(1,idtime)
2850 vinfo(21)=vname(6,ifield)
2851 aval(5)=real(iinfo(1,ifield,ng),r8)
2852 tlm(ng)%pioVar(ifield)%dkind=pio_fout
2853 tlm(ng)%pioVar(ifield)%gtype=v2dobc
2854!
2855 status=def_var(ng, model, tlm(ng)%pioFile, &
2856 & tlm(ng)%pioVar(ifield)%vd, &
2857 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
2858 & setfillval = .false.)
2859 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2860 END IF
2861# endif
2862# ifdef SOLVE3D
2863!
2864! Define 3D U-momentum component.
2865!
2866 IF (hout(iduvel,ng)) THEN
2867 vinfo( 1)=vname(1,iduvel)
2868 WRITE (vinfo( 2),40) trim(vname(2,iduvel))
2869 vinfo( 3)=vname(3,iduvel)
2870 vinfo(14)=vname(4,iduvel)
2871 vinfo(16)=vname(1,idtime)
2872# if defined WRITE_WATER && defined MASKING
2873 vinfo(20)='mask_u'
2874# endif
2875 vinfo(21)=vname(6,iduvel)
2876 vinfo(22)='coordinates'
2877 aval(5)=real(iinfo(1,iduvel,ng),r8)
2878 tlm(ng)%pioVar(iduvel)%dkind=pio_fout
2879 tlm(ng)%pioVar(iduvel)%gtype=u3dvar
2880!
2881 status=def_var(ng, model, tlm(ng)%pioFile, &
2882 & tlm(ng)%pioVar(iduvel)%vd, &
2883 & pio_fout, nvd4, u3dgrd, aval, vinfo, ncname)
2884 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2885
2886# if defined FORWARD_WRITE && defined FORWARD_RHS
2887!
2888 vinfo( 1)=vname(1,idru3d)
2889 WRITE (vinfo( 2),40) trim(vname(2,idru3d))
2890 vinfo( 3)=vname(3,idru3d)
2891 vinfo(14)=vname(4,idru3d)
2892 vinfo(16)=vname(1,idtime)
2893# if defined WRITE_WATER && defined MASKING
2894 vinfo(20)='mask_u'
2895# endif
2896 vinfo(21)=vname(6,idru3d)
2897 vinfo(22)='coordinates'
2898 aval(5)=real(u3dvar,r8)
2899 tlm(ng)%pioVar(idru3d)%dkind=pio_fout
2900 tlm(ng)%pioVar(idru3d)%gtype=u3dvar
2901!
2902 status=def_var(ng, model, tlm(ng)%pioFile, &
2903 & tlm(ng)%pioVar(idru3d)%vd, &
2904 & pio_fout, nvd4, u3dgrd, aval, vinfo, ncname)
2905 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2906# endif
2907 END IF
2908
2909# ifdef ADJUST_BOUNDARY
2910!
2911! Define 3D U-momentum component open boundaries.
2912!
2913 IF (any(lobc(:,isuvel,ng))) THEN
2914 ifield=idsbry(isuvel)
2915 vinfo( 1)=vname(1,ifield)
2916 WRITE (vinfo( 2),40) trim(vname(2,ifield))
2917 vinfo( 3)=vname(3,ifield)
2918 vinfo(14)=vname(4,ifield)
2919 vinfo(16)=vname(1,idtime)
2920 vinfo(21)=vname(6,ifield)
2921 aval(5)=real(iinfo(1,ifield,ng),r8)
2922 tlm(ng)%pioVar(ifield)%dkind=pio_fout
2923 tlm(ng)%pioVar(ifield)%gtype=u3dobc
2924!
2925 status=def_var(ng, model, tlm(ng)%pioFile, &
2926 & tlm(ng)%pioVar(ifield)%vd, &
2927 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
2928 & setfillval = .false.)
2929 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2930 END IF
2931# endif
2932!
2933! Define 3D V-momentum component.
2934!
2935 IF (hout(idvvel,ng)) THEN
2936 vinfo( 1)=vname(1,idvvel)
2937 WRITE (vinfo( 2),40) trim(vname(2,idvvel))
2938 vinfo( 3)=vname(3,idvvel)
2939 vinfo(14)=vname(4,idvvel)
2940 vinfo(16)=vname(1,idtime)
2941# if defined WRITE_WATER && defined MASKING
2942 vinfo(20)='mask_v'
2943# endif
2944 vinfo(21)=vname(6,idvvel)
2945 vinfo(22)='coordinates'
2946 aval(5)=real(iinfo(1,idvvel,ng),r8)
2947 tlm(ng)%pioVar(idvvel)%dkind=pio_fout
2948 tlm(ng)%pioVar(idvvel)%gtype=v3dvar
2949!
2950 status=def_var(ng, model, tlm(ng)%pioFile, &
2951 & tlm(ng)%pioVar(idvvel)%vd, &
2952 & pio_fout, nvd4, v3dgrd, aval, vinfo, ncname)
2953 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2954
2955# if defined FORWARD_WRITE && defined FORWARD_RHS
2956!
2957 vinfo( 1)=vname(1,idrv3d)
2958 WRITE (vinfo( 2),40) trim(vname(2,idrv3d))
2959 vinfo( 3)=vname(3,idrv3d)
2960 vinfo(14)=vname(4,idrv3d)
2961 vinfo(16)=vname(1,idtime)
2962# if defined WRITE_WATER && defined MASKING
2963 vinfo(20)='mask_v'
2964# endif
2965 vinfo(21)=vname(6,idrv3d)
2966 vinfo(22)='coordinates'
2967 aval(5)=real(v3dvar,r8)
2968 tlm(ng)%pioVar(idrv3d)%dkind=pio_fout
2969 tlm(ng)%pioVar(idrv3d)%gtype=v3dvar
2970!
2971 status=def_var(ng, model, tlm(ng)%pioFile, &
2972 & tlm(ng)%pioVar(idrv3d)%vd, &
2973 & pio_fout, nvd4, v3dgrd, aval, vinfo, ncname)
2974 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2975# endif
2976 END IF
2977
2978# ifdef ADJUST_BOUNDARY
2979!
2980! Define 3D V-momentum component open boundaries.
2981!
2982 IF (any(lobc(:,isvvel,ng))) THEN
2983 ifield=idsbry(isvvel)
2984 vinfo( 1)=vname(1,ifield)
2985 WRITE (vinfo( 2),40) trim(vname(2,ifield))
2986 vinfo( 3)=vname(3,ifield)
2987 vinfo(14)=vname(4,ifield)
2988 vinfo(16)=vname(1,idtime)
2989 vinfo(21)=vname(6,ifield)
2990 aval(5)=real(iinfo(1,ifield,ng),r8)
2991 tlm(ng)%pioVar(ifield)%dkind=pio_fout
2992 tlm(ng)%pioVar(ifield)%gtype=v3dobc
2993!
2994 status=def_var(ng, model, tlm(ng)%pioFile, &
2995 & tlm(ng)%pioVar(ifield)%vd, &
2996 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
2997 & setfillval = .false.)
2998 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2999 END IF
3000# endif
3001# ifdef UV_DESTAGGERED
3002!
3003! Define 3D Eastward momentum at RHO-points, A-grid.
3004!
3005 IF (hout(idu3de,ng)) THEN
3006 vinfo( 1)=vname(1,idu3de)
3007 vinfo( 2)=vname(2,idu3de)
3008 vinfo( 3)=vname(3,idu3de)
3009 vinfo(14)=vname(4,idu3de)
3010 vinfo(16)=vname(1,idtime)
3011# if defined WRITE_WATER && defined MASKING
3012 vinfo(20)='mask_rho'
3013# endif
3014 vinfo(21)=vname(6,idu3de)
3015 vinfo(22)='coordinates'
3016 aval(5)=real(iinfo(1,idu3de,ng),r8)
3017 tlm(ng)%pioVar(idu3de)%dkind=pio_fout
3018 tlm(ng)%pioVar(idu3de)%gtype=r3dvar
3019!
3020 status=def_var(ng, model, tlm(ng)%pioFile, &
3021 & tlm(ng)%pioVar(idu3de)%vd, &
3022 & pio_fout, nvd4, t3dgrd, aval, vinfo, ncname)
3023 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3024 END IF
3025!
3026! Define 3D Northward momentum at RHO-points, A-grid.
3027!
3028 IF (hout(idv3dn,ng)) THEN
3029 vinfo( 1)=vname(1,idv3dn)
3030 vinfo( 2)=vname(2,idv3dn)
3031 vinfo( 3)=vname(3,idv3dn)
3032 vinfo(14)=vname(4,idv3dn)
3033 vinfo(16)=vname(1,idtime)
3034# if defined WRITE_WATER && defined MASKING
3035 vinfo(20)='mask_rho'
3036# endif
3037 vinfo(21)=vname(6,idv3dn)
3038 vinfo(22)='coordinates'
3039 aval(5)=real(iinfo(1,idv3dn,ng),r8)
3040 tlm(ng)%pioVar(idv3dn)%dkind=pio_fout
3041 tlm(ng)%pioVar(idv3dn)%gtype=r3dvar
3042!
3043 status=def_var(ng, model, tlm(ng)%pioFile, &
3044 & tlm(ng)%pioVar(idv3dn)%vd, &
3045 & pio_fout, nvd4, t3dgrd, aval, vinfo, ncname)
3046 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3047 END IF
3048# endif
3049!
3050! Define tracer type variables.
3051!
3052 DO itrc=1,nt(ng)
3053 IF (hout(idtvar(itrc),ng)) THEN
3054 vinfo( 1)=vname(1,idtvar(itrc))
3055 WRITE (vinfo( 2),40) trim(vname(2,idtvar(itrc)))
3056 vinfo( 3)=vname(3,idtvar(itrc))
3057 vinfo(14)=vname(4,idtvar(itrc))
3058 vinfo(16)=vname(1,idtime)
3059# ifdef SEDIMENT_NOT_YET
3060 DO i=1,nst
3061 IF (itrc.eq.idsed(i)) THEN
3062 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
3063 END IF
3064 END DO
3065# endif
3066# if defined WRITE_WATER && defined MASKING
3067 vinfo(20)='mask_rho'
3068# endif
3069 vinfo(21)=vname(6,idtvar(itrc))
3070 vinfo(22)='coordinates'
3071 aval(5)=real(r3dvar,r8)
3072 tlm(ng)%pioTrc(itrc)%dkind=pio_fout
3073 tlm(ng)%pioTrc(itrc)%gtype=r3dvar
3074!
3075 status=def_var(ng, model, tlm(ng)%pioFile, &
3076 & tlm(ng)%pioTrc(itrc)%vd, &
3077 & pio_fout, nvd4, t3dgrd, aval, vinfo, ncname)
3078 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3079 END IF
3080 END DO
3081
3082# ifdef ADJUST_BOUNDARY
3083!
3084! Define tracer type variables open boundaries.
3085!
3086 DO itrc=1,nt(ng)
3087 IF (any(lobc(:,istvar(itrc),ng))) THEN
3088 ifield=idsbry(istvar(itrc))
3089 vinfo( 1)=vname(1,ifield)
3090 WRITE (vinfo( 2),40) trim(vname(2,ifield))
3091 vinfo( 3)=vname(3,ifield)
3092 vinfo(14)=vname(4,ifield)
3093 vinfo(16)=vname(1,idtime)
3094# ifdef SEDIMENT
3095 DO i=1,nst
3096 IF (itrc.eq.idsed(i)) THEN
3097 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
3098 END IF
3099 END DO
3100# endif
3101 vinfo(21)=vname(6,ifield)
3102 aval(5)=real(iinfo(1,ifield,ng),r8)
3103 tlm(ng)%pioVar(ifield)%dkind=pio_fout
3104 tlm(ng)%pioVar(ifield)%gtype=r3dobc
3105!
3106 status=def_var(ng, model, tlm(ng)%pioFile, &
3107 & tlm(ng)%pioVar(ifield)%vd, &
3108 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
3109 & setfillval = .false.)
3110 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3111 END IF
3112 END DO
3113# endif
3114!
3115! Define density anomaly.
3116!
3117 IF (hout(iddano,ng)) THEN
3118 vinfo( 1)=vname(1,iddano)
3119 WRITE (vinfo( 2),40) trim(vname(2,iddano))
3120 vinfo( 3)=vname(3,iddano)
3121 vinfo(14)=vname(4,iddano)
3122 vinfo(16)=vname(1,idtime)
3123# if defined WRITE_WATER && defined MASKING
3124 vinfo(20)='mask_rho'
3125# endif
3126 vinfo(21)=vname(6,iddano)
3127 vinfo(22)='coordinates'
3128 aval(5)=real(iinfo(1,iddano,ng),r8)
3129 tlm(ng)%pioVar(iddano)%dkind=pio_fout
3130 tlm(ng)%pioVar(iddano)%gtype=r3dvar
3131!
3132 status=def_var(ng, model, tlm(ng)%pioFile, &
3133 & tlm(ng)%pioVar(iddano)%vd, &
3134 & pio_fout, nvd4, t3dgrd, aval, vinfo, ncname)
3135 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3136 END IF
3137
3138# if defined FORWARD_MIXING && \
3139 (defined bvf_mixing || defined gls_mixing || \
3140 defined lmd_mixing || defined my25_mixing)
3141!
3142! Define vertical viscosity coefficient.
3143!
3144 IF (hout(idvvis,ng)) THEN
3145 vinfo( 1)=vname(1,idvvis)
3146 WRITE (vinfo( 2),40) trim(vname(2,idvvis))
3147 vinfo( 3)=vname(3,idvvis)
3148 vinfo(14)=vname(4,idvvis)
3149 vinfo(16)=vname(1,idtime)
3150 vinfo(21)=vname(6,idvvis)
3151 vinfo(22)='coordinates'
3152 aval(5)=real(iinfo(1,idvvis,ng),r8)
3153 tlm(ng)%pioVar(idvvis)%dkind=pio_fout
3154 tlm(ng)%pioVar(idvvis)%gtype=w3dvar
3155!
3156 status=def_var(ng, model, tlm(ng)%pioFile, &
3157 & tlm(ng)%pioVar(idvvis)%vd, &
3158 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
3159 & setfillval = .false.)
3160 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3161 END IF
3162!
3163! Define vertical diffusion coefficient for potential temperature.
3164!
3165 IF (hout(idtdif,ng)) THEN
3166 vinfo( 1)=vname(1,idtdif)
3167 WRITE (vinfo( 2),40) trim(vname(2,idtdif))
3168 vinfo( 3)=vname(3,idtdif)
3169 vinfo(14)=vname(4,idtdif)
3170 vinfo(16)=vname(1,idtime)
3171 vinfo(21)=vname(6,idtdif)
3172 vinfo(22)='coordinates'
3173 aval(5)=real(iinfo(1,idtdif,ng),r8)
3174 tlm(ng)%pioVar(idtdif)%dkind=pio_fout
3175 tlm(ng)%pioVar(idtdif)%gtype=w3dvar
3176!
3177 status=def_var(ng, model, tlm(ng)%pioFile, &
3178 & tlm(ng)%pioVar(idtdif)%vd, &
3179 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
3180 & setfillval = .false.)
3181 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3182 END IF
3183
3184# ifdef SALINITY
3185!
3186! Define vertical diffusion coefficient for salinity.
3187!
3188 IF (hout(idsdif,ng)) THEN
3189 vinfo( 1)=vname(1,idsdif)
3190 WRITE (vinfo( 2),40) trim(vname(2,idsdif))
3191 vinfo( 3)=vname(3,idsdif)
3192 vinfo(14)=vname(4,idsdif)
3193 vinfo(16)=vname(1,idtime)
3194 vinfo(21)=vname(6,idsdif)
3195 vinfo(22)='coordinates'
3196 aval(5)=real(iinfo(1,idsdif,ng),r8)
3197 tlm(ng)%pioVar(idsdif)%dkind=pio_fout
3198 tlm(ng)%pioVar(idsdif)%gtype=w3dvar
3199!
3200 status=def_var(ng, model, tlm(ng)%pioFile, &
3201 & tlm(ng)%pioVar(idsdif)%vd, &
3202 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
3203 & setfillval = .false.)
3204 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3205 END IF
3206# endif
3207# if defined GLS_MIXING_NOT_YET || defined MY25_MIXING_NOT_YET
3208!
3209! Define turbulent kinetic energy.
3210!
3211 IF (hout(idmtke,ng)) THEN
3212 vinfo( 1)=vname(1,idmtke)
3213 WRITE (vinfo( 2),40) trim(vname(2,idmtke))
3214 vinfo( 3)=vname(3,idmtke)
3215 vinfo(14)=vname(4,idmtke)
3216 vinfo(16)=vname(1,idtime)
3217 vinfo(21)=vname(6,idmtke)
3218 vinfo(22)='coordinates'
3219 aval(5)=real(iinfo(1,idmtke,ng),r8)
3220 tlm(ng)%pioVar(idmtke)%dkind=pio_fout
3221 tlm(ng)%pioVar(idmtke)%gtype=w3dvar
3222!
3223 status=def_var(ng, model, tlm(ng)%pioFile, &
3224 & tlm(ng)%pioVar(idmtke)%vd, &
3225 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
3226 & setfillval = .false.)
3227 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3228!
3229 vinfo( 1)=vname(1,idvmkk)
3230 WRITE (vinfo( 2),40) trim(vname(2,idvmkk))
3231 vinfo( 3)=vname(3,idvmkk)
3232 vinfo(14)=vname(4,idvmkk)
3233 vinfo(16)=vname(1,idtime)
3234 vinfo(21)=vname(6,idvmkk)
3235# if defined WRITE_WATER && defined MASKING
3236 vinfo(20)='mask_rho'
3237# endif
3238 vinfo(22)='coordinates'
3239 aval(5)=real(iinfo(1,idvmkk,ng),r8)
3240 tlm(ng)%pioVar(idvmkk)%dkind=pio_fout
3241 tlm(ng)%pioVar(idvmkk)%gtype=w3dvar
3242!
3243 status=def_var(ng, model, tlm(ng)%pioFile, &
3244 & tlm(ng)%pioVar(idvmkk)%vd, &
3245 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname)
3246 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3247 END IF
3248!
3249! Define turbulent kinetic energy time length scale.
3250!
3251 IF (hout(idmtls,ng)) THEN
3252 vinfo( 1)=vname(1,idmtls)
3253 WRITE (vinfo( 2),40) trim(vname(2,idmtls))
3254 vinfo( 3)=vname(3,idmtls)
3255 vinfo(14)=vname(4,idmtls)
3256 vinfo(16)=vname(1,idtime)
3257 vinfo(21)=vname(6,idmtls)
3258 vinfo(22)='coordinates'
3259 aval(5)=real(iinfo(1,idmtls,ng),r8)
3260 tlm(ng)%pioVar(idmtls)%dkind=pio_fout
3261 tlm(ng)%pioVar(idmtls)%gtype=w3dvar
3262!
3263 status=def_var(ng, model, tlm(ng)%pioFile, &
3264 & tlm(ng)%pioVar(idmtls)%vd, &
3265 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
3266 & setfillval = .false.)
3267 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3268!
3269 vinfo( 1)=vname(1,idvmls)
3270 WRITE (vinfo( 2),40) trim(vname(2,idvmls))
3271 vinfo( 3)=vname(3,idvmls)
3272 vinfo(14)=vname(4,idvmls)
3273 vinfo(16)=vname(1,idtime)
3274# if defined WRITE_WATER && defined MASKING
3275 vinfo(20)='mask_rho'
3276# endif
3277 vinfo(21)=vname(6,idvmls)
3278 vinfo(22)='coordinates'
3279 aval(5)=real(iinfo(1,idvmls,ng),r8)
3280 tlm(ng)%pioVar(idvmls)%dkind=pio_fout
3281 tlm(ng)%pioVar(idvmls)%gtype=w3dvar
3282!
3283 status=def_var(ng, model, tlm(ng)%pioFile, &
3284 & tlm(ng)%pioVar(idvmls)%vd, &
3285 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname)
3286 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3287
3288# ifdef GLS_MIXING_NOT_YET
3289!
3290 vinfo( 1)=vname(1,idvmkp)
3291 WRITE (vinfo( 2),40) trim(vname(2,idvmkp))
3292 vinfo( 3)=vname(3,idvmkp)
3293 vinfo(14)=vname(4,idvmkp)
3294 vinfo(16)=vname(1,idtime)
3295# if defined WRITE_WATER && defined MASKING
3296 vinfo(20)='mask_rho'
3297# endif
3298 vinfo(21)=vname(6,idvmkp)
3299 vinfo(22)='coordinates'
3300 aval(5)=real(iinfo(1,idvmkp,ng),r8)
3301 tlm(ng)%pioVar(idvmkp)%dkind=pio_fout
3302 tlm(ng)%pioVar(idvmkp)%gtype=w3dvar
3303!
3304 status=def_var(ng, model, tlm(ng)%pioFile, &
3305 & tlm(ng)%pioVar(idvmkp), &
3306 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname)
3307 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3308# endif
3309 END IF
3310# endif
3311# endif
3312# endif
3313!
3314!-----------------------------------------------------------------------
3315! Leave definition mode.
3316!-----------------------------------------------------------------------
3317!
3318 CALL pio_netcdf_enddef (ng, model, ncname, tlm(ng)%pioFile)
3319 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3320!
3321!-----------------------------------------------------------------------
3322! Write out time-recordless, information variables.
3323!-----------------------------------------------------------------------
3324!
3325 CALL wrt_info (ng, model, tlm(ng)%pioFile, ncname)
3326 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3327 END IF define
3328!
3329!=======================================================================
3330! Open an existing tangent file, check its contents, and prepare for
3331! appending data.
3332!=======================================================================
3333!
3334 query : IF (.not.ldef) THEN
3335 ncname=tlm(ng)%name
3336!
3337! Open tangent linear history file for read/write.
3338!
3339 CALL pio_netcdf_open (ng, model, ncname, 1, tlm(ng)%pioFile)
3340 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
3341 WRITE (stdout,60) trim(ncname)
3342 RETURN
3343 END IF
3344!
3345! Inquire about the dimensions and check for consistency.
3346!
3347 CALL pio_netcdf_check_dim (ng, model, ncname, &
3348 & piofile = tlm(ng)%pioFile)
3349 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3350!
3351! Inquire about the variables.
3352!
3353 CALL pio_netcdf_inq_var (ng, model, ncname, &
3354 & piofile = tlm(ng)%pioFile)
3355 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3356!
3357! Initialize logical switches.
3358!
3359 DO i=1,nv
3360 got_var(i)=.false.
3361 END DO
3362!
3363! Scan variable list from input NetCDF and activate switches for
3364! tangent variables. Get variable IDs.
3365!
3366 DO i=1,n_var
3367 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
3368 got_var(idtime)=.true.
3369 tlm(ng)%pioVar(idtime)%vd=var_desc(i)
3370 tlm(ng)%pioVar(idtime)%dkind=pio_tout
3371 tlm(ng)%pioVar(idtime)%gtype=0
3372# ifdef SOLVE3D
3373 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idpthr))) THEN
3374 got_var(idpthr)=.true.
3375 tlm(ng)%pioVar(idpthr)%vd=var_desc(i)
3376 tlm(ng)%pioVar(idpthr)%dkind=pio_fout
3377 tlm(ng)%pioVar(idpthr)%gtype=r3dvar
3378 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idpthw))) THEN
3379 got_var(idpthw)=.true.
3380 tlm(ng)%pioVar(idpthw)%vd=var_desc(i)
3381 tlm(ng)%pioVar(idpthw)%dkind=pio_fout
3382 tlm(ng)%pioVar(idpthw)%gtype=w3dvar
3383# endif
3384 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
3385 got_var(idfsur)=.true.
3386 tlm(ng)%pioVar(idfsur)%vd=var_desc(i)
3387 tlm(ng)%pioVar(idfsur)%dkind=pio_fout
3388 tlm(ng)%pioVar(idfsur)%gtype=r2dvar
3389 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
3390 got_var(idubar)=.true.
3391 tlm(ng)%pioVar(idubar)%vd=var_desc(i)
3392 tlm(ng)%pioVar(idubar)%dkind=pio_fout
3393 tlm(ng)%pioVar(idubar)%gtype=u2dvar
3394 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
3395 got_var(idvbar)=.true.
3396 tlm(ng)%pioVar(idvbar)%vd=var_desc(i)
3397 tlm(ng)%pioVar(idvbar)%dkind=pio_fout
3398 tlm(ng)%pioVar(idvbar)%gtype=v2dvar
3399# ifdef ADJUST_BOUNDARY
3400 ELSE IF (trim(var_name(i)).eq. &
3401 & trim(vname(1,idsbry(isfsur)))) THEN
3402 got_var(idsbry(isfsur))=.true.
3403 tlm(ng)%pioVar(idsbry(isfsur))%vd=var_desc(i)
3404 tlm(ng)%pioVar(idsbry(isfsur))%dkind=pio_fout
3405 tlm(ng)%pioVar(idsbry(isfsur))%gtype=r2dobc
3406 ELSE IF (trim(var_name(i)).eq. &
3407 & trim(vname(1,idsbry(isubar)))) THEN
3408 got_var(idsbry(isubar))=.true.
3409 tlm(ng)%pioVar(idsbry(isubar))%vd=var_desc(i)
3410 tlm(ng)%pioVar(idsbry(isubar))%dkind=pio_fout
3411 tlm(ng)%pioVar(idsbry(isubar))%gtype=u2dobc
3412 ELSE IF (trim(var_name(i)).eq. &
3413 & trim(vname(1,idsbry(isvbar)))) THEN
3414 got_var(idsbry(isvbar))=.true.
3415 tlm(ng)%pioVar(idsbry(isvbar))%vd=var_desc(i)
3416 tlm(ng)%pioVar(idsbry(isvbar))%dkind=pio_fout
3417 tlm(ng)%pioVar(idsbry(isvbar))%gtype=v2dobc
3418# endif
3419# ifdef FORWARD_WRITE
3420# ifdef FORWARD_RHS
3421 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idrzet))) THEN
3422 got_var(idrzet)=.true.
3423 tlm(ng)%pioVar(idrzet)%vd=var_desc(i)
3424 tlm(ng)%pioVar(idrzet)%dkind=pio_fout
3425 tlm(ng)%pioVar(idrzet)%gtype=r2dvar
3426 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idru2d))) THEN
3427 got_var(idru2d)=.true.
3428 tlm(ng)%pioVar(idru2d)%vd=var_desc(i)
3429 tlm(ng)%pioVar(idru2d)%dkind=pio_fout
3430 tlm(ng)%pioVar(idru2d)%gtype=u2dvar
3431 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idrv2d))) THEN
3432 got_var(idrv2d)=.true.
3433 tlm(ng)%pioVar(idrv2d)%vd=var_desc(i)
3434 tlm(ng)%pioVar(idrv2d)%dkind=pio_fout
3435 tlm(ng)%pioVar(idrv2d)%gtype=v2dvar
3436# endif
3437# ifdef SOLVE3D
3438# ifdef FORWARD_RHS
3439 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idruct))) THEN
3440 got_var(idruct)=.true.
3441 tlm(ng)%pioVar(idruct)%vd=var_desc(i)
3442 tlm(ng)%pioVar(idruct)%dkind=pio_fout
3443 tlm(ng)%pioVar(idruct)%gtype=u2dvar
3444 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idrvct))) THEN
3445 got_var(idrvct)=.true.
3446 tlm(ng)%pioVar(idrvct)%vd=var_desc(i)
3447 tlm(ng)%pioVar(idrvct)%dkind=pio_fout
3448 tlm(ng)%pioVar(idrvct)%gtype=v2dvar
3449# endif
3450 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idufx1))) THEN
3451 got_var(idufx1)=.true.
3452 tlm(ng)%pioVar(idufx1)%vd=var_desc(i)
3453 tlm(ng)%pioVar(idufx1)%dkind=pio_fout
3454 tlm(ng)%pioVar(idufx1)%gtype=u2dvar
3455 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idufx2))) THEN
3456 got_var(idufx2)=.true.
3457 tlm(ng)%pioVar(idufx2)%vd=var_desc(i)
3458 tlm(ng)%pioVar(idufx2)%dkind=pio_fout
3459 tlm(ng)%pioVar(idufx2)%gtype=u2dvar
3460 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvfx1))) THEN
3461 got_var(idvfx1)=.true.
3462 tlm(ng)%pioVar(idvfx1)%vd=var_desc(i)
3463 tlm(ng)%pioVar(idvfx1)%dkind=pio_fout
3464 tlm(ng)%pioVar(idvfx1)%gtype=v2dvar
3465 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvfx2))) THEN
3466 got_var(idvfx2)=.true.
3467 tlm(ng)%pioVar(idvfx2)%vd=var_desc(i)
3468 tlm(ng)%pioVar(idvfx2)%dkind=pio_fout
3469 tlm(ng)%pioVar(idvfx2)%gtype=v2dvar
3470# ifdef FORWARD_RHS
3471 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idru3d))) THEN
3472 got_var(idru3d)=.true.
3473 tlm(ng)%pioVar(idru3d)%vd=var_desc(i)
3474 tlm(ng)%pioVar(idru3d)%dkind=pio_fout
3475 tlm(ng)%pioVar(idru3d)%gtype=u3dvar
3476 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idrv3d))) THEN
3477 got_var(idrv3d)=.true.
3478 tlm(ng)%pioVar(idrv3d)%vd=var_desc(i)
3479 tlm(ng)%pioVar(idrv3d)%dkind=pio_fout
3480 tlm(ng)%pioVar(idrv3d)%gtype=v3dvar
3481# endif
3482# endif
3483# endif
3484# ifdef SOLVE3D
3485 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
3486 got_var(iduvel)=.true.
3487 tlm(ng)%pioVar(iduvel)%vd=var_desc(i)
3488 tlm(ng)%pioVar(iduvel)%dkind=pio_fout
3489 tlm(ng)%pioVar(iduvel)%gtype=u3dvar
3490 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
3491 got_var(idvvel)=.true.
3492 tlm(ng)%pioVar(idvvel)%vd=var_desc(i)
3493 tlm(ng)%pioVar(idvvel)%dkind=pio_fout
3494 tlm(ng)%pioVar(idvvel)%gtype=v3dvar
3495# ifdef ADJUST_BOUNDARY
3496 ELSE IF (trim(var_name(i)).eq. &
3497 & trim(vname(1,idsbry(isuvel)))) THEN
3498 got_var(idsbry(isuvel))=.true.
3499 tlm(ng)%pioVar(idsbry(isuvel))%vd=var_desc(i)
3500 tlm(ng)%pioVar(idsbry(isuvel))%dkind=pio_fout
3501 tlm(ng)%pioVar(idsbry(isuvel))%gtype=u3dobc
3502 ELSE IF (trim(var_name(i)).eq. &
3503 & trim(vname(1,idsbry(isvvel)))) THEN
3504 got_var(idsbry(isvvel))=.true.
3505 tlm(ng)%pioVar(idsbry(isvvel))%vd=var_desc(i)
3506 tlm(ng)%pioVar(idsbry(isvvel))%dkind=pio_fout
3507 tlm(ng)%pioVar(idsbry(isvvel))%gtype=v3dobc
3508# endif
3509# ifdef UV_DESTAGGERED
3510 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idu3de))) THEN
3511 got_var(idu3de)=.true.
3512 tlm(ng)%pioVar(idu3de)%vd=var_desc(i)
3513 tlm(ng)%pioVar(idu3de)%dkind=pio_fout
3514 tlm(ng)%pioVar(idu3de)%gtype=r3dvar
3515 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idv3dn))) THEN
3516 got_var(idv3dn)=.true.
3517 tlm(ng)%pioVar(idv3dn)%vd=var_desc(i)
3518 tlm(ng)%pioVar(idv3dn)%dkind=pio_fout
3519 tlm(ng)%pioVar(idv3dn)%gtype=r3dvar
3520# endif
3521 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iddano))) THEN
3522 got_var(iddano)=.true.
3523 tlm(ng)%pioVar(iddano)%vd=var_desc(i)
3524 tlm(ng)%pioVar(iddano)%dkind=pio_fout
3525 tlm(ng)%pioVar(iddano)%gtype=r3dvar
3526# if defined FORWARD_MIXING && \
3527 (defined bvf_mixing || defined gls_mixing || \
3528 defined lmd_mixing || defined my25_mixing)
3529 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvis))) THEN
3530 got_var(idvvis)=.true.
3531 tlm(ng)%pioVar(idvvis)%vd=var_desc(i)
3532 tlm(ng)%pioVar(idvvis)%dkind=pio_fout
3533 tlm(ng)%pioVar(idvvis)%gtype=w3dvar
3534 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idtdif))) THEN
3535 got_var(idtdif)=.true.
3536 tlm(ng)%pioVar(idtdif)%vd=var_desc(i)
3537 tlm(ng)%pioVar(idtdif)%dkind=pio_fout
3538 tlm(ng)%pioVar(idtdif)%gtype=w3dvar
3539# ifdef SALINITY
3540 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idsdif))) THEN
3541 got_var(idsdif)=.true.
3542 tlm(ng)%pioVar(idsdif)%vd=var_desc(i)
3543 tlm(ng)%pioVar(idsdif)%dkind=pio_fout
3544 tlm(ng)%pioVar(idsdif)%gtype=w3dvar
3545# endif
3546# if defined GLS_MIXING_NOT_YET || defined MY25_MIXING_NOT_YET
3547 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idmtke))) THEN
3548 got_var(idmtke)=.true.
3549 tlm(ng)%pioVar(idmtke)%vd=var_desc(i)
3550 tlm(ng)%pioVar(idmtke)%dkind=pio_fout
3551 tlm(ng)%pioVar(idmtke)%gtype=w3dvar
3552 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvmkk))) THEN
3553 got_var(idvmkk)=.true.
3554 tlm(ng)%pioVar(idvmkk)%vd=var_desc(i)
3555 tlm(ng)%pioVar(idvmkk)%dkind=pio_fout
3556 tlm(ng)%pioVar(idvmkk)%gtype=w3dvar
3557 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idmtls))) THEN
3558 got_var(idmtls)=.true.
3559 tlm(ng)%pioVar(idmtls)%vd=var_desc(i)
3560 tlm(ng)%pioVar(idmtls)%dkind=pio_fout
3561 tlm(ng)%pioVar(idmtls)%gtype=w3dvar
3562 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvmls))) THEN
3563 got_var(idvmls)=.true.
3564 tlm(ng)%pioVar(idvmls)%vd=var_desc(i)
3565 tlm(ng)%pioVar(idvmls)%dkind=pio_fout
3566 tlm(ng)%pioVar(idvmls)%gtype=w3dvar
3567# ifdef GLS_MIXING_NOT_YET
3568 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvmkp))) THEN
3569 got_var(idvmkp)=.true.
3570 tlm(ng)%pioVar(idvmkp)%vd=var_desc(i)
3571 tlm(ng)%pioVar(idvmkp)%dkind=pio_fout
3572 tlm(ng)%pioVar(idvmkp)%gtype=w3dvar
3573# endif
3574# endif
3575# endif
3576# endif
3577# ifdef ADJUST_WSTRESS
3578 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
3579 got_var(idusms)=.true.
3580 tlm(ng)%pioVar(idusms)%vd=var_desc(i)
3581 tlm(ng)%pioVar(idusms)%dkind=pio_fout
3582 tlm(ng)%pioVar(idusms)%gtype=u2dvar
3583 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
3584 got_var(idvsms)=.true.
3585 tlm(ng)%pioVar(idvsms)%vd=var_desc(i)
3586 tlm(ng)%pioVar(idvsms)%dkind=pio_fout
3587 tlm(ng)%pioVar(idvsms)%gtype=v2dvar
3588# endif
3589 END IF
3590# ifdef SOLVE3D
3591 DO itrc=1,nt(ng)
3592 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
3593 got_var(idtvar(itrc))=.true.
3594 tlm(ng)%pioTrc(itrc)%vd=var_desc(i)
3595 tlm(ng)%pioTrc(itrc)%dkind=pio_fout
3596 tlm(ng)%pioTrc(itrc)%gtype=r3dvar
3597# ifdef ADJUST_BOUNDARY
3598 ELSE IF (trim(var_name(i)).eq. &
3599 & trim(vname(1,idsbry(istvar(itrc))))) THEN
3600 got_var(idsbry(istvar(itrc)))=.true.
3601 tlm(ng)%pioVar(idsbry(istvar(itrc)))%vd=var_desc(i)
3602 tlm(ng)%pioVar(idsbry(istvar(itrc)))%dkind=pio_fout
3603 tlm(ng)%pioVar(idsbry(istvar(itrc)))%gtype=r3dobc
3604# endif
3605# ifdef ADJUST_STFLUX
3606 ELSE IF (trim(var_name(i)).eq. &
3607 & trim(vname(1,idtsur(itrc)))) THEN
3608 got_var(idtsur(itrc))=.true.
3609 tlm(ng)%pioVar(idtsur(itrc))%vd=var_desc(i)
3610 tlm(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
3611 tlm(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
3612# endif
3613 END IF
3614 END DO
3615# endif
3616 END DO
3617!
3618! Check if tangent variables are available in input NetCDF file.
3619!
3620 IF (.not.got_var(idtime)) THEN
3621 IF (master) WRITE (stdout,70) trim(vname(1,idtime)), &
3622 & trim(ncname)
3623 exit_flag=3
3624 RETURN
3625 END IF
3626# ifdef SOLVE3D
3627 IF (.not.got_var(idpthr).and.hout(idpthr,ng)) THEN
3628 IF (master) WRITE (stdout,70) trim(vname(1,idpthr)), &
3629 & trim(ncname)
3630 exit_flag=3
3631 RETURN
3632 END IF
3633 IF (.not.got_var(idpthw).and.hout(idpthw,ng)) THEN
3634 IF (master) WRITE (stdout,70) trim(vname(1,idpthw)), &
3635 & trim(ncname)
3636 exit_flag=3
3637 RETURN
3638 END IF
3639# endif
3640 IF (.not.got_var(idfsur).and.hout(idfsur,ng)) THEN
3641 IF (master) WRITE (stdout,70) trim(vname(1,idfsur)), &
3642 & trim(ncname)
3643 exit_flag=3
3644 RETURN
3645 END IF
3646 IF (.not.got_var(idubar).and.hout(idubar,ng)) THEN
3647 IF (master) WRITE (stdout,70) trim(vname(1,idubar)), &
3648 & trim(ncname)
3649 exit_flag=3
3650 RETURN
3651 END IF
3652 IF (.not.got_var(idvbar).and.hout(idvbar,ng)) THEN
3653 IF (master) WRITE (stdout,70) trim(vname(1,idvbar)), &
3654 & trim(ncname)
3655 exit_flag=3
3656 RETURN
3657 END IF
3658# ifdef ADJUST_BOUNDARY
3659 IF (.not.got_var(idsbry(isfsur))) THEN
3660 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isfsur))), &
3661 & trim(ncname)
3662 exit_flag=3
3663 RETURN
3664 END IF
3665 IF (.not.got_var(idsbry(isubar))) THEN
3666 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isubar))), &
3667 & trim(ncname)
3668 exit_flag=3
3669 RETURN
3670 END IF
3671 IF (.not.got_var(idsbry(isvbar))) THEN
3672 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvbar))), &
3673 & trim(ncname)
3674 exit_flag=3
3675 RETURN
3676 END IF
3677# endif
3678# ifdef FORWARD_WRITE
3679# ifdef FORWARD_RHS
3680 IF (.not.got_var(idrzet)) THEN
3681 IF (master) WRITE (stdout,70) trim(vname(1,idrzet)), &
3682 & trim(ncname)
3683 exit_flag=3
3684 RETURN
3685 END IF
3686 IF (.not.got_var(idru2d)) THEN
3687 IF (master) WRITE (stdout,70) trim(vname(1,idru2d)), &
3688 & trim(ncname)
3689 exit_flag=3
3690 RETURN
3691 END IF
3692 IF (.not.got_var(idrv2d)) THEN
3693 IF (master) WRITE (stdout,70) trim(vname(1,idrv2d)), &
3694 & trim(ncname)
3695 exit_flag=3
3696 RETURN
3697 END IF
3698# endif
3699# ifdef SOLVE3D
3700# ifdef FORWARD_RHS
3701 IF (.not.got_var(idruct)) THEN
3702 IF (master) WRITE (stdout,70) trim(vname(1,idruct)), &
3703 & trim(ncname)
3704 exit_flag=3
3705 RETURN
3706 END IF
3707 IF (.not.got_var(idrvct)) THEN
3708 IF (master) WRITE (stdout,70) trim(vname(1,idrvct)), &
3709 & trim(ncname)
3710 exit_flag=3
3711 RETURN
3712 END IF
3713# endif
3714 IF (.not.got_var(idufx1)) THEN
3715 IF (master) WRITE (stdout,70) trim(vname(1,idufx1)), &
3716 & trim(ncname)
3717 exit_flag=3
3718 RETURN
3719 END IF
3720 IF (.not.got_var(idufx2)) THEN
3721 IF (master) WRITE (stdout,70) trim(vname(1,idufx2)), &
3722 & trim(ncname)
3723 exit_flag=3
3724 RETURN
3725 END IF
3726 IF (.not.got_var(idvfx1)) THEN
3727 IF (master) WRITE (stdout,70) trim(vname(1,idvfx1)), &
3728 & trim(ncname)
3729 exit_flag=3
3730 RETURN
3731 END IF
3732 IF (.not.got_var(idvfx2)) THEN
3733 IF (master) WRITE (stdout,70) trim(vname(1,idvfx2)), &
3734 & trim(ncname)
3735 exit_flag=3
3736 RETURN
3737 END IF
3738# ifdef FORWARD_RHS
3739 IF (.not.got_var(idru3d)) THEN
3740 IF (master) WRITE (stdout,70) trim(vname(1,idru3d)), &
3741 & trim(ncname)
3742 exit_flag=3
3743 RETURN
3744 END IF
3745 IF (.not.got_var(idrv3d)) THEN
3746 IF (master) WRITE (stdout,70) trim(vname(1,idrv3d)), &
3747 & trim(ncname)
3748 exit_flag=3
3749 RETURN
3750 END IF
3751# endif
3752# endif
3753# endif
3754# ifdef SOLVE3D
3755 IF (.not.got_var(iduvel).and.hout(iduvel,ng)) THEN
3756 IF (master) WRITE (stdout,70) trim(vname(1,iduvel)), &
3757 & trim(ncname)
3758 exit_flag=3
3759 RETURN
3760 END IF
3761 IF (.not.got_var(idvvel).and.hout(idvvel,ng)) THEN
3762 IF (master) WRITE (stdout,70) trim(vname(1,idvvel)), &
3763 & trim(ncname)
3764 exit_flag=3
3765 RETURN
3766 END IF
3767# ifdef ADJUST_BOUNDARY
3768 IF (.not.got_var(idsbry(isuvel))) THEN
3769 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isuvel))), &
3770 & trim(ncname)
3771 exit_flag=3
3772 RETURN
3773 END IF
3774 IF (.not.got_var(idsbry(isvvel))) THEN
3775 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvvel))), &
3776 & trim(ncname)
3777 exit_flag=3
3778 RETURN
3779 END IF
3780# endif
3781# ifdef UV_DESTAGGERED
3782 IF (.not.got_var(idu3de).and.hout(idu3de,ng)) THEN
3783 IF (master) WRITE (stdout,70) trim(vname(1,idu3de)), &
3784 & trim(ncname)
3785 exit_flag=3
3786 RETURN
3787 END IF
3788 IF (.not.got_var(idv3dn).and.hout(idv3dn,ng)) THEN
3789 IF (master) WRITE (stdout,70) trim(vname(1,idv3dn)), &
3790 & trim(ncname)
3791 exit_flag=3
3792 RETURN
3793 END IF
3794# endif
3795 IF (.not.got_var(iddano).and.hout(iddano,ng)) THEN
3796 IF (master) WRITE (stdout,70) trim(vname(1,iddano)), &
3797 & trim(ncname)
3798 exit_flag=3
3799 RETURN
3800 END IF
3801# if defined FORWARD_MIXING && \
3802 (defined bvf_mixing || defined gls_mixing || \
3803 defined lmd_mixing || defined my25_mixing)
3804 IF (.not.got_var(idvvis).and.hout(idvvis,ng)) THEN
3805 IF (master) WRITE (stdout,70) trim(vname(1,idvvis)), &
3806 & trim(ncname)
3807 exit_flag=3
3808 RETURN
3809 END IF
3810 IF (.not.got_var(idtdif).and.hout(idtdif,ng)) THEN
3811 IF (master) WRITE (stdout,70) trim(vname(1,idtdif)), &
3812 & trim(ncname)
3813 exit_flag=3
3814 RETURN
3815 END IF
3816# ifdef SALINITY
3817 IF (.not.got_var(idsdif).and.hout(idsdif,ng)) THEN
3818 IF (master) WRITE (stdout,70) trim(vname(1,idsdif)), &
3819 & trim(ncname)
3820 exit_flag=3
3821 RETURN
3822 END IF
3823# endif
3824# if defined GLS_MIXING_NOT_YET || defined MY25_MIXING_NOT_YET
3825 IF (.not.got_var(idmtke).and.hout(idmtke,ng)) THEN
3826 IF (master) WRITE (stdout,70) trim(vname(1,idmtke)), &
3827 & trim(ncname)
3828 exit_flag=3
3829 RETURN
3830 END IF
3831 IF (.not.got_var(idvmkk).and.hout(idvmkk,ng)) THEN
3832 IF (master) WRITE (stdout,70) trim(vname(1,idvmkk)), &
3833 & trim(ncname)
3834 exit_flag=3
3835 RETURN
3836 END IF
3837 IF (.not.got_var(idmtls).and.hout(idmtls,ng)) THEN
3838 IF (master) WRITE (stdout,70) trim(vname(1,idmtls)), &
3839 & trim(ncname)
3840 exit_flag=3
3841 RETURN
3842 END IF
3843 IF (.not.got_var(idvmls).and.hout(idvmls,ng)) THEN
3844 IF (master) WRITE (stdout,70) trim(vname(1,idvmls)), &
3845 & trim(ncname)
3846 exit_flag=3
3847 RETURN
3848 END IF
3849# ifdef GSL_MIXING
3850 IF (.not.got_var(idvmkp).and.hout(idvmkp,ng)) THEN
3851 IF (master) WRITE (stdout,70) trim(vname(1,idvmkp)), &
3852 & trim(ncname)
3853 exit_flag=3
3854 RETURN
3855 END IF
3856# endif
3857# endif
3858# endif
3859# endif
3860# ifdef ADJUST_WSTRESS
3861 IF (.not.got_var(idusms).and.hout(idusms,ng)) THEN
3862 IF (master) WRITE (stdout,70) trim(vname(1,idusms)), &
3863 & trim(ncname)
3864 exit_flag=3
3865 RETURN
3866 END IF
3867 IF (.not.got_var(idvsms).and.hout(idvsms,ng)) THEN
3868 IF (master) WRITE (stdout,70) trim(vname(1,idvsms)), &
3869 & trim(ncname)
3870 exit_flag=3
3871 RETURN
3872 END IF
3873# endif
3874# ifdef SOLVE3D
3875 DO itrc=1,nt(ng)
3876 IF (.not.got_var(idtvar(itrc)).and.hout(idtvar(itrc),ng)) THEN
3877 IF (master) WRITE (stdout,70) trim(vname(1,idtvar(itrc))), &
3878 & trim(ncname)
3879 exit_flag=3
3880 RETURN
3881 END IF
3882# ifdef ADJUST_BOUNDARY
3883 IF (.not.got_var(idsbry(istvar(itrc)))) THEN
3884 IF (master) WRITE (stdout,70) &
3885 & trim(vname(1,idsbry(istvar(itrc)))), &
3886 & trim(ncname)
3887 exit_flag=3
3888 RETURN
3889 END IF
3890# endif
3891# ifdef ADJUST_STFLUX
3892 IF (.not.got_var(idtsur(itrc)).and.hout(idtsur(itrc),ng).and. &
3893 & lstflux(itrc,ng)) THEN
3894 IF (master) WRITE (stdout,70) trim(vname(1,idtsur(itrc))), &
3895 & trim(ncname)
3896 exit_flag=3
3897 RETURN
3898 END IF
3899# endif
3900 END DO
3901# endif
3902!
3903! Set unlimited time record dimension to the appropriate value.
3904!
3905 IF (ndeftlm(ng).gt.0) THEN
3906 tlm(ng)%Rindex=((ntstart(ng)-1)- &
3907 & ndeftlm(ng)*((ntstart(ng)-1)/ndeftlm(ng)))/ &
3908 & ntlm(ng)
3909 ELSE
3910 tlm(ng)%Rindex=(ntstart(ng)-1)/ntlm(ng)
3911 END IF
3912 tlm(ng)%Rindex=min(tlm(ng)%Rindex,rec_size)
3913 END IF query
3914!
3915 10 FORMAT (2x,'TL_DEF_HIS_PIO - creating tangent file,',t56, &
3916 & 'Grid ',i2.2,': ',a)
3917 20 FORMAT (2x,'TL_DEF_HIS_PIO - inquiring tangent file,',t56, &
3918 & 'Grid ',i2.2,': ',a)
3919 30 FORMAT (/,' TL_DEF_HIS_PIO - unable to create tangent NetCDF', &
3920 & ' file: ',a)
3921 40 FORMAT ('tangent linear',1x,a)
3922 50 FORMAT (1pe11.4,1x,'millimeter')
3923 60 FORMAT (/,' TL_DEF_HIS_PIO - unable to open tangent NetCDF', &
3924 & ' file: ',a)
3925 70 FORMAT (/,' TL_DEF_HIS_PIO - unable to find variable: ',a,2x, &
3926 & ' in tangent NetCDF file: ',a)
3927!
3928 RETURN
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::pio_type
integer, parameter pio_type
Definition mod_pio_netcdf.F:579
mod_pio_netcdf::pio_fout
integer, parameter pio_fout
Definition mod_pio_netcdf.F:569
mod_pio_netcdf::var_desc
type(var_desc_t), dimension(:), pointer var_desc
Definition mod_pio_netcdf.F:437
mod_pio_netcdf::pio_netcdf_create
subroutine, public pio_netcdf_create(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:8997
mod_pio_netcdf::pio_netcdf_inq_var
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
Definition mod_pio_netcdf.F:1923
mod_pio_netcdf::pio_netcdf_open
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
Definition mod_pio_netcdf.F:9148
mod_pio_netcdf::pio_netcdf_check_dim
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:1080
mod_pio_netcdf::pio_tout
integer, parameter pio_tout
Definition mod_pio_netcdf.F:588
mod_pio_netcdf::pio_netcdf_enddef
subroutine, public pio_netcdf_enddef(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:9096

References mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::hout, mod_ncparam::iddano, mod_ncparam::idfsur, mod_ncparam::idmtke, mod_ncparam::idmtls, mod_ncparam::idpthr, mod_ncparam::idpthw, mod_ncparam::idru2d, mod_ncparam::idru3d, mod_ncparam::idruct, mod_ncparam::idrv2d, mod_ncparam::idrv3d, mod_ncparam::idrvct, mod_ncparam::idrzet, mod_ncparam::idsbry, mod_ncparam::idsdif, mod_sediment::idsed, mod_ncparam::idtdif, mod_ncparam::idtime, mod_ncparam::idtsur, mod_ncparam::idtvar, mod_ncparam::idu3de, mod_ncparam::idubar, mod_ncparam::idufx1, mod_ncparam::idufx2, mod_ncparam::idusms, mod_ncparam::iduvel, mod_ncparam::idv3dn, mod_ncparam::idvbar, mod_ncparam::idvfx1, mod_ncparam::idvfx2, mod_ncparam::idvmkk, mod_ncparam::idvmkp, mod_ncparam::idvmls, mod_ncparam::idvsms, mod_ncparam::idvvel, mod_ncparam::idvvis, mod_ncparam::iinfo, mod_param::inlm, mod_param::iobounds, mod_scalars::isalt, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::itemp, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_biology::nbac, mod_biology::nbands, mod_param::nbed, mod_scalars::nbrec, mod_scalars::ndeftlm, mod_biology::ndom, mod_biology::nfec, mod_scalars::nfrec, mod_scalars::noerror, mod_biology::nphy, mod_param::nst, mod_fourdvar::nstatevar, mod_param::nt, mod_scalars::ntlm, mod_scalars::ntstart, mod_ncparam::nv, mod_pio_netcdf::pio_fout, mod_pio_netcdf::pio_netcdf_check_dim(), mod_pio_netcdf::pio_netcdf_create(), mod_pio_netcdf::pio_netcdf_enddef(), mod_pio_netcdf::pio_netcdf_inq_var(), mod_pio_netcdf::pio_netcdf_open(), mod_pio_netcdf::pio_tout, mod_pio_netcdf::pio_type, mod_param::r2dobc, mod_param::r2dvar, mod_param::r3dobc, mod_param::r3dvar, mod_scalars::rclock, mod_sediment::sd50, mod_iounits::sourcefile, mod_iounits::stdout, mod_iounits::tlm, mod_param::u2dobc, mod_param::u2dvar, mod_param::u3dobc, mod_param::u3dvar, mod_param::v2dobc, mod_param::v2dvar, mod_param::v3dobc, mod_param::v3dvar, mod_pio_netcdf::var_desc, mod_ncparam::vname, and mod_param::w3dvar.

Referenced by tl_def_his().

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