pkg/exf/exf_getffieldrec.F

6d54cf9ca1 Ed H*0001 #include "EXF_OPTIONS.h"
7f861c1808 Patr*0002
d7e09becc2 Jean*0003 CBOP
                0004 C     !ROUTINE: EXF_GetFFieldRec
                0005 C     !INTERFACE:
e8bcad7904 Jean*0006       SUBROUTINE EXF_GetFFieldRec(
8a0f942cd7 Jean*0007      I               fldStartTime, fldPeriod, fldRepeatCycle,
                0008      I               fldName, usefldyearlyfields,
                0009      O               fac, first, changed,
                0010      O               count0, count1, year0, year1,
                0011      I               myTime, myIter, myThid )
7f861c1808 Patr*0012
d7e09becc2 Jean*0013 C     !DESCRIPTION: \bv
                0014 C     *==========================================================*
                0015 C     | SUBROUTINE EXF_GetFFieldRec
                0016 C     | o Get flags, counters, and the linear interpolation
                0017 C     |   factor for a given field.
                0018 C     *==========================================================*
                0019 C     \ev
7f861c1808 Patr*0020
d7e09becc2 Jean*0021 C     !USES:
e8bcad7904 Jean*0022       IMPLICIT NONE
7f861c1808 Patr*0023
d7e09becc2 Jean*0024 C     == Global variables ==
                0025 #include "SIZE.h"
7f861c1808 Patr*0026 #include "EEPARAMS.h"
d7e09becc2 Jean*0027 #include "PARAMS.h"
082e18c36c Jean*0028 #include "EXF_PARAM.h"
d7e09becc2 Jean*0029 #ifdef ALLOW_CAL
                0030 # include "cal.h"
                0031 #endif
                0032
                0033 C     !INPUT PARAMETERS:
                0034 C     fldStartTime       :: time in seconds of first fld record from the
                0035 C                           beginning of the model integration or, if
                0036 C                           usefldyearlyfields, from the beginning of year
                0037 C     fldPeriod          :: period between forcing field records
8a0f942cd7 Jean*0038 C     fldRepeatCycle     :: time duration of a repeating cycle
                0039 C     fldName            :: field short name (to print mesg)
d7e09becc2 Jean*0040 C     usefldyearlyfields :: when set, use yearly forcing files
                0041 C     myTime             :: current time in simulation
                0042 C     myIter             :: current iteration number in simulation
                0043 C     myThid             :: my thread identification number
8a0f942cd7 Jean*0044       _RL     fldStartTime, fldPeriod, fldRepeatCycle
                0045       CHARACTER*(*) fldName
d7e09becc2 Jean*0046       LOGICAL usefldyearlyfields
e8bcad7904 Jean*0047       _RL     myTime
                0048       INTEGER myIter, myThid
5d912106da Dimi*0049
d7e09becc2 Jean*0050 C     !OUTPUT PARAMETERS:
                0051 C     fac     :: weight of record count0 for linear interpolation purposes
                0052 C     first   :: model initialization flag: read two forcing records
                0053 C     changed :: flag indicating that a new forcing record must be read
                0054 C     count0  :: record number for forcing field preceding myTime
                0055 C     count1  :: record number for forcing field following myTime
                0056 C     year0   :: year of forcing file for record preceding myTime
                0057 C     year1   :: year of forcing file for record following myTime
7f861c1808 Patr*0058       _RL     fac
e8bcad7904 Jean*0059       LOGICAL first, changed
                0060       INTEGER count0, count1, year0, year1
