sw/rescue/lab8e_goettingen/disk2_11/rka/paroff/work.ft

   1         EXTERNAL TIME
   2         INTEGER S1,IXTA,TIME
   3         EXTERNAL S1,IXTA
   4         INTEGER M,D,Y
   5         INTEGER REC9,LSTDAY,
   6      *  RECORD(14,6),FRSTRE(14,6),
   7      *  RECPOS,I,LSTACT
   8 C       STATEMENT FUNCTIONS ARE:
   9         INTEGER POS
  10         POS(I1)=MOD(I1,6)+1
  11 C
  12 C
  13         DEFINE FILE 9 (400,85,U,REC9)
  14 C
  15 50      CONTINUE
  16         REC9=1
  17         READ (9'REC9) RECPOS,FRSTRE
  18         REC9=RECPOS/6+1
  19         READ (9'REC9) RECPOS,RECORD
  20         LSTDAY=RECORD(2,POS(RECPOS))
  21         WRITE (4,1) (RECORD(I,POS(RECPOS)),I=1,14)
  22         LSTACT=IXTA(S1(RECORD(4,POS(RECPOS))))
  23 C       READ THE NEXT ENTRY
  24         RECPOS=RECPOS+1
  25         CALL DATE (M,D,Y)               @ GET TODAYS DATE IN INTEGERS
  26         IF (M.GE.1.AND.M.LE.12) GOTO 10 @ TEST FOR AN VALID DATE WORD
  27         WRITE (4,4)                     @ NO VALID DATE, SO WE TAKE NO ACTION
  28         STOP
  29 20      CONTINUE
  30         WRITE (4,5)
  31         GOTO 50
  32 30      CONTINUE
  33         WRITE (4,6)
  34         STOP
  35 10      CONTINUE
  36         CALL ADATE (RECORD(1,POS(RECPOS)))
  37         WRITE (4,2) (RECORD(I,POS(RECPOS)),I=1,3)
  38         READ (4,3) (RECORD(I,POS(RECPOS)),I=4,14)
  39         NXTACT=IXTA(S1(RECORD(4,POS(RECPOS))))
  40         IF (LSTACT.EQ.NXTACT) GOTO 20
  41         IF (NXTACT.NE.IXTA(S1(1HA)).AND.
  42      *      NXTACT.NE.IXTA(S1(1HE))) GOTO 20
  43         IF (NXTACT.EQ.IXTA(S1(1HE)).AND.LSTDAY.NE.RECORD(2,POS(RECPOS)))
  44      *   GOTO 30
  45         REC9=RECPOS/6+1
  46         WRITE (9'REC9) RECPOS,RECORD
  47         IF (REC9.EQ.2) STOP
  48         REC9=1
  49         WRITE (9'REC9) RECPOS,FRSTRE
  50         STOP
  51 1       FORMAT (/,1X,A2,1H/,A2,3H/19,A2,1X,10A6,A4)
  52 2       FORMAT (1X,A2,1H/,A2,3H/19,A2,1H:,$)
  53 3       FORMAT (11A6)
  54 4       FORMAT (' BAD DATE TODAY - NO ENTRY DONE')
  55 5       FORMAT (' BAD ACTION - REPEAT')
  56 6       FORMAT (' BAD DATE FOR ',3H'E',' ACTION - NO ENTRY DONE')
  57         END
  58 \1a