pkg/ctrl/ctrl_get_gen_rec.F

7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
7109a141b2 Patr*0002
                0003       subroutine ctrl_get_gen_rec(
                0004      I                        xx_genstartdate,
                0005      I                        xx_genperiod,
                0006      O                        fac,
                0007      O                        first,
                0008      O                        changed,
                0009      O                        count0,
                0010      O                        count1,
4d72283393 Mart*0011      I                        myTime, myIter, myThid )
7109a141b2 Patr*0012
05e2fb6b68 Jean*0013 C     ==================================================================
                0014 C     SUBROUTINE ctrl_get_gen_rec
                0015 C     ==================================================================
                0016 C
                0017 C     o Get flags, counters, and the linear interpolation factor for a
                0018 C       given control vector contribution.
                0019 C     o New, generic, for new routine ctrl_get_gen
                0020 C
                0021 C     ==================================================================
                0022 C     SUBROUTINE ctrl_get_gen_rec
                0023 C     ==================================================================
7109a141b2 Patr*0024
                0025       implicit none
                0026
05e2fb6b68 Jean*0027 C     == global variables ==
7109a141b2 Patr*0028
                0029 #include "SIZE.h"
594dbca4e4 Jean*0030 #include "EEPARAMS.h"
                0031 #include "PARAMS.h"
5cf4364659 Mart*0032 #include "CTRL_SIZE.h"
4d72283393 Mart*0033 #include "CTRL.h"
dff4940422 Patr*0034 #ifdef ALLOW_CAL
7109a141b2 Patr*0035 # include "cal.h"
                0036 #endif
                0037
05e2fb6b68 Jean*0038 C     == routine arguments ==
7109a141b2 Patr*0039
                0040       integer xx_genstartdate(4)
                0041       _RL     xx_genperiod
                0042       _RL     fac
                0043       logical first
                0044       logical changed
                0045       integer count0
                0046       integer count1
4d72283393 Mart*0047       _RL     myTime
                0048       integer myIter
                0049       integer myThid
7109a141b2 Patr*0050
05e2fb6b68 Jean*0051 C     == local variables ==
7109a141b2 Patr*0052
dff4940422 Patr*0053 #ifdef ALLOW_CAL
7109a141b2 Patr*0054
                0055       integer mydate(4)
                0056       integer previousdate(4)
                0057       integer difftime(4)
                0058
                0059       integer fldcount
                0060       _RL     fldsecs
                0061       integer prevfldcount
                0062       _RL     prevfldsecs
                0063       integer flddate(4)
                0064
                0065       integer fldstartdate(4)
                0066       _RL     fldperiod
                0067
594dbca4e4 Jean*0068 c     integer startrec
cc7fa87b6d Gael*0069
deacece587 Oliv*0070       integer year0
                0071       integer year1
                0072
7109a141b2 Patr*0073       logical lArgErr
ab460d1282 Mart*0074 #else
                0075 C     Declarations for code, adapted from external_fields_load,
                0076 C     for simplied default model calendar without exf/cal
03c07845ac Jean*0077       _RL myRelTime, tmpFac
                0078       INTEGER countP
6dfbc266bb Jean*0079 #endif
7109a141b2 Patr*0080
                0081 #ifdef ECCO_VERBOSE
                0082       character*(max_len_mbuf) msgbuf
                0083 #endif
                0084
05e2fb6b68 Jean*0085 C     == end of interface ==
7109a141b2 Patr*0086
6dfbc266bb Jean*0087 #ifdef ALLOW_CAL
7109a141b2 Patr*0088       lArgErr = .true.
                0089       fldperiod = 0.
                0090
05e2fb6b68 Jean*0091 C     Map the field parameters.
7109a141b2 Patr*0092
                0093       call cal_CopyDate(
                0094      I     xx_genstartdate,
                0095      O     fldstartdate,
4d72283393 Mart*0096      I     myThid
7109a141b2 Patr*0097      &     )
                0098       fldperiod = xx_genperiod
                0099       lArgErr = .false.
