pkg/cal/cal_set.F

6d54cf9ca1 Ed H*0001 #include "CAL_OPTIONS.h"
a63ed37559 Patr*0002
3cb4ec9f6f Jean*0003       SUBROUTINE CAL_SET(
                0004      I                    modstart, modend, modstep,
                0005      I                    moditerini, moditerend, modintsteps,
                0006      I                    myThid )
                0007
                0008 C     ==================================================================
                0009 C     SUBROUTINE cal_Set
                0010 C     ==================================================================
                0011 C
                0012 C     o This routine initialises the calendar according to the user
                0013 C       specifications in "data".
                0014 C
                0015 C     Purpose: Precalculations for the calendar.
                0016 C              Given the type of calendar that should be used date
                0017 C              arrays and some additional information is returned.
                0018 C              Check for consistency with other specifications such
                0019 C              as modintsteps.
                0020 C
                0021 C     started: Christian Eckert eckert@mit.edu  30-Jun-1999
                0022 C     changed: Christian Eckert eckert@mit.edu  29-Dec-1999
                0023 C              - restructured the original version in order to have a
                0024 C                better interface to the MITgcmUV.
                0025 C              Christian Eckert eckert@mit.edu  19-Jan-2000
                0026 C              - Changed the role of the routine arguments. Chris Hill
                0027 C                proposed to make the calendar less "invasive". The tool
                0028 C                now assumes that the MITgcmUV already provides an ade-
                0029 C                quate set of time stepping parameters. The calendar
                0030 C                only associates a date with the given starttime of the
                0031 C                numerical model. startdate corresponds to zero start-
                0032 C                time. So, given niter0 or startdate .ne. zero the actual
                0033 C                startdate of the current integration is shifted by the
                0034 C                time interval correponding to niter0, startdate respec-
                0035 C                tively.
                0036 C              Christian Eckert eckert@mit.edu  03-Feb-2000
                0037 C              - Introduced new routine and function names, cal_<NAME>,
                0038 C                for verion 0.1.3.
                0039 C              Christian Eckert eckert@mit.edu  23-Feb-2000
                0040 C              - Corrected the declaration of *modelrundate*
                0041 C                --> integer modelrundate(4)
                0042 C
                0043 C     ==================================================================
                0044 C     SUBROUTINE cal_Set
                0045 C     ==================================================================
                0046
                0047       IMPLICIT NONE
                0048
                0049 C     == global variables ==
a63ed37559 Patr*0050
                0051 #include "cal.h"
                0052
3cb4ec9f6f Jean*0053 C     == routine arguments ==
                0054 C     modstart        :: start time of the model integration
                0055 C     modend          :: end time of the model integration
                0056 C     modstep         :: timestep of the numerical model
                0057 C     moditerini      :: initial iteration number of the model
                0058 C     moditerend      :: last iteration number of the model
                0059 C     modintsteps     :: number of timesteps that are to be performed.
                0060 C     myThid          :: my Thread Id number
a63ed37559 Patr*0061
                0062       _RL     modstart
                0063       _RL     modend
                0064       _RL     modstep
3cb4ec9f6f Jean*0065       INTEGER moditerini
                0066       INTEGER moditerend
                0067       INTEGER modintsteps
                0068       INTEGER myThid
                0069
                0070 C     == local variables ==
ce3a0fd2a0 Jean*0071 C     modelBaseDate :: full date array for startdate_1,startdate_2
                0072 C                       (corresponds to model baseTime, iter=0)
3cb4ec9f6f Jean*0073       INTEGER i,j,k
                0074       INTEGER ierr
                0075       INTEGER timediff(4)
                0076       INTEGER iterinitime(4)
ce3a0fd2a0 Jean*0077       INTEGER modelBaseDate(4)
a63ed37559 Patr*0078       _RL     runtimesecs
                0079       _RL     iterinisecs
3cb4ec9f6f Jean*0080 C     == end of interface ==
a63ed37559 Patr*0081
ce3a0fd2a0 Jean*0082       _BEGIN_MASTER(myThid)
a63ed37559 Patr*0083
13a16b18e5 Jean*0084 C-    Initialise some variables.
                0085       usingNoLeapYearCal     = .FALSE.
ce3a0fd2a0 Jean*0086       usingGregorianCalendar = .FALSE.
                0087       usingModelCalendar     = .FALSE.
                0088       usingJulianCalendar    = .FALSE.
a63ed37559 Patr*0089
13a16b18e5 Jean*0090 C-    Set calendar parameters which are independent of the calendar choice:
                0091       hoursPerDay      = 24
                0092       minutesPerHour   = 60
                0093       minutesPerDay    = minutesPerHour*hoursPerDay
                0094       secondsPerMinute = 60
                0095       secondsPerHour   = secondsPerMinute*minutesPerHour
                0096       secondsPerDay    = secondsPerMinute*minutesPerDay
