ROMS
Loading...
Searching...
No Matches
tl_def_his.F
Go to the documentation of this file.
1#include "cppdefs.h"
3#if defined TANGENT || defined TL_IOMS
4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! This module creates tangent linear history file using either !
13! the standard NetCDF library or the Parallel-IO (PIO) library. !
14! It defines its dimensions, attributes, and variables. !
15! !
16!=======================================================================
17!
18 USE mod_param
19 USE mod_parallel
20# ifdef BIOLOGY
21 USE mod_biology
22# endif
23# ifdef FOUR_DVAR
24 USE mod_fourdvar
25# endif
26 USE mod_iounits
27 USE mod_ncparam
28 USE mod_scalars
29# if defined SEDIMENT_NOT_YET || defined BBL_MODEL_NOT_YET
30 USE mod_sediment
31# endif
32!
33 USE def_dim_mod, ONLY : def_dim
34 USE def_info_mod, ONLY : def_info
35 USE def_var_mod, ONLY : def_var
36 USE strings_mod, ONLY : founderror
37 USE wrt_info_mod, ONLY : wrt_info
38!
39 implicit none
40!
41 PUBLIC :: tl_def_his
42 PRIVATE :: tl_def_his_nf90
43#if defined PIO_LIB && defined DISTRIBUTE
44 PRIVATE :: tl_def_his_pio
45#endif
46!
47 CONTAINS
48!
49!***********************************************************************
50 SUBROUTINE tl_def_his (ng, ldef)
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
86 END SUBROUTINE tl_def_his
87!
88!***********************************************************************
89 SUBROUTINE tl_def_his_nf90 (ng, model, ldef)
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
1873 END SUBROUTINE tl_def_his_nf90
1874
1875# if defined PIO_LIB && defined DISTRIBUTE
1876!
1877!***********************************************************************
1878 SUBROUTINE tl_def_his_pio (ng, ldef)
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
3929 END SUBROUTINE tl_def_his_pio
3930# endif
3931#endif
3932 END MODULE tl_def_his_mod
3933
integer, parameter nfec
Definition ecosim_mod.h:204
integer, parameter nbac
Definition ecosim_mod.h:202
integer, parameter ndom
Definition ecosim_mod.h:203
integer, parameter nbands
Definition ecosim_mod.h:201
integer, parameter nphy
Definition ecosim_mod.h:205
integer, dimension(:), allocatable nstatevar
type(t_io), dimension(:), allocatable tlm
integer stdout
character(len=256) sourcefile
integer iddano
integer idvmls
logical, dimension(:,:), allocatable hout
integer, parameter io_nf90
Definition mod_ncparam.F:95
integer idrv3d
integer idubar
integer idvvel
integer idvsms
integer, parameter nv
integer idpthw
integer isvvel
integer, dimension(:), allocatable idsbry
integer, parameter io_pio
Definition mod_ncparam.F:96
integer isvbar
integer idsdif
integer idvfx2
integer, dimension(:), allocatable idtsur
integer idru2d
integer idvmkp
integer idtdif
integer idfsur
integer, dimension(:), allocatable idtvar
integer, dimension(:), allocatable istvar
integer idvfx1
integer isuvel
integer idufx2
integer isfsur
integer idmtke
integer iduvel
integer idv3dn
character(len=maxlen), dimension(6, 0:nv) vname
integer idtime
integer isubar
integer, dimension(:,:,:), allocatable iinfo
integer idru3d
integer idusms
integer idvmkk
integer, parameter ndimid
integer idvvis
integer idu3de
integer idrzet
integer idrvct
integer idufx1
integer idmtls
integer idruct
integer idpthr
integer idrv2d
integer idvbar
subroutine, public netcdf_check_dim(ng, model, ncname, ncid)
Definition mod_netcdf.F:538
subroutine, public netcdf_open(ng, model, ncname, omode, ncid)
integer, parameter nf_fout
Definition mod_netcdf.F:188
subroutine, public netcdf_enddef(ng, model, ncname, ncid)
character(len=100), dimension(mvars) var_name
Definition mod_netcdf.F:169
integer, dimension(mvars) var_id
Definition mod_netcdf.F:160
integer n_var
Definition mod_netcdf.F:152
integer, parameter nf_type
Definition mod_netcdf.F:198
integer rec_size
Definition mod_netcdf.F:156
subroutine, public netcdf_create(ng, model, ncname, ncid)
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)
logical master
integer, parameter u2dobc
Definition mod_param.F:729
integer, parameter v3dobc
Definition mod_param.F:733
integer, parameter inlm
Definition mod_param.F:662
integer nbed
Definition mod_param.F:517
integer, parameter r2dobc
Definition mod_param.F:728
integer, dimension(:), allocatable n
Definition mod_param.F:479
integer, parameter r3dvar
Definition mod_param.F:721
integer, parameter r3dobc
Definition mod_param.F:731
integer, parameter v2dobc
Definition mod_param.F:730
type(t_iobounds), dimension(:), allocatable iobounds
Definition mod_param.F:282
integer, parameter u3dobc
Definition mod_param.F:732
integer, parameter u3dvar
Definition mod_param.F:722
integer, parameter u2dvar
Definition mod_param.F:718
integer, parameter itlm
Definition mod_param.F:663
integer, parameter w3dvar
Definition mod_param.F:724
integer, dimension(:), allocatable nt
Definition mod_param.F:489
integer, parameter r2dvar
Definition mod_param.F:717
integer, parameter v2dvar
Definition mod_param.F:719
integer nst
Definition mod_param.F:521
integer, parameter v3dvar
Definition mod_param.F:723
integer, parameter pio_type
integer, parameter pio_fout
type(var_desc_t), dimension(:), pointer var_desc
subroutine, public pio_netcdf_create(ng, model, ncname, piofile)
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
integer, parameter pio_tout
subroutine, public pio_netcdf_enddef(ng, model, ncname, piofile)
integer, dimension(:), allocatable ntlm
logical, dimension(:,:,:), allocatable lobc
logical, dimension(:,:), allocatable lstflux
integer, dimension(:), allocatable nfrec
integer, dimension(:), allocatable ndeftlm
type(t_clock) rclock
integer exit_flag
integer isalt
integer itemp
integer, dimension(:), allocatable ntstart
integer, dimension(:), allocatable nbrec
integer noerror
integer, dimension(:), allocatable idsed
real(r8), dimension(:,:), allocatable sd50
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
subroutine, private tl_def_his_nf90(ng, model, ldef)
Definition tl_def_his.F:90
subroutine, public tl_def_his(ng, ldef)
Definition tl_def_his.F:51
subroutine, private tl_def_his_pio(ng, ldef)