ROMS
Loading...
Searching...
No Matches
def_floats_mod Module Reference

Functions/Subroutines

subroutine, public def_floats (ng, ldef)
 
subroutine, private def_floats_nf90 (ng, ldef)
 
subroutine, private def_floats_pio (ng, ldef)
 

Function/Subroutine Documentation

◆ def_floats()

subroutine, public def_floats_mod::def_floats ( integer, intent(in) ng,
logical, intent(in) ldef )

Definition at line 52 of file def_floats.F.

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

References def_floats_nf90(), def_floats_pio(), mod_scalars::exit_flag, mod_iounits::flt, strings_mod::founderror(), mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_parallel::master, mod_scalars::noerror, and mod_iounits::stdout.

Referenced by output().

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

◆ def_floats_nf90()

subroutine, private def_floats_mod::def_floats_nf90 ( integer, intent(in) ng,
logical, intent(in) ldef )
private

Definition at line 91 of file def_floats.F.

92!***********************************************************************
93!
94 USE mod_netcdf
95!
96! Imported variable declarations.
97!
98 integer, intent(in) :: ng
99!
100 logical, intent(in) :: ldef
101!
102! Local variable declarations.
103!
104 logical :: got_var(-6:NV)
105!
106 integer, parameter :: Natt = 25
107
108 integer :: fltdim, i, itrc, j, l
109 integer :: recdim, status
110
111 integer :: DimIDs(nDimID)
112 integer :: fgrd(2), start(2), total(2)
113!
114 real(r8) :: Aval(6), Tinp(Nfloats(ng))
115!
116 character (len=256) :: ncname
117 character (len=MaxLen) :: Vinfo(Natt)
118
119 character (len=*), parameter :: MyFile = &
120 & __FILE__//", def_floats_nf90"
121!
122 sourcefile=myfile
123!
124!-----------------------------------------------------------------------
125! Set and report file name.
126!-----------------------------------------------------------------------
127!
128 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
129 ncname=flt(ng)%name
130!
131 IF (master) THEN
132 IF (ldef) THEN
133 WRITE (stdout,10) ng, trim(ncname)
134 ELSE
135 WRITE (stdout,20) ng, trim(ncname)
136 END IF
137 END IF
138!
139!=======================================================================
140! Create a new floats data file.
141!=======================================================================
142!
143 define : IF (ldef) THEN
144 CALL netcdf_create (ng, inlm, trim(ncname), flt(ng)%ncid)
145 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
146 IF (master) WRITE (stdout,30) trim(ncname)
147 RETURN
148 END IF
149!
150!-----------------------------------------------------------------------
151! Define file dimensions.
152!-----------------------------------------------------------------------
153!
154 dimids=0
155!
156# ifdef SOLVE3D
157 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 's_rho', &
158 & n(ng), dimids( 9))
159 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
160
161 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 's_w', &
162 & n(ng)+1, dimids(10))
163 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
164
165 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 'tracer', &
166 & nt(ng), dimids(11))
167 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
168
169# ifdef SEDIMENT
170 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 'NST', &
171 & nst, dimids(32))
172 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
173
174 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 'Nbed', &
175 & nbed, dimids(16))
176 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
177# endif
178
179# ifdef ECOSIM
180 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 'Nbands', &
181 & nbands, dimids(33))
182 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
183
184 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 'Nphy', &
185 & nphy, dimids(25))
186 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
187
188 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 'Nbac', &
189 & nbac, dimids(26))
190 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
191
192 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 'Ndom', &
193 & ndom, dimids(27))
194 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
195
196 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 'Nfec', &
197 & nfec, dimids(28))
198 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
199# endif
200# endif
201
202 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 'drifter' , &
203 & nfloats(ng), dimids(15))
204 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
205
206 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 'boundary', &
207 & 4, dimids(14))
208 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
209
210# ifdef FOUR_DVAR
211 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, 'Nstate', &
212 & nstatevar(ng), dimids(29))
213 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
214# endif
215
216 status=def_dim(ng, inlm, flt(ng)%ncid, ncname, &
217 & trim(adjustl(vname(5,idtime))), &
218 & nf90_unlimited, dimids(12))
219 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
220
221 recdim=dimids(12)
222 fltdim=dimids(15)
223!
224! Define dimension vectors for point variables.
225!
226 fgrd(1)=dimids(15)
227 fgrd(2)=dimids(12)
228!
229! Initialize unlimited time record dimension.
230!
231 flt(ng)%Rindex=0
232!
233! Initialize local information variable arrays.
234!
235 DO i=1,natt
236 DO j=1,len(vinfo(1))
237 vinfo(i)(j:j)=' '
238 END DO
239 END DO
240 DO i=1,6
241 aval(i)=0.0_r8
242 END DO
243!
244!-----------------------------------------------------------------------
245! Define time-recordless information variables.
246!-----------------------------------------------------------------------
247!
248 CALL def_info (ng, inlm, flt(ng)%ncid, ncname, dimids)
249 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
250!
251!-----------------------------------------------------------------------
252! Define variables and their attributes.
253!-----------------------------------------------------------------------
254!
255! Define model time.
256!
257 vinfo( 1)=vname(1,idtime)
258 vinfo( 2)=vname(2,idtime)
259 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
260 vinfo( 4)=trim(rclock%calendar)
261 vinfo(14)=vname(4,idtime)
262 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(idtime), &
263 & nf_tout, 1, (/recdim/), aval, vinfo, ncname, &
264 & setparaccess = .true.)
265 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
266!
267! Define floats X-grid locations.
268!
269 vinfo( 1)='Xgrid'
270 vinfo( 2)='x-grid floats locations'
271 vinfo( 5)='valid_min'
272 vinfo( 6)='valid_max'
273 aval(2)=0.0_r8
274 aval(3)=real(lm(ng)+1,r8)
275 vinfo(14)='Xgrid, scalar, series'
276 vinfo(16)=vname(1,idtime)
277# ifndef NO_4BYTE_REALS
278 vinfo(24)='_FillValue'
279 aval(6)=spval
280# endif
281 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(idxgrd), &
282 & nf_fout, 2, fgrd, aval, vinfo, ncname)
283 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
284!
285! Define floats Y-grid locations.
286!
287 vinfo( 1)='Ygrid'
288 vinfo( 2)='Y-grid floats locations'
289 vinfo( 5)='valid_min'
290 vinfo( 6)='valid_max'
291 aval(2)=0.0_r8
292 aval(3)=real(mm(ng)+1,r8)
293 vinfo(14)='Ygrid, scalar, series'
294 vinfo(16)=vname(1,idtime)
295# ifndef NO_4BYTE_REALS
296 vinfo(24)='_FillValue'
297 aval(6)=spval
298# endif
299 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(idygrd), &
300 & nf_fout, 2, fgrd, aval, vinfo, ncname)
301 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
302
303# ifdef SOLVE3D
304!
305! Define floats Z-grid locations.
306!
307 vinfo( 1)='Zgrid'
308 vinfo( 2)='Z-grid floats locations'
309 vinfo( 5)='valid_min'
310 vinfo( 6)='valid_max'
311 aval(2)=0.0_r8
312 aval(3)=real(n(ng),r8)
313 vinfo(14)='Zgrid, scalar, series'
314 vinfo(16)=vname(1,idtime)
315# ifndef NO_4BYTE_REALS
316 vinfo(24)='_FillValue'
317 aval(6)=spval
318# endif
319 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(idzgrd), &
320 & nf_fout, 2, fgrd, aval, vinfo, ncname)
321 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
322# endif
323!
324! Define floats (lon,lat) or (x,y) locations.
325!
326 IF (spherical) THEN
327 vinfo( 1)='lon'
328 vinfo( 2)='longitude of floats trajectories'
329 vinfo( 3)='degree_east'
330 vinfo( 5)='valid_min'
331 vinfo( 6)='valid_max'
332 vinfo(14)='lon, scalar, series'
333 vinfo(16)=vname(1,idtime)
334# ifndef NO_4BYTE_REALS
335 vinfo(24)='_FillValue'
336 aval(6)=spval
337# endif
338 aval(2)=-180.0_r8
339 aval(3)=180.0_r8
340 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(idglon), &
341 & nf_fout, 2, fgrd, aval, vinfo, ncname)
342 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
343
344 vinfo( 1)='lat'
345 vinfo( 2)='latitude of floats trajectories'
346 vinfo( 3)='degree_north'
347 vinfo( 5)='valid_min'
348 vinfo( 6)='valid_max'
349 vinfo(14)='lat, scalar, series'
350 vinfo(16)=vname(1,idtime)
351# ifndef NO_4BYTE_REALS
352 vinfo(24)='_FillValue'
353 aval(6)=spval
354# endif
355 aval(2)=-90.0_r8
356 aval(3)=90.0_r8
357 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(idglat), &
358 & nf_fout, 2, fgrd, aval, vinfo, ncname)
359 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
360 ELSE
361 vinfo( 1)='x'
362 vinfo( 2)='x-location of floats trajectories'
363 vinfo( 3)='meter'
364 vinfo(14)='x, scalar, series'
365 vinfo(16)=vname(1,idtime)
366# ifndef NO_4BYTE_REALS
367 vinfo(24)='_FillValue'
368 aval(6)=spval
369# endif
370 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(idglon), &
371 & nf_fout, 2, fgrd, aval, vinfo, ncname)
372 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
373
374 vinfo( 1)='y'
375 vinfo( 2)='y-location of floats trajectories'
376 vinfo( 3)='meter'
377 vinfo(14)='y, scalar, series'
378 vinfo(16)=vname(1,idtime)
379# ifndef NO_4BYTE_REALS
380 vinfo(24)='_FillValue'
381 aval(6)=spval
382# endif
383 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(idglat), &
384 & nf_fout, 2, fgrd, aval, vinfo, ncname)
385 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
386 END IF
387
388# ifdef SOLVE3D
389!
390! Define floats depths.
391!
392 vinfo( 1)='depth'
393 vinfo( 2)='depth of floats trajectories'
394 vinfo( 3)='meter'
395 vinfo(14)='depth, scalar, series'
396 vinfo(16)=vname(1,idtime)
397# ifndef NO_4BYTE_REALS
398 vinfo(24)='_FillValue'
399 aval(6)=spval
400# endif
401 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(iddpth), &
402 & nf_fout, 2, fgrd, aval, vinfo, ncname)
403 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
404!
405! Define density anomaly.
406!
407 vinfo( 1)=vname(1,iddano)
408 vinfo( 2)=vname(2,iddano)
409 vinfo( 3)=vname(3,iddano)
410 vinfo(14)=vname(4,iddano)
411 vinfo(16)=vname(1,idtime)
412# ifndef NO_4BYTE_REALS
413 vinfo(24)='_FillValue'
414 aval(6)=spval
415# endif
416 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(iddano), &
417 & nf_fout, 2, fgrd, aval, vinfo, ncname)
418 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
419!
420! Define tracer type variables.
421!
422 DO itrc=1,nt(ng)
423 vinfo( 1)=vname(1,idtvar(itrc))
424 vinfo( 2)=vname(2,idtvar(itrc))
425 vinfo( 3)=vname(3,idtvar(itrc))
426 vinfo(14)=vname(4,idtvar(itrc))
427 vinfo(16)=vname(1,idtime)
428# ifndef NO_4BYTE_REALS
429 vinfo(24)='_FillValue'
430 aval(6)=spval
431# endif
432# ifdef SEDIMENT
433 DO i=1,nst
434 IF (itrc.eq.idsed(i)) THEN
435 WRITE (vinfo(19),40) 1000.0_r8*sd50(i,ng)
436 END IF
437 END DO
438# endif
439 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Tid(itrc), &
440 & nf_fout, 2, fgrd, aval, vinfo, ncname)
441 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
442 END DO
443# endif
444
445# ifdef FLOAT_OYSTER
446!
447! Define biological float swimming time.
448!
449 vinfo( 1)='swim_time'
450 vinfo( 2)='biological float swimming time'
451 vinfo( 3)='s'
452 vinfo(14)='swim_time, scalar, series'
453 vinfo(16)=vname(1,idtime)
454# ifndef NO_4BYTE_REALS
455 vinfo(24)='_FillValue'
456 aval(6)=spval
457# endif
458 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(idswim), &
459 & nf_fout, 2, fgrd, aval, vinfo, ncname)
460 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
461!
462! Define biological float vertical velocity.
463!
464 vinfo( 1)='w_bio'
465 vinfo( 2)='biological float vertical velocity'
466 vinfo( 3)='m/s'
467 vinfo(14)='w_bio, scalar, series'
468 vinfo(16)=vname(1,idtime)
469# ifndef NO_4BYTE_REALS
470 vinfo(24)='_FillValue'
471 aval(6)=spval
472# endif
473 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(idwbio), &
474 & nf_fout, 2, fgrd, aval, vinfo, ncname)
475 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
476!
477! Define biological float size (length).
478!
479 vinfo( 1)='bio_size'
480 vinfo( 2)='biological float size'
481 vinfo( 3)='um'
482 vinfo(14)='bio_size, scalar, series'
483 vinfo(16)=vname(1,idtime)
484# ifndef NO_4BYTE_REALS
485 vinfo(24)='_FillValue'
486 aval(6)=spval
487# endif
488 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(idsize), &
489 & nf_fout, 2, fgrd, aval, vinfo, ncname)
490 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
491!
492! Define biological float sinking velocity.
493!
494 vinfo( 1)='bio_sink'
495 vinfo( 2)='biological float sinking velocity'
496 vinfo( 3)='m/s'
497 vinfo(14)='bio_sink, scalar, series'
498 vinfo(16)=vname(1,idtime)
499# ifndef NO_4BYTE_REALS
500 vinfo(24)='_FillValue'
501 aval(6)=spval
502# endif
503 status=def_var(ng, inlm, flt(ng)%ncid, flt(ng)%Vid(idwsin), &
504 & nf_fout, 2, fgrd, aval, vinfo, ncname)
505 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
506# endif
507!
508! Initialize unlimited time record dimension.
509!
510 flt(ng)%Rindex=0
511!
512!-----------------------------------------------------------------------
513! Leave definition mode.
514!-----------------------------------------------------------------------
515!
516 CALL netcdf_enddef (ng, inlm, ncname, flt(ng)%ncid)
517 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
518!
519!-----------------------------------------------------------------------
520! Write out time-recordless, information variables.
521!-----------------------------------------------------------------------
522!
523 CALL wrt_info (ng, inlm, flt(ng)%ncid, ncname)
524 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
525 END IF define
526!
527!=======================================================================
528! Open an existing floats file, check its contents, and prepare for
529! appending data.
530!=======================================================================
531!
532 query : IF (.not.ldef) THEN
533 ncname=flt(ng)%name
534!
535! Open floats file for read/write.
536!
537 CALL netcdf_open (ng, inlm, ncname, 1, flt(ng)%ncid)
538 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
539 WRITE (stdout,50) trim(ncname)
540 RETURN
541 END IF
542!
543! Inquire about the dimensions and check for consistency.
544!
545 CALL netcdf_check_dim (ng, inlm, ncname, &
546 & ncid = flt(ng)%ncid)
547 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
548!
549! Get the size of the drifter dimension.
550!
551 DO i=1,n_dim
552 IF (trim(dim_name(i)).eq.'drifter') THEN
553 nfloats(ng)=dim_size(i)
554 EXIT
555 END IF
556 END DO
557!
558! Inquire about the variables.
559!
560 CALL netcdf_inq_var (ng, inlm, ncname, &
561 & ncid = flt(ng)%ncid)
562 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
563!
564! Initialize logical switches.
565!
566 DO i=1,nv
567 got_var(i)=.false.
568 END DO
569!
570! Scan variable list from input NetCDF and activate switches for
571! float variables. Get variable IDs.
572!
573 DO i=1,n_var
574 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
575 got_var(idtime)=.true.
576 flt(ng)%Vid(idtime)=var_id(i)
577 ELSE IF (trim(var_name(i)).eq.'Xgrid') THEN
578 got_var(idxgrd)=.true.
579 flt(ng)%Vid(idxgrd)=var_id(i)
580 ELSE IF (trim(var_name(i)).eq.'Ygrid') THEN
581 got_var(idygrd)=.true.
582 flt(ng)%Vid(idygrd)=var_id(i)
583# ifdef SOLVE3D
584 ELSE IF (trim(var_name(i)).eq.'Zgrid') THEN
585 got_var(idzgrd)=.true.
586 flt(ng)%Vid(idzgrd)=var_id(i)
587# endif
588 ELSE IF (spherical.and.trim(var_name(i)).eq.'lon') THEN
589 got_var(idglon)=.true.
590 flt(ng)%Vid(idglon)=var_id(i)
591 ELSE IF (spherical.and.trim(var_name(i)).eq.'lat') THEN
592 got_var(idglat)=.true.
593 flt(ng)%Vid(idglat)=var_id(i)
594 ELSE IF (.not.spherical.and.trim(var_name(i)).eq.'x') THEN
595 got_var(idglon)=.true.
596 flt(ng)%Vid(idglon)=var_id(i)
597 ELSE IF (.not.spherical.and.trim(var_name(i)).eq.'y') THEN
598 got_var(idglat)=.true.
599 flt(ng)%Vid(idglat)=var_id(i)
600# ifdef SOLVE3D
601 ELSE IF (trim(var_name(i)).eq.'depth') THEN
602 got_var(iddpth)=.true.
603 flt(ng)%Vid(iddpth)=var_id(i)
604 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iddano))) THEN
605 got_var(iddano)=.true.
606 flt(ng)%Vid(iddano)=var_id(i)
607# endif
608# ifdef FLOAT_OYSTER
609 ELSE IF (trim(var_name(i)).eq.'swim_time') THEN
610 got_var(idswim)=.true.
611 flt(ng)%Vid(idswim)=var_id(i)
612 ELSE IF (trim(var_name(i)).eq.'w_bio') THEN
613 got_var(idwbio)=.true.
614 flt(ng)%Vid(idwbio)=var_id(i)
615 ELSE IF (trim(var_name(i)).eq.'bio_size') THEN
616 got_var(idsize)=.true.
617 flt(ng)%Vid(idsize)=var_id(i)
618 ELSE IF (trim(var_name(i)).eq.'bio_sink') THEN
619 got_var(idwsin)=.true.
620 flt(ng)%Vid(idwsin)=var_id(i)
621# endif
622 END IF
623# ifdef SOLVE3D
624 DO itrc=1,nt(ng)
625 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
626 got_var(idtvar(itrc))=.true.
627 flt(ng)%Tid(itrc)=var_id(i)
628 END IF
629 END DO
630# endif
631 END DO
632!
633! Check if floats variables are available in input NetCDF file.
634!
635 IF (.not.got_var(idtime)) THEN
636 IF (master) WRITE (stdout,60) trim(vname(1,idtime)), &
637 & trim(ncname)
638 exit_flag=3
639 RETURN
640 END IF
641 IF (.not.got_var(idxgrd)) THEN
642 IF (master) WRITE (stdout,60) 'Xgrid', trim(ncname)
643 exit_flag=3
644 RETURN
645 END IF
646 IF (.not.got_var(idygrd)) THEN
647 IF (master) WRITE (stdout,60) 'Ygrid', trim(ncname)
648 exit_flag=3
649 RETURN
650 END IF
651# ifdef SOLVE3D
652 IF (.not.got_var(idzgrd)) THEN
653 IF (master) WRITE (stdout,60) 'Zgrid', trim(ncname)
654 exit_flag=3
655 RETURN
656 END IF
657# endif
658 IF (.not.got_var(idglon)) THEN
659 IF (spherical) THEN
660 IF (master) WRITE (stdout,60) 'lon', trim(ncname)
661 ELSE
662 IF (master) WRITE (stdout,60) 'x', trim(ncname)
663 END IF
664 exit_flag=3
665 RETURN
666 END IF
667 IF (.not.got_var(idglat)) THEN
668 IF (spherical) THEN
669 IF (master) WRITE (stdout,60) 'lat', trim(ncname)
670 ELSE
671 IF (master) WRITE (stdout,60) 'y', trim(ncname)
672 END IF
673 exit_flag=3
674 RETURN
675 END IF
676# ifdef SOLVE3D
677 IF (.not.got_var(iddpth)) THEN
678 IF (master) WRITE (stdout,60) 'depth', trim(ncname)
679 exit_flag=3
680 RETURN
681 END IF
682 IF (.not.got_var(iddano)) THEN
683 IF (master) WRITE (stdout,60) trim(vname(1,iddano)), &
684 & trim(ncname)
685 exit_flag=3
686 RETURN
687 END IF
688# endif
689# ifdef FLOAT_OYSTER
690 IF (.not.got_var(idswim)) THEN
691 IF (master) WRITE (stdout,60) 'swim_time', trim(ncname)
692 exit_flag=3
693 RETURN
694 END IF
695 IF (.not.got_var(idwbio)) THEN
696 IF (master) WRITE (stdout,60) 'w_bio', trim(ncname)
697 exit_flag=3
698 RETURN
699 END IF
700 IF (.not.got_var(idsize)) THEN
701 IF (master) WRITE (stdout,60) 'bio_size', trim(ncname)
702 exit_flag=3
703 RETURN
704 END IF
705 IF (.not.got_var(idwsin)) THEN
706 IF (master) WRITE (stdout,60) 'bio_sink', trim(ncname)
707 exit_flag=3
708 RETURN
709 END IF
710# endif
711# ifdef SOLVE3D
712 DO itrc=1,nt(ng)
713 IF (.not.got_var(idtvar(itrc))) THEN
714 IF (master) WRITE (stdout,60) trim(vname(1,idtvar(itrc))), &
715 & trim(ncname)
716 exit_flag=3
717 RETURN
718 END IF
719 END DO
720# endif
721!
722!-----------------------------------------------------------------------
723! Initialize floats positions to the appropriate values.
724!-----------------------------------------------------------------------
725!
726! Set-up floats time record.
727!
728 IF (frrec(ng).lt.0) THEN
729 flt(ng)%Rindex=rec_size
730 ELSE
731 flt(ng)%Rindex=abs(frrec(ng))
732 END IF
733!
734! Read in floats nondimentional horizontal positions. If the floats
735! have not been released yet at restart time, the values of Xgrid,
736! Ygrid, and Zgrid will be _FillValue (1.0E+37) in the FLOATS NetCDF
737! file. The calls to 'netcdf_get_fvar' will replace such values with
738! zero. Therefore, we need to read Zgrid first so the bounded switch
739! is false in such cases tp trigger release. Then, the bounded switch
740! is set correctly when reading Xgrid and/or Ygrid since the lower
741! bound is 0.5 in fractional coordinates.
742!
743# ifdef SOLVE3D
744 CALL netcdf_get_fvar (ng, inlm, ncname, 'Zgrid', &
745 & tinp, &
746 & ncid = flt(ng)%ncid, &
747 & start = (/1,flt(ng)%Rindex/), &
748 & total = (/nfloats(ng),1/))
749 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
750
751 DO l=1,nfloats(ng)
752 IF ((tinp(l).gt.real(n(ng),r8)).or. &
753 & (tinp(l).lt.0.0_r8)) THEN
754 drifter(ng)%bounded(l)=.false.
755 ELSE
756 drifter(ng)%bounded(l)=.true.
757 DO i=0,nft
758 drifter(ng)%track(izgrd,i,l)=tinp(l)
759 drifter(ng)%track(izrhs,i,l)=0.0_r8
760 END DO
761 END IF
762 END DO
763!
764# endif
765 CALL netcdf_get_fvar (ng, inlm, ncname, 'Xgrid', &
766 & tinp, &
767 & ncid = flt(ng)%ncid, &
768 & start = (/1,flt(ng)%Rindex/), &
769 & total = (/nfloats(ng),1/))
770 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
771
772 DO l=1,nfloats(ng)
773 IF ((tinp(l).gt.real(lm(ng)+1,r8)-0.5_r8).or. &
774 & (tinp(l).lt.0.5_r8)) THEN
775 drifter(ng)%bounded(l)=.false.
776 ELSE
777 drifter(ng)%bounded(l)=.true.
778 DO i=0,nft
779 drifter(ng)%track(ixgrd,i,l)=tinp(l)
780 drifter(ng)%track(ixrhs,i,l)=0.0_r8
781 END DO
782 END IF
783 END DO
784!
785 CALL netcdf_get_fvar (ng, inlm, ncname, 'Ygrid', &
786 & tinp, &
787 & ncid = flt(ng)%ncid, &
788 & start = (/1,flt(ng)%Rindex/), &
789 & total = (/nfloats(ng),1/))
790 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
791
792 DO l=1,nfloats(ng)
793 IF ((tinp(l).gt.real(mm(ng)+1,r8)-0.5_r8).or. &
794 & (tinp(l).lt.0.5_r8)) THEN
795 drifter(ng)%bounded(l)=.false.
796 ELSE
797 drifter(ng)%bounded(l)=.true.
798 DO i=0,nft
799 drifter(ng)%track(iygrd,i,l)=tinp(l)
800 drifter(ng)%track(iyrhs,i,l)=0.0_r8
801 END DO
802 END IF
803 END DO
804
805 END IF query
806!
807 10 FORMAT (2x,'DEF_FLOATS_NF90 - creating floats file,',t56, &
808 & 'Grid ',i2.2,': ',a)
809 20 FORMAT (2x,'DEF_FLOATS_NF90 - inquiring floats file,',t56, &
810 & 'Grid ',i2.2,': ',a)
811 30 FORMAT (/,' DEF_FLOATS_NF90 - unable to create floats NetCDF', &
812 & ' file: ',a)
813 40 FORMAT (1pe11.4,1x,'millimeter')
814 50 FORMAT (/,' DEF_FLOATS_NF90 - unable to open floats NetCDF', &
815 & ' file: ',a)
816 60 FORMAT (/,' DEF_FLOATS_NF90 - unable to find variable: ',a,2x, &
817 & ' in floats NetCDF file: ',a)
818!
819 RETURN
integer, parameter nf_tout
Definition mod_netcdf.F:207
subroutine, public netcdf_check_dim(ng, model, ncname, ncid)
Definition mod_netcdf.F:538
character(len=100), dimension(mdims) dim_name
Definition mod_netcdf.F:168
subroutine, public netcdf_open(ng, model, ncname, omode, ncid)
integer, parameter nf_fout
Definition mod_netcdf.F:188
subroutine, public netcdf_enddef(ng, model, ncname, ncid)
integer, dimension(mdims) dim_size
Definition mod_netcdf.F:159
character(len=100), dimension(mvars) var_name
Definition mod_netcdf.F:169
integer n_dim
Definition mod_netcdf.F:151
integer, dimension(mvars) var_id
Definition mod_netcdf.F:160
integer n_var
Definition mod_netcdf.F:152
integer rec_size
Definition mod_netcdf.F:156
subroutine, public netcdf_create(ng, model, ncname, ncid)
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)

