2 SUBROUTINE get_ngfld (ng, model, ifield, ncid, &
3#if defined PIO_LIB && defined DISTRIBUTE
6 & nfiles, S, recordless, update, &
7 & LBi, UBi, UBj, UBk, Istr, Iend, Jrec, &
27# if defined PIO_LIB && defined DISTRIBUTE
66 logical,
intent(in) :: recordless
67 logical,
intent(out) :: update
69 integer,
intent(in) :: ng, model, ifield, nfiles
70 integer,
intent(in) :: LBi, UBi, UBj, UBk, Istr, Iend, Jrec
73#if defined PIO_LIB && defined DISTRIBUTE
74 TYPE (File_desc_t),
intent(inout) :: pioFile
76 TYPE(
t_io),
intent(inout) :: S(nfiles)
78 real(r8),
intent(inout) :: Fout(LBi:UBi,UBj,UBk)
82 character (len=*),
parameter :: MyFile = &
89 SELECT CASE (s(1)%IOtype)
92 & nfiles, s, recordless, update, &
93 & lbi, ubi, ubj, ubk, istr, iend, jrec, &
96#if defined PIO_LIB && defined DISTRIBUTE
99 & nfiles, s, recordless, update, &
100 & lbi, ubi, ubj, ubk, istr, iend, jrec, &
109 10
FORMAT (
' GET_NGFLD - Illegal input file type, io_type = ',i0, &
110 & /,13x,
'Check KeyWord ''INP_LIB'' in ''roms.in''.')
117 & nfiles, S, recordless, update, &
118 & LBi, UBi, UBj, UBk, Istr, Iend, Jrec, &
140 logical,
intent(in) :: recordless
141 logical,
intent(out) :: update
143 integer,
intent(in) :: ng, model, ifield, nfiles
144 integer,
intent(in) :: LBi, UBi, UBj, UBk, Istr, Iend, Jrec
147 TYPE(
t_io),
intent(inout) :: S(nfiles)
149 real(r8),
intent(inout) :: Fout(LBi:UBi,UBj,UBk)
153 logical :: Linquire, Liocycle, Lmulti, Lonerec
155 integer :: Nrec, Tid, Tindex, Trec, Vid, Vtype
156 integer :: i, ic, j, job, lend, lstr, npts, nvdim, status
158 integer(i8b) :: Fhash
161 real(r8) :: Aval, Fmax, Fmin
163 real(dp) :: Clength, Tdelta, Tend
164 real(dp) :: Tmax, Tmin, Tmono, Tscale, Tstr
165 real(dp) :: Tsec, Tval
167 real(r8),
dimension((UBi-LBi+1)*UBj) :: Awrk
169 character (len=22) :: t_code
171 character (len=*),
parameter :: MyFile = &
172 & __FILE__//
", get_ngfld_nf90"
188 IF (
iic(ng).eq.0) linquire=.true.
189 IF (.not.linquire.and. &
190 & ((
iinfo(10,ifield,ng).gt.1).and. &
191 & (
linfo( 6,ifield,ng).or. &
208 CALL inquiry (ng, model, job, ubk, iend, ubi, ifield, ncid, &
211 IF (
linfo(6,ifield,ng))
THEN
212 linfo(6,ifield,ng)=.false.
221 tmono=
finfo(7,ifield,ng)
223 IF ((tmono.lt.
time(ng)).or.(
iic(ng).eq.0).or. &
228 liocycle=
linfo( 2,ifield,ng)
229 lonerec =
linfo( 3,ifield,ng)
230 vtype =
iinfo( 1,ifield,ng)
231 vid =
iinfo( 2,ifield,ng)
232 tid =
iinfo( 3,ifield,ng)
233 nrec =
iinfo( 4,ifield,ng)
234 tindex =
iinfo( 8,ifield,ng)
235 trec =
iinfo( 9,ifield,ng)
236 nvdim =
iinfo(11,ifield,ng)
237 tmin =
finfo( 1,ifield,ng)
238 tmax =
finfo( 2,ifield,ng)
239 clength =
finfo( 5,ifield,ng)
240 tscale =
finfo( 6,ifield,ng)
244 trec=mod(trec,nrec)+1
248 iinfo(9,ifield,ng)=trec
250 IF (trec.le.nrec)
THEN
261 iinfo(8,ifield,ng)=tindex
265 IF (.not.recordless.and.(tid.ge.0).and.(tid.ne.vid))
THEN
267 &
rclock%DateNumber, tval, &
269 & start = (/trec/), &
276 vtime(tindex,ifield,ng)=tval
282 IF ((trec.eq.nrec).and.(tval*
day2sec.le.
time(ng)))
THEN
283 linfo(6,ifield,ng)=.true.
296 &
vname(1,ifield), awrk, &
299 & total = (/iend-istr+1/))
300 ELSE IF (nvdim.eq.2)
THEN
302 npts=(iend-istr+1)*jrec
304 &
vname(1,ifield), awrk, &
307 & total = (/iend-istr+1,jrec/))
311 &
vname(1,ifield), awrk, &
313 & start = (/1,trec/), &
314 & total = (/iend-istr+1,1/))
316 ELSE IF (nvdim.eq.3)
THEN
317 npts=(iend-istr+1)*jrec
319 &
vname(1,ifield), awrk, &
321 & start = (/1,1,trec/), &
322 & total = (/iend-istr+1,jrec,1/))
328 fmin=awrk(1)*
fscale(ifield,ng)
329 fmax=awrk(1)*
fscale(ifield,ng)
334 aval=awrk(ic)*
fscale(ifield,ng)
337 fout(i,j,tindex)=aval
340 finfo(8,ifield,ng)=fmin
341 finfo(9,ifield,ng)=fmax
347 WRITE (
stdout,60) trim(
vname(2,ifield)), ng, fmin, fmax
349 lstr=scan(
ncfile,
'/',back=.true.)+1
354 & ng, trec, tindex,
ncfile(lstr:lend), &
355 & tmin, tmax, tval, fmin, fmax
370 IF (.not.lonerec.and.(.not.recordless))
THEN
371 tdelta=
vtime(tindex,ifield,ng)-
vtime(3-tindex,ifield,ng)
372 IF (liocycle.and.(tdelta.lt.0.0_r8))
THEN
373 tdelta=tdelta+clength
376 finfo(7,ifield,ng)=tmono
377 tintrp(tindex,ifield,ng)=tmono
381 10
FORMAT (/,
' GET_NGFLD_NF90 - unable to find dimension ',a, &
382 & /,18x,
'for variable: ',a,/,18x,
'in file: ',a, &
383 & /,18x,
'file is not CF compliant...')
384 20
FORMAT (/,
' GET_NGFLD_NF90 - too small dimension for variable ', &
386 30
FORMAT (/,
' GET_NGFLD_NF90 - unable to find requested variable:', &
387 & 1x,a,/,18x,
'in file: ',a)
388 40
FORMAT (/,
' GET_NGFLD_NF90 - unable to open input NetCDF', &
390 50
FORMAT (/,
' GET_NGFLD_NF90 - error while reading variable: ',a, &
391 & 2x,
' at TIME index = ',i0)
392 60
FORMAT (2x,
'GET_NGFLD_NF90 - ',a,/,22x,
'(Grid = ',i2.2, &
393 &
', Min = ',1pe15.8,
' Max = ', 1pe15.8,
')')
394 70
FORMAT (2x,
'GET_NGFLD_NF90 - ',a,
',',t75,a,/,22x, &
395 &
'(Grid= ',i2.2,
', Rec=',i0,
', Index=',i1, &
396 &
', File: ',a,
')',/,22x, &
397 &
'(Tmin= ', f15.4,
' Tmax= ', f15.4,
')', &
398 & t71,
't = ', f15.4 ,/,22x, &
399 &
'(Min = ', 1p,e15.8,0p,
' Max = ',1p,e15.8,0p,
')')
401 80
FORMAT (22x,
'(CheckSum = ',i0,
')')
407#if defined PIO_LIB && defined DISTRIBUTE
411 & nfiles, S, recordless, update, &
412 & LBi, UBi, UBj, UBk, Istr, Iend, Jrec, &
434 logical,
intent(in) :: recordless
435 logical,
intent(out) :: update
437 integer,
intent(in) :: ng, model, ifield, nfiles
438 integer,
intent(in) :: LBi, UBi, UBj, UBk, Istr, Iend, Jrec
440 TYPE (File_desc_t),
intent(inout) :: pioFile
441 TYPE(
t_io),
intent(inout) :: S(nfiles)
443 real(r8),
intent(inout) :: Fout(LBi:UBi,UBj,UBk)
447 logical :: Linquire, Liocycle, Lmulti, Lonerec
449 integer :: Nrec, Tindex, Trec, Vtype
450 integer :: i, ic, j, job, lend, lstr, npts, nvdim, status
452 integer(i8b) :: Fhash
455 real(r8) :: Aval, Fmax, Fmin
457 real(dp) :: Clength, Tdelta, Tend
458 real(dp) :: Tmax, Tmin, Tmono, Tscale, Tstr
459 real(dp) :: Tsec, Tval
461 real(r8),
dimension((UBi-LBi+1)*UBj) :: Awrk
463 character (len=22) :: t_code
465 character (len=*),
parameter :: MyFile = &
466 & __FILE__//
", get_ngfld_pio"
468 TYPE (My_VarDesc) :: TpioVar, VpioVar
484 IF (
iic(ng).eq.0) linquire=.true.
485 IF (.not.linquire.and. &
486 & ((
iinfo(10,ifield,ng).gt.1).and. &
487 & (
linfo( 6,ifield,ng).or. &
504 CALL inquiry (ng, model, job, ubk, iend, ubi, ifield, piofile, &
507 IF (
linfo(6,ifield,ng))
THEN
508 linfo(6,ifield,ng)=.false.
517 tmono=
finfo(7,ifield,ng)
519 IF ((tmono.lt.
time(ng)).or.(
iic(ng).eq.0).or. &
524 liocycle=
linfo( 2,ifield,ng)
525 lonerec =
linfo( 3,ifield,ng)
526 vtype =
iinfo( 1,ifield,ng)
527 vpiovar =
dinfo( 1,ifield,ng)
528 tpiovar =
dinfo( 2,ifield,ng)
529 nrec =
iinfo( 4,ifield,ng)
530 tindex =
iinfo( 8,ifield,ng)
531 trec =
iinfo( 9,ifield,ng)
532 nvdim =
iinfo(11,ifield,ng)
533 tmin =
finfo( 1,ifield,ng)
534 tmax =
finfo( 2,ifield,ng)
535 clength =
finfo( 5,ifield,ng)
536 tscale =
finfo( 6,ifield,ng)
540 trec=mod(trec,nrec)+1
544 iinfo(9,ifield,ng)=trec
546 IF (trec.le.nrec)
THEN
557 iinfo(8,ifield,ng)=tindex
561 IF (.not.recordless.and.(tpiovar%vd%varID.ge.0).and. &
562 & (tpiovar%vd%varID.ne.vpiovar%vd%varID))
THEN
564 &
rclock%DateNumber, tval, &
565 & piofile = piofile, &
566 & start = (/trec/), &
573 vtime(tindex,ifield,ng)=tval
579 IF ((trec.eq.nrec).and.(tval*
day2sec.le.
time(ng)))
THEN
580 linfo(6,ifield,ng)=.true.
587 IF (vpiovar%vd%varID.ge.0)
THEN
593 &
vname(1,ifield), awrk, &
594 & piofile = piofile, &
596 & total = (/iend-istr+1/))
597 ELSE IF (nvdim.eq.2)
THEN
599 npts=(iend-istr+1)*jrec
601 &
vname(1,ifield), awrk, &
602 & piofile = piofile, &
604 & total = (/iend-istr+1,jrec/))
609 &
vname(1,ifield), awrk, &
610 & piofile = piofile, &
611 & start = (/1,trec/), &
612 & total = (/iend-istr+1,1/))
614 ELSE IF (nvdim.eq.3)
THEN
615 npts=(iend-istr+1)*jrec
617 &
vname(1,ifield), awrk, &
618 & piofile = piofile, &
619 & start = (/1,1,trec/), &
620 & total = (/iend-istr+1,jrec,1/))
626 fmin=awrk(1)*
fscale(ifield,ng)
627 fmax=awrk(1)*
fscale(ifield,ng)
632 aval=awrk(ic)*
fscale(ifield,ng)
635 fout(i,j,tindex)=aval
638 finfo(8,ifield,ng)=fmin
639 finfo(9,ifield,ng)=fmax
645 WRITE (
stdout,60) trim(
vname(2,ifield)), ng, fmin, fmax
647 lstr=scan(
ncfile,
'/',back=.true.)+1
652 & ng, trec, tindex,
ncfile(lstr:lend), &
653 & tmin, tmax, tval, fmin, fmax
668 IF (.not.lonerec.and.(.not.recordless))
THEN
669 tdelta=
vtime(tindex,ifield,ng)-
vtime(3-tindex,ifield,ng)
670 IF (liocycle.and.(tdelta.lt.0.0_r8))
THEN
671 tdelta=tdelta+clength
674 finfo(7,ifield,ng)=tmono
675 tintrp(tindex,ifield,ng)=tmono
679 10
FORMAT (/,
' GET_NGFLD_PIO - unable to find dimension ',a, &
680 & /,17x,
'for variable: ',a,/,17x,
'in file: ',a, &
681 & /,17x,
'file is not CF compliant...')
682 20
FORMAT (/,
' GET_NGFLD_PIO - too small dimension for variable ', &
684 30
FORMAT (/,
' GET_NGFLD_PIO - unable to find requested variable:', &
685 & 1x,a,/,18x,
'in file: ',a)
686 40
FORMAT (/,
' GET_NGFLD_PIO - unable to open input NetCDF', &
688 50
FORMAT (/,
' GET_NGFLD_PIO - error while reading variable: ',a, &
689 & 2x,
' at TIME index = ',i0)
690 60
FORMAT (2x,
'GET_NGFLD_PIO - ',a,/,22x,
'(Grid = ',i2.2, &
691 &
', Min = ',1pe15.8,
' Max = ', 1pe15.8,
')')
692 70
FORMAT (2x,
'GET_NGFLD_PIO - ',a,
',',t75,a,/,22x, &
693 &
'(Grid= ',i2.2,
', Rec=',i0,
', Index=',i1, &
694 &
', File: ',a,
')',/,22x, &
695 &
'(Tmin= ', f15.4,
' Tmax= ', f15.4,
')', &
696 & t71,
't = ', f15.4 ,/,22x, &
697 &
'(Min = ', 1p,e15.8,0p,
' Max = ',1p,e15.8,0p,
')')
699 80
FORMAT (22x,
'(CheckSum = ',i0,
')')
subroutine get_ngfld(ng, model, ifield, ncid, piofile, nfiles, s, recordless, update, lbi, ubi, ubj, ubk, istr, iend, jrec, fout)
subroutine get_ngfld_pio(ng, model, ifield, piofile, nfiles, s, recordless, update, lbi, ubi, ubj, ubk, istr, iend, jrec, fout)
subroutine get_ngfld_nf90(ng, model, ifield, ncid, nfiles, s, recordless, update, lbi, ubi, ubj, ubk, istr, iend, jrec, fout)
subroutine, public time_string(mytime, date_string)
subroutine, public get_hash(a, asize, hash, lreduce)
character(len=256) ncfile
character(len=256) sourcefile
integer, parameter io_nf90
character(len=256), dimension(:,:), allocatable cinfo
logical, dimension(:,:,:), allocatable linfo
integer, parameter io_pio
type(my_vardesc), dimension(:,:,:), pointer dinfo
real(dp), dimension(:,:,:), allocatable vtime
real(dp), dimension(:,:,:), allocatable tintrp
real(dp), dimension(:,:), allocatable fscale
character(len=46), dimension(0:nv) tname
real(dp), dimension(:,:,:), allocatable finfo
character(len=maxlen), dimension(6, 0:nv) vname
integer, dimension(:,:,:), allocatable iinfo
real(dp), parameter day2sec
integer, dimension(:), allocatable iic
real(dp), dimension(:), allocatable time
integer, dimension(:), allocatable ntstart
logical function, public founderror(flag, noerr, line, routine)