7f861c1808 Patr*0061
d7e09becc2 Jean*0062 C     !FUNCTIONS:
                0063 #ifdef ALLOW_CAL
                0064       INTEGER  cal_IsLeap
                0065       EXTERNAL cal_IsLeap
                0066 #endif
                0067
                0068 C     !LOCAL VARIABLES:
                0069 C     mydate        :: model date of current time step
                0070 C     yearStartDate :: start of year date for flux record just before mydate
                0071 C     difftime      :: time difference between yearStartDate and mydate
                0072 C     fldsectot     :: time in seconds from fldStartTime to mydate
                0073 C     fldsecs       :: time from start of current forcing period to mydate
                0074 C     fldsecs0      :: time from start of repeat period to mydate
                0075 C     fldsecs1      :: time from end of current forcing period to mydate
                0076 C     secondsInYear :: seconds in the flux year just before mydate
                0077 C     myDateSeconds :: seconds from beginning of year to mydate
                0078 #ifdef ALLOW_CAL
e8bcad7904 Jean*0079       INTEGER mydate(4)
                0080       INTEGER yearStartDate(4)
                0081       INTEGER difftime(4)
dafc34a813 Dimi*0082       _RL fldsectot, fldsecs, fldsecs0, fldsecs1
                0083       _RL secondsInYear, myDateSeconds
d7e09becc2 Jean*0084 #endif
                0085        INTEGER intimeP, intime0, intime1
                0086        _RL locTime, aWght, bWght
                0087       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0088 CEOP
cee16b76ae Dimi*0089
d7e09becc2 Jean*0090 #ifdef ALLOW_CAL
                0091       IF ( useCAL ) THEN
7f861c1808 Patr*0092
d7e09becc2 Jean*0093 C     Set some default values.
                0094        first = ((myTime - modelstart) .lt. 0.5*modelstep)
e8bcad7904 Jean*0095        changed = .FALSE.
659d0ae881 Dimi*0096
d7e09becc2 Jean*0097        if ( fldPeriod .eq. 0. _d 0 ) then
                0098 C     Read field only once in the beginning. Hack: count1=count0 causes
                0099 C     the model to read the first record twice, but since this this is
                0100 C     done only the first time around it is not too much of an overhead.
                0101         first   = ((myTime - modelstart) .lt. 0.5*modelstep)
                0102         changed = .FALSE.
                0103         fac     = 1. _d 0
                0104         count0  = 1
                0105         count1  = count0
                0106 C     Give these variables some unproblematic values although they are
                0107 C     never used in this context.
                0108         year0   = 0
                0109         year1   = year0
659d0ae881 Dimi*0110        else
d7e09becc2 Jean*0111 C       fldPeriod .ne. 0
                0112         if (.not.usefldyearlyfields) then
659d0ae881 Dimi*0113
d7e09becc2 Jean*0114 C     Determine offset in seconds from beginning of input data
                0115 C     to current date.
                0116          fldsectot = myTime - fldStartTime
659d0ae881 Dimi*0117
d7e09becc2 Jean*0118 C     Determine the flux records just before and after mycurrentdate.
8a0f942cd7 Jean*0119          if ( fldRepeatCycle .eq. 0. _d 0 ) then
659d0ae881 Dimi*0120
d7e09becc2 Jean*0121           if ( fldsectot .lt. 0. _d 0 ) then
8a0f942cd7 Jean*0122            WRITE(msgBuf,'(4A,1P1E17.10,A)') 'EXF_GetFFieldRec ',
                0123      &       'for field "', fldName, '": myTime=', myTime, ' earlier'
                0124            CALL PRINT_ERROR( msgBuf, myThid )
                0125            WRITE(msgBuf,'(2A,1P1E18.10,A)') 'EXF_GetFFieldRec: ',
                0126      &       'than 1rst reccord (field-startdate=', fldStartTime, ')'
d7e09becc2 Jean*0127            CALL PRINT_ERROR( msgBuf, myThid )
                0128            STOP 'ABNORMAL END: S/R EXF_GetFFieldRec'
                0129           endif
8a0f942cd7 Jean*0130           count0       = INT((fldsectot+0.5)/fldPeriod) + 1
d7e09becc2 Jean*0131           count1       = count0 + 1
8a0f942cd7 Jean*0132           fldsecs      = MOD(fldsectot,fldPeriod)
d7e09becc2 Jean*0133
                0134          else