951926fb9b Jean*0100
05e2fb6b68 Jean*0101 C--   Check the field argument.
7109a141b2 Patr*0102       if ( lArgErr ) then
                0103          print*,' The subroutine *ctrl_get_gen_rec* has been called'
                0104          print*,' with an illegal field specification.'
                0105          stop   ' ... stopped in ctrl_get_gen_rec.'
                0106       endif
                0107
79ee6da03d Mart*0108       if ( xx_genperiod .eq. -12. _d 0 ) then
05e2fb6b68 Jean*0109 C     record numbers are assumed 1 to 12 corresponding to
                0110 C     Jan. through Dec.
79ee6da03d Mart*0111        call cal_GetMonthsRec(
                0112      O      fac, first, changed,
deacece587 Oliv*0113      O      count0, count1, year0, year1,
4d72283393 Mart*0114      I      myTime, myIter, myThid
79ee6da03d Mart*0115      &      )
                0116       elseif ( fldperiod .eq. 0. _d 0 ) then
05e2fb6b68 Jean*0117 C     Read field only once in the beginning. Hack: count1=count0 causes
                0118 C     the model to read the first record twice, but since this this is
                0119 C     done only the first time around it is not too much of an overhead.
4d72283393 Mart*0120        first   = ((myTime - modelstart) .lt. 0.5*modelstep)
d2701cc5c1 Mart*0121        changed = .false.
                0122        fac     = 1. _d 0
                0123        count0  = 1
                0124        count1  = count0
                0125       else
05e2fb6b68 Jean*0126 C     fldperiod .ne. 0
                0127 C--   Determine the current date.
4d72283393 Mart*0128        call cal_GetDate( myIter, myTime, mydate, myThid )
7109a141b2 Patr*0129
05e2fb6b68 Jean*0130 C     Determine first record:
594dbca4e4 Jean*0131 c      call cal_TimePassed( fldstartdate, modelstartdate,
4d72283393 Mart*0132 c    &                      difftime, myThid )
                0133 c      call cal_ToSeconds ( difftime, fldsecs, myThid )
b938a3c63b antn*0134 c      startrec = int((modelstart - fldsecs)/fldperiod) + 1
cc7fa87b6d Gael*0135
05e2fb6b68 Jean*0136 C     Determine the flux record just before mycurrentdate.
d2701cc5c1 Mart*0137        call cal_TimePassed( fldstartdate, mydate, difftime,
4d72283393 Mart*0138      &                      myThid )
                0139        call cal_ToSeconds( difftime, fldsecs, myThid )
d2701cc5c1 Mart*0140        fldsecs  = int((fldsecs+0.5)/fldperiod)*fldperiod
                0141        fldcount = int((fldsecs+0.5)/fldperiod) + 1
7109a141b2 Patr*0142
05e2fb6b68 Jean*0143 C     Set switches for reading new records.
4d72283393 Mart*0144        first = ((myTime - modelstart) .lt. 0.5*modelstep)
7109a141b2 Patr*0145
d2701cc5c1 Mart*0146        if ( first) then
7109a141b2 Patr*0147         changed = .false.
d2701cc5c1 Mart*0148        else
4d72283393 Mart*0149         call cal_GetDate( myIter-1, myTime-modelstep,
                0150      &                    previousdate, myThid )
7109a141b2 Patr*0151
                0152         call cal_TimePassed( fldstartdate, previousdate,
4d72283393 Mart*0153      &                       difftime, myThid )
                0154         call cal_ToSeconds( difftime, prevfldsecs, myThid )
7109a141b2 Patr*0155         prevfldsecs  = int((prevfldsecs+0.5)/fldperiod)*fldperiod
                0156         prevfldcount = int((prevfldsecs+0.5)/fldperiod) + 1
                0157
                0158         if (fldcount .ne. prevfldcount) then
d2701cc5c1 Mart*0159          changed = .true.
7109a141b2 Patr*0160         else
d2701cc5c1 Mart*0161          changed = .false.
7109a141b2 Patr*0162         endif
d2701cc5c1 Mart*0163        endif
7109a141b2 Patr*0164
743c6cc502 Timo*0165        count0 = fldcount
                0166        count1 = fldcount + 1
