BLOCK DATA COMMON/TABLE/ITBL(30,30) DIMENSION ITBLA(30,15),ITBLB(30,15) EQUIVALENCE(ITBL,ITBLA),(ITBL(1,16),ITBLB) DATA ITBLA/ 1 1,1,1,1,1,1,0,0,0,0,0,1,0,1,1,1,1,1,0,1,0,9*0, 21,1,1,1,1,1,0,0,0,0,0,1,0,1,1,1,1,1,0,1,0,9*0, 3 1,1,1,1,1,1,0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,9*0, 4 1,1,1,1,1,1,0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,9*0, 5 0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,9*0, 6 0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,9*0, 7 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,9*0, 8 1,1,1,1,1,1,0,0,0,0,0,1,0,1,1,1,1,1,0,1,1,9*0, 91,1,1,1,1,1,0,0,0,0,0,1,0,1,1,1,1,1,0,1,1,9*0, 10,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,9*0, 20,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,9*0, 3 1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9*0, 41,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9*0, 5 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,9*0, 6 0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,1,0,0,0,9*0/ DATA ITBLB/ 1 0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,1,0,0,0,9*0, 2 1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9*0, 3 1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9*0, 4 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,9*0, 5 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,9*0, 6 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9*0, 7 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9*0, 8 1,1,1,27*0, 9 1,1,1,27*0, 1 30*0, 2 30*0, 3 30*0, 4 30*0, 5 30*0, 6 30*0/ END C *** BANK *** C C THIS SUBROUTINE IS THE INTERPRUTER. ITS FUNCTION IS TO TAKE THE C COMMANDS PRESENTED BY THE USER SCAN FOR LEGALALITY AND FORM, AND C THEN SET UP THE COMMON AREA CORRECTLY C C THE ONLY ARGUMENT IWHICH IS USED TO RETURN THE NUMBER OF THE C COMMAND TO BE EXECUTED. C SUBROUTINE INTERP(IWHICH) DIMENSION NAME(15),DATE(2),CMDS(30),SWT(30),ROOM(3) DIMENSION NNS(18,6),COMB(2),ITYPES(9) DIMENSION LV(125),ITBLA(30,15),ITBLB(30,15) INTEGER CMDS COMMON/TABLE/ITBL(30,30) COMMON/DEV/IDLG,ICC,IBNK,IUPGR,ITMPRY,MPROG COMMON /GEN/ IPROJA,IPROGA,NV,NO,BNKNM,DATCR,NPROJR,NPROGR COMMON /VAR/ LICVR,NHV,IV(2,30) COMMON /OBS/ LICOB,NHO,IO(2,30) COMMON /SEL/ NS,ISEL(5,20),DATC(20,20) COMMON /FMT/ LICFMT,FORM(48) COMMON /IDINFO/ LICID,LICIN,LICWO COMMON /CNST/ LICCON,CNVAL,ICNVAL,NUMCNS COMMON /SET/ NHVSET,IVSET(2,30), NHOSET,IOSET(2,30) 1 ,NSSET,ISELST(5,20),DATCST(20,20), LFMTST,FORMST(48) 2 ,LDEVST,DEVSET,FNAMST, LSETWO COMMON /OOUT/ LICDEV,DEV,FNAM COMMON /MTM/ NMTM,IVARSQ(20) COMMON/TRNS/INSTR(25),IVAR1(25),IVAR2(25),CONST(25),SV(99),ITO(25) COMMON /MRG/ BNKU(2),IPJU,IPGU,NMATCH,MATCHS(20) COMMON /PROG/ IOUTOF,LICRUN,INPUT(80) COMMON /NXTRUN/ RUNUO,PRGRUN(30) COMMON /BELL/ LBELL COMMON /REFRN/ NREF,IREF(2),NAMREF(2),MODREF(2) EQUIVALENCE (LV,NNS),(IROOM,ROOM),(FNAM,COMB),(MISS,AMISS) EQUIVALENCE (INST,SINST),(ITBL,ITBLA),(ITBL(1,16),ITBLB) EQUIVALENCE (ICON,CON) DOUBLE PRECISION BNKNM,XTRARM,FNAM,FNAMST,DATCR,CMDPG,CMDDFT DATA CMDDFT/'BNKPG.DAT'/ DATA CMDS/'REPLA','MODIF','CHANG','FORGE','DELET','DEL', 1'BACKU','CREAT','MAKE','ADD','MA','OUTPU','MERGE','PRINT', 2'LIST','Q','STDES','TYPE','SORT','SET','=:','FOR:', 38*' '/ DATA SWT/'VARIA','VAR','OBSER','OBS','DEVIC','DEV', 1'MATCH','SELEC','SUBSE','FORMA','FMT','CONST','CON', 2'BANK','INFO','INFOR','IDENT','ID','MAJOR','MTM', 3'W/O','BELL','REF','REFER',6*' '/ DATA IBRKL,IBRKR/"555004020100,"565004020100/ DATA IALT/"155004020100/ DATA BELL/"034000000000/ DATA MISS/"400000000000/ NCMDS=22 NSWTS=24 3 FORMAT(80A1) 42 IBASE=((((NO-1)/125)+1)*NV)+1 NHV=0 NHO=0 NS=0 NMATCH=0 NSELTB=0 IPJU=0 IPGU=0 BNKU(1)=0 NMTM=0 CC=0 LICIN=0 LICID=0 LICWO=0 LICVR=0 LICOB=0 LICDEV=0 LICFMT=0 LICCON=0 DEV=DEVSET FNAM=FNAMST NREF=0 C C READ CARD WITH COMMAND ONIT AND PROCESS IF CC.EQ.0 C IF CC.EQ.1 READ NEXT CARD AND PROCESS IT C READ UNTIL SIGN FOR IALT OCCURRS THEN PROCESS C 54 IF(IOUTOF.EQ.1) GO TO 56 IF(CC.EQ.1) GO TO 29 CALL TYPEON IF(LBELL.GT.0) WRITE(IDLG,27) (BELL,J=1,LBELL) 27 FORMAT('+',99A1) WRITE(IDLG,36) 36 FORMAT('0 ? ',$) LBELL=0 GO TO 28 29 WRITE(IDLG,57) 57 FORMAT('+* ',$) 28 CALL GES(INPUT,80,ICHECK) IF(ICHECK.EQ.2) GO TO 9999 GO TO 41 56 READ(MPROG,3,END=9950) INPUT 41 I=1 IF(CC.EQ.1) GO TO 50 IF((INPUT(1).NE.'F').OR.(INPUT(2).NE.'O').OR. 1(INPUT(3).NE.'R')) GO TO 51 IF((INPUT(4).EQ.' ').OR.(INPUT(4).EQ.IBRKL)) GO TO 53 51 DO 43 J=1,5 43 NAME(J)=' ' J=1 CC=1 IF(INPUT(1).EQ.'/') GO TO 9800 IF(INPUT(1).EQ.'@') GO TO 9900 44 IF(INPUT(I).EQ.' ') GO TO 47 IF(INPUT(I).EQ.'!') GO TO 42 IF(INPUT(I).EQ.IALT) GO TO 47 IF((I.EQ.6).AND.(INPUT(5).EQ.')').AND.(INPUT(6).EQ.'=')) GO TO 45 IF((INPUT(I).EQ.'=').AND.(INPUT(I-1).NE.'(')) GO TO 1000 IF(J.GT.5) GO TO 45 NAME(J)=INPUT(I) J=J+1 45 I=I+1 IF(I.LE.25) GO TO 44 32 WRITE(IDLG,46) 46 FORMAT(' NO SPACE BETWEEN INSTRUCTION AND QUALIFIER') GO TO 42 47 ENCODE(5,3,INST) (NAME(J),J=1,5) IF(INST.EQ.'HELP') GO TO 2010 IF(INST.EQ.'HELP(') GO TO 2010 DO 48 J=1,NCMDS IF(INST.NE.CMDS(J)) GO TO 48 NCOMD=J IF((NCOMD.EQ.12).OR.(NCOMD.EQ.14).OR.(NCOMD.EQ.15)) GO TO 50 IF((NCOMD.EQ.16).OR.(NCOMD.EQ.17).OR.(NCOMD.EQ.18)) GO TO 50 IF((NCOMD.EQ.20).OR.(NCOMD.EQ.22)) GO TO 50 IF((NPROJR.EQ.IPROJA).AND.(NPROGR.EQ.IPROGA)) GO TO 50 WRITE(IDLG,35) 35 FORMAT(' YOU ARE NOT AUTHORIZED TO MODIFY THIS BANK'/) GO TO 42 48 CONTINUE WRITE(IDLG,49) INST 49 FORMAT(' INSTRUCTION "',A5,'" DOES NOT EXIST') GO TO 42 C C INSTRUCTION OK NOW CHECK FOR SWITHCES C 50 IF(INPUT(I).EQ.'!') GO TO 42 IF(INPUT(I).EQ.IALT) GO TO 52 IF(INPUT(I).NE.' ') GO TO 60 I=I+1 IF(I.LE.80) GO TO 50 GO TO 54 52 IF(INST.EQ.'SET') GO TO 59 IF(LICVR.NE.0) GO TO 58 NHV=NHVSET DO 90 J=1,NHV IV(1,J)=IVSET(1,J) 90 IV(2,J)=IVSET(2,J) 58 IF(NS.NE.0) GO TO 91 NS=NSSET IF(NS.EQ.0) GO TO 91 DO 92 J=1,NS ISEL(1,J)=ISELST(1,J) ISEL(2,J)=ISELST(2,J) ISEL(3,J)=ISELST(3,J) ISEL(4,J)=ISELST(4,J) 92 ISEL(5,J)=ISELST(5,J) DO 97 J=1,20 DO 97 I=1,20 97 DATC(I,J)=DATCST(I,J) 91 IF(LICOB.NE.0) GO TO 94 IF((NCOMD.GE.8).AND.(NCOMD.LE.11)) GO TO 96 NHO=NHOSET DO 93 J=1,NHO IO(1,J)=IOSET(1,J) 93 IO(2,J)=IOSET(2,J) GO TO 94 96 NHO=1 IO(1,1)=NO+1 IO(2,1)=NO+1 94 IF(LICFMT.EQ.1) GO TO 80 IF(LFMTST.NE.1) GO TO 80 DO 95 J=1,48 95 FORM(J)=FORMST(J) LICFMT=1 80 IF(NHO.LT.2) GO TO 59 DO 81 I=1,NHO-1 DO 82 J=I+1,NHO IF(IO(1,I).LE.IO(1,J)) GO TO 82 DO 83 K=1,2 ISAV=IO(K,I) IO(K,I)=IO(K,J) 83 IO(K,J)=ISAV 82 CONTINUE 81 CONTINUE I=1 84 J=IO(2,I) IF(J.GE.IO(1,I+1)) GO TO 85 I=I+1 IF(I.GE.NHO) GO TO 59 GO TO 84 85 IF(J.GE.IO(2,I+1)) GO TO 86 IO(2,I)=IO(2,I+1) 86 IF(I+1.GE.NHO) GO TO 88 DO 87 J=I+1,NHO-1 DO 87 K=1,2 87 IO(K,J)=IO(K,J+1) 88 NHO=NHO-1 IF(I.GE.NHO) GO TO 59 GO TO 84 59 IWHICH=NCOMD RETURN 53 IWHICH=22 RETURN C C SWITCH HAS BEEN FOUND CHECK WHICH ONE C 60 DO 61 J=1,5 61 NAME(J)=' ' J=1 69 IF(INPUT(I).EQ.' ') GO TO 63 IF(INPUT(I).EQ.':') GO TO 65 IF(J.GT.5) GO TO 62 NAME(J)=INPUT(I) J=J+1 62 I=I+1 IF(I.GT.80) GO TO 63 GO TO 69 63 WRITE(IDLG,64) 64 FORMAT(' SWITCHES MUST BE FOLLOWED BY A :') GO TO 42 65 ENCODE(5,3,SWITCH)(NAME(J),J=1,5) I=I+1 DO 66 J=1,NSWTS IF(SWITCH.EQ.SWT(J)) GO TO 68 66 CONTINUE WRITE(IDLG,67) SWITCH 67 FORMAT(' THE SWITCH "',A5,'" DOES NOT EXIST') GO TO 42 68 IF(ITBL(NCOMD,J).EQ.1) GO TO 72 WRITE(IDLG,70) SWT(J),CMDS(NCOMD) 70 FORMAT('+SWITCH ',A5,' CANNOT BE USED WITH INSTRUCTION ',A5, 1' - SWITCH IGNORED'/) 71 IF((INPUT(I).EQ.' ').OR.(INPUT(I).EQ.IALT)) GO TO 50 I=I+1 IF(I.LE.80) GO TO 71 GO TO 54 72 GO TO (7100,7100,7000,7000,7200,7200,7300,7423,7423,7500, 17500,7700,7700,7600,7800,7800,8000,8000,8200,8200,8300 2,8400,8500,8500)J C C OBSERVATION STRING C 7000 ISW=0 LICOB=1 7017 DO 7001 J=1,6 7001 NAME(J)=' ' J=1 7006 IF((INPUT(I).EQ.' ').OR.(INPUT(I).EQ.',').OR.(INPUT(I).EQ. 1'-').OR.(INPUT(I).EQ.IALT)) GO TO 7007 IF((INPUT(I).GE.'0').AND.(INPUT(I).LE.'9')) GO TO 7004 7002 WRITE(IDLG,7003) 7003 FORMAT(' OBSERVATIONS MAY BE SPECIFIED BY NUMBER ONLY') GO TO 42 7004 IF(J.GE.6) GO TO 7005 NAME(J)=INPUT(I) J=J+1 7005 I=I+1 IF(I.LE.80) GO TO 7006 7007 IF(J.GT.1) GO TO 7011 IF(ISW.EQ.0) GO TO 7009 WRITE(IDLG,7008) 7008 FORMAT(' IN SPECIFYING A RANGE OF OBSERVATIONS NO UPPER BOUND') GO TO 42 7009 IF(INPUT(I+1).EQ.' ') GO TO 50 WRITE(IDLG,7010) 7010 FORMAT(' WHERE AN OBSERVATION NUMBER SHOULD HAVE APPEARED NONE ', 1'DID') GO TO 42 7011 IF(NAME(6).NE.' ') GO TO 7013 DO 7012 J=5,1,-1 7012 NAME(J+1)=NAME(J) NAME(1)=' ' GO TO 7011 7013 ENCODE(6,3,ROOM)(NAME(J),J=1,6) DECODE(6,7014,ROOM) NUMB 7014 FORMAT(I6) IF((NCOMD.LE.11).AND.(NCOMD.GE.8)) GO TO 7041 IF(NUMB.GT.NO) GO TO 7025 IF(NUMB.LT.1) GO TO 7027 GO TO 7040 7041 IF(NUMB.LE.NO) GO TO 7042 7040 IF(ISW.EQ.1) GO TO 7020 NHO=NHO+1 IF(NHO.LE.30) GO TO 7016 WRITE(IDLG,7015) 7015 FORMAT(' NO MORE THAN 30 SELECTIONS FOR OBSERVATIONS') GO TO 42 7016 IO(1,NHO)=NUMB IF(I.GT.80) GO TO 54 IF(INPUT(I).NE.'-') GO TO 7018 I=I+1 ISW=1 GO TO 7017 7018 IF(INPUT(I).NE.',') GO TO 7019 I=I+1 IO(2,NHO)=IO(1,NHO) GO TO 7017 7019 IF(INPUT(I).NE.' ') GO TO 7029 I=I+1 IO(2,NHO)=IO(1,NHO) GO TO 50 7029 IF(INPUT(I).NE.IALT) PAUSE IO(2,NHO)=IO(1,NHO) GO TO 50 C C C 7020 IO(2,NHO)=NUMB IF(IO(1,NHO).LE.IO(2,NHO)) GO TO 7030 ISAV=IO(1,NHO) IO(1,NHO)=IO(2,NHO) IO(2,NHO)=ISAV 7030 IF(I.GT.80) GO TO 54 IF(INPUT(I).NE.'-') GO TO 7022 WRITE(IDLG,7021) 7021 FORMAT(' A SECOND RANGE ATTEMPTED BEFOR FINISHING THE FIRST') GO TO 42 7022 IF(INPUT(I).NE.' ') GO TO 7023 I=I+1 GO TO 50 7023 IF(INPUT(I).NE.',') GO TO 7031 I=I+1 ISW=0 GO TO 7017 7031 IF(INPUT(I).NE.IALT) PAUSE GO TO 50 C C 7025 WRITE(IDLG,7026) NUMB,NO 7026 FORMAT(' OBS. ',I6,' IS TOO LARGE, ONLY ',I6,' OBS. IN BANK') GO TO 42 7027 WRITE(IDLG,7028) NUMB 7028 FORMAT(' OBS. ',I6,' IS ILLEGAL, IT MUST BE A POSITIVE INTEGER') GO TO 42 7042 WRITE(IDLG,7043) NO 7043 FORMAT(' TO CREATE NEW OBSERVATIONS THEY MUST BE GREATER', 1' THAN ',I5) GO TO 42 C C VARIABLES SWITCH C 7100 ISW=0 LICVR=1 7101 DO 7102 J=1,5 7102 NAME(J)=' ' J=1 NUM=0 7103 IF((INPUT(I).EQ.' ').OR.(INPUT(I).EQ.',').OR.(INPUT(I).EQ. 1'-').OR.(INPUT(I).EQ.IALT)) GO TO 7105 IF((INPUT(I).GE.0).AND.(INPUT(I).LE.'9').AND.(J.EQ.1)) NUM=1 IF(J.GT.5) GO TO 7104 NAME(J)=INPUT(I) J=J+1 7104 I=I+1 IF(I.LE.80) GO TO 7103 7105 IF(J.GT.1) GO TO 7109 IF(ISW.EQ.0) GO TO 7107 WRITE(IDLG,7106) 7106 FORMAT(' IN SPECIFYING A RANGE OF VARIABLES NO UPPER BOUND') GO TO 42 7107 IF((I.GT.79).OR.(INPUT(I+1).EQ.' ')) GO TO 50 WRITE(IDLG,7108) 7108 FORMAT(' WHERE A VARIABLE SHOULD HAVE APPEARED NONE DID') GO TO 42 7109 IF(NUM.EQ.0) GO TO 7114 7110 IF(NAME(5).NE.' ') GO TO 7112 DO 7111 J=4,1,-1 7111 NAME(J+1)=NAME(J) NAME(1)=' ' GO TO 7110 7112 ENCODE(5,3,ROOM)(NAME(J),J=1,5) DECODE(5,7113,ROOM) NUMB 7113 FORMAT(I5) IF(NUMB.GT.NV) GO TO 7118 IF(NUMB.LT.1) GO TO 7118 GO TO 7120 7114 IROOM=0 ENCODE(5,3,IROOM)(NAME(J),J=1,5) DO 7115 J=1,NV,6 NUM=IBASE+J/6+1 READ(IBNK#NUM) LV DO 7116 K=1,6 IF(IROOM.NE.NNS(1,K)) GO TO 7116 NUMB=J+K-1 GO TO 7120 7116 CONTINUE 7115 CONTINUE WRITE(IDLG,7117) IROOM 7117 FORMAT(' VARIABLE "',A5,'" DOES NOT EXIST') GO TO 42 7118 WRITE(IDLG,7119) NUMB 7119 FORMAT(' VARIABLE NUMBER ',I5,' DOES NOT EXIST') GO TO 42 7120 IF(ISW.EQ.1) GO TO 7126 NHV=NHV+1 IF(NHV.LE.20) GO TO 7122 WRITE(IDLG,7121) 7121 FORMAT(' NO MORE THAN 20 SELECTIONS FOR VARIABLES') GO TO 42 7122 IV(1,NHV)=NUMB IF(I.GT.80) GO TO 54 IF(INPUT(I).NE.'-') GO TO 7123 I=I+1 ISW=1 GO TO 7101 7123 IF(INPUT(I).NE.',') GO TO 7124 I=I+1 IV(2,NHV)=IV(1,NHV) GO TO 7101 7124 IF(INPUT(I).NE.' ') GO TO 7125 I=I+1 IV(2,NHV)=IV(1,NHV) GO TO 50 7125 IF(INPUT(I).NE.IALT) PAUSE IV(2,NHV)=IV(1,NHV) GO TO 50 C C C 7126 IV(2,NHV)=NUMB IF(IV(1,NHV).LE.IV(2,NHV)) GO TO 7127 ISAV=IV(1,NHV) IV(1,NHV)=IV(2,NHV) IV(2,NHV)=ISAV 7127 IF(I.GT.80) GO TO 54 IF(INPUT(I).NE.'-') GO TO 7129 WRITE(IDLG,7128) 7128 FORMAT(' A SECOND RANGE ATTEMPTED BEFOR FINISHING THE FIRST') GO TO 42 7129 IF(INPUT(I).NE.' ') GO TO 7130 I=I+1 GO TO 50 7130 IF(INPUT(I).NE.',') GO TO 7131 I=I+1 ISW=0 GO TO 7101 7131 IF(INPUT(I).NE.IALT) PAUSE GO TO 50 C C C DEVICE SWITCH C 7200 IF(LICDEV.NE.1) GO TO 7202 WRITE(IDLG,7201) 7201 FORMAT(' 2 DEVICES CANNOT BE USED IN THE SAME INSTRUCTION') GO TO 42 7202 LICDEV=1 DO 7203 J=1,10 7203 NAME(J)=' ' M=1 7204 IF(INPUT(I).EQ.':') GO TO 7206 IF(INPUT(I).EQ.IALT) GO TO 7215 IF(INPUT(I).EQ.' ') GO TO 7215 IF(M.GT.10) GO TO 7205 NAME(M)=INPUT(I) M=M+1 7205 I=I+1 IF(I.LE.80) GO TO 7204 GO TO 7215 7206 IF((M.GT.1).AND.(M.LT.5)) GO TO 7209 7207 WRITE(IDLG,7208) 7208 FORMAT(' ILLEGAL DEVICE') GO TO 42 7209 ENCODE(5,3,DEV) (NAME(J),J=1,5) I=I+1 IF(DEV.EQ.'DSK') GO TO 7210 IF((DEV.GT.'DTA').AND.(DEV.LT.'DTA9')) GO TO 7210 GO TO 50 7210 IF(I.GT.80) GO TO 50 IF(INPUT(I).EQ.' ') GO TO 50 IF(INPUT(I).EQ.IALT) GO TO 50 DO 7211 J=1,10 7211 NAME(J)=' ' M=1 7212 IF(INPUT(I).EQ.IALT) GO TO 7215 IF(INPUT(I).EQ.' ') GO TO 7215 IF(M.GT.10) GO TO 7213 NAME(M)=INPUT(I) M=M+1 7213 I=I+1 IF(I.LE.80) GO TO 7212 7215 ENCODE(10,3,FNAM) (NAME(J),J=1,10) GO TO 50 C C MATCH SWITCH C 7300 DO 7301 J=1,5 7301 NAME(J)=' ' J=1 7302 IF((INPUT(I).EQ.' ').OR.(INPUT(I).EQ.',').OR.(INPUT(I).EQ.IALT)) 1GO TO 7305 IF(J.GT.5) GO TO 7304 NAME(J)=INPUT(I) J=J+1 7304 I=I+1 IF(I.LE.80) GO TO 7302 7305 IF(J.GE.1) GO TO 7309 IF((I.GT.79).OR.(INPUT(I+1).EQ.' ')) GO TO 50 WRITE(IDLG,7108) GO TO 42 7309 IROOM=0 ENCODE(5,3,IROOM)(NAME(J),J=1,5) IF(IROOM.EQ.'OBS') GO TO 7325 DO 7315 J=1,NV,6 NUM=IBASE+J/6+1 READ(IBNK#NUM) LV DO 7316 K=1,6 IF(IROOM.NE.NNS(1,K)) GO TO 7316 NUMB=K+J-1 GO TO 7320 7316 CONTINUE 7315 CONTINUE WRITE(IDLG,7117) IROOM GO TO 42 7325 NUMB=-1 7320 IF(NMATCH.LT.20) GO TO 7319 WRITE(IDLG,7318) 7318 FORMAT(' MAXIMUM OF 20 MATCH VARIABLES PER INSTURCTION') GO TO 42 7319 NMATCH=NMATCH+1 MATCHS(NMATCH)=NUMB IF(INPUT(I).NE.' ') GO TO 7323 GO TO 50 7323 IF(INPUT(I).NE.',') GO TO 7324 I=I+1 GO TO 7300 7324 IF(INPUT(I).NE.IALT) PAUSE GO TO 50 C C SELECTION C 7423 NSELTB=NSELTB+1 7400 ICOND=0 ISL=0 ISG=0 ISE=0 NUM=0 ISNV=0 C C DETERMINE VARIABLE C DO 7401 J=1,5 7401 NAME(J)=' ' J=1 IF((INPUT(I).LE.'9').AND.(INPUT(I).GE.'0')) GO TO 7403 IF((INPUT(I).LE.'Z').AND.(INPUT(I).GE.'A')) GO TO 7409 WRITE(IDLG,7402) 7402 FORMAT(' VARIABLES IN THE SELECT MUST BE SPECIFIED BY NAME', 1' OR NUMBER') GO TO 42 7403 NUM=1 GO TO 7409 7404 I=I+1 IF(I.LE.80) GO TO 7407 7405 WRITE(IDLG,7406) 7406 FORMAT(' IN A SELECT NO CONDITION OCCURED') GO TO 42 7407 IF((INPUT(I).EQ.'=').OR.(INPUT(I).EQ.'<').OR.(INPUT(I).EQ. 1'>')) GO TO 7410 IF((INPUT(I).EQ.' ').OR.(INPUT(I).EQ.IALT)) GO TO 7405 IF(NUM.NE.1) GO TO 7409 IF((INPUT(I).LE.'9').AND.(INPUT(I).GE.'0')) GO TO 7409 WRITE(IDLG,7408) 7408 FORMAT(' A NON-NUMERIC CHARACTER APPEARED IN THE VARIABLE', 1' NUMBER OF A SELECT') GO TO 42 7409 IF(J.GT.5) GO TO 7404 NAME(J)=INPUT(I) J=J+1 GO TO 7404 7410 IF(NUM.EQ.0) GO TO 7413 7411 IF(NAME(5).NE.' ') GO TO 7413 DO 7412 J=4,1,-1 7412 NAME(J+1)=NAME(J) NAME(1)=' ' GO TO 7411 7413 ENCODE(5,3,IROOM)(NAME(J),J=1,5) IF(NUM.EQ.0) GO TO 7419 DECODE(5,7414,IROOM)NUMB 7414 FORMAT(I5) IF(NUMB.LE.NV) GO TO 7416 WRITE(IDLG,7415) 7415 FORMAT(' VARIABLE NUMBER IN SELECT NOT POSSIBLE FOR THIS BANK') GO TO 42 7416 IF(NUMB.GT.0) GO TO 7418 WRITE(IDLG,7417) 7417 FORMAT(' VARIABLE NUMBER IN SELECT MUST BE POSITIVE INTEGER') 7418 IONE=(NUMB-1)/6 NUM=IBASE+IONE+1 IONE=NUMB-IONE*6 READ(IBNK#NUM) LV MODE=NNS(10,IONE) GO TO 7430 7419 DO 7420 J=1,NV,6 NUM=IBASE+J/6+1 READ(IBNK#NUM) LV DO 7421 K=1,6 IF(IROOM.NE.NNS(1,K)) GO TO 7421 NUMB=J+K-1 MODE=NNS(10,K) GO TO 7430 7421 CONTINUE 7420 CONTINUE WRITE(IDLG,7422) IROOM 7422 FORMAT(' VARIABLE "',A5,'" DOES NOT EXIST IN THIS BANK') GO TO 42 C C NOW CONSIDER CONDITION C 7430 IF(INPUT(I).NE.'<') GO TO 7433 IF(ISL.EQ.0) GO TO 7432 WRITE(IDLG,7431) 7431 FORMAT(' IN A SELECT, < WAS USED TWICE') GO TO 42 7432 ISL=2 GO TO 7439 7433 IF(INPUT(I).NE.'>') GO TO 7436 IF(ISG.EQ.0) GO TO 7435 WRITE(IDLG,7434) 7434 FORMAT(' IN A SELECT, > WAS USED TWICE') GO TO 42 7435 ISG=4 GO TO 7439 7436 IF(INPUT(I).NE.'=') GO TO 7441 IF(ISE.EQ.0) GO TO 7438 WRITE(IDLG,7437) 7437 FORMAT(' IN A SELECT, = WAS USED TWICE') GO TO 42 7438 ISE=1 7439 I=I+1 IF(I.LE.80) GO TO 7430 WRITE(IDLG,7440) 7440 FORMAT(' NOTHING TO BE COMPARED AGAINST IN A SELECT') GO TO 42 7441 ICOND=ISE+ISG+ISL IF(ICOND.EQ.0) PAUSE C C NOW THE THING TO BE COMPARED AGAINST C 7463 IF((INPUT(I).EQ.'M').AND.(INPUT(I+1).EQ.'I').AND.(INPUT(I+2). 1EQ.'S').AND.(INPUT(I+3).EQ.'S')) GO TO 7459 ICON=0 DO 7442 J=1,15 7442 NAME(J)=' ' J=1 IF(MODE.NE.1) GO TO 7445 IF(INPUT(I).EQ.1H') GO TO 7449 7443 WRITE(IDLG,7444) 7444 FORMAT(' IN A SELECT, THE ALPHA VALUE WAS NOT ENCOLSED IN ', 1'QUOTES') GO TO 42 7445 IF(INPUT(I).EQ.IALT) GO TO 7450 IF(MODE.EQ.1) GO TO 7447 IF(INPUT(I).EQ.',')GO TO 7450 IF(INPUT(I).EQ.';') GO TO 7450 IF(INPUT(I).EQ.' ') GO TO 7450 IF(INPUT(I).EQ.'.') GO TO 7448 IF(INPUT(I).EQ.'E') GO TO 7448 IF((INPUT(I).EQ.'-').AND.((J.EQ.1).OR.(INPUT(I-1).EQ.'E'))) 1 GO TO 7448 IF((INPUT(I).LE.'9').AND.(INPUT(I).GE.'0')) GO TO 7448 IF(INPUT(I-1).EQ.',') WRITE(IDLG,7472) 7472 FORMAT(' USE A COMMA TO SEPARATE "OR" VALUES AND A SEMICOLON'/ 1' TO SEPARATE "OR" SELECTS') IF(INPUT(I-1).NE.',') WRITE(IDLG,7446) 7446 FORMAT(' NON-NUMERIC CHARACTER IN VALUE TO BE COMPARED') GO TO 42 7447 IF(INPUT(I).NE.1H') GO TO 7448 I=I+1 GO TO 7453 7448 IF(J.GT.15) GO TO 7449 NAME(J)=INPUT(I) J=J+1 7449 I=I+1 IF(I.LE.80) GO TO 7445 WRITE(IDLG,7444) GO TO 42 7450 IF(MODE.EQ.1) GO TO 7443 7451 IF(NAME(15).NE.' ') GO TO 7453 DO 7452 J=14,1,-1 7452 NAME(J+1)=NAME(J) NAME(1)=' ' GO TO 7451 7453 ENCODE(15,3,ROOM) NAME IF(MODE.EQ.1) GO TO 7457 IF(MODE.EQ.2) GO TO 7455 DECODE(15,7454,ROOM) ICON 7454 FORMAT(F15.0) GO TO 7458 7455 DECODE(15,7456,ROOM) ICON 7456 FORMAT(I15) GO TO 7458 7457 ICON=IROOM GO TO 7458 7459 ICON=MISS IF((ICOND.EQ.1).OR.(ICOND.EQ.6)) GO TO 7461 WRITE(IDLG,7462) 7462 FORMAT(' MISSING MAY ONLY BE USED TO SELECT WHEN THE CONDITION'/ 1' IS EQUAL OR NOT EQUAL') GO TO 42 7461 I=I+4 7460 IF(I.GT.80) GO TO 7458 IF(INPUT(I).EQ.IALT) GO TO 7458 IF(INPUT(I).EQ.' ') GO TO 7458 IF(INPUT(I).EQ.',') GO TO 7458 IF(INPUT(I).EQ.';') GO TO 7458 I=I+1 GO TO 7460 7458 IF(ISNV.EQ.0)NS=NS+1 ISEL(1,NS)=NSELTB ISEL(2,NS)=NUMB ISEL(3,NS)=ICOND ISEL(4,NS)=1 IF(ISNV.EQ.0) ISEL(5,NS)=0 ISEL(5,NS)=ISEL(5,NS)+1 IF(ISEL(5,NS).LE.20) GO TO 7474 WRITE(IDLG,7473) 7473 FORMAT(' NO MORE THAN 20 VALUES IN A COMPARISON TO MULTIPLE', 1' VALUES') GO TO 42 7474 DATC(NS,ISEL(5,NS))=CON ISNV=1 IF(INPUT(I).NE.',') GO TO 7470 I=I+1 IF(ICOND.EQ.1) GO TO 7463 WRITE(IDLG,7471) 7471 FORMAT(' COMPARRISON TO MULTIPLE VALUES MUST BE WITH AN =', 1' CONDITION') GO TO 42 7470 IF(INPUT(I).NE.';') GO TO 50 I=I+1 GO TO 7400 C C C 7500 IF(LICFMT.NE.1) GO TO 7502 WRITE(IDLG,7501) 7501 FORMAT(' ONLY 1 FORMAT PER INSTRUCTION') GO TO 42 7502 LICFMT=1 M=0 KOUNT=0 ISW=0 DO 7514 J=1,48 7514 FORM(J)=' ' IF(INPUT(I).EQ.'(') GO TO 7504 WRITE(IDLG,7503) 7503 FORMAT(' FORMAT MUST BE ENCLOSED IN PARENTHESIS') GO TO 42 7504 DO 7505 J=1,5 7505 NAME(J)=' ' J=1 7515 IF(INPUT(I).EQ.IALT) GO TO 7520 IF(ISW.EQ.1) GO TO 7508 IF(INPUT(I).EQ.' ') GO TO 7513 IF(INPUT(I).EQ.'(') KOUNT=KOUNT+1 IF(INPUT(I).NE.')') GO TO 7508 KOUNT=KOUNT-1 IF(KOUNT.GT.0) GO TO 7508 M=M+1 IF(M.LE.48) GO TO 7507 WRITE(IDLG,7506) 7506 FORMAT(' NO MORE THAN 240 CHARACTERS IN THE FORMAT') GO TO 42 7507 NAME(J)=')' ENCODE(5,3,FORM(M))(NAME(J),J=1,5) I=I+1 GO TO 50 7508 IF(INPUT(I).NE.1H') GO TO 7510 IF(ISW.EQ.1) GO TO 7509 ISW=1 GO TO 7510 7509 ISW=0 7510 NAME(J)=INPUT(I) J=J+1 IF(J.LE.5) GO TO 7513 M=M+1 IF(M.LE.48) GO TO 7511 WRITE(IDLG,7506) GO TO 42 7511 ENCODE(5,3,FORM(M)) (NAME(J),J=1,5) DO 7512 J=1,5 7512 NAME(J)=' ' J=1 7513 I=I+1 IF(I.LE.80) GO TO 7515 IF(IOUTOF.EQ.1) GO TO 7516 WRITE(IDLG,57) CALL GES(INPUT,80,ICHECK) IF(ICHECK.EQ.2) GO TO 9999 GO TO 7518 7516 READ(MPROG,3,END=9950) INPUT 7518 I=1 GO TO 7515 7520 IF(ISW.EQ.1) GO TO 7522 WRITE(IDLG,7503) GO TO 42 7522 WRITE(IDLG,7523) 7523 FORMAT(' UNTERMINATED HOLERITH STRING') GO TO 42 C C BANK SWITCH C 7600 IF(BNKU(1).EQ.0) GO TO 7638 WRITE(IDLG,7637) 7637 FORMAT(' ONLY ONE BANK SWITCH PER INSTRUCTION') GO TO 42 7638 DO 7601 J=1,15 7601 NAME(J)=' ' J=1 7602 IF((INPUT(I).EQ.' ').OR.(INPUT(I).EQ.'.').OR.(INPUT(I).EQ.IALT). 1OR.(INPUT(I).EQ.IBRKL)) GO TO 7605 IF(J.GT.6) GO TO 7603 NAME(J)=INPUT(I) J=J+1 I=I+1 IF(I.LE.80) GO TO 7602 GO TO 7605 7603 WRITE(IDLG,7604) 7604 FORMAT(' 6 CHARACTERS MAXIMUM FOR A NAME OF BANK') GO TO 42 7605 IF(J.GT.1) GO TO 7607 WRITE(IDLG,7606) 7606 FORMAT(' WHERE A BANK SHOULD HAVE BEEN SPECIFIED NONE WAS') GO TO 42 7607 IF(INPUT(I).NE.'.') GO TO 7611 IF((INPUT(I+1).EQ.'B').AND.(INPUT(I+2).EQ.'N').AND. 1(INPUT(I+3).EQ.'K')) GO TO 7609 WRITE(IDLG,7608) 7608 FORMAT(' IF SPECIFIED, EXTENSION MUST BE .BNK') GO TO 42 7609 I=I+4 IF((INPUT(I).EQ.IBRKL).OR.(INPUT(I).EQ.' ').OR. 1(INPUT(I).EQ.IALT)) GO TO 7611 WRITE(IDLG,7610) 7610 FORMAT(' MAXIMUM OF 3 CHARACTERS FOR THE EXTENSION') GO TO 42 7611 NAME(J)='.' NAME(J+1)='B' NAME(J+2)='N' NAME(J+3)='K' ENCODE(10,3,BNKU)(NAME(J),J=1,10) IF((INPUT(I).EQ.IALT).OR.(INPUT(I).EQ.' ')) GO TO 7640 C PROJECT PROGRAMMER NUMBER DO 7612 J=1,15 7612 NAME(J)=' ' J=1 I=I+1 7613 IF(INPUT(I).EQ.',') GO TO 7621 IF(INPUT(I).NE.IBRKR) GO TO 7615 WRITE(IDLG,7614) 7614 FORMAT(' THERE MUST BE A , SEPARATING PROJECT AND PROGRAMMER NO.') GO TO 42 7615 IF((INPUT(I).LE.'7').AND.(INPUT(I).GE.'0')) GO TO 7617 WRITE(IDLG,7616) INPUT(I) 7616 FORMAT(' CHARACTER "',A1,'" IS ILLEGAL FOR PROJ PROG. NUMBER') GO TO 42 7617 IF(J.GT.6) GO TO 7619 NAME(J)=INPUT(I) J=J+1 I=I+1 IF(I.LE.80) GO TO 7613 WRITE(IDLG,7618) 7618 FORMAT(' INCOMPLETE PROJECT PROGRAMMER NUMBER') GO TO 42 7619 WRITE(IDLG,7620) 7620 FORMAT(' PROJECT NUMBER LARGER THAN POSSIBLE') GO TO 42 7621 IF(J.GT.1) GO TO 7623 WRITE(IDLG,7622) 7622 FORMAT(' ILLEGAL PROJECT NUMBER') GO TO 42 7623 IF(NAME(6).NE.' ') GO TO 7624 DO 7639 J=5,1,-1 7639 NAME(J+1)=NAME(J) NAME(1)=' ' GO TO 7623 7624 ENCODE(15,3,ROOM) NAME DECODE(6,7625,ROOM) IPJU 7625 FORMAT(O6) DO 7626 J=1,6 7626 NAME(J)=' ' J=1 I=I+1 7628 IF(INPUT(I).EQ.IBRKR) GO TO 7632 IF((INPUT(I).LE.'7').AND.(INPUT(I).GE.'0')) GO TO 7629 WRITE(IDLG,7616) INPUT(I) GO TO 42 7629 IF(J.GT.6) GO TO 7630 NAME(J)=INPUT(I) J=J+1 I=I+1 IF(I.LE.80) GO TO 7628 WRITE(IDLG,7618) GO TO 42 7630 WRITE(IDLG,7631) 7631 FORMAT(' PROGRAMMER NUMBER LARGER THAN POSSIBLE') GO TO 42 7632 IF(J.GT.1) GO TO 7634 WRITE(IDLG,7633) 7633 FORMAT(' ILLEGAL PROGRAMMER NUMBER') GO TO 42 7634 IF(NAME(6).NE.' ') GO TO 7641 DO 7635 J=5,1,-1 7635 NAME(J+1)=NAME(J) NAME(1)=' ' GO TO 7634 7641 ENCODE(15,3,ROOM) NAME DECODE(6,7625,ROOM) IPGU I=I+1 7640 CALL EXIST (BNKU,IERR,IPJU,IPGU) IF(IERR.EQ.0) GO TO 50 WRITE(IDLG,7636) 7636 FORMAT(' BANK SPECIFIED NOT AVAILABLE') GO TO 42 C C C 7700 IF(LICCON.NE.1) GO TO 7708 WRITE(IDLG,7709) 7709 FORMAT(' ONLY 1 CONSTANT SWITCH PER INSTRUCTION') GO TO 42 7708 LICCON=1 CNVAL=0 ICNVAL=0 NUMCNS=0 IDP=0 IF((INPUT(I).EQ.'M').AND.(INPUT(I+1).EQ.'I').AND.(INPUT(I+2). 1EQ.'S').AND.(INPUT(I+3).EQ.'S')) GO TO 7724 DO 7701 J=1,15 7701 NAME(J)=' ' J=1 IF(INPUT(I).EQ.1H') GO TO 7720 7702 IF((INPUT(I).LE.'9').AND.(INPUT(I).GE.'0')) GO TO 7704 IF(INPUT(I).EQ.' ') GO TO 7706 IF((INPUT(I).EQ.'-').AND.(J.EQ.1)) GO TO 7704 IF(INPUT(I).EQ.IALT) GO TO 7706 IF(INPUT(I).EQ.'.') GO TO 7710 7723 WRITE(IDLG,7703) 7703 FORMAT(' ALPHA CONSTANTS MUST BE ENCLOSED IN QUOTES') GO TO 42 7710 IF(IDP.EQ.0) GO TO 7712 WRITE(IDLG,7711) 7711 FORMAT(' CONSTANT SPECIFIED HAS TWO DECIMLE POINTS') GO TO 42 7712 IDP=1 7704 IF(J.GT.15) GO TO 7705 NAME(J)=INPUT(I) J=J+1 7705 I=I+1 IF(I.LE.80) GO TO 7702 7706 IF(J.GT.1) GO TO 7713 WRITE(IDLG,7707) 7707 FORMAT(' CONSTANT SWITCH MUST BE FOLLOWED BY A CONSTANT') GO TO 42 7713 IF(NAME(15).NE.' ') GO TO 7715 DO 7714 J=14,1,-1 7714 NAME(J+1)=NAME(J) NAME(1)=' ' GO TO 7713 7715 ENCODE(15,3,ROOM) NAME DECODE(15,7716,ROOM) CNVAL 7716 FORMAT(F15.0) IF(IDP.EQ.1) GO TO 7718 DECODE(15,7717,ROOM) ICNVAL 7717 FORMAT(I15) GO TO 50 7718 ICNVAL=CNVAL GO TO 50 7720 I=I+1 IF(I.GT.80) GO TO 7723 IF(INPUT(I).EQ.1H') GO TO 7722 IF(INPUT(I).EQ.IALT) GO TO 7723 IF(J.GT.5) GO TO 7720 NAME(J)=INPUT(I) J=J+1 GO TO 7720 7722 ENCODE(5,3,CNVAL)(NAME(J),J=1,5) IF(INPUT(I).EQ.1H') I=I+1 NUMCNS=1 GO TO 50 7724 CNVAL=AMISS ICNVAL=MISS NUMCNS=5 I=I+4 7725 IF(I.GT.80) GO TO 50 IF(INPUT(I).EQ.IALT) GO TO 50 IF(INPUT(I).EQ.' ') GO TO 50 I=I+1 GO TO 7725 7800 LICIN=1 GO TO 50 7900 WRITE(IDLG,9000) SWT(J) GO TO 42 C C ID SWITCH C 8000 LICID=1 GO TO 50 C C MAJOR TO MINOR SWITCH C 8200 DO 8202 J=1,5 8202 NAME(J)=' ' J=1 NUM=0 8203 IF((INPUT(I).EQ.' ').OR.(INPUT(I).EQ.',').OR.(INPUT(I).EQ.IALT)) 1 GO TO 8205 IF(INPUT(I).NE.'-') GO TO 8226 WRITE(IDLG,8225) 8225 FORMAT(' RANGES ARE ILLEGAL IN A MAJOR TO MINOR SWITCH') GO TO 42 8226 IF((INPUT(I).GE.'0').AND.(INPUT(I).LE.'9').AND.(J.EQ.1)) NUM=1 IF(J.GT.5) GO TO 8204 NAME(J)=INPUT(I) J=J+1 8204 I=I+1 IF(I.LE.80) GO TO 8203 8205 IF(J.GT.1) GO TO 8209 IF((I.GT.79).OR.(INPUT(I+1)).EQ.' ') GO TO 50 WRITE(IDLG,7108) GO TO 42 8209 IF(NUM.EQ.0) GO TO 8214 DO 8227 J=1,5 IF(NAME(J).EQ.' ') GO TO 8227 IF((NAME(J).LE.'9').AND.(NAME(J).GE.'0')) GO TO 8227 WRITE(IDLG,8228) 8228 FORMAT(' ILLEGAL NAME OR MISSING COMMA IN AN MTM SWITCH') GO TO 42 8227 CONTINUE 8210 IF(NAME(5).NE.' ') GO TO 8212 DO 8211 J=4,1,-1 8211 NAME(J+1)=NAME(J) NAME(1)=' ' GO TO 8210 8212 ENCODE(5,3,ROOM) (NAME(J),J=1,5) DECODE(5,7113,ROOM) NUMB IF(NUMB.GT.NV) GO TO 7118 IF(NUMB.LT.1) GO TO 7118 GO TO 8220 8214 IROOM=0 ENCODE(5,3,IROOM)(NAME(J),J=1,5) DO 8215 J=1,NV,6 NUM=IBASE+J/6+1 READ(IBNK#NUM) LV DO 8216 K=1,6 IF(IROOM.NE.NNS(1,K)) GO TO 8216 NUMB=J+K-1 GO TO 8220 8216 CONTINUE 8215 CONTINUE WRITE(IDLG,7117) IROOM GO TO 42 8220 IF(NMTM.LT.20) GO TO 8219 WRITE(IDLG,8218) 8218 FORMAT(' MAXIMUM OF 20 MAJOR-TO-MINOR VARIABLSE PER INSTRUCTION') GO TO 42 8219 NMTM=NMTM+1 8222 IVARSQ(NMTM)=NUMB IF(INPUT(I).NE.' ') GO TO 8223 GO TO 50 8223 IF(INPUT(I).NE.',') GO TO 8224 I=I+1 GO TO 8200 8224 IF(INPUT(I).NE.IALT) PAUSE GO TO 50 8300 LICWO=1 GO TO 50 C C BELLS SWITCH C 8400 IF((INPUT(I).LE.'9').AND.(INPUT(I).GE.'0')) GO TO 8402 8403 WRITE(IDLG,8401) INPUT(I) 8401 FORMAT(1X,'"',A1,'" IS AN ILLEGAL CHARACTER FOR NUMBER OF BELLS') GO TO 42 8402 NAME(1)=INPUT(I) I=I+1 IF(INPUT(I).EQ.' ') GO TO 8406 IF(INPUT(I).EQ.IALT) GO TO 8406 IF((INPUT(I).GT.'9').OR.(INPUT(I).LT.'0')) GO TO 8403 NAME(2)=INPUT(I) I=I+1 IF(INPUT(I).EQ.IALT) GO TO 8407 IF(INPUT(I).EQ.' ') GO TO 8407 WRITE(IDLG,8405) 8405 FORMAT(' MAXIMUM OF 2 DIGIT NUMBER FOR BELLS') GO TO 42 8406 NAME(2)=NAME(1) NAME(1)=' ' 8407 ENCODE(2,3,ROOM) NAME(1),NAME(2) DECODE(2,8408,ROOM) LBELL 8408 FORMAT(I2) GO TO 50 C C REFERENCE SWITCH C 8500 DO 8501 J=1,5 8501 NAME(J)=' ' J=1 NUM=0 8503 IF((INPUT(I).EQ.' ').OR.(INPUT(I).EQ.',').OR.(INPUT(I).EQ.IALT)) 1GO TO 8505 IF((INPUT(I).GE.'0').AND.(INPUT(I).LE.'9').AND.(J.EQ.1)) NUM=1 IF(J.GT.5) GO TO 8504 NAME(J)=INPUT(I) J=J+1 8504 I=I+1 IF(I.LE.80) GO TO 8503 8505 IF(J.GT.1) GO TO 8509 IF((I.GT.79).OR.(INPUT(I+1)).EQ.' ') GO TO 50 WRITE(IDLG,7108) GO TO 42 8509 IF(NUM.EQ.0) GO TO 8514 8510 IF(NAME(5).NE.' ') GO TO 8512 DO 8511 J=4,1,-1 8511 NAME(J+1)=NAME(J) NAME(1)=' ' GO TO 8510 8512 ENCODE(5,3,ROOM) (NAME(J),J=1,5) DECODE(5,7113,ROOM) NUMB IF(NUMB.GT.NV) GO TO 7118 IF(NUMB.LT.1) GO TO 7118 NUM=(K+5)/6+IBASE IONE=K-((K-1)/6)*6 READ(IBNK#NUM) LV IROOM=NNS(1,IONE) MODERF=NNS(10,IONE) GO TO 8520 8514 IROOM=0 ENCODE(5,3,IROOM)(NAME(J),J=1,5) DO 8515 J=1,NV,6 NUM=IBASE+J/6+1 READ(IBNK#NUM) LV DO 8516 K=1,6 IF(IROOM.NE.NNS(1,K)) GO TO 8516 MODERF=NNS(10,K) NUMB=J+K-1 GO TO 8520 8516 CONTINUE 8515 CONTINUE WRITE(IDLG,7117) IROOM GO TO 42 8520 IF(NREF.LT.2) GO TO 8519 WRITE(IDLG,8518) 8518 FORMAT(' MAXIMUM OF 2 REFERENCES PER INSTRUCTION') GO TO 42 8519 NREF=NREF+1 IREF(NREF)=NUMB NAMREF(NREF)=IROOM MODREF(NREF)=MODERF IF(INPUT(I).EQ.' ') GO TO 50 IF(INPUT(I).EQ.IALT) GO TO 50 IF(INPUT(I).NE.',') PAUSE I=I+1 GO TO 8500 9000 FORMAT(' SWITCH "',A5,'" IS UNAVAILABLE FOR USE AT THIS TIME') C C EXIT FROM BANK INTO PROGRAM SPECIFIED C 9800 DO 9801 J=1,5 9801 NAME(J)=' ' J=1 9802 I=I+1 IF(I.LE.6) GO TO 9803 9807 WRITE(IDLG,9804) 9804 FORMAT(' PROGRAM NOT AVAILABLE FOR BANK') GO TO 42 9803 IF(INPUT(I).EQ.' ') GO TO 9805 IF(INPUT(I).EQ.IALT) GO TO 9805 NAME(J)=INPUT(I) J=J+1 GO TO 9802 9805 IF(J.EQ.1) GO TO 9807 ENCODE(5,3,ROOM)(NAME(J),J=1,5) DO 9806 M=1,30 IF(ROOM(1).EQ.PRGRUN(M)) GO TO 9808 9806 CONTINUE GO TO 9807 9808 IWHICH=23 RUNUO=ROOM(1) RETURN C C RUN INSTRUCTION C 9900 IOUTOF=1 CMDPG=CMDDFT IF((INPUT(2).EQ.' ').OR.(INPUT(2).EQ.IALT)) GO TO 9940 DO 9904 J=1,10 9904 NAME(J)=' ' J=1 I=2 9901 IF(INPUT(I).EQ.' ') GO TO 9903 IF(INPUT(I).EQ.IALT) GO TO 9903 IF(INPUT(I).EQ.IBRKL) GO TO 9903 IF(J.GT.10) GO TO 9902 NAME(J)=INPUT(I) J=J+1 9902 I=I+1 IF(I.LE.80) GO TO 9901 9903 ENCODE(10,3,CMDPG) (NAME(J),J=1,10) IF(INPUT(I).NE.IBRKL) GO TO 9940 C C C 9940 CALL EXIST(CMDPG,IERR,0,0) IF(IERR.EQ.0) GO TO 9942 WRITE(IDLG,9941) 9941 FORMAT(' NO PROGRAM EXISTS') IOUTOF=0 GO TO 42 9942 OPEN(UNIT=MPROG,DEVICE='DSK',FILE=CMDPG,ACCESS='SEQIN') GO TO 42 9950 CALL RELEAS(MPROG) IOUTOF=0 GO TO 42 9999 CALL RELEAS(IBNK) IWHICH=99 RETURN C C TRANSFORMATION PART C 1000 IF((NPROJR.EQ.IPROJA).AND.(NPROGR.EQ.IPROGA)) GO TO 1007 WRITE(IDLG,35) GO TO 42 1007 INST='TRANS' ITYPES(1)='(' ITYPES(2)=')' ITYPES(3)=',' ITYPES(4)='=' ITYPES(5)='+' ITYPES(6)='-' ITYPES(7)='/' ITYPES(8)='*' ITYPES(9)=' ' L=1 I=1 IPAR=0 CALL COMPD(INPUT,I,ROOM,IDEF,ITYPES) IF(IDEF.NE.4) GO TO 1002 IF(IROOM.EQ.'OBS') GO TO 1008 IF(IROOM.EQ.'HELP') GO TO 1008 IF(IROOM.EQ.'STOP') GO TO 1008 IF(IROOM.EQ.'ALL') GO TO 1008 IF(IROOM.EQ.'EMPTY') GO TO 1008 CALL VARB(IROOM,IERR,ITV,NV,IBASE) IF(ITV.LT.0) GO TO 1002 IF(IERR.NE.0) GO TO 1001 ITO(1)=ITV GO TO 1004 1001 IF((IERR.NE.1).AND.(IERR.NE.3)) GO TO 1002 ITO(1)=NV+1 DO 1094 K=1,5 1094 NAME(K)=' ' ENCODE(5,1093,INSTR(1)) ITO(1) 1093 FORMAT(I5) DECODE(5,3,INSTR(1))(NAME(K),K=1,5) NAME(1)='B' 1096 IF(NAME(2).NE.' ') GO TO 1097 DO 1095 K=3,5 1095 NAME(K-1)=NAME(K) NAME(5)=' ' GO TO 1096 1097 ENCODE(5,3,INSTR(1))(NAME(K),K=1,5) IF(IERR.EQ.3) GO TO 1004 INSTR(1)=IROOM GO TO 1004 1002 WRITE(IDLG,1003) 1003 FORMAT(' A TRANSFORMATION MUST HAVE A FORTRAN FORM') GO TO 42 1008 WRITE(IDLG,1009) IROOM 1009 FORMAT(' "',A5,'" IS A RESERVED NAME - CANNOT BE CREATED') GO TO 42 1004 M=I 1005 M=M+1 IF(M.GT.80) GO TO 1006 IF(INPUT(M).EQ.IALT) GO TO 1006 IF(INPUT(M).NE.' ') GO TO 1005 1006 K=2 CALL CALC(INPUT,I,M,K,L,INSTR,IVAR1,IVAR2,ITO,CONST,SV,NV,IBASE, 1IERR,ITYPES) IF(IERR.EQ.0) GO TO 1080 1010 GO TO (1011,1012,1013,1014,1015,1016,1017,1018,1019,1020, 11021,1022,1023,1024,1025,1026,1027,1028,1029,1030)IERR 1011 WRITE(IDLG,1051) 1051 FORMAT(' UNBALANCED PARENTHESIS') GOTO 42 1012 WRITE(IDLG,1052) 1052 FORMAT(' PARENTHESIS DO NOT ENCLOSE ANYTHING') GO TO 42 1013 WRITE(IDLG,1053) 1053 FORMAT(' POWER IS NOT A CONSTANT OR VARIABLE') GO TO 42 1014 WRITE(IDLG,1054) 1054 FORMAT(' ONE OF THE VARIABLES USED DOES NOT EXIST') GOTO 42 1015 WRITE(IDLG,1055) 1055 FORMAT(' #MUST BE FOLLOWED BY A VARIABLE NUMBER') GO TO 42 1016 WRITE(IDLG,1056) 1056 FORMAT(' ONE OF THE VARIBALE NUMBERS USED DOES NOT EXIST') GO TO 42 1017 WRITE(IDLG,1057) 1057 FORMAT(' TWO INSTRUCTIONS NOT SEPARATED BY A VARIABLE') GO TO 42 1018 WRITE(IDLG,1058) 1058 FORMAT(' ATTEMPT TO DIVIDE BY THE CONSTANT ZERO') GOTO 42 1019 WRITE(IDLG,1059) 1059 FORMAT(' INSTRUCTION TOO LONG') GO TO 42 1020 WRITE(IDLG,1060)IERR 1060 FORMAT(' SYS PROB ',I2,'-CONTACT DICK HOUCHARD') GO TO 42 1021 WRITE(IDLG,1060)IERR GOTO 42 1022 WRITE(IDLG,1060) IERR GO TO 42 1023 WRITE(IDLG,1063) 1063 FORMAT(' TWO EXPRESSIONS NOT SEPARATED BY AN OPERATION') GO TO 42 1024 WRITE(IDLG,1064) 1064 FORMAT(' "," IS NOT A LEGAL OPERATION') GO TO 42 1025 WRITE(IDLG,1065) 1065 FORMAT(' "=" MAY NOT BE USED TWICE IN AN INSTRUCTION') GO TO 42 1026 WRITE(IDLG,1060) IERR GO TO 42 1027 WRITE(IDLG,1063) GO TO 42 1028 WRITE(IDLG,1068) 1068 FORMAT(' ILLEGAL OR MISSPELLED FUNCTION') GOTO 42 1029 WRITE(IDLG,1069) 1069 FORMAT(' ATTEMPT TO TAKE MEAN OR STD. DEV. OF A CONSTANT') GO TO 42 1030 WRITE(IDLG,1070) 1070 FORMAT(' ILLEGAL CHARACTER IN VARIABLE') GO TO 42 1080 CALL COMPD(INPUT,I,ROOM,IDEF,ITYPES) I=I-1 IF((IDEF.NE.9).AND.(IDEF.NE.19)) PAUSE 'OOPS' INSTR(K)=9 IF(IDEF.EQ.19) GOTO 1081 CALL VARB(IROOM,IERR,ITV,NV,IBASE) IF(IERR.NE.0) IERR=IERR+3 IF(IERR.NE.0) GO TO 1010 ITO(K)=ITV NCOMD=21 GO TO 50 1081 ITO(K)=0 CONST(K)=ROOM(1) NCOMD=21 GO TO 50 2010 IHLP=IDLG IF(INST.EQ.'HELP') GO TO 2000 DO 2011 I=6,10 IF(INPUT(I).EQ.')') GO TO 2012 2011 CONTINUE GO TO 2014 2012 DO 2013 J=I,10 2013 INPUT(J)=' ' 2014 ENCODE(5,3,INST)(INPUT(J),J=6,10) IF(INST.EQ.'TABLE') GO TO 2020 IF(INST.EQ.'ALL') GO TO 2020 IF(INST.EQ.'=') GO TO 2073 IF(INST.EQ.'LPT') GO TO 2023 DO 2015 J=1,NCMDS IF(INST.EQ.CMDS(J)) GO TO 2018 2015 CONTINUE DO 2016 J=1,NSWTS IF(SINST.EQ.SWT(J)) GO TO 2019 2016 CONTINUE WRITE(IDLG,2017) 2017 FORMAT(' WITHIN THE PARENTHESIS INDICATE WHICH COMMAND') GO TO 42 2018 GO TO (2040,2040,2040,2043,2043,2043,2046,2049,2049,2049,2049, 12052,2055,2058,2058,2058,2061,2064,2067,2070)J 2019 GO TO (2101,2101,2104,2104,2107,2107,2110,2113,2113,2116, 12116,2119,2119,2122,2125,2125,2128,2128,2130,2130) J 2023 IHLP=21 INST='ALL' CALL OFILE(IHLP,'HELP') 2000 WRITE(IHLP,2001) 2001 FORMAT('0COMMANDS AVAILABLE:'/ 1'0 REPLACE'/ 2' MODIFY - CHANGE VALUES FOR PARTICULAR DATA POINTS'/ 3' CHANGE'/ 4'0 FORGET'/ 5' DELETE - DELETE OBSERVATIONS OR VARIABLES FROM BANK'/ 6' DEL'/ 7'0 BACKUP - CREATE A BACKUP OF THE BANK (SAME NAME .BAK)'/ 8'0 CREATE'/ 9' MAKE - ADD OBSERVATIONS TO BANK'/ 1' ADD'/ 2' MA'/ 3'0 OUTPUT - MAKE ASCII FILE OF DATA IN BANK'/ 4'0 MERGE - MERGE TWO BANKS TOGETHER'/ 5'0 PRINT'/ 6' LIST - AUTOMATICALLY PRINT DATA OR INFO. ON LPT'/ 7' Q'/ 8'0 STDES - SINGLE VARIABLE STATISTICS (AUTO. OUTPUT ON LPT)'/ 9'0 TYPE - TYPE DATA OR INFO ON TERMINAL'/ 1'0 SORT - SORT BANK INTO ASCENDING ORDER') WRITE(IHLP,2002) 2002 FORMAT( 1'0 SET - ALLOWS USER TO MODIFY ASSUMPTIONS ABOUT SWITCHES'/ 1'0 = - TRANSFORMATION INCLUDES CREATING NEW VARIABLES'/ 2' (FORTRAN ARITHMETIC STATEMENTS)'/ 3'0THE QUESTION MARK INDICATES THAT AN INSTRUCTION IS'/ 4' EXPECTED. AN INSTRUCTION MAY BE JUST A COMMAND, OR'/ 5' A COMMAND AND SWITCHES. THE COMMAND MUST BE THE FIRST'/ 6' ENTRY OF THE INSTRUCTION. AN INSTRUCTION MAY BE MORE'/ 7' THAN 1 LINE LONG, AND MAY CONTAIN MANY SWITCHES, HOWEVER,'/ 8' ONLY ONE COMMAND MAY BE GIVEN FOR EACH INSTRUCTION.'/ 9' TO END AN INSTRUCTION AND BEGIN EXECUTION OF THE'/ 1' INSTRUCTION, TYPE AN ALTMODE (ESC).'/ 2'0A NEW BANK MAY BE SPECIFIED BY TYPING A CONTROL Z (^Z).'/ 3' TO EXIT FROM THE PROGRAM TYPE A CONTROL Z (^Z) WHEN ASKED'/ 4' TO SPECIFY THE NEW BANK. THE CORRECT EXITING PROCEDURE'/ 5' MUST BE USED TO ENSURE PRINTING OF RESULTS OBTAINED FROM'/ 6' THE STDES COMMAND.') WRITE(IHLP,2003) 2003 FORMAT('1AVAILABLE SWITCHES:'/ 1'0 VARIABLE - SPECIFY VARIABLES'/ 2' VAR'/ 3'0 OBSERVATION - SPECIFY OBSERVATIONS'/ 4' OBS'/ 5'0 DEVICE - SPECIFY DEVICE'/ 6' DEV'/ 7'0 MATCH - MATCH VALUES FOR MERGING'/ 8'0 SELECT - SUBSET DATA BY SELECTING ONLY THOSE'/ 9' SUBSET OBSERVATIONS WHICH MEET CERTAIN CRITERIA'/ 1'0 FORMAT - SPECIFY USER OUTPUT FORMAT'/ 2' FMT'/ 3'0 CONSTANT - SPECIFY CONSTANT'/ 4' CON'/ 5'0 BANK - INDICATE NAME OF ANOTHER BANK'/ 6'0 INFORMATION - INDICATE PERTINANT DATA ABOUT BANK'/ 7' INFO'/ 8'0 IDENTIFICATION - INDICATE VARIABLE NAMES AND DESCRIPTIONS'/ 9' ID') WRITE(IHLP,2005) 2005 FORMAT( 1'0 MAJOR-TO-MINOR - INDICATE MAJOR TO MINOR SEQUENCE'/ 2' MTM') WRITE(IHLP,2004) 2004 FORMAT( 1'0ALL SWITCHES MUST BE FOLLOWED BY A :, IF MORE INFORMATION'/ 2' IS NECESSARY, THE INFORMATION MUST FOLLOW THE : WITH NO'/ 3' SPACES INBETWEEN.'/ 4'0TO RECEIVE MORE HELP ON A PARTICULAR COMMAND OR SWITCH'/ 4' TYPE HELP FOLLOWED BY THE NAME OF THE COMMAND OR SWITCH'/ 6' IN PARENTHESIS. FOR A TABLE OF PERMISSABLE COMMAND -'/ 7' SWITCH COMBINATIONS TYPE HELP(TABLE). FOR ALL THE'/ 8' ADVANCED HELPS TYPE HELP(ALL).') IF(INST.NE.'ALL') GO TO 42 2020 WRITE(IHLP,2021) 2021 FORMAT('1----------'/'0SWITCH COMMAND COMBINATIONS'/ 1'0 C D B C O'/ 2' H E A R U M P S'/ 3' A L C E T E R T T S'/ 4' N E K A P R I D Y O S'/ 5' G T U T U G N E P R E'/ 6' E E P E T E T S E T T ='/ 7'0VARIABLE X X X X X X X'/ 8'0OBSERVATION X X X X X X X X X'/ 9'0DEVICE X X'/ 1'0MATCH X'/ 2'0SELECT X X X X X X X X'/ 3'0FORMAT X X'/ 4'0CONSTANT X'/ 5'0BANK X'/ 6'0INFORMATION X X'/ 7'0IDENTIFICATION X'/ 8'0MAJOR-TO-MINOR X') IF(INST.NE.'ALL') GO TO 42 2040 WRITE(IHLP,2041) 2041 FORMAT('1----------'/ 1'0COMMAND: REPLACE, MODIFY, CHANGE'/ 2'0PURPOSE: ALTER DATA LOCATED IN BANK'/ 3'0SWITCHES POSSIBLE: VARIABLE, OBSERVATION, SELECT, CONSTANT,'/ 4' IDENTIFICATION'/ 5'0DESCRIPTION: ONLY PROJECT-PROGRAMMER NUMBER RESPONSIBLE FOR'/ 6' BANK MAY ALTER ITS CONTENT. NORMAL MEANS OF'/ 7' OBTAINING THE VALUES TO REPLACE THOSE IN THE'/ 8' BANK WILL BE FROM THE TERMINAL. IF ALL DATA'/ 9' TO BE REPLACED IS TO BE CHANGED TO THE SAME'/ 1' VALUE A CONSTANT SWITCH MAY BE USED. WHEN'/ 2' CHANGING VALUES, VARIABLES MUST MAINTAIN THEIR'/ 3' TYPE.') IF(INST.NE.'ALL') GO TO 42 2043 WRITE(IHLP,2044) 2044 FORMAT('0----------'/ 1'0COMMAND: FORGET, DELETE, DEL'/ 2'0PURPOSE: DELETE VARIABLES OR OBSERVATIONS FROM BANK.'/ 3'0SWITCHES POSSIBLE: VARIABLE, OBSERVATION, SELECT'/ 4'0DESCRIPTION: ONLY PROJECT-PROGRAMMER NUMBER RESPONSIBLE FOR'/ 5' BANK MAY ALTER ITS CONTENT. THE VARIABLE'/ 6' SWITCH MUST BE USED BY ITSELF, IT CANNOT BE'/ 7' USED WITH THE SELECT OR OBSERVATION SWITCHES.'/ 8' IF NO SWITCHES ARE SPECIFIED THE ENTIRE BANK'/ 9' IS DELETED.') IF(INST.NE.'ALL') GO TO 42 2046 WRITE(IHLP,2047) 2047 FORMAT('0----------'/ 1'0COMMAND: BACKUP'/ 2'0PURPOSE: CREATE A BACKUP FILE'/ 3'0SWITCHES POSSIBLE: (NONE)'/ 4'0DESCRIPTION: THE COMMAND WILL CAUSE A BACKUP FILE TO BE'/ 5' CREATED. THE FILE WILL HAVE THE SAME NAME'/ 6' WITH A .BAK EXTENSION. IF THE BACKUP COMMAND'/ 7' IS CALLED MORE THAN ONCE, EACH SUCCESSIVE'/ 8' CALL CAUSES THE NEW BACKUP FILE TO REPLACE'/ 9' THE FORMER ONE. BACKUP FILES ARE PROTECTED'/ 1' WITH 077 PROTECTIONS.') IF(INST.NE.'ALL') GO TO 42 2049 WRITE(IHLP,2050) 2050 FORMAT('1----------'/ 1'0COMMAND: CREATE, MAKE, ADD, MA'/ 2'0PURPOSE: ADD NEW OBSERVATIONS TO THE BANK'/ 3'0SWITCHES POSSIBLE: OBSERVATION'/ 4'0DESCRIPTION: THE CREATE COMMAND MUST CONTAIN AT LEAST ONE'/ 5' OBSERVATION SWITCH INDICATING THE NEW'/ 6' OBSERVATIONS TO BE ADDED. THE OBSERVATIONS TO'/ 7' BE ADDED MUST BEGIN WITH THE FIRST FREE'/ 8' OBSERVATION IN THE BANK (THE OBSERVATION NUMBER'/ 9' FOLLOWING THE LAST OBSERVATION IN THE BANK),'/ 1' AND PROCEED THRU THE LAST OBSERVATION TO BE ADDED'/ 2' WITHOUT LEAVING AN OBSERVATION NUMBER OUT. THE'/ 3' USER WILL BE EXPECTED TO SUPPLY THE VALUES FOR'/ 4' NEW OBSERVATIONS ONE AT A TIME, IN RESPONSE TO'/ 5' QUERY. VALUES ENTERED MUST BE OF THE SAME TYPE'/ 6' AS THE VARIABLE FOR WHICH THEY ARE INTENDED.') IF(INST.NE.'ALL') GO TO 42 2052 WRITE(IHLP,2053) 2053 FORMAT('0----------'/ 1'0COMMAND: OUTPUT'/ 2'0PURPOSE: OUTPUT IN ASCII, DATA IN BANK'/ 3'0SWITCHES POSSIBLE: VARIABLE, OBSERVATION, DEVICE, SELECT,'/ 4' FORMAT'/ 5'0DESCRIPTION: THE OUTPUT COMMAND OUTPUTS DATA IN ASCII,'/ 6' UNDER A USER SPECIFIED FORMAT TO A USER'/ 7' SPECIFIED DEVICE. IF LPT IS SPECIFIED AS'/ 8' THE OUTPUT DEVICE, THE OUTPUT WILL BE SPOOLED'/ 9' AND AUTOMATICALLY PRINTED WHEN THE COMMAND IS'/ 1' FINISHED.') IF(INST.NE.'ALL') GO TO 42 2055 WRITE(IHLP,2056) 2056 FORMAT('1----------'/ 1'0COMMAND: MERGE'/ 2'0PURPOSE: MERGE TWO BANKS'/ 3'0SWITCHES POSSIBLE: MATCH, BANK'/ 4'0DESCRIPTION: THE MERGE COMMAND MERGES DATA IN AN UPDATE BANK'/ 5' (INDICATED IN THE BANK SWITCH) INTO THE RESIDENT'/ 6' BANK (SPECIFIED AT BEGINNING OF RUN). UPON'/ 7' COMPLETION OF THE MERGE, THE RESIDENT BANK WILL'/ 8' CONTAIN ANY VARIABLES PREVIOUSLY CONTAINED IN'/ 9' EITHER BANK. THE UPDATING BANK WILL REMAIN'/ 1' UNCHANGED. A MERGE MUST BE ACCOMPANIED BY ONE'/ 2' AND ONLY ONE BANK SWITCH. ONE OR MORE MATCH'/ 3' SWITCHES MAY BE SPECIFIED. IF NO MATCH SWITCHES'/ 4' ARE USED, THE DATA IN THE UPDATING BANK WILL BE'/ 5' ADDED TO THE RESIDENT BANK AS NEW OBSERVATIONS.'/ 6' WHERE MATCH SWITCHES ARE USED, AN OBSERVATION'/ 7' IN THE RESIDENT BANK IS UPDATED BY AN'/ 8' OBSERVATION IN THE UPDATING BANK, IF THE'/ 9' VARIABLES INDICATED IN THE MATCH SWITCH HAVE') WRITE(IHLP,2057) 2057 FORMAT( 1' THE SAME VALUES FOR BOTH OBSERVATIONS. IF AN'/ 2' OBSERVATION IN THE UPDATING BANK CANNOT BE'/ 3' MATCHED, IT WILL BE ADDED TO THE RESIDENT BANK'/ 4' AS AN ENTIRE OBSERVATION.'/ 5'0 MISSING DATA WILL NOT BE MATCHED WITH MISSING'/ 6' DATA, AND INFORMATION PRESENT WILL NOT BE'/ 7' UPDATED WITH MISSING DATA. WHEN CERTAIN'/ 8' VARIABLES ARE NOT AVAILABLE IN AND OBSERVATION,'/ 9' MISSING DATA WILL BE USED.') IF(INST.NE.'ALL') GO TO 42 2058 WRITE(IHLP,2059) 2059 FORMAT('0----------'/ 1'0COMMAND: PRINT, LIST, Q'/ 2'0PURPOSE: PRINT A COPY OF DATA OR INFORMATION ABOUT THE BANK'/ 3' ON THE LINE PRINTER.'/ 4'0SWITCHES POSSIBLE: VARIABLE, OBSERVATION, SELECT,'/ 5' INFORMATION'/ 6'0DESCRIPTION: THE COMMAND WILL CAUSE OUTPUT TO BE AUTOMATICALLY'/ 7' PRINTED ON THE LINE PRINTER. IF THE PRINT'/ 8' COMMAND IS USED WITHOUT SWITCHES, BOTH THE'/ 9' INFORMATION AND THE COMPLETE DATA SET WILL BE'/ 1' PRINTED. OUTPUT WILL BE LABELED BY OBSERVATION'/ 2' AND VARIABLE.') IF(INST.NE.'ALL') GO TO 42 2061 WRITE(IHLP,2062) 2062 FORMAT('1----------'/ 1'0COMMAND: STDES'/ 2'0PURPOSE: SUPPLY USER WITH SINGLE VARIABLE STATISTICS'/ 3'0SWITCHES POSSIBLE: VARIABLE, OBSERVATION, SELECT'/ 4'0DESCRIPTION: THE STDES COMMAND PROVIDES THE USER WITH THE'/ 5' FOLLOWING INFORMATION: DATE THE STATISTICS'/ 6' WERE RUN, THE BANK THEY WERE TAKEN FROM, THE'/ 7' DATE THE BANK WAS CREATED, THE PROJECT-PROGRAMMER'/ 8' NUMBER WHICH CREATED THE BANK, THE VARIABLE'/ 9' NAME, THE POSITION NUMBER OF THE VARIABLE IN'/ 1' THE BANK, ITS DESCRIPTION, AND ITS TYPE. IF'/ 2' ANY SELECT SWITCHES ARE USED, THEY WILL ALSO BE'/ 3' SPECIFIED. THE NUMBER OF OBSERVATIONS AND'/ 4' MISSING DATA WILL BE SHOWN.'/ 5'0 FOR FLOATING AND FIXED TYPE VARIABLES THE'/ 6' FOLLOWING STATISTICS ARE PROVIDED: MEAN, MEDIAN,'/ 7' MODE, MAXIMUM, MINIMUM, RANGE, STANDARD ERROR'/ 8' OF MEAN, STANDARD DEVIATION, VARIANCE, COEFF.'/ 9' OF SKEWNESS, COEFFICIENT OF VARIATION, AND'/ 1' KURTOSIS. THERE WILL ALSO BE A DISTRIBUTION') WRITE(IHLP,2063) 2063 FORMAT( 1' CHART.'/ 2'0 FOR ALPHA TYPE VARIABLES THERE WILL BE A'/ 3' MAXIMUM, MINIMUM, AND A DISTRIBUTION CHART.'/ 4'0 THE DISTRIBUTION CHART CONTAINS FREQUENCY OF'/ 5' OCCURANCE, PERCENTAGE, AND CUMULATIVE PERCENTAGE'/ 6' FOR EACH ENTRY. IF THERE ARE 35 OR LESS'/ 7' INDIVIDUAL VALUES, EACH ENTRY IN THE CHART WILL'/ 8' BE AN INDIVIDUAL VALUE. IF MORE THAN 35'/ 9' INDIVIDUAL VALUES EXIST, THE CHART WILL BE'/ 1' BROKEN INTO 35 RANGES EACH HAVING THE SAME'/ 2' SIZE INTERVAL. A BAR GRAPH OF PERCENTAGE IS'/ 3' SUPPLIED.'/ 4'0 OUTPUT WILL BE AUTOMATICALLY PRINTED ON THE'/ 5' LINE PRINTER, WHEN THERE IS A NORMAL EXIT.') IF(INST.NE.'ALL') GO TO 42 2064 WRITE(IHLP,2065) 2065 FORMAT('0----------'/ 1'0COMMAND: TYPE'/ 2'0PURPOSE: TYPE A COPY OF DATA OR INFORMATION ABOUT THE BANK'/ 3' ON THE TERMINAL'/ 4'0SWITCHES POSSIBLE: VARIABLE, OBSERVATION, SELECT,'/ 5' INFORMATION'/ 6'0DESCRIPTION: THE TYPE COMMAND WILL TYPE DATA OR INFORMATION'/ 7' ON THE TERMINAL. IF THE TYPE COMMAND IS USED'/ 8' WITHOUT SWITCHES, BOTH THE INFORMATION AND'/ 9' COMPLETE DATA SET WILL BE TYPED. OUTPUT WILL'/ 1' BE LABELED BY OBSERVATION AND VARIABLE.') IF(INST.NE.'ALL') GO TO 42 2067 WRITE(IHLP,2068) 2068 FORMAT('1----------'/ 1'0COMMAND: SORT'/ 2'0PURPOSE: SORT BANK'/ 3'0SWITCHES POSSIBLE: MAJOR-TO-MINOR'/ 4'0DESCRIPTION: THE SORT COMMAND IS USED TO SORT THE BANK INTO'/ 5' ASCENDING ORDER BASED ON SELECTED VARIABLES.'/ 6' THE SORT IS PERFORMED ON VARIABLES SPECIFIED BY'/ 7' THE USER IN THE MAJOR-TO-MINOR SWITCH. UPON'/ 8' COMPLETION OF THE SORT EACH OBSERVATION REMAINS'/ 9' UNCHANGED (ONLY THE ORDER IN WHICH THE'/ 1' OBSERVATIONS OCCUR WILL BE ALTERED). A'/ 2' MAJOR-TO-MINOR SWITCH MUST BE SPECIFIED FOR'/ 3' EACH SORT, HOWEVER ONLY ONE MAY BE SPECIFIED'/ 4' PER SORT.') IF(INST.NE.'ALL') GO TO 42 2070 WRITE(IHLP,2071) 2071 FORMAT('0----------'/ 1'0COMMAND: SET'/ 2'0PURPOSE: ALTER THE ASSUMPTIONS MADE WHEN SWITCHES ARE NOT'/ 3' SPECIFIED.'/ 4'0SWITCHES POSSIBLE: VARIABLE, OBSERVATION, DEVICE, SELECT,'/ 5' FORMAT'/ 6'0DESCRIPTION: MOST COMMANDS REQUIRE THE USE OF SWITCHES'/ 7' (SWITCH-COMMAND TABLE). IF A NECESSARY SWITCH'/ 8' IS NOT SPECIFIED BY THE USER, A PREDEFINED'/ 9' ASSUMPTION (SEE INDIVIDUAL SWITCHES) WILL BE'/ 1' USED. THE SET COMMAND ALLOWS THE USER TO ALTER'/ 2' THESE ASSUMPTIONS. IT IS ONLY NECESSARY FOR'/ 3' THE USER TO SPECIFY THE SWITCHES FOR WHICH THE'/ 4' ASSUMPTIONS ARE TO BE CHANGED. THE SET COMMAND'/ 5' WILL REPLACE THE ASSUMPTIONS WITH THOSE'/ 6' INDICATED IN THE SWITCHES. IF A SWITCH IS NOT'/ 7' SPECIFIED IN A SET COMMAND, IT WILL BE RETURNED'/ 8' TO THE ORIGINAL ASSUMPTION. MORE THAN ONE SET'/ 9' COMMAND MAY BE ISSUED DURING A RUN.') IF(INST.NE.'ALL') GO TO 42 2073 WRITE(IHLP,2074) 2074 FORMAT('1----------'/ 1'0COMMAND: ='/ 2'0PURPOSE: ALLOW USER TO TRANSFORM EXISTING VARIABLES AND'/ 3' CREATE NEW ONES.'/ 4'0SWITCHES POSSIBLE: OBSERVATION, SELECT'/ 5'0DESCRIPTION: THE = COMMAND FOLLOWS A FORM SIMILIAR TO'/ 6' FORTRAN: THE VARIABLE TO BE TRANSFORMED OR'/ 7' CREATED IS SITUATED IN THE FIRST POSITION, AN'/ 8' =, AND THE ARITHEMATIC STATEMENT TO THE RIGHT'/ 9' OF THE EQUALITY SIGN (IT WILL BE EVALUATED AND'/ 1' PLACED IN THE VARIABLE INDICATED). NO SPACES'/ 2' ARE ALLOWED IN THE COMMAND. THE HIERARCHY'/ 3' (ORDER IN WHICH CALCULATIONS ARE PERFORMED) IS'/ 4' THE SAME AS FOR FORTRAN (** EXPONENTIATION,'/ 5' * MULTIPLICATION AND / DIVISION,'/ 6' + ADDITION AND - SUBTRACTION). FUNCTIONS ARE'/ 7' AVAILABLE, AND WILL BE EVALUATED FIRST.'/ 8'0 VARIABLE NAMES ARE USED TO INDICATE VARIABLES.'/ 9' ALL CALCULATIONS ARE PERFORMED IN FLOATING POINT.'/ 1'0 FUNCTIONS AVAILABLE:') WRITE(IHLP,2075) 2075 FORMAT( 1'0 SQRT - SQUARE ROOT SIN - SINE'/ 2' LN - NATURAL LOG COS - COSINE'/ 3' EXP - EXPONETIAL ARCTN - ARCTANGENT'/ 4' LOG10 - LOG BASE 10 ARCSN - ARC SINE'/ 5' ABS - ABSOLUTE VALUE'/ 6' FIX - TRANSLATE FROM OTHER TYPE TO FIXED'/ 7' FLOAT - TRANSLATE FROM OTHER TYPE TO FLOATING'/ 8' ALPHA - TRANSLATE FROM OTHER TYPE TO ALPHA'/ 9' RAN - RANDOM NUMBER GENERATOR'/ 1' NORM - NORMAL RANDOM NUMBER GENERATOR') IF(INST.NE.'ALL') GO TO 42 2101 WRITE(IHLP,2102) 2102 FORMAT('1----------'/ 1'0SWITCH: VARIABLE, VAR'/ 2'0PURPOSE: INDICATE VARIABLES TO BE USED IN AN INSTRUCTION'/ 3'0COMMANDS POSSIBLE: CHANGE, DELETE, OUTPUT, PRINT, STDES'/ 4' TYPE, SET'/ 5'0DESCRIPTION: IF NO VARIABLE SWITCH IS GIVEN THE ENTIRE RANGE'/ 5' OF VARIABLES IS ASSUMED (VARIABLE 1 THRU LAST'/ 7' VARIABLE IN THE BANK). THE VARIABLES TO BE'/ 8' ACTED UPON ARE LISTED BY VARIABLE NAME OR'/ 9' NUMBER (INDICATING ITS POSITION IN THE BANK).'/ 1' IF SEVERAL VARIABLES ARE SPECIFIED IN A SINGLE'/ 2' VARIABLE SWITCH, THEY SHOULD BE SEPARATED BY'/ 3' COMMAS. RANGES OF VARIABLES MAY BE SPECIFIED'/ 4' BY LISTING THE FIRST VARIABLE OF THE RANGE, A'/ 5' -, AND THE LAST VARIABLE OF THE RANGE. MORE'/ 6' THAN 1 VARIABLE SWITCH MAY BE USED IN AN'/ 7' INSTRUCTION') IF(INST.NE.'ALL') GO TO 42 2104 WRITE(IHLP,2105) 2105 FORMAT('0----------'/ 1'0SWITCH: OBSERVATION, OBS'/ 2'0PURPOSE: DEFINE OBSERVATIONS TO BE USED IN AN INSTRUCTION'/ 3'0COMMANDS POSSIBLE: CHANGE, DELETE, CREATE, OUTPUT, PRINT,'/ 4' TYPE, STDES, SET, ='/ 5'0DESCRIPTION: IF NO OBSERVATION SWITCH IS GIVEN THE ENTIRE'/ 6' RANGE OF OBSERVATIONS IS ASSUMED (OBSERVATION 1'/ 7' THRU LAST OBSERVATION IN THE BANK). THE'/ 8' OBSERVATIONS TO BE ACTED UPON SHOULD BE LISTED'/ 9' BY OBSERVATION NUMBERS, AND SEPARATED BY COMMAS.'/ 1' RANGES OF OBSERVATIONS MAY BE SPECIFIED BY'/ 2' LISTING THE FIRST OBSERVATION OF THE RANGE, A -,'/ 3' AND THE LAST OBSERVATION IN THE RANGE. MORE'/ 4' THAN 1 OBSERVATION SWITCH MAY BE USED IN AN'/ 5' INSTRUCTION') IF(INST.NE.'ALL') GO TO 42 2107 WRITE(IHLP,2108) 2108 FORMAT('0----------'/ 1'0SWITCH: DEVICE, DEV'/ 2'0PURPOSE: DEFINE OUTPUT DEVICE, AND FILE NAME (IF NECESSARY)'/ 3'0COMMANDS POSSIBLE: OUTPUT, SET'/ 4'0DESCRIPTION: IF NO DEFINE SWITCH IS USED, DSK:OUT.DAT IS'/ 5' ASSUMED. THE DEVICE TO BE USED FOR OUTPUT (LPT,'/ 6' DSK, DTA, ETC.) IS SPECIFIED AFTER THE SWITCH.'/ 7' IF THE DEVICE IS A DIRECTORY DEVICE IT MAY BE'/ 8' FOLLOWED BY A : AND THE NAME OF THE FILE.'/ 9' IF NO NAME IS GIVEN FOR A DIRECTORY DEVICE,'/ 1' OUT.DAT IS ASSUMED. ONLY 1 DEVICE SWITCH MAY BE'/ 2' USED IN AN INSTRUCTION') IF(INST.NE.'ALL') GO TO 42 2110 WRITE(IHLP,2111) 2111 FORMAT('1----------'/ 1'0SWITCH: MATCH'/ 2'0PURPOSE: INDICATE VARIABLES TO BE MATCHED FOR MERGING'/ 3'0COMMANDS POSSIBLE: MERGE'/ 4'0DESCRIPTION: IF NO MATCH SWITCH IS SPECIFIED, NONE IS'/ 5' ASSUMED. THE MATCH SWITCH IS FOLLOWED BY ONE'/ 6' OR MORE VARIABLE NAMES SEPARATED BY COMMAS.'/ 7' UP TO 20 VARIABLES MAY BE SPECIFIED PER'/ 8' INSTRUCTION. THE VARIABLE NAMES SPECIFIED MUST'/ 9' APPEAR IN BOTH BANKS. MORE THAN 1 MATCH SWITCH'/ 1' MAY BE USED IN AN INSTRUCTION.') IF(INST.NE.'ALL') GO TO 42 2113 WRITE(IHLP,2114) 2114 FORMAT('0----------'/ 1'0SWITCH: SELECT, SUBSET'/ 2'0PURPOSE: CONSIDER ONLY THOSE OBSERVATIONS MEETING USER'/ 3' SPECIFIED CRITERIA'/ 4'0COMMANDS POSSIBLE: CHANGE, DELETE, OUTPUT, PRINT, STDES,'/ 5' TYPE, SET, ='/ 6'0DESCRIPTION: IF NO SELECT SWITCHES ARE USED, NONE ARE'/ 7' ASSUMED. THE SELECT SWITCH CONTAINS THREE BASIC'/ 8' PARTS: VARIABLE, CONDITION, AND VALUE TO BE'/ 9' COMPARED AGAINST. THE VARIABLE MAY BE SPECIFIED'/ 1' BY EITHER THE VARIABLE NAME, OR THE NUMBER'/ 2' INDICATING ITS POSITION IN THE BANK. THE'/ 3' CONDITION MAY BE ONE OF THE FOLLOWING:'/ 4'0 CONDITION MEANING'/ 5'0 = EQUAL TO'/ 6' < LESS THAN'/ 7' > GREATER THAN'/ 8' <= OR =< LESS THAN OR EQUAL TO'/ 9' >= OR => GREATER THAN OR EQUAL TO'/ 1' <> OR >< NOT EQUAL') WRITE(IHLP,2115) 2115 FORMAT( 2'0 THE VALUE TO BE COMPARED AGAINST MUST BE OF THE'/ 3' SAME TYPE AS THE VARIABLE IT IS COMPARED WITH.'/ 4' IN USE, THE SELECT LIMITS THE OBSERVATIONS'/ 5' CONSIDERED TO THOSE WHICH MEET ALL THE USERS'/ 6' SPECIFICATIONS. NO SPACES ARE ALLOWED IN THE'/ 7' SELECT. UP TO 20 SELECTS MAY BE SPECIFIED IN'/ 8' AN INSTRUCTION') IF(INST.NE.'ALL') GO TO 42 2116 WRITE(IHLP,2117) 2117 FORMAT('1----------'/ 1'0SWITCH: FORMAT, FMT'/ 2'0PURPOSE: SPECIFY AN OUTPUT FORMAT'/ 3'0COMMANDS POSSIBLE: OUTPUT, SET'/ 4'0DESCRIPTION: IF NO FORMAT SWITCH IS USED, A FORMAT WILL BE'/ 5' GENERATED BY THE PROGRAM. THE FORMAT SWITCH IS'/ 6' FOLLOWED BY THE FORMAT ENCLOSED IN PARENTHESIS.'/ 7' THE FORMAT MAY BE UP TO 240 CHARACTERS LONG AND'/ 8' MAY EXTEND BEYOND ONE LINE. FORMATS SPECIFIED'/ 9' MUST AGREE IN TYPE WITH THE VARIABLES TO BE'/ 1' OUTPUT. ONLY ONE FORMAT SWITCH MAY BE'/ 2' SPECIFIED IN AN INSTRUCTION.') IF(INST.NE.'ALL') GO TO 42 2119 WRITE(IHLP,2120) 2120 FORMAT('0----------'/ 1'0SWITCH: CONSTANT, CON'/ 2'0PURPOSE: INDICATE A CONSTANT VALUE'/ 3'0COMMANDS POSSIBLE: CHANGE'/ 4'0DESCRIPTION: IF A CONSTANT SWITCH IS NOT USED, IT IS ASSUMED'/ 5' THE USER WILL TYPE IN THE NEW DATA. THE'/ 6' CONSTANT SWITCH IS FOLLOWED BY THE CONSTANT TO'/ 7' BE USED. THE TYPE MUST AGREE WITH THE VARIABLE'/ 8' TYPE. TO INDICATE MISSING DATA MISSING MAY'/ 9' BE USED. ONLY ONE CONSTANT SWITCH MAY BE USED'/ 1' PER INSTRUCTION.') IF(INST.NE.'ALL') GO TO 42 2122 WRITE(IHLP,2123) 2123 FORMAT('0----------'/ 1'0SWITCH: BANK'/ 2'0PURPOSE: SPECIFY A BANK'/ 3'0COMMANDS POSSIBLE: MERGE'/ 4'0DESCRIPTION: BANK SWITCH MUST BE USED WHERE NECESSARY,'/ 5' OTHERWISE AN ERROR WILL OCCUR. THE BANK SWITCH'/ 6' IS FOLLOWED BY THE NAME OF A BANK, WITH OR'/ 7' WITHOUT THE .BNK EXTENSION. ONLY ONE BANK'/ 8' SWITCH MAY BE USED PER INSTRUCTION.') 2128 IF(INST.NE.'ALL') GO TO 42 2125 WRITE(IHLP,2126) 2126 FORMAT('1----------'/ 1'0SWITCH: INFORMATION, INFO'/ 2'0PURPOSE: NOTIFY PROGRAM THAT VARIABLE NAMES, TYPES, AND'/ 3' DESCRIPTIONS ARE TO REPLACE OUTPUT OF RAW DATA.'/ 4'0COMMANDS POSSIBLE: PRINT, TYPE'/ 5'0DESCRIPTION: IF NO INFORMATION SWITCH IS SPECIFIED, VARIABLE'/ 6' NAMES, DESCRITIONS, AND VARIABLE TYPES WILL'/ 7' NOT BE OUTPUT. IT IS NOT NECESSARY TO PROVIDE'/ 8' ANY ADDITIONAL SPECIFICATIONS WITH THIS SWITCH.'/ 9' WHEN AN INFORMATION SWITCH HAS BEEN GIVEN'/ 1' OUTPUT OF ACTUAL DATA WILL BE SURPRESSED. ONLY'/ 2' ONE INFORMATION SWITCH MAY BE GIVEN IN AN'/ 3' INSTRUCTION.') IF(INST.NE.'ALL') GO TO 42 WRITE(IHLP,2129) 2129 FORMAT('0----------'/ 1'0SWITCH: IDENTIFICATION, ID'/ 2'0PURPOSE: ALLOW USER TO ALTER NAMES, AND DESCRIPTIONS'/ 3'0COMMANDS POSSIBLE: CHANGE'/ 4'0DESCRIPTION: IF NO IDENTIFICATION SWITCH IS SPECIFIED, NONE'/ 5' IS ASSUMED. THE IDENTIFICATION SWITCH DOES NOT'/ 6' REQUIRE ANY ADDITIONAL INFORMATION. WHEN THE'/ 7' USER IS INSTRUCTED TO ENTER THE NEW'/ 8' IDENTIFICATION, THE VARIABLE NAME MUST APPEAR'/ 9' IN THE FIRST 5 COLUMNS FOLLOWED BY A ; AND THE'/ 1' DESCRIPTION. ONLY ONE IDENTIFICATION SWITCH'/ 2' MAY BE USED PER INSTRUCTION.') IF(INST.NE.'ALL') GO TO 42 2130 WRITE(IHLP,2131) 2131 FORMAT('0----------'/ 1'0SWITCH: MAJOR-TO-MINOR, MTM'/ 2'0PURPOSE: INDICATE THE MAJOR TO MINOR SORT VARIABLES'/ 3'0COMMANDS POSSIBLE: SORT'/ 4'0DESCRIPTION: IF NO MAJOR-TO-MINOR SWITCH IS USED (WHERE'/ 5' NECESSARY), AN ERROR WILL OCCUR. THE MAJOR-'/ 6' TO-MINOR SWITCH IS FOLLOWED BY 1 TO 20'/ 7' VARIABLES, SEPARATED BY COMMAS, AND INDICATED'/ 8' BY VARIABLE NAMES OR NUMBERS. THIS LIST OF'/ 9' VARIABLES INDICATES THE SORT SEQUENCE, THE FIRST'/ 1' VARIABLE IN THE LIST BEING THE MOST MAJOR, THE'/ 2' LAST IN THE LIST BEING THE MOST MINOR. ONLY 1'/ 3' MAJOR-TO-MINOR SWITCH MAY BE USED IN AN '/ 4' INSTRUCTION.') IF(INST.NE.'ALL') GO TO 42 IF(IHLP.EQ.IDLG) GO TO 42 CALL RELEAS(IHLP) CALL PRINTS('HELP.DAT',2,1,1) GO TO 42 END SUBROUTINE CALC (LINE,N,M,K,L,INST,IVAR1,IVAR2,ITO,CONST,SV,NV, 1IBASE,IERRC,ITYPES) DIMENSION LINE(1),INST(1),IVAR1(1),IVAR2(1),ITO(1),CONST(1),SV(1), 1NAMES(1),ITYPES(1) DIMENSION IZ(2) EQUIVALENCE (IWORD,WORD) DATA IALT/"155004020100/ 1 IERRC=0 MA=0 MB=0 NA=N-1 2 NA=NA+1 IF (NA.GT.M) GO TO 4 IF (LINE(NA).EQ.'(') MA=NA+1 IF (LINE(NA).NE.')') GO TO 2 MB=NA-1 IF (MA.GT.0) GO TO 3 IERRC=1 RETURN 3 IF (MA.LE.MB) GO TO 4 IERRC=2 RETURN 4 KK=0 IF (MA.EQ.0) MA=N IF (MB.EQ.0) MB=M 5 KK=KK+1 NZ=MA GO TO (90,6,20,30,60) KK 90 NZ1=NZ CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF(IDEF.NE.-6) GO TO 5 INST(K)=6 IVAR1(K)=0 CONST(K)=0 CALL COMPD(LINE,NZ,WORD,IDEF,ITYPES) IF(IDEF.LT.10) GO TO 91 SV(L)=-WORD CONST(K)=SV(L) INST(K)=99 GO TO 50 91 CALL VARB(IWORD,IERR,IV,NV,IBASE) IF(IERR.NE.0) GO TO 10 IVAR2(K)=IV GO TO 50 6 NZ1=NZ CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF (NZ.GT.MB) GO TO 5 IF ((IDEF.NE.8).AND.(IDEF.NE.18)) GO TO 6 IF (LINE(NZ).NE.'*') GO TO 6 NZ=NZ+1 INST(K)=3 IF (IDEF.EQ.18) GO TO 12 CALL VARB (IWORD,IERR,IV,NV,IBASE) IF (IERR.EQ.0) GO TO 8 10 IERRC=IERR+3 RETURN 8 IVAR1(K)=IV CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF (IDEF.LE.0) GO TO 21 IF (IDEF.GT.9) GO TO 11 CALL VARB (IWORD,IERR,IV,NV,IBASE) IF (IERR.NE.0) GO TO 10 IVAR2(K)=IV GO TO 50 11 IVAR2(K)=0 CONST(K)=WORD GO TO 50 12 CONST(K)=WORD IVAR1(K)=0 CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF (IDEF.LE.0) GO TO 21 IF (IDEF.GT.9) GO TO 14 CALL VARB (IWORD,IERR,IV,NV,IBASE) IF (IERR.NE.0) GO TO 10 IVAR2(K)=IV GO TO 50 14 INST(K)=99 SV(L)=CONST(K)**WORD INST(K)=99 CONST(K)=SV(L) GO TO 50 20 NZ1=NZ CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF (NZ.GT.MB) GO TO 5 IF ((IDEF.NE.8).AND.(IDEF.NE.18).AND.(IDEF.NE.7).AND.(IDEF.NE.17)) 1GO TO 20 IF ((IDEF.EQ.8).OR.(IDEF.EQ.18)) INST(K)=8 IF ((IDEF.EQ.7).OR.(IDEF.EQ.17)) INST(K)=7 IF (IDEF.GT.9) GO TO 24 CALL VARB (IWORD,IERR,IV,NV,IBASE) IF (IERR.NE.0) GO TO 10 IVAR1(K)=IV CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF (IDEF.GT.0) GO TO 22 21 IERRC=7 RETURN 22 IF (IDEF.GT.9) GO TO 23 CALL VARB (IWORD,IERR,IV,NV,IBASE) IF (IERR.NE.0) GO TO 10 IVAR2(K)=IV GO TO 50 23 IVAR2(K)=0 CONST(K)=WORD IF (WORD.NE.0) GO TO 50 IERRC=8 RETURN 24 CONST(K)=WORD IVAR1(K)=0 CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF (IDEF.LE.0) GO TO 21 IF (IDEF.GT.9) GO TO 25 CALL VARB (IWORD,IERR,IV,NV,IBASE) IF (IERR.NE.0) GO TO 10 IVAR2(K)=IV GO TO 50 25 IF (INST(K).EQ.8) SV(L)=CONST(K)*WORD IF ((INST(K).NE.7).OR.(WORD.NE.0)) GO TO 26 IERRC=8 RETURN 26 IF (INST(K).EQ.7) SV(L)=CONST(K)/WORD INST(K)=99 CONST(K)=SV(L) GO TO 50 30 NZ1=NZ CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF (NZ.GT.MB) GO TO 5 IF ((IDEF.NE.5).AND.(IDEF.NE.15).AND.(IDEF.NE.6).AND.(IDEF.NE.16)) 1 GO TO 30 IF ((IDEF.EQ.5).OR.(IDEF.EQ.15)) INST(K)=5 IF ((IDEF.EQ.6).OR.(IDEF.EQ.16)) INST(K)=6 IF (IDEF.GT.9) GO TO 34 CALL VARB (IWORD,IERR,IV,NV,IBASE) IF (IERR.NE.0) GO TO 10 IVAR1(K)=IV CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF (IDEF.LE.0) GO TO 21 IF (IDEF.GT.9) GO TO 33 CALL VARB (IWORD,IERR,IV,NV,IBASE) IF (IERR.NE.0) GO TO 10 IVAR2(K)=IV GO TO 50 33 IVAR2(K)=0 CONST(K)=WORD GO TO 50 34 CONST(K)=WORD IVAR1(K)=0 CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF (IDEF.LE.0) GO TO 21 IF (IDEF.GT.9) GO TO 35 CALL VARB (IWORD,IERR,IV,NV,IBASE) IF (IERR.NE.0) GO TO 10 IVAR2(K)=IV GO TO 50 35 IF (INST(K).EQ.5) SV(L)=CONST(K)+WORD IF (INST(K).EQ.6) SV(L)=CONST(K)-WORD CONST(K)=SV(L) INST(K)=99 GO TO 50 50 ITO(K)=L ENCODE (2,51,IWORD) L 51 FORMAT (I2) DECODE (2,52,WORD) IZ 52 FORMAT (2A1) NZ2=NZ1 IDIF=0 IF(L.GT.9) IDIF=1 IDIF=NZ-NZ1-3-IDIF IF(IDIF.EQ.0) GO TO 85 IF(IDIF.GT.0) GO TO 82 DO 81 I=80+IDIF,NZ-1,-1 81 LINE(I-IDIF)=LINE(I) GO TO 85 82 DO 83 I=NZ-1,80 83 LINE(I-IDIF)=LINE(I) DO 84 I=81-IDIF,80 84 LINE(I)=' ' GO TO 85 85 MB=MB-IDIF M=M-IDIF LINE (NZ1)="771004020100 NZ1=NZ1+1 IF (IZ(1).EQ.' ') GO TO 53 LINE (NZ1)=IZ(1) NZ1=NZ1+1 53 LINE (NZ1)=IZ(2) NZ1=NZ1+1 57 L=L+1 IF (L.GT.99) PAUSE 'PROBLEM' NZ=NZ2 K=K+1 IF (K.LE.25) GO TO 56 IERRC=9 RETURN 56 GO TO (5,6,20,30) KK 60 NZ=MA CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF (NZ.GT.MB) GO TO 62 61 IERRC=10 RETURN 62 IF ((MA.EQ.N).AND.(MB.EQ.M)) RETURN IF ((IDEF.EQ.2).OR.(IDEF.EQ.12)) GO TO 63 IERRC=11 RETURN 63 IF ((LINE(NZ).EQ.'+').OR.(LINE(NZ).EQ.'-').OR.(LINE(NZ).EQ.'*').OR 1.(LINE(NZ).EQ.'/').OR.(LINE(NZ).EQ.' ').OR.(LINE(NZ).EQ.')') 3.OR.(LINE(NZ).EQ.IALT)) GO TO 64 IERRC=13 RETURN 64 MA=MA-1 IF (LINE(MA).EQ.'(') GO TO 65 IERRC=12 RETURN 65 MA=MA-1 DO 70 I=1,9 IF (LINE(MA).NE.ITYPES(I)) GO TO 70 IF (I.NE.3) GO TO 66 IERRC=14 RETURN 66 IF (I.NE.4) GO TO 58 IF(MA.LT.N) GO TO 58 IERRC=15 RETURN 58 IF(I.NE.2) GO TO 67 IERRC=13 RETURN 67 DO 68 J=MA+2,80 68 LINE (J-1)=LINE(J) LINE (80)=' ' DO 69 J=NZ-1,80 69 LINE (J-1)=LINE(J) LINE (80)=' ' M=M-2 GO TO 1 70 CONTINUE 71 MA=MA-1 IF (MA.GT.0) GO TO 72 IERRC=16 RETURN 72 DO 7 I=1,9 IF (LINE(MA).NE.ITYPES(I)) GO TO 7 IF ((I.GE.4).AND.(I.LE.8)) GO TO 73 IF(I.EQ.1) GO TO 73 IERRC=17 RETURN 7 CONTINUE GO TO 71 73 NZ=MA+1 CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF (IDEF.NE.1) PAUSE 'NONONO' INST(K)=0 IF (WORD.EQ.'SQRT') INST(K)=10 IF (WORD.EQ.'LN') INST(K)=11 IF (WORD.EQ.'EXP') INST(K)=12 IF (WORD.EQ.'LOG10') INST(K)=13 IF (WORD.EQ.'SIN') INST(K)=14 IF (WORD.EQ.'COS') INST(K)=15 IF (WORD.EQ.'MEAN') INST(K)=16 IF (WORD.EQ.'STD') INST(K)=17 IF (WORD.EQ.'ARCTN') INST(K)=18 IF (WORD.EQ.'ARCSN') INST(K)=19 IF(WORD.EQ.'ABS') INST(K)=20 IF(WORD.EQ.'FIX') INST(K)=21 IF(WORD.EQ.'FLOAT') INST(K)=22 IF(WORD.EQ.'ALPHA') INST(K)=23 IF(WORD.EQ.'RAN') INST(K)=24 IF(WORD.EQ.'NORM') INST(K)=25 IF (INST(K).NE.0) GO TO 74 IERRC=18 RETURN 74 CALL COMPD (LINE,NZ,WORD,IDEF,ITYPES) IF (IDEF.EQ.12) GO TO 75 CALL VARB (IWORD,IERR,IV,NV,IBASE) IF (IERR.NE.0) GO TO 10 IVAR1(K)=IV IVAR2(K)=0 IF ((INST(K).NE.16).AND.(INST(K).NE.17)) GO TO 77 IF (IVAR1(K).GT.0) GO TO 77 IERRC=19 RETURN 75 IF (INST(K).EQ.10) SV(L)=SQRT(WORD) IF (INST(K).EQ.11) SV(L)=ALOG(WORD) IF (INST(K).EQ.12) SV(L)=EXP(WORD) IF (INST(K).EQ.13) SV(L)=ALOG10(WORD) IF (INST(K).EQ.14) SV(L)=SIN(WORD) IF (INST(K).EQ.15) SV(L)=COS(WORD) IF ((INST(K).NE.16).AND.(INST(K).NE.17)) GO TO 76 IERRC=19 RETURN 76 IF (INST(K).EQ.18) SV(L)=ATAN(WORD) IF (INST(K).EQ.19) SV(L)=ASIN(WORD) IF((INST(K).EQ.20).AND.(WORD.GE.0)) SV(L)=WORD IF((INST(K).EQ.20).AND.(WORD.LT.0)) SV(L)=-WORD IF((INST(K).GT.25).OR.(INST(K).LT.21)) GO TO 87 IVAR1(K)=0 CONST(K)=WORD GO TO 77 87 INST(K)=99 CONST(K)=SV(L) 77 ITO(K)=L ENCODE (2,51,WORD) L DECODE (2,52,WORD) IZ NZ1=MA+1 LINE (NZ1)="771004020100 NZ1=NZ1+1 IF (IZ(1).EQ.' ') GO TO 78 LINE (NZ1)=IZ(1) NZ1=NZ1+1 78 LINE (NZ1)=IZ(2) NZ1=NZ1+1 IDIF=NZ-NZ1 DO 79 I=NZ,80 79 LINE (I-IDIF)=LINE(I) DO 80 I=81-IDIF,80 80 LINE (I)=' ' M=M-IDIF L=L+1 IF (L.GT.99) PAUSE 'PROB1' K=K+1 IF (K.LE.25) GO TO 1 IERRC=9 RETURN END SUBROUTINE VARB (IWORD,IERR,IV,NV,IBASE) DIMENSION NAMES(1),TAKPT(5),LV(125),NNS(18,6) COMMON /DEV/ IDLG,ICC,IBNK EQUIVALENCE (LV,NNS) IERR=0 IV=0 IF(IWORD.EQ.'OBS') GO TO 15 DO 1 J=1,NV,6 NUM=IBASE+J/6+1 READ(IBNK#NUM)LV DO 1 K=1,6 IF(IWORD.NE.NNS(1,K)) GO TO 1 IV=J+K-1 GO TO 13 1 CONTINUE DO 100 I=1,5 100 TAKPT(I)=' ' DECODE (5,2,IWORD) TAKPT 2 FORMAT (5A1) IF (TAKPT(1).NE.'#') GO TO 8 TAKPT(1)=' ' IF (TAKPT(2).NE.' ') GO TO 3 IERR=2 GO TO 13 3 IF (TAKPT(5).NE.' ') GO TO 5 DO 4 I=4,1,-1 4 TAKPT(I+1)=TAKPT(I) GO TO 3 5 DO 200 I=1,5 200 IF(TAKPT(I).NE.' '.AND.(TAKPT(I).LT.'0'.OR.TAKPT(I).GT.'9')) #GO TO 16 ENCODE (5,2,IWORD) TAKPT DECODE (5,6,IWORD) IV 6 FORMAT (I5) IF ((IV.GE.1).AND.(IV.LE.NV)) GO TO 13 IERR=3 GO TO 13 8 IF (TAKPT(1).NE."771004020100) GO TO 12 TAKPT(1)=' ' 9 IF (TAKPT(5).NE.' ') GO TO 11 DO 10 I=4,1,-1 10 TAKPT(I+1)=TAKPT(I) GO TO 9 11 DO 201 I=1,5 201 IF(TAKPT(I).NE.' '.AND.(TAKPT(I).LT.'0'.OR.TAKPT(I).GT.'9')) #GO TO 16 ENCODE (5,2,IWORD) TAKPT DECODE (5,6,IWORD) IV IV=-IV GO TO 13 15 IV=999999999 GO TO 13 12 IERR=1 13 RETURN 16 IERR=17 RETURN END SUBROUTINE COMPD (LINE,N,WORD,IDEF,ITYPES) DIMENSION LINE(1),ICHAR(15),COMP(3),ITYPES(9) DATA IALT/"155004020100/ DO 1 I=1,15 1 ICHAR(I)=' ' COMP(1)=0 L=1 NUM=0 IF(LINE(N).EQ.'.') NUM=1 IF ((LINE(N).LT.'0').OR.(LINE(N).GT.'9')) GO TO 2 NUM=1 GO TO 4 2 IF(LINE(N).EQ.IALT) GO TO 13 DO 3 I=1,9 IF (ITYPES(I).NE.LINE(N)) GO TO 3 IDEF=I IF (NUM.EQ.1) IDEF=IDEF+10 GO TO 7 3 CONTINUE 4 IF (NUM.NE.1) GO TO 5 IF ((LINE(N).GE.'0').AND.(LINE(N).LE.'9')) GO TO 5 IF(LINE(N).EQ.'.') GO TO 5 IDEF=80 GO TO 7 5 IF (L.GT.15) GO TO 6 ICHAR(L)=LINE(N) L=L+1 6 N=N+1 IF (N.LT.80) GO TO 2 13 IDEF=9 IF (NUM.EQ.1) IDEF=19 7 ENCODE (15,8,COMP) ICHAR 8 FORMAT (15A1) IF (L.GT.1) GO TO 9 IDEF=-IDEF WORD=0 GO TO 12 9 IF (NUM.NE.1) GO TO 11 DECODE (15,10,COMP) WORD 10 FORMAT (F) GO TO 12 11 WORD=COMP(1) 12 N=N+1 RETURN END