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

Functions/Subroutines

subroutine, public ad_def_his (ng, ldef)
 
subroutine, private ad_def_his_nf90 (ng, model, ldef)
 
subroutine, private ad_def_his_pio (ng, model, ldef)
 

Function/Subroutine Documentation

◆ ad_def_his()

subroutine, public ad_def_his_mod::ad_def_his ( integer, intent(in) ng,
logical, intent(in) ldef )

Definition at line 50 of file ad_def_his.F.

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

References ad_def_his_nf90(), ad_def_his_pio(), mod_iounits::adm, mod_scalars::exit_flag, strings_mod::founderror(), mod_param::iadm, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_parallel::master, mod_scalars::noerror, and mod_iounits::stdout.

Referenced by ad_output(), r4dvar_mod::increment(), and rbl4dvar_mod::increment().

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

◆ ad_def_his_nf90()

subroutine, private ad_def_his_mod::ad_def_his_nf90 ( integer, intent(in) ng,
integer, intent(in) model,
logical, intent(in) ldef )
private

Definition at line 89 of file ad_def_his.F.

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

References mod_iounits::adm, mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::hout, mod_ncparam::idbath, mod_ncparam::iddano, mod_ncparam::idfsur, mod_ncparam::idovel, mod_ncparam::idpthr, mod_ncparam::idpthw, mod_ncparam::idsbry, mod_ncparam::idsdif, mod_sediment::idsed, mod_ncparam::idtdif, mod_ncparam::idtime, mod_ncparam::idtsur, mod_ncparam::idtvar, mod_ncparam::idu3de, mod_ncparam::idubar, mod_ncparam::idubms, mod_ncparam::idusms, mod_ncparam::iduvel, mod_ncparam::idv3dn, mod_ncparam::idvbar, mod_ncparam::idvbms, mod_ncparam::idvsms, mod_ncparam::idvvel, mod_ncparam::idvvis, mod_ncparam::iinfo, mod_param::inlm, mod_param::iobounds, mod_scalars::isalt, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::itemp, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_netcdf::n_var, mod_scalars::nadj, mod_biology::nbac, mod_biology::nbands, mod_param::nbed, mod_scalars::nbrec, mod_scalars::ndefadj, mod_biology::ndom, mod_netcdf::netcdf_check_dim(), mod_netcdf::netcdf_create(), mod_netcdf::netcdf_enddef(), mod_netcdf::netcdf_inq_var(), mod_netcdf::netcdf_open(), mod_netcdf::nf_fout, mod_netcdf::nf_frst, mod_netcdf::nf_tout, mod_netcdf::nf_type, mod_biology::nfec, mod_scalars::nfrec, mod_scalars::ninner, mod_scalars::noerror, mod_scalars::nouter, mod_biology::nphy, mod_param::nst, mod_fourdvar::nstatevar, mod_param::nt, mod_scalars::ntstart, mod_ncparam::nv, mod_param::r3dvar, mod_scalars::rclock, mod_netcdf::rec_size, mod_sediment::sd50, mod_iounits::sourcefile, mod_iounits::stdout, mod_netcdf::var_id, mod_netcdf::var_name, and mod_ncparam::vname.

Referenced by ad_def_his().

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

◆ ad_def_his_pio()

subroutine, private ad_def_his_mod::ad_def_his_pio ( integer, intent(in) ng,
model,
logical, intent(in) ldef )
private

Definition at line 1551 of file ad_def_his.F.