8a0f942cd7 Jean*0135 C        if ( fldRepeatCycle .gt. 0. )
d7e09becc2 Jean*0136
                0137 C     If using repeating data then make fldsectot cycle around.
8a0f942cd7 Jean*0138           if (fldsectot.lt.0. _d 0)
                0139      &        fldsectot = fldsectot + fldRepeatCycle
                0140           fldsecs0     = MOD(fldsectot,fldRepeatCycle)
                0141           count0       = INT((fldsecs0+0.5)/fldPeriod) + 1
                0142           fldsecs1     = MOD(fldsectot+fldPeriod,fldRepeatCycle)
                0143           count1       = INT((fldsecs1+0.5)/fldPeriod) + 1
                0144           fldsecs      = MOD(fldsecs0,fldPeriod)
d7e09becc2 Jean*0145
                0146          endif
                0147
                0148 C     Weight belonging to count0 for linear interpolation purposes.
                0149          fac = 1. - fldsecs/fldPeriod
                0150
                0151         else
                0152 C       if (usefldyearlyfields)
                0153
                0154 C     Determine seconds from beginning of year to model current time.
8a0f942cd7 Jean*0155          CALL cal_GetDate( myIter, myTime, mydate, myThid )
                0156          year0            = INT(mydate(1)/10000.)
d7e09becc2 Jean*0157          yearStartDate(1) = year0 * 10000 + 101
                0158          yearStartDate(2) = 0
                0159          yearStartDate(3) = mydate(3)
                0160          yearStartDate(4) = mydate(4)
                0161          CALL cal_TimePassed(yearStartDate,mydate,difftime,myThid)
                0162          CALL cal_ToSeconds (difftime,myDateSeconds,myThid)
                0163
                0164 C     Determine the flux year just before mycurrentdate.
                0165          if ( myDateSeconds .lt. fldStartTime ) year0 = year0 - 1
                0166
                0167 C     Determine seconds in the flux year just before mycurrentdate.
                0168          secondsInYear = ndaysnoleap * secondsperday
                0169          if ( cal_IsLeap(year0,myThid) .eq. 2)
                0170      &       secondsInYear = ndaysleap * secondsperday
659d0ae881 Dimi*0171
d7e09becc2 Jean*0172 C     Determine the record just before mycurrentdate.
                0173          if ( myDateSeconds .lt. fldStartTime )
                0174      &       myDateSeconds = myDateSeconds + secondsInYear
                0175          fldsectot = myDateSeconds - fldStartTime
8a0f942cd7 Jean*0176          count0    = INT((fldsectot+0.5)/fldPeriod) + 1
d7e09becc2 Jean*0177
                0178 C     Determine the flux year and record just after mycurrentdate.
                0179          year1  = year0
                0180          count1 = count0 + 1
                0181          if ( (fldStartTime+count0*fldPeriod) .ge. secondsInYear ) then
                0182           year1  = year0 + 1
                0183           count1 = 1
                0184          endif
                0185
                0186 C     Weight belonging to count0 for linear interpolation purposes.
8a0f942cd7 Jean*0187          fldsecs = MOD(fldsectot,fldPeriod)
d7e09becc2 Jean*0188          fac     = 1. - fldsecs/fldPeriod
                0189          if ( year0 .ne. year1 )
                0190      &       fac = 1. - fldsecs/(secondsInYear-(count0-1)*fldPeriod)
dafc34a813 Dimi*0191
d7e09becc2 Jean*0192        endif
                0193 C      if (usefldyearlyfields)
dafc34a813 Dimi*0194
d7e09becc2 Jean*0195 C     Set switch for reading new record.
                0196        if ( fldsecs - modelstep .lt. 0. _d 0 ) changed = .TRUE.
