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

Functions/Subroutines

subroutine, public def_dai (ng)
 
subroutine, private def_dai_nf90 (ng)
 
subroutine, private def_dai_pio (ng)
 

Function/Subroutine Documentation

◆ def_dai()

subroutine, public def_dai_mod::def_dai ( integer, intent(in) ng)

Definition at line 51 of file def_dai.F.

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

References mod_iounits::dai, def_dai_nf90(), def_dai_pio(), mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_parallel::master, mod_scalars::noerror, and mod_iounits::stdout.

Here is the call graph for this function:

◆ def_dai_nf90()

subroutine, private def_dai_mod::def_dai_nf90 ( integer, intent(in) ng)
private

Definition at line 88 of file def_dai.F.

89!***********************************************************************
90!
91 USE mod_netcdf
92!
93! Imported variable declarations.
94!
95 integer, intent(in) :: ng
96!
97! Local variable declarations.
98!
99 logical :: got_var(NV)
100!
101 integer, parameter :: Natt = 25
102
103 integer :: i, j, itrc, nvd3, nvd4
104 integer :: recdim, status, varid
105
106 integer :: DimIDs(nDimID)
107 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
108# ifdef SOLVE3D
109 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
110# endif
111!
112 real(r8) :: Aval(6)
113!
114 character (len=256) :: ncname
115 character (len=MaxLen) :: Vinfo(Natt)
116
117 character (len=*), parameter :: MyFile = &
118 & __FILE__//", def_dai_nf90"
119!
120 sourcefile=myfile
121!
122!-----------------------------------------------------------------------
123! Set and report file name.
124!-----------------------------------------------------------------------
125!
126 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
127 ncname=dai(ng)%name
128!
129 IF (master) THEN
130 IF (ldefdai(ng)) THEN
131 WRITE (stdout,10) ng, trim(ncname)
132 ELSE
133 WRITE (stdout,20) ng, trim(ncname)
134 END IF
135 END IF
136!
137!=======================================================================
138! Create a new Data Assimilation initial/restart NetCDF file.
139!=======================================================================
140!
141 define : IF (ldefdai(ng)) THEN
142 CALL netcdf_create (ng, inlm, trim(ncname), dai(ng)%ncid)
143 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
144 IF (master) WRITE (stdout,30) trim(ncname)
145 RETURN
146 END IF
147!
148!-----------------------------------------------------------------------
149! Define file dimensions.
150!-----------------------------------------------------------------------
151!
152 dimids=0
153!
154 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'xi_rho', &
155 & iobounds(ng)%xi_rho, dimids( 1))
156 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
157
158 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'xi_u', &
159 & iobounds(ng)%xi_u, dimids( 2))
160 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
161
162 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'xi_v', &
163 & iobounds(ng)%xi_v, dimids( 3))
164 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
165
166 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'xi_psi', &
167 & iobounds(ng)%xi_psi, dimids( 4))
168 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
169
170 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'eta_rho', &
171 & iobounds(ng)%eta_rho, dimids( 5))
172 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
173
174 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'eta_u', &
175 & iobounds(ng)%eta_u, dimids( 6))
176 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
177
178 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'eta_v', &
179 & iobounds(ng)%eta_v, dimids( 7))
180 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
181
182 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'eta_psi', &
183 & iobounds(ng)%eta_psi, dimids( 8))
184 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
185
186# ifdef SOLVE3D
187 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'N', &
188 & n(ng), dimids( 9))
189 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
190
191 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 's_rho', &
192 & n(ng), dimids( 9))
193 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
194
195 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 's_w', &
196 & n(ng)+1, dimids(10))
197 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
198
199 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'tracer', &
200 & nt(ng), dimids(11))
201 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
202
203# ifdef SEDIMENT
204 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'NST', &
205 & nst, dimids(32))
206 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
207
208 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'Nbed', &
209 & nbed, dimids(16))
210 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
211# endif
212# ifdef ECOSIM
213 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'Nbands', &
214 & nbands, dimids(33))
215 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
216
217 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'Nphy', &
218 & nphy, dimids(25))
219 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
220
221 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'Nbac', &
222 & nbac, dimids(26))
223 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
224
225 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'Ndom', &
226 & ndom, dimids(27))
227 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
228
229 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'Nfec', &
230 & nfec, dimids(28))
231 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
232# endif
233# endif
234
235 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'boundary', &
236 & 4, dimids(14))
237 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
238
239#ifdef FOUR_DVAR
240 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, 'Nstate', &
241 & nstatevar(ng), dimids(29))
242 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
243#endif
244
245 status=def_dim(ng, inlm, dai(ng)%ncid, ncname, &
246 & trim(adjustl(vname(5,idtime))), &
247 & nf90_unlimited, dimids(12))
248 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
249
250 recdim=dimids(12)
251!
252! Set number of dimensions for output variables.
253!
254 nvd3=3
255 nvd4=4
256!
257! Define dimension vectors for staggered tracer type variables.
258!
259 t2dgrd(1)=dimids( 1)
260 t2dgrd(2)=dimids( 5)
261 t2dgrd(3)=dimids(12)
262# ifdef SOLVE3D
263 t3dgrd(1)=dimids( 1)
264 t3dgrd(2)=dimids( 5)
265 t3dgrd(3)=dimids( 9)
266 t3dgrd(4)=dimids(12)
267# endif
268!
269! Define dimension vectors for staggered u-momentum type variables.
270!
271 u2dgrd(1)=dimids( 2)
272 u2dgrd(2)=dimids( 6)
273 u2dgrd(3)=dimids(12)
274# ifdef SOLVE3D
275 u3dgrd(1)=dimids( 2)
276 u3dgrd(2)=dimids( 6)
277 u3dgrd(3)=dimids( 9)
278 u3dgrd(4)=dimids(12)
279# endif
280!
281! Define dimension vectors for staggered v-momentum type variables.
282!
283 v2dgrd(1)=dimids( 3)
284 v2dgrd(2)=dimids( 7)
285 v2dgrd(3)=dimids(12)
286# ifdef SOLVE3D
287 v3dgrd(1)=dimids( 3)
288 v3dgrd(2)=dimids( 7)
289 v3dgrd(3)=dimids( 9)
290 v3dgrd(4)=dimids(12)
291# endif
292# ifdef SOLVE3D
293!
294! Define dimension vector for staggered w-momentum type variables.
295!
296 w3dgrd(1)=dimids( 1)
297 w3dgrd(2)=dimids( 5)
298 w3dgrd(3)=dimids(10)
299 w3dgrd(4)=dimids(12)
300# endif
301!
302! Initialize unlimited time record dimension.
303!
304 dai(ng)%Rindex=0
305!
306! Initialize local information variable arrays.
307!
308 DO i=1,natt
309 DO j=1,len(vinfo(1))
310 vinfo(i)(j:j)=' '
311 END DO
312 END DO
313 DO i=1,6
314 aval(i)=0.0_r8
315 END DO
316!
317!-----------------------------------------------------------------------
318! Define time-recordless information variables.
319!-----------------------------------------------------------------------
320!
321 CALL def_info (ng, inlm, dai(ng)%ncid, ncname, dimids)
322 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
323
324# ifdef SOLVE3D
325!
326! Define time independent (unperturb) depths of RHO-points.
327!
328 vinfo( 1)=vname(1,idpthr)
329 WRITE (vinfo( 2),40) trim(vname(2,idpthr))
330 vinfo( 3)=vname(3,idpthr)
331 vinfo(11)='downwards'
332 vinfo(22)='coordinates'
333 aval(5)=real(iinfo(1,idpthr,ng),r8)
334 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(idpthr), &
335 & nf_frst, nvd3, t3dgrd, aval, vinfo, ncname, &
336 & setfillval = .false.)
337 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
338!
339! Define time independent (unperturb) depths of U-points.
340!
341 vinfo( 1)=vname(1,idpthu)
342 WRITE (vinfo( 2),40) trim(vname(2,idpthu))
343 vinfo( 3)=vname(3,idpthu)
344 vinfo(11)='downwards'
345 vinfo(22)='coordinates'
346 aval(5)=real(iinfo(1,idpthu,ng),r8)
347 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(idpthu), &
348 & nf_frst, nvd3, u3dgrd, aval, vinfo, ncname, &
349 & setfillval = .false.)
350 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
351!
352! Define time independent (unperturb) depths of V-points.
353!
354 vinfo( 1)=vname(1,idpthv)
355 WRITE (vinfo( 2),40) trim(vname(2,idpthv))
356 vinfo( 3)=vname(3,idpthv)
357 vinfo(11)='downwards'
358 vinfo(22)='coordinates'
359 aval(5)=real(iinfo(1,idpthv,ng),r8)
360 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(idpthv), &
361 & nf_frst, nvd3, v3dgrd, aval, vinfo, ncname, &
362 & setfillval = .false.)
363 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
364!
365! Define time independent (unperturb) depths of W-points.
366!
367 vinfo( 1)=vname(1,idpthw)
368 WRITE (vinfo( 2),40) trim(vname(2,idpthw))
369 vinfo( 3)=vname(3,idpthw)
370 vinfo(11)='downwards'
371 vinfo(22)='coordinates'
372 aval(5)=real(iinfo(1,idpthw,ng),r8)
373 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(idpthw), &
374 & nf_frst, nvd3, w3dgrd, aval, vinfo, ncname, &
375 & setfillval = .false.)
376 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
377# endif
378!
379!-----------------------------------------------------------------------
380! Define time-varying variables.
381!-----------------------------------------------------------------------
382!
383! Define model time.
384!
385 vinfo( 1)=vname(1,idtime)
386 vinfo( 2)=vname(2,idtime)
387 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
388 vinfo( 4)=trim(rclock%calendar)
389 vinfo(14)=vname(4,idtime)
390 vinfo(21)=vname(6,idtime)
391 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(idtime), &
392 & nf_tout, 1, (/recdim/), aval, vinfo, ncname, &
393 & setparaccess = .true.)
394 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
395!
396! Define free-surface.
397!
398 vinfo( 1)=vname(1,idfsur)
399 vinfo( 2)=vname(2,idfsur)
400 vinfo( 3)=vname(3,idfsur)
401 vinfo(14)=vname(4,idfsur)
402 vinfo(16)=vname(1,idtime)
403 vinfo(21)=vname(6,idfsur)
404 vinfo(22)='coordinates'
405 aval(5)=real(iinfo(1,idfsur,ng),r8)
406 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(idfsur), &
407# ifdef WET_DRY
408 & nf_frst, nvd3, t2dgrd, aval, vinfo, ncname, &
409 & setfillval = .false.)
410# else
411 & nf_frst, nvd3, t2dgrd, aval, vinfo, ncname)
412
413# endif
414 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
415!
416! Define 2D momentum in the XI-direction.
417!
418 vinfo( 1)=vname(1,idubar)
419 vinfo( 2)=vname(2,idubar)
420 vinfo( 3)=vname(3,idubar)
421 vinfo(14)=vname(4,idubar)
422 vinfo(16)=vname(1,idtime)
423 vinfo(21)=vname(6,idubar)
424 vinfo(22)='coordinates'
425 aval(5)=real(iinfo(1,idubar,ng),r8)
426 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(idubar), &
427 & nf_frst, nvd3, u2dgrd, aval, vinfo, ncname)
428 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
429!
430! Define 2D momentum in the ETA-direction.
431!
432 vinfo( 1)=vname(1,idvbar)
433 vinfo( 2)=vname(2,idvbar)
434 vinfo( 3)=vname(3,idvbar)
435 vinfo(14)=vname(4,idvbar)
436 vinfo(16)=vname(1,idtime)
437 vinfo(21)=vname(6,idvbar)
438 vinfo(22)='coordinates'
439 aval(5)=real(iinfo(1,idvbar,ng),r8)
440 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(idvbar), &
441 & nf_frst, nvd3, v2dgrd, aval, vinfo, ncname)
442 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
443
444# ifdef SOLVE3D
445!
446! Define 3D momentum component in the XI-direction.
447!
448 vinfo( 1)=vname(1,iduvel)
449 vinfo( 2)=vname(2,iduvel)
450 vinfo( 3)=vname(3,iduvel)
451 vinfo(14)=vname(4,iduvel)
452 vinfo(16)=vname(1,idtime)
453 vinfo(21)=vname(6,iduvel)
454 vinfo(22)='coordinates'
455 aval(5)=real(iinfo(1,iduvel,ng),r8)
456 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(iduvel), &
457 & nf_frst, nvd4, u3dgrd, aval, vinfo, ncname)
458 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
459!
460! Define 3D momentum component in the ETA-direction.
461!
462 vinfo( 1)=vname(1,idvvel)
463 vinfo( 2)=vname(2,idvvel)
464 vinfo( 3)=vname(3,idvvel)
465 vinfo(14)=vname(4,idvvel)
466 vinfo(16)=vname(1,idtime)
467 vinfo(21)=vname(6,idvvel)
468 vinfo(22)='coordinates'
469 aval(5)=real(iinfo(1,idvvel,ng),r8)
470 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(idvvel), &
471 & nf_frst, nvd4, v3dgrd, aval, vinfo, ncname)
472 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
473!
474! Define tracer type variables.
475!
476 DO itrc=1,nt(ng)
477 vinfo( 1)=vname(1,idtvar(itrc))
478 vinfo( 2)=vname(2,idtvar(itrc))
479 vinfo( 3)=vname(3,idtvar(itrc))
480 vinfo(14)=vname(4,idtvar(itrc))
481 vinfo(16)=vname(1,idtime)
482# ifdef SEDIMENT
483 DO i=1,nst
484 IF (itrc.eq.idsed(i)) THEN
485 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
486 END IF
487 END DO
488# endif
489 vinfo(21)=vname(6,idtvar(itrc))
490 vinfo(22)='coordinates'
491 aval(5)=real(r3dvar,r8)
492 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Tid(itrc), &
493 & nf_frst, nvd4, t3dgrd, aval, vinfo, ncname)
494 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
495 END DO
496!
497! Define vertical viscosity coefficient.
498!
499 vinfo( 1)=vname(1,idvvis)
500 vinfo( 2)=vname(2,idvvis)
501 vinfo( 3)=vname(3,idvvis)
502 vinfo(14)=vname(4,idvvis)
503 vinfo(16)=vname(1,idtime)
504 vinfo(21)=vname(6,idvvis)
505 vinfo(22)='coordinates'
506 aval(5)=real(iinfo(1,idvvis,ng),r8)
507 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(idvvis), &
508 & nf_frst, nvd4, w3dgrd, aval, vinfo, ncname, &
509 & setfillval = .false.)
510 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
511!
512! Define vertical diffusion coefficient for potential temperature.
513!
514 vinfo( 1)=vname(1,idtdif)
515 vinfo( 2)=vname(2,idtdif)
516 vinfo( 3)=vname(3,idtdif)
517 vinfo(14)=vname(4,idtdif)
518 vinfo(16)=vname(1,idtime)
519 vinfo(21)=vname(6,idtdif)
520 vinfo(22)='coordinates'
521 aval(5)=real(iinfo(1,idtdif,ng),r8)
522 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(idtdif), &
523 & nf_frst, nvd4, w3dgrd, aval, vinfo, ncname, &
524 & setfillval = .false.)
525 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
526# ifdef SALINITY
527!
528! Define vertical diffusion coefficient for salinity.
529!
530 vinfo( 1)=vname(1,idsdif)
531 vinfo( 2)=vname(2,idsdif)
532 vinfo( 3)=vname(3,idsdif)
533 vinfo(14)=vname(4,idsdif)
534 vinfo(16)=vname(1,idtime)
535 vinfo(21)=vname(6,idsdif)
536 vinfo(22)='coordinates'
537 aval(5)=real(iinfo(1,idsdif,ng),r8)
538 status=def_var(ng, inlm, dai(ng)%ncid, dai(ng)%Vid(idsdif), &
539 & nf_frst, nvd4, w3dgrd, aval, vinfo, ncname, &
540 & setfillval = .false.)
541 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
542# endif
543# endif
544!
545!-----------------------------------------------------------------------
546! Leave definition mode.
547!-----------------------------------------------------------------------
548!
549 CALL netcdf_enddef (ng, inlm, ncname, dai(ng)%ncid)
550 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
551!
552!-----------------------------------------------------------------------
553! Write out time-recordless, information variables.
554!-----------------------------------------------------------------------
555!
556 CALL wrt_info (ng, inlm, dai(ng)%ncid, ncname)
557 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
558
559 END IF define
560!
561!=======================================================================
562! Open an existing Data Assimilation initial/restart file, check its
563! contents, and prepare for appending data.
564!=======================================================================
565!
566 query : IF (.not.ldefdai(ng)) THEN
567 ncname=dai(ng)%name
568!
569! Open restart file for read/write.
570!
571 CALL netcdf_open (ng, inlm, ncname, 1, dai(ng)%ncid)
572 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
573 WRITE (stdout,60) trim(ncname)
574 RETURN
575 END IF
576!
577! Inquire about the dimensions and check for consistency.
578!
579 CALL netcdf_check_dim (ng, inlm, ncname, &
580 & ncid = dai(ng)%ncid)
581 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
582!
583! Inquire about the variables.
584!
585 CALL netcdf_inq_var (ng, inlm, ncname, &
586 & ncid = dai(ng)%ncid)
587 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
588!
589! Initialize logical switches.
590!
591 DO i=1,nv
592 got_var(i)=.false.
593 END DO
594!
595! Scan variable list from input NetCDF and activate switches for
596! Data Assimilation initial/restart variables. Get variable IDs.
597!
598 DO i=1,n_var
599 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
600 got_var(idtime)=.true.
601 dai(ng)%Vid(idtime)=var_id(i)
602 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
603 got_var(idfsur)=.true.
604 dai(ng)%Vid(idfsur)=var_id(i)
605 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
606 got_var(idubar)=.true.
607 dai(ng)%Vid(idubar)=var_id(i)
608 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
609 got_var(idvbar)=.true.
610 dai(ng)%Vid(idvbar)=var_id(i)
611# ifdef SOLVE3D
612 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
613 got_var(iduvel)=.true.
614 dai(ng)%Vid(iduvel)=var_id(i)
615 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
616 got_var(idvvel)=.true.
617 dai(ng)%Vid(idvvel)=var_id(i)
618 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvis))) THEN
619 got_var(idvvis)=.true.
620 dai(ng)%Vid(idvvis)=var_id(i)
621 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idtdif))) THEN
622 got_var(idtdif)=.true.
623 dai(ng)%Vid(idtdif)=var_id(i)
624 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idsdif))) THEN
625 got_var(idsdif)=.true.
626 dai(ng)%Vid(idsdif)=var_id(i)
627# endif
628 END IF
629# ifdef SOLVE3D
630 DO itrc=1,nt(ng)
631 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
632 got_var(idtvar(itrc))=.true.
633 dai(ng)%Tid(itrc)=var_id(i)
634 END IF
635 END DO
636# endif
637 END DO
638!
639! Check if initialization variables are available in input NetCDF
640! file.
641!
642 IF (.not.got_var(idtime)) THEN
643 IF (master) WRITE (stdout,70) trim(vname(1,idtime)), &
644 & trim(ncname)
645 exit_flag=3
646 RETURN
647 END IF
648 IF (.not.got_var(idfsur)) THEN
649 IF (master) WRITE (stdout,70) trim(vname(1,idfsur)), &
650 & trim(ncname)
651 exit_flag=3
652 RETURN
653 END IF
654 IF (.not.got_var(idubar)) THEN
655 IF (master) WRITE (stdout,70) trim(vname(1,idubar)), &
656 & trim(ncname)
657 exit_flag=3
658 RETURN
659 END IF
660 IF (.not.got_var(idvbar)) THEN
661 IF (master) WRITE (stdout,70) trim(vname(1,idvbar)), &
662 & trim(ncname)
663 exit_flag=3
664 RETURN
665 END IF
666# ifdef SOLVE3D
667 IF (.not.got_var(iduvel)) THEN
668 IF (master) WRITE (stdout,70) trim(vname(1,iduvel)), &
669 & trim(ncname)
670 exit_flag=3
671 RETURN
672 END IF
673 IF (.not.got_var(idvvel)) THEN
674 IF (master) WRITE (stdout,70) trim(vname(1,idvvel)), &
675 & trim(ncname)
676 exit_flag=3
677 RETURN
678 END IF
679 DO itrc=1,nt(ng)
680 IF (.not.got_var(idtvar(itrc))) THEN
681 IF (master) WRITE (stdout,70) trim(vname(1,idtvar(itrc))), &
682 & trim(ncname)
683 exit_flag=3
684 RETURN
685 END IF
686 END DO
687 IF (.not.got_var(idvvis)) THEN
688 IF (master) WRITE (stdout,70) trim(vname(1,idvvis)), &
689 & trim(ncname)
690 exit_flag=3
691 RETURN
692 END IF
693 IF (.not.got_var(idtdif)) THEN
694 IF (master) WRITE (stdout,70) trim(vname(1,idtdif)), &
695 & trim(ncname)
696 exit_flag=3
697 RETURN
698 END IF
699# ifdef SALINITY
700 IF (.not.got_var(idsdif)) THEN
701 IF (master) WRITE (stdout,70) trim(vname(1,idsdif)), &
702 & trim(ncname)
703 exit_flag=3
704 RETURN
705 END IF
706# endif
707# endif
708!
709! Set unlimited time record dimension to current value.
710!
711 dai(ng)%Rindex=rec_size
712 END IF query
713!
714 10 FORMAT (/,2x,'DEF_DAI_NF90 - creating DA INI/RST file,',t56, &
715 & 'Grid ',i2.2,': ',a)
716 20 FORMAT (/,2x,'DEF_DAI_NF90 - inquiring DA INI/RST file,',t56, &
717 & 'Grid ',i2.2,': ',a)
718 30 FORMAT (/,' DEF_DAI_NF90 - unable to create DA initial/restart', &
719 & ' NetCDF file: ',a)
720 40 FORMAT ('time independent',1x,a)
721 50 FORMAT (1pe11.4,1x,'millimeter')
722 60 FORMAT (/,' DEF_DAI_NF90 - unable to open DA initial/restart' &
723 & ' NetCDF file: ',a)
724 70 FORMAT (/,' DEF_DAI_NF90 - unable to find variable: ',a,2x, &
725 & ' in DA initial/restart NetCDF file: ',a)
726!
727 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::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
mod_netcdf::nf_frst
integer, parameter nf_frst
Definition mod_netcdf.F:193

