IF(J4.EQ.1) REWIND J4 IF(J4.EQ.1) CALL ICL0SE(J4,1) IF(J5.EQ.2) REWIND J5 IF(J5.EQ,2) CALL ICLOSE(J5,1) JOP = -1
CALL PAUSE(2) RETURN
52 DO 53 1=1,NRA IF(KORFO.EQ.'K') WRITE(I6,217) I
217 FORMATC Enter row \I3,' of matrix A: ') READ(J4,*,END=500) (AM(I,J),J=1 ,NCA)
53 CONTINUE IF(KORFO.EQ.'F’) REWIND J4 IF(JOP.EQ.3) GOTO 54
KORF = 'F' IF(KORF.EQ.’K') J5 = 0 IF(KORF.EQ.'K') GOT© 56 J5 = 2
WRITE(I6,219)
219 FORMAT(/' Enter name of file containing matrix B: '} CALL FNRDIN(FNAME)
IF(LZ.LT.O) RETURN
CALL FILOPN(0,J5,FNAME) IF(LZ.LT.O) RETURN
56 IF(KORF.EQ.'K') WRITE(I6,220)
220 FORMATS Enter number of rows and columns for matrix B: ') READ(J5,‘,END=5C0) NRB.NCB IF(NRB.GT.MAXR.OR.NCB.GT.MAXC) GOTO 57
CHECK CONSISTENCYOF MATRIX DIMENSIONS
54 GOTO (71,72,80,73,80,73), 10PM1
71 IF(NRA.EQ.NRB.AND.NCA.EQ.NCB) GOTO 80 CALL TONE
WRITE(I6,221)
221 FORMAT^ Error - Matrices A and В do not have compatible’, 1’ dimensions.')
LZ = -9
CALL PAUSE(2) RETURN
72 IF(NCA.EQ.NRB) GOTO 80 CALL TONE WRITE(I6,221)
LZ = -9
CALL PAUSE(2) * '
CHARACTERS KORF.MON.IPRT.KORFO
CHARACTERS IPAUSE
C
IF(IOP.EQ,3) GOTO 100
IF(IOP.EQ,1) WRITE(I6,201)
201FORMAT(/' Press RETURN to go to the main menu of options') IF(IOP.EQ,2) WRITE(I6,202)
202FORMAT(/’ Press RETURN to return to the menu of options') w
IF(IOP.EQ.O) WRITE(I6,200)
200 FORMAT^ Press RETURN to continue')
101 READ(I5,299) IPAUSE
299 FORMAT(A1) RETURN
C
100 IF(MON.EQ.'Y') WRITE(I6,202) IF(MON.EQ.'N'.AND.iPRT.EQ.'N') WRITE(I6,202) IF(MON.EQ.'N'.AND.IPRT.EQ.’Y') WRITE(I6,203)
203 FORMAT(/' Output file created') IF(MON.EQ.'N'.AND.IPRT.EQ.'Y') WRITE(!6,202) GOTO 101
END
* # * * * < ► * * * * * * * * # * * * * * * * * * * * * * * * * < ► » * * * * * * * * * * * * * * *
CHECKS IFFILE IS NEW OR OLD, THEN OPENS IT
IUNK = 0 : FILE SHOULD EXIST
= 1 : UNKNOWN FILE
SUBROUTINE FILOPN(IUNK,IFlL,FNAME)
COMMON TLC/ SV(20),LZ,LU,Z11 ,Z22,D11,D22,N2Z,NSP,DPC,DFT,UPA COMMON /IOLUN/ I5,I6,J5,J6,J4
CHARACTERS6 FNAME LOGICAL*2 FILEOK
C
IF(IUNK.EQ.O) GOTO 100 INQUIRE(FlLE=FNAME,EXIST=FlLEOK)
IF(FILEOK) OPEN(IF!L,FILE=FNAME,STATUS='OLD',FORM='FORMATTED') IF(,NOT.FILEOK) OPEN(IFIL,FILE=FNAME,STATUS='NEW',
1 FORM='FORMATTED') CALL FILADD(IFIL) RETURN
100 INQUIRE(FILE=FNAME,EXIST=FILEOK) IF(FILEOK) GOTO 102
WRITE(I6,200) FNAME
200 FORMAT(/' File ',A16,' does not exist
1//’ Enter correct file name or press RETURN to abort: ') CALL FNRDIN(FNAME)
IF(LZ.LT.O) RETURN GOTO 100
102 OPEN(IFIL,FILE=FNAME,STATUS='OLD,,FORM='FORMATTED') CALL FILADD(IFIL)
RETURN END
о
KEEPS TRACK OF ALL LUN OF CURRENTLY OPENED FILES
SUBROUTINE FILADD(IFIL)
COMMON /FLINDX/ IFLUN(2G)
DO 100 1=1,20 IF(IFLUN(l).EQ.O) GOTO 101
100 CONTINUE
101 J=l
IFLUN(J) = I FIL RETURN
END
READS IN FILE NAME AND CHECKS FOR LENGTH AND NONSTANDARD CHARACTERS
SUBROUTINE FNRDIN(FNAME) COMMON /IOLUN/ I5,I6,J5,J6,J4
COMMON f X L C l SV(20),LZ,LU,Z11 ,Z22,D11 ,D22,NZZ,NSP,DPC,DFT,UPA COMMON /ASC/ iALPHA(96)
CHARACTER'1 (ALPHA
CHARACTER-16 FNAME CHARACTER-1 ANAME(16),CHOL EQUIVALENCE (ANAME(1),FNAME)
105 READ(l5,200) ANAME
200 FORMAT(16A1) WRITE(FNAME,'(16A1)') ANAME IF(FNAME.NE.IALPHA(1)) GOTO 100 LZ = -9
CALL CLSALL RETURN
... CHECK FOR TOTAL LENGTH
100 DO 101 1=1,16 IF(ANAME(I).EQ.IALPHA(1)) GOTO 102
CLOSE ALL CURRENTLY OPENED IDLES
SUBROUTINE CLSALL COMMON /FLINDX/ IFLUN(20) DO 100 1=1,20 IF(IFLUN(l).EQ.O) GOTO 100
JFIL = IFLUN(I) CALL ICLOSE(JFIL,1)
00 CONTINUE RETURN END
CLOSE FILE I, IOP = 0 IS DELTE, IOP = 1 IS KEEP
SUBROUTINE ICLOSE(I.IOP) COMMON /FLINDX/ IFLUN(20)
IF(IOP.EQ.O) CLOSE(l;STATUS=’DELETE’) IF(IOP.EQ.1) CLOSE(l,STATUS=’KEEP’) DO 100 J=1,20
IF(IFLUN(J).EQ.I) IFLUN(J) = 0 00 CONTINUE
RETURN END
SUBROUTINE DATENT
COMMON rXLCI SV(20),LZ,LU,Z11 ,Z22,D11,D22,NZZ,NSP,DPC,DFT UPA COMMON /IOLUN/ I5,I6,J5,J6,J4
COMMON /DATQ/ A(1 00,2),B(2,2),C(2),D(100,4) COMMON /NAMEF/ FNAME
CHARACTERS 6 FNAME
C
NCMAX = 100
CALL CLEAR '.7RITE(I6,205)
205 FORMATS DATA ENTRY MODULE',//) WRITE(I6,200)
200 FORMAT(/’ Enter name of file to store data. ’) CALL FNRDIN(FNAME)
IF(LZ.LT 0) RETURN
CALL FILOPN(1,20,FNAME) 104 WRITE(l6,202)
202 FORMAT^ Enter number cf rows and columns of data matrix: ') 102 CALL IREAD;2,K !’ OW,NCOL,105,105)
IF(LZ.LT.O) RETURN
I F(NROW.GE.1 .AND.NCOL.GE.1) GOTO 101 CALL INVLID(1)
GOTO 102
101 IF{NCOL.LE.NCMAX) GOTO 105 WRITE(I6,206) NCMAX
20G FORMAT^ Number of columns exceed max of ',I4,’ - Try again') GOTO 104
105 VV'Rn E(20,*) NROW,NCOL DO 100 l=1,NROW
DO 103 J=1,NCOL
WRITERS,203) U
203 FORMATC Enter vslua tor rev,1 |
column ',14, |
1’ of data matrix: ') |
|
CALL RREA0(1 ,ZA,AG5,A05,A05) |
|
IF(LZ.LT.O) RETURN |
|
A(J,1) = ZA |
|
103 CONTINUE |
|
WRITE(20,*) (A(J,1),J=1 ,NCOL) |
|
100 CONTINUE
REWIND20
CALL ICLOSE(20,1) WRITE(I6,204) FNAME
204 FORMAT(F Data now stored in file ‘,A16) CALL PAUSE(2)
RETURN
END
**fcC-»«*#*****i*> *.? «&***•«*•*** r- ******* *' '•***
subroutine CLEAR clears tha monitor screen
SUBROUTINECLEAR
CHARACTERS ESC
CHARACTER*3 SEQ
CHARACTERSCLS
SEQ='[2J‘
ESC=CHAR(027)
WRITE (CLS,'(A1,A3)') ESC,SEQ
WRITE (*,*) CLS
RETURN
END
ASKS USER FOR DATEAND TIME TO BEWRITTEN ONTO ALL
PRINTOUT FILES
SUBROUTINE DATE
COMMON /IOLUN/ I5,I6,J5,J6,J4 COMMON /ASC/ IALPHA(S6) COMMON /DAT I Mr IDATE(8),ITIME(5) CHARACTER'1 lALPHA.IDATE.ITIME DIMENSION IN(6)
105 WRITE(I6,200)
200 FORMAT(//,’ Enier current date (MM-DD-YY): READ(I5,201) IDATE
201 F0RMAT(8A1) CHECK FOR Q, U OR H
CALL QUH(IDATE(1),IQUIT)
IF(IQUIT.EQ.I) STOP ' '
IF(IDATE(3).NE.]ALPHA(14)) GOTO 100 IF(IDATE(6).NE,IALPHA(1 4)) GOTO 100
DO 102 1=1,6
IN(l> = -1000
102CONTINUE
DO 101 1=1,96 IF(IDATE(1).EQ.IALPHA(I)) IN(1) = I 17 IF(IDATE(2).EQ.IALPHA(I)) IN(2) = I 17 IF(IDATE(4).EQ.IALPHA(I)) IN(3) = I 17 IF(IDATE(5).EQ,IALPHA(I)) IN(4) = I 17 IF(1DATE(7).EQ.IALPHA(I)) IN(5) = I 17
1F(IDATE(8).EQ.IALPHA(I)) IN(6) = I 17 101 CONTINUE
DO 103 1=1,6 IF(IN(I).EQ.-1000) GOTO 100
103 CONTINUE
IF(IN(1 ).NE.-16.AND.IN(1),NE.0.AND.IN(1 ).NE.1) GOTO 100 IF(IN(2).LT.O.OR.IN(2).GT.9) GOTO 100
IF(IN(1 ).LE.O.AND,IN(2).EQ.O) GOTO 100
IF(IN(1).EQ.1 ,AND,IN(2).GT.2) GOTO 100 IF(IN(3).GT.-16.AND.!N(3).LT.0) GOTO 100 IF(IN(3).GT.3) GOTO 100 IF(IN(4).LT.0.OR.IN(4).GT.9) GOTO 100 IF(IN(3).LE.0.AND.IN(4).EQ,0) GOTO 100
IF(IN(3).EQ.3.AND.IN(4).GT 1) GOTO 100 GOTO 104
С
100 CALL INVLID( 1 GOTO 105
C |
104 |
WRiTE(l6,203) |
|
|
203 |
FORMAT(/’ Enter current time (HH:MM) ') |
Lt |
READ(I5,204) ITIME |
‘204 FORMAT(5A1)
о о |
|
|
.. CHECK FOR Q, U OR H |
|
о |
|
|
CALL QUH(IT!ME(1 ),IQUIT) |
|
IF(IQUIT.EQ.I) GOTO 105 |
|
о |
|
|
IF(ITIME(3).NE.IALPHA(27)) GOTO 106 |
о |
|
|
DO 107 1=1,4 |
|
IN(I) = |
1000 |
|
’“107 CONTINUE |
|
о |
v |
|
DO 108 1=1,96 |
|
IF(ITIME(1).EQJALPHA(!)) IN(1) = I |
17 |
IF(ITIME(2).EQ.IALPHA(I)) IN(2) = I |
17 |
IF(ITIME(4).EQ.IALPHA(I)) IN(3) = I |
1 " |
IF(ITIME(5).EQ.IALPHA(I)) IN'4) = I |
17 |
108 CONTINUE |
|
о |
|
|
DO 109 1=1,4 |
|
IF(IN(I).EQ.-1000) GOTO 106 |
|
109 CONTINUE |
|
О |
|
|
IF(IN(1 ).GT 16.ANDJN(1).LT.0) GOTO 106 IF(IN(1 ).GT.2> GOTO 106 IF(IN(2).LT.0.OR.(N(2).GT.9) GOTO 106 IF(IN(1 ).EQ,2.AND.IN(2),GT.4j GOTO 106 IF(IN(3).LT.0,OR.IN(3).GT.5) GOTO 106 IF()N(4).LT.0.OR.IN(4) G~ 9) GOTO 106 CALL PAUSE(1)
RETURN
О
106 CALL INVUD(1 GOTO 104
END
