MINICERN/packlib/zebra/rz/rzdate.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.3  1997/08/22 08:40:50  jamie
   6 * fix rzdate for 2000-2016. Will FAIL in 2017
   7 *
   8 * Revision 1.2  1996/04/24 17:26:44  mclareni
   9 * Extend the include file cleanup to dzebra, rz and tq, and also add
  10 * dependencies in some cases.
  11 *
  12 * Revision 1.1.1.1  1996/03/06 10:47:23  mclareni
  13 * Zebra
  14 *
  15 *
  16 #include "zebra/pilot.h"
  17       SUBROUTINE RZDATE(IWORD,IDATE,ITIME,ICASE)
  18 *
  19 ***********************************************************************
  20 *
  21 *       If ICASE=1 returns IDATE and ITIME as stored in IWORD
  22 *       If ICASE=2 pack current time and date into IWORD
  23 *       If ICASE=3 same as ICASE=2 but take IDATE,ITIME from
  24 *                  input parameters instead of calling DATIME
  25 *
  26 * Called by RZCOP1,RZLDIR,RZLLOK,RZLOCK,RZMAKE,RZMDIR,RZOUT,
  27 *           RZSAVE,RZVOUT
  28 *
  29 *  Author  : R.Brun DD/US/PD
  30 *  Written : 01.04.86
  31 *  Last mod: 01.12.86
  32 *            22.08.97 JDS - fix for 2000-2016. RZDATE will FAIL in 2017
  33 *
  34 *
  35 ***********************************************************************
  36 #include "zebra/q_jbyt.inc"
  37 *
  38       IF(ICASE.EQ.1)THEN
  39          ICONT = JBYT(IWORD,9,24)
  40          IMINUT= MOD(ICONT,60)
  41          IM1   = ICONT-IMINUT
  42          IHOUR = MOD(IM1/60,24)
  43          ITIME = 100*IHOUR+IMINUT
  44          IM2   = IM1-60*IHOUR
  45          IDAY  = MOD(IM2/1440,31)
  46          IF(IDAY.EQ.0)IDAY=31
  47          IM3   = IM2-1440*IDAY
  48          IMONTH= MOD(IM3/44640,12)
  49          IF(IMONTH.EQ.0)IMONTH=12
  50          IYEAR = (IM3-44640*IMONTH)/535680
  51 *
  52 *        IYEAR = 14 is the year 2000
  53 *
  54          IF(IYEAR.GE.14) THEN
  55             IDATE = 10000*(IYEAR-14)+100*IMONTH+IDAY
  56          ELSE
  57             IDATE = 860000+10000*IYEAR+100*IMONTH+IDAY
  58          ENDIF
  59 *
  60       ELSE
  61          IF(ICASE.NE.3)CALL DATIME(IDATE,ITIME)
  62 *
  63 *     Handle dates > 2000 (IDATE=00MMDD)
  64 *     Note: /SLATE/ is ignored. 000101 is assumed to be 1st January 2000
  65 *
  66          IF(IDATE.GE.860000) THEN
  67             IDAT2 = IDATE - 860000
  68          ELSE
  69             IDAT2 = IDATE + 140000
  70          ENDIF
  71
  72          IYEAR = IDAT2/10000
  73          IMONTH= (IDAT2-10000*IYEAR)/100
  74          IDAY  = MOD(IDAT2,100)
  75          IHOUR = ITIME/100
  76          IMINUT= MOD(ITIME,100)
  77          ICONT2= IDAY+31*(IMONTH+12*IYEAR)
  78          ICONT = IMINUT+60*(IHOUR+24*ICONT2)
  79          CALL SBYT(ICONT,IWORD,9,24)
  80       ENDIF
  81 *
  82       END