home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB101 / idate.for < prev    next >
Text File  |  1995-05-19  |  373b  |  24 lines
  1. $STORAGE: 2
  2. $NOFLOATCALLS
  3.     SUBROUTINE IDATE(IMON,IDAY,IYEA)
  4. C FILL IN INITIAL DEFAULT DATE
  5. C DUMMY AT FIRST TO 4/1/84
  6.     INTEGER*2 IDYR,IDMO,IDDY,IYEA,IMON,IDAY
  7.     COMMON/DEFDAT/IDYR,IDMO,IDDY
  8.     IF(IDYR.LE.0)GOTO 10
  9.     IMON=IDMO
  10.     IDAY=IDDY
  11.     IYEA=IDYR
  12.     RETURN
  13. 10    CONTINUE
  14.     IYEA=84
  15.     IMON=1
  16.     IDAY=1
  17.     CALL SDATE(IYEA,IMON,IDAY)
  18.     IYEA=IYEA-1900
  19.     RETURN
  20.     END
  21.  
  22.  
  23.  
  24.