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

Functions/Subroutines

subroutine, public def_tides (ng, ldef)
 
subroutine, private def_tides_nf90 (ng, ldef)
 
subroutine, private def_tides_pio (ng, ldef)
 

Function/Subroutine Documentation

◆ def_tides()

subroutine, public def_tides_mod::def_tides ( integer, intent(in) ng,
logical, intent(in) ldef )

Definition at line 44 of file def_tides.F.

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

References def_tides_nf90(), def_tides_pio(), mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::har, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_parallel::master, mod_scalars::noerror, and mod_iounits::stdout.

Referenced by get_idata().

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

◆ def_tides_nf90()

subroutine, private def_tides_mod::def_tides_nf90 ( integer, intent(in) ng,
logical, intent(in) ldef )
private

Definition at line 83 of file def_tides.F.

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

Referenced by def_tides().

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

◆ def_tides_pio()

subroutine, private def_tides_mod::def_tides_pio ( integer, intent(in) ng,
logical, intent(in) ldef )
private

Definition at line 705 of file def_tides.F.

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

Referenced by def_tides().

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