doc-doxygen/html/calend_8f_source.html

00001       SUBROUTINE calend (kdini, kmini, kyini, kinc, kcal,
00002      $                   kdfin, kmfin, kyfin, klmo)
00003 C****
00004 C               *****************************
00005 C               * OASIS ROUTINE  -  LEVEL 1 *
00006 C               * -------------     ------- *
00007 C               *****************************
00008 C
00009 C**** *calend*  - Calendar routine
00010 C
00011 C     Purpose:
00012 C     -------
00013 C     Updates the calendar values. Date is of the form YYYYMMDD.
00014 C     Increases day by day the date, updates if necessary the month
00015 C     and the year.
00016 C
00017 C**   Interface:
00018 C     ---------
00019 C       *CALL*  *calend (kdini, kmini, kyini, kinc, kcal
00020 C                        kdfin, kmfin, kyfin, klmo)*
00021 C
00022 C     Input:
00023 C     -----
00024 C                kdini,kmini,kyini : initial date (day,month,year)
00025 C                kinc              : number of days to increment
00026 C                kcal              : calendar type
00027 C
00028 C     Output:
00029 C     ------
00030 C                kdfin,kmfin,kyfin : final date
00031 C                klmo(12)          : length of the 12 months
00032 C
00033 C     Workspace:
00034 C     ---------
00035 C     None
00036 C
00037 C     Externals:
00038 C     ---------
00039 C     None
00040 C
00041 C     History:
00042 C     -------
00043 C       Version   Programmer     Date      Description
00044 C       -------   ----------     ----      -----------
00045 C       2.0       L. Terray      95/10/01  created
00046 C       2.3       S. Valcke      99/03/15  year is leap if divible by 4 but
00047 C                                          not by 100, leap if div. by 400
00048 C       2.3       S. Valcke      99/04/30  added: printing levels
00049 C
00050 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00051 C
00052 C* ---------------------------- Include files ---------------------------
00053 C
00054       USE mod_unit
00055       USE mod_printing
00056 C
00057 C* ---------------------------- Argument declarations -------------------
00058 C
00059       INTEGER (kind=ip_intwp_p) klmo(12)
00060 C
00061 C* ---------------------------- Local declarations -------------------
00062 C
00063       LOGICAL lleap
00064 C* ---------------------------- Poema verses ----------------------------
00065 C
00066 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00067 C
00068 C*    1. Length of the months
00069 C        --------------------
00070 C
00071       IF (nlogprt .GE. 2) THEN
00072           WRITE (UNIT = nulou,FMT = *) ' '
00073           WRITE (UNIT = nulou,FMT = *) ' '
00074           WRITE (UNIT = nulou,FMT = *)
00075      $    '           ROUTINE calend  -  Level 1'
00076           WRITE (UNIT = nulou,FMT = *)
00077      $    '           **************     *******'
00078           WRITE (UNIT = nulou,FMT = *) ' '
00079           WRITE (UNIT = nulou,FMT = *) ' Updates calendar values'
00080           WRITE (UNIT = nulou,FMT = *) ' '
00081           WRITE (UNIT = nulou,FMT = *) ' '
00082           CALL FLUSH(nulou)
00083       ENDIF
00084 C
00085 C* Calculate month lengths for current year
00086 C
00087       IF (kcal .eq. 0 .or. kcal .eq. 1) THEN
00088
00089         DO 110 jm = 1, 12
00090           klmo(jm) = 31
00091           IF (jm .eq. 4 .or. jm .eq. 6 .or.
00092      $        jm .eq. 9 .or. jm .eq. 11) THEN
00093               klmo(jm) = 30
00094           ENDIF
00095           IF (jm .eq. 2) THEN
00096 C
00097 C* Leap years
00098 C
00099             lleap = .FALSE.
00100             IF (kcal .eq. 1) THEN
00101               IF (MOD(kyini,4) .eq. 0) lleap = .TRUE.
00102               IF (MOD(kyini,100) .eq. 0) lleap = .FALSE.
00103               IF (MOD(kyini,400) .eq. 0) lleap = .TRUE.
00104             ENDIF
00105             IF (lleap) THEN
00106                 klmo(jm) = 29
00107               ELSE
00108                 klmo(jm) = 28
00109             ENDIF
00110           ENDIF
00111  110    CONTINUE
00112         kdfin = kdini
00113         kmfin = kmini
00114         kyfin = kyini
00115 C
00116 C
00117 C*    2. Loop on the days
00118 C        ----------------
00119 C
00120         DO 210 jd = 1, kinc
00121           kdfin = kdfin + 1
00122           IF (kdfin .le. klmo(kmfin)) GOTO 210
00123           kdfin = 1
00124           kmfin = kmfin + 1
00125           IF (kmfin .le. 12) GOTO 210
00126           kmfin = 1
00127           kyfin = kyfin + 1
00128 C
00129 C* Leap years
00130 C
00131           lleap = .FALSE.
00132           IF (kcal .eq. 1) THEN
00133             IF (MOD(kyfin,4) .eq. 0) lleap = .TRUE.
00134             IF (MOD(kyfin,100) .eq. 0) lleap = .FALSE.
00135             IF (MOD(kyfin,400) .eq. 0) lleap = .TRUE.
00136           ENDIF
00137           IF (lleap) THEN
00138               klmo(2) = 29
00139             ELSE
00140               klmo(2) = 28
00141           ENDIF
00142  210    CONTINUE
00143       ELSE
00144 C
00145 C* Calculate month lengths for current year
00146 C
00147         DO 310 jm = 1, 12
00148           klmo(jm) = kcal
00149  310    CONTINUE
00150         kdfin = kdini
00151         kmfin = kmini
00152         kyfin = kyini
00153 C
00154 C*    2. Loop on the days
00155 C        ----------------
00156         DO 410 jd = 1, kinc
00157           kdfin = kdfin + 1
00158           IF (kdfin .le. klmo(kmfin)) GOTO 410
00159           kdfin = 1
00160           kmfin = kmfin + 1
00161           IF (kmfin .le. 12) GOTO 410
00162           kmfin = 1
00163           kyfin = kyfin + 1
00164  410    CONTINUE
00165       ENDIF
00166 C
00167 C
00168 C*    3. End of routine
00169 C        --------------
00170 C
00171       IF (nlogprt .GE. 2) THEN
00172           WRITE (UNIT = nulou,FMT = *) ' '
00173           WRITE (UNIT = nulou,FMT = *)
00174      $    '          --------- End of ROUTINE calend ---------'
00175           CALL FLUSH (nulou)
00176       ENDIF
00177       RETURN
00178       END