a63ed37559 Patr*0097
13a16b18e5 Jean*0098 C-    Select which calendar type to use:
                0099       IF ( theCalendar .EQ. 'gregorian') THEN
ce3a0fd2a0 Jean*0100         usingGregorianCalendar = .TRUE.
13a16b18e5 Jean*0101 c     ELSE IF ( theCalendar .EQ. 'julian') THEN
                0102 c       usingJulianCalendar = .TRUE.
                0103 c       STOP ' stopped in cal_Set (Julian Calendar).'
                0104       ELSE IF ( theCalendar .EQ. 'noLeapYear') THEN
                0105         usingNoLeapYearCal = .TRUE.
                0106       ELSE IF ( theCalendar .EQ. 'model') THEN
                0107         usingModelCalendar = .TRUE.
                0108 c     ELSE IF ( theCalendar .EQ. 'none') THEN
                0109 c       usingNoCalendar = .TRUE.
                0110 c       STOP ' stopped in cal_Set (No Calendar).'
                0111       ELSE
                0112         ierr = 101
                0113         CALL cal_PrintError( ierr, myThid )
                0114         STOP
                0115       ENDIF
                0116
                0117 C-    Set calendar parameters according to the calendar type:
                0118
                0119       IF ( usingGregorianCalendar .OR. usingNoLeapYearCal ) THEN
3cb4ec9f6f Jean*0120 C       The reference date for the Gregorian Calendar.
                0121 C       and its format: ( yymmdd , hhmmss , leap year, weekday )
                0122 C                                             (1/2)    (1 - 7)
                0123 C       The Gregorian calendar starts on Friday, 15 Oct. 1582.
82e480d1a1 Jean*0124         refDate(1) = 15821015
                0125         refDate(2) = 0
                0126         refDate(3) = 1
                0127         refDate(4) = 1
a63ed37559 Patr*0128
3cb4ec9f6f Jean*0129 C       Number of months per year and other useful numbers.
82e480d1a1 Jean*0130         nDaysNoLeap      = 365
                0131         nDaysLeap        = 366
                0132         nMaxDayMonth     = 31
a63ed37559 Patr*0133
3cb4ec9f6f Jean*0134 C       Number of days per month.
                0135 C       The "magic" number 2773 derives from the sequence: 101010110101
                0136 C         read in reverse and interpreted as a dual number. An
                0137 C         alternative would be to take 2741 with the loop being
                0138 C         executed in reverse order. Accidentially, the latter
                0139 C         is a prime number.
a63ed37559 Patr*0140         k=2773
13a16b18e5 Jean*0141         DO i=1,nMonthYear
                0142           j = MOD(k,2)
a63ed37559 Patr*0143           k = (k-j)/2
82e480d1a1 Jean*0144           nDayMonth(i,1) = 30+j
                0145           nDayMonth(i,2) = 30+j
13a16b18e5 Jean*0146         ENDDO
82e480d1a1 Jean*0147         nDayMonth(2,1) = 28
                0148         nDayMonth(2,2) = 29
a63ed37559 Patr*0149
3cb4ec9f6f Jean*0150 C       Week days.
82e480d1a1 Jean*0151         dayOfWeek(1) = 'FRI'
                0152         dayOfWeek(2) = 'SAT'
                0153         dayOfWeek(3) = 'SUN'
                0154         dayOfWeek(4) = 'MON'
                0155         dayOfWeek(5) = 'TUE'
                0156         dayOfWeek(6) = 'WED'
                0157         dayOfWeek(7) = 'THU'
13a16b18e5 Jean*0158       ENDIF
a63ed37559 Patr*0159
13a16b18e5 Jean*0160       IF ( usingModelCalendar ) THEN
3cb4ec9f6f Jean*0161 C       Assume a model calendar having 12 months with thirty days each.
ce3a0fd2a0 Jean*0162 C       Reference date is the first day of year 0 at 0am, and model day 1.
82e480d1a1 Jean*0163         refDate(1) = 00000101
                0164         refDate(2) = 0
                0165         refDate(3) = 1
                0166         refDate(4) = 1
a63ed37559 Patr*0167
3cb4ec9f6f Jean*0168 C       Some useful numbers.
82e480d1a1 Jean*0169         nDaysNoLeap      = 360
                0170         nDaysLeap        = 360
                0171         nMaxDayMonth     = 30