7109a141b2 Patr*0167
4d72283393 Mart*0168        call cal_TimeInterval( fldsecs, 'secs', difftime, myThid )
                0169        call cal_AddTime( fldstartdate, difftime, flddate, myThid )
                0170        call cal_TimePassed( flddate, mydate, difftime, myThid )
                0171        call cal_ToSeconds( difftime, fldsecs, myThid )
7109a141b2 Patr*0172
05e2fb6b68 Jean*0173 C     Weight belonging to irec for linear interpolation purposes.
                0174 C     Note: The weight as chosen here is 1. - fac of the "old"
                0175 C           MITgcm estimation program.
d2701cc5c1 Mart*0176        fac = 1. - fldsecs/fldperiod
7109a141b2 Patr*0177
05e2fb6b68 Jean*0178 C     fldperiod .ne. 0.
03c07845ac Jean*0179       endif
ab460d1282 Mart*0180 #else /* not ALLOW_CAL */
6dfbc266bb Jean*0181 C     Code, adapted from external_fields_load, for simplied
ab460d1282 Mart*0182 C     default model calendar without exf/cal, but
05e2fb6b68 Jean*0183 C     based on myTime, myIter, deltaTClock, externForcingCycle, and startTime
ab460d1282 Mart*0184
                0185       myRelTime = myTime - startTime
                0186       first = (myRelTime .lt. 0.5*deltaTClock)
6dfbc266bb Jean*0187       if ( xx_genperiod .eq. 0. _d 0
ab460d1282 Mart*0188      &     .or. externForcingCycle .eq. 0. _d 0 ) then
6dfbc266bb Jean*0189 C     control parameter is constant in time and only needs to be updated
ab460d1282 Mart*0190 C     once in the beginning
                0191        changed = .false.
                0192        count0  = 1
                0193        count1  = 1
                0194        fac     = 1. _d 0
                0195       else
03c07845ac Jean*0196
                0197 C--   Now calculate whether it is time to update the forcing arrays
                0198        CALL GET_PERIODIC_INTERVAL(
                0199      O                   countP, count0, count1, tmpFac, fac,
                0200      I                   externForcingCycle, xx_genperiod,
05e2fb6b68 Jean*0201      I                   deltaTClock, myTime, myThid )
03c07845ac Jean*0202
                0203        IF ( count0.NE.countP ) THEN
ab460d1282 Mart*0204         changed = .true.
03c07845ac Jean*0205        ELSE
ab460d1282 Mart*0206         changed = .false.
03c07845ac Jean*0207        ENDIF
                0208        IF ( first ) changed = .false.
ab460d1282 Mart*0209
                0210       endif
                0211
                0212 #endif /* ALLOW_CAL */
                0213
7109a141b2 Patr*0214 #ifdef ECCO_VERBOSE
05e2fb6b68 Jean*0215 C     Do some printing for the protocol.
4d72283393 Mart*0216       _BEGIN_MASTER( myThid )
7109a141b2 Patr*0217         write(msgbuf,'(a)') ' '
4d72283393 Mart*0218         call print_message( msgbuf, standardMessageUnit,
                0219      &                      SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0220         write(msgbuf,'(a,2x,l2,2x,l2,2x,D15.8)')
                0221      &    '                     first, changed, fac:',
                0222      &                          first, changed, fac
4d72283393 Mart*0223         call print_message( msgbuf, standardMessageUnit,
                0224      &                      SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0225         write(msgbuf,'(a,i4,i4)')
                0226      &    '                          count0, count1:',
                0227      &                               count0, count1
4d72283393 Mart*0228         call print_message( msgbuf, standardMessageUnit,
                0229      &                      SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0230         write(msgbuf,'(a)') ' '
4d72283393 Mart*0231         call print_message( msgbuf, standardMessageUnit,
                0232      &                      SQUEEZE_RIGHT, myThid )
                0233       _END_MASTER( myThid )
7109a141b2 Patr*0234 #endif
                0235
                0236       return
                0237       end