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 / gaby.for < prev    next >
Text File  |  1995-05-19  |  2KB  |  60 lines
  1. $STORAGE: 2
  2. $NOFLOATCALLS
  3. c-----------------------------------------------------------------------
  4. c
  5. c    Subroutine Gaby
  6. c
  7. c    Part of Mitch Wyle's DTC program
  8. c
  9. c    return a string corresponding to the month number
  10. c    Month number contained in im.  Send back string in monthn.
  11. c    (JANUARY for 1, etc.)
  12. c
  13. c-----------------------------------------------------------------------
  14. c
  15.  
  16.     SUBROUTINE gaby(im,monthn)
  17.  
  18. c
  19. c    Declarations:
  20. c
  21.     character months(9,14)
  22.     character monthn(9)
  23.  
  24. c
  25. c    Table of month names and numbers:
  26. c
  27.  
  28.     data months/
  29.      *              'D','E','C','E','M','B','E','R',' ',
  30.      *              'J','A','N','U','A','R','Y',' ',' ',
  31.      *              'F','E','B','R','U','A','R','Y',' ',
  32.      *              'M','A','R','C','H',' ',' ',' ',' ',
  33.      *              'A','P','R','I','L',' ',' ',' ',' ',
  34.      *              'M','A','Y',' ',' ',' ',' ',' ',' ',
  35.      *              'J','U','N','E',' ',' ',' ',' ',' ',
  36.      *              'J','U','L','Y',' ',' ',' ',' ',' ',
  37.      *              'A','U','G','U','S','T',' ',' ',' ',
  38.      *              'S','E','P','T','E','M','B','E','R',
  39.      *              'O','C','T','O','B','E','R',' ',' ',
  40.      *              'N','O','V','E','M','B','E','R',' ',
  41.      *              'D','E','C','E','M','B','E','R',' ',
  42.      *              'J','A','N','U','A','R','Y',' ',' '/
  43.  
  44. c
  45. c    Select the right month and fill monthn with it:
  46. c
  47.  
  48. C ALLOW FOR OVERFLOWS...
  49.     IMM=IM+1
  50.     Do 1 i=1,9
  51.         Monthn(i) = months(i,imm)
  52. 1    Continue
  53.  
  54. c    All done.
  55.  
  56.     return
  57.     end
  58.  
  59.  
  60.