13a16b18e5 Jean*0172         DO i=1,nMonthYear
82e480d1a1 Jean*0173           nDayMonth(i,1) = 30
                0174           nDayMonth(i,2) = 30
13a16b18e5 Jean*0175         ENDDO
a63ed37559 Patr*0176
3cb4ec9f6f Jean*0177 C       Week days (Model Day 1 - 7).
82e480d1a1 Jean*0178         dayOfWeek(1) = 'MD1'
                0179         dayOfWeek(2) = 'MD2'
                0180         dayOfWeek(3) = 'MD3'
                0181         dayOfWeek(4) = 'MD4'
                0182         dayOfWeek(5) = 'MD5'
                0183         dayOfWeek(6) = 'MD6'
                0184         dayOfWeek(7) = 'MD7'
a63ed37559 Patr*0185
13a16b18e5 Jean*0186       ENDIF
a63ed37559 Patr*0187
ce3a0fd2a0 Jean*0188 C-    Record completion of calendar settings: stage 1 = calendar is defined
                0189       cal_setStatus = 1
                0190
                0191 C     Map the numerical model parameters. --> common blocks in CALENDAR.h
82e480d1a1 Jean*0192       modelStart       = modstart
                0193       modelEnd         = modend
                0194       modelStep        = modstep
                0195       modelIter0       = moditerini
                0196       modelIterEnd     = moditerend
                0197       modelIntSteps    = modintsteps
ce3a0fd2a0 Jean*0198
                0199 C     Do first consistency checks
                0200 C     o Time step.
13a16b18e5 Jean*0201       IF ( modelStep .LE. 0. ) THEN
ce3a0fd2a0 Jean*0202         ierr = 102
13a16b18e5 Jean*0203         CALL cal_PrintError( ierr, myThid )
                0204         STOP ' stopped in cal_Set.'
                0205       ENDIF
                0206       IF ( modelStep .LT. 1. ) THEN
ce3a0fd2a0 Jean*0207         ierr = 103
13a16b18e5 Jean*0208         CALL cal_PrintError( ierr, myThid )
                0209         STOP ' stopped in cal_Set.'
                0210       ENDIF
                0211       IF ( ABS(modelStep - NINT(modelStep)) .GT. 0.000001 ) THEN
ce3a0fd2a0 Jean*0212         ierr = 104
13a16b18e5 Jean*0213         CALL cal_PrintError( ierr, myThid )
                0214         STOP ' stopped in cal_Set.'
                0215       ELSE
                0216         modelStep = FLOAT(NINT(modelStep))
                0217       ENDIF
ce3a0fd2a0 Jean*0218
                0219 C-    Record completion of calendar settings: stage 2 = numerical model parms
                0220       cal_setStatus = 2
a63ed37559 Patr*0221
3cb4ec9f6f Jean*0222 C     Complete the start date specification to get a full date array.
13a16b18e5 Jean*0223       CALL cal_FullDate( startdate_1, startdate_2,
ce3a0fd2a0 Jean*0224      &                   modelBaseDate, myThid )
3cb4ec9f6f Jean*0225
                0226 C     From here on, the final calendar settings are determined by the
                0227 C     following variables:
82e480d1a1 Jean*0228 C               modelStart, modelStep*modelIntSteps & modelBaseDate
3cb4ec9f6f Jean*0229
82e480d1a1 Jean*0230       runtimesecs = modelIntSteps*modelStep
3cb4ec9f6f Jean*0231
                0232 C     Determine the startdate of the integration.
82e480d1a1 Jean*0233 c     iterinisecs = float(modelIter0)*modelStep
3cb4ec9f6f Jean*0234 C-jmc: above does not work if baseTime <> 0 ; fix it below:
82e480d1a1 Jean*0235       iterinisecs = modelStart
13a16b18e5 Jean*0236       CALL cal_TimeInterval( iterinisecs, 'secs', iterinitime, myThid )
                0237       CALL cal_AddTime( modelBaseDate, iterinitime, modelStartDate,
3cb4ec9f6f Jean*0238      &                  myThid )
a63ed37559 Patr*0239
13a16b18e5 Jean*0240       CALL cal_TimeInterval( runtimesecs, 'secs', timediff, myThid )
                0241       CALL cal_AddTime( modelStartDate, timediff, modelEndDate,
3cb4ec9f6f Jean*0242      &                  myThid )
                0243
ce3a0fd2a0 Jean*0244 C-    Record completion of calendar settings: stage 3 = fully set-up.
                0245       cal_setStatus = 3
                0246
                0247       _END_MASTER(myThid)
                0248
                0249 C     Everyone else must wait for the parameters to be set
                0250       _BARRIER
3cb4ec9f6f Jean*0251
                0252       RETURN
                0253       END