Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0137/bank/bnk2.ban
There are 3 other files named bnk2.ban in the archive. Click here to see a list.
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),ITBL(30,30)
DIMENSION LV(125),ITBLA(30,15),ITBLB(30,15)
INTEGER CMDS
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 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/
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)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 NTO 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
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 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 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
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