1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-01 09:21:15 +00:00
Files
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

108 lines
2.5 KiB
Fortran

COMMON CHKING,SAVING,LOAN,BALNC(9),OVERDU(9),PAYMNT(9),
1 ITEM(9),MONTH,CAR(3),INSUR(3),MIWORK(2),TOTMI(3),HOUSE(2),
2 NOMNTH(3)
C
INTEGER STUNUM,FOLIO,CHKING,SAVING,LOAN,BALNC,OVERDU,
1 PAYMNT,MONTH,CAR,HOUSE
C
REAL INSUR,MIWORK
C
DOUBLE PRECISION ITEM
C
DIMENSION ANSWER(5),TEMP(110,4),LIST(100)
C
C READ CROSS.REF
10 FORMAT (4A5,I3)
15 OPEN (UNIT=4,DEVICE='DSK',ACCESS='SEQIN',FILE='CROSS.REF'
1 ,DIRECTORY='1700,170700')
DO 20 I=1,50
READ (4,10) (TEMP(I,J),J=1,4),LIST(I)
20 CONTINUE
CLOSE (UNIT=4)
C
C ASSIGN A NUMBER TO THE STUDENT
DO 30 I=1,50
IF (LIST(I).EQ.0) GOTO 40
30 CONTINUE
TYPE 35
35 FORMAT (' THE FILE IS FULL AND NEEDS TO BE ENLARGE')
GOTO 9999
40 STUNUM=I
TYPE 45
45 FORMAT (' TYPE THE STUDENTS NAME: ',$)
ACCEPT 47,(TEMP(I,J),J=1,4)
47 FORMAT (4A5)
TYPE 48,(TEMP(I,J),J=1,4),STUNUM
48 FORMAT (1X,4A5,' HAS BEEN ASSIGNED # ',I3)
C
C ZERO ALL THE NUMBERS
FOLIO=1;MONTH=1;CHKING=0;SAVING=20000;LOAN=0
DO 50 J=1,9
ITEM(J)='NOTHING'
PAYMNT(J)=0
BALNC(J)=0
50 OVERDU(J)=0
C
DO 55 J=1,3
CAR(J)=0
TOTMI(J)=0.0
INSUR(J)=0.00
55 NOMNTH(J)=12
C
DO 57 J=1,2
MIWORK(J)=0.0
57 HOUSE(J)=0
CAR(1)=3
INSUR(1)=75.00
MIWORK(1)=8.5
HOUSE(1)=1
C
C UPDATE CROSS.REF
LIST(STUNUM)=STUNUM
OPEN (UNIT=4,DEVICE='DSK',ACCESS='SEQOUT',FILE='CROSS.REF'
1 ,DIRECTORY='1700,170700')
DO 60 I=1,50
59 WRITE (4,10) (TEMP(I,J),J=1,4),LIST(I)
60 CONTINUE
CLOSE (UNIT=4)
C
C PRINT STUDENT INTO STUDEN.DAT
CALL PRINT(STUNUM,FOLIO)
C
C CONTINUE?
TYPE 70
70 FORMAT (' ENROLL ANOTHER? ',$)
ACCEPT 75,(ANSWER(J),J=1,5)
75 FORMAT (5A1)
IF (ANSWER(1).EQ.'Y') GOTO 15
9999 END
SUBROUTINE PRINT(STUNUM,FOLIO)
C
COMMON CHKING,SAVING,LOAN,BALNC(9),OVERDU(9),PAYMNT(9),
1 ITEM(9),MONTH,CAR(3),INSUR(3),MIWORK(2),TOTMI(3),HOUSE(2),
2 NOMNTH(3)
C
INTEGER STUNUM,FOLIO,CHKING,SAVING,LOAN,BALNC,OVERDU,
1 PAYMNT,MONTH,CAR,HOUSE
C
REAL INSUR,MIWORK
C
DOUBLE PRECISION ITEM
C
OPEN(UNIT=5,DEVICE='DSK',ACCESS='RANDOM',FILE='STUDEN.DAT',
1 RECORD=310,DIRECTORY='1700,170700')
C
WRITE (5#STUNUM,10) STUNUM,FOLIO,MONTH,CHKING,SAVING,LOAN,
1 (ITEM(J),PAYMNT(J),BALNC(J),OVERDU(J),J=1,9),
2 (CAR(J),TOTMI(J),INSUR(J),NOMNTH(J),J=1,3),
3 (MIWORK(J),J=1,2),(HOUSE(J),J=1,2)
C
10 FORMAT(I3,2I2,3I7,
1 9(A10,I5,I6,I2),
2 3(I2,F7.0,F6.2,I2),
3 2F4.1,2I2)
C
CLOSE(UNIT=5)
RETURN
END