mirror of
https://github.com/PDP-10/stacken.git
synced 2026-03-01 09:21:15 +00:00
266 lines
6.6 KiB
Fortran
266 lines
6.6 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
|
|
DIMENSION ANSWER(5),FSTNAM(9),DESCRP(15,3),
|
|
1 GROUP(5,2),RECORD(15),AVGCST(15),SPREAD(15)
|
|
|
|
C
|
|
DOUBLE PRECISION VEHICL,ITEM
|
|
C
|
|
REAL INSUR,MIWORK,LICENS
|
|
C
|
|
C ***INITIALIZE PROGRAM
|
|
CALL CHECK(STUNUM,FSTNAM)
|
|
CALL READ(STUNUM,FOLIO)
|
|
C
|
|
GOTO 1000
|
|
C
|
|
C ***INSTRUCTIONS
|
|
TYPE 10
|
|
10 FORMAT (/' YOU WILL NOW BE ASKED TO MAKE CHOICES WHICH YOU
|
|
1 WILL HAVE TO LIVE WITH FOR'/' A YEAR. YOU SHOULD HAVE THESE
|
|
2 CHOICES MADE ON THE WORKSHEET THAT'/' ACCOMPANIES THIS
|
|
3 SIMULATION.'//' ARE YOU PREPARED TO MAKE THESE CHOICES? ',$)
|
|
C
|
|
ACCEPT 19,(ANSWER(J),J=1,5)
|
|
19 FORMAT (5A1)
|
|
IF(ANSWER(1).EQ.'Y') GOTO 30
|
|
TYPE 20
|
|
20 FORMAT(/' PLEASE LOG OFF AND COME BACK WHEN YOU ARE READY
|
|
1 WITH THE CHOICES.')
|
|
GOTO 9999
|
|
C
|
|
C ***INPUT CHOICES
|
|
30 TYPE 35,(FSTNAM(J),J=1,9)
|
|
35 FORMAT(/' GOOD! OK ',9A1,' GIVE ME YOUR CHOICES AFTER I
|
|
1 ASK FOR THEM'/)
|
|
C
|
|
C ***PORTFOLIO
|
|
C
|
|
1000 TYPE 37
|
|
37 FORMAT(/' PORTFOLIO NUMBER? ',$)
|
|
ACCEPT *,FOLIO
|
|
C
|
|
C ***VEHICLES
|
|
TYPE 38
|
|
38 FORMAT(/' YOU WILL BE ASKED NOW FOR THE VEHICLE NUMBERS.
|
|
1 WHEN ASKED FOR'/' MILES TO WORK, ENTER "0" IF NOT DRIVEN
|
|
2 TO WORK, OR ENTER THE MILES'/' TO THE NEAREST TENTH OF A MILE
|
|
3 (EXAMPLE "4.5"). REMEMBER THE FIRST'/' VEHICLE IS
|
|
4 ALWAYS DRIVEN TO WORK AND IS USED FOR RECREATION.')
|
|
C
|
|
DO 49 I=1,3
|
|
39 TYPE 40,I
|
|
40 FORMAT(' CHOICE #',I1,': VEHICLE NUMBER? ',$)
|
|
C
|
|
ACCEPT *,CAR(I)
|
|
K=CAR(I)
|
|
CALL AUTO(K,VEHICL,PAY,LICENS,CSTMI,AVGMPG,
|
|
1 WEIGHT,DESCRP,RECORD,AVGCST,SPREAD)
|
|
TYPE 42,VEHICL
|
|
42 FORMAT(' DID YOU WANT A(N) ',A10,'? ',$)
|
|
C
|
|
ACCEPT 19,(ANSWER(J),J=1,5)
|
|
IF(ANSWER(1).EQ.'Y') GOTO 48
|
|
TYPE 47
|
|
47 FORMAT(/' TRY AGAIN'/)
|
|
GOTO 39
|
|
C
|
|
C *INSURANCE COST FOR THIS VEHICLE
|
|
C
|
|
48 TYPE 100,VEHICL
|
|
100 FORMAT(/' INSURANCE COST FOR THE ',A10,'? $ ',$)
|
|
C
|
|
ACCEPT *,INSUR(I)
|
|
C
|
|
C *MILES CAR WILL BE DRIVEN TO WORK
|
|
C
|
|
IF(I.EQ.3) GOTO 600
|
|
C
|
|
TYPE 110,VEHICL
|
|
110 FORMAT(/' NUMBER OF MILES (TO NEAREST TENTH) THE ',A10,' WILL
|
|
1 BE'/' DRIVEN TO WORK? ',$)
|
|
C
|
|
ACCEPT *,MIWORK(I)
|
|
C
|
|
115 TYPE 120
|
|
120 FORMAT(/' DO YOU WANT ANOTHER VEHICLE? ',$)
|
|
C
|
|
ACCEPT 19,(ANSWER(J),J=1,5)
|
|
IF(ANSWER(1).NE.'Y') GOTO 600
|
|
C
|
|
49 CONTINUE
|
|
C
|
|
C ***SHELTER
|
|
C
|
|
600 TYPE 60
|
|
60 FORMAT(' THE NUMBER OF THE MAIN SHELTER YOU WILL LIVE IN? ',$)
|
|
C
|
|
C
|
|
ACCEPT *,HOUSE(1)
|
|
TYPE 45
|
|
45 FORMAT(' DO YOU WANT ANOTHER SHELTER? ',$)
|
|
C
|
|
ACCEPT 19,(ANSWER(J),J=1,5)
|
|
IF(ANSWER(1).NE.'Y') GOTO 70
|
|
TYPE 62
|
|
62 FORMAT (' NUMBER OF THE OTHER SHELTER? ',$)
|
|
ACCEPT *,HOUSE(2)
|
|
C
|
|
C ***SET MONTH COUNTER TO 1 AND ASSIGN SOME SAVINGS
|
|
C
|
|
70 SAVING=20000
|
|
MONTH=1
|
|
C
|
|
C ***CLOSING STATEMENT AND UPDATE STUDEN.DAT
|
|
C
|
|
CALL PRINT(STUNUM,FOLIO)
|
|
C
|
|
TYPE 80,(FSTNAM(J),J=1,9)
|
|
80 FORMAT(/' THANK YOU FOR THIS INFORMATION ',9A1,'.')
|
|
C
|
|
XSAV=SAVING/100
|
|
TYPE 82,XSAV
|
|
82 FORMAT(/' I HAVE GIVEN YOU $'F6.2,' IN YOUR SAVINGS ACCOUNT
|
|
1 TO START YOU OUT'/' THIS YEAR. YOU MAY NOW ASK FOR THE PROGRAM
|
|
2 PLAY.FOR AND BEGIN.')
|
|
C
|
|
TYPE 84,(FSTNAM(J),J=1,9)
|
|
84 FORMAT (/' GOOD LUCK ',9A1,'!!!')
|
|
C
|
|
9999 END
|
|
SUBROUTINE CHECK(STUNUM,FSTNAM)
|
|
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
|
|
DIMENSION ANSWER(5),FSTNAM(9),NAME(20)
|
|
INTEGER STUNUM
|
|
REAL NAME
|
|
C
|
|
7 FORMAT (/, ' ALWAYS HIT THE [RETURN] KEY AFTER TYPING
|
|
1 SOMETHING TO THE COMPUTER!!!',/)
|
|
C
|
|
C ASK THE STUDENT FOR HIS NUMBER
|
|
10 FORMAT (20A1,I3)
|
|
15 OPEN (UNIT=4,DEVICE='DSK',ACCESS='SEQIN',FILE='CROSS.REF')
|
|
TYPE 20
|
|
20 FORMAT (' PLEASE TYPE YOUR NUMBER: ',$)
|
|
ACCEPT *,STUNUM
|
|
C
|
|
C CHECK TO SEE IF # IN CROSS.REF
|
|
DO 30 I=1,50
|
|
READ (4,10) (NAME(J),J=1,20),ISTU
|
|
C IF # IN CROSS.REF - CHECK IF IT CORRESPONDS TO RIGHT STU.
|
|
IF (ISTU.EQ.STUNUM) GOTO 35
|
|
30 CONTINUE
|
|
C IF NOT IN CROSS.REF - TRY AGAIN
|
|
32 TYPE 34
|
|
34 FORMAT (/,' PLEASE TRY AGAIN.',/)
|
|
CLOSE (UNIT=4)
|
|
GOTO 15
|
|
C
|
|
C RIGHT STUDENT NAME?
|
|
35 TYPE 40, (NAME(J),J=1,20)
|
|
40 FORMAT (' ARE YOU ',20A1,'?',$)
|
|
ACCEPT 45,(ANSWER(J),J=1,5)
|
|
45 FORMAT (5A1)
|
|
C IF YES CONTINUE AND GET FSTNAM NAME - IF NO TRY AGAIN
|
|
IF (ANSWER(1).EQ.'Y') GOTO 50
|
|
GOTO 32
|
|
50 DO 60 J=1,9
|
|
IF (NAME(J).EQ.' ') GOTO 70
|
|
FSTNAM(J)=NAME(J)
|
|
60 CONTINUE
|
|
70 CLOSE (UNIT=4)
|
|
RETURN
|
|
END
|
|
SUBROUTINE READ(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)
|
|
C
|
|
READ (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
|
|
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)
|
|
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
|
|
SUBROUTINE AUTO(N,VEHICL,PAY,LICENS,CSTMI,AVGMPG,
|
|
1 WEIGHT,DESCRP,RECORD,AVGCST,SPREAD)
|
|
C
|
|
DIMENSION DESCRP(15,3),RECORD(15),AVGCST(15),
|
|
1 SPREAD(15)
|
|
C
|
|
INTEGER WEIGHT,RECORD
|
|
C
|
|
REAL LICENS
|
|
C
|
|
DOUBLE PRECISION VEHICL,V
|
|
C
|
|
OPEN(UNIT=5,DEVICE='DSK',ACCESS='SEQIN',FILE='VEHICL.FIL')
|
|
C
|
|
DO 100 I=1,N
|
|
READ (5,10) J,VEHICL,V,PAY,V,LICENS,V,CSTMI,V,AVGMPG,V,WEIGHT,
|
|
1(((DESCRP(K,J),J=1,3),RECORD(K),AVGCST(K),SPREAD(K)),K=1,15)
|
|
C
|
|
10 FORMAT(I3,X,A10,4(/,A7,F7.3),/,A7,I1,15(/,3A5,X,I1,F7.2,F7.2))
|
|
C
|
|
100 CONTINUE
|
|
C
|
|
CLOSE (UNIT=5)
|
|
RETURN
|
|
END
|