26#if defined PIO_LIB && defined DISTRIBUTE
38#if defined PIO_LIB && defined DISTRIBUTE
84#if defined PIO_LIB && defined DISTRIBUTE
93 & ncname, ncid, TvarName, ntime, &
94 & smday, Tid, Lcycle, clength, &
95 & Tindex, Tstr, Tend, Tmin, Tmax, &
103 logical,
intent(in) :: Lmulti
104 logical,
intent(out) :: Lcycle
106 integer,
intent(in) :: ng, model, ifield, job, ncid, ntime
108 integer,
intent(out) :: Tindex, Tid
110 real(dp),
intent(in) :: smday
112 real(dp),
intent(out) :: Tmax, Tmin, Tend, Tscale, Tstr, clength
114 character (len=*),
intent(in) :: ncname
115 character (len=*),
intent(in) :: TvarName
120 logical :: Linside, LowerBound, Upperbound
122 integer :: i, nvatt, nvdim
124 real(dp) :: mday, tstart
125 real(dp) :: Tval(ntime)
127 character (len=40) :: tunits
129 character (len=*),
parameter :: MyFile = &
153 IF ((index(trim(tvarname),
'period').gt.0).or. &
154 & (trim(tvarname).eq.
'river'))
THEN
163 & myvarname = trim(tvarname), &
175 IF (trim(
var_aname(i)).eq.
'cycle_length')
THEN
187 ELSE IF (trim(
var_aname(i)).eq.
'units')
THEN
189 IF (tunits(1:6).eq.
'second')
THEN
199 &
rclock%DateNumber, tval, &
202 & total = (/ntime/), &
211 tval(i)=tval(i)*tscale
216 mday=mod(smday,clength)
224 IF ((tmin.le.mday).and.(mday.le.tmax))
THEN
226 ELSE IF (mday.ge.tmax)
THEN
228 ELSE IF (mday.le.tmin)
THEN
247 IF (tval(i).gt.mday)
THEN
255 IF (tval(i).le.mday)
THEN
275 IF ((tstart.le.mday).and.(mday.le.tval(i)))
THEN
295 IF ((tstart.le.mday).and.(mday.le.tval(i)))
THEN
303 ELSE IF (lowerbound)
THEN
306 ELSE IF (upperbound)
THEN
319 tstr=
finfo(2,ifield,ng)
321 tend=
finfo(1,ifield,ng)
324 IF (lcycle.and.(tindex.eq.ntime))
THEN
328 i=min(ntime,tindex+1)
341 IF (.not.timeless)
THEN
342 IF (.not.lcycle.and.(ntime.gt.1))
THEN
345 IF (smday.gt.tmax)
THEN
350 ELSE IF (
linfo(6,ifield,ng))
THEN
351 IF (tmin.lt.smday)
THEN
354 &
'Upper snapshot time for multi-file variable:', &
356 & trim(
vname(1,ifield)), &
357 &
'is less than current model time.', &
358 &
'Tmin = ', tmin, smday
365 IF (
linfo(5,ifield,ng))
THEN
366 IF (tmin.gt.smday)
THEN
369 &
'Lower snapshot time for multi-file variable:', &
371 & trim(
vname(1,ifield)), &
372 &
'is greater than current model time.', &
373 &
'Tmin = ', tmin, smday
379 IF (smday.lt.tmax)
THEN
382 &
'starting time for multi-file variable:', &
384 & trim(
vname(1,ifield)), &
385 &
'is greater than current model time.', &
386 &
'Tmax = ', tmax, smday
394 IF (.not.upperbound.and.(smday.lt.tmin))
THEN
396 & trim(
vname(1,ifield)), &
405 10
FORMAT (/,
' GET_CYCLE_NF90 - unable to get value for attribute:', &
406 & 1x,a,/,18x,
'in variable: ',a, &
407 & /,18x,
'This attribute value is expected to be of', &
408 & /,18x,
'the same external type as the variable.')
409 20
FORMAT (/,
' GET_CYCLE_NF90 - ending time for multi-file', &
410 &
' variable: ',a,/,18x,
'is less than current model time.', &
411 & /,18x,
'TMAX = ',f15.4,2x,
'TDAYS = ',f15.4)
412 30
FORMAT (/,
' GET_CYCLE_NF90 - ',a,1x,a,2x,
'(',a,
')',/,18x,a, &
413 & /,18x,a,f15.4,2x,
'TDAYS = ',f15.4)
414 40
FORMAT (/,
' GET_CYCLE_Nf90 - starting time for variable: ',a,2x, &
415 &
'(',a,
')',/,18x,
'is greater than current model time.', &
416 & /,18x,
'TMIN = ',f15.4,2x,
'TDAYS = ',f15.4)
421#if defined PIO_LIB && defined DISTRIBUTE
425 & ncname, pioFile, TvarName, ntime, &
426 & smday, TpioVar, Lcycle, clength, &
427 & Tindex, Tstr, Tend, Tmin, Tmax, &
435 logical,
intent(in) :: Lmulti
436 logical,
intent(out) :: Lcycle
438 integer,
intent(in) :: ng, model, ifield, job, ntime
440 integer,
intent(out) :: Tindex
442 real(dp),
intent(in) :: smday
444 real(dp),
intent(out) :: Tmax, Tmin, Tend, Tscale, Tstr, clength
446 character (len=*),
intent(in) :: ncname
447 character (len=*),
intent(in) :: TvarName
449 TYPE (File_desc_t),
intent(inout) :: pioFile
450 TYPE (Var_desc_t),
intent(out) :: TpioVar
455 logical :: Linside, LowerBound, Upperbound
457 integer :: i, nvatt, nvdim
459 real(dp) :: mday, tstart
460 real(dp) :: Tval(ntime)
462 character (len=40) :: tunits
464 character (len=*),
parameter :: MyFile = &
488 IF ((index(trim(tvarname),
'period').gt.0).or. &
489 & (trim(tvarname).eq.
'river'))
THEN
497 & piofile = piofile, &
498 & myvarname = trim(tvarname), &
499 & piovar = tpiovar, &
510 IF (trim(var_aname(i)).eq.
'cycle_length')
THEN
512 IF (var_afloat(i).gt.0.0_r8)
THEN
513 clength=var_afloat(i)
514 ELSE IF (var_aint(i).gt.0)
THEN
515 clength=real(var_aint(i),r8)
522 ELSE IF (trim(var_aname(i)).eq.
'units')
THEN
523 tunits=trim(var_achar(i))
524 IF (tunits(1:6).eq.
'second')
THEN
534 &
rclock%DateNumber, tval, &
535 & piofile = piofile, &
537 & total = (/ntime/), &
546 tval(i)=tval(i)*tscale
551 mday=mod(smday,clength)
559 IF ((tmin.le.mday).and.(mday.le.tmax))
THEN
561 ELSE IF (mday.ge.tmax)
THEN
563 ELSE IF (mday.le.tmin)
THEN
582 IF (tval(i).gt.mday)
THEN
590 IF (tval(i).le.mday)
THEN
610 IF ((tstart.le.mday).and.(mday.le.tval(i)))
THEN
630 IF ((tstart.le.mday).and.(mday.le.tval(i)))
THEN
638 ELSE IF (lowerbound)
THEN
641 ELSE IF (upperbound)
THEN
654 tstr=
finfo(2,ifield,ng)
656 tend=
finfo(1,ifield,ng)
659 IF (lcycle.and.(tindex.eq.ntime))
THEN
663 i=min(ntime,tindex+1)
676 IF (.not.timeless)
THEN
677 IF (.not.lcycle.and.(ntime.gt.1))
THEN
680 IF (smday.gt.tmax)
THEN
685 ELSE IF (
linfo(6,ifield,ng))
THEN
686 IF (tmin.lt.smday)
THEN
689 &
'Upper snapshot time for multi-file variable:', &
691 & trim(
vname(1,ifield)), &
692 &
'is less than current model time.', &
693 &
'Tmin = ', tmin, smday
700 IF (
linfo(5,ifield,ng))
THEN
701 IF (tmin.gt.smday)
THEN
704 &
'Lower snapshot time for multi-file variable:', &
706 & trim(
vname(1,ifield)), &
707 &
'is greater than current model time.', &
708 &
'Tmin = ', tmin, smday
714 IF (smday.lt.tmax)
THEN
717 &
'starting time for multi-file variable:', &
719 & trim(
vname(1,ifield)), &
720 &
'is greater than current model time.', &
721 &
'Tmax = ', tmax, smday
729 IF (.not.upperbound.and.(smday.lt.tmin))
THEN
731 & trim(
vname(1,ifield)), &
740 10
FORMAT (/,
' GET_CYCLE_PIO - unable to get value for attribute:', &
741 & 1x,a,/,17x,
'in variable: ',a, &
742 & /,17x,
'This attribute value is expected to be of', &
743 & /,17x,
'the same external type as the variable.')
744 20
FORMAT (/,
' GET_CYCLE_PIO - ending time for multi-file', &
745 &
' variable: ',a,/,17x,
'is less than current model time.', &
746 & /,17x,
'TMAX = ',f15.4,2x,
'TDAYS = ',f15.4)
747 30
FORMAT (/,
' GET_CYCLE_PIO - ',a,1x,a,2x,
'(',a,
')',/,17x,a, &
748 & /,17x,a,f15.4,2x,
'TDAYS = ',f15.4)
749 40
FORMAT (/,
' GET_CYCLE_PIO - starting time for variable: ',a,2x, &
750 &
'(',a,
')',/,17x,
'is greater than current model time.', &
751 & /,17x,
'TMIN = ',f15.4,2x,
'TDAYS = ',f15.4)
subroutine get_cycle_nf90(ng, model, ifield, job, lmulti, ncname, ncid, tvarname, ntime, smday, tid, lcycle, clength, tindex, tstr, tend, tmin, tmax, tscale)
subroutine get_cycle_pio(ng, model, ifield, job, lmulti, ncname, piofile, tvarname, ntime, smday, tpiovar, lcycle, clength, tindex, tstr, tend, tmin, tmax, tscale)
character(len=256) sourcefile
logical, dimension(:,:,:), allocatable linfo
real(dp), dimension(:,:,:), allocatable finfo
character(len=maxlen), dimension(6, 0:nv) vname
integer, dimension(nvara) var_aint
character(len=1024), dimension(nvara) var_achar
real(r8), dimension(nvara) var_afloat
character(len=100), dimension(nvara) var_aname
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
real(dp), parameter sec2day
logical function, public founderror(flag, noerr, line, routine)