pkg/ctrl/ctrl_init_rec.F

7bd66d7dc3 Patr*0001 #include "CTRL_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004
6fc9daf8e1 Jean*0005       SUBROUTINE CTRL_INIT_REC(
7bd66d7dc3 Patr*0006      I     fldname,
                0007      I     fldstartdate1, fldstartdate2, fldperiod, nfac,
                0008      O     fldstartdate, diffrec, startrec, endrec,
6fc9daf8e1 Jean*0009      I     myThid )
7bd66d7dc3 Patr*0010
6fc9daf8e1 Jean*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     ==================================================================
7bd66d7dc3 Patr*0023
6fc9daf8e1 Jean*0024       IMPLICIT NONE
7bd66d7dc3 Patr*0025
6fc9daf8e1 Jean*0026 C     == global variables ==
7bd66d7dc3 Patr*0027 #include "SIZE.h"
                0028 #include "EEPARAMS.h"
                0029 #include "PARAMS.h"
                0030 #ifdef ALLOW_CAL
                0031 # include "cal.h"
                0032 #endif
                0033
6fc9daf8e1 Jean*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          :: my thread Id number
                0040       CHARACTER*(*) fldname
                0041       INTEGER fldstartdate1
                0042       INTEGER fldstartdate2
7bd66d7dc3 Patr*0043       _RL     fldperiod
6fc9daf8e1 Jean*0044       INTEGER nfac
                0045       INTEGER myThid
7bd66d7dc3 Patr*0046
6fc9daf8e1 Jean*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
7bd66d7dc3 Patr*0056
6fc9daf8e1 Jean*0057 C     == functions ==
                0058       INTEGER  ILNBLNK
                0059       EXTERNAL ILNBLNK
                0060
                0061 C     == local variables ==
                0062       INTEGER i
7bd66d7dc3 Patr*0063 #ifdef ALLOW_CAL
6fc9daf8e1 Jean*0064       INTEGER difftime(4)
b938a3c63b antn*0065       INTEGER modelBaseDate(4)
7bd66d7dc3 Patr*0066       _RL     diffsecs
                0067 #endif /* ALLOW_CAL */
6fc9daf8e1 Jean*0068       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0069       INTEGER il
7bd66d7dc3 Patr*0070
6fc9daf8e1 Jean*0071       IF ( debugLevel .GE. debLevB ) THEN
                0072        il = ILNBLNK(fldname)
7bd66d7dc3 Patr*0073        WRITE( msgBuf,'(A,A)')
                0074      &     'CTRL_INIT_REC: Getting record indices for ',fldname(1:il)
                0075        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
6fc9daf8e1 Jean*0076      &                     SQUEEZE_RIGHT, myThid )
                0077       ENDIF
7bd66d7dc3 Patr*0078
6fc9daf8e1 Jean*0079 C     initialise some output
                0080       DO i = 1,4
7bd66d7dc3 Patr*0081        fldstartdate(i) = 0
6fc9daf8e1 Jean*0082       ENDDO
7bd66d7dc3 Patr*0083       startrec = 0
                0084       endrec   = 0
                0085       diffrec  = 0
6fc9daf8e1 Jean*0086       IF ( fldperiod .EQ. -12. ) THEN
7bd66d7dc3 Patr*0087        startrec = 1
                0088        endrec   = 12*nfac
6fc9daf8e1 Jean*0089       ELSEIF ( fldperiod .EQ. 0. ) THEN
7bd66d7dc3 Patr*0090        startrec = 1
                0091        endrec   = 1*nfac
                0092 # ifdef ALLOW_CAL
6fc9daf8e1 Jean*0093       ELSEIF ( useCAL ) THEN
                0094        CALL cal_FullDate( startdate_1, startdate_2,
                0095      &                        modelBaseDate , myThid )
                0096        CALL cal_FullDate( fldstartdate1, fldstartdate2,
                0097      &                        fldstartdate , myThid )
                0098        CALL cal_TimePassed( modelBaseDate, fldstartdate,
                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
6fc9daf8e1 Jean*0104        IF ( nfac .NE. 1 ) THEN
                0105 C     This is the case of obcs.
7bd66d7dc3 Patr*0106         startrec = (startrec - 1)*nfac + 1
                0107         endrec   = endrec*nfac
6fc9daf8e1 Jean*0108        ENDIF
                0109 #endif /* ALLOW_CAL */
                0110       ELSE
7bd66d7dc3 Patr*0111        startrec = 1
                0112        endrec   = (int((endTime - startTime)/fldperiod) + 1)*nfac
6fc9daf8e1 Jean*0113       ENDIF
7bd66d7dc3 Patr*0114       diffrec  = endrec - startrec + 1
                0115
6fc9daf8e1 Jean*0116       IF ( debugLevel .GE. debLevB ) THEN
7bd66d7dc3 Patr*0117        WRITE( msgBuf,'(A,A,A)')
                0118      &      'CTRL_INIT_REC: Record indices for ',fldname(1:il),':'
                0119        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
6fc9daf8e1 Jean*0120      &                     SQUEEZE_RIGHT, myThid )
7bd66d7dc3 Patr*0121        WRITE( msgBuf,'(A,I10,A,I10)')
                0122      &      'CTRL_INIT_REC: startrec = ',startrec,', endrec = ',endrec
                0123        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
6fc9daf8e1 Jean*0124      &                     SQUEEZE_RIGHT, myThid )
                0125       ENDIF
7bd66d7dc3 Patr*0126
6fc9daf8e1 Jean*0127       RETURN
                0128       END