pkg/exf/exf_getffield_start.F

da6a686ce6 Jean*0001 #include "EXF_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004
                0005 CBOP
                0006 C     !ROUTINE: EXF_GETFFIELD_START
                0007 C     !INTERFACE:
                0008        SUBROUTINE EXF_GETFFIELD_START(
                0009      I                useYearlyFields, pkg_name, fld_name,
                0010      I                fld_period, fld_startdate1, fld_startdate2,
                0011      U                fld_start_time, errCount,
                0012      I                myThid )
                0013
                0014 C !DESCRIPTION: \bv
                0015 C  *==========================================================*
                0016 C  | SUBROUTINE EXF_GETFFIELD_START
                0017 C  | o get forcing-field starting-time (in secs);
                0018 C  |   distinguish between using Yearly-Fields or not.
                0019 C  *==========================================================*
                0020 C \ev
                0021
                0022 C !USES:
                0023       IMPLICIT NONE
                0024 C     === Global variables ===
                0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
                0027 c#include "cal.h"
                0028 #include "PARAMS.h"
                0029
                0030 C !INPUT/OUTPUT PARAMETERS:
                0031 C     useYearlyFields :: select if using EXF Yearly-fields or not
                0032 C     pkg_name        :: package name from which this S/R is called
                0033 C     fld_name        :: field short name (to print mesg)
                0034 C     fld_period      :: time period (in sec) between 2 reccords
                0035 C     fld_startdate1  :: field starting date (YYYYMMDD)
                0036 C     fld_startdate2  :: field starting date (HHMMSS)
                0037 C     fld_start_time  :: corresponding starting time (in sec) for this field
                0038 C     errCount        :: error counter
                0039 C     myThid          :: My Thread Id number
                0040       LOGICAL useYearlyFields
                0041       CHARACTER*(*) pkg_name
                0042       CHARACTER*(*) fld_name
                0043       _RL fld_period
                0044       INTEGER fld_startdate1, fld_startdate2
                0045       _RL fld_start_time
                0046       INTEGER errCount
                0047       INTEGER myThid
                0048
                0049 C !FUNCTIONS:
                0050
                0051 C !LOCAL VARIABLES:
                0052 C     msgBuf          :: Informational/error message buffer
                0053       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0054 #ifdef ALLOW_CAL
                0055       INTEGER date_array(4), difftime(4), yearStartDate(4)
                0056       INTEGER gcm_startdate(4)
                0057 #endif /* ALLOW_CAL */
                0058 CEOP
                0059
                0060 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0061
                0062 C--   Set default start_time (in case not using Calendar)
                0063       IF ( fld_start_time.EQ.UNSET_RL ) THEN
                0064         fld_start_time = 0.
                0065       ELSEIF ( useCAL ) THEN
                0066 C-    Report inconsistent setting:
2b0c656f40 Jean*0067         WRITE(msgBuf,'(8A)') 'S/R EXF_GETFFIELD_START: ',
                0068      &   'start-time for ', pkg_name, '-field "', fld_name,
da6a686ce6 Jean*0069      &    '" = ', fld_name, 'StartTime'
                0070         CALL PRINT_ERROR( msgBuf, myThid )
2b0c656f40 Jean*0071 c       WRITE(msgBuf,'(5A)') 'S/R EXF_GETFFIELD_START: ',
                0072         WRITE(msgBuf,'(5A)') '    ',
                0073      &   'is computed (useCAL) from startdate1 & date2',
da6a686ce6 Jean*0074      &   ' and cannot be set (in data.', pkg_name, ')'
                0075         CALL PRINT_ERROR( msgBuf, myThid )
                0076         errCount = errCount + 1
                0077       ENDIF
                0078
                0079 C--   Convert start-date to start_time (case using Calendar)
6e2befed03 Oliv*0080       IF ( useCAL .AND. (fld_period.GT.0. .OR.
                0081      &     (fld_period.EQ.-1. .AND. .NOT.useYearlyFields)) ) THEN
