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 / dany.for < prev    next >
Text File  |  1995-05-19  |  2KB  |  105 lines
  1. $STORAGE: 2
  2. $NOFLOATCALLS
  3. c-----------------------------------------------------------------------
  4. c
  5. c    Dany subroutine
  6. c
  7. c    part of Mitch Wyle's DTC program
  8. c
  9. c    Inputs: 
  10. c        im    -    month (number 1-12)
  11. c        iy    -    year  (either 1983 or 83)
  12. c
  13. c    Outputs:
  14. c        ib    -    integer corresponding to day of week
  15. c                on which the month begins (1-7)
  16. c        il    -    length of the month in days
  17. c
  18. c-----------------------------------------------------------------------
  19. c
  20.  
  21.     SUBROUTINE dany(ib,il,im,iy)
  22.  
  23. c
  24. c    Declarations:
  25. c
  26.  
  27.     integer im        
  28. c     Julian Month
  29.     integer iy        
  30. c     Julian Year
  31.  
  32.     integer months(12)    
  33. c     array of months and the number 
  34.                 
  35. c     of days in each one
  36. c
  37. c    Initialize:
  38. c
  39.  
  40.     data months/31,28,31,30,31,30,31,31,30,31,30,31/
  41.  
  42.     If ( iy .gt. 1900 ) iy = iy - 1900
  43.     If ( ( iy .eq. 82 ) .and. ( im .eq. 1 ) ) then
  44.         ib = 6
  45.         il = 31
  46.         return
  47.     End If
  48.  
  49. c
  50. c    Now add up all of the days since January first nineteen hundred
  51. c    eighty-two (which was a Friday)        So:
  52. c
  53.  
  54.     idays = 1        
  55. c     Total Number of days since 1/1/82
  56.                 
  57. c     Starts at 1 because first day of month
  58.  
  59.     Do 1 i=1,(im-1)        
  60. c     Add all previous months' days to sum
  61.         idays = idays + months(i)
  62. 1    Continue
  63.  
  64.     ilp=(iy-81)/4
  65.     if(ilp.lt.0)ilp=0
  66.     itemp = iy - 82
  67.     If ( itemp .gt. 0 ) then
  68.         Do 2 i=1,itemp
  69.         idays = idays + 365
  70. 2        Continue
  71.     idays=idays+ilp
  72. c leap years have 366 days
  73.     End If
  74.  
  75.     itemp = itemp + 2
  76.  
  77. c
  78. c        Leap year consideration:
  79. c
  80.  
  81. 3    continue
  82.     If ( ( mod ( itemp , 4 )  .eq. 0 ) .and. (itemp .ne. 0 ) .and.
  83.      1       ( im .gt. 2 ) ) then
  84.         idays = idays + 1
  85.         itemp = itemp - 4
  86. C        goto 3
  87.     End If
  88.  
  89. c
  90. c        Now add five because 1/1/82 was a friday.
  91. c
  92.  
  93.     idays = idays + 5
  94.     ib = mod ( idays , 7 )
  95.     If ( ib .eq. 0 ) ib = 7
  96.     il = months(im)
  97.  
  98.     If ( ( im .eq. 2 ) .and. ( mod(iy,4) .eq. 0 ) ) il = il + 1
  99.  
  100.     return
  101.     end
  102.  
  103.  
  104. 
  105.