References mod_iounits::dai, mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::idfsur, mod_ncparam::idpthr, mod_ncparam::idpthu, mod_ncparam::idpthv, mod_ncparam::idpthw, mod_ncparam::idsdif, mod_sediment::idsed, mod_ncparam::idtdif, mod_ncparam::idtime, mod_ncparam::idtvar, mod_ncparam::idubar, mod_ncparam::iduvel, mod_ncparam::idvbar, mod_ncparam::idvvel, mod_ncparam::idvvis, mod_ncparam::iinfo, mod_param::inlm, mod_param::iobounds, mod_scalars::ldefdai, mod_parallel::master, mod_param::n, mod_netcdf::n_var, mod_biology::nbac, mod_biology::nbands, mod_param::nbed, 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_frst, mod_netcdf::nf_tout, mod_biology::nfec, mod_scalars::noerror, mod_biology::nphy, mod_param::nst, mod_fourdvar::nstatevar, mod_param::nt, 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 def_dai().

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

◆ def_dai_pio()

subroutine, private def_dai_mod::def_dai_pio ( integer, intent(in) ng)
private

Definition at line 733 of file def_dai.F.

734!***********************************************************************
735!
736 USE mod_pio_netcdf
737!
738! Imported variable declarations.
739!
740 integer, intent(in) :: ng
741!
742! Local variable declarations.
743!
744 logical :: got_var(NV)
745!
746 integer, parameter :: Natt = 25
747
748 integer :: i, j, itrc, nvd3, nvd4
749 integer :: recdim, status
750
751 integer :: DimIDs(nDimID)
752 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
753# ifdef SOLVE3D
754 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
755# endif
756!
757 real(r8) :: Aval(6)
758!
759 character (len=256) :: ncname
760 character (len=MaxLen) :: Vinfo(Natt)
761
762 character (len=*), parameter :: MyFile = &
763 & __FILE__//", def_dai_pio"
764!
765 sourcefile=myfile
766!
767!-----------------------------------------------------------------------
768! Set and report file name.
769!-----------------------------------------------------------------------
770!
771 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
772 ncname=dai(ng)%name
773!
774 IF (master) THEN
775 IF (ldefdai(ng)) THEN
776 WRITE (stdout,10) ng, trim(ncname)
777 ELSE
778 WRITE (stdout,20) ng, trim(ncname)
779 END IF
780 END IF
781!
782!=======================================================================
783! Create a new Data Assimilation initial/restart NetCDF file.
784!=======================================================================
785!
786 define : IF (ldefdai(ng)) THEN
787 CALL pio_netcdf_create (ng, inlm, trim(ncname), dai(ng)%pioFile)
788 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
789 IF (master) WRITE (stdout,30) trim(ncname)
790 RETURN
791 END IF
792!
793!-----------------------------------------------------------------------
794! Define file dimensions.
795!-----------------------------------------------------------------------
796!
797 dimids=0
798!
799 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'xi_rho', &
800 & iobounds(ng)%xi_rho, dimids( 1))
801 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
802
803 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'xi_u', &
804 & iobounds(ng)%xi_u, dimids( 2))
805 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
806
807 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'xi_v', &
808 & iobounds(ng)%xi_v, dimids( 3))
809 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
810
811 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'xi_psi', &
812 & iobounds(ng)%xi_psi, dimids( 4))
813 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
814
815 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'eta_rho', &
816 & iobounds(ng)%eta_rho, dimids( 5))
817 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
818
819 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'eta_u', &
820 & iobounds(ng)%eta_u, dimids( 6))
821 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
822
823 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'eta_v', &
824 & iobounds(ng)%eta_v, dimids( 7))
825 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
826
827 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'eta_psi', &
828 & iobounds(ng)%eta_psi, dimids( 8))
829 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
830
831# ifdef SOLVE3D
832 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'N', &
833 & n(ng), dimids( 9))
834 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
835
836 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 's_rho', &
837 & n(ng), dimids( 9))
838 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
839
840 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 's_w', &
841 & n(ng)+1, dimids(10))
842 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
843
844 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'tracer', &
845 & nt(ng), dimids(11))
846 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
847
848# ifdef SEDIMENT
849 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'NST', &
850 & nst, dimids(32))
851 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
852
853 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'Nbed', &
854 & nbed, dimids(16))
855 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
856# endif
857# ifdef ECOSIM
858 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'Nbands', &
859 & nbands, dimids(33))
860 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
861
862 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'Nphy', &
863 & nphy, dimids(25))
864 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
865
866 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'Nbac', &
867 & nbac, dimids(26))
868 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
869
870 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'Ndom', &
871 & ndom, dimids(27))
872 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
873
874 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'Nfec', &
875 & nfec, dimids(28))
876 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
877# endif
878# endif
879
880 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'boundary', &
881 & 4, dimids(14))
882 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
883
884# ifdef FOUR_DVAR
885 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, 'Nstate', &
886 & nstatevar(ng), dimids(29))
887 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
888# endif
889
890 status=def_dim(ng, inlm, dai(ng)%pioFile, ncname, &
891 & trim(adjustl(vname(5,idtime))), &
892 & pio_unlimited, dimids(12))
893 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
894
895 recdim=dimids(12)
896!
897! Set number of dimensions for output variables.
898!
899 nvd3=3
900 nvd4=4
901!
902! Define dimension vectors for staggered tracer type variables.
903!
904 t2dgrd(1)=dimids( 1)
905 t2dgrd(2)=dimids( 5)
906 t2dgrd(3)=dimids(12)
907# ifdef SOLVE3D
908 t3dgrd(1)=dimids( 1)
909 t3dgrd(2)=dimids( 5)
910 t3dgrd(3)=dimids( 9)
911 t3dgrd(4)=dimids(12)
912# endif
913!
914! Define dimension vectors for staggered u-momentum type variables.
915!
916 u2dgrd(1)=dimids( 2)
917 u2dgrd(2)=dimids( 6)
918 u2dgrd(3)=dimids(12)
919# ifdef SOLVE3D
920 u3dgrd(1)=dimids( 2)
921 u3dgrd(2)=dimids( 6)
922 u3dgrd(3)=dimids( 9)
923 u3dgrd(4)=dimids(12)
924# endif
925!
926! Define dimension vectors for staggered v-momentum type variables.
927!
928 v2dgrd(1)=dimids( 3)
929 v2dgrd(2)=dimids( 7)
930 v2dgrd(3)=dimids(12)
931# ifdef SOLVE3D
932 v3dgrd(1)=dimids( 3)
933 v3dgrd(2)=dimids( 7)
934 v3dgrd(3)=dimids( 9)
935 v3dgrd(4)=dimids(12)
936# endif
937# ifdef SOLVE3D
938!
939! Define dimension vector for staggered w-momentum type variables.
940!
941 w3dgrd(1)=dimids( 1)
942 w3dgrd(2)=dimids( 5)
943 w3dgrd(3)=dimids(10)
944 w3dgrd(4)=dimids(12)
945# endif
946!
947! Initialize unlimited time record dimension.
948!
949 dai(ng)%Rindex=0
950!
951! Initialize local information variable arrays.
952!
953 DO i=1,natt
954 DO j=1,len(vinfo(1))
955 vinfo(i)(j:j)=' '
956 END DO
957 END DO
958 DO i=1,6
959 aval(i)=0.0_r8
960 END DO
961!
962!-----------------------------------------------------------------------
963! Define time-recordless information variables.
964!-----------------------------------------------------------------------
965!
966 CALL def_info (ng, inlm, dai(ng)%pioFile, ncname, dimids)
967 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
968
969# ifdef SOLVE3D
970!
971! Define time independent (unperturb) depths of RHO-points.
972!
973 vinfo( 1)=vname(1,idpthr)
974 WRITE (vinfo( 2),40) trim(vname(2,idpthr))
975 vinfo( 3)=vname(3,idpthr)
976 vinfo(11)='downwards'
977 vinfo(22)='coordinates'
978 aval(5)=real(iinfo(1,idpthr,ng),r8)
979 dai(ng)%pioVar(idpthr)%dkind=pio_frst
980 dai(ng)%pioVar(idpthr)%gtype=r3dvar
981!
982 status=def_var(ng, inlm, dai(ng)%pioFile, &
983 & dai(ng)%pioVar(idpthr)%vd, &
984 & pio_frst, nvd3, t3dgrd, aval, vinfo, ncname, &
985 & setfillval = .false.)
986 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
987!
988! Define time independent (unperturb) depths of U-points.
989!
990 vinfo( 1)=vname(1,idpthu)
991 WRITE (vinfo( 2),40) trim(vname(2,idpthu))
992 vinfo( 3)=vname(3,idpthu)
993 vinfo(11)='downwards'
994 vinfo(22)='coordinates'
995 aval(5)=real(iinfo(1,idpthu,ng),r8)
996 dai(ng)%pioVar(idpthu)%dkind=pio_frst
997 dai(ng)%pioVar(idpthu)%gtype=u3dvar
998!
999 status=def_var(ng, inlm, dai(ng)%pioFile, &
1000 & dai(ng)%pioVar(idpthu)%vd, &
1001 & pio_frst, nvd3, u3dgrd, aval, vinfo, ncname, &
1002 & setfillval = .false.)
1003 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1004!
1005! Define time independent (unperturb) depths of V-points.
1006!
1007 vinfo( 1)=vname(1,idpthv)
1008 WRITE (vinfo( 2),40) trim(vname(2,idpthv))
1009 vinfo( 3)=vname(3,idpthv)
1010 vinfo(11)='downwards'
1011 vinfo(22)='coordinates'
1012 aval(5)=real(iinfo(1,idpthv,ng),r8)
1013 dai(ng)%pioVar(idpthv)%dkind=pio_frst
1014 dai(ng)%pioVar(idpthv)%gtype=v3dvar
1015!
1016 status=def_var(ng, inlm, dai(ng)%pioFile, &
1017 & dai(ng)%pioVar(idpthv)%vd, &
1018 & pio_frst, nvd3, v3dgrd, aval, vinfo, ncname, &
1019 & setfillval = .false.)
1020 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1021!
1022! Define time independent (unperturb) depths of W-points.
1023!
1024 vinfo( 1)=vname(1,idpthw)
1025 WRITE (vinfo( 2),40) trim(vname(2,idpthw))
1026 vinfo( 3)=vname(3,idpthw)
1027 vinfo(11)='downwards'
1028 vinfo(22)='coordinates'
1029 aval(5)=real(iinfo(1,idpthw,ng),r8)
1030 dai(ng)%pioVar(idpthw)%dkind=pio_frst
1031 dai(ng)%pioVar(idpthw)%gtype=w3dvar
1032!
1033 status=def_var(ng, inlm, dai(ng)%pioFile, &
1034 & dai(ng)%pioVar(idpthw)%vd, &
1035 & pio_frst, nvd3, w3dgrd, aval, vinfo, ncname, &
1036 & setfillval = .false.)
1037 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1038# endif
1039!
1040!-----------------------------------------------------------------------
1041! Define time-varying variables.
1042!-----------------------------------------------------------------------
1043!
1044! Define model time.
1045!
1046 vinfo( 1)=vname(1,idtime)
1047 vinfo( 2)=vname(2,idtime)
1048 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
1049 vinfo( 4)=trim(rclock%calendar)
1050 vinfo(14)=vname(4,idtime)
1051 vinfo(21)=vname(6,idtime)
1052 dai(ng)%pioVar(idtime)%dkind=pio_tout
1053 dai(ng)%pioVar(idtime)%gtype=0
1054!
1055 status=def_var(ng, inlm, dai(ng)%pioFile, &
1056 & dai(ng)%pioVar(idtime)%vd, &
1057 & pio_tout, 1, (/recdim/), aval, vinfo, ncname, &
1058 & setparaccess = .true.)
1059 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1060!
1061! Define free-surface.
1062!
1063 vinfo( 1)=vname(1,idfsur)
1064 vinfo( 2)=vname(2,idfsur)
1065 vinfo( 3)=vname(3,idfsur)
1066 vinfo(14)=vname(4,idfsur)
1067 vinfo(16)=vname(1,idtime)
1068 vinfo(21)=vname(6,idfsur)
1069 vinfo(22)='coordinates'
1070 aval(5)=real(iinfo(1,idfsur,ng),r8)
1071 dai(ng)%pioVar(idfsur)%dkind=pio_frst
1072 dai(ng)%pioVar(idfsur)%gtype=r2dvar
1073!
1074 status=def_var(ng, inlm, dai(ng)%pioFile, &
1075 & dai(ng)%pioVar(idfsur)%vd, &
1076# ifdef WET_DRY
1077 & pio_frst, nvd3, t2dgrd, aval, vinfo, ncname, &
1078 & setfillval = .false.)
1079# else
1080 & pio_frst, nvd3, t2dgrd, aval, vinfo, ncname)
1081
1082# endif
1083 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1084!
1085! Define 2D momentum in the XI-direction.
1086!
1087 vinfo( 1)=vname(1,idubar)
1088 vinfo( 2)=vname(2,idubar)
1089 vinfo( 3)=vname(3,idubar)
1090 vinfo(14)=vname(4,idubar)
1091 vinfo(16)=vname(1,idtime)
1092 vinfo(21)=vname(6,idubar)
1093 vinfo(22)='coordinates'
1094 aval(5)=real(iinfo(1,idubar,ng),r8)
1095 dai(ng)%pioVar(idubar)%dkind=pio_frst
1096 dai(ng)%pioVar(idubar)%gtype=u2dvar
1097!
1098 status=def_var(ng, inlm, dai(ng)%pioFile, &
1099 & dai(ng)%pioVar(idubar)%vd, &
1100 & pio_frst, nvd3, u2dgrd, aval, vinfo, ncname)
1101 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1102!
1103! Define 2D momentum in the ETA-direction.
1104!
1105 vinfo( 1)=vname(1,idvbar)
1106 vinfo( 2)=vname(2,idvbar)
1107 vinfo( 3)=vname(3,idvbar)
1108 vinfo(14)=vname(4,idvbar)
1109 vinfo(16)=vname(1,idtime)
1110 vinfo(21)=vname(6,idvbar)
1111 vinfo(22)='coordinates'
1112 aval(5)=real(iinfo(1,idvbar,ng),r8)
1113 dai(ng)%pioVar(idvbar)%dkind=pio_frst
1114 dai(ng)%pioVar(idvbar)%gtype=v2dvar
1115!
1116 status=def_var(ng, inlm, dai(ng)%pioFile, &
1117 & dai(ng)%pioVar(idvbar)%vd, &
1118 & pio_frst, nvd3, v2dgrd, aval, vinfo, ncname)
1119 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1120
1121# ifdef SOLVE3D
1122!
1123! Define 3D momentum component in the XI-direction.
1124!
1125 vinfo( 1)=vname(1,iduvel)
1126 vinfo( 2)=vname(2,iduvel)
1127 vinfo( 3)=vname(3,iduvel)
1128 vinfo(14)=vname(4,iduvel)
1129 vinfo(16)=vname(1,idtime)
1130 vinfo(21)=vname(6,iduvel)
1131 vinfo(22)='coordinates'
1132 aval(5)=real(iinfo(1,iduvel,ng),r8)
1133 dai(ng)%pioVar(iduvel)%dkind=pio_frst
1134 dai(ng)%pioVar(iduvel)%gtype=u3dvar
1135!
1136 status=def_var(ng, inlm, dai(ng)%pioFile, &
1137 & dai(ng)%pioVar(iduvel)%vd, &
1138 & pio_frst, nvd4, u3dgrd, aval, vinfo, ncname)
1139 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1140!
1141! Define 3D momentum component in the ETA-direction.
1142!
1143 vinfo( 1)=vname(1,idvvel)
1144 vinfo( 2)=vname(2,idvvel)
1145 vinfo( 3)=vname(3,idvvel)
1146 vinfo(14)=vname(4,idvvel)
1147 vinfo(16)=vname(1,idtime)
1148 vinfo(21)=vname(6,idvvel)
1149 vinfo(22)='coordinates'
1150 aval(5)=real(iinfo(1,idvvel,ng),r8)
1151 dai(ng)%pioVar(idvvel)%dkind=pio_frst
1152 dai(ng)%pioVar(idvvel)%gtype=v3dvar
1153!
1154 status=def_var(ng, inlm, dai(ng)%pioFile, &
1155 & dai(ng)%pioVar(idvvel)%vd, &
1156 & pio_frst, nvd4, v3dgrd, aval, vinfo, ncname)
1157 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1158!
1159! Define tracer type variables.
1160!
1161 DO itrc=1,nt(ng)
1162 vinfo( 1)=vname(1,idtvar(itrc))
1163 vinfo( 2)=vname(2,idtvar(itrc))
1164 vinfo( 3)=vname(3,idtvar(itrc))
1165 vinfo(14)=vname(4,idtvar(itrc))
1166 vinfo(16)=vname(1,idtime)
1167# ifdef SEDIMENT
1168 DO i=1,nst
1169 IF (itrc.eq.idsed(i)) THEN
1170 WRITE (vinfo(19),50) 1000.0_r8*sd50(i,ng)
1171 END IF
1172 END DO
1173# endif
1174 vinfo(21)=vname(6,idtvar(itrc))
1175 vinfo(22)='coordinates'
1176 aval(5)=real(r3dvar,r8)
1177 dai(ng)%pioTrc(itrc)%dkind=pio_frst
1178 dai(ng)%pioTrc(itrc)%gtype=r3dvar
1179!
1180 status=def_var(ng, inlm, dai(ng)%pioFile, &
1181 & dai(ng)%pioTrc(itrc)%vd, &
1182 & pio_frst, nvd4, t3dgrd, aval, vinfo, ncname)
1183 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1184 END DO
1185!
1186! Define vertical viscosity coefficient.
1187!
1188 vinfo( 1)=vname(1,idvvis)
1189 vinfo( 2)=vname(2,idvvis)
1190 vinfo( 3)=vname(3,idvvis)
1191 vinfo(14)=vname(4,idvvis)
1192 vinfo(16)=vname(1,idtime)
1193 vinfo(21)=vname(6,idvvis)
1194 vinfo(22)='coordinates'
1195 aval(5)=real(iinfo(1,idvvis,ng),r8)
1196 dai(ng)%pioVar(idvvis)%dkind=pio_frst
1197 dai(ng)%pioVar(idvvis)%gtype=w3dvar
1198!
1199 status=def_var(ng, inlm, dai(ng)%pioFile, &
1200 & dai(ng)%pioVar(idvvis)%vd, &
1201 & pio_frst, nvd4, w3dgrd, aval, vinfo, ncname, &
1202 & setfillval = .false.)
1203 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1204!
1205! Define vertical diffusion coefficient for potential temperature.
1206!
1207 vinfo( 1)=vname(1,idtdif)
1208 vinfo( 2)=vname(2,idtdif)
1209 vinfo( 3)=vname(3,idtdif)
1210 vinfo(14)=vname(4,idtdif)
1211 vinfo(16)=vname(1,idtime)
1212 vinfo(21)=vname(6,idtdif)
1213 vinfo(22)='coordinates'
1214 aval(5)=real(iinfo(1,idtdif,ng),r8)
1215 dai(ng)%pioVar(idtdif)%dkind=pio_frst
1216 dai(ng)%pioVar(idtdif)%gtype=w3dvar
1217!
1218 status=def_var(ng, inlm, dai(ng)%pioFile, &
1219 & dai(ng)%pioVar(idtdif)%vd, &
1220 & pio_frst, nvd4, w3dgrd, aval, vinfo, ncname, &
1221 & setfillval = .false.)
1222 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1223
1224# ifdef SALINITY
1225!
1226! Define vertical diffusion coefficient for salinity.
1227!
1228 vinfo( 1)=vname(1,idsdif)
1229 vinfo( 2)=vname(2,idsdif)
1230 vinfo( 3)=vname(3,idsdif)
1231 vinfo(14)=vname(4,idsdif)
1232 vinfo(16)=vname(1,idtime)
1233 vinfo(21)=vname(6,idsdif)
1234 vinfo(22)='coordinates'
1235 aval(5)=real(iinfo(1,idsdif,ng),r8)
1236 dai(ng)%pioVar(idsdif)%dkind=pio_frst
1237 dai(ng)%pioVar(idsdif)%gtype=w3dvar
1238!
1239 status=def_var(ng, inlm, dai(ng)%pioFile, &
1240 & dai(ng)%pioVar(idsdif)%vd, &
1241 & pio_frst, nvd4, w3dgrd, aval, vinfo, ncname, &
1242 & setfillval = .false.)
1243 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1244# endif
1245# endif
1246!
1247!-----------------------------------------------------------------------
1248! Leave definition mode.
1249!-----------------------------------------------------------------------
1250!
1251 CALL pio_netcdf_enddef (ng, inlm, ncname, dai(ng)%pioFile)
1252 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1253!
1254!-----------------------------------------------------------------------
1255! Write out time-recordless, information variables.
1256!-----------------------------------------------------------------------
1257!
1258 CALL wrt_info (ng, inlm, dai(ng)%pioFile, ncname)
1259 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1260
1261 END IF define
1262!
1263!=======================================================================
1264! Open an existing Data Assimilation initial/restart file, check its
1265! contents, and prepare for appending data.
1266!=======================================================================
1267!
1268 query : IF (.not.ldefdai(ng)) THEN
1269 ncname=dai(ng)%name
1270!
1271! Open restart file for read/write.
1272!
1273 CALL pio_netcdf_open (ng, inlm, ncname, 1, dai(ng)%pioFile)
1274 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1275 WRITE (stdout,60) trim(ncname)
1276 RETURN
1277 END IF
1278!
1279! Inquire about the dimensions and check for consistency.
1280!
1281 CALL pio_netcdf_check_dim (ng, inlm, ncname, &
1282 & piofile = dai(ng)%pioFile)
1283 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1284!
1285! Inquire about the variables.
1286!
1287 CALL pio_netcdf_inq_var (ng, inlm, ncname, &
1288 & piofile= dai(ng)%pioFile)
1289 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1290!
1291! Initialize logical switches.
1292!
1293 DO i=1,nv
1294 got_var(i)=.false.
1295 END DO
1296!
1297! Scan variable list from input NetCDF and activate switches for
1298! Data Assimilation initial/restart variables. Get variable IDs.
1299!
1300 DO i=1,n_var
1301 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
1302 got_var(idtime)=.true.
1303 dai(ng)%pioVar(idtime)%vd=var_desc(i)
1304 dai(ng)%pioVar(idtime)%dkind=pio_tout
1305 dai(ng)%pioVar(idtime)%gtype=0
1306 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
1307 got_var(idfsur)=.true.
1308 dai(ng)%pioVar(idfsur)%vd=var_desc(i)
1309 dai(ng)%pioVar(idfsur)%dkind=pio_frst
1310 dai(ng)%pioVar(idfsur)%gtype=r2dvar
1311 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
1312 got_var(idubar)=.true.
1313 dai(ng)%pioVar(idubar)%vd=var_desc(i)
1314 dai(ng)%pioVar(idubar)%dkind=pio_frst
1315 dai(ng)%pioVar(idubar)%gtype=u2dvar
1316 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
1317 got_var(idvbar)=.true.
1318 dai(ng)%pioVar(idvbar)%vd=var_desc(i)
1319 dai(ng)%pioVar(idvbar)%dkind=pio_frst
1320 dai(ng)%pioVar(idvbar)%gtype=v2dvar
1321# ifdef SOLVE3D
1322 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
1323 got_var(iduvel)=.true.
1324 dai(ng)%pioVar(iduvel)%vd=var_desc(i)
1325 dai(ng)%pioVar(iduvel)%dkind=pio_frst
1326 dai(ng)%pioVar(iduvel)%gtype=u3dvar
1327 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
1328 got_var(idvvel)=.true.
1329 dai(ng)%pioVar(idvvel)%vd=var_desc(i)
1330 dai(ng)%pioVar(idvvel)%dkind=pio_frst
1331 dai(ng)%pioVar(idvvel)%gtype=v3dvar
1332 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvis))) THEN
1333 got_var(idvvis)=.true.
1334 dai(ng)%pioVar(idvvis)%vd=var_desc(i)
1335 dai(ng)%pioVar(idvvis)%dkind=pio_frst
1336 dai(ng)%pioVar(idvvis)%gtype=w3dvar
1337 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idtdif))) THEN
1338 got_var(idtdif)=.true.
1339 dai(ng)%pioVar(idtdif)%vd=var_desc(i)
1340 dai(ng)%pioVar(idtdif)%dkind=pio_frst
1341 dai(ng)%pioVar(idtdif)%gtype=w3dvar
1342 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idsdif))) THEN
1343 got_var(idsdif)=.true.
1344 dai(ng)%pioVar(idsdif)%vd=var_desc(i)
1345 dai(ng)%pioVar(idsdif)%dkind=pio_frst
1346 dai(ng)%pioVar(idsdif)%gtype=w3dvar
1347# endif
1348 END IF
1349# ifdef SOLVE3D
1350 DO itrc=1,nt(ng)
1351 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
1352 got_var(idtvar(itrc))=.true.
1353 dai(ng)%pioTrc(itrc)%vd=var_desc(i)
1354 dai(ng)%pioTrc(itrc)%dkind=pio_frst
1355 dai(ng)%pioTrc(itrc)%gtype=r3dvar
1356 END IF
1357 END DO
1358# endif
1359 END DO
1360!
1361! Check if initialization variables are available in input NetCDF
1362! file.
1363!
1364 IF (.not.got_var(idtime)) THEN
1365 IF (master) WRITE (stdout,70) trim(vname(1,idtime)), &
1366 & trim(ncname)
1367 exit_flag=3
1368 RETURN
1369 END IF
1370 IF (.not.got_var(idfsur)) THEN
1371 IF (master) WRITE (stdout,70) trim(vname(1,idfsur)), &
1372 & trim(ncname)
1373 exit_flag=3
1374 RETURN
1375 END IF
1376 IF (.not.got_var(idubar)) THEN
1377 IF (master) WRITE (stdout,70) trim(vname(1,idubar)), &
1378 & trim(ncname)
1379 exit_flag=3
1380 RETURN
1381 END IF
1382 IF (.not.got_var(idvbar)) THEN
1383 IF (master) WRITE (stdout,70) trim(vname(1,idvbar)), &
1384 & trim(ncname)
1385 exit_flag=3
1386 RETURN
1387 END IF
1388# ifdef SOLVE3D
1389 IF (.not.got_var(iduvel)) THEN
1390 IF (master) WRITE (stdout,70) trim(vname(1,iduvel)), &
1391 & trim(ncname)
1392 exit_flag=3
1393 RETURN
1394 END IF
1395 IF (.not.got_var(idvvel)) THEN
1396 IF (master) WRITE (stdout,70) trim(vname(1,idvvel)), &
1397 & trim(ncname)
1398 exit_flag=3
1399 RETURN
1400 END IF
1401 DO itrc=1,nt(ng)
1402 IF (.not.got_var(idtvar(itrc))) THEN
1403 IF (master) WRITE (stdout,70) trim(vname(1,idtvar(itrc))), &
1404 & trim(ncname)
1405 exit_flag=3
1406 RETURN
1407 END IF
1408 END DO
1409 IF (.not.got_var(idvvis)) THEN
1410 IF (master) WRITE (stdout,70) trim(vname(1,idvvis)), &
1411 & trim(ncname)
1412 exit_flag=3
1413 RETURN
1414 END IF
1415 IF (.not.got_var(idtdif)) THEN
1416 IF (master) WRITE (stdout,70) trim(vname(1,idtdif)), &
1417 & trim(ncname)
1418 exit_flag=3
1419 RETURN
1420 END IF
1421# ifdef SALINITY
1422 IF (.not.got_var(idsdif)) THEN
1423 IF (master) WRITE (stdout,70) trim(vname(1,idsdif)), &
1424 & trim(ncname)
1425 exit_flag=3
1426 RETURN
1427 END IF
1428# endif
1429# endif
1430!
1431! Set unlimited time record dimension to current value.
1432!
1433 dai(ng)%Rindex=rec_size
1434 END IF query
1435!
1436 10 FORMAT (/,2x,'DEF_DAI_PIO - creating DA INI/RST file,',t56, &
1437 & 'Grid ',i2.2,': ',a)
1438 20 FORMAT (/,2x,'DEF_DAI_PIO - inquiring DA INI/RST file,',t56, &
1439 & 'Grid ',i2.2,': ',a)
1440 30 FORMAT (/,' DEF_DAI_PIO - unable to create DA initial/restart', &
1441 & ' NetCDF file: ',a)
1442 40 FORMAT ('time independent',1x,a)
1443 50 FORMAT (1pe11.4,1x,'millimeter')
1444 60 FORMAT (/,' DEF_DAI_PIO - unable to open DA initial/restart' &
1445 & ' NetCDF file: ',a)
1446 70 FORMAT (/,' DEF_DAI_PIO - unable to find variable: ',a,2x, &
1447 & ' in DA initial/restart NetCDF file: ',a)
1448!
1449 RETURN
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
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::dai, mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::idfsur, mod_ncparam::idpthr, mod_ncparam::idpthu, mod_ncparam::idpthv, mod_ncparam::idpthw, mod_ncparam::idsdif, mod_sediment::idsed, mod_ncparam::idtdif, mod_ncparam::idtime, mod_ncparam::idtvar, mod_ncparam::idubar, mod_ncparam::iduvel, mod_ncparam::idvbar, mod_ncparam::idvvel, mod_ncparam::idvvis, mod_ncparam::iinfo, mod_param::inlm, mod_param::iobounds, mod_scalars::ldefdai, mod_parallel::master, mod_param::n, mod_biology::nbac, mod_biology::nbands, mod_param::nbed, mod_biology::ndom, mod_biology::nfec, mod_scalars::noerror, mod_biology::nphy, mod_param::nst, mod_fourdvar::nstatevar, mod_param::nt, mod_ncparam::nv, 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_param::r2dvar, mod_param::r3dvar, mod_scalars::rclock, mod_sediment::sd50, mod_iounits::sourcefile, mod_iounits::stdout, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, mod_pio_netcdf::var_desc, mod_ncparam::vname, and mod_param::w3dvar.

Referenced by def_dai().

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