C%%A-RCB-0047-SL-18-2 C C C Fortran translation of MCR line handling routines originally C written in Ratfor. These routines are part of the Ratfor library C listed in A-RCB-0047-SL-18-5 and described in A-RCB-0091-SP-2. C INTEGERFUNCTIONGETL(LINE,MAXLIN,LUNIN) ! 18 INTEGERN,MAXLIN,LUNIN ! 19 LOGICAL*1LINE(MAXLIN) ! 20 READ(LUNIN,10,END=100)N,LINE ! 22 10 FORMAT(Q,255A1) ! 23 IF(.NOT.(N.GE.MAXLIN))GOTO23000 ! 24 N=MAXLIN-1 ! 24 23000 CONTINUE ! 25 LINE(N+1)="000 ! 25 GETL=(N) ! 26 RETURN ! 26 100 GETL=(-1) ! 28 RETURN ! 28 END ! 29 INTEGERFUNCTIONNXTMCR(LUNPMT,PROMPT,LUNIND,NUMOUT) ! 17 LOGICAL*1PROMPT(3),MCR(82),CJUNK,FN(41),TYPE ! 18 INTEGERNUMOUT,DONE,I,N,POS,LUNIND,FIRST,NBRCK,ININD,GETL ! 19 COMMON/MCRNFO/MCR,POS ! 20 DATADONE/0/,FIRST/1/ ! 21 CONTINUE ! 23 23000 CONTINUE ! 23 IF(.NOT.(DONE.EQ.1.AND.ININD.EQ.0))GOTO23004 ! 24 NXTMCR=(0) ! 24 RETURN ! 24 23004 CONTINUE ! 25 IF(.NOT.(FIRST.EQ.1))GOTO23007 ! 25 CALLGETMCR(MCR,N) ! 26 POS=1 ! 27 GOTO23013 ! 27 23011 POS=POS+1 ! 27 23013 IF(.NOT.(POS.LE.N))GOTO23012 ! 27 IF(.NOT.(MCR(POS).NE."040.AND.MCR(POS).NE."011))GOTO23012 ! 27 GOTO23011 ! 29 23012 CONTINUE ! 29 CONTINUE ! 29 23014 IF(.NOT.(POS.LE.N))GOTO23015 ! 29 IF(.NOT.(MCR(POS).EQ."040.OR. MCR(POS).EQ."011))GOTO23015 ! 29 POS=POS+1 ! 30 GOTO23014 ! 31 23015 CONTINUE ! 31 IF(.NOT.(POS.LE.N))GOTO23016 ! 31 DONE=1 ! 31 23016 CONTINUE ! 32 FIRST=0 ! 32 23010 CONTINUE ! 33 23009 GOTO23008 ! 34 23007 CONTINUE ! 34 IF(.NOT.(ININD.EQ.1.AND.LUNIND.GT.0))GOTO23020 ! 35 N=GETL(MCR,80,LUNIND) ! 36 IF(.NOT.(N.EQ.-1))GOTO23024 ! 37 ININD=0 ! 38 CLOSE(UNIT=LUNIND) ! 39 23027 CONTINUE ! 40 23024 CONTINUE ! 41 23023 CONTINUE ! 41 23022 GOTO23021 ! 42 23020 CONTINUE ! 42 WRITE(LUNPMT,10)PROMPT ! 43 10 FORMAT('$',3A1,'>') ! 44 READ(LUNPMT,20,END=1000)N,MCR ! 45 20 FORMAT(Q,82A1) ! 46 23028 CONTINUE ! 47 23021 CONTINUE ! 48 POS=1 ! 48 GOTO23031 ! 48 23029 POS=POS+1 ! 48 23031 IF(.NOT.(POS.LE.N))GOTO23030 ! 48 IF(.NOT.(MCR(POS).EQ."040.OR. MCR(POS).EQ."011))GOTO23030 ! 48 GOTO23029 ! 50 23030 CONTINUE ! 50 23019 CONTINUE ! 50 23008 CONTINUE ! 51 IF(.NOT.(POS.LT.N))GOTO23032 ! 51 IF(.NOT.(MCR(POS).EQ.'@'))GOTO23032 ! 51 MCR(N+1)="000 ! 52 N=-1 ! 53 IF(.NOT.(LUNIND.LE.0.OR.ININD.EQ.1))GOTO23036 ! 54 CALLMCRERR(LUNPMT,PROMPT,'COMMAND FILES INVALID HERE') ! 55 23038 GOTO23037 ! 56 23036 CONTINUE ! 56 POS=POS+1 ! 57 JUNK=NXTFIL('.CMD',FN,41,CJUNK,1) ! 58 OPEN(UNIT=LUNIND,NAME=FN,TYPE='OLD',ERR=30,READONLY) ! 59 ININD=1 ! 60 GOTO23039 ! 61 30 CALLMCRERR(LUNPMT,PROMPT,'CAN''T OPEN INDIRECT COMMAND FILE') ! 62 23039 CONTINUE ! 63 23037 CONTINUE ! 64 23035 CONTINUE ! 64 23032 CONTINUE ! 65 23003 CONTINUE ! 65 23002 IF(.NOT.(POS.LE.N))GOTO23000 ! 65 23001 CONTINUE ! 66 NUMOUT=1 ! 66 NBRCK=0 ! 67 MCR(N+1)="000 ! 68 I=1 ! 70 GOTO23042 ! 70 23040 I=I+1 ! 70 23042 IF(.NOT.(MCR(I).NE."000))GOTO23041 ! 70 IF(.NOT.(MCR(I).EQ.'['))GOTO23043 ! 71 NBRCK=NBRCK+1 ! 71 23045 GOTO23044 ! 72 23043 CONTINUE ! 72 IF(.NOT.(MCR(I).EQ.']'))GOTO23046 ! 72 NBRCK=NBRCK-1 ! 72 23048 GOTO23047 ! 73 23046 CONTINUE ! 73 IF(.NOT.(MCR(I).EQ.','.AND.NBRCK.EQ.0))GOTO23049 ! 73 NUMOUT=NUMOUT+1 ! 73 23051 GOTO23050 ! 74 23049 CONTINUE ! 74 IF(.NOT.(MCR(I).EQ.'='))GOTO23052 ! 74 GOTO23041 ! 74 23052 CONTINUE ! 75 23050 CONTINUE ! 75 23047 CONTINUE ! 75 23044 CONTINUE ! 75 GOTO23040 ! 75 23041 CONTINUE ! 75 IF(.NOT.(MCR(I).NE.'='))GOTO23055 ! 75 NUMOUT=0 ! 76 23055 CONTINUE ! 77 NXTMCR=(1) ! 77 RETURN ! 77 1000 DONE=1 ! 79 NXTMCR=(0) ! 80 RETURN ! 80 END ! 81 INTEGERFUNCTIONNXTFIL(EXT,FNAME,MAXFNM,SWITCH,MAXSW) ! 83 LOGICAL*1EXT(4),FNAME(MAXFNM),SWITCH(MAXSW),MCR(82) ! 84 INTEGERMAXFNM,MAXSW,POS,GOTDOT,I,J,NBRK ! 85 COMMON/MCRNFO/MCR,POS ! 86 CONTINUE ! 88 23058 IF(.NOT.(MCR(POS).EQ."040.OR. MCR(POS).EQ."011))GOTO23059 ! 88 POS=POS+1 ! 88 GOTO23058 ! 89 23059 CONTINUE ! 89 FNAME(1)="000 ! 89 SWITCH(1)="000 ! 90 IF(.NOT.(MCR(POS).EQ."000))GOTO23060 ! 91 NXTFIL=(0) ! 91 RETURN ! 91 23060 CONTINUE ! 92 I=1 ! 92 GOTDOT=0 ! 93 NBRAK=0 ! 94 GOTO23065 ! 95 23063 POS=POS+1 ! 95 23065 IF(.NOT.(MCR(POS).NE."000.AND.MCR(POS).NE.'/'.AND.MCR(POS).NE.'='. ! 95 1AND.(MCR(POS).NE.','.OR. NBRK.GT.0)))GOTO23064 ! 95 IF(.NOT.(MCR(POS).GE."141.AND.MCR(POS).LE."172))GOTO23067 ! 96 MCR(POS)=MCR(POS)-"040 ! 96 23069 GOTO23068 ! 97 23067 CONTINUE ! 97 IF(.NOT.(MCR(POS).EQ.'.'))GOTO23070 ! 97 GOTDOT=1 ! 97 23072 GOTO23071 ! 98 23070 CONTINUE ! 98 IF(.NOT.(MCR(POS).EQ.'['))GOTO23073 ! 98 NBRK=NBRK+1 ! 98 23075 GOTO23074 ! 99 23073 CONTINUE ! 99 IF(.NOT.(MCR(POS).EQ.']'))GOTO23076 ! 99 NBRK=NBRK-1 ! 99 23078 GOTO23077 ! 100 23076 CONTINUE ! 100 IF(.NOT.(MCR(POS).EQ.';'.AND.GOTDOT.EQ.0))GOTO23079 ! 100 J=1 ! 101 GOTO23085 ! 101 23083 J=J+1 ! 101 23085 IF(.NOT.(I.LT.MAXFNM.AND.J.LE.4))GOTO23084 ! 101 FNAME(I)=EXT(J) ! 102 I=I+1 ! 103 23086 CONTINUE ! 104 GOTO23083 ! 105 23084 CONTINUE ! 105 GOTDOT=1 ! 105 23082 CONTINUE ! 106 23079 CONTINUE ! 107 23077 CONTINUE ! 107 23074 CONTINUE ! 107 23071 CONTINUE ! 107 23068 CONTINUE ! 107 IF(.NOT.(I.LT.MAXFNM.AND.MCR(POS).NE."040.AND.MCR(POS).NE."011))GO ! 107 1TO23087 ! 107 FNAME(I)=MCR(POS) ! 108 I=I+1 ! 109 23090 CONTINUE ! 110 23087 CONTINUE ! 111 23066 CONTINUE ! 111 GOTO23063 ! 112 23064 CONTINUE ! 112 IF(.NOT.(GOTDOT.EQ.0.AND.I.GT.1))GOTO23091 ! 112 J=1 ! 113 GOTO23096 ! 113 23094 J=J+1 ! 113 23096 IF(.NOT.(I.LT.MAXFNM.AND.J.LE.4))GOTO23095 ! 113 FNAME(I)=EXT(J) ! 114 I=I+1 ! 115 23097 CONTINUE ! 116 GOTO23094 ! 117 23095 CONTINUE ! 117 23091 CONTINUE ! 117 FNAME(I)="000 ! 117 J=1 ! 118 IF(.NOT.(MCR(POS).EQ.'/'))GOTO23098 ! 119 POS=POS+1 ! 120 GOTO23103 ! 121 23101 POS=POS+1 ! 121 23103 IF(.NOT.(MCR(POS).NE.'='.AND.MCR(POS).NE."000.AND.MCR(POS).NE.',') ! 121 1)GOTO23102 ! 121 IF(.NOT.(J.LT.MAXSW))GOTO23104 ! 122 SWITCH(J)=MCR(POS) ! 123 J=J+1 ! 124 23107 CONTINUE ! 125 23104 CONTINUE ! 126 GOTO23101 ! 126 23102 CONTINUE ! 126 23098 CONTINUE ! 126 SWITCH(J)="000 ! 126 IF(.NOT.(MCR(POS).NE."000))GOTO23108 ! 127 POS=POS+1 ! 127 23108 CONTINUE ! 128 NXTFIL=(1) ! 128 RETURN ! 128 END ! 129 SUBROUTINEMCRERR(LUN,PRGNAM,MESS) ! 130 LOGICAL*1PRGNAM(3),MESS(10000) ! 131 INTEGERLENGTH,LUN,I ! 132 WRITE(LUN,10)PRGNAM,(MESS(I),I=1,LENGTH(MESS)) ! 133 10 FORMAT('0',3A1,' -- ',255A1) ! 134 RETURN ! 135 END ! 136 SUBROUTINECANT(LUN,PRGNAM,FNAME) ! 138 LOGICAL*1PRGNAM(3),FNAME(10000) ! 139 INTEGERLENGTH,L,I ! 140 L=LENGTH(FNAME) ! 142 IF(.NOT.(L.LE.0))GOTO23111 ! 143 WRITE(LUN,10)PRGNAM ! 144 23113 GOTO23112 ! 145 23111 CONTINUE ! 145 WRITE(LUN,20)PRGNAM,(FNAME(I),I=1,L) ! 146 23112 CONTINUE ! 147 RETURN ! 147 10 FORMAT('0',3A1,' -- NULL FILE NAME') ! 148 20 FORMAT('0',3A1,' -- CAN''T OPEN THIS FILE: ',255A1) ! 149 END ! 150 SUBROUTINEKILFER ! 152 CALLERRSET(29,,.FALSE.,,.FALSE.) ! 153 CALLERRSET(43,,.FALSE.,,.FALSE.) ! 154 RETURN ! 155 END ! 156