dafc34a813 Dimi*0197
d7e09becc2 Jean*0198        endif
                0199 C      if (fldPeriod .eq. 0.)
                0200
                0201       ELSE
                0202 #else /* ALLOW_CAL */
                0203       IF ( .TRUE. ) THEN
                0204 #endif /* ALLOW_CAL */
                0205
                0206        year0 = 0
                0207        year1 = 0
                0208
                0209        IF ( fldPeriod .EQ. 0. _d 0 ) THEN
                0210         fac     = 1. _d 0
                0211         first   = ( myIter.EQ.nIter0 )
                0212         changed = .FALSE.
                0213 C     Read field only once in the beginning. Hack: count1=count0 causes
                0214 C     the model to read the first record twice, but since this this is
                0215 C     done only the first time around it is not too much of an overhead.
                0216         count0  = 1
                0217         count1  = 1
                0218
                0219        ELSE
                0220         locTime = myTime - fldStartTime + fldPeriod*halfRL
                0221         CALL GET_PERIODIC_INTERVAL(
                0222      O                  intimeP, intime0, intime1, bWght, aWght,
8a0f942cd7 Jean*0223      I                  fldRepeatCycle, fldPeriod,
d7e09becc2 Jean*0224      I                  deltaTClock, locTime, myThid )
                0225
                0226 C      Fld @ t = bWght*Fld(intime0) + aWght*Fld(intime1)
                0227         fac     =  bWght
                0228         first   = ( myIter .EQ.nIter0 )
                0229         changed = ( intime0.NE.intimeP )
                0230         count0  = intime0
                0231         count1  = intime1
                0232
                0233         IF ( intime0 .LE. 0 ) THEN
8a0f942cd7 Jean*0234            WRITE(msgBuf,'(3A,I10,A,1P1E17.10)')
                0235      &       'EXF_GetFFieldRec: for field "', fldName,
                0236      &       '" @ Iter=', myIter, ' , myTime=', myTime
d7e09becc2 Jean*0237            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
8a0f942cd7 Jean*0238      &                         SQUEEZE_RIGHT, myThid )
                0239            WRITE(msgBuf,'(2(A,1P1E18.10))')
                0240      &       'EXF_GetFFieldRec:  fldRepeatCycle=', fldRepeatCycle,
                0241      &                            ' , fldPeriod=', fldPeriod
d7e09becc2 Jean*0242            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
8a0f942cd7 Jean*0243      &                         SQUEEZE_RIGHT, myThid )
                0244            WRITE(msgBuf,'(3(A,I8))') 'EXF_GetFFieldRec:  intimeP=',
                0245      &       intimeP, ', intime0=', intime0, ', intime1=', intime1
d7e09becc2 Jean*0246            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
8a0f942cd7 Jean*0247      &                         SQUEEZE_RIGHT, myThid )
                0248            WRITE(msgBuf,'(2(A,1P1E14.7),A,1P1E16.9)')
                0249      &      'EXF_GetFFieldRec:  bWght,aWght=', bWght, ',', aWght,
                0250      &      ' @ locTime=', locTime
d7e09becc2 Jean*0251            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
8a0f942cd7 Jean*0252      &                         SQUEEZE_RIGHT, myThid )
d7e09becc2 Jean*0253            WRITE(msgBuf,'(2A)') 'EXF_GetFFieldRec: ',
                0254      &        'Reccord number "intime0" not valid ; possible cause:'
                0255            CALL PRINT_ERROR( msgBuf, myThid )
8a0f942cd7 Jean*0256            WRITE(msgBuf,'(2A,1P2E18.10)') 'EXF_GetFFieldRec: ',
d7e09becc2 Jean*0257      &        ' myTime earlier than field-StartTime=', fldStartTime
                0258            CALL PRINT_ERROR( msgBuf, myThid )
                0259            STOP 'ABNORMAL END: S/R EXF_GetFFieldRec'
                0260         ENDIF
                0261
                0262 C-     end if fldPeriod=0
                0263        ENDIF
                0264
                0265 C--   end if/else useCAL
                0266       ENDIF
8f134a052a Patr*0267
e8bcad7904 Jean*0268       RETURN
                0269       END