ungrib/src/ngl/w3/w3fs26.f

   1        SUBROUTINE W3FS26(JLDAYN,IYEAR,MONTH,IDAY,IDAYWK,IDAYYR)
   2 C$$$   SUBPROGRAM  DOCUMENTATION  BLOCK
   3 C
   4 C SUBPROGRAM: W3FS26         YEAR, MONTH, DAY FROM JULIAN DAY NUMBER
   5 C   AUTHOR: JONES,R.E.       ORG: W342       DATE: 87-03-29
   6 C
   7 C ABSTRACT: COMPUTES YEAR (4 DIGITS), MONTH, DAY, DAY OF WEEK, DAY
   8 C   OF YEAR FROM JULIAN DAY NUMBER. THIS SUBROUTINE WILL WORK
   9 C   FROM 1583 A.D. TO 3300 A.D.
  10 C
  11 C PROGRAM HISTORY LOG:
  12 C   87-03-29  R.E.JONES
  13 C   89-10-25  R.E.JONES   CONVERT TO CRAY CFT77 FORTRAN
  14 C
  15 C USAGE:  CALL W3FS26(JLDAYN,IYEAR,MONTH,IDAY,IDAYWK,IDAYYR)
  16 C
  17 C   INPUT VARIABLES:
  18 C     NAMES  INTERFACE DESCRIPTION OF VARIABLES AND TYPES
  19 C     ------ --------- -----------------------------------------------
  20 C     JLDAYN ARG LIST  INTEGER   JULIAN DAY NUMBER
  21 C
  22 C   OUTPUT VARIABLES:
  23 C     NAMES  INTERFACE DESCRIPTION OF VARIABLES AND TYPES
  24 C     ------ --------- -----------------------------------------------
  25 C     IYEAR  ARG LIST  INTEGER   YEAR  (4 DIGITS)
  26 C     MONTH  ARG LIST  INTEGER   MONTH
  27 C     IDAY   ARG LIST  INTEGER   DAY
  28 C     IDAYWK ARG LIST  INTEGER   DAY OF WEEK (1 IS SUNDAY, 7 IS SAT)
  29 C     IDAYYR ARG LIST  INTEGER   DAY OF YEAR (1 TO 366)
  30 C
  31 C   REMARKS: A JULIAN DAY NUMBER CAN BE COMPUTED BY USING ONE OF THE
  32 C     FOLLOWING STATEMENT FUNCTIONS. A DAY OF WEEK CAN BE COMPUTED
  33 C     FROM THE JULIAN DAY NUMBER. A DAY OF YEAR CAN BE COMPUTED FROM
  34 C     A JULIAN DAY NUMBER AND YEAR.
  35 C
  36 C      IYEAR (4 DIGITS)
  37 C
  38 C      JDN(IYEAR,MONTH,IDAY) = IDAY - 32075
  39 C    &            + 1461 * (IYEAR + 4800 + (MONTH - 14) / 12) / 4
  40 C    &            + 367 * (MONTH - 2 - (MONTH -14) / 12 * 12) / 12
  41 C    &            - 3 * ((IYEAR + 4900 + (MONTH - 14) / 12) / 100) / 4
  42 C
  43 C      IYR (4 DIGITS) , IDYR(1-366) DAY OF YEAR
  44 C
  45 C      JULIAN(IYR,IDYR) = -31739 + 1461 * (IYR + 4799) / 4
  46 C    &                    -3 * ((IYR + 4899) / 100) / 4 + IDYR
  47 C
  48 C      DAY OF WEEK FROM JULIAN DAY NUMBER, 1 IS SUNDAY, 7 IS SATURDAY.
  49 C
  50 C      JDAYWK(JLDAYN) = MOD((JLDAYN + 1),7) + 1
  51 C
  52 C      DAY OF YEAR FROM JULIAN DAY NUMBER AND 4 DIGIT YEAR.
  53 C
  54 C      JDAYYR(JLDAYN,IYEAR) = JLDAYN -
  55 C     &  (-31739+1461*(IYEAR+4799)/4-3*((IYEAR+4899)/100)/4)
  56 C
  57 C      THE FIRST FUNCTION WAS IN A LETTER TO THE EDITOR COMMUNICATIONS
  58 C      OF THE ACM  VOLUME 11 / NUMBER 10 / OCTOBER, 1968. THE 2ND
  59 C      FUNCTION WAS DERIVED FROM THE FIRST. THIS SUBROUTINE WAS ALSO
  60 C      INCLUDED IN THE SAME LETTER. JULIAN DAY NUMBER 1 IS
  61 C      JAN 1,4713 B.C. A JULIAN DAY NUMBER CAN BE USED TO REPLACE A
  62 C      DAY OF CENTURY, THIS WILL TAKE CARE OF THE DATE PROBLEM IN
  63 C      THE YEAR 2000, OR REDUCE PROGRAM CHANGES TO ONE LINE CHANGE
  64 C      OF 1900 TO 2000. JULIAN DAY NUMBERS CAN BE USED FOR FINDING
  65 C      RECORD NUMBERS IN AN ARCHIVE OR DAY OF WEEK, OR DAY OF YEAR.
  66 C
  67 C ATTRIBUTES:
  68 C   LANGUAGE: CRAY CFT77 FORTRAN
  69 C   MACHINE:  CRAY Y-MP8/864
  70 C
  71 C$$$
  72 C
  73        L      = JLDAYN + 68569
  74        N      = 4 * L / 146097
  75        L      = L - (146097 * N + 3) / 4
  76        I      = 4000 * (L + 1) / 1461001
  77        L      = L - 1461 * I / 4 + 31
  78        J      = 80 * L / 2447
  79        IDAY   = L - 2447 * J / 80
  80        L      = J / 11
  81        MONTH  = J + 2 - 12 * L
  82        IYEAR  = 100 * (N - 49) + I + L
  83        IDAYWK = MOD((JLDAYN + 1),7) + 1
  84        IDAYYR = JLDAYN -
  85      &  (-31739 +1461 * (IYEAR+4799) / 4 - 3 * ((IYEAR+4899)/100)/4)
  86        RETURN
  87        END