pkg/ctrl/ctrl_init_rec.F

7bd66d7dc3 Patr*0001 #include "CTRL_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004
                0005       subroutine ctrl_init_rec(
                0006      I     fldname,
                0007      I     fldstartdate1, fldstartdate2, fldperiod, nfac,
                0008      O     fldstartdate, diffrec, startrec, endrec,
                0009      I     mythid )
                0010
                0011 c     ==================================================================
                0012 c     SUBROUTINE ctrl_init_rec
                0013 c     ==================================================================
                0014 c
                0015 c     helper routine to compute the first and last record of a
                0016 c     time dependent control variable
                0017 c
                0018 c     Martin.Losch@awi.de, 2011-Mar-15
                0019 c
                0020 c     ==================================================================
                0021 c     SUBROUTINE ctrl_init_rec
                0022 c     ==================================================================
                0023
                0024       implicit none
                0025
                0026 c     == global variables ==
                0027 #include "SIZE.h"
                0028 #include "EEPARAMS.h"
                0029 #include "PARAMS.h"
                0030 #ifdef ALLOW_CAL
                0031 # include "cal.h"
                0032 #endif
                0033
                0034 c     == input variables ==
                0035 c     fldstartdate1/2 : start time (date/time) of fld
                0036 c     fldperod        : sampling interval of fld
                0037 c     nfac            : factor for the case that fld is an obcs variable
                0038 c                       in this case nfac = 4, otherwise nfac = 1
                0039 c     mythid          : thread ID of this instance
                0040       character*(*) fldname
                0041       integer fldstartdate1
                0042       integer fldstartdate2
                0043       _RL     fldperiod
                0044       integer nfac
                0045       integer mythid
                0046
                0047 c     == output variables ==
                0048 c     fldstartdate : full date from fldstartdate1 and 2
                0049 c     startrec     : first record of ctrl variable
                0050 c     startrec     : last record of ctrl variable
                0051 c     diffrec      : difference between first and last record of ctrl variable
                0052       integer fldstartdate(4)
                0053       integer startrec
                0054       integer endrec
                0055       integer diffrec
                0056
                0057 c     == local variables ==
                0058       integer i
                0059 #ifdef ALLOW_CAL
                0060       integer difftime(4)
b938a3c63b antn*0061       INTEGER modelBaseDate(4)
7bd66d7dc3 Patr*0062       _RL     diffsecs
                0063 #endif /* ALLOW_CAL */
                0064       character*(max_len_mbuf) msgbuf
                0065       integer il
                0066
                0067 c     == functions ==
                0068       integer  ilnblnk
                0069       external ilnblnk
                0070
                0071       if ( debugLevel .GE. debLevB ) then
                0072        il=ilnblnk(fldname)
                0073        WRITE( msgBuf,'(A,A)')
                0074      &     'CTRL_INIT_REC: Getting record indices for ',fldname(1:il)
                0075        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0076      &      SQUEEZE_RIGHT , myThid )
                0077       endif
                0078
                0079 c     initialise some output
                0080       do i = 1,4
                0081        fldstartdate(i) = 0
                0082       end do
                0083       startrec = 0
                0084       endrec   = 0
                0085       diffrec  = 0
                0086       if ( fldperiod .EQ. -12. ) then
                0087        startrec = 1
                0088        endrec   = 12*nfac
                0089       elseif ( fldperiod .EQ. 0. ) then
                0090        startrec = 1
                0091        endrec   = 1*nfac
                0092       else
                0093 # ifdef ALLOW_CAL
b938a3c63b antn*0094        call cal_FullDate( startdate_1, startdate_2,
                0095      &                        modelBaseDate , mythid )
7bd66d7dc3 Patr*0096        call cal_FullDate( fldstartdate1, fldstartdate2,
                0097      &                        fldstartdate , mythid )
b938a3c63b antn*0098        call cal_TimePassed( modelBaseDate, fldstartdate,
7bd66d7dc3 Patr*0099      &                           difftime, mythid )
                0100        call cal_ToSeconds ( difftime, diffsecs, mythid )
b938a3c63b antn*0101        startrec = int((modelstart - diffsecs)/fldperiod) + 1
                0102        endrec   = int((modelend   - diffsecs + modelstep/2)
                0103      &                                       /fldperiod) + 2
7bd66d7dc3 Patr*0104        if ( nfac .ne. 1 ) then
                0105 c     This is the case of obcs.
                0106         startrec = (startrec - 1)*nfac + 1
                0107         endrec   = endrec*nfac
                0108        endif
                0109 # else /* ndef ALLOW_CAL */
                0110        startrec = 1
                0111        endrec   = (int((endTime - startTime)/fldperiod) + 1)*nfac
                0112 #endif /* ALLOW_CAL */
                0113       endif
                0114       diffrec  = endrec - startrec + 1
                0115
                0116       if ( debugLevel .GE. debLevB ) then
                0117        WRITE( msgBuf,'(A,A,A)')
                0118      &      'CTRL_INIT_REC: Record indices for ',fldname(1:il),':'
                0119        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0120      &      SQUEEZE_RIGHT , myThid )
                0121        WRITE( msgBuf,'(A,I10,A,I10)')
                0122      &      'CTRL_INIT_REC: startrec = ',startrec,', endrec = ',endrec
                0123        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0124      &      SQUEEZE_RIGHT , myThid )
                0125       endif
                0126
                0127       return
                0128       end