Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
SUBROUTINE EXT(IEXT)
DIMENSION IDATE(2),MONTH(13),NUMBER(13)
DATA MONTH/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG',
1'SEP','OCT','NOV','DEC',0/
DATA NUMBER/'.01','.02','.03','.04','.05','.06','.07','.08'
1 ,'.09','.10','.11','.12',0/
C MAKE A THREE LETTER ALPHA EXTENSION
C OUT OF THE DATE (2-DEC-70 GOES TO .121)
CALL DATE(IDATE)
C WATCH OUT FOR ONE DIGIT DAY OF MONTH
IF((IDATE(1).AND."774000 000000).EQ."200000 000000)
1 IDATE(1) = IDATE(1).AND."3777 777777.OR."300000 000000
C CONVERT THE DAY TO INTEGER
IDAY = ISHIFT(IDATE(1),-21)
IDAY = (IDAY-ISHIFT(ISHIFT(IDAY,-7),7))/2-"60
1 + (ISHIFT(IDAY,-8)-"60)*10
C CONVERT THE DAY TO WEEK
IDAY = IDAY/7 + 1
C LEFT ADJUST-BLANK FILL THE MONTH
NONTH = ISHIFT(IDATE(1),21).OR.ISHIFT(ISHIFT(IDATE(2),-28),14)
1 .OR. "20100
C FIND THE MONTH NUMBER
DO 10 I=1,13
IF(NONTH.EQ.MONTH(I)) GO TO 15
10 CONTINUE
STOP
C SET EXT TO THE CORRESPONDING MNEMONIC
C AND OR IN THE WEEK NUMBER
15 CONTINUE
IEXT = NUMBER(I) + ISHIFT(IDAY+"20,8)
R E T U R N
E N D