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

Functions/Subroutines

subroutine, public tl_def_ini (ng)
 
subroutine, private tl_def_ini_nf90 (ng)
 
subroutine, private tl_def_ini_pio (ng)
 

Function/Subroutine Documentation

◆ tl_def_ini()

subroutine, public tl_def_ini_mod::tl_def_ini ( integer, intent(in) ng)

Definition at line 42 of file tl_def_ini.F.

43!***********************************************************************
44!
45! Imported variable declarations.
46!
47 integer, intent(in) :: ng
48!
49! Local variable declarations.
50!
51 character (len=*), parameter :: MyFile = &
52 & __FILE__
53!
54!-----------------------------------------------------------------------
55! Create a new history file according to IO type.
56!-----------------------------------------------------------------------
57!
58 SELECT CASE (itl(ng)%IOtype)
59 CASE (io_nf90)
60 CALL tl_def_ini_nf90 (ng)
61
62# if defined PIO_LIB && defined DISTRIBUTE
63 CASE (io_pio)
64 CALL tl_def_ini_pio (ng)
65# endif
66 CASE DEFAULT
67 IF (master) WRITE (stdout,10) itl(ng)%IOtype
68 exit_flag=3
69 END SELECT
70 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
71!
72 10 FORMAT (' TL_DEF_INI - Illegal output file type, io_type = ',i0, &
73 & /,14x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
74!
75 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_iounits::itl, mod_parallel::master, mod_scalars::noerror, mod_iounits::stdout, tl_def_ini_nf90(), and tl_def_ini_pio().

Referenced by i4dvar_mod::analysis(), i4dvar_mod::background_initialize(), i4dvar_mod::increment(), r4dvar_mod::increment(), rbl4dvar_mod::increment(), i4dvar_mod::posterior_analysis_initialize(), roms_kernel_mod::roms_run(), rp_output(), and tl_initial().

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

◆ tl_def_ini_nf90()

subroutine, private tl_def_ini_mod::tl_def_ini_nf90 ( integer, intent(in) ng)
private

Definition at line 79 of file tl_def_ini.F.

80!***********************************************************************
81!
82 USE mod_netcdf
83!
84! Imported variable declarations.
85!
86 integer, intent(in) :: ng
87!
88! Local variable declarations.
89!
90 logical :: got_var(NV)
91!
92 integer, parameter :: Natt = 25
93
94 integer :: i, j, ifield, itrc, nvd3, nvd4
95 integer :: recdim, status, varid
96 integer :: Fcount
97# ifdef ADJUST_BOUNDARY
98 integer :: IorJdim, brecdim
99# endif
100# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
101 integer :: frecdim
102# endif
103 integer :: DimIDs(nDimID)
104 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
105# ifdef ADJUST_BOUNDARY
106 integer :: t2dobc(4)
107# endif
108
109# ifdef SOLVE3D
110 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
111# ifdef ADJUST_BOUNDARY
112 integer :: t3dobc(5)
113# endif
114# ifdef ADJUST_STFLUX
115 integer :: t3dfrc(4)
116# endif
117# endif
118# ifdef ADJUST_WSTRESS
119 integer :: u3dfrc(4), v3dfrc(4)
120# endif
121!
122 real(r8) :: Aval(6)
123!
124 character (len=256) :: ncname
125 character (len=MaxLen) :: Vinfo(Natt)
126
127 character (len=*), parameter :: MyFile = &
128 & __FILE__//", tl_def_ini_nf90"
129!
130 sourcefile=myfile
131!
132!-----------------------------------------------------------------------
133! Set and report file name.
134!-----------------------------------------------------------------------
135!
136 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
137 ncname=itl(ng)%name
138!
139 IF (master) THEN
140 IF (ldefitl(ng)) THEN
141 WRITE (stdout,10) ng, trim(ncname)
142 ELSE
143 WRITE (stdout,20) ng, trim(ncname)
144 END IF
145 END IF
146!
147!=======================================================================
148! Create a new tangent linear model initialization file.
149!=======================================================================
150!
151 define : IF (ldefitl(ng)) THEN
152 CALL netcdf_create (ng, itlm, trim(ncname), itl(ng)%ncid)
153 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
154 IF (master) WRITE (stdout,30) trim(ncname)
155 RETURN
156 END IF
157!
158!-----------------------------------------------------------------------
159! Define the dimensions of staggered fields.
160!-----------------------------------------------------------------------
161!
162 dimids=0
163!
164 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xi_rho', &
165 & iobounds(ng)%xi_rho, dimids( 1))
166 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
167
168 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xi_u', &
169 & iobounds(ng)%xi_u, dimids( 2))
170 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
171
172 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xi_v', &
173 & iobounds(ng)%xi_v, dimids( 3))
174 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
175
176 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xi_psi', &
177 & iobounds(ng)%xi_psi, dimids( 4))
178 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
179
180 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'eta_rho', &
181 & iobounds(ng)%eta_rho, dimids( 5))
182 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
183
184 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'eta_u', &
185 & iobounds(ng)%eta_u, dimids( 6))
186 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
187
188 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'eta_v', &
189 & iobounds(ng)%eta_v, dimids( 7))
190 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
191
192 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'eta_psi', &
193 & iobounds(ng)%eta_psi, dimids( 8))
194 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
195
196# ifdef ADJUST_BOUNDARY
197 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'IorJ', &
198 & iobounds(ng)%IorJ, iorjdim)
199 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
200# endif
201
202# if defined WRITE_WATER && defined MASKING
203 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xy_rho', &
204 & iobounds(ng)%xy_rho, dimids(17))
205 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
206
207 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xy_u', &
208 & iobounds(ng)%xy_u, dimids(18))
209 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
210
211 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xy_v', &
212 & iobounds(ng)%xy_v, dimids(19))
213 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
214# endif
215
216# ifdef SOLVE3D
217# if defined WRITE_WATER && defined MASKING
218 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xyz_rho', &
219 & iobounds(ng)%xy_rho*n(ng), dimids(20))
220 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
221
222 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xyz_u', &
223 & iobounds(ng)%xy_u*n(ng), dimids(21))
224 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
225
226 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xyz_v', &
227 & iobounds(ng)%xy_v*n(ng), dimids(22))
228 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
229
230 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xyz_w', &
231 & iobounds(ng)%xy_rho*(n(ng)+1), dimids(23))
232 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
233# endif
234
235 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'N', &
236 & n(ng), dimids( 9))
237 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
238
239 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 's_rho', &
240 & n(ng), dimids( 9))
241 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
242
243 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 's_w', &
244 & n(ng)+1, dimids(10))
245 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
246
247 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'tracer', &
248 & nt(ng), dimids(11))
249 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
250
251# ifdef SEDIMENT
252 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'NST', &
253 & nst, dimids(32))
254 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
255
256 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'Nbed', &
257 & nbed, dimids(16))
258 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
259
260# if defined WRITE_WATER && defined MASKING
261 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'xybed', &
262 & iobounds(ng)%xy_rho*nbed, dimids(24))
263 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
264# endif
265# endif
266# endif
267
268 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'boundary', &
269 & 4, dimids(14))
270 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
271
272# ifdef FOUR_DVAR
273 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'Nstate', &
274 & nstatevar(ng), dimids(29))
275 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
276# endif
277
278# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
279 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'frc_adjust', &
280 & nfrec(ng), dimids(30))
281 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
282# endif
283
284# ifdef ADJUST_BOUNDARY
285 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, 'obc_adjust', &
286 & nbrec(ng), dimids(31))
287 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
288# endif
289
290 status=def_dim(ng, itlm, itl(ng)%ncid, ncname, &
291 & trim(adjustl(vname(5,idtime))), &
292 & nf90_unlimited, dimids(12))
293 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
294
295 recdim=dimids(12)
296# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
297 frecdim=dimids(30)
298# endif
299# ifdef ADJUST_BOUNDARY
300 brecdim=dimids(31)
301# endif
302!
303! Set number of dimensions for output variables.
304!
305# if defined WRITE_WATER && defined MASKING
306 nvd3=2
307 nvd4=2
308# else
309 nvd3=3
310 nvd4=4
311# endif
312!
313! Define dimension vectors for staggered tracer type variables.
314!
315# if defined WRITE_WATER && defined MASKING
316 t2dgrd(1)=dimids(17)
317 t2dgrd(2)=dimids(12)
318# ifdef SOLVE3D
319 t3dgrd(1)=dimids(20)
320 t3dgrd(2)=dimids(12)
321# endif
322# else
323 t2dgrd(1)=dimids( 1)
324 t2dgrd(2)=dimids( 5)
325 t2dgrd(3)=dimids(12)
326# ifdef SOLVE3D
327 t3dgrd(1)=dimids( 1)
328 t3dgrd(2)=dimids( 5)
329 t3dgrd(3)=dimids( 9)
330 t3dgrd(4)=dimids(12)
331# endif
332# ifdef ADJUST_STFLUX
333 t3dfrc(1)=dimids( 1)
334 t3dfrc(2)=dimids( 5)
335 t3dfrc(3)=frecdim
336 t3dfrc(4)=dimids(12)
337# endif
338# endif
339# ifdef ADJUST_BOUNDARY
340 t2dobc(1)=iorjdim
341 t2dobc(2)=dimids(14)
342 t2dobc(3)=brecdim
343 t2dobc(4)=dimids(12)
344# ifdef SOLVE3D
345 t3dobc(1)=iorjdim
346 t3dobc(2)=dimids( 9)
347 t3dobc(3)=dimids(14)
348 t3dobc(4)=brecdim
349 t3dobc(5)=dimids(12)
350# endif
351# endif
352!
353! Define dimension vectors for staggered u-momentum type variables.
354!
355# if defined WRITE_WATER && defined MASKING
356 u2dgrd(1)=dimids(18)
357 u2dgrd(2)=dimids(12)
358# ifdef SOLVE3D
359 u3dgrd(1)=dimids(21)
360 u3dgrd(2)=dimids(12)
361# endif
362# else
363 u2dgrd(1)=dimids( 2)
364 u2dgrd(2)=dimids( 6)
365 u2dgrd(3)=dimids(12)
366# ifdef SOLVE3D
367 u3dgrd(1)=dimids( 2)
368 u3dgrd(2)=dimids( 6)
369 u3dgrd(3)=dimids( 9)
370 u3dgrd(4)=dimids(12)
371# endif
372# ifdef ADJUST_WSTRESS
373 u3dfrc(1)=dimids( 2)
374 u3dfrc(2)=dimids( 6)
375 u3dfrc(3)=frecdim
376 u3dfrc(4)=dimids(12)
377# endif
378# endif
379!
380! Define dimension vectors for staggered v-momentum type variables.
381!
382# if defined WRITE_WATER && defined MASKING
383 v2dgrd(1)=dimids(19)
384 v2dgrd(2)=dimids(12)
385# ifdef SOLVE3D
386 v3dgrd(1)=dimids(22)
387 v3dgrd(2)=dimids(12)
388# endif
389# else
390 v2dgrd(1)=dimids( 3)
391 v2dgrd(2)=dimids( 7)
392 v2dgrd(3)=dimids(12)
393# ifdef SOLVE3D
394 v3dgrd(1)=dimids( 3)
395 v3dgrd(2)=dimids( 7)
396 v3dgrd(3)=dimids( 9)
397 v3dgrd(4)=dimids(12)
398# endif
399# ifdef ADJUST_WSTRESS
400 v3dfrc(1)=dimids( 3)
401 v3dfrc(2)=dimids( 7)
402 v3dfrc(3)=frecdim
403 v3dfrc(4)=dimids(12)
404# endif
405# endif
406# ifdef SOLVE3D
407!
408! Define dimension vector for staggered w-momentum type variables.
409!
410# if defined WRITE_WATER && defined MASKING
411 w3dgrd(1)=dimids(23)
412 w3dgrd(2)=dimids(12)
413# else
414 w3dgrd(1)=dimids( 1)
415 w3dgrd(2)=dimids( 5)
416 w3dgrd(3)=dimids(10)
417 w3dgrd(4)=dimids(12)
418# endif
419# endif
420!
421! Initialize local information variable arrays.
422!
423 DO i=1,natt
424 DO j=1,len(vinfo(1))
425 vinfo(i)(j:j)=' '
426 END DO
427 END DO
428 DO i=1,6
429 aval(i)=0.0_r8
430 END DO
431!
432!-----------------------------------------------------------------------
433! Define time-recordless information variables.
434!-----------------------------------------------------------------------
435!
436 CALL def_info (ng, itlm, itl(ng)%ncid, ncname, dimids)
437 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
438!
439!-----------------------------------------------------------------------
440! Define time-varying variables.
441!-----------------------------------------------------------------------
442!
443! Define model time.
444!
445 vinfo( 1)=vname(1,idtime)
446 vinfo( 2)=vname(2,idtime)
447 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
448 vinfo( 4)=trim(rclock%calendar)
449 vinfo(14)=vname(4,idtime)
450 vinfo(21)=vname(6,idtime)
451 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idtime), &
452 & nf_tout, 1, (/recdim/), aval, vinfo, ncname, &
453 & setparaccess = .false.)
454 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
455!
456! Define free-surface.
457!
458 vinfo( 1)=vname(1,idfsur)
459 WRITE (vinfo( 2),40) trim(vname(2,idfsur))
460 vinfo( 3)=vname(3,idfsur)
461 vinfo(14)=vname(4,idfsur)
462 vinfo(16)=vname(1,idtime)
463# if defined WRITE_WATER && defined MASKING
464 vinfo(20)='mask_rho'
465# endif
466 vinfo(21)=vname(6,idfsur)
467 vinfo(22)='coordinates'
468 aval(5)=real(iinfo(1,idfsur,ng),r8)
469 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idfsur), &
470# ifdef WET_DRY
471 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname, &
472 & setfillval = .false.)
473# else
474 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
475# endif
476 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
477
478# ifdef ADJUST_BOUNDARY
479!
480! Define free-surface open boundaries.
481!
482 IF (any(lobc(:,isfsur,ng))) THEN
483 ifield=idsbry(isfsur)
484 vinfo( 1)=vname(1,ifield)
485 WRITE (vinfo( 2),40) trim(vname(2,ifield))
486 vinfo( 3)=vname(3,ifield)
487 vinfo(14)=vname(4,ifield)
488 vinfo(16)=vname(1,idtime)
489 vinfo(21)=vname(6,ifield)
490 aval(5)=real(iinfo(1,ifield,ng),r8)
491 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(ifield), &
492 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
493 & setfillval = .false.)
494 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
495 END IF
496# endif
497!
498! Define 2D U-momentum component.
499!
500 vinfo( 1)=vname(1,idubar)
501 WRITE (vinfo( 2),40) trim(vname(2,idubar))
502 vinfo( 3)=vname(3,idubar)
503 vinfo(14)=vname(4,idubar)
504 vinfo(16)=vname(1,idtime)
505# if defined WRITE_WATER && defined MASKING
506 vinfo(20)='mask_u'
507# endif
508 vinfo(21)=vname(6,idubar)
509 vinfo(22)='coordinates'
510 aval(5)=real(iinfo(1,idubar,ng),r8)
511 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idubar), &
512 & nf_fout, nvd3, u2dgrd, aval, vinfo, ncname)
513 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
514
515# ifdef ADJUST_BOUNDARY
516!
517! Define 2D U-momentum component open boundaries.
518!
519 IF (any(lobc(:,isubar,ng))) THEN
520 ifield=idsbry(isubar)
521 vinfo( 1)=vname(1,ifield)
522 WRITE (vinfo( 2),40) trim(vname(2,ifield))
523 vinfo( 3)=vname(3,ifield)
524 vinfo(14)=vname(4,ifield)
525 vinfo(16)=vname(1,idtime)
526 vinfo(21)=vname(6,ifield)
527 aval(5)=real(iinfo(1,ifield,ng),r8)
528 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(ifield), &
529 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
530 & setfillval = .false.)
531 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
532 END IF
533# endif
534!
535! Define 2D V-momentum component.
536!
537 vinfo( 1)=vname(1,idvbar)
538 WRITE (vinfo( 2),40) trim(vname(2,idvbar))
539 vinfo( 3)=vname(3,idvbar)
540 vinfo(14)=vname(4,idvbar)
541 vinfo(16)=vname(1,idtime)
542# if defined WRITE_WATER && defined MASKING
543 vinfo(20)='mask_v'
544# endif
545 vinfo(21)=vname(6,idvbar)
546 vinfo(22)='coordinates'
547 aval(5)=real(iinfo(1,idvbar,ng),r8)
548 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idvbar), &
549 & nf_fout, nvd3, v2dgrd, aval, vinfo, ncname)
550 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
551
552# ifdef ADJUST_BOUNDARY
553!
554! Define 2D V-momentum component open boundaries.
555!
556 IF (any(lobc(:,isvbar,ng))) THEN
557 ifield=idsbry(isvbar)
558 vinfo( 1)=vname(1,ifield)
559 WRITE (vinfo( 2),40) trim(vname(2,ifield))
560 vinfo( 3)=vname(3,ifield)
561 vinfo(14)=vname(4,ifield)
562 vinfo(16)=vname(1,idtime)
563 vinfo(21)=vname(6,ifield)
564 aval(5)=real(iinfo(1,ifield,ng),r8)
565 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(ifield), &
566 & nf_fout, 4, t2dobc, aval, vinfo, ncname, &
567 & setfillval = .false.)
568 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
569 END IF
570# endif
571# ifdef ADJUST_WSTRESS
572!
573! Define surface U-momentum stress.
574!
575 vinfo( 1)=vname(1,idusms)
576 WRITE (vinfo( 2),40) trim(vname(2,idusms))
577 vinfo( 3)=vname(3,idusms)
578 vinfo(14)=vname(4,idusms)
579 vinfo(16)=vname(1,idtime)
580# if defined WRITE_WATER && defined MASKING
581 vinfo(20)='mask_u'
582# endif
583 vinfo(21)=vname(6,idusms)
584 vinfo(22)='coordinates'
585 aval(5)=real(u2dvar,r8)
586 status=def_var(ng, itlm, itl(ng)%ncid, itl(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( 2)=vname(2,idvsms)
595 vinfo( 3)=vname(3,idvsms)
596 vinfo(14)=vname(4,idvsms)
597 vinfo(16)=vname(1,idtime)
598# if defined WRITE_WATER && defined MASKING
599 vinfo(20)='mask_v'
600# endif
601 vinfo(21)=vname(6,idvsms)
602 vinfo(22)='coordinates'
603 aval(5)=real(v2dvar,r8)
604 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idvsms), &
605 & nf_fout, nvd4, v3dfrc, aval, vinfo, ncname)
606 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
607# endif
608# ifdef SOLVE3D
609!
610! Define 3D U-momentum component.
611!
612 vinfo( 1)=vname(1,iduvel)
613 WRITE (vinfo( 2),40) trim(vname(2,iduvel))
614 vinfo( 3)=vname(3,iduvel)
615 vinfo(14)=vname(4,iduvel)
616 vinfo(16)=vname(1,idtime)
617# if defined WRITE_WATER && defined MASKING
618 vinfo(20)='mask_u'
619# endif
620 vinfo(21)=vname(6,iduvel)
621 vinfo(22)='coordinates'
622 aval(5)=real(iinfo(1,iduvel,ng),r8)
623 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(iduvel), &
624 & nf_fout, nvd4, u3dgrd, aval, vinfo, ncname)
625 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
626
627# ifdef ADJUST_BOUNDARY
628!
629! Define 3D U-momentum component open boundaries.
630!
631 IF (any(lobc(:,isuvel,ng))) THEN
632 ifield=idsbry(isuvel)
633 vinfo( 1)=vname(1,ifield)
634 WRITE (vinfo( 2),40) trim(vname(2,ifield))
635 vinfo( 3)=vname(3,ifield)
636 vinfo(14)=vname(4,ifield)
637 vinfo(16)=vname(1,idtime)
638 vinfo(21)=vname(6,ifield)
639 aval(5)=real(iinfo(1,ifield,ng),r8)
640 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(ifield), &
641 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
642 & setfillval = .false.)
643 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
644 END IF
645# endif
646!
647! Define 3D V-momentum component.
648!
649 vinfo( 1)=vname(1,idvvel)
650 WRITE (vinfo( 2),40) trim(vname(2,idvvel))
651 vinfo( 3)=vname(3,idvvel)
652 vinfo(14)=vname(4,idvvel)
653 vinfo(16)=vname(1,idtime)
654# if defined WRITE_WATER && defined MASKING
655 vinfo(20)='mask_v'
656# endif
657 vinfo(21)=vname(6,idvvel)
658 vinfo(22)='coordinates'
659 aval(5)=real(iinfo(1,idvvel,ng),r8)
660 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(idvvel), &
661 & nf_fout, nvd4, v3dgrd, aval, vinfo, ncname)
662 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
663
664# ifdef ADJUST_BOUNDARY
665!
666! Define 3D V-momentum component open boundaries.
667!
668 IF (any(lobc(:,isvvel,ng))) THEN
669 ifield=idsbry(isvvel)
670 vinfo( 1)=vname(1,ifield)
671 WRITE (vinfo( 2),40) trim(vname(2,ifield))
672 vinfo( 3)=vname(3,ifield)
673 vinfo(14)=vname(4,ifield)
674 vinfo(16)=vname(1,idtime)
675 vinfo(21)=vname(6,ifield)
676 aval(5)=real(iinfo(1,ifield,ng),r8)
677 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(ifield), &
678 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
679 & setfillval = .false.)
680 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
681 END IF
682# endif
683!
684! Define tracer type variables.
685!
686 DO itrc=1,nt(ng)
687 vinfo( 1)=vname(1,idtvar(itrc))
688 WRITE (vinfo( 2),40) trim(vname(2,idtvar(itrc)))
689 vinfo( 3)=vname(3,idtvar(itrc))
690 vinfo(14)=vname(4,idtvar(itrc))
691 vinfo(16)=vname(1,idtime)
692# ifdef SEDIMENT
693 DO i=1,nst
694 IF (itrc.eq.idsed(i)) THEN
695 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
696 END IF
697 END DO
698# endif
699# if defined WRITE_WATER && defined MASKING
700 vinfo(20)='mask_rho'
701# endif
702 vinfo(21)=vname(6,idtvar(itrc))
703 vinfo(22)='coordinates'
704 aval(5)=real(r3dvar,r8)
705 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Tid(itrc), &
706 & nf_fout, nvd4, t3dgrd, aval, vinfo, ncname)
707 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
708 END DO
709
710# ifdef ADJUST_BOUNDARY
711!
712! Define tracer type variables open boundaries.
713!
714 DO itrc=1,nt(ng)
715 IF (any(lobc(:,istvar(itrc),ng))) THEN
716 ifield=idsbry(istvar(itrc))
717 vinfo( 1)=vname(1,ifield)
718 WRITE (vinfo( 2),40) trim(vname(2,ifield))
719 vinfo( 3)=vname(3,ifield)
720 vinfo(14)=vname(4,ifield)
721 vinfo(16)=vname(1,idtime)
722# ifdef SEDIMENT
723 DO i=1,nst
724 IF (itrc.eq.idsed(i)) THEN
725 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
726 END IF
727 END DO
728# endif
729 vinfo(21)=vname(6,ifield)
730 aval(5)=real(iinfo(1,ifield,ng),r8)
731 status=def_var(ng, itlm, itl(ng)%ncid, itl(ng)%Vid(ifield), &
732 & nf_fout, 5, t3dobc, aval, vinfo, ncname, &
733 setfillval = .false.)
734 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
735 END IF
736 END DO
737# endif
738# ifdef ADJUST_STFLUX
739!
740! Define surface tracer fluxes.
741!
742 DO itrc=1,nt(ng)
743 IF (lstflux(itrc,ng)) THEN
744 vinfo( 1)=vname(1,idtsur(itrc))
745 WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
746 vinfo( 3)=vname(3,idtsur(itrc))
747 IF (itrc.eq.itemp) THEN
748 vinfo(11)='upward flux, cooling'
749 vinfo(12)='downward flux, heating'
750 ELSE IF (itrc.eq.isalt) THEN
751 vinfo(11)='upward flux, freshening (net precipitation)'
752 vinfo(12)='downward flux, salting (net evaporation)'
753 END IF
754 vinfo(14)=vname(4,idtsur(itrc))
755 vinfo(16)=vname(1,idtime)
756# if defined WRITE_WATER && defined MASKING
757 vinfo(20)='mask_rho'
758# endif
759 vinfo(21)=vname(6,idtsur(itrc))
760 vinfo(22)='coordinates'
761 aval(5)=real(r2dvar,r8)
762 status=def_var(ng, itlm, itl(ng)%ncid, &
763 & itl(ng)%Vid(idtsur(itrc)), nf_fout, &
764 & nvd4, t3dfrc, aval, vinfo, ncname)
765 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
766 END IF
767 END DO
768# endif
769# endif
770!
771!-----------------------------------------------------------------------
772! Leave definition mode.
773!-----------------------------------------------------------------------
774!
775 CALL netcdf_enddef (ng, itlm, ncname, itl(ng)%ncid)
776 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
777!
778!-----------------------------------------------------------------------
779! Write out time-recordless, information variables.
780!-----------------------------------------------------------------------
781!
782 CALL wrt_info (ng, itlm, itl(ng)%ncid, ncname)
783 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
784 END IF define
785!
786!=======================================================================
787! Open an existing initialization file, check its contents, and
788! prepare for appending data.
789!=======================================================================
790!
791 query : IF (.not.ldefitl(ng)) THEN
792 ncname=itl(ng)%name
793!
794! Open tangent linear initialization file for read/write.
795!
796 CALL netcdf_open (ng, itlm, ncname, 1, itl(ng)%ncid)
797 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
798 WRITE (stdout,60) trim(ncname)
799 RETURN
800 END IF
801!
802! Inquire about the dimensions and check for consistency.
803!
804 CALL netcdf_check_dim (ng, itlm, ncname, &
805 & ncid = itl(ng)%ncid)
806 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
807!
808! Inquire about the variables.
809!
810 CALL netcdf_inq_var (ng, itlm, ncname, &
811 & ncid = itl(ng)%ncid)
812 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
813!
814! Initialize logical switches.
815!
816 DO i=1,nv
817 got_var(i)=.false.
818 END DO
819!
820! Scan variable list from input NetCDF and activate switches for
821! initialization variables. Get variable IDs.
822!
823 DO i=1,n_var
824 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
825 got_var(idtime)=.true.
826 itl(ng)%Vid(idtime)=var_id(i)
827 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
828 got_var(idfsur)=.true.
829 itl(ng)%Vid(idfsur)=var_id(i)
830 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
831 got_var(idubar)=.true.
832 itl(ng)%Vid(idubar)=var_id(i)
833 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
834 got_var(idvbar)=.true.
835 itl(ng)%Vid(idvbar)=var_id(i)
836# ifdef ADJUST_BOUNDARY
837 ELSE IF (trim(var_name(i)).eq. &
838 & trim(vname(1,idsbry(isfsur)))) THEN
839 got_var(idsbry(isfsur))=.true.
840 itl(ng)%Vid(idsbry(isfsur))=var_id(i)
841 ELSE IF (trim(var_name(i)).eq. &
842 & trim(vname(1,idsbry(isubar)))) THEN
843 got_var(idsbry(isubar))=.true.
844 itl(ng)%Vid(idsbry(isubar))=var_id(i)
845 ELSE IF (trim(var_name(i)).eq. &
846 & trim(vname(1,idsbry(isvbar)))) THEN
847 got_var(idsbry(isvbar))=.true.
848 itl(ng)%Vid(idsbry(isvbar))=var_id(i)
849# endif
850# ifdef ADJUST_WSTRESS
851 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
852 got_var(idusms)=.true.
853 itl(ng)%Vid(idusms)=var_id(i)
854 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
855 got_var(idvsms)=.true.
856 itl(ng)%Vid(idvsms)=var_id(i)
857# endif
858# ifdef SOLVE3D
859 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
860 got_var(iduvel)=.true.
861 itl(ng)%Vid(iduvel)=var_id(i)
862 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
863 got_var(idvvel)=.true.
864 itl(ng)%Vid(idvvel)=var_id(i)
865# ifdef ADJUST_BOUNDARY
866 ELSE IF (trim(var_name(i)).eq. &
867 & trim(vname(1,idsbry(isuvel)))) THEN
868 got_var(idsbry(isuvel))=.true.
869 itl(ng)%Vid(idsbry(isuvel))=var_id(i)
870 ELSE IF (trim(var_name(i)).eq. &
871 & trim(vname(1,idsbry(isvvel)))) THEN
872 got_var(idsbry(isvvel))=.true.
873 itl(ng)%Vid(idsbry(isvvel))=var_id(i)
874# endif
875# endif
876 END IF
877# ifdef SOLVE3D
878 DO itrc=1,nt(ng)
879 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
880 got_var(idtvar(itrc))=.true.
881 itl(ng)%Tid(itrc)=var_id(i)
882# ifdef ADJUST_BOUNDARY
883 ELSE IF (trim(var_name(i)).eq. &
884 & trim(vname(1,idsbry(istvar(itrc))))) THEN
885 got_var(idsbry(istvar(itrc)))=.true.
886 itl(ng)%Vid(idsbry(istvar(itrc)))=var_id(i)
887# endif
888# ifdef ADJUST_STFLUX
889 ELSE IF (trim(var_name(i)).eq. &
890 & trim(vname(1,idtsur(itrc)))) THEN
891 got_var(idtsur(itrc))=.true.
892 itl(ng)%Vid(idtsur(itrc))=var_id(i)
893# endif
894 END IF
895 END DO
896# endif
897 END DO
898!
899! Check if tangent linear mode initialization variables are available
900! in input NetCDF file.
901!
902 IF (.not.got_var(idtime)) THEN
903 IF (master) WRITE (stdout,70) trim(vname(1,idtime)), &
904 & trim(ncname)
905 exit_flag=3
906 RETURN
907 END IF
908 IF (.not.got_var(idfsur)) THEN
909 IF (master) WRITE (stdout,70) trim(vname(1,idfsur)), &
910 & trim(ncname)
911 exit_flag=3
912 RETURN
913 END IF
914 IF (.not.got_var(idubar)) THEN
915 IF (master) WRITE (stdout,70) trim(vname(1,idubar)), &
916 & trim(ncname)
917 exit_flag=3
918 RETURN
919 END IF
920 IF (.not.got_var(idvbar)) THEN
921 IF (master) WRITE (stdout,70) trim(vname(1,idvbar)), &
922 & trim(ncname)
923 exit_flag=3
924 RETURN
925 END IF
926# ifdef ADJUST_BOUNDARY
927 IF (.not.got_var(idsbry(isfsur)).and. &
928 & any(lobc(:,isfsur,ng))) THEN
929 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isfsur))), &
930 & trim(ncname)
931 exit_flag=3
932 RETURN
933 END IF
934 IF (.not.got_var(idsbry(isubar)).and. &
935 & any(lobc(:,isubar,ng))) THEN
936 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isubar))), &
937 & trim(ncname)
938 exit_flag=3
939 RETURN
940 END IF
941 IF (.not.got_var(idsbry(isvbar)).and. &
942 & any(lobc(:,isvbar,ng))) THEN
943 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvbar))), &
944 & trim(ncname)
945 exit_flag=3
946 RETURN
947 END IF
948# endif
949# ifdef ADJUST_WSTRESS
950 IF (.not.got_var(idusms)) THEN
951 IF (master) WRITE (stdout,70) trim(vname(1,idusms)), &
952 & trim(ncname)
953 exit_flag=3
954 RETURN
955 END IF
956 IF (.not.got_var(idvsms)) THEN
957 IF (master) WRITE (stdout,70) trim(vname(1,idvsms)), &
958 & trim(ncname)
959 exit_flag=3
960 RETURN
961 END IF
962# endif
963# ifdef SOLVE3D
964 IF (.not.got_var(iduvel)) THEN
965 IF (master) WRITE (stdout,70) trim(vname(1,iduvel)), &
966 & trim(ncname)
967 exit_flag=3
968 RETURN
969 END IF
970 IF (.not.got_var(idvvel)) THEN
971 IF (master) WRITE (stdout,70) trim(vname(1,idvvel)), &
972 & trim(ncname)
973 exit_flag=3
974 RETURN
975 END IF
976# ifdef ADJUST_BOUNDARY
977 IF (.not.got_var(idsbry(isuvel)).and. &
978 & any(lobc(:,isuvel,ng))) THEN
979 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isuvel))), &
980 & trim(ncname)
981 exit_flag=3
982 RETURN
983 END IF
984 IF (.not.got_var(idsbry(isvvel)).and. &
985 & any(lobc(:,isvvel,ng))) THEN
986 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvvel))), &
987 & trim(ncname)
988 exit_flag=3
989 RETURN
990 END IF
991# endif
992# endif
993# ifdef SOLVE3D
994 DO itrc=1,nt(ng)
995 IF (.not.got_var(idtvar(itrc))) THEN
996 IF (master) WRITE (stdout,70) trim(vname(1,idtvar(itrc))), &
997 & trim(ncname)
998 exit_flag=3
999 RETURN
1000 END IF
1001# ifdef ADJUST_BOUNDARY
1002 IF (.not.got_var(idsbry(istvar(itrc))).and. &
1003 & any(lobc(:,istvar(itrc),ng))) THEN
1004 IF (master) WRITE (stdout,70) &
1005 & trim(vname(1,idsbry(istvar(itrc)))), &
1006 & trim(ncname)
1007 exit_flag=3
1008 RETURN
1009 END IF
1010# endif
1011# ifdef ADJUST_STFLUX
1012 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
1013 IF (master) WRITE (stdout,70) trim(vname(1,idtsur(itrc))), &
1014 & trim(ncname)
1015 exit_flag=3
1016 RETURN
1017 END IF
1018# endif
1019 END DO
1020# endif
1021!
1022! Set unlimited time record dimension to the appropriate value.
1023!
1024 itl(ng)%Rindex=rec_size
1025 fcount=itl(ng)%Fcount
1026 itl(ng)%Nrec(fcount)=rec_size
1027 END IF query
1028!
1029 10 FORMAT (2x,'TL_DEF_INI_NF90 - creating initial file,',t56, &
1030 & 'Grid ',i2.2,': ',a)
1031 20 FORMAT (2x,'TL_DEF_INI_NF90 - inquiring initial file,',t56, &
1032 & 'Grid ',i2.2,': ',a)
1033 30 FORMAT (/,' TL_DEF_INI_NF90 - unable to create initial NetCDF', &
1034 & ' file:',1x,a)
1035 40 FORMAT ('tangent linear',1x,a)
1036 50 FORMAT (1pe11.4,1x,'millimeter')
1037 60 FORMAT (/,' TL_DEF_INI_NF90 - unable to open initial NetCDF', &
1038 & ' file: ',a)
1039 70 FORMAT (/,' TL_DEF_INI_NF90 - unable to find variable: ',a,2x, &
1040 & ' in file: ',a)
1041!
1042 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::rec_size
integer rec_size
Definition mod_netcdf.F:156
mod_netcdf::netcdf_create
subroutine, public netcdf_create(ng, model, ncname, ncid)
Definition mod_netcdf.F:9089
mod_netcdf::netcdf_inq_var
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)
Definition mod_netcdf.F:1371

References mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::idfsur, mod_ncparam::idsbry, mod_ncparam::idtime, mod_ncparam::idtsur, mod_ncparam::idtvar, mod_ncparam::idubar, mod_ncparam::idusms, mod_ncparam::iduvel, mod_ncparam::idvbar, mod_ncparam::idvsms, mod_ncparam::idvvel, mod_ncparam::iinfo, mod_param::iobounds, mod_scalars::isalt, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::itemp, mod_iounits::itl, mod_param::itlm, mod_scalars::ldefitl, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_netcdf::n_var, mod_param::nbed, mod_scalars::nbrec, 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_tout, mod_scalars::nfrec, mod_scalars::noerror, mod_param::nst, mod_fourdvar::nstatevar, mod_param::nt, mod_ncparam::nv, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::rclock, mod_netcdf::rec_size, mod_iounits::sourcefile, mod_iounits::stdout, mod_param::u2dvar, mod_param::v2dvar, mod_netcdf::var_id, mod_netcdf::var_name, and mod_ncparam::vname.

Referenced by tl_def_ini().

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

◆ tl_def_ini_pio()

subroutine, private tl_def_ini_mod::tl_def_ini_pio ( integer, intent(in) ng)
private

Definition at line 1048 of file tl_def_ini.F.

1049!***********************************************************************
1050!
1051 USE mod_pio_netcdf
1052!
1053! Imported variable declarations.
1054!
1055 integer, intent(in) :: ng
1056!
1057! Local variable declarations.
1058!
1059 logical :: got_var(NV)
1060!
1061 integer, parameter :: Natt = 25
1062
1063 integer :: i, j, ifield, itrc, nvd3, nvd4
1064 integer :: recdim, status
1065 integer :: Fcount
1066# ifdef ADJUST_BOUNDARY
1067 integer :: IorJdim, brecdim
1068# endif
1069# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1070 integer :: frecdim
1071# endif
1072 integer :: DimIDs(nDimID)
1073 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
1074# ifdef ADJUST_BOUNDARY
1075 integer :: t2dobc(4)
1076# endif
1077
1078# ifdef SOLVE3D
1079 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
1080# ifdef ADJUST_BOUNDARY
1081 integer :: t3dobc(5)
1082# endif
1083# ifdef ADJUST_STFLUX
1084 integer :: t3dfrc(4)
1085# endif
1086# endif
1087# ifdef ADJUST_WSTRESS
1088 integer :: u3dfrc(4), v3dfrc(4)
1089# endif
1090!
1091 real(r8) :: Aval(6)
1092!
1093 character (len=256) :: ncname
1094 character (len=MaxLen) :: Vinfo(Natt)
1095
1096 character (len=*), parameter :: MyFile = &
1097 & __FILE__//", tl_def_ini_pio"
1098!
1099 sourcefile=myfile
1100!
1101!-----------------------------------------------------------------------
1102! Set and report file name.
1103!-----------------------------------------------------------------------
1104!
1105 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1106 ncname=itl(ng)%name
1107!
1108 IF (master) THEN
1109 IF (ldefitl(ng)) THEN
1110 WRITE (stdout,10) ng, trim(ncname)
1111 ELSE
1112 WRITE (stdout,20) ng, trim(ncname)
1113 END IF
1114 END IF
1115!
1116!=======================================================================
1117! Create a new tangent linear model initialization file.
1118!=======================================================================
1119!
1120 define : IF (ldefitl(ng)) THEN
1121 CALL pio_netcdf_create (ng, itlm, trim(ncname), itl(ng)%pioFile)
1122 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1123 IF (master) WRITE (stdout,30) trim(ncname)
1124 RETURN
1125 END IF
1126!
1127!-----------------------------------------------------------------------
1128! Define the dimensions of staggered fields.
1129!-----------------------------------------------------------------------
1130!
1131 dimids=0
1132!
1133 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xi_rho', &
1134 & iobounds(ng)%xi_rho, dimids( 1))
1135 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1136
1137 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xi_u', &
1138 & iobounds(ng)%xi_u, dimids( 2))
1139 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1140
1141 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xi_v', &
1142 & iobounds(ng)%xi_v, dimids( 3))
1143 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1144
1145 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xi_psi', &
1146 & iobounds(ng)%xi_psi, dimids( 4))
1147 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1148
1149 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'eta_rho', &
1150 & iobounds(ng)%eta_rho, dimids( 5))
1151 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1152
1153 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'eta_u', &
1154 & iobounds(ng)%eta_u, dimids( 6))
1155 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1156
1157 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'eta_v', &
1158 & iobounds(ng)%eta_v, dimids( 7))
1159 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1160
1161 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'eta_psi', &
1162 & iobounds(ng)%eta_psi, dimids( 8))
1163 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1164
1165# ifdef ADJUST_BOUNDARY
1166 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'IorJ', &
1167 & iobounds(ng)%IorJ, iorjdim)
1168 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1169# endif
1170
1171# if defined WRITE_WATER && defined MASKING
1172 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xy_rho', &
1173 & iobounds(ng)%xy_rho, dimids(17))
1174 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1175
1176 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xy_u', &
1177 & iobounds(ng)%xy_u, dimids(18))
1178 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1179
1180 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xy_v', &
1181 & iobounds(ng)%xy_v, dimids(19))
1182 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1183# endif
1184
1185# ifdef SOLVE3D
1186# if defined WRITE_WATER && defined MASKING
1187 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xyz_rho', &
1188 & iobounds(ng)%xy_rho*n(ng), dimids(20))
1189 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1190
1191 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xyz_u', &
1192 & iobounds(ng)%xy_u*n(ng), dimids(21))
1193 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1194
1195 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xyz_v', &
1196 & iobounds(ng)%xy_v*n(ng), dimids(22))
1197 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1198
1199 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xyz_w', &
1200 & iobounds(ng)%xy_rho*(n(ng)+1), dimids(23))
1201 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1202# endif
1203
1204 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'N', &
1205 & n(ng), dimids( 9))
1206 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1207
1208 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 's_rho', &
1209 & n(ng), dimids( 9))
1210 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1211
1212 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 's_w', &
1213 & n(ng)+1, dimids(10))
1214 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1215
1216 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'tracer', &
1217 & nt(ng), dimids(11))
1218 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1219
1220# ifdef SEDIMENT
1221 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'NST', &
1222 & nst, dimids(32))
1223 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1224
1225 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'Nbed', &
1226 & nbed, dimids(16))
1227 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1228
1229# if defined WRITE_WATER && defined MASKING
1230 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'xybed', &
1231 & iobounds(ng)%xy_rho*nbed, dimids(24))
1232 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1233# endif
1234# endif
1235# endif
1236
1237 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'boundary', &
1238 & 4, dimids(14))
1239 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1240
1241# ifdef FOUR_DVAR
1242 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'Nstate', &
1243 & nstatevar(ng), dimids(29))
1244 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1245# endif
1246
1247# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1248 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'frc_adjust', &
1249 & nfrec(ng), dimids(30))
1250 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1251# endif
1252
1253# ifdef ADJUST_BOUNDARY
1254 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, 'obc_adjust', &
1255 & nbrec(ng), dimids(31))
1256 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1257# endif
1258
1259 status=def_dim(ng, itlm, itl(ng)%pioFile, ncname, &
1260 & trim(adjustl(vname(5,idtime))), &
1261 & pio_unlimited, dimids(12))
1262 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1263
1264 recdim=dimids(12)
1265# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1266 frecdim=dimids(30)
1267# endif
1268# ifdef ADJUST_BOUNDARY
1269 brecdim=dimids(31)
1270# endif
1271!
1272! Set number of dimensions for output variables.
1273!
1274# if defined WRITE_WATER && defined MASKING
1275 nvd3=2
1276 nvd4=2
1277# else
1278 nvd3=3
1279 nvd4=4
1280# endif
1281!
1282! Define dimension vectors for staggered tracer type variables.
1283!
1284# if defined WRITE_WATER && defined MASKING
1285 t2dgrd(1)=dimids(17)
1286 t2dgrd(2)=dimids(12)
1287# ifdef SOLVE3D
1288 t3dgrd(1)=dimids(20)
1289 t3dgrd(2)=dimids(12)
1290# endif
1291# else
1292 t2dgrd(1)=dimids( 1)
1293 t2dgrd(2)=dimids( 5)
1294 t2dgrd(3)=dimids(12)
1295# ifdef SOLVE3D
1296 t3dgrd(1)=dimids( 1)
1297 t3dgrd(2)=dimids( 5)
1298 t3dgrd(3)=dimids( 9)
1299 t3dgrd(4)=dimids(12)
1300# endif
1301# ifdef ADJUST_STFLUX
1302 t3dfrc(1)=dimids( 1)
1303 t3dfrc(2)=dimids( 5)
1304 t3dfrc(3)=frecdim
1305 t3dfrc(4)=dimids(12)
1306# endif
1307# endif
1308# ifdef ADJUST_BOUNDARY
1309 t2dobc(1)=iorjdim
1310 t2dobc(2)=dimids(14)
1311 t2dobc(3)=brecdim
1312 t2dobc(4)=dimids(12)
1313# ifdef SOLVE3D
1314 t3dobc(1)=iorjdim
1315 t3dobc(2)=dimids( 9)
1316 t3dobc(3)=dimids(14)
1317 t3dobc(4)=brecdim
1318 t3dobc(5)=dimids(12)
1319# endif
1320# endif
1321!
1322! Define dimension vectors for staggered u-momentum type variables.
1323!
1324# if defined WRITE_WATER && defined MASKING
1325 u2dgrd(1)=dimids(18)
1326 u2dgrd(2)=dimids(12)
1327# ifdef SOLVE3D
1328 u3dgrd(1)=dimids(21)
1329 u3dgrd(2)=dimids(12)
1330# endif
1331# else
1332 u2dgrd(1)=dimids( 2)
1333 u2dgrd(2)=dimids( 6)
1334 u2dgrd(3)=dimids(12)
1335# ifdef SOLVE3D
1336 u3dgrd(1)=dimids( 2)
1337 u3dgrd(2)=dimids( 6)
1338 u3dgrd(3)=dimids( 9)
1339 u3dgrd(4)=dimids(12)
1340# endif
1341# ifdef ADJUST_WSTRESS
1342 u3dfrc(1)=dimids( 2)
1343 u3dfrc(2)=dimids( 6)
1344 u3dfrc(3)=frecdim
1345 u3dfrc(4)=dimids(12)
1346# endif
1347# endif
1348!
1349! Define dimension vectors for staggered v-momentum type variables.
1350!
1351# if defined WRITE_WATER && defined MASKING
1352 v2dgrd(1)=dimids(19)
1353 v2dgrd(2)=dimids(12)
1354# ifdef SOLVE3D
1355 v3dgrd(1)=dimids(22)
1356 v3dgrd(2)=dimids(12)
1357# endif
1358# else
1359 v2dgrd(1)=dimids( 3)
1360 v2dgrd(2)=dimids( 7)
1361 v2dgrd(3)=dimids(12)
1362# ifdef SOLVE3D
1363 v3dgrd(1)=dimids( 3)
1364 v3dgrd(2)=dimids( 7)
1365 v3dgrd(3)=dimids( 9)
1366 v3dgrd(4)=dimids(12)
1367# endif
1368# ifdef ADJUST_WSTRESS
1369 v3dfrc(1)=dimids( 3)
1370 v3dfrc(2)=dimids( 7)
1371 v3dfrc(3)=frecdim
1372 v3dfrc(4)=dimids(12)
1373# endif
1374# endif
1375# ifdef SOLVE3D
1376!
1377! Define dimension vector for staggered w-momentum type variables.
1378!
1379# if defined WRITE_WATER && defined MASKING
1380 w3dgrd(1)=dimids(23)
1381 w3dgrd(2)=dimids(12)
1382# else
1383 w3dgrd(1)=dimids( 1)
1384 w3dgrd(2)=dimids( 5)
1385 w3dgrd(3)=dimids(10)
1386 w3dgrd(4)=dimids(12)
1387# endif
1388# endif
1389!
1390! Initialize local information variable arrays.
1391!
1392 DO i=1,natt
1393 DO j=1,len(vinfo(1))
1394 vinfo(i)(j:j)=' '
1395 END DO
1396 END DO
1397 DO i=1,6
1398 aval(i)=0.0_r8
1399 END DO
1400!
1401!-----------------------------------------------------------------------
1402! Define time-recordless information variables.
1403!-----------------------------------------------------------------------
1404!
1405 CALL def_info (ng, itlm, itl(ng)%pioFile, ncname, dimids)
1406 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1407!
1408!-----------------------------------------------------------------------
1409! Define time-varying variables.
1410!-----------------------------------------------------------------------
1411!
1412! Define model time.
1413!
1414 vinfo( 1)=vname(1,idtime)
1415 vinfo( 2)=vname(2,idtime)
1416 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
1417 vinfo( 4)=trim(rclock%calendar)
1418 vinfo(14)=vname(4,idtime)
1419 vinfo(21)=vname(6,idtime)
1420 itl(ng)%pioVar(idtime)%dkind=pio_tout
1421 itl(ng)%pioVar(idtime)%gtype=0
1422!
1423 status=def_var(ng, itlm, itl(ng)%pioFile, &
1424 & itl(ng)%pioVar(idtime)%vd, pio_tout, &
1425 & 1, (/recdim/), aval, vinfo, ncname, &
1426 & setparaccess = .false.)
1427 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1428!
1429! Define free-surface.
1430!
1431 vinfo( 1)=vname(1,idfsur)
1432 WRITE (vinfo( 2),40) trim(vname(2,idfsur))
1433 vinfo( 3)=vname(3,idfsur)
1434 vinfo(14)=vname(4,idfsur)
1435 vinfo(16)=vname(1,idtime)
1436# if defined WRITE_WATER && defined MASKING
1437 vinfo(20)='mask_rho'
1438# endif
1439 vinfo(21)=vname(6,idfsur)
1440 vinfo(22)='coordinates'
1441 aval(5)=real(iinfo(1,idfsur,ng),r8)
1442 itl(ng)%pioVar(idfsur)%dkind=pio_fout
1443 itl(ng)%pioVar(idfsur)%gtype=r2dvar
1444!
1445 status=def_var(ng, itlm, itl(ng)%pioFile, &
1446 & itl(ng)%pioVar(idfsur)%vd, pio_fout, &
1447# ifdef WET_DRY
1448 & nvd3, t2dgrd, aval, vinfo, ncname, &
1449 & setfillval = .false.)
1450# else
1451 & nvd3, t2dgrd, aval, vinfo, ncname)
1452# endif
1453 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1454
1455# ifdef ADJUST_BOUNDARY
1456!
1457! Define free-surface open boundaries.
1458!
1459 IF (any(lobc(:,isfsur,ng))) THEN
1460 ifield=idsbry(isfsur)
1461 vinfo( 1)=vname(1,ifield)
1462 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1463 vinfo( 3)=vname(3,ifield)
1464 vinfo(14)=vname(4,ifield)
1465 vinfo(16)=vname(1,idtime)
1466 vinfo(21)=vname(6,ifield)
1467 aval(5)=real(iinfo(1,ifield,ng),r8)
1468 itl(ng)%pioVar(ifield)%dkind=pio_fout
1469 itl(ng)%pioVar(ifield)%gtype=r2dobc
1470!
1471 status=def_var(ng, itlm, itl(ng)%pioFile, &
1472 & itl(ng)%pioVar(ifield)%vd, pio_fout, &
1473 & 4, t2dobc, aval, vinfo, ncname, &
1474 & setfillval = .false.)
1475 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1476 END IF
1477# endif
1478!
1479! Define 2D U-momentum component.
1480!
1481 vinfo( 1)=vname(1,idubar)
1482 WRITE (vinfo( 2),40) trim(vname(2,idubar))
1483 vinfo( 3)=vname(3,idubar)
1484 vinfo(14)=vname(4,idubar)
1485 vinfo(16)=vname(1,idtime)
1486# if defined WRITE_WATER && defined MASKING
1487 vinfo(20)='mask_u'
1488# endif
1489 vinfo(21)=vname(6,idubar)
1490 vinfo(22)='coordinates'
1491 aval(5)=real(iinfo(1,idubar,ng),r8)
1492 itl(ng)%pioVar(idubar)%dkind=pio_fout
1493 itl(ng)%pioVar(idubar)%gtype=u2dvar
1494!
1495 status=def_var(ng, itlm, itl(ng)%pioFile, &
1496 & itl(ng)%pioVar(idubar)%vd, pio_fout, &
1497 & nvd3, u2dgrd, aval, vinfo, ncname)
1498 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1499
1500# ifdef ADJUST_BOUNDARY
1501!
1502! Define 2D U-momentum component open boundaries.
1503!
1504 IF (any(lobc(:,isubar,ng))) THEN
1505 ifield=idsbry(isubar)
1506 vinfo( 1)=vname(1,ifield)
1507 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1508 vinfo( 3)=vname(3,ifield)
1509 vinfo(14)=vname(4,ifield)
1510 vinfo(16)=vname(1,idtime)
1511 vinfo(21)=vname(6,ifield)
1512 aval(5)=real(iinfo(1,ifield,ng),r8)
1513 itl(ng)%pioVar(ifield)%dkind=pio_fout
1514 itl(ng)%pioVar(ifield)%gtype=u2dobc
1515!
1516 status=def_var(ng, itlm, itl(ng)%pioFile, &
1517 & itl(ng)%pioVar(ifield)%vd, pio_fout, &
1518 & 4, t2dobc, aval, vinfo, ncname, &
1519 & setfillval = .false.)
1520 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1521 END IF
1522# endif
1523!
1524! Define 2D V-momentum component.
1525!
1526 vinfo( 1)=vname(1,idvbar)
1527 WRITE (vinfo( 2),40) trim(vname(2,idvbar))
1528 vinfo( 3)=vname(3,idvbar)
1529 vinfo(14)=vname(4,idvbar)
1530 vinfo(16)=vname(1,idtime)
1531# if defined WRITE_WATER && defined MASKING
1532 vinfo(20)='mask_v'
1533# endif
1534 vinfo(21)=vname(6,idvbar)
1535 vinfo(22)='coordinates'
1536 aval(5)=real(iinfo(1,idvbar,ng),r8)
1537 itl(ng)%pioVar(idvbar)%dkind=pio_fout
1538 itl(ng)%pioVar(idvbar)%gtype=v2dvar
1539!
1540 status=def_var(ng, itlm, itl(ng)%pioFile, &
1541 & itl(ng)%pioVar(idvbar)%vd, pio_fout, &
1542 & nvd3, v2dgrd, aval, vinfo, ncname)
1543 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1544
1545# ifdef ADJUST_BOUNDARY
1546!
1547! Define 2D V-momentum component open boundaries.
1548!
1549 IF (any(lobc(:,isvbar,ng))) THEN
1550 ifield=idsbry(isvbar)
1551 vinfo( 1)=vname(1,ifield)
1552 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1553 vinfo( 3)=vname(3,ifield)
1554 vinfo(14)=vname(4,ifield)
1555 vinfo(16)=vname(1,idtime)
1556 vinfo(21)=vname(6,ifield)
1557 aval(5)=real(iinfo(1,ifield,ng),r8)
1558 itl(ng)%pioVar(ifield)%dkind=pio_fout
1559 itl(ng)%pioVar(ifield)%gtype=v2dobc
1560!
1561 status=def_var(ng, itlm, itl(ng)%pioFile, &
1562 & itl(ng)%pioVar(ifield)%vd, pio_fout, &
1563 & 4, t2dobc, aval, vinfo, ncname, &
1564 & setfillval = .false.)
1565 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1566 END IF
1567# endif
1568# ifdef ADJUST_WSTRESS
1569!
1570! Define surface U-momentum stress.
1571!
1572 vinfo( 1)=vname(1,idusms)
1573 WRITE (vinfo( 2),40) trim(vname(2,idusms))
1574 vinfo( 3)=vname(3,idusms)
1575 vinfo(14)=vname(4,idusms)
1576 vinfo(16)=vname(1,idtime)
1577# if defined WRITE_WATER && defined MASKING
1578 vinfo(20)='mask_u'
1579# endif
1580 vinfo(21)=vname(6,idusms)
1581 vinfo(22)='coordinates'
1582 aval(5)=real(u2dvar,r8)
1583 itl(ng)%pioVar(idusms)%dkind=pio_fout
1584 itl(ng)%pioVar(idusms)%gtype=u2dvar
1585!
1586 status=def_var(ng, itlm, itl(ng)%pioFile, &
1587 & itl(ng)%pioVar(idusms)%vd, pio_fout, &
1588 & nvd4, u3dfrc, aval, vinfo, ncname)
1589 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1590!
1591! Define surface V-momentum stress.
1592!
1593 vinfo( 1)=vname(1,idvsms)
1594 WRITE (vinfo( 2),40) trim(vname(2,idvsms))
1595 vinfo( 2)=vname(2,idvsms)
1596 vinfo( 3)=vname(3,idvsms)
1597 vinfo(14)=vname(4,idvsms)
1598 vinfo(16)=vname(1,idtime)
1599# if defined WRITE_WATER && defined MASKING
1600 vinfo(20)='mask_v'
1601# endif
1602 vinfo(21)=vname(6,idvsms)
1603 vinfo(22)='coordinates'
1604 aval(5)=real(v2dvar,r8)
1605 itl(ng)%pioVar(idvsms)%dkind=pio_fout
1606 itl(ng)%pioVar(idvsms)%gtype=v2dvar
1607!
1608 status=def_var(ng, itlm, itl(ng)%pioFile, &
1609 & itl(ng)%pioVar(idvsms)%vd, pio_fout, &
1610 & nvd4, v3dfrc, aval, vinfo, ncname)
1611 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1612# endif
1613# ifdef SOLVE3D
1614!
1615! Define 3D U-momentum component.
1616!
1617 vinfo( 1)=vname(1,iduvel)
1618 WRITE (vinfo( 2),40) trim(vname(2,iduvel))
1619 vinfo( 3)=vname(3,iduvel)
1620 vinfo(14)=vname(4,iduvel)
1621 vinfo(16)=vname(1,idtime)
1622# if defined WRITE_WATER && defined MASKING
1623 vinfo(20)='mask_u'
1624# endif
1625 vinfo(21)=vname(6,iduvel)
1626 vinfo(22)='coordinates'
1627 aval(5)=real(iinfo(1,iduvel,ng),r8)
1628 itl(ng)%pioVar(iduvel)%dkind=pio_fout
1629 itl(ng)%pioVar(iduvel)%gtype=u3dvar
1630!
1631 status=def_var(ng, itlm, itl(ng)%pioFile, &
1632 & itl(ng)%pioVar(iduvel)%vd, pio_fout, &
1633 & nvd4, u3dgrd, aval, vinfo, ncname)
1634 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1635
1636# ifdef ADJUST_BOUNDARY
1637!
1638! Define 3D U-momentum component open boundaries.
1639!
1640 IF (any(lobc(:,isuvel,ng))) THEN
1641 ifield=idsbry(isuvel)
1642 vinfo( 1)=vname(1,ifield)
1643 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1644 vinfo( 3)=vname(3,ifield)
1645 vinfo(14)=vname(4,ifield)
1646 vinfo(16)=vname(1,idtime)
1647 vinfo(21)=vname(6,ifield)
1648 aval(5)=real(iinfo(1,ifield,ng),r8)
1649 itl(ng)%pioVar(ifield)%dkind=pio_fout
1650 itl(ng)%pioVar(ifield)%gtype=u3dobc
1651!
1652 status=def_var(ng, itlm, itl(ng)%pioFile, &
1653 & itl(ng)%pioVar(ifield)%vd, pio_fout, &
1654 & 5, t3dobc, aval, vinfo, ncname, &
1655 & setfillval = .false.)
1656 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1657 END IF
1658# endif
1659!
1660! Define 3D V-momentum component.
1661!
1662 vinfo( 1)=vname(1,idvvel)
1663 WRITE (vinfo( 2),40) trim(vname(2,idvvel))
1664 vinfo( 3)=vname(3,idvvel)
1665 vinfo(14)=vname(4,idvvel)
1666 vinfo(16)=vname(1,idtime)
1667# if defined WRITE_WATER && defined MASKING
1668 vinfo(20)='mask_v'
1669# endif
1670 vinfo(21)=vname(6,idvvel)
1671 vinfo(22)='coordinates'
1672 aval(5)=real(iinfo(1,idvvel,ng),r8)
1673 itl(ng)%pioVar(idvvel)%dkind=pio_fout
1674 itl(ng)%pioVar(idvvel)%gtype=v3dvar
1675!
1676 status=def_var(ng, itlm, itl(ng)%pioFile, &
1677 & itl(ng)%pioVar(idvvel)%vd, pio_fout, &
1678 & nvd4, v3dgrd, aval, vinfo, ncname)
1679 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1680
1681# ifdef ADJUST_BOUNDARY
1682!
1683! Define 3D V-momentum component open boundaries.
1684!
1685 IF (any(lobc(:,isvvel,ng))) THEN
1686 ifield=idsbry(isvvel)
1687 vinfo( 1)=vname(1,ifield)
1688 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1689 vinfo( 3)=vname(3,ifield)
1690 vinfo(14)=vname(4,ifield)
1691 vinfo(16)=vname(1,idtime)
1692 vinfo(21)=vname(6,ifield)
1693 aval(5)=real(iinfo(1,ifield,ng),r8)
1694 itl(ng)%pioVar(ifield)%dkind=pio_fout
1695 itl(ng)%pioVar(ifield)%gtype=v3dobc
1696!
1697 status=def_var(ng, itlm, itl(ng)%pioFile, &
1698 & itl(ng)%pioVar(ifield)%vd, pio_fout, &
1699 & 5, t3dobc, aval, vinfo, ncname, &
1700 & setfillval = .false.)
1701 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1702 END IF
1703# endif
1704!
1705! Define tracer type variables.
1706!
1707 DO itrc=1,nt(ng)
1708 vinfo( 1)=vname(1,idtvar(itrc))
1709 WRITE (vinfo( 2),40) trim(vname(2,idtvar(itrc)))
1710 vinfo( 3)=vname(3,idtvar(itrc))
1711 vinfo(14)=vname(4,idtvar(itrc))
1712 vinfo(16)=vname(1,idtime)
1713# ifdef SEDIMENT
1714 DO i=1,nst
1715 IF (itrc.eq.idsed(i)) THEN
1716 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
1717 END IF
1718 END DO
1719# endif
1720# if defined WRITE_WATER && defined MASKING
1721 vinfo(20)='mask_rho'
1722# endif
1723 vinfo(21)=vname(6,idtvar(itrc))
1724 vinfo(22)='coordinates'
1725 aval(5)=real(r3dvar,r8)
1726 itl(ng)%pioTrc(itrc)%dkind=pio_fout
1727 itl(ng)%pioTrc(itrc)%gtype=r3dvar
1728!
1729 status=def_var(ng, itlm, itl(ng)%pioFile, &
1730 & itl(ng)%pioTrc(itrc)%vd, pio_fout, &
1731 & nvd4, t3dgrd, aval, vinfo, ncname)
1732 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1733 END DO
1734
1735# ifdef ADJUST_BOUNDARY
1736!
1737! Define tracer type variables open boundaries.
1738!
1739 DO itrc=1,nt(ng)
1740 IF (any(lobc(:,istvar(itrc),ng))) THEN
1741 ifield=idsbry(istvar(itrc))
1742 vinfo( 1)=vname(1,ifield)
1743 WRITE (vinfo( 2),40) trim(vname(2,ifield))
1744 vinfo( 3)=vname(3,ifield)
1745 vinfo(14)=vname(4,ifield)
1746 vinfo(16)=vname(1,idtime)
1747# ifdef SEDIMENT
1748 DO i=1,nst
1749 IF (itrc.eq.idsed(i)) THEN
1750 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
1751 END IF
1752 END DO
1753# endif
1754 vinfo(21)=vname(6,ifield)
1755 aval(5)=real(iinfo(1,ifield,ng),r8)
1756 itl(ng)%pioVar(ifield)%dkind=pio_fout
1757 itl(ng)%pioVar(ifield)%gtype=r3dobc
1758!
1759 status=def_var(ng, itlm, itl(ng)%pioFile, &
1760 & itl(ng)%pioVar(ifield)%vd, pio_fout, &
1761 & 5, t3dobc, aval, vinfo, ncname, &
1762 setfillval = .false.)
1763 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1764 END IF
1765 END DO
1766# endif
1767# ifdef ADJUST_STFLUX
1768!
1769! Define surface tracer fluxes.
1770!
1771 DO itrc=1,nt(ng)
1772 IF (lstflux(itrc,ng)) THEN
1773 vinfo( 1)=vname(1,idtsur(itrc))
1774 WRITE (vinfo( 2),40) trim(vname(2,idtsur(itrc)))
1775 vinfo( 3)=vname(3,idtsur(itrc))
1776 IF (itrc.eq.itemp) THEN
1777 vinfo(11)='upward flux, cooling'
1778 vinfo(12)='downward flux, heating'
1779 ELSE IF (itrc.eq.isalt) THEN
1780 vinfo(11)='upward flux, freshening (net precipitation)'
1781 vinfo(12)='downward flux, salting (net evaporation)'
1782 END IF
1783 vinfo(14)=vname(4,idtsur(itrc))
1784 vinfo(16)=vname(1,idtime)
1785# if defined WRITE_WATER && defined MASKING
1786 vinfo(20)='mask_rho'
1787# endif
1788 vinfo(21)=vname(6,idtsur(itrc))
1789 vinfo(22)='coordinates'
1790 aval(5)=real(r2dvar,r8)
1791 itl(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
1792 itl(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
1793!
1794 status=def_var(ng, itlm, itl(ng)%pioFile, &
1795 & itl(ng)%pioVar(idtsur(itrc))%vd, pio_fout, &
1796 & nvd4, t3dfrc, aval, vinfo, ncname)
1797 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1798 END IF
1799 END DO
1800# endif
1801# endif
1802!
1803!-----------------------------------------------------------------------
1804! Leave definition mode.
1805!-----------------------------------------------------------------------
1806!
1807 CALL pio_netcdf_enddef (ng, itlm, ncname, itl(ng)%pioFile)
1808 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1809!
1810!-----------------------------------------------------------------------
1811! Write out time-recordless, information variables.
1812!-----------------------------------------------------------------------
1813!
1814 CALL wrt_info (ng, itlm, itl(ng)%pioFile, ncname)
1815 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1816 END IF define
1817!
1818!=======================================================================
1819! Open an existing initialization file, check its contents, and
1820! prepare for appending data.
1821!=======================================================================
1822!
1823 query : IF (.not.ldefitl(ng)) THEN
1824 ncname=itl(ng)%name
1825!
1826! Open tangent linear initialization file for read/write.
1827!
1828 CALL pio_netcdf_open (ng, itlm, ncname, 1, itl(ng)%pioFile)
1829 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1830 WRITE (stdout,60) trim(ncname)
1831 RETURN
1832 END IF
1833!
1834! Inquire about the dimensions and check for consistency.
1835!
1836 CALL pio_netcdf_check_dim (ng, itlm, ncname, &
1837 & piofile = itl(ng)%pioFile)
1838 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1839!
1840! Inquire about the variables.
1841!
1842 CALL pio_netcdf_inq_var (ng, itlm, ncname, &
1843 & piofile = itl(ng)%pioFile)
1844 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1845!
1846! Initialize logical switches.
1847!
1848 DO i=1,nv
1849 got_var(i)=.false.
1850 END DO
1851!
1852! Scan variable list from input NetCDF and activate switches for
1853! initialization variables. Get variable IDs.
1854!
1855 DO i=1,n_var
1856 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
1857 got_var(idtime)=.true.
1858 itl(ng)%pioVar(idtime)%vd=var_desc(i)
1859 itl(ng)%pioVar(idtime)%dkind=pio_tout
1860 itl(ng)%pioVar(idtime)%gtype=0
1861 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
1862 got_var(idfsur)=.true.
1863 itl(ng)%pioVar(idfsur)%vd=var_desc(i)
1864 itl(ng)%pioVar(idfsur)%dkind=pio_fout
1865 itl(ng)%pioVar(idfsur)%gtype=r2dvar
1866 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
1867 got_var(idubar)=.true.
1868 itl(ng)%pioVar(idubar)%vd=var_desc(i)
1869 itl(ng)%pioVar(idubar)%dkind=pio_fout
1870 itl(ng)%pioVar(idubar)%gtype=u2dvar
1871 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
1872 got_var(idvbar)=.true.
1873 itl(ng)%pioVar(idvbar)%vd=var_desc(i)
1874 itl(ng)%pioVar(idvbar)%dkind=pio_fout
1875 itl(ng)%pioVar(idvbar)%gtype=v2dvar
1876# ifdef ADJUST_BOUNDARY
1877 ELSE IF (trim(var_name(i)).eq. &
1878 & trim(vname(1,idsbry(isfsur)))) THEN
1879 got_var(idsbry(isfsur))=.true.
1880 itl(ng)%pioVar(idsbry(isfsur))%vd=var_desc(i)
1881 itl(ng)%pioVar(idsbry(isfsur))%dkind=pio_fout
1882 itl(ng)%pioVar(idsbry(isfsur))%gtype=r2dobc
1883 ELSE IF (trim(var_name(i)).eq. &
1884 & trim(vname(1,idsbry(isubar)))) THEN
1885 got_var(idsbry(isubar))=.true.
1886 itl(ng)%pioVar(idsbry(isubar))%vd=var_desc(i)
1887 itl(ng)%pioVar(idsbry(isubar))%dkind=pio_fout
1888 itl(ng)%pioVar(idsbry(isubar))%gtype=u2dobc
1889 ELSE IF (trim(var_name(i)).eq. &
1890 & trim(vname(1,idsbry(isvbar)))) THEN
1891 got_var(idsbry(isvbar))=.true.
1892 itl(ng)%pioVar(idsbry(isvbar))%vd=var_desc(i)
1893 itl(ng)%pioVar(idsbry(isvbar))%dkind=pio_fout
1894 itl(ng)%pioVar(idsbry(isvbar))%gtype=v2dobc
1895# endif
1896# ifdef ADJUST_WSTRESS
1897 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
1898 got_var(idusms)=.true.
1899 itl(ng)%pioVar(idusms)%vd=var_desc(i)
1900 itl(ng)%pioVar(idusms)%dkind=pio_fout
1901 itl(ng)%pioVar(idusms)%gtype=u2dvar
1902 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
1903 got_var(idvsms)=.true.
1904 itl(ng)%pioVar(idvsms)%vd=var_desc(i)
1905 itl(ng)%pioVar(idvsms)%dkind=pio_fout
1906 itl(ng)%pioVar(idvsms)%gtype=v2dvar
1907# endif
1908# ifdef SOLVE3D
1909 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
1910 got_var(iduvel)=.true.
1911 itl(ng)%pioVar(iduvel)%vd=var_desc(i)
1912 itl(ng)%pioVar(iduvel)%dkind=pio_fout
1913 itl(ng)%pioVar(iduvel)%gtype=u3dvar
1914 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
1915 got_var(idvvel)=.true.
1916 itl(ng)%pioVar(idvvel)%vd=var_desc(i)
1917 itl(ng)%pioVar(idvvel)%dkind=pio_fout
1918 itl(ng)%pioVar(idvvel)%gtype=v3dvar
1919# ifdef ADJUST_BOUNDARY
1920 ELSE IF (trim(var_name(i)).eq. &
1921 & trim(vname(1,idsbry(isuvel)))) THEN
1922 got_var(idsbry(isuvel))=.true.
1923 itl(ng)%pioVar(idsbry(isuvel))%vd=var_desc(i)
1924 itl(ng)%pioVar(idsbry(isuvel))%dkind=pio_fout
1925 itl(ng)%pioVar(idsbry(isuvel))%gtype=u3dobc
1926 ELSE IF (trim(var_name(i)).eq. &
1927 & trim(vname(1,idsbry(isvvel)))) THEN
1928 got_var(idsbry(isvvel))=.true.
1929 itl(ng)%pioVar(idsbry(isvvel))%vd=var_desc(i)
1930 itl(ng)%pioVar(idsbry(isvvel))%dkind=pio_fout
1931 itl(ng)%pioVar(idsbry(isvvel))%gtype=v3dobc
1932# endif
1933# endif
1934 END IF
1935# ifdef SOLVE3D
1936 DO itrc=1,nt(ng)
1937 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
1938 got_var(idtvar(itrc))=.true.
1939 itl(ng)%pioTrc(itrc)%vd=var_desc(i)
1940 itl(ng)%pioTrc(itrc)%dkind=pio_fout
1941 itl(ng)%pioTrc(itrc)%gtype=r3dvar
1942# ifdef ADJUST_BOUNDARY
1943 ELSE IF (trim(var_name(i)).eq. &
1944 & trim(vname(1,idsbry(istvar(itrc))))) THEN
1945 got_var(idsbry(istvar(itrc)))=.true.
1946 itl(ng)%pioVar(idsbry(istvar(itrc)))%vd=var_desc(i)
1947 itl(ng)%pioVar(idsbry(istvar(itrc)))%dkind=pio_fout
1948 itl(ng)%pioVar(idsbry(istvar(itrc)))%gtype=r3dobc
1949# endif
1950# ifdef ADJUST_STFLUX
1951 ELSE IF (trim(var_name(i)).eq. &
1952 & trim(vname(1,idtsur(itrc)))) THEN
1953 got_var(idtsur(itrc))=.true.
1954 itl(ng)%pioVar(idtsur(itrc))%vd=var_desc(i)
1955 itl(ng)%pioVar(idtsur(itrc))%dkind=pio_fout
1956 itl(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
1957# endif
1958 END IF
1959 END DO
1960# endif
1961 END DO
1962!
1963! Check if tangent linear mode initialization variables are available
1964! in input NetCDF file.
1965!
1966 IF (.not.got_var(idtime)) THEN
1967 IF (master) WRITE (stdout,70) trim(vname(1,idtime)), &
1968 & trim(ncname)
1969 exit_flag=3
1970 RETURN
1971 END IF
1972 IF (.not.got_var(idfsur)) THEN
1973 IF (master) WRITE (stdout,70) trim(vname(1,idfsur)), &
1974 & trim(ncname)
1975 exit_flag=3
1976 RETURN
1977 END IF
1978 IF (.not.got_var(idubar)) THEN
1979 IF (master) WRITE (stdout,70) trim(vname(1,idubar)), &
1980 & trim(ncname)
1981 exit_flag=3
1982 RETURN
1983 END IF
1984 IF (.not.got_var(idvbar)) THEN
1985 IF (master) WRITE (stdout,70) trim(vname(1,idvbar)), &
1986 & trim(ncname)
1987 exit_flag=3
1988 RETURN
1989 END IF
1990# ifdef ADJUST_BOUNDARY
1991 IF (.not.got_var(idsbry(isfsur)).and. &
1992 & any(lobc(:,isfsur,ng))) THEN
1993 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isfsur))), &
1994 & trim(ncname)
1995 exit_flag=3
1996 RETURN
1997 END IF
1998 IF (.not.got_var(idsbry(isubar)).and. &
1999 & any(lobc(:,isubar,ng))) THEN
2000 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isubar))), &
2001 & trim(ncname)
2002 exit_flag=3
2003 RETURN
2004 END IF
2005 IF (.not.got_var(idsbry(isvbar)).and. &
2006 & any(lobc(:,isvbar,ng))) THEN
2007 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvbar))), &
2008 & trim(ncname)
2009 exit_flag=3
2010 RETURN
2011 END IF
2012# endif
2013# ifdef ADJUST_WSTRESS
2014 IF (.not.got_var(idusms)) THEN
2015 IF (master) WRITE (stdout,70) trim(vname(1,idusms)), &
2016 & trim(ncname)
2017 exit_flag=3
2018 RETURN
2019 END IF
2020 IF (.not.got_var(idvsms)) THEN
2021 IF (master) WRITE (stdout,70) trim(vname(1,idvsms)), &
2022 & trim(ncname)
2023 exit_flag=3
2024 RETURN
2025 END IF
2026# endif
2027# ifdef SOLVE3D
2028 IF (.not.got_var(iduvel)) THEN
2029 IF (master) WRITE (stdout,70) trim(vname(1,iduvel)), &
2030 & trim(ncname)
2031 exit_flag=3
2032 RETURN
2033 END IF
2034 IF (.not.got_var(idvvel)) THEN
2035 IF (master) WRITE (stdout,70) trim(vname(1,idvvel)), &
2036 & trim(ncname)
2037 exit_flag=3
2038 RETURN
2039 END IF
2040# ifdef ADJUST_BOUNDARY
2041 IF (.not.got_var(idsbry(isuvel)).and. &
2042 & any(lobc(:,isuvel,ng))) THEN
2043 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isuvel))), &
2044 & trim(ncname)
2045 exit_flag=3
2046 RETURN
2047 END IF
2048 IF (.not.got_var(idsbry(isvvel)).and. &
2049 & any(lobc(:,isvvel,ng))) THEN
2050 IF (master) WRITE (stdout,70) trim(vname(1,idsbry(isvvel))), &
2051 & trim(ncname)
2052 exit_flag=3
2053 RETURN
2054 END IF
2055# endif
2056# endif
2057# ifdef SOLVE3D
2058 DO itrc=1,nt(ng)
2059 IF (.not.got_var(idtvar(itrc))) THEN
2060 IF (master) WRITE (stdout,70) trim(vname(1,idtvar(itrc))), &
2061 & trim(ncname)
2062 exit_flag=3
2063 RETURN
2064 END IF
2065# ifdef ADJUST_BOUNDARY
2066 IF (.not.got_var(idsbry(istvar(itrc))).and. &
2067 & any(lobc(:,istvar(itrc),ng))) THEN
2068 IF (master) WRITE (stdout,70) &
2069 & trim(vname(1,idsbry(istvar(itrc)))), &
2070 & trim(ncname)
2071 exit_flag=3
2072 RETURN
2073 END IF
2074# endif
2075# ifdef ADJUST_STFLUX
2076 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
2077 IF (master) WRITE (stdout,70) trim(vname(1,idtsur(itrc))), &
2078 & trim(ncname)
2079 exit_flag=3
2080 RETURN
2081 END IF
2082# endif
2083 END DO
2084# endif
2085!
2086! Set unlimited time record dimension to the appropriate value.
2087!
2088 itl(ng)%Rindex=rec_size
2089 fcount=itl(ng)%Fcount
2090 itl(ng)%Nrec(fcount)=rec_size
2091 END IF query
2092!
2093 10 FORMAT (2x,'TL_DEF_INI_PIO - creating initial file,',t56, &
2094 & 'Grid ',i2.2,': ',a)
2095 20 FORMAT (2x,'TL_DEF_INI_PIO - inquiring initial file,',t56, &
2096 & 'Grid ',i2.2,': ',a)
2097 30 FORMAT (/,' TL_DEF_INI_PIO - unable to create initial NetCDF', &
2098 & ' file:',1x,a)
2099 40 FORMAT ('tangent linear',1x,a)
2100 50 FORMAT (1pe11.4,1x,'millimeter')
2101 60 FORMAT (/,' TL_DEF_INI_PIO - unable to open initial NetCDF', &
2102 & ' file: ',a)
2103 70 FORMAT (/,' TL_DEF_INI_PIO - unable to find variable: ',a,2x, &
2104 & ' in file: ',a)
2105!
2106 RETURN
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::pio_fout
integer, parameter pio_fout
Definition mod_pio_netcdf.F:569
mod_pio_netcdf::var_desc
type(var_desc_t), dimension(:), pointer var_desc
Definition mod_pio_netcdf.F:437
mod_pio_netcdf::pio_netcdf_create
subroutine, public pio_netcdf_create(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:8997
mod_pio_netcdf::pio_netcdf_inq_var
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
Definition mod_pio_netcdf.F:1923
mod_pio_netcdf::pio_netcdf_open
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
Definition mod_pio_netcdf.F:9148
mod_pio_netcdf::pio_netcdf_check_dim
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:1080
mod_pio_netcdf::pio_tout
integer, parameter pio_tout
Definition mod_pio_netcdf.F:588
mod_pio_netcdf::pio_netcdf_enddef
subroutine, public pio_netcdf_enddef(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:9096

References mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::idfsur, mod_ncparam::idsbry, mod_ncparam::idtime, mod_ncparam::idtsur, mod_ncparam::idtvar, mod_ncparam::idubar, mod_ncparam::idusms, mod_ncparam::iduvel, mod_ncparam::idvbar, mod_ncparam::idvsms, mod_ncparam::idvvel, mod_ncparam::iinfo, mod_param::iobounds, mod_scalars::isalt, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::itemp, mod_iounits::itl, mod_param::itlm, mod_scalars::ldefitl, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_param::nbed, mod_scalars::nbrec, mod_scalars::nfrec, mod_scalars::noerror, mod_param::nst, mod_fourdvar::nstatevar, mod_param::nt, mod_ncparam::nv, mod_pio_netcdf::pio_fout, mod_pio_netcdf::pio_netcdf_check_dim(), mod_pio_netcdf::pio_netcdf_create(), mod_pio_netcdf::pio_netcdf_enddef(), mod_pio_netcdf::pio_netcdf_inq_var(), mod_pio_netcdf::pio_netcdf_open(), mod_pio_netcdf::pio_tout, mod_param::r2dobc, mod_param::r2dvar, mod_param::r3dobc, mod_param::r3dvar, mod_scalars::rclock, 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::v3dobc, mod_param::v3dvar, mod_pio_netcdf::var_desc, and mod_ncparam::vname.

Referenced by tl_def_ini().

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