da6a686ce6 Jean*0082 #ifdef ALLOW_CAL
                0083         CALL CAL_FULLDATE( fld_startdate1, fld_startdate2,
                0084      &                     date_array, myThid )
                0085         IF ( useYearlyFields ) THEN
                0086           yearStartDate(1) = INT(date_array(1)/10000.) * 10000 + 101
                0087           yearStartDate(2) = 0
                0088           yearStartDate(3) = date_array(3)
                0089           yearStartDate(4) = date_array(4)
                0090           CALL cal_TimePassed( yearStartDate, date_array, difftime,
                0091      I                         myThid )
                0092           CALL cal_ToSeconds ( difftime, fld_start_time, myThid )
                0093         ELSE
                0094 C--   with "cal.h" header file:
                0095 c         CALL cal_TimePassed(modelstartdate,date_array,difftime,myThid)
                0096 c         CALL cal_ToSeconds ( difftime, fld_start_time, myThid )
                0097 c         fld_start_time = modelstart + fld_start_time
                0098 C--   with "PARAMS.h" header file:
                0099           CALL cal_getdate( nIter0, startTime, gcm_startdate, myThid )
                0100           CALL cal_TimePassed( gcm_startdate, date_array, difftime,
                0101      I                         myThid )
                0102           CALL cal_ToSeconds ( difftime, fld_start_time, myThid )
                0103           fld_start_time = startTime  + fld_start_time
                0104         ENDIF
                0105 #endif /* ALLOW_CAL */
2b0c656f40 Jean*0106       ELSEIF ( .NOT.useCAL ) THEN
da6a686ce6 Jean*0107
2b0c656f40 Jean*0108        IF ( ( fld_startdate1.NE.0 .OR. fld_startdate2.NE.0 )
                0109      &      .AND. fld_period.GT.0. ) THEN
da6a686ce6 Jean*0110 C-    Report inconsistent setting:
                0111         IF ( fld_startdate1.NE.0 ) THEN
2b0c656f40 Jean*0112          WRITE(msgBuf,'(8A)') 'S/R EXF_GETFFIELD_START: ',
                0113      &   'start-date for ', pkg_name, '-field "', fld_name,
                0114      &   '" = ', fld_name, 'startdate1'
da6a686ce6 Jean*0115          CALL PRINT_ERROR( msgBuf, myThid )
                0116         ENDIF
                0117         IF ( fld_startdate2.NE.0 ) THEN
2b0c656f40 Jean*0118          WRITE(msgBuf,'(8A)') 'S/R EXF_GETFFIELD_START: ',
                0119      &   'start-date for ', pkg_name, '-field "', fld_name,
                0120      &   '" = ', fld_name, 'startdate2'
da6a686ce6 Jean*0121          CALL PRINT_ERROR( msgBuf, myThid )
                0122         ENDIF
2b0c656f40 Jean*0123 c       WRITE(msgBuf,'(5A)') 'S/R EXF_GETFFIELD_START: ',
                0124         WRITE(msgBuf,'(5A)') '    ',
                0125      &   'is not allowed (in data.', pkg_name, ')',
da6a686ce6 Jean*0126      &   ' when pkg/cal is not used (useCAL=F)'
                0127         CALL PRINT_ERROR( msgBuf, myThid )
                0128         errCount = errCount + 1
                0129        ENDIF
                0130
2b0c656f40 Jean*0131        IF ( fld_period.LT.0. ) THEN
                0132         WRITE(msgBuf,'(6A)') 'S/R EXF_GETFFIELD_START: ',
                0133      &   'Invalid record period for ', pkg_name, '-field "',
                0134      &   fld_name, '":'
                0135         CALL PRINT_ERROR( msgBuf, myThid )
                0136 c       WRITE(msgBuf,'(3A,F14.2,A)') 'S/R EXF_GETFFIELD_START: ',
                0137         WRITE(msgBuf,'(3A,F14.2,A)') '    ',
                0138      &   fld_name, 'period =', fld_period,
                0139      &   ' but should be >= 0 when useCAL=F'
                0140         CALL PRINT_ERROR( msgBuf, myThid )
                0141         errCount = errCount + 1
                0142        ENDIF
                0143
da6a686ce6 Jean*0144 C-    end if fld_period > 0
                0145       ENDIF
                0146
                0147       RETURN
                0148       END