References mod_netcdf::dim_name, mod_netcdf::dim_size, mod_floats::drifter, mod_scalars::exit_flag, mod_iounits::flt, strings_mod::founderror(), mod_floats::frrec, mod_ncparam::iddano, mod_ncparam::iddpth, mod_ncparam::idglat, mod_ncparam::idglon, mod_sediment::idsed, mod_ncparam::idsize, mod_ncparam::idswim, mod_ncparam::idtime, mod_ncparam::idtvar, mod_ncparam::idwbio, mod_ncparam::idwsin, mod_ncparam::idxgrd, mod_ncparam::idygrd, mod_ncparam::idzgrd, mod_param::inlm, mod_floats::ixgrd, mod_floats::ixrhs, mod_floats::iygrd, mod_floats::iyrhs, mod_floats::izgrd, mod_floats::izrhs, mod_param::lm, mod_parallel::master, mod_param::mm, mod_param::n, mod_netcdf::n_dim, 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_fout, mod_netcdf::nf_tout, mod_biology::nfec, mod_param::nfloats, mod_param::nft, mod_scalars::noerror, mod_biology::nphy, mod_param::nst, mod_fourdvar::nstatevar, mod_param::nt, mod_ncparam::nv, mod_scalars::rclock, mod_netcdf::rec_size, mod_sediment::sd50, mod_iounits::sourcefile, mod_scalars::spherical, mod_scalars::spval, mod_iounits::stdout, mod_netcdf::var_id, mod_netcdf::var_name, and mod_ncparam::vname.