1552!***********************************************************************
1553!
1554 USE mod_pio_netcdf
1555!
1556! Imported variable declarations.
1557!
1558 integer, intent(in) :: ng
1559
1560 logical, intent(in) :: ldef
1561!
1562! Local variable declarations.
1563!
1564 logical :: got_var(NV)
1565!
1566 integer, parameter :: Natt = 25
1567
1568 integer :: i, j, ifield, itrc, nvd3, nvd4
1569 integer :: recdim, status, varid
1570 integer :: Fcount
1571# ifdef ADJUST_BOUNDARY
1572 integer :: IorJdim, brecdim
1573# endif
1574# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1575 integer :: frecdim
1576# endif
1577# if defined I4DVAR
1578 integer :: MinnerDim, NinnerDim, NouterDim
1579 integer :: vardim(2)
1580# endif
1581 integer :: DimIDs(nDimID)
1582 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
1583# ifdef ADJUST_BOUNDARY
1584 integer :: t2dobc(4)
1585# endif
1586# ifdef SOLVE3D
1587 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
1588# ifdef ADJUST_BOUNDARY
1589 integer :: t3dobc(5)
1590# endif
1591# ifdef ADJUST_STFLUX
1592 integer :: t3dfrc(4)
1593# endif
1594# endif
1595# ifdef ADJUST_WSTRESS
1596 integer :: u3dfrc(4), v3dfrc(4)
1597# endif
1598!
1599 real(r8) :: Aval(6)
1600!
1601 character (len=256) :: ncname
1602 character (len=MaxLen) :: Vinfo(Natt)
1603
1604 character (len=*), parameter :: MyFile = &
1605 & __FILE__//", ad_def_his_pio"
1606!
1607 TYPE (Var_desc_t) :: varDesc
1608!
1609 sourcefile=myfile
1610!
1611!-----------------------------------------------------------------------
1612! Set and report file name.
1613!-----------------------------------------------------------------------
1614!
1615 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1616 ncname=adm(ng)%name
1617!
1618 IF (master) THEN
1619 IF (ldef) THEN
1620 WRITE (stdout,10) ng, trim(ncname)
1621 ELSE
1622 WRITE (stdout,20) ng, trim(ncname)
1623 END IF
1624 END IF
1625!
1626!=======================================================================
1627! Create a new adjoint history file.
1628!=======================================================================
1629!
1630 define : IF (ldef) THEN
1631 CALL pio_netcdf_create (ng, model, trim(ncname), adm(ng)%pioFile)
1632 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1633 IF (master) WRITE (stdout,30) trim(ncname)
1634 RETURN
1635 END IF
1636!
1637!-----------------------------------------------------------------------
1638! Define file dimensions.
1639!-----------------------------------------------------------------------
1640!
1641 dimids=0
1642!
1643 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'xi_rho', &
1644 & iobounds(ng)%xi_rho, dimids( 1))
1645 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1646
1647 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'xi_u', &
1648 & iobounds(ng)%xi_u, dimids( 2))
1649 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1650
1651 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'xi_v', &
1652 & iobounds(ng)%xi_v, dimids( 3))
1653 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1654
1655 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'xi_psi', &
1656 & iobounds(ng)%xi_psi, dimids( 4))
1657 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1658
1659 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'eta_rho', &
1660 & iobounds(ng)%eta_rho, dimids( 5))
1661 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1662
1663 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'eta_u', &
1664 & iobounds(ng)%eta_u, dimids( 6))
1665 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1666
1667 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'eta_v', &
1668 & iobounds(ng)%eta_v, dimids( 7))
1669 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1670
1671 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'eta_psi', &
1672 & iobounds(ng)%eta_psi, dimids( 8))
1673 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1674
1675# ifdef ADJUST_BOUNDARY
1676 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'IorJ', &
1677 & iobounds(ng)%IorJ, iorjdim)
1678 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1679# endif
1680
1681# if defined WRITE_WATER && defined MASKING
1682 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'xy_rho', &
1683 & iobounds(ng)%xy_rho, dimids(17))
1684 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1685
1686 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'xy_u', &
1687 & iobounds(ng)%xy_u, dimids(18))
1688 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1689
1690 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'xy_v', &
1691 & iobounds(ng)%xy_v, dimids(19))
1692 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1693# endif
1694
1695# ifdef SOLVE3D
1696# if defined WRITE_WATER && defined MASKING
1697 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'xyz_rho', &
1698 & iobounds(ng)%xy_rho*n(ng), dimids(20))
1699 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1700
1701 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'xyz_u', &
1702 & iobounds(ng)%xy_u*n(ng), dimids(21))
1703 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1704
1705 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'xyz_v', &
1706 & iobounds(ng)%xy_v*n(ng), dimids(22))
1707 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1708
1709 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'xyz_w', &
1710 & iobounds(ng)%xy_rho*(n(ng)+1), dimids(23))
1711 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1712# endif
1713
1714 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'N', &
1715 & n(ng), dimids( 9))
1716 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1717
1718 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 's_rho', &
1719 & n(ng), dimids( 9))
1720 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1721
1722 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 's_w', &
1723 & n(ng)+1, dimids(10))
1724 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1725
1726 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'tracer', &
1727 & nt(ng), dimids(11))
1728 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1729
1730# ifdef SEDIMENT
1731 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'NST', &
1732 & nst, dimids(32))
1733 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1734
1735 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'Nbed', &
1736 & nbed, dimids(16))
1737 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1738
1739# if defined WRITE_WATER && defined MASKING
1740 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'xybed', &
1741 & iobounds(ng)%xy_rho*nbed, dimids(24))
1742 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1743# endif
1744# endif
1745
1746# ifdef ECOSIM
1747 status=def_dim(ng, inlm, adm(ng)%pioFile, ncname, 'Nbands', &
1748 & nbands, dimids(33))
1749 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1750
1751 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'Nphy', &
1752 & nphy, dimids(25))
1753 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1754
1755 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'Nbac', &
1756 & nbac, dimids(26))
1757 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1758
1759 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'Ndom', &
1760 & ndom, dimids(27))
1761 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1762
1763 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'Nfec', &
1764 & nfec, dimids(28))
1765 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1766# endif
1767# endif
1768
1769 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'boundary', &
1770 & 4, dimids(14))
1771 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1772
1773# ifdef FOUR_DVAR
1774 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'Nstate', &
1775 & nstatevar(ng), dimids(29))
1776 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1777# endif
1778
1779# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1780 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'frc_adjust',&
1781 & nfrec(ng), dimids(30))
1782 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1783# endif
1784
1785# ifdef ADJUST_BOUNDARY
1786 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'obc_adjust',&
1787 & nbrec(ng), dimids(31))
1788 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1789# endif
1790
1791# if defined I4DVAR
1792 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'Ninner', &
1793 & ninner, ninnerdim)
1794 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1795
1796 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'Minner', &
1797 & ninner+1, minnerdim)
1798 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1799
1800 status=def_dim(ng, model, adm(ng)%pioFile, ncname, 'Nouter', &
1801 & nouter, nouterdim)
1802 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1803# endif
1804
1805 status=def_dim(ng, model, adm(ng)%pioFile, ncname, &
1806 & trim(adjustl(vname(5,idtime))), &
1807 & pio_unlimited, dimids(12))
1808 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1809
1810 recdim=dimids(12)
1811# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1812 frecdim=dimids(30)
1813# endif
1814# ifdef ADJUST_BOUNDARY
1815 brecdim=dimids(31)
1816# endif
1817!
1818! Set number of dimensions for output variables.
1819!
1820# if defined WRITE_WATER && defined MASKING
1821 nvd3=2
1822 nvd4=2
1823# else
1824 nvd3=3
1825 nvd4=4
1826# endif
1827!
1828! Define dimension vectors for staggered tracer type variables.
1829!
1830# if defined WRITE_WATER && defined MASKING
1831 t2dgrd(1)=dimids(17)
1832 t2dgrd(2)=dimids(12)
1833# ifdef SOLVE3D
1834 t3dgrd(1)=dimids(20)
1835 t3dgrd(2)=dimids(12)
1836# endif
1837# else
1838 t2dgrd(1)=dimids( 1)
1839 t2dgrd(2)=dimids( 5)
1840 t2dgrd(3)=dimids(12)
1841# ifdef SOLVE3D
1842 t3dgrd(1)=dimids( 1)
1843 t3dgrd(2)=dimids( 5)
1844 t3dgrd(3)=dimids( 9)
1845 t3dgrd(4)=dimids(12)
1846# endif
1847# ifdef ADJUST_STFLUX
1848 t3dfrc(1)=dimids( 1)
1849 t3dfrc(2)=dimids( 5)
1850 t3dfrc(3)=frecdim
1851 t3dfrc(4)=dimids(12)
1852# endif
1853# endif
1854# ifdef ADJUST_BOUNDARY
1855 t2dobc(1)=iorjdim
1856 t2dobc(2)=dimids(14)
1857 t2dobc(3)=brecdim
1858 t2dobc(4)=dimids(12)
1859# ifdef SOLVE3D
1860 t3dobc(1)=iorjdim
1861 t3dobc(2)=dimids( 9)
1862 t3dobc(3)=dimids(14)
1863 t3dobc(4)=brecdim
1864 t3dobc(5)=dimids(12)
1865# endif
1866# endif
1867!
1868! Define dimension vectors for staggered u-momentum type variables.
1869!
1870# if defined WRITE_WATER && defined MASKING
1871 u2dgrd(1)=dimids(18)
1872 u2dgrd(2)=dimids(12)
1873# ifdef SOLVE3D
1874 u3dgrd(1)=dimids(21)
1875 u3dgrd(2)=dimids(12)
1876# endif
1877# else
1878 u2dgrd(1)=dimids( 2)
1879 u2dgrd(2)=dimids( 6)
1880 u2dgrd(3)=dimids(12)
1881# ifdef SOLVE3D
1882 u3dgrd(1)=dimids( 2)
1883 u3dgrd(2)=dimids( 6)
1884 u3dgrd(3)=dimids( 9)
1885 u3dgrd(4)=dimids(12)
1886# endif
1887# ifdef ADJUST_WSTRESS
1888 u3dfrc(1)=dimids( 2)
1889 u3dfrc(2)=dimids( 6)
1890 u3dfrc(3)=frecdim
1891 u3dfrc(4)=dimids(12)
1892# endif
1893# endif
1894!
1895! Define dimension vectors for staggered v-momentum type variables.
1896!
1897# if defined WRITE_WATER && defined MASKING
1898 v2dgrd(1)=dimids(19)
1899 v2dgrd(2)=dimids(12)
1900# ifdef SOLVE3D
1901 v3dgrd(1)=dimids(22)
1902 v3dgrd(2)=dimids(12)
1903# endif
1904# else
1905 v2dgrd(1)=dimids( 3)
1906 v2dgrd(2)=dimids( 7)
1907 v2dgrd(3)=dimids(12)
1908# ifdef SOLVE3D
1909 v3dgrd(1)=dimids( 3)
1910 v3dgrd(2)=dimids( 7)
1911 v3dgrd(3)=dimids( 9)
1912 v3dgrd(4)=dimids(12)
1913# endif
1914# ifdef ADJUST_WSTRESS
1915 v3dfrc(1)=dimids( 3)
1916 v3dfrc(2)=dimids( 7)
1917 v3dfrc(3)=frecdim
1918 v3dfrc(4)=dimids(12)
1919# endif
1920# endif
1921# ifdef SOLVE3D
1922!
1923! Define dimension vector for staggered w-momentum type variables.
1924!
1925# if defined WRITE_WATER && defined MASKING
1926 w3dgrd(1)=dimids(23)
1927 w3dgrd(2)=dimids(12)
1928# else
1929 w3dgrd(1)=dimids( 1)
1930 w3dgrd(2)=dimids( 5)
1931 w3dgrd(3)=dimids(10)
1932 w3dgrd(4)=dimids(12)
1933# endif
1934# endif
1935!
1936! Initialize unlimited time record dimension.
1937!
1938 adm(ng)%Rindex=0
1939!
1940! Initialize local information variable arrays.
1941!
1942 DO i=1,natt
1943 DO j=1,len(vinfo(1))
1944 vinfo(i)(j:j)=' '
1945 END DO
1946 END DO
1947 DO i=1,6
1948 aval(i)=0.0_r8
1949 END DO
1950!
1951!-----------------------------------------------------------------------
1952! Define time-recordless information variables.
1953!-----------------------------------------------------------------------
1954!
1955 CALL def_info (ng, model, adm(ng)%pioFile, ncname, dimids)
1956 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1957!
1958!-----------------------------------------------------------------------
1959! Define time-varying variables.
1960!-----------------------------------------------------------------------
1961!
1962! Define model time.
1963!
1964 vinfo( 1)=vname(1,idtime)
1965 vinfo( 2)=vname(2,idtime)
1966 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
1967 vinfo( 4)=trim(rclock%calendar)
1968 vinfo(14)=vname(4,idtime)
1969 vinfo(21)=vname(6,idtime)
1970 adm(ng)%pioVar(idtime)%dkind=pio_tout
1971 adm(ng)%pioVar(idtime)%gtype=0
1972!
1973 status=def_var(ng, model, adm(ng)%pioFile, &
1974 & adm(ng)%pioVar(idtime)%vd, &
1975 & pio_tout, 1, (/recdim/), aval, vinfo, ncname, &
1976 & setparaccess = .false.)
1977 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1978
1979# ifdef PROPAGATOR
1980!
1981! Define Ritz eigenvalues and Ritz eigenvectors Euclidean norm.
1982!
1983 vinfo( 1)='Ritz_rvalue'
1984 vinfo( 2)='real Ritz eigenvalues'
1985 status=def_var(ng, model, adm(ng)%pioFile, vardesc, pio_type, &
1986 & 1, (/recdim/), aval, vinfo, ncname, &
1987 & setparaccess = .false.)
1988 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1989!
1990# if defined AFT_EIGENMODES
1991 vinfo( 1)='Ritz_ivalue'
1992 vinfo( 2)='imaginary Ritz eigenvalues'
1993 status=def_var(ng, model, adm(ng)%pioFile, vardesc, pio_type, &
1994 & 1, (/recdim/), aval, vinfo, ncname, &
1995 & setparaccess = .false.)
1996 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1997!
1998# endif
1999
2000 vinfo( 1)='Ritz_norm'
2001 vinfo( 2)='Ritz eigenvectors Euclidean norm'
2002 status=def_var(ng, model, adm(ng)%pioFile, vardesc, pio_type, &
2003 & 1, (/recdim/), aval, vinfo, ncname, &
2004 & setparaccess = .false.)
2005 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2006# endif
2007# if defined I4DVAR
2008!
2009! Define Lanczos algorithm coefficients which can be used to
2010! compute the sensitivity of the observations to the 4DVAR
2011! data assimilation system.
2012!
2013 vinfo( 1)='cg_beta'
2014 vinfo( 2)='conjugate gradient beta coefficient'
2015 vardim(1)=minnerdim
2016 vardim(2)=nouterdim
2017 status=def_var(ng, model, adm(ng)%pioFile, vardesc, pio_frst, &
2018 & 2, vardim, aval, vinfo, ncname, &
2019 & setparaccess = .false.)
2020 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2021!
2022 vinfo( 1)='cg_delta'
2023 vinfo( 2)='Lanczos algorithm delta coefficient'
2024 vardim(1)=ninnerdim
2025 vardim(2)=nouterdim
2026 status=def_var(ng, model, adm(ng)%pioFile, vardesc, pio_frst, &
2027 & 2, vardim, aval, vinfo, ncname, &
2028 & setparaccess = .false.)
2029 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2030!
2031 vinfo( 1)='cg_zv'
2032 vinfo( 2)='Lanczos recurrence eigenvectors'
2033 vardim(1)=ninnerdim
2034 vardim(2)=ninnerdim
2035 status=def_var(ng, model, adm(ng)%pioFile, vardesc, pio_frst, &
2036 & 2, vardim, aval, vinfo, ncname, &
2037 & setparaccess = .false.)
2038 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2039# endif
2040# ifdef ADJUST_WSTRESS
2041!
2042! Define surface U-momentum stress. Notice that the stress has its
2043! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
2044! at other times in addition to initialization time.
2045!
2046 vinfo( 1)=vname(1,idusms)
2047 WRITE (vinfo( 2),40) trim(vname(2,idusms))
2048 vinfo( 3)='meter2 second-2'
2049 vinfo(16)=vname(1,idtime)
2050# if defined WRITE_WATER && defined MASKING
2051 vinfo(20)='mask_u'
2052# endif
2053 vinfo(22)='coordinates'
2054 aval(5)=real(iinfo(1,idusms,ng),r8)
2055 adm(ng)%pioVar(idusms)%dkind=pio_fout
2056 adm(ng)%pioVar(idusms)%gtype=u2dvar
2057!
2058 status=def_var(ng, model, adm(ng)%pioFile, &
2059 & adm(ng)%pioVar(idusms)%vd, &
2060 & pio_fout, nvd4, u3dfrc, aval, vinfo, ncname)
2061 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2062!
2063! Define surface V-momentum stress.
2064!
2065 vinfo( 1)=vname(1,idvsms)
2066 WRITE (vinfo( 2),40) trim(vname(2,idvsms))
2067 vinfo( 3)='meter2 second-2'
2068 vinfo(16)=vname(1,idtime)
2069# if defined WRITE_WATER && defined MASKING
2070 vinfo(20)='mask_v'
2071# endif
2072 vinfo(22)='coordinates'
2073 aval(5)=real(iinfo(1,idvsms,ng),r8)
2074 adm(ng)%pioVar(idvsms)%dkind=pio_fout
2075 adm(ng)%pioVar(idvsms)%gtype=v2dvar
2076!
2077 status=def_var(ng, model, adm(ng)%pioFile, &
2078 & adm(ng)%pioVar(idvsms)%vd, &
2079 & pio_fout, nvd4, v3dfrc, aval, vinfo, ncname)
2080 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2081# endif
2082# if defined ADJUST_STFLUX && defined SOLVE3D
2083!
2084! Define surface net heat flux. Notice that different tracer fluxes
2085! are written at their own fixed time-dimension (of size Nfrec) to
2086! allow 4DVAR adjustments at other times in addition to initial time.
2087!
2088 DO itrc=1,nt(ng)
2089 IF (lstflux(itrc,ng)) THEN
2090 vinfo( 1)=vname(1,idtsur(itrc))
2091 WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
2092 IF (itrc.eq.itemp) THEN
2093 vinfo( 3)='Celsius meter second-1'
2094 vinfo(11)='upward flux, cooling'
2095 vinfo(12)='downward flux, heating'
2096 ELSE IF (itrc.eq.isalt) THEN
2097 vinfo( 3)='meter second-1'
2098 vinfo(11)='upward flux, freshening (net precipitation)'
2099 vinfo(12)='downward flux, salting (net evaporation)'
2100 END IF
2101 vinfo(16)=vname(1,idtime)
2102# if defined WRITE_WATER && defined MASKING
2103 vinfo(20)='mask_rho'
2104# endif
2105 vinfo(22)='coordinates'
2106 aval(5)=real(iinfo(1,idtsur(itrc),ng),r8)
2107 adm(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
2108 adm(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
2109!
2110 status=def_var(ng, model, adm(ng)%pioFile, &
2111 & adm(ng)%pioVar(idtsur(itrc))%vd, &
2112 & pio_fout, nvd4, t3dfrc, aval, vinfo, ncname)
2113 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2114 END IF
2115 END DO
2116# endif
2117!
2118! Define bathymetry.
2119!
2120 IF (hout(idbath,ng)) THEN
2121 vinfo( 1)=vname(1,idbath)
2122 WRITE (vinfo( 2),40) trim(vname(2,idbath))
2123 vinfo( 3)='meter-1'
2124 vinfo(14)=vname(4,idbath)
2125 vinfo(16)=vname(1,idtime)
2126 vinfo(21)=vname(6,idbath)
2127 vinfo(22)='coordinates'
2128 aval(5)=real(iinfo(1,idbath,ng),r8)
2129 adm(ng)%pioVar(idbath)%dkind=pio_fout
2130 adm(ng)%pioVar(idbath)%gtype=r2dvar
2131!
2132 status=def_var(ng, model, adm(ng)%pioFile, &
2133 & adm(ng)%pioVar(idbath)%vd, &
2134 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname, &
2135 & setfillval = .false.)
2136 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2137 END IF
2138
2139# ifdef SOLVE3D
2140!
2141! Define time-varying depth of RHO-points.
2142!
2143 IF (hout(idpthr,ng)) THEN
2144 vinfo( 1)=vname(1,idpthr)
2145 WRITE (vinfo( 2),40) trim(vname(2,idpthr))
2146 vinfo( 3)=vname(3,idpthr)
2147 vinfo(14)=vname(4,idpthr)
2148 vinfo(16)=vname(1,idtime)
2149# if defined WRITE_WATER && defined MASKING
2150 vinfo(20)='mask_rho'
2151# endif
2152 vinfo(21)=vname(6,idpthr)
2153 vinfo(22)='coordinates'
2154 aval(5)=real(iinfo(1,idpthr,ng),r8)
2155 adm(ng)%pioVar(idpthr)%dkind=pio_fout
2156 adm(ng)%pioVar(idpthr)%gtype=r3dvar
2157!
2158 status=def_var(ng, model, adm(ng)%pioFile, &
2159 & adm(ng)%pioVar(idpthr)%vd, &
2160 & pio_fout, nvd4, t3dgrd, aval, vinfo, ncname, &
2161 & setfillval = .false.)
2162 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2163 END IF
2164!
2165! Define time-varying depth of W-points.
2166!
2167 IF (hout(idpthw,ng)) THEN
2168 vinfo( 1)=vname(1,idpthw)
2169 WRITE (vinfo( 2),40) trim(vname(2,idpthw))
2170 vinfo( 3)=vname(3,idpthw)
2171 vinfo(14)=vname(4,idpthw)
2172 vinfo(16)=vname(1,idtime)
2173# if defined WRITE_WATER && defined MASKING
2174 vinfo(20)='mask_rho'
2175# endif
2176 vinfo(21)=vname(6,idpthw)
2177 vinfo(22)='coordinates'
2178 aval(5)=real(iinfo(1,idpthw,ng),r8)
2179 adm(ng)%pioVar(idpthw)%dkind=pio_fout
2180 adm(ng)%pioVar(idpthw)%gtype=w3dvar
2181!
2182 status=def_var(ng, model, adm(ng)%pioFile, &
2183 & adm(ng)%pioVar(idpthw)%vd, &
2184 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
2185 & setfillval = .false.)
2186 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2187 END IF
2188# endif
2189!
2190! Define free-surface.
2191!
2192 IF (hout(idfsur,ng)) THEN
2193 vinfo( 1)=vname(1,idfsur)
2194 WRITE (vinfo( 2),40) trim(vname(2,idfsur))
2195 vinfo( 3)='meter-1'
2196 vinfo(14)=vname(4,idfsur)
2197 vinfo(16)=vname(1,idtime)
2198# if !defined WET_DRY && (defined WRITE_WATER && defined MASKING)
2199 vinfo(20)='mask_rho'
2200# endif
2201 vinfo(21)=vname(6,idfsur)
2202 vinfo(22)='coordinates'
2203 aval(5)=real(iinfo(1,idfsur,ng),r8)
2204 adm(ng)%pioVar(idfsur)%dkind=pio_fout
2205 adm(ng)%pioVar(idfsur)%gtype=r2dvar
2206!
2207 status=def_var(ng, model, adm(ng)%pioFile, &
2208 & adm(ng)%pioVar(idfsur)%vd, &
2209# ifdef WET_DRY
2210 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname, &
2211 & setfillval = .false.)
2212# else
2213 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
2214# endif
2215 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2216 END IF
2217
2218# ifdef ADJUST_BOUNDARY
2219!
2220! Define free-surface open boundaries.
2221!
2222 IF (any(lobc(:,isfsur,ng))) THEN
2223 ifield=idsbry(isfsur)
2224 vinfo( 1)=vname(1,ifield)
2225 WRITE (vinfo( 2),40) trim(vname(2,ifield))
2226 vinfo( 3)='meter-1'
2227 vinfo(14)=vname(4,ifield)
2228 vinfo(16)=vname(1,idtime)
2229 vinfo(21)=vname(6,ifield)
2230 aval(5)=real(iinfo(1,ifield,ng),r8)
2231 adm(ng)%pioVar(ifield)%dkind=pio_fout
2232 adm(ng)%pioVar(ifield)%gtype=r2dobc
2233!
2234 status=def_var(ng, model, adm(ng)%pioFile, &
2235 & adm(ng)%pioVar(ifield)%vd, &
2236 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
2237 & setfillval = .false.)
2238 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2239 END IF
2240# endif
2241!
2242! Define 2D U-momentum component.
2243!
2244 IF (hout(idubar,ng)) THEN
2245 vinfo( 1)=vname(1,idubar)
2246 WRITE (vinfo( 2),40) trim(vname(2,idubar))
2247 vinfo( 3)='second meter-1'
2248 vinfo(14)=vname(4,idubar)
2249 vinfo(16)=vname(1,idtime)
2250# if defined WRITE_WATER && defined MASKING
2251 vinfo(20)='mask_u'
2252# endif
2253 vinfo(21)=vname(6,idubar)
2254 vinfo(22)='coordinates'
2255 aval(5)=real(iinfo(1,idubar,ng),r8)
2256 adm(ng)%pioVar(idubar)%dkind=pio_fout
2257 adm(ng)%pioVar(idubar)%gtype=u2dvar
2258!
2259 status=def_var(ng, model, adm(ng)%pioFile, &
2260 & adm(ng)%pioVar(idubar)%vd, &
2261 & pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
2262 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2263 END IF
2264
2265# ifdef ADJUST_BOUNDARY
2266!
2267! Define 2D U-momentum component open boundaries.
2268!
2269 IF (any(lobc(:,isubar,ng))) THEN
2270 ifield=idsbry(isubar)
2271 vinfo( 1)=vname(1,ifield)
2272 WRITE (vinfo( 2),40) trim(vname(2,ifield))
2273 vinfo( 3)='second meter-1'
2274 vinfo(14)=vname(4,ifield)
2275 vinfo(16)=vname(1,idtime)
2276 vinfo(21)=vname(6,ifield)
2277 aval(5)=real(iinfo(1,ifield,ng),r8)
2278 adm(ng)%pioVar(ifield)%dkind=pio_fout
2279 adm(ng)%pioVar(ifield)%gtype=u2dobc
2280!
2281 status=def_var(ng, model, adm(ng)%pioFile, &
2282 & adm(ng)%pioVar(ifield)%vd, &
2283 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
2284 & setfillval = .false.)
2285 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2286 END IF
2287# endif
2288!
2289! Define 2D V-momentum component.
2290!
2291 IF (hout(idvbar,ng)) THEN
2292 vinfo( 1)=vname(1,idvbar)
2293 WRITE (vinfo( 2),40) trim(vname(2,idvbar))
2294 vinfo( 3)='second meter-1'
2295 vinfo(14)=vname(4,idvbar)
2296 vinfo(16)=vname(1,idtime)
2297# if defined WRITE_WATER && defined MASKING
2298 vinfo(20)='mask_v'
2299# endif
2300 vinfo(21)=vname(6,idvbar)
2301 vinfo(22)='coordinates'
2302 aval(5)=real(iinfo(1,idvbar,ng),r8)
2303 adm(ng)%pioVar(idvbar)%dkind=pio_fout
2304 adm(ng)%pioVar(idvbar)%gtype=v2dvar
2305!
2306 status=def_var(ng, model, adm(ng)%pioFile, &
2307 & adm(ng)%pioVar(idvbar)%vd, &
2308 & pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
2309 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2310 END IF
2311
2312# ifdef ADJUST_BOUNDARY
2313!
2314! Define 2D V-momentum component open boundaries.
2315!
2316 IF (any(lobc(:,isvbar,ng))) THEN
2317 ifield=idsbry(isvbar)
2318 vinfo( 1)=vname(1,ifield)
2319 WRITE (vinfo( 2),40) trim(vname(2,ifield))
2320 vinfo( 3)='second meter-1'
2321 vinfo(14)=vname(4,ifield)
2322 vinfo(16)=vname(1,idtime)
2323 vinfo(21)=vname(6,ifield)
2324 aval(5)=real(iinfo(1,ifield,ng),r8)
2325 adm(ng)%pioVar(ifield)%dkind=pio_fout
2326 adm(ng)%pioVar(ifield)%gtype=v2dobc
2327!
2328 status=def_var(ng, model, adm(ng)%pioFile, &
2329 & adm(ng)%pioVar(ifield)%vd, &
2330 & pio_fout, 4, t2dobc, aval, vinfo, ncname, &
2331 & setfillval = .false.)
2332 IF (founderror(exit_flag, noerror,__line__, myfile)) RETURN
2333 END IF
2334# endif
2335# ifdef SOLVE3D
2336!
2337! Define 3D U-momentum component.
2338!
2339 IF (hout(iduvel,ng)) THEN
2340 vinfo( 1)=vname(1,iduvel)
2341 WRITE (vinfo( 2),40) trim(vname(2,iduvel))
2342 vinfo( 3)='second meter-1'
2343 vinfo(14)=vname(4,iduvel)
2344 vinfo(16)=vname(1,idtime)
2345# if defined WRITE_WATER && defined MASKING
2346 vinfo(20)='mask_u'
2347# endif
2348 vinfo(21)=vname(6,iduvel)
2349 vinfo(22)='coordinates'
2350 aval(5)=real(iinfo(1,iduvel,ng),r8)
2351 adm(ng)%pioVar(iduvel)%dkind=pio_fout
2352 adm(ng)%pioVar(iduvel)%gtype=u3dvar
2353!
2354 status=def_var(ng, model, adm(ng)%pioFile, &
2355 & adm(ng)%pioVar(iduvel)%vd, &
2356 & pio_fout, nvd4, u3dgrd, aval, vinfo, ncname)
2357 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2358 END IF
2359
2360# ifdef ADJUST_BOUNDARY
2361!
2362! Define 3D U-momentum component open boundaries.
2363!
2364 IF (any(lobc(:,isuvel,ng))) THEN
2365 ifield=idsbry(isuvel)
2366 vinfo( 1)=vname(1,ifield)
2367 WRITE (vinfo( 2),40) trim(vname(2,ifield))
2368 vinfo( 3)='second meter-1'
2369 vinfo(14)=vname(4,ifield)
2370 vinfo(16)=vname(1,idtime)
2371 vinfo(21)=vname(6,ifield)
2372 aval(5)=real(iinfo(1,ifield,ng),r8)
2373 adm(ng)%pioVar(ifield)%dkind=pio_fout
2374 adm(ng)%pioVar(ifield)%gtype=u3dobc
2375!
2376 status=def_var(ng, model, adm(ng)%pioFile, &
2377 & adm(ng)%pioVar(ifield)%vd, &
2378 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
2379 & setfillval = .false.)
2380 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2381 END IF
2382# endif
2383!
2384! Define 3D V-momentum component.
2385!
2386 IF (hout(idvvel,ng)) THEN
2387 vinfo( 1)=vname(1,idvvel)
2388 WRITE (vinfo( 2),40) trim(vname(2,idvvel))
2389 vinfo( 3)='second meter-1'
2390 vinfo(14)=vname(4,idvvel)
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,idvvel)
2396 vinfo(22)='coordinates'
2397 aval(5)=real(iinfo(1,idvvel,ng),r8)
2398 adm(ng)%pioVar(idvvel)%dkind=pio_fout
2399 adm(ng)%pioVar(idvvel)%gtype=v3dvar
2400!
2401 status=def_var(ng, model, adm(ng)%pioFile, &
2402 & adm(ng)%pioVar(idvvel)%vd, &
2403 & pio_fout, nvd4, v3dgrd, aval, vinfo, ncname)
2404 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2405 END IF
2406
2407# ifdef ADJUST_BOUNDARY
2408!
2409! Define 3D V-momentum component open boundaries.
2410!
2411 IF (any(lobc(:,isvvel,ng))) THEN
2412 ifield=idsbry(isvvel)
2413 vinfo( 1)=vname(1,ifield)
2414 WRITE (vinfo( 2),40) trim(vname(2,ifield))
2415 vinfo( 3)='second meter-1'
2416 vinfo(14)=vname(4,ifield)
2417 vinfo(16)=vname(1,idtime)
2418 vinfo(21)=vname(6,ifield)
2419 aval(5)=real(iinfo(1,ifield,ng),r8)
2420 adm(ng)%pioVar(ifield)%dkind=pio_fout
2421 adm(ng)%pioVar(ifield)%gtype=v3dvar
2422!
2423 status=def_var(ng, model, adm(ng)%pioFile, &
2424 & adm(ng)%pioVar(ifield)%vd, &
2425 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
2426 & setfillval = .false.)
2427 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2428 END IF
2429# endif
2430# ifdef UV_DESTAGGERED
2431!
2432! Define 3D Eastward momentum at RHO-points, A-grid.
2433!
2434 IF (hout(idu3de,ng)) THEN
2435 vinfo( 1)=vname(1,idu3de)
2436 vinfo( 2)=vname(2,idu3de)
2437 vinfo( 3)=vname(3,idu3de)
2438 vinfo(14)=vname(4,idu3de)
2439 vinfo(16)=vname(1,idtime)
2440# if defined WRITE_WATER && defined MASKING
2441 vinfo(20)='mask_rho'
2442# endif
2443 vinfo(21)=vname(6,idu3de)
2444 vinfo(22)='coordinates'
2445 aval(5)=real(iinfo(1,idu3de,ng),r8)
2446 adm(ng)%pioVar(idu3de)%dkind=pio_fout
2447 adm(ng)%pioVar(idu3de)%gtype=r3dvar
2448!
2449 status=def_var(ng, model, adm(ng)%pioFile, &
2450 & adm(ng)%pioVar(idu3de)%vd, &
2451 & pio_fout, nvd4, t3dgrd, aval, vinfo, ncname)
2452 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2453 END IF
2454!
2455! Define 3D Northward momentum at RHO-points, A-grid.
2456!
2457 IF (hout(idv3dn,ng)) THEN
2458 vinfo( 1)=vname(1,idv3dn)
2459 vinfo( 2)=vname(2,idv3dn)
2460 vinfo( 3)=vname(3,idv3dn)
2461 vinfo(14)=vname(4,idv3dn)
2462 vinfo(16)=vname(1,idtime)
2463# if defined WRITE_WATER && defined MASKING
2464 vinfo(20)='mask_rho'
2465# endif
2466 vinfo(21)=vname(6,idv3dn)
2467 vinfo(22)='coordinates'
2468 aval(5)=real(iinfo(1,idv3dn,ng),r8)
2469 adm(ng)%pioVar(idv3dn)%dkind=pio_fout
2470 adm(ng)%pioVar(idv3dn)%gtype=r3dvar
2471!
2472 status=def_var(ng, model, adm(ng)%pioFile, &
2473 & adm(ng)%pioVar(idv3dn)%vd, &
2474 & pio_fout, nvd4, t3dgrd, aval, vinfo, ncname)
2475 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2476 END IF
2477# endif
2478!
2479! Define S-coordinate omega vertical velocity.
2480!
2481 IF (hout(idovel,ng)) THEN
2482 vinfo( 1)=vname(1,idovel)
2483 WRITE (vinfo( 2),40) trim(vname(2,idovel))
2484 vinfo( 3)='meter second-1'
2485 vinfo(14)=vname(4,idovel)
2486 vinfo(16)=vname(1,idtime)
2487 vinfo(21)=vname(6,idovel)
2488 vinfo(22)='coordinates'
2489 aval(5)=real(iinfo(1,idovel,ng),r8)
2490 adm(ng)%pioVar(idovel)%dkind=pio_fout
2491 adm(ng)%pioVar(idovel)%gtype=w3dvar
2492!
2493 status=def_var(ng, model, adm(ng)%pioFile, &
2494 & adm(ng)%pioVar(idovel)%vd, &
2495 & pio_fout, nvd4, v3dgrd, aval, vinfo, ncname)
2496 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2497 END IF
2498!
2499! Define tracer type variables.
2500!
2501 DO itrc=1,nt(ng)
2502 IF (hout(idtvar(itrc),ng)) THEN
2503 vinfo( 1)=vname(1,idtvar(itrc))
2504 WRITE (vinfo( 2),40) trim(vname(2,idtvar(itrc)))
2505 vinfo( 3)=vname(3,idtvar(itrc))
2506 vinfo(14)=vname(4,idtvar(itrc))
2507 vinfo(16)=vname(1,idtime)
2508# ifdef SEDIMENT_NOT_YET
2509 DO i=1,nst
2510 IF (itrc.eq.idsed(i)) THEN
2511 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
2512 END IF
2513 END DO
2514# endif
2515# if defined WRITE_WATER && defined MASKING
2516 vinfo(20)='mask_rho'
2517# endif
2518 vinfo(21)=vname(6,idtvar(itrc))
2519 vinfo(22)='coordinates'
2520 aval(5)=real(r3dvar,r8)
2521 adm(ng)%pioTrc(itrc)%dkind=pio_fout
2522 adm(ng)%pioTrc(itrc)%gtype=r3dvar
2523!
2524 status=def_var(ng, model, adm(ng)%pioFile, &
2525 & adm(ng)%pioTrc(itrc)%vd, &
2526 & pio_fout, nvd4, t3dgrd, aval, vinfo, ncname)
2527 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2528 END IF
2529 END DO
2530
2531# ifdef ADJUST_BOUNDARY
2532!
2533! Define tracer type variables open boundaries.
2534!
2535 DO itrc=1,nt(ng)
2536 IF (any(lobc(:,istvar(itrc),ng))) THEN
2537 ifield=idsbry(istvar(itrc))
2538 vinfo( 1)=vname(1,ifield)
2539 WRITE (vinfo( 2),40) trim(vname(2,ifield))
2540 vinfo( 3)=vname(3,ifield)
2541 vinfo(14)=vname(4,ifield)
2542 vinfo(16)=vname(1,idtime)
2543# ifdef SEDIMENT
2544 DO i=1,nst
2545 IF (itrc.eq.idsed(i)) THEN
2546 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
2547 END IF
2548 END DO
2549# endif
2550 vinfo(21)=vname(6,ifield)
2551 aval(5)=real(iinfo(1,ifield,ng),r8)
2552 adm(ng)%pioVar(ifield)%dkind=pio_fout
2553 adm(ng)%pioVar(ifield)%gtype=r2dvar
2554!
2555 status=def_var(ng, model, adm(ng)%pioFile, &
2556 & adm(ng)%pioVar(ifield)%vd, &
2557 & pio_fout, 5, t3dobc, aval, vinfo, ncname, &
2558 & setfillval = .false.)
2559 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2560 END IF
2561 END DO
2562# endif
2563!
2564! Define density anomaly.
2565!
2566 IF (hout(iddano,ng)) THEN
2567 vinfo( 1)=vname(1,iddano)
2568 WRITE (vinfo( 2),40) trim(vname(2,iddano))
2569 vinfo( 3)=vname(3,iddano)
2570 vinfo(14)=vname(4,iddano)
2571 vinfo(16)=vname(1,idtime)
2572# if defined WRITE_WATER && defined MASKING
2573 vinfo(20)='mask_rho'
2574# endif
2575 vinfo(21)=vname(6,iddano)
2576 vinfo(22)='coordinates'
2577 aval(5)=real(iinfo(1,iddano,ng),r8)
2578 adm(ng)%pioVar(iddano)%dkind=pio_fout
2579 adm(ng)%pioVar(iddano)%gtype=r3dvar
2580!
2581 status=def_var(ng, model, adm(ng)%pioFile, &
2582 & adm(ng)%pioVar(iddano)%vd, &
2583 & pio_fout, nvd4, t3dgrd, aval, vinfo, ncname)
2584 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2585 END IF
2586!
2587! Define vertical viscosity coefficient.
2588!
2589 IF (hout(idvvis,ng)) THEN
2590 vinfo( 1)=vname(1,idvvis)
2591 WRITE (vinfo( 2),40) trim(vname(2,idvvis))
2592 vinfo( 3)=vname(3,idvvis)
2593 vinfo(14)=vname(4,idvvis)
2594 vinfo(16)=vname(1,idtime)
2595 vinfo(21)=vname(6,idvvis)
2596 vinfo(22)='coordinates'
2597 aval(5)=real(iinfo(1,idvvis,ng),r8)
2598 adm(ng)%pioVar(idvvis)%dkind=pio_fout
2599 adm(ng)%pioVar(idvvis)%gtype=w3dvar
2600!
2601 status=def_var(ng, model, adm(ng)%pioFile, &
2602 & adm(ng)%pioVar(idvvis)%vd, &
2603 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
2604 & setfillval = .false.)
2605 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2606 END IF
2607!
2608! Define vertical diffusion coefficient for potential temperature.
2609!
2610 IF (hout(idtdif,ng)) THEN
2611 vinfo( 1)=vname(1,idtdif)
2612 WRITE (vinfo( 2),40) trim(vname(2,idtdif))
2613 vinfo( 3)=vname(3,idtdif)
2614 vinfo(14)=vname(4,idtdif)
2615 vinfo(16)=vname(1,idtime)
2616 vinfo(21)=vname(6,idtdif)
2617 vinfo(22)='coordinates'
2618 aval(5)=real(iinfo(1,idtdif,ng),r8)
2619 adm(ng)%pioVar(idtdif)%dkind=pio_fout
2620 adm(ng)%pioVar(idtdif)%gtype=w3dvar
2621!
2622 status=def_var(ng, model, adm(ng)%pioFile, &
2623 & adm(ng)%pioVar(idtdif)%vd, &
2624 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
2625 & setfillval = .false.)
2626 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2627 END IF
2628
2629# ifdef SALINITY
2630!
2631! Define vertical diffusion coefficient for salinity.
2632!
2633 IF (hout(idsdif,ng)) THEN
2634 vinfo( 1)=vname(1,idsdif)
2635 WRITE (vinfo( 2),40) trim(vname(2,idsdif))
2636 vinfo( 3)=vname(3,idsdif)
2637 vinfo(14)=vname(4,idsdif)
2638 vinfo(16)=vname(1,idtime)
2639 vinfo(21)=vname(6,idsdif)
2640 vinfo(22)='coordinates'
2641 aval(5)=real(iinfo(1,idsdif,ng),r8)
2642 adm(ng)%pioVar(idsdif)%dkind=pio_fout
2643 adm(ng)%pioVar(idsdif)%gtype=w3dvar
2644!
2645 status=def_var(ng, model, adm(ng)%pioFile, &
2646 & adm(ng)%pioVar(idsdif)%vd, &
2647 & pio_fout, nvd4, w3dgrd, aval, vinfo, ncname, &
2648 & setfillval = .false.)
2649 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2650 END IF
2651# endif
2652# ifndef ADJUST_STFLUX
2653!
2654! Define surface tracer fluxes.
2655!
2656 DO itrc=1,nt(ng)
2657 IF (hout(idtsur(itrc),ng)) THEN
2658 vinfo( 1)=vname(1,idtsur(itrc))
2659 WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
2660 vinfo( 3)=vname(3,idtsur(itrc))
2661 IF (itrc.eq.itemp) THEN
2662 vinfo(11)='upward flux, cooling'
2663 vinfo(12)='downward flux, heating'
2664 ELSE IF (itrc.eq.isalt) THEN
2665 vinfo(11)='upward flux, freshening (net precipitation)'
2666 vinfo(12)='downward flux, salting (net evaporation)'
2667 END IF
2668 vinfo(14)=vname(4,idtsur(itrc))
2669 vinfo(16)=vname(1,idtime)
2670# if defined WRITE_WATER && defined MASKING
2671 vinfo(20)='mask_rho'
2672# endif
2673 vinfo(21)=vname(6,idtsur(itrc))
2674 vinfo(22)='coordinates'
2675 aval(5)=real(iinfo(1,idtsur(itrc),ng),r8)
2676 adm(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
2677 adm(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
2678!
2679 status=def_var(ng, model, adm(ng)%pioFile, &
2680 & adm(ng)%pioVar(idtsur(itrc))%vd, &
2681 & pio_fout, &
2682 & nvd3, t2dgrd, aval, vinfo, ncname)
2683 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2684 END IF
2685 END DO
2686# endif
2687# endif
2688# ifndef ADJUST_WSTRESS
2689!
2690! Define surface U-momentum stress.
2691!
2692 IF (hout(idusms,ng)) THEN
2693 vinfo( 1)=vname(1,idusms)
2694 WRITE (vinfo( 2),40) trim(vname(2,idusms))
2695 vinfo( 3)=vname(3,idusms)
2696 vinfo(14)=vname(4,idusms)
2697 vinfo(16)=vname(1,idtime)
2698# if defined WRITE_WATER && defined MASKING
2699 vinfo(20)='mask_u'
2700# endif
2701 vinfo(21)=vname(6,idusms)
2702 vinfo(22)='coordinates'
2703 aval(5)=real(iinfo(1,idusms,ng),r8)
2704 adm(ng)%pioVar(idusms)%dkind=pio_fout
2705 adm(ng)%pioVar(idusms)%gtype=u2dvar
2706!
2707 status=def_var(ng, model, adm(ng)%pioFile, &
2708 & adm(ng)%pioVar(idusms)%vd, &
2709 & pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
2710 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2711 END IF
2712!
2713! Define surface V-momentum stress.
2714!
2715 IF (hout(idvsms,ng)) THEN
2716 vinfo( 1)=vname(1,idvsms)
2717 WRITE (vinfo( 2),40) trim(vname(2,idvsms))
2718 vinfo( 3)=vname(3,idvsms)
2719 vinfo(14)=vname(4,idvsms)
2720 vinfo(16)=vname(1,idtime)
2721# if defined WRITE_WATER && defined MASKING
2722 vinfo(20)='mask_v'
2723# endif
2724 vinfo(21)=vname(6,idvsms)
2725 vinfo(22)='coordinates'
2726 aval(5)=real(iinfo(1,idvsms,ng),r8)
2727 adm(ng)%pioVar(idvsms)%dkind=pio_fout
2728 adm(ng)%pioVar(idvsms)%gtype=v2dvar
2729!
2730 status=def_var(ng, model, adm(ng)%pioFile, &
2731 & adm(ng)%pioVar(idvsms)%vd, &
2732 & pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
2733 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2734 END IF
2735# endif
2736!
2737! Define bottom U-momentum stress.
2738!
2739 IF (hout(idubms,ng)) THEN
2740 vinfo( 1)=vname(1,idubms)
2741 WRITE (vinfo( 2),40) trim(vname(2,idubms))
2742 vinfo( 3)=vname(3,idubms)
2743 vinfo(14)=vname(4,idubms)
2744 vinfo(16)=vname(1,idtime)
2745# if defined WRITE_WATER && defined MASKING
2746 vinfo(20)='mask_u'
2747# endif
2748 vinfo(21)=vname(6,idubms)
2749 vinfo(22)='coordinates'
2750 aval(5)=real(iinfo(1,idubms,ng),r8)
2751 adm(ng)%pioVar(idubms)%dkind=pio_fout
2752 adm(ng)%pioVar(idubms)%gtype=u2dvar
2753!
2754 status=def_var(ng, model, adm(ng)%pioFile, &
2755 & adm(ng)%pioVar(idubms)%vd, &
2756 & pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
2757 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2758 END IF
2759!
2760! Define bottom V-momentum stress.
2761!
2762 IF (hout(idvbms,ng)) THEN
2763 vinfo( 1)=vname(1,idvbms)
2764 WRITE (vinfo( 2),40) trim(vname(2,idvbms))
2765 vinfo( 3)=vname(3,idvbms)
2766 vinfo(14)=vname(4,idvbms)
2767 vinfo(16)=vname(1,idtime)
2768# if defined WRITE_WATER && defined MASKING
2769 vinfo(20)='mask_v'
2770# endif
2771 vinfo(21)=vname(6,idvbms)
2772 vinfo(22)='coordinates'
2773 aval(5)=real(iinfo(1,idvbms,ng),r8)
2774 adm(ng)%pioVar(idvbms)%dkind=pio_fout
2775 adm(ng)%pioVar(idvbms)%gtype=v2dvar
2776!
2777 status=def_var(ng, model, adm(ng)%pioFile, &
2778 & adm(ng)%pioVar(idvbms)%vd, &
2779 & pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
2780 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2781 END IF
2782!
2783!-----------------------------------------------------------------------
2784! Leave definition mode.
2785!-----------------------------------------------------------------------
2786!
2787 CALL pio_netcdf_enddef (ng, model, ncname, adm(ng)%pioFile)
2788 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2789!
2790!-----------------------------------------------------------------------
2791! Write out time-recordless, information variables.
2792!-----------------------------------------------------------------------
2793!
2794 CALL wrt_info (ng, model, adm(ng)%pioFile, ncname)
2795 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2796 END IF define
2797!
2798!=======================================================================
2799! Open an existing adjoint file, check its contents, and prepare for
2800! appending data.
2801!=======================================================================
2802!
2803 query : IF (.not.ldef) THEN
2804 ncname=adm(ng)%name
2805!
2806! Open adjoint file for read/write.
2807!
2808 CALL pio_netcdf_open (ng, model, ncname, 1, adm(ng)%pioFile)
2809 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
2810 WRITE (stdout,60) trim(ncname)
2811 RETURN
2812 END IF
2813!
2814! Inquire about the dimensions and check for consistency.
2815!
2816 CALL pio_netcdf_check_dim (ng, model, ncname, &
2817 & piofile = adm(ng)%pioFile)
2818 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2819!
2820! Inquire about the variables.
2821!
2822 CALL pio_netcdf_inq_var (ng, model, ncname, &
2823 & piofile = adm(ng)%pioFile)
2824 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2825!
2826! Initialize logical switches.
2827!
2828 DO i=1,nv
2829 got_var(i)=.false.
2830 END DO
2831!
2832! Scan variable list from input NetCDF and activate switches for
2833! adjoint variables. Get variable IDs.
2834!
2835 DO i=1,n_var
2836 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
2837 got_var(idtime)=.true.
2838 adm(ng)%pioVar(idtime)%vd=var_desc(i)
2839 adm(ng)%pioVar(idtime)%dkind=pio_tout
2840 adm(ng)%pioVar(idtime)%gtype=0
2841# ifdef SOLVE3D
2842 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idpthr))) THEN
2843 got_var(idpthr)=.true.
2844 adm(ng)%pioVar(idpthr)%vd=var_desc(i)
2845 adm(ng)%pioVar(idpthr)%dkind=pio_fout
2846 adm(ng)%pioVar(idpthr)%gtype=r3dvar
2847 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idpthw))) THEN
2848 got_var(idpthw)=.true.
2849 adm(ng)%pioVar(idpthw)%vd=var_desc(i)
2850 adm(ng)%pioVar(idpthw)%dkind=pio_fout
2851 adm(ng)%pioVar(idpthw)%gtype=w3dvar
2852# endif
2853 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
2854 got_var(idfsur)=.true.
2855 adm(ng)%pioVar(idfsur)%vd=var_desc(i)
2856 adm(ng)%pioVar(idfsur)%dkind=pio_fout
2857 adm(ng)%pioVar(idfsur)%gtype=r2dvar
2858 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
2859 got_var(idubar)=.true.
2860 adm(ng)%pioVar(idubar)%vd=var_desc(i)
2861 adm(ng)%pioVar(idubar)%dkind=pio_fout
2862 adm(ng)%pioVar(idubar)%gtype=u2dvar
2863 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
2864 got_var(idvbar)=.true.
2865 adm(ng)%pioVar(idvbar)%vd=var_desc(i)
2866 adm(ng)%pioVar(idvbar)%dkind=pio_fout
2867 adm(ng)%pioVar(idvbar)%gtype=v2dvar
2868# ifdef ADJUST_BOUNDARY
2869 ELSE IF (trim(var_name(i)).eq. &
2870 & trim(vname(1,idsbry(isfsur)))) THEN
2871 got_var(idsbry(isfsur))=.true.
2872 adm(ng)%pioVar(idsbry(isfsur))%vd=var_desc(i)
2873 adm(ng)%pioVar(idsbry(isfsur))%dkind=pio_fout
2874 adm(ng)%pioVar(idsbry(isfsur))%gtype=r2dobc
2875 ELSE IF (trim(var_name(i)).eq. &
2876 & trim(vname(1,idsbry(isubar)))) THEN
2877 got_var(idsbry(isubar))=.true.
2878 adm(ng)%pioVar(idsbry(isubar))%vd=var_desc(i)
2879 adm(ng)%pioVar(idsbry(isubar))%dkind=pio_fout
2880 adm(ng)%pioVar(idsbry(isubar))%gtype=u2dobc
2881 ELSE IF (trim(var_name(i)).eq. &
2882 & trim(vname(1,idsbry(isvbar)))) THEN
2883 got_var(idsbry(isvbar))=.true.
2884 adm(ng)%pioVar(idsbry(isvbar))%vd=var_desc(i)
2885 adm(ng)%pioVar(idsbry(isvbar))%dkind=pio_fout
2886 adm(ng)%pioVar(idsbry(isvbar))%gtype=v2dobc
2887# endif
2888# ifdef ADJUST_WSTRESS
2889 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
2890 got_var(idusms)=.true.
2891 adm(ng)%pioVar(idusms)%vd=var_desc(i)
2892 adm(ng)%pioVar(idusms)%dkind=pio_fout
2893 adm(ng)%pioVar(idusms)%gtype=u2dvar
2894 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
2895 got_var(idvsms)=.true.
2896 adm(ng)%pioVar(idvsms)%vd=var_desc(i)
2897 adm(ng)%pioVar(idvsms)%dkind=pio_fout
2898 adm(ng)%pioVar(idvsms)%gtype=v2dvar
2899# endif
2900# ifdef SOLVE3D
2901 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
2902 got_var(iduvel)=.true.
2903 adm(ng)%pioVar(iduvel)%vd=var_desc(i)
2904 adm(ng)%pioVar(iduvel)%dkind=pio_fout
2905 adm(ng)%pioVar(iduvel)%gtype=u3dvar
2906 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
2907 got_var(idvvel)=.true.
2908 adm(ng)%pioVar(idvvel)%vd=var_desc(i)
2909 adm(ng)%pioVar(idvvel)%dkind=pio_fout
2910 adm(ng)%pioVar(idvvel)%gtype=v3dvar
2911# ifdef ADJUST_BOUNDARY
2912 ELSE IF (trim(var_name(i)).eq. &
2913 & trim(vname(1,idsbry(isuvel)))) THEN
2914 got_var(idsbry(isuvel))=.true.
2915 adm(ng)%pioVar(idsbry(isuvel))%vd=var_desc(i)
2916 adm(ng)%pioVar(idsbry(isuvel))%dkind=pio_fout
2917 adm(ng)%pioVar(idsbry(isuvel))%gtype=u3dobc
2918 ELSE IF (trim(var_name(i)).eq. &
2919 & trim(vname(1,idsbry(isvvel)))) THEN
2920 got_var(idsbry(isvvel))=.true.
2921 adm(ng)%pioVar(idsbry(isvvel))%vd=var_desc(i)
2922 adm(ng)%pioVar(idsbry(isvvel))%dkind=pio_fout
2923 adm(ng)%pioVar(idsbry(isvvel))%gtype=v3dvar
2924# endif
2925# ifdef UV_DESTAGGERED
2926 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idu3de))) THEN
2927 got_var(idu3de)=.true.
2928 adm(ng)%pioVar(idu3de)%vd=var_desc(i)
2929 adm(ng)%pioVar(idu3de)%dkind=pio_fout
2930 adm(ng)%pioVar(idu3de)%gtype=r3dvar
2931 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idv3dn))) THEN
2932 got_var(idv3dn)=.true.
2933 adm(ng)%pioVar(idv3dn)%vd=var_desc(i)
2934 adm(ng)%pioVar(idv3dn)%dkind=pio_fout
2935 adm(ng)%pioVar(idv3dn)%gtype=r3dvar
2936# endif
2937 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idovel))) THEN
2938 got_var(idovel)=.true.
2939 adm(ng)%pioVar(idovel)%vd=var_desc(i)
2940 adm(ng)%pioVar(idovel)%dkind=pio_fout
2941 adm(ng)%pioVar(idovel)%gtype=w3dvar
2942 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iddano))) THEN
2943 got_var(iddano)=.true.
2944 adm(ng)%pioVar(iddano)%vd=var_desc(i)
2945 adm(ng)%pioVar(iddano)%dkind=pio_fout
2946 adm(ng)%pioVar(iddano)%gtype=r3dvar
2947 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvis))) THEN
2948 got_var(idvvis)=.true.
2949 adm(ng)%pioVar(idvvis)%vd=var_desc(i)
2950 adm(ng)%pioVar(idvvis)%dkind=pio_fout
2951 adm(ng)%pioVar(idvvis)%gtype=w3dvar
2952 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idtdif))) THEN
2953 got_var(idtdif)=.true.
2954 adm(ng)%pioVar(idtdif)%vd=var_desc(i)
2955 adm(ng)%pioVar(idtdif)%dkind=pio_fout
2956 adm(ng)%pioVar(idtdif)%gtype=w3dvar
2957# ifdef SALINITY
2958 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idsdif))) THEN
2959 got_var(idsdif)=.true.
2960 adm(ng)%pioVar(idsdif)%vd=var_desc(i)
2961 adm(ng)%pioVar(idsdif)%dkind=pio_fout
2962 adm(ng)%pioVar(idsdif)%gtype=w3dvar
2963# endif
2964# endif
2965 END IF
2966# ifdef SOLVE3D
2967 DO itrc=1,nt(ng)
2968 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
2969 got_var(idtvar(itrc))=.true.
2970 adm(ng)%pioTrc(itrc)%vd=var_desc(i)
2971 adm(ng)%pioTrc(itrc)%dkind=pio_fout
2972 adm(ng)%pioTrc(itrc)%gtype=r3dvar
2973# ifdef ADJUST_BOUNDARY
2974 ELSE IF (trim(var_name(i)).eq. &
2975 & trim(vname(1,idsbry(istvar(itrc))))) THEN
2976 got_var(idsbry(istvar(itrc)))=.true.
2977 adm(ng)%pioVar(idsbry(istvar(itrc)))%vd=var_desc(i)
2978 adm(ng)%pioVar(idsbry(istvar(itrc)))%dkind=pio_fout
2979 adm(ng)%pioVar(idsbry(istvar(itrc)))%gtype=r2dvar
2980# endif
2981# ifdef ADJUST_STFLUX
2982 ELSE IF (trim(var_name(i)).eq. &
2983 & trim(vname(1,idtsur(itrc)))) THEN
2984 got_var(idtsur(itrc))=.true.
2985 adm(ng)%pioVar(idtsur(itrc))%vd=var_desc(i)
2986 adm(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
2987 adm(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
2988# endif
2989 END IF
2990 END DO
2991# endif
2992 END DO
2993!
2994! Check if adjoint variables are available in input NetCDF file.
2995!
2996 IF (.not.got_var(idtime)) THEN
2997 IF (master) WRITE (stdout,70) trim(vname(1,idtime)), &
2998 & trim(ncname)
2999 exit_flag=3
3000 RETURN
3001 END IF
3002# ifdef SOLVE3D
3003 IF (.not.got_var(idpthr).and.hout(idpthr,ng)) THEN
3004 IF (master) WRITE (stdout,70) trim(vname(1,idpthr)), &
3005 & trim(ncname)
3006 exit_flag=3
3007 RETURN
3008 END IF
3009 IF (.not.got_var(idpthw).and.hout(idpthw,ng)) THEN
3010 IF (master) WRITE (stdout,70) trim(vname(1,idpthw)), &
3011 & trim(ncname)
3012 exit_flag=3
3013 RETURN
3014 END IF
3015# endif
3016 IF (.not.got_var(idfsur).and.hout(idfsur,ng)) THEN
3017 IF (master) WRITE (stdout,70) trim(vname(1,idfsur)), &
3018 & trim(ncname)
3019 exit_flag=3
3020 RETURN
3021 END IF
3022 IF (.not.got_var(idubar).and.hout(idubar,ng)) THEN
3023 IF (master) WRITE (stdout,70) trim(vname(1,idubar)), &
3024 & trim(ncname)
3025 exit_flag=3
3026 RETURN
3027 END IF
3028 IF (.not.got_var(idvbar).and.hout(idvbar,ng)) THEN
3029 IF (master) WRITE (stdout,70) trim(vname(1,idvbar)), &
3030 & trim(ncname)
3031 exit_flag=3
3032 RETURN
3033 END IF
3034# ifdef ADJUST_BOUNDARY
3035 IF (.not.got_var(idsbry(isfsur)).and. &
3036 & any(lobc(:,isfsur,ng))) THEN
3037 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isfsur))), &
3038 & trim(ncname)
3039 exit_flag=3
3040 RETURN
3041 END IF
3042 IF (.not.got_var(idsbry(isubar)).and. &
3043 & any(lobc(:,isubar,ng))) THEN
3044 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isubar))), &
3045 & trim(ncname)
3046 exit_flag=3
3047 RETURN
3048 END IF
3049 IF (.not.got_var(idsbry(isvbar)).and. &
3050 & any(lobc(:,isvbar,ng))) THEN
3051 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvbar))), &
3052 & trim(ncname)
3053 exit_flag=3
3054 RETURN
3055 END IF
3056# endif
3057# ifdef ADJUST_WSTRESS
3058 IF (.not.got_var(idusms)) THEN
3059 IF (master) WRITE (stdout,70) trim(vname(1,idusms)), &
3060 & trim(ncname)
3061 exit_flag=3
3062 RETURN
3063 END IF
3064 IF (.not.got_var(idvsms)) THEN
3065 IF (master) WRITE (stdout,70) trim(vname(1,idvsms)), &
3066 & trim(ncname)
3067 exit_flag=3
3068 RETURN
3069 END IF
3070# endif
3071# ifdef SOLVE3D
3072 IF (.not.got_var(iduvel).and.hout(iduvel,ng)) THEN
3073 IF (master) WRITE (stdout,70) trim(vname(1,iduvel)), &
3074 & trim(ncname)
3075 exit_flag=3
3076 RETURN
3077 END IF
3078 IF (.not.got_var(idvvel).and.hout(idvvel,ng)) THEN
3079 IF (master) WRITE (stdout,70) trim(vname(1,idvvel)), &
3080 & trim(ncname)
3081 exit_flag=3
3082 RETURN
3083 END IF
3084# ifdef ADJUST_BOUNDARY
3085 IF (.not.got_var(idsbry(isuvel)).and. &
3086 & any(lobc(:,isuvel,ng))) THEN
3087 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isuvel))), &
3088 & trim(ncname)
3089 exit_flag=3
3090 RETURN
3091 END IF
3092 IF (.not.got_var(idsbry(isvvel)).and. &
3093 & any(lobc(:,isvvel,ng))) THEN
3094 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvvel))), &
3095 & trim(ncname)
3096 exit_flag=3
3097 RETURN
3098 END IF
3099# endif
3100 IF (.not.got_var(idovel).and.hout(idovel,ng)) THEN
3101 IF (master) WRITE (stdout,70) trim(vname(1,idovel)), &
3102 & trim(ncname)
3103 exit_flag=3
3104 RETURN
3105 END IF
3106# ifdef UV_DESTAGGERED
3107 IF (.not.got_var(idu3de).and.hout(idu3de,ng)) THEN
3108 IF (master) WRITE (stdout,70) trim(vname(1,idu3de)), &
3109 & trim(ncname)
3110 exit_flag=3
3111 RETURN
3112 END IF
3113 IF (.not.got_var(idv3dn).and.hout(idv3dn,ng)) THEN
3114 IF (master) WRITE (stdout,70) trim(vname(1,idv3dn)), &
3115 & trim(ncname)
3116 exit_flag=3
3117 RETURN
3118 END IF
3119# endif
3120 IF (.not.got_var(iddano).and.hout(iddano,ng)) THEN
3121 IF (master) WRITE (stdout,70) trim(vname(1,iddano)), &
3122 & trim(ncname)
3123 exit_flag=3
3124 RETURN
3125 END IF
3126# endif
3127# ifdef SOLVE3D
3128 DO itrc=1,nt(ng)
3129 IF (.not.got_var(idtvar(itrc)).and.hout(idtvar(itrc),ng)) THEN
3130 IF (master) WRITE (stdout,70) trim(vname(1,idtvar(itrc))), &
3131 & trim(ncname)
3132 exit_flag=3
3133 RETURN
3134 END IF
3135# ifdef ADJUST_BOUNDARY
3136 IF (.not.got_var(idsbry(istvar(itrc))).and. &
3137 & any(lobc(:,istvar(itrc),ng))) THEN
3138 IF (master) WRITE (stdout,70) &
3139 & trim(vname(1,idsbry(istvar(itrc)))), &
3140 & trim(ncname)
3141 exit_flag=3
3142 RETURN
3143 END IF
3144# endif
3145# ifdef ADJUST_STFLUX
3146 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
3147 IF (master) WRITE (stdout,70) trim(vname(1,idtsur(itrc))), &
3148 & trim(ncname)
3149 exit_flag=3
3150 RETURN
3151 END IF
3152# endif
3153 END DO
3154# endif
3155!
3156! Set unlimited time record dimension to the appropriate value.
3157!
3158 IF (ndefadj(ng).gt.0) THEN
3159 adm(ng)%Rindex=((ntstart(ng)-1)- &
3160 & ndefadj(ng)*((ntstart(ng)-1)/ndefadj(ng)))/ &
3161 & nadj(ng)
3162 ELSE
3163 adm(ng)%Rindex=(ntstart(ng)-1)/nadj(ng)
3164 END IF
3165 adm(ng)%Rindex=min(adm(ng)%Rindex,rec_size)
3166 fcount=adm(ng)%Fcount
3167 adm(ng)%Nrec(fcount)=rec_size
3168 END IF query
3169!
3170 10 FORMAT (2x,'AD_DEF_HIS_PIO - creating adjoint file,',t56, &
3171 & 'Grid ',i2.2,': ',a)
3172 20 FORMAT (2x,'AD_DEF_HIS_PIO - inquiring adjoint file,',t56, &
3173 & 'Grid ',i2.2,': ',a)
3174 30 FORMAT (/,' AD_DEF_HIS_PIO - unable to create adjoint NetCDF', &
3175 & ' file: ',a)
3176 40 FORMAT ('adjoint',1x,a)
3177 50 FORMAT (1pe11.4,1x,'millimeter')
3178 60 FORMAT (/,' AD_DEF_HIS_PIO - unable to open adjoint NetCDF', &
3179 & ' file: ',a)
3180 70 FORMAT (/,' AD_DEF_HIS_PIO - unable to find variable: ',a,2x, &
3181 & ' in adjoint NetCDF file: ',a)
3182!
3183 RETURN
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::pio_type
integer, parameter pio_type
Definition mod_pio_netcdf.F:579
mod_pio_netcdf::pio_fout
integer, parameter pio_fout
Definition mod_pio_netcdf.F:569
mod_pio_netcdf::var_desc
type(var_desc_t), dimension(:), pointer var_desc
Definition mod_pio_netcdf.F:437
mod_pio_netcdf::pio_frst
integer, parameter pio_frst
Definition mod_pio_netcdf.F:574
mod_pio_netcdf::pio_netcdf_create
subroutine, public pio_netcdf_create(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:8997
mod_pio_netcdf::pio_netcdf_inq_var
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
Definition mod_pio_netcdf.F:1923
mod_pio_netcdf::pio_netcdf_open
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
Definition mod_pio_netcdf.F:9148
mod_pio_netcdf::pio_netcdf_check_dim
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:1080
mod_pio_netcdf::pio_tout
integer, parameter pio_tout
Definition mod_pio_netcdf.F:588
mod_pio_netcdf::pio_netcdf_enddef
subroutine, public pio_netcdf_enddef(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:9096

References mod_iounits::adm, mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::hout, mod_ncparam::idbath, mod_ncparam::iddano, mod_ncparam::idfsur, mod_ncparam::idovel, mod_ncparam::idpthr, mod_ncparam::idpthw, mod_ncparam::idsbry, mod_ncparam::idsdif, mod_sediment::idsed, mod_ncparam::idtdif, mod_ncparam::idtime, mod_ncparam::idtsur, mod_ncparam::idtvar, mod_ncparam::idu3de, mod_ncparam::idubar, mod_ncparam::idubms, mod_ncparam::idusms, mod_ncparam::iduvel, mod_ncparam::idv3dn, mod_ncparam::idvbar, mod_ncparam::idvbms, mod_ncparam::idvsms, mod_ncparam::idvvel, mod_ncparam::idvvis, mod_ncparam::iinfo, mod_param::inlm, mod_param::iobounds, mod_scalars::isalt, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::itemp, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_scalars::nadj, mod_biology::nbac, mod_biology::nbands, mod_param::nbed, mod_scalars::nbrec, mod_scalars::ndefadj, mod_biology::ndom, mod_biology::nfec, mod_scalars::nfrec, mod_scalars::ninner, mod_scalars::noerror, mod_scalars::nouter, mod_biology::nphy, mod_param::nst, mod_fourdvar::nstatevar, mod_param::nt, mod_scalars::ntstart, mod_ncparam::nv, mod_pio_netcdf::pio_fout, mod_pio_netcdf::pio_frst, mod_pio_netcdf::pio_netcdf_check_dim(), mod_pio_netcdf::pio_netcdf_create(), mod_pio_netcdf::pio_netcdf_enddef(), mod_pio_netcdf::pio_netcdf_inq_var(), mod_pio_netcdf::pio_netcdf_open(), mod_pio_netcdf::pio_tout, mod_pio_netcdf::pio_type, mod_param::r2dobc, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::rclock, mod_sediment::sd50, mod_iounits::sourcefile, mod_iounits::stdout, mod_param::u2dobc, mod_param::u2dvar, mod_param::u3dobc, mod_param::u3dvar, mod_param::v2dobc, mod_param::v2dvar, mod_param::v3dvar, mod_pio_netcdf::var_desc, mod_ncparam::vname, and mod_param::w3dvar.

Referenced by ad_def_his().

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