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