Referenced by def_floats().

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

◆ def_floats_pio()

subroutine, private def_floats_mod::def_floats_pio ( integer, intent(in) ng,
logical, intent(in) ldef )
private

Definition at line 825 of file def_floats.F.

826!***********************************************************************
827!
829!
830! Imported variable declarations.
831!
832 integer, intent(in) :: ng
833!
834 logical, intent(in) :: ldef
835!
836! Local variable declarations.
837!
838 logical :: got_var(-6:NV)
839!
840 integer, parameter :: Natt = 25
841
842 integer :: fltdim, i, itrc, j, l
843 integer :: recdim, status
844
845 integer :: DimIDs(nDimID)
846 integer :: fgrd(2), start(2), total(2)
847!
848 real(r8) :: Aval(6), Tinp(Nfloats(ng))
849!
850 character (len=256) :: ncname
851 character (len=MaxLen) :: Vinfo(Natt)
852
853 character (len=*), parameter :: MyFile = &
854 & __FILE__//", def_floats_pio"
855!
856 sourcefile=myfile
857!
858!-----------------------------------------------------------------------
859! Set and report file name.
860!-----------------------------------------------------------------------
861!
862 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
863 ncname=flt(ng)%name
864!
865 IF (master) THEN
866 IF (ldef) THEN
867 WRITE (stdout,10) ng, trim(ncname)
868 ELSE
869 WRITE (stdout,20) ng, trim(ncname)
870 END IF
871 END IF
872!
873!=======================================================================
874! Create a new floats data file.
875!=======================================================================
876!
877 define : IF (ldef) THEN
878 CALL pio_netcdf_create (ng, inlm, trim(ncname), flt(ng)%pioFile)
879 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
880 IF (master) WRITE (stdout,30) trim(ncname)
881 RETURN
882 END IF
883!
884!-----------------------------------------------------------------------
885! Define file dimensions.
886!-----------------------------------------------------------------------
887!
888 dimids=0
889!
890# ifdef SOLVE3D
891 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 's_rho', &
892 & n(ng), dimids( 9))
893 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
894
895 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 's_w', &
896 & n(ng)+1, dimids(10))
897 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
898
899 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 'tracer', &
900 & nt(ng), dimids(11))
901 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
902
903# ifdef SEDIMENT
904 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 'NST', &
905 & nst, dimids(32))
906 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
907
908 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 'Nbed', &
909 & nbed, dimids(16))
910 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
911# endif
912
913# ifdef ECOSIM
914 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 'Nbands', &
915 & nbands, dimids(33))
916 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
917
918 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 'Nphy', &
919 & nphy, dimids(25))
920 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
921
922 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 'Nbac', &
923 & nbac, dimids(26))
924 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
925
926 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 'Ndom', &
927 & ndom, dimids(27))
928 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
929
930 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 'Nfec', &
931 & nfec, dimids(28))
932 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
933# endif
934# endif
935
936 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 'drifter' , &
937 & nfloats(ng), dimids(15))
938 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
939
940 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 'boundary', &
941 & 4, dimids(14))
942 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
943
944# ifdef FOUR_DVAR
945 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, 'Nstate', &
946 & nstatevar(ng), dimids(29))
947 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
948# endif
949
950 status=def_dim(ng, inlm, flt(ng)%pioFile, ncname, &
951 & trim(adjustl(vname(5,idtime))), &
952 & pio_unlimited, dimids(12))
953 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
954
955 recdim=dimids(12)
956 fltdim=dimids(15)
957!
958! Define dimension vectors for point variables.
959!
960 fgrd(1)=dimids(15)
961 fgrd(2)=dimids(12)
962!
963! Initialize unlimited time record dimension.
964!
965 flt(ng)%Rindex=0
966!
967! Initialize local information variable arrays.
968!
969 DO i=1,natt
970 DO j=1,len(vinfo(1))
971 vinfo(i)(j:j)=' '
972 END DO
973 END DO
974 DO i=1,6
975 aval(i)=0.0_r8
976 END DO
977!
978!-----------------------------------------------------------------------
979! Define time-recordless information variables.
980!-----------------------------------------------------------------------
981!
982 CALL def_info (ng, inlm, flt(ng)%pioFile, ncname, dimids)
983 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
984!
985!-----------------------------------------------------------------------
986! Define variables and their attributes.
987!-----------------------------------------------------------------------
988!
989! Define model time.
990!
991 vinfo( 1)=vname(1,idtime)
992 vinfo( 2)=vname(2,idtime)
993 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
994 vinfo( 4)=trim(rclock%calendar)
995 vinfo(14)=vname(4,idtime)
996 flt(ng)%pioVar(idtime)%dkind=pio_tout
997 flt(ng)%pioVar(idtime)%gtype=0
998!
999 status=def_var(ng, inlm, flt(ng)%pioFile, &
1000 & flt(ng)%pioVar(idtime)%vd, &
1001 & pio_tout, 1, (/recdim/), aval, vinfo, ncname, &
1002 & setparaccess = .true.)
1003 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1004!
1005! Define floats X-grid locations.
1006!
1007 vinfo( 1)='Xgrid'
1008 vinfo( 2)='x-grid floats locations'
1009 vinfo( 5)='valid_min'
1010 vinfo( 6)='valid_max'
1011 aval(2)=0.0_r8
1012 aval(3)=real(lm(ng)+1,r8)
1013 vinfo(14)='Xgrid, scalar, series'
1014 vinfo(16)=vname(1,idtime)
1015# ifndef NO_4BYTE_REALS
1016 vinfo(24)='_FillValue'
1017 aval(6)=spval
1018# endif
1019 flt(ng)%pioVar(idxgrd)%dkind=pio_fout
1020 flt(ng)%pioVar(idxgrd)%gtype=0
1021!
1022 status=def_var(ng, inlm, flt(ng)%pioFile, &
1023 & flt(ng)%pioVar(idxgrd)%vd, &
1024 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1025 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1026!
1027! Define floats Y-grid locations.
1028!
1029 vinfo( 1)='Ygrid'
1030 vinfo( 2)='Y-grid floats locations'
1031 vinfo( 5)='valid_min'
1032 vinfo( 6)='valid_max'
1033 aval(2)=0.0_r8
1034 aval(3)=real(mm(ng)+1,r8)
1035 vinfo(14)='Ygrid, scalar, series'
1036 vinfo(16)=vname(1,idtime)
1037# ifndef NO_4BYTE_REALS
1038 vinfo(24)='_FillValue'
1039 aval(6)=spval
1040# endif
1041 flt(ng)%pioVar(idygrd)%dkind=pio_fout
1042 flt(ng)%pioVar(idygrd)%gtype=0
1043!
1044 status=def_var(ng, inlm, flt(ng)%pioFile, &
1045 & flt(ng)%pioVar(idygrd)%vd, &
1046 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1047 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1048
1049# ifdef SOLVE3D
1050!
1051! Define floats Z-grid locations.
1052!
1053 vinfo( 1)='Zgrid'
1054 vinfo( 2)='Z-grid floats locations'
1055 vinfo( 5)='valid_min'
1056 vinfo( 6)='valid_max'
1057 aval(2)=0.0_r8
1058 aval(3)=real(n(ng),r8)
1059 vinfo(14)='Zgrid, scalar, series'
1060 vinfo(16)=vname(1,idtime)
1061# ifndef NO_4BYTE_REALS
1062 vinfo(24)='_FillValue'
1063 aval(6)=spval
1064# endif
1065 flt(ng)%pioVar(idzgrd)%dkind=pio_fout
1066 flt(ng)%pioVar(idzgrd)%gtype=0
1067!
1068 status=def_var(ng, inlm, flt(ng)%pioFile, &
1069 & flt(ng)%pioVar(idzgrd)%vd, &
1070 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1071 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1072# endif
1073!
1074! Define floats (lon,lat) or (x,y) locations.
1075!
1076 IF (spherical) THEN
1077 vinfo( 1)='lon'
1078 vinfo( 2)='longitude of floats trajectories'
1079 vinfo( 3)='degree_east'
1080 vinfo( 5)='valid_min'
1081 vinfo( 6)='valid_max'
1082 vinfo(14)='lon, scalar, series'
1083 vinfo(16)=vname(1,idtime)
1084# ifndef NO_4BYTE_REALS
1085 vinfo(24)='_FillValue'
1086 aval(6)=spval
1087# endif
1088 aval(2)=-180.0_r8
1089 aval(3)=180.0_r8
1090 flt(ng)%pioVar(idglon)%dkind=pio_fout
1091 flt(ng)%pioVar(idglon)%gtype=0
1092!
1093 status=def_var(ng, inlm, flt(ng)%pioFile, &
1094 & flt(ng)%pioVar(idglon)%vd, &
1095 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1096 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1097!
1098 vinfo( 1)='lat'
1099 vinfo( 2)='latitude of floats trajectories'
1100 vinfo( 3)='degree_north'
1101 vinfo( 5)='valid_min'
1102 vinfo( 6)='valid_max'
1103 vinfo(14)='lat, scalar, series'
1104 vinfo(16)=vname(1,idtime)
1105# ifndef NO_4BYTE_REALS
1106 vinfo(24)='_FillValue'
1107 aval(6)=spval
1108# endif
1109 aval(2)=-90.0_r8
1110 aval(3)=90.0_r8
1111 flt(ng)%pioVar(idglat)%dkind=pio_fout
1112 flt(ng)%pioVar(idglat)%gtype=0
1113!
1114 status=def_var(ng, inlm, flt(ng)%pioFile, &
1115 & flt(ng)%pioVar(idglat)%vd, &
1116 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1117 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1118 ELSE
1119 vinfo( 1)='x'
1120 vinfo( 2)='x-location of floats trajectories'
1121 vinfo( 3)='meter'
1122 vinfo(14)='x, scalar, series'
1123 vinfo(16)=vname(1,idtime)
1124# ifndef NO_4BYTE_REALS
1125 vinfo(24)='_FillValue'
1126 aval(6)=spval
1127# endif
1128 flt(ng)%pioVar(idglon)%dkind=pio_fout
1129 flt(ng)%pioVar(idglon)%gtype=0
1130!
1131 status=def_var(ng, inlm, flt(ng)%pioFile, &
1132 & flt(ng)%pioVar(idglon)%vd, &
1133 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1134 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1135!
1136 vinfo( 1)='y'
1137 vinfo( 2)='y-location of floats trajectories'
1138 vinfo( 3)='meter'
1139 vinfo(14)='y, scalar, series'
1140 vinfo(16)=vname(1,idtime)
1141# ifndef NO_4BYTE_REALS
1142 vinfo(24)='_FillValue'
1143 aval(6)=spval
1144# endif
1145 flt(ng)%pioVar(idglat)%dkind=pio_fout
1146 flt(ng)%pioVar(idglat)%gtype=0
1147!
1148 status=def_var(ng, inlm, flt(ng)%pioFile, &
1149 & flt(ng)%pioVar(idglat)%vd, &
1150 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1151 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1152 END IF
1153
1154# ifdef SOLVE3D
1155!
1156! Define floats depths.
1157!
1158 vinfo( 1)='depth'
1159 vinfo( 2)='depth of floats trajectories'
1160 vinfo( 3)='meter'
1161 vinfo(14)='depth, scalar, series'
1162 vinfo(16)=vname(1,idtime)
1163# ifndef NO_4BYTE_REALS
1164 vinfo(24)='_FillValue'
1165 aval(6)=spval
1166# endif
1167 flt(ng)%pioVar(iddpth)%dkind=pio_fout
1168 flt(ng)%pioVar(iddpth)%gtype=0
1169!
1170 status=def_var(ng, inlm, flt(ng)%pioFile, &
1171 & flt(ng)%pioVar(iddpth)%vd, &
1172 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1173 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1174!
1175! Define density anomaly.
1176!
1177 vinfo( 1)=vname(1,iddano)
1178 vinfo( 2)=vname(2,iddano)
1179 vinfo( 3)=vname(3,iddano)
1180 vinfo(14)=vname(4,iddano)
1181 vinfo(16)=vname(1,idtime)
1182# ifndef NO_4BYTE_REALS
1183 vinfo(24)='_FillValue'
1184 aval(6)=spval
1185# endif
1186 flt(ng)%pioVar(iddano)%dkind=pio_fout
1187 flt(ng)%pioVar(iddano)%gtype=0
1188!
1189 status=def_var(ng, inlm, flt(ng)%pioFile, &
1190 & flt(ng)%pioVar(iddano)%vd, &
1191 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1192 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1193!
1194! Define tracer type variables.
1195!
1196 DO itrc=1,nt(ng)
1197 vinfo( 1)=vname(1,idtvar(itrc))
1198 vinfo( 2)=vname(2,idtvar(itrc))
1199 vinfo( 3)=vname(3,idtvar(itrc))
1200 vinfo(14)=vname(4,idtvar(itrc))
1201 vinfo(16)=vname(1,idtime)
1202# ifndef NO_4BYTE_REALS
1203 vinfo(24)='_FillValue'
1204 aval(6)=spval
1205# endif
1206# ifdef SEDIMENT
1207 DO i=1,nst
1208 IF (itrc.eq.idsed(i)) THEN
1209 WRITE (vinfo(19),40) 1000.0_r8*sd50(i,ng)
1210 END IF
1211 END DO
1212# endif
1213 flt(ng)%pioTrc(itrc)%dkind=pio_fout
1214 flt(ng)%pioTrc(itrc)%gtype=0
1215!
1216 status=def_var(ng, inlm, flt(ng)%pioFile, &
1217 & flt(ng)%pioTrc(itrc)%vd, &
1218 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1219 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1220 END DO
1221# endif
1222
1223# ifdef FLOAT_OYSTER
1224!
1225! Define biological float swimming time.
1226!
1227 vinfo( 1)='swim_time'
1228 vinfo( 2)='biological float swimming time'
1229 vinfo( 3)='s'
1230 vinfo(14)='swim_time, scalar, series'
1231 vinfo(16)=vname(1,idtime)
1232# ifndef NO_4BYTE_REALS
1233 vinfo(24)='_FillValue'
1234 aval(6)=spval
1235# endif
1236 flt(ng)%pioVar(idswim)%dkind=pio_fout
1237 flt(ng)%pioVar(idswim)%gtype=0
1238!
1239 status=def_var(ng, inlm, flt(ng)%pioFile, &
1240 & flt(ng)%pioVar(idswim)%vd, &
1241 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1242 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1243!
1244! Define biological float vertical velocity.
1245!
1246 vinfo( 1)='w_bio'
1247 vinfo( 2)='biological float vertical velocity'
1248 vinfo( 3)='m/s'
1249 vinfo(14)='w_bio, scalar, series'
1250 vinfo(16)=vname(1,idtime)
1251# ifndef NO_4BYTE_REALS
1252 vinfo(24)='_FillValue'
1253 aval(6)=spval
1254# endif
1255 flt(ng)%pioVar(idwbio)%dkind=pio_fout
1256 flt(ng)%pioVar(idwbio)%gtype=0
1257!
1258 status=def_var(ng, inlm, flt(ng)%pioFile, &
1259 & flt(ng)%pioVar(idwbio)%vd, &
1260 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1261 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1262!
1263! Define biological float size (length).
1264!
1265 vinfo( 1)='bio_size'
1266 vinfo( 2)='biological float size'
1267 vinfo( 3)='um'
1268 vinfo(14)='bio_size, scalar, series'
1269 vinfo(16)=vname(1,idtime)
1270# ifndef NO_4BYTE_REALS
1271 vinfo(24)='_FillValue'
1272 aval(6)=spval
1273# endif
1274 flt(ng)%pioVar(idsize)%dkind=pio_fout
1275 flt(ng)%pioVar(idsize)%gtype=0
1276!
1277 status=def_var(ng, inlm, flt(ng)%pioFile, &
1278 & flt(ng)%pioVar(idsize)%vd, &
1279 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1280 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1281!
1282! Define biological float sinking velocity.
1283!
1284 vinfo( 1)='bio_sink'
1285 vinfo( 2)='biological float sinking velocity'
1286 vinfo( 3)='m/s'
1287 vinfo(14)='bio_sink, scalar, series'
1288 vinfo(16)=vname(1,idtime)
1289# ifndef NO_4BYTE_REALS
1290 vinfo(24)='_FillValue'
1291 aval(6)=spval
1292# endif
1293 flt(ng)%pioVar(idwsin)%dkind=pio_fout
1294 flt(ng)%pioVar(idwsin)%gtype=0
1295!
1296 status=def_var(ng, inlm, flt(ng)%pioFile, &
1297 & flt(ng)%pioVar(idwsin)%vd, &
1298 & pio_fout, 2, fgrd, aval, vinfo, ncname)
1299 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1300# endif
1301!
1302! Initialize unlimited time record dimension.
1303!
1304 flt(ng)%Rindex=0
1305!
1306!-----------------------------------------------------------------------
1307! Leave definition mode.
1308!-----------------------------------------------------------------------
1309!
1310 CALL pio_netcdf_enddef (ng, inlm, ncname, flt(ng)%pioFile)
1311 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1312!
1313!-----------------------------------------------------------------------
1314! Write out time-recordless, information variables.
1315!-----------------------------------------------------------------------
1316!
1317 CALL wrt_info (ng, inlm, flt(ng)%pioFile, ncname)
1318 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1319 END IF define
1320!
1321!=======================================================================
1322! Open an existing floats file, check its contents, and prepare for
1323! appending data.
1324!=======================================================================
1325!
1326 query : IF (.not.ldef) THEN
1327 ncname=flt(ng)%name
1328!
1329! Open floats file for read/write.
1330!
1331 CALL pio_netcdf_open (ng, inlm, ncname, 1, flt(ng)%pioFile)
1332 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1333 WRITE (stdout,50) trim(ncname)
1334 RETURN
1335 END IF
1336!
1337! Inquire about the dimensions and check for consistency.
1338!
1339 CALL pio_netcdf_check_dim (ng, inlm, ncname, &
1340 & piofile = flt(ng)%pioFile)
1341 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1342!
1343! Get the size of the drifter dimension.
1344!
1345 DO i=1,n_dim
1346 IF (trim(dim_name(i)).eq.'drifter') THEN
1347 nfloats(ng)=dim_size(i)
1348 EXIT
1349 END IF
1350 END DO
1351!
1352! Inquire about the variables.
1353!
1354 CALL pio_netcdf_inq_var (ng, inlm, ncname, &
1355 & piofile = flt(ng)%pioFile)
1356 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1357!
1358! Initialize logical switches.
1359!
1360 DO i=1,nv
1361 got_var(i)=.false.
1362 END DO
1363!
1364! Scan variable list from input NetCDF and activate switches for
1365! float variables. Get variable IDs.
1366!
1367 DO i=1,n_var
1368 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
1369 got_var(idtime)=.true.
1370 flt(ng)%pioVar(idtime)%vd=var_desc(i)
1371 flt(ng)%pioVar(idtime)%dkind=pio_tout
1372 flt(ng)%pioVar(idtime)%gtype=0
1373 ELSE IF (trim(var_name(i)).eq.'Xgrid') THEN
1374 got_var(idxgrd)=.true.
1375 flt(ng)%pioVar(idxgrd)%vd=var_desc(i)
1376 flt(ng)%pioVar(idxgrd)%dkind=pio_fout
1377 flt(ng)%pioVar(idxgrd)%gtype=0
1378 ELSE IF (trim(var_name(i)).eq.'Ygrid') THEN
1379 got_var(idygrd)=.true.
1380 flt(ng)%pioVar(idygrd)%vd=var_desc(i)
1381 flt(ng)%pioVar(idygrd)%dkind=pio_fout
1382 flt(ng)%pioVar(idygrd)%gtype=0
1383# ifdef SOLVE3D
1384 ELSE IF (trim(var_name(i)).eq.'Zgrid') THEN
1385 got_var(idzgrd)=.true.
1386 flt(ng)%pioVar(idzgrd)%vd=var_desc(i)
1387 flt(ng)%pioVar(idzgrd)%dkind=pio_fout
1388 flt(ng)%pioVar(idzgrd)%gtype=0
1389# endif
1390 ELSE IF (spherical.and.trim(var_name(i)).eq.'lon') THEN
1391 got_var(idglon)=.true.
1392 flt(ng)%pioVar(idglon)%vd=var_desc(i)
1393 flt(ng)%pioVar(idglon)%dkind=pio_fout
1394 flt(ng)%pioVar(idglon)%gtype=0
1395 ELSE IF (spherical.and.trim(var_name(i)).eq.'lat') THEN
1396 got_var(idglat)=.true.
1397 flt(ng)%pioVar(idglat)%vd=var_desc(i)
1398 flt(ng)%pioVar(idglat)%dkind=pio_fout
1399 flt(ng)%pioVar(idglat)%gtype=0
1400 ELSE IF (.not.spherical.and.trim(var_name(i)).eq.'x') THEN
1401 got_var(idglon)=.true.
1402 flt(ng)%pioVar(idglon)%vd=var_desc(i)
1403 flt(ng)%pioVar(idglon)%dkind=pio_fout
1404 flt(ng)%pioVar(idglon)%gtype=0
1405 ELSE IF (.not.spherical.and.trim(var_name(i)).eq.'y') THEN
1406 got_var(idglat)=.true.
1407 flt(ng)%pioVar(idglat)%vd=var_desc(i)
1408 flt(ng)%pioVar(idglat)%dkind=pio_fout
1409 flt(ng)%pioVar(idglat)%gtype=0
1410# ifdef SOLVE3D
1411 ELSE IF (trim(var_name(i)).eq.'depth') THEN
1412 got_var(iddpth)=.true.
1413 flt(ng)%pioVar(iddpth)%vd=var_desc(i)
1414 flt(ng)%pioVar(iddpth)%dkind=pio_fout
1415 flt(ng)%pioVar(iddpth)%gtype=0
1416 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iddano))) THEN
1417 got_var(iddano)=.true.
1418 flt(ng)%pioVar(iddano)%vd=var_desc(i)
1419 flt(ng)%pioVar(iddano)%dkind=pio_fout
1420 flt(ng)%pioVar(iddano)%gtype=0
1421# endif
1422# ifdef FLOAT_OYSTER
1423 ELSE IF (trim(var_name(i)).eq.'swim_time') THEN
1424 got_var(idswim)=.true.
1425 flt(ng)%pioVar(idswim)%vd=var_desc(i)
1426 flt(ng)%pioVar(idswim)%dkind=pio_fout
1427 flt(ng)%pioVar(idswim)%gtype=0
1428 ELSE IF (trim(var_name(i)).eq.'w_bio') THEN
1429 got_var(idwbio)=.true.
1430 flt(ng)%pioVar(idwbio)%vd=var_desc(i)
1431 flt(ng)%pioVar(idwbio)%dkind=pio_fout
1432 flt(ng)%pioVar(idwbio)%gtype=0
1433 ELSE IF (trim(var_name(i)).eq.'bio_size') THEN
1434 got_var(idsize)=.true.
1435 flt(ng)%pioVar(idsize)%vd=var_desc(i)
1436 flt(ng)%pioVar(idsize)%dkind=pio_fout
1437 flt(ng)%pioVar(idsize)%gtype=0
1438 ELSE IF (trim(var_name(i)).eq.'bio_sink') THEN
1439 got_var(idwsin)=.true.
1440 flt(ng)%pioVar(idwsin)%vd=var_desc(i)
1441 flt(ng)%pioVar(idwsin)%dkind=pio_fout
1442 flt(ng)%pioVar(idwsin)%gtype=0
1443# endif
1444 END IF
1445# ifdef SOLVE3D
1446 DO itrc=1,nt(ng)
1447 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
1448 got_var(idtvar(itrc))=.true.
1449 flt(ng)%pioTrc(itrc)%vd=var_desc(i)
1450 flt(ng)%pioTrc(itrc)%dkind=pio_fout
1451 flt(ng)%pioTrc(itrc)%gtype=0
1452 END IF
1453 END DO
1454# endif
1455 END DO
1456!
1457! Check if floats variables are available in input NetCDF file.
1458!
1459 IF (.not.got_var(idtime)) THEN
1460 IF (master) WRITE (stdout,60) trim(vname(1,idtime)), &
1461 & trim(ncname)
1462 exit_flag=3
1463 RETURN
1464 END IF
1465 IF (.not.got_var(idxgrd)) THEN
1466 IF (master) WRITE (stdout,60) 'Xgrid', trim(ncname)
1467 exit_flag=3
1468 RETURN
1469 END IF
1470 IF (.not.got_var(idygrd)) THEN
1471 IF (master) WRITE (stdout,60) 'Ygrid', trim(ncname)
1472 exit_flag=3
1473 RETURN
1474 END IF
1475# ifdef SOLVE3D
1476 IF (.not.got_var(idzgrd)) THEN
1477 IF (master) WRITE (stdout,60) 'Zgrid', trim(ncname)
1478 exit_flag=3
1479 RETURN
1480 END IF
1481# endif
1482 IF (.not.got_var(idglon)) THEN
1483 IF (spherical) THEN
1484 IF (master) WRITE (stdout,60) 'lon', trim(ncname)
1485 ELSE
1486 IF (master) WRITE (stdout,60) 'x', trim(ncname)
1487 END IF
1488 exit_flag=3
1489 RETURN
1490 END IF
1491 IF (.not.got_var(idglat)) THEN
1492 IF (spherical) THEN
1493 IF (master) WRITE (stdout,60) 'lat', trim(ncname)
1494 ELSE
1495 IF (master) WRITE (stdout,60) 'y', trim(ncname)
1496 END IF
1497 exit_flag=3
1498 RETURN
1499 END IF
1500# ifdef SOLVE3D
1501 IF (.not.got_var(iddpth)) THEN
1502 IF (master) WRITE (stdout,60) 'depth', trim(ncname)
1503 exit_flag=3
1504 RETURN
1505 END IF
1506 IF (.not.got_var(iddano)) THEN
1507 IF (master) WRITE (stdout,60) trim(vname(1,iddano)), &
1508 & trim(ncname)
1509 exit_flag=3
1510 RETURN
1511 END IF
1512# endif
1513# ifdef FLOAT_OYSTER
1514 IF (.not.got_var(idswim)) THEN
1515 IF (master) WRITE (stdout,60) 'swim_time', trim(ncname)
1516 exit_flag=3
1517 RETURN
1518 END IF
1519 IF (.not.got_var(idwbio)) THEN
1520 IF (master) WRITE (stdout,60) 'w_bio', trim(ncname)
1521 exit_flag=3
1522 RETURN
1523 END IF
1524 IF (.not.got_var(idsize)) THEN
1525 IF (master) WRITE (stdout,60) 'bio_size', trim(ncname)
1526 exit_flag=3
1527 RETURN
1528 END IF
1529 IF (.not.got_var(idwsin)) THEN
1530 IF (master) WRITE (stdout,60) 'bio_sink', trim(ncname)
1531 exit_flag=3
1532 RETURN
1533 END IF
1534# endif
1535# ifdef SOLVE3D
1536 DO itrc=1,nt(ng)
1537 IF (.not.got_var(idtvar(itrc))) THEN
1538 IF (master) WRITE (stdout,60) trim(vname(1,idtvar(itrc))), &
1539 & trim(ncname)
1540 exit_flag=3
1541 RETURN
1542 END IF
1543 END DO
1544# endif
1545!
1546!-----------------------------------------------------------------------
1547! Initialize floats positions to the appropriate values.
1548!-----------------------------------------------------------------------
1549!
1550! Set-up floats time record.
1551!
1552 IF (frrec(ng).lt.0) THEN
1553 flt(ng)%Rindex=rec_size
1554 ELSE
1555 flt(ng)%Rindex=abs(frrec(ng))
1556 END IF
1557!
1558! Read in floats nondimentional horizontal positions. If the floats
1559! have not been released yet at restart time, the values of Xgrid,
1560! Ygrid, and Zgrid will be _FillValue (1.0E+37) in the FLOATS NetCDF
1561! file. The calls to 'netcdf_get_fvar' will replace such values with
1562! zero. Therefore, we need to read Zgrid first so the bounded switch
1563! is false in such cases tp trigger release. Then, the bounded switch
1564! is set correctly when reading Xgrid and/or Ygrid since the lower
1565! bound is 0.5 in fractional coordinates.
1566!
1567# ifdef SOLVE3D
1568 CALL pio_netcdf_get_fvar (ng, inlm, ncname, 'Zgrid', &
1569 & tinp, &
1570 & piofile = flt(ng)%pioFile, &
1571 & start = (/1,flt(ng)%Rindex/), &
1572 & total = (/nfloats(ng),1/))
1573 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1574
1575 DO l=1,nfloats(ng)
1576 IF ((tinp(l).gt.real(n(ng),r8)).or. &
1577 & (tinp(l).lt.0.0_r8)) THEN
1578 drifter(ng)%bounded(l)=.false.
1579 ELSE
1580 drifter(ng)%bounded(l)=.true.
1581 DO i=0,nft
1582 drifter(ng)%track(izgrd,i,l)=tinp(l)
1583 drifter(ng)%track(izrhs,i,l)=0.0_r8
1584 END DO
1585 END IF
1586 END DO
1587!
1588# endif
1589 CALL pio_netcdf_get_fvar (ng, inlm, ncname, 'Xgrid', &
1590 & tinp, &
1591 & piofile = flt(ng)%pioFile, &
1592 & start = (/1,flt(ng)%Rindex/), &
1593 & total = (/nfloats(ng),1/))
1594 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1595
1596 DO l=1,nfloats(ng)
1597 IF ((tinp(l).gt.real(lm(ng)+1,r8)-0.5_r8).or. &
1598 & (tinp(l).lt.0.5_r8)) THEN
1599 drifter(ng)%bounded(l)=.false.
1600 ELSE
1601 drifter(ng)%bounded(l)=.true.
1602 DO i=0,nft
1603 drifter(ng)%track(ixgrd,i,l)=tinp(l)
1604 drifter(ng)%track(ixrhs,i,l)=0.0_r8
1605 END DO
1606 END IF
1607 END DO
1608!
1609 CALL pio_netcdf_get_fvar (ng, inlm, ncname, 'Ygrid', &
1610 & tinp, &
1611 & piofile = flt(ng)%pioFile, &
1612 & start = (/1,flt(ng)%Rindex/), &
1613 & total = (/nfloats(ng),1/))
1614 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1615
1616 DO l=1,nfloats(ng)
1617 IF ((tinp(l).gt.real(mm(ng)+1,r8)-0.5_r8).or. &
1618 & (tinp(l).lt.0.5_r8)) THEN
1619 drifter(ng)%bounded(l)=.false.
1620 ELSE
1621 drifter(ng)%bounded(l)=.true.
1622 DO i=0,nft
1623 drifter(ng)%track(iygrd,i,l)=tinp(l)
1624 drifter(ng)%track(iyrhs,i,l)=0.0_r8
1625 END DO
1626 END IF
1627 END DO
1628
1629 END IF query
1630!
1631 10 FORMAT (2x,'DEF_FLOATS_PIO - creating floats file,',t56, &
1632 & 'Grid ',i2.2,': ',a)
1633 20 FORMAT (2x,'DEF_FLOATS_PIO - inquiring floats file,',t56, &
1634 & 'Grid ',i2.2,': ',a)
1635 30 FORMAT (/,' DEF_FLOATS_PIO - unable to create floats NetCDF', &
1636 & ' file: ',a)
1637 40 FORMAT (1pe11.4,1x,'millimeter')
1638 50 FORMAT (/,' DEF_FLOATS_PIO - unable to open floats NetCDF', &
1639 & ' file: ',a)
1640 60 FORMAT (/,' DEF_FLOATS_PIO - unable to find variable: ',a,2x, &
1641 & ' in floats NetCDF file: ',a)
1642!
1643 RETURN
integer, parameter pio_fout
type(var_desc_t), dimension(:), pointer var_desc
subroutine, public pio_netcdf_create(ng, model, ncname, piofile)
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
integer, parameter pio_tout
subroutine, public pio_netcdf_enddef(ng, model, ncname, piofile)

References mod_floats::drifter, mod_scalars::exit_flag, mod_iounits::flt, strings_mod::founderror(), mod_floats::frrec, mod_ncparam::iddano, mod_ncparam::iddpth, mod_ncparam::idglat, mod_ncparam::idglon, mod_sediment::idsed, mod_ncparam::idsize, mod_ncparam::idswim, mod_ncparam::idtime, mod_ncparam::idtvar, mod_ncparam::idwbio, mod_ncparam::idwsin, mod_ncparam::idxgrd, mod_ncparam::idygrd, mod_ncparam::idzgrd, mod_param::inlm, mod_floats::ixgrd, mod_floats::ixrhs, mod_floats::iygrd, mod_floats::iyrhs, mod_floats::izgrd, mod_floats::izrhs, mod_param::lm, mod_parallel::master, mod_param::mm, mod_param::n, mod_biology::nbac, mod_biology::nbands, mod_param::nbed, mod_biology::ndom, mod_biology::nfec, mod_param::nfloats, mod_param::nft, mod_scalars::noerror, mod_biology::nphy, mod_param::nst, mod_fourdvar::nstatevar, mod_param::nt, mod_ncparam::nv, mod_pio_netcdf::pio_fout, mod_pio_netcdf::pio_netcdf_check_dim(), mod_pio_netcdf::pio_netcdf_create(), mod_pio_netcdf::pio_netcdf_enddef(), mod_pio_netcdf::pio_netcdf_inq_var(), mod_pio_netcdf::pio_netcdf_open(), mod_pio_netcdf::pio_tout, mod_scalars::rclock, mod_sediment::sd50, mod_iounits::sourcefile, mod_scalars::spherical, mod_scalars::spval, mod_iounits::stdout, mod_pio_netcdf::var_desc, and mod_ncparam::vname.

Referenced by def_floats().

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