SUBROUTINE GET(LINENO,STRING,ENDFIL) C C GET IS THE INPUT SUBROUTINE FOR THE FLECS TRANSLATOR. C C THIS MINIMAL VERSION OF GET IS BASED ON THE FOLLOWING C ASSUMPTIONS -- C -- THE FLECS SOURCE APPEARS AS 80 COLUMN CARD IMAGES ON C FORTRAN UNIT NUMBER IN C -- THE LAYOUT OF STATEMENTS CONFORMS TO ANSI STANDARDS WITH C RESPECT TO THE USE OF COLUMNS 1 THROUGH 7, AND C TERMINATES IN COLUMN 72. C -- COLUMNS 73-75 ARE IGNORED. C -- COLUMNS 76 THROUGH 80 EITHER CONTAIN BLANKS OR A POSITIVE C LINE NUMBER IN I5 FORMAT. C -- CARDS WITHOUT LINE NUMBERS ARE TO BE ASSIGNED SEQUENTIALLY C INCREASING LINE NUMBERS BASED ON THE LAST LINE NUMBER C SEEN. C INTEGER CH,POS,STRING,WD,CHZERO, CHSPAC, CHC, NCHPWD INTEGER LINENO,LIM,LPOS,I,LINE,LAST INTEGER EOUT,FOUT,IN,LOUT,LWIDTH,CHTAB,CHCOMT,CHSYST INTEGER L0,L1,IOFST,IDST,ISRC LOGICAL ENDFIL,SEQNC,NOINCL,CMPR,DOINCL LOGICAL*1 INCLFI(11) COMMON /SYSTEM/ EOUT,FOUT,IN,LOUT,LWIDTH,CHTAB,CHCOMT,CHSYST COMMON /RT11/ IRTCMD(40),INFAKE,LINERT,LASTRT,SEQNC, 1IXFAKE,NOINCL,DOINCL DIMENSION STRING(73) DIMENSION INCLUD(8) DATA LIM/73/ DATA CHSPAC /1H / DATA IDOLAR,ICHAR,IXCHAR/1H$,1HI,1HX/ DATA INCLUD/1HI,1HN,1HC,1HL,1HU,1HD,1HE,1H / C C SOURCE STATEMENT INPUT FORMAT 10 FORMAT(72A1,3X,I5) C 1 CONTINUE CONDITIONAL (INFAKE.EQ.1) INFAKE=2 LINE=0 STRING(2)=IDOLAR STRING(3)=ICHAR DO (J=4,LIM)STRING(J)=CHSPAC FIN (IXFAKE.EQ.1) IXFAKE=2 LINE=0 STRING(2)=IDOLAR STRING(3)=IXCHAR DO(J=4,LIM)STRING(J)=CHSPAC FIN (OTHERWISE) WHEN(.NOT.DOINCL) READ(IN,10,END=20) (STRING(I),I=2,LIM),LINE FIN ELSE READ(4,10,END=30,ERR=50) (STRING(I),I=2,LIM),LINE FIN FIN FIN WHEN (LINE.GT.0) LINENO=LINE ELSE LINENO=LINENO+1 EXPAND-TABS IF((INFAKE.EQ.0).AND.(.NOT.NOINCL)) CHECK-FOR-AN-INCLUDE FIN TRIM-TRAILING-BLANKS-FROM-STRING RETURN 20 ENDFIL=.TRUE. LINENO=0 RETURN C 30 DOINCL=.FALSE. CALL CLOSE(4) GO TO 1 40 TYPE 42 42 FORMAT(' FLECS-W-NOTHING IN INCLUDE FILE!') CALL CLOSE(4) GO TO 1 50 STOP 'FLECS-F-ERROR READING INCLUDE FILE!' C TO EXPAND-TABS DO (L0=2,7) IF (STRING(L0).EQ.CHTAB) IOFST=7-L0 DO (L1=8,LIM) IDST=81-L1 ISRC=IDST-IOFST STRING(IDST)=STRING(ISRC) FIN DO (L1=L0,7) STRING(L1)=CHSPAC FIN FIN DO (L0=8,LIM) IF (STRING(L0).EQ.CHTAB) STRING(L0)=CHSPAC FIN FIN C TO TRIM-TRAILING-BLANKS-FROM-STRING WD=LIM+1 REPEAT UNTIL(WD.LE.2.OR.CH.NE.CHSPAC) WD=WD-1 CH=STRING(WD) FIN WHEN (WD.EQ.2.AND.CH.EQ.CHSPAC) STRING(1)=0 ELSE STRING(1)=WD-1 FIN TO CHECK-FOR-AN-INCLUDE IF(CMPR(INCLUD,STRING(8),8)) DOINCL=.TRUE. DO(J=1,10) INCLFI(J)=STRING(J+15) CALL ASSIGN (4,INCLFI) READ(4,10,END=40,ERR=50)(STRING(I),I=2,LIM),LINE EXPAND-TABS FIN FIN END C C*********************************************************************** C SUBROUTINE PUT(LINENO,STRING,IOCLAS) C C PUT IS THE OUTPUT ROUTINE FOR THE FLECS TRANSLATOR. C C THIS MINIMAL VERSION OF PUT IS BASED ON THE FOLLOWING C ASSUMPTIONS-- C -- FILE FORTOUT IS WRITTEN ON FORTRAN UNIT FOUT. C -- FILE LISTOUT IS WRITTEN ON FORTRAN UNIT LOUT. C -- UNIT LOUT ACCEPTS THE FOLLOWING CARRIAGE CONTROL CHARACTERS C (BLANK) SINGLE SPACE THEN PRINT C (+) SUPPRESS SPACING BEFORE PRINTING C -- THE LINE NUMBERS TO BE WRITTEN TO FORTOUT SHOULD APPEAR C IN COLUMNS 76 THROUGH 80. C -- OUTPUT CLASS ERROR IS TO ALSO APPEAR ON THE EOUT DEVICE C INTEGER ALN,BLANKS,ERR,FORT,REM INTEGER LINENO,IOCLAS,LIST,LIMLN,LIMST,I,LASTWD,LPOS,LNHOLD INTEGER STMT,STRING,CHZERO, CHSPAC, CHC, NCHPWD INTEGER IICWD,IIJJKK,IICH,CHH,CHONE,CHX ,CHT INTEGER EOUT,FOUT,IN,LOUT,LWIDTH,CHTAB,CHCOMT,CHSYST LOGICAL SEQNC,DOINCL,NOINCL,CMPR LOGICAL NEWVER,FORTOF,LISTOF,CONDOF COMMON /CONTRL/ NEWVER,FORTOF,LISTOF,CONDOF COMMON /SYSTEM/ EOUT,FOUT,IN,LOUT,LWIDTH,CHTAB,CHCOMT,CHSYST COMMON /RT11/ IRTCMD(40),INFAKE,LINERT,LASTRT,SEQNC, 1IXFAKE,NOINCL,DOINCL C DIMENSION STRING(2) DIMENSION BLANKS(73) DIMENSION LNHOLD(6),LNRT11(6) DIMENSION STMT(73) DIMENSION IENDST(4),IFSTM1(3),IFSTM2(3) DIMENSION IPROST(9) C DATA FORT /1/, LIST/2/, ERR/3/ DATA BLANKS(01),BLANKS(02),BLANKS(03),BLANKS(04) 1 ,BLANKS(05),BLANKS(06),BLANKS(07),BLANKS(08),BLANKS(09) 1 ,BLANKS(10),BLANKS(11),BLANKS(12),BLANKS(13),BLANKS(14) 1 ,BLANKS(15),BLANKS(16),BLANKS(17),BLANKS(18),BLANKS(19) 1 ,BLANKS(20),BLANKS(21),BLANKS(22),BLANKS(23),BLANKS(24) 1 ,BLANKS(25),BLANKS(26),BLANKS(27),BLANKS(28),BLANKS(29) 1 ,BLANKS(30),BLANKS(31),BLANKS(32),BLANKS(33),BLANKS(34) 1 ,BLANKS(35),BLANKS(36),BLANKS(37),BLANKS(38),BLANKS(39) 1 ,BLANKS(40),BLANKS(41),BLANKS(42),BLANKS(43),BLANKS(44) 1 ,BLANKS(45),BLANKS(46),BLANKS(47),BLANKS(48),BLANKS(49) 1 ,BLANKS(50),BLANKS(51),BLANKS(52),BLANKS(53),BLANKS(54) 1 ,BLANKS(55),BLANKS(56),BLANKS(57),BLANKS(58),BLANKS(59) 1 ,BLANKS(60),BLANKS(61),BLANKS(62),BLANKS(63),BLANKS(64) 1 ,BLANKS(65),BLANKS(66),BLANKS(67),BLANKS(68),BLANKS(69) 1 ,BLANKS(70),BLANKS(71),BLANKS(72),BLANKS(73) 1 /72,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H , 1 1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H , 1 1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H , 1 1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H , 1 1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H / $PAGE DATA LNHOLD(1) /5/ DATA LNRT11(1) /5/ DATA LIMLN /6/, LIMST /73/ DATA CHX /1HX/, CHT/1HT/ DATA CHH,CHONE /1HH,1H1/,CHSPAC /1H / DATA IDOLAR,ICHAR /1H$,1HI/ DATA IENDST /1HE,1HN,1HD,8276/ DATA IFSTM1 /1HI,1HF,1H / DATA IFSTM2 /1HI,1HF,1H(/ DATA IECHAR /1HE/ DATA IPROST /1HP,1HR,1HO,1HC,1HE,1HD,1HU,1HR,1HE/ DATA IACHAR,I0CHAR,IXCHAR/1HA,1H0,1HX/ C C OUTPUT FORMAT FOR FORTRAN STATEMENTS 10 FORMAT(72A1,3X,5A1) C C OUTPUT FORMAT FOR LISTING LINES 20 FORMAT(1X,4A1,1X,3A1,1X,130A1) C C OUTPUT FORMAT USED TO INDICATE DELETED LINE. 30 FORMAT(6H+-----) C C OUTPUT FORMAT USED FOR INDENTED SOURCE OUTPUT 40 FORMAT(72A1) C CONDITIONAL (LINENO.GT.0) CALL PUTNUM(LNHOLD,LINENO) (LINENO.EQ.0) CALL CPYSUB(LNHOLD,BLANKS,1,5) (OTHERWISE) CALL PUTNUM(LNHOLD,-LINENO) FIN WHEN ((LINERT.EQ.LASTRT).OR.(LINENO.EQ.0)) CALL CPYSUB(LNRT11,BLANKS,1,5) FIN ELSE CALL PUTNUM (LNRT11,LINERT) CONDITIONAL (IOCLAS.EQ.FORT) CALL CPYSTR(STMT,STRING) IF (STMT(2).EQ.CHX) STMT(2)=CHSPAC UPDATE-THE-FORTRAN-LINE-COUNT IIJJKK=STMT(1)+1 I=2 WHILE (I.LE.IIJJKK) IF(STMT(I).EQ.CHCOMT) UNLESS(STMT(I-1).EQ.CHH.AND.STMT(I-2).EQ.CHONE) STMT(1)=I-2 I=IIJJKK FIN FIN I=I+1 FIN REM=72-STMT(1) IF(REM.GT.0) CALL CATSUB(STMT,BLANKS,1,REM) WHEN(SEQNC) WRITE(FOUT,10) (STMT(I),I=2,LIMST),(LNHOLD(I),I=2,LIMLN) FIN ELSE J=STRING(1)+1 WRITE(FOUT,40)(STRING(I),I=2,J) FIN FIN (STRING(1).LE.0) WRITE(LOUT,20) (LNHOLD(I),I=3,LIMLN) (OTHERWISE) LASTWD=STRING(1)+1 UNLESS (NEWVER) WHEN(LINENO.EQ.0 .AND. STRING(2).EQ.CHT) WRITE(LOUT,12345) 12345 FORMAT(1H1) FIN ELSE IF(CMPR(STRING(8),IPROST,9)) WRITE(LOUT,12345) LINERT=0 LASTRT=0 FIN UNLESS((STRING(2).EQ.IDOLAR).AND.(STRING(3).EQ.IPROST(1))) WRITE(LOUT,20) (LNHOLD(I),I=3,LIMLN), 1 (LNRT11(I),I=4,LIMLN),(STRING(I),I=2,LASTWD) IF(LINENO.NE.0)LASTRT=LINERT FIN FIN FIN IF (NEWVER.AND.LINENO.NE.0) CALL CPYSTR(STMT,STRING) REM=72-STMT(1) IF(REM.GT.0) CALL CATSUB(STMT,BLANKS,1,REM) CONDITIONAL ((STMT(2).EQ.IDOLAR).AND.(STMT(3).EQ.ICHAR)) IF(INFAKE.EQ.2)INFAKE=3 FIN ((STMT(2).EQ.IDOLAR).AND.(STMT(3).EQ.IXCHAR)) IF(IXFAKE.EQ.2)IXFAKE=3 FIN (OTHERWISE) WHEN(SEQNC) WRITE(LOUT,10)(STMT(I),I=2,LIMST), 1 (LNHOLD(I),I=2,LIMLN) FIN ELSE WRITE(LOUT,40)(STRING(I),I=2,LASTWD) FIN FIN FIN FIN IF (IOCLAS.EQ.ERR) WRITE(EOUT,20) (LNHOLD(I),I=3,LIMLN), 1 (LNRT11(I),I=4,LIMLN),(STRING(I),I=2,LASTWD) FIN FIN FIN UNLESS (NEWVER) IF(LINENO.LT.0) WRITE(LOUT,30) FIN RETURN TO UPDATE-THE-FORTRAN-LINE-COUNT CONDITIONAL (STMT(7).NE.CHSPAC)LASTRT=LINERT (CMPR(STMT(8),IFSTM1,3))LINERT=LINERT+2 (CMPR(STMT(8),IFSTM2,3))LINERT=LINERT+2 (CMPR(STMT(8),IENDST,3)) KKK=0 JJJ=IACHAR+25 DO (I=IACHAR,JJJ) IF(I.EQ.STMT(11))KKK=LINERT+1 FIN JJJ=I0CHAR+9 DO (I=I0CHAR,JJJ) IF(I.EQ.STMT(11))KKK=LINERT+1 FIN LINERT=KKK IF(LINERT.EQ.0)LASTRT=0 FIN (OTHERWISE)LINERT=LINERT+1 FIN FIN END LOGICAL FUNCTION CMPR (ISTR1,ISTR2,LENGTH) DIMENSION ISTR1(1),ISTR2(1) CMPR=.TRUE. DO (I=1,LENGTH) IF(ISTR1(I).NE.ISTR2(I))CMPR=.FALSE. UNLESS (CMPR)RETURN FIN END