Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/stp9.stp
There is 1 other file named stp9.stp in the archive. Click here to see a list.
C                                        *** STAT PACK ***
C     SUBROUTINE FOR INPUTTING DATA FROM A PRE-CREATED DATA BANK
C     CALLING SEQUENCE: CALL ABANK(NV,NC,MV,MC,DATA,VMN,COR,STD,INV,NAMES)
C     WHERE NV - IS THE NUMBER OV COLUMNS ACTUALLY FILLED (VARIABLES)
C           NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (CASES)
C           MV - IS MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN MAIN.
C           MC - IS MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN MAIN.
C           DATA - STORAGE FOR DATA, DIMENSIONED FOR MAXIMUM MATRIX.
C           VMN - IS A VECTOR CONTAINING VARIABLE MEANS.
C           COR - IS A MATRIX CONTAINING CORRELATIONS.
C           STD - IS A VECTOR CONTAINING VARIABLE STANDARD DEVIATIONS.
C           INV - IS A VECTOR AT LEAST MV LONG.
C           NAMES - S A VECTOR CONTAINING VARIABLE NAMES
C
C     PROGRAM IS UPDATE OF ONE ORIGINALLY WRITTEN FOR MANAGEMENT
C     DEPARTMENT TO ACCESS STORED DATA BANKS.  STRUCTURE IS SET SUCH
C     THAT AS MANY VARIABLES AS ARE NECESSARY MAY BE USED AND AS
C     MANY OBSERVATIONS AS ARE NECESSARY MAY BE USED.  ALL VARIABLES
C     RECOVERED ARE FORCED TO BE FLOATING POINT RATHER THEY WERE ORIGINALLY
C      FIXED OR FLOATING.  ALPHA VARIABLES ARE COMPLETELY OUT OF BOUNDS
C      AND ANY ATTEMPT TO USE THEM WILL BE THROWN OUT OF THE REQUEST.
C      ALPHA VARIABLES MAY BE USED IN SELECT STATEMENTS HOWEVER.
C      MISSING DATA IS REPRESENTED AS OCTAL 400000000000 IN THE
C     BANK.  WHEN READ INTO STP THEY ARE REPLACED WITH -9999E-20.
C     THE DATA BANK STORES DATA IN A BINARY FILE, EACH BLOCK CONTAINING
C     125 OBSERVATIONS.  THE BLOCK STRUCTURE IS AS FOLLOWS:
C     BLOCK 1 - VARIABLE 1 OBSERVATIONS 1-125
C     BLOCK 2 - VARIABLE 1 OBSERVATIONS 126-250
C     BLOCK 3 - VARIABLE 1 OBSERVATIONS 251-375
C         .
C         .
C         .
C         .
C     BLOCK N - VARIABLE 1 OBSERVATION (N-1)*125-LAST OBSERVATION IN BANK
C     BLOCK N+1 - VARIABLE 2 OBSERVATION 1-125
C     BLOCK N+2 - VARIABLE 2 OBSERVATION 126-250
C     BLOCK N+3 - VARIABLE 2 OBSERVATION 251-375
C         .
C         .
C         .
C     BLOCK 2*N - VARIABLE 2 OBSERVATION (N-1)*125+1-LAST OBSERVATION
C         .
C         .
C         .
C         .
C     BLOCK NV*N - VARIABLE NV(LAST VARIABLE) OBSERVATION THROUGH LAST
C     AS PICKED UP ALL DATA MAINTAINS A PLACE
C     RELATIONSHIP, THAT IS: VAR 1 OBSERVATIONS 17 COMES FROM THE 
C     SAME  OBSERVATION ON THE DATA BANK THAT VAR 14 OBSERVATION
C     17 CAME FROM.  MAKING CORRELATIONS BETWEEN DATA FOR HEIGHTS
C     AND WEIGHTS MEANINGFUL.  THIS COMMAND IS, HOWEVER, CAPABLE
C     OF RECOVERING DATA LIKE: THE IQ OF ALL BOYS AS VAR 1, AND THE 
C     IQ OF ALL GIRLS AS VARIABLE 2.  THE ONLY RESTRICTION HERE IS
C     OF COURSE, THE SAMPLE NEEDS THE SAME NUMBER OF OBSERVATIONS
C     FOR ALL VARIABLES.  IF THEY HAVE DIFFERENT SIZES, THE LARGER
C     IS SIMPLY TRIMMED.  IN ADDITION STARTING POINTS CAN BE GIVEN.
C     IF A COMMAND WERE GIVEN TO START AT OBSERVATION 73 THE PROGRAM
C     WOULD GATHER ALL POSSIBLE DATA, REJECTING ANY WITH MISSING
C     DATA OBSERVATIONS, MAKING ONE COMPLETE PASS THROUGH THE BANK.  THIS 
C     COMMAND ALSO HAS A POWERFUL SUBSETTING PACKAGE ALLOWING THE
C     USER TO LOOK AT SOMETHING LIKE: THE IQ'S OF BOYS 21 YEARS OLD,
C     WITH A GPA OF 3.0 OR HIGHER.  THE "ACBNK" STATEMENT ALSO
C     ALLOWS RECOVERY OF MISSING DATA, BY THE SIMPLE SETTING OF A 
C     SWITCH.  NAMES MAY BE USED TO ACCESS THE BANK.  6 NAME DESCRIPTIONS
C     WILL BE STORED PER RECORD; EACH DESCRIPTION IS MADE UP OF 1 WORD
C     NAME(5 CHARACTERS), A 9 WORD (45 CHARACTER) VARIABLE DESCRIPTION,
C     AND A 1 WORD MODE(0-FLOAT, 1-ALPHA, 2-FIXED).
C
      SUBROUTINE ABANK(NV,NC,MV,MC,DATA,VMN,COR,STD,INV,ICOND,NAMES)
      DIMENSION VMN(1),DATA(MC,MV),COR(MV,MV),STD(1)
      DIMENSION INV(1),ICOND(1),NAMES(1),PATH(3)
      DIMENSION INPUT(80),D(1500),ID(1500),NAME(10),IO(125),NNS(18,6)
      DIMENSION IVSL(20),ISLCOD(20),VALUE(20),IWTBP(20),MODE(20)
      EQUIVALENCE (ID,D),(MISS,AMISS),(IO,NNS)
      EQUIVALENCE(PATH(1),IPJ),(PATH(2),IPG)
      COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK
      DOUBLE PRECISION BNKNM,XTRA
C     NBL IS LEFT HAND BRACKET NBR IS RIGHT HAND BRACKET
      NBL="555004020100
      NBR="565004020100
      PATH(3)=0
      MISS="400000000000
      SWM=0
      SWQ=0
      SWS=0
      SWI=0
      IPJ=0
      IPG=0
      IROOM=1500
      NV=0
      ISTART=1
      IBNK=1
1     IF(ICC.NE.2) WRITE(IDLG,2)
2     FORMAT('0BANK AND SWITCHES? ',$)
      READ(ICC,3,END=440)INPUT
3     FORMAT(80A1)
      IF(INPUT(1).EQ.'!') GO TO 440
      IF(INPUT(1).EQ.' ') GO TO 440
C
C     ..............................................................
C     IF HELP IS NEEDED
C     ...............................................................
C
      IF((INPUT(1).NE.'H').OR.(INPUT(2).NE.'E').OR.(INPUT(3).NE.'L').OR.
     1(INPUT(4).NE.'P')) GO TO 7
      WRITE (IDLG,4)
      WRITE(IDLG,5)
      WRITE (IDLG,6) NBL,NBR
4     FORMAT('0THIS PACKAGE WAS WRITTEN TO ACCESS STORED BINARY DATA'/
     1' BANKS.  IT ALLOWS FOR SUBSETTING OF DATA, REJECTION OF'/
     2' OBSERVATIONS CONTAINING MISSING DATA, AND RECOVERY OF'/
     3' INDEPENDENT SAMPLES.  WHEN THE PROGRAM CALLS FOR THE NAME'/
     4' OF THE FILE, TYPE IN THE NAME WITHOUT THE EXTENSION.  TO'/
     5' ACCESS THE BANK IT WILL HAVE BEEN NECESSARY TO CREATE'/
     6' IT IN THE PROGRAM MABNK, THUS IT WILL ALREADY HAVE THE'/
     7' EXTENSION "BNK".  DIRECTLY ADJOINING THIS WILL BE THE'/
     8' PROJECT-PROGRAMMER NUMBER IN BRACKETS (IF OTHER THAN YOUR OWN).'
     9/' NEXT WILL BE ANY SWITCHES YOU WISH TO SET, ENCLOSED IN'/
     1' PARANTHESES.  SWITCHES AVAILABLE ARE:'/
     2'   Q-SPECIFY QUALIFYING FIELDS.'/'   I-INDEPENDENT SAMPLES.'/
     3'   S-SPECIFY STARTING OBSERVATION NUMBER OTHER THAN 1.'/
     4'   M-ALLOW RECOVERY OF OBSERVATIONS WITH MISSING DATA.*'/
     5' VARIABLES ARE ENTERED BY THEIR CORRESPONDING BANK CODES'/
     6' OR NAMES, IF NAMES HAVE BEEN DEFINED FOR THE BANK.'/
     6'ALL VARIABLES ENTERED AT ONE TIME WILL MAINTAIN'/
     7' A PLACE RELATIONSHIP.  IT IS POSSIBLE TO SUBSET THE DATA BY'/
     8' USE OF THE Q SWITCH.'/)
5     FORMAT(' QUALIFYING VARIABLES ARE ENTERED BY A BANK CODE OR NAME,'/
     1/' A  RELATIONSHIP CODE, AND A VALUE FOR GROUPING.'/
     2' THESE ARE TYPED ON THE SAME LINE WITH NO SPACES (1 QUALIFIER'/
     1' PER LINE).  THE RELATIONSHIP CODES ARE:'/
     5' ",EQ," OR "="  -  EQUAL'/
     5' ",LT," OR "<"  -  LESS THAN'/
     5' ",GT," OR ">"  -  GREATER THAN'/
     5' ",NE," OR "<>" OR "><"  -  NOT EQUAL TO'/
     5' ",LE," OR "<=" OR "=<"  -  LESS THAN OR EQUAL TO'/
     5' ",GE," OR ">=" OR "=>"  -  GREATER THAN OR EQUAL TO'/
     7' AN INSTRUCTION TO KEEP ONLY THOSE OBSERVATIONS WHERE VARIABLE '/
     8' 1 IS LESS THAN 10 MIGHT LOOK LIKE THIS:'/' 1,LT,10'/
     9' TO STOP INSERTION OF QUALIFYING FIELDS TYPE A <CR>,'/
     1' ^Z(CONTROL Z), OR "STOP"'/)
6     FORMAT(' A TYPICAL RUN MIGHT LOOK LIKE THIS:'/
     1' .............'/' WHAT BANK NAME AND SWITCHES? ',
     2'DATA',A1,'420,420',A1,'(QS)'/' WHAT STARTING POSITION? 170'/
     3' LIST BANK CODES SEPERATED BY COMMAS'/' 1,2,4'/
     4' LIST QUALIFYING FIELDS IN FOLLOWING MANNER'/
     5' 1 PER LINE: BANK CODE, RELATIONSHIP, VALUE AT POINT'/
     6' 3,LT,17'/' AGE=9'/' 4>=3'/' STOP'/' .............'/
     7' DATA BANK WAS LOCATED IN AREA 420,420.  IT WAS RECOVERED'/
     8' LISTING A STARTING POINT OF 170; AND 3 QUALIFYING FIELDS,'/
     9' SUBSETTING THE DATA SO THAT EVERY OBSERVATION USED FOR DATA'/
     1' HAS BANK CODE 3 LESS THAN 17, AGE EQUAL TO 9, AND'/
     2' BANK CODE 4 GREATER THAN OR EQUAL TO 3.'//
     3' * MISSING DATA IS REPRESENTED BY THE NUMBER -9999E-20')
      GO TO 1
C
C     .............................................................
C
C     USED TO DETERMINE NAME OF FILE TO BE FOUND
C
C     ............................................................
C
7     DO 8 I=1,10
8     NAME(I)=' '
      I=1
11    IF(INPUT(I).EQ.NBL) GO TO 14
      IF(INPUT(I).EQ.'(') GO TO 14
      IF(INPUT(I).EQ.' ') GO TO 14
      IF(INPUT(I).EQ.'/') GO TO 14
      IF(INPUT(I).NE.'.') GO TO 10
      WRITE(IDLG,9)
9     FORMAT(' NO EXTENSION NECESSARY ".BNK" WILL BE ADDED')
      GO TO 14
10    IF(I.LE.6) GO TO 13
      WRITE(IDLG,12)
12    FORMAT(' BANK NAME TOO LONG')
      GO TO 1
13    NAME(I)=INPUT(I)
      I=I+1
      GO TO 11
14    IF(I.EQ.1) RETURN
      NAME(I)='.'
      NAME(I+1)='B'
      NAME(I+2)='N'
      NAME(I+3)='K'
      ENCODE(10,3,BNKNM) NAME
      IF(INPUT(I).NE.NBL) GO TO 35
C
C     PROJECT NUMBER
C
      DO 15 J=1,10
15    NAME(J)=' '
      J=1
21    I=I+1
      IF(INPUT(I).EQ.',') GO TO 22
      IF(INPUT(I).EQ.' ') GO TO 20
      IF(INPUT(I).NE.NBR) GO TO 17
20    WRITE(IDLG,16)
16    FORMAT(' NO COMMA BETWEEN PROJECT AND PROGRAMMER NUMBER')
      GO TO 1
17    IF((INPUT(I).LE.'7').AND.(INPUT(I).GE.'0')) GO TO 19
      WRITE(IDLG,18) INPUT(I)
18    FORMAT(' THE CHARACTER "',A1,'" IS ILLEGAL FOR PROJECT NUMBER')
      GO TO 1
19    IF(J.GT.6) GO TO 20
      NAME(J)=INPUT(I)
      J=J+1
      GO TO 21
22    IF(NAME(6).NE.' ') GO TO 24
      DO 23 J=6,2,-1
23    NAME(J)=NAME(J-1)
      NAME(1)=' '
      GO TO 22
24    ENCODE(10,3,XTRA) NAME
      DECODE(6,34,XTRA) IPJ
C 
C     PROGRAMMER NUMBER
C
      DO 25 J=1,10
25    NAME(J)=' '
      J=1
      I=I+1
30    IF(INPUT(I).EQ.NBR) GO TO 31
      IF(INPUT(I).EQ.' ') GO TO 31
      IF((INPUT(I).LE.'7').AND.(INPUT(I).GE.'0')) GO TO 27
      WRITE(IDLG,26) INPUT(I)
26    FORMAT(' THE CHARACTER "',A1,'" IS ILLEGAL FOR PROGRAMMER NUMBER')
      GO TO 1
27    IF(J.LE.6) GO TO 29
      WRITE(IDLG,28)
28    FORMAT(' PROGRAMMER NUMBER TOO LONG')
      GO TO 1
29    NAME(J)=INPUT(I)
      J=J+1
      I=I+1
      GO TO 30
31    IF(NAME(6).NE.' ') GO TO 33
      DO 32 J=6,2,-1
32    NAME(J)=NAME(J-1)
      NAME(1)=' '
      GO TO 31
33    ENCODE(10,3,XTRA) NAME
      DECODE(6,34,XTRA) IPG
34    FORMAT(O6)
      I=I+1
C
C
C
35    CALL EXIST(BNKNM,IERR,IPJ,IPG)
      IF(IERR.EQ.0) GO TO 39
      WRITE(IDLG,38)
38    FORMAT(' BANK NOT AVIALABLE')
      GO TO 1
C
C     SWITCH IF SET MUST BE ENCLOSED IN PARANTHESIS OR PRECEDED BY A /
C
39    OPEN(UNIT=IBNK,FILE=BNKNM,ACCESS='RANDIN',MODE='BINARY',
     1RECORD SIZE=126,DIRECTORY=PATH)
      READ(IBNK#1) NVB,NOB,(J,K=3,7),VERSON,(J,K=9,125)
      IF(VERSON.EQ.'V2') GO TO 37
      WRITE(IDLG,36)
36    FORMAT(' THIS BANK CREATED WITH AN EXPERIMENTAL VERSION'/
     1' TO UPDATE THE BANK RUN BANKUP FROM AREA 220,220.  IF YOU'/
     2' ARE  NOT RESPONSIBLE FOR THE BANK CONTACT THE OWNER')
      RETURN
37    NOBASE=(NOB+124)/125
      IBASE=NOBASE*NVB+1
      LBASE=(NVB+5)/6
      GO TO 55
40    I=I+1
55    IF(INPUT(I).EQ.' ') GO TO 60
      IF(INPUT(I).EQ.'/') GO TO 42
      IF(INPUT(I).EQ.'(') GO TO 51
      WRITE(IDLG,41)
41    FORMAT(' SWITCHES MUST BE PRECEDED BY A / OR ENCLOSED IN ',
     1'PARANTHESES')
      GO TO 1
C
C     SWITCHES PRECEDED BY A /
C
42    I=I+1
      IF(INPUT(I).NE.'Q') GO TO 46
      IF(SWQ.NE.1) GO TO 45
43    WRITE(IDLG,44) INPUT(I)
44    FORMAT(' SWITCH ',A1,' SPECIFIED TWICE IN STRING OF SWITCHES')
      GO TO 1
45    SWQ=1
      GO TO 40
46    IF(INPUT(I).NE.'I') GO TO 47
      IF(SWI.EQ.1) GO TO 43
      SWI=1
      GO TO 40
47    IF(INPUT(I).NE.'S') GO TO 48
      IF(SWS.EQ.1) GO TO 43
      SWS=1
      GO TO 40
48    IF(INPUT(I).NE.'M') GO TO 49
      IF(SWM.EQ.1) GO TO 43
      SWM=1
      GO TO 40
49    WRITE(IDLG,50) INPUT(I)
50    FORMAT(' SWITCH "',A1,'" DOES NOT EXIST')
      GO TO 1
C
C     SWITCHES ENCLOSED IN PARANTHESIS
C
51    I=I+1
      IF(INPUT(I).EQ.')') GO TO 40
      IF(INPUT(I).NE.'Q') GO TO 52
      IF(SWQ.EQ.1) GO TO 43
      SWQ=1
      GO TO 51
52    IF(INPUT(I).NE.'I') GO TO 53
      IF(SWI.EQ.1) GO TO 43
      SWI=1
      GO TO 51
53    IF(INPUT(I).NE.'S') GO TO 54
      IF(SWS.EQ.1) GO TO 43
      SWS=1
      GO TO 51
54    IF(INPUT(I).NE.'M') GO TO 49
      IF(SWM.EQ.1) GO TO 43
      SWM=1
      GO TO 51
C
C     IF STARTING SWITCH WAS USED GET STARTING POSITION
C
60    IF(SWS.EQ.0) GO TO 514
502   IF(ICC.NE.2) WRITE(IDLG,500)
500   FORMAT(' WHAT IS THE STARTING ADRESS? ',$)
      READ(ICC,3,END=432) INPUT
      IF(INPUT(1).EQ.'!') GO TO 432
      IF(INPUT(1).EQ.' ') GO TO 514
      IF((INPUT(1).NE.'H').AND.(INPUT(2).NE.'E').AND.(INPUT(3).NE.'L').
     1AND.(INPUT(4).NE.'P')) GO TO 503
      WRITE(IDLG,501)
501   FORMAT(' ENTER THE OBSERVATION NUMBER OF THE BANK WHERE YOU'/
     1' WOULD LIKE TO BEGIN SELECTING DATA FROM')
      GO TO 502
503   DO 504 J=1,10
504   NAME(J)=' '
      J=1
      I=1
508   IF(INPUT(I).EQ.' ') GO TO 509
      IF((INPUT(I).LE.'9').AND.(INPUT(I).GE.'0')) GO TO 506
      WRITE(IDLG,505)
505   FORMAT(' INDICATE STARTING POSITION BY OBSERVATION NUMBER ONLY')
      GO TO 502
506   IF(J.GT.10) GO TO 507
      NAME(J)=INPUT(I)
      J=J+1
507   I=I+1
      IF(I.LE.80) GO TO 508
509   IF(NAME(10).NE.' ') GO TO 511
      DO 510 J=9,1,-1
510   NAME(J+1)=NAME(J)
      NAME(1)=' '
      GO TO 509
511   ENCODE(10,3,XTRA) NAME
      DECODE(10,515,XTRA) I
515   FORMAT(I10)
      IF((I.LE.NOB).AND.(I.GT.0)) GO TO 513
      WRITE(IDLG,512)
512   FORMAT(' STARTING POSITION NOT IN RANGE OF OBSERVATIONS IN BANK')
      GO TO 502
513   ISTART=I
514   NVSF=0
      NOSF=MC
      IF(SWI.EQ.0) GO TO 62
      IF(ICC.NE.2) WRITE(IDLG,61)
61    FORMAT('0INDEPENDENT SAMPLES WILL BE TAKEN ON SUCCESSIVE'/
     1' "LIST VARIABLES".   WHEN ALL INDEPENDENT SAMPLES HAVE BEEN'/
     2' GIVEN TYPE A ^Z(CONTROL Z) OR A <CR>')
      ISAMP=0
62    ISAMP=ISAMP+1
59    IF((SWI.EQ.1).AND.(ICC.NE.2))  WRITE(IDLG,63)  ISAMP
63    FORMAT(' INDEPENDENT SAMPLE ',I2/)
147   IF(ICC.NE.2) WRITE(IDLG,64)
64    FORMAT(' ENTER VARIABLES SEPARATED BY COMMAS'/)
      READ(ICC,3,END=400) INPUT
      IF(INPUT(1).EQ.'*') GO TO 600
      IF((INPUT(1).NE.'H').OR.(INPUT(2).NE.'E').OR.(INPUT(3).NE.'L').
     1 OR.(INPUT(4).NE.'P').OR.(INPUT(5).NE.' ')) GO TO 131
      WRITE(IDLG,130)
130   FORMAT(' ENTER THE VARIABLES TO BE RECOVERED FROM THE BANK.'/
     1' EITHER VARIABLE NAMES OR NUMBERS MAY BE USED.  RANGES MAY'/
     2' BE ENTERED BY LISTING THE EXTREMES OF THE RANGE SEPARATED'/
     3' BY A -'/)
      GO TO 147
131   IF(INPUT(1).EQ.'!') GO TO 432
      IF(INPUT(1).EQ.' ') GO TO 400 
      NVTBR=0
      I=1
65    DO 66 J=1,5
66    NAME(J)=' '
      J=1
      NUM=0
67    IF(INPUT(I).EQ.',') GO TO 72
      IF(INPUT(I).EQ.'-') GO TO 72
      IF(INPUT(I).EQ.' ') GO TO 72
      IF(J.NE.1) GO TO 68
      IF((INPUT(I).GT.'9').OR.(INPUT(I).LT.'0')) GO TO 70
      NUM=1
      GO TO 70
68    IF(NUM.EQ.0) GO TO 70
      IF((INPUT(I).LE.'9').AND.(INPUT(I).GE.'0')) GO TO 70
      WRITE(IDLG,69)
69    FORMAT(' COMMA MISSING BETWEEN VARIABLE NUMBER AND NAME'/)
      GO TO 147
70    IF(J.GT.5) GO TO 71
      NAME(J)=INPUT(I)
      J=J+1
71    I=I+1
      IF(I.LE.80) GO TO 67
72    IF(J.GT.1) GO TO 148
      WRITE(IDLG,73)
73    FORMAT(' WHERE A NAME OR VARIABLE NUMBER SHOULD HAVE OCCURRED ',
     1' NONE DID')
      GO TO 147
148   NVTBR=NVTBR+1
      IF((NVSF+NVTBR).LE.MV) GO TO 75
93    WRITE(IDLG,74)
74    FORMAT(' MORE VARIABLES THAN ROOM ALLOCATED'/)
      GO TO 147
75    STD(NVTBR)=NUM
      IF(NUM.EQ.0) GO TO 79
C
C     VARIABLE IS INDICATED BY NUMBERS
C
77    IF(NAME(5).NE.' ') GO TO 78
      DO 76 J=5,2,-1
76    NAME(J)=NAME(J-1)
      NAME(1)=' '
      GO TO 77
78    ENCODE(5,3,NAMCP) (NAME(J),J=1,5)
      DECODE(5,149,NAMCP) INV(NVTBR)
149   FORMAT(I5)
      IF((INV(NVTBR).LE.NVB).AND.(INV(NVTBR).GT.0)) GO TO 80
      WRITE(IDLG,119) INV(NVTBR)
119   FORMAT(' VARIABLE ',I5,' DOES NOT EXIST')
      GO TO 147
C
C     VARIABLE IS INDICATED BY NAME
C
79    ENCODE(5,3,NAMCP)(NAME(J),J=1,5)
      IF(NAMCP.EQ.'STOP') GO TO 400
      IF(NAMCP.EQ.'ALL') GO TO 600
      NAMES(NVSF+NVTBR)=NAMCP
      IF(NAMES(NVSF+NVTBR).NE.'OBS') GO TO 80
      NAMES(NVSF+NVTBR)='OBSER'
      INV(NVTBR)=0
      STD(NVTBR)=2
      ICOND(NVTBR)=0
80    IF(INPUT(I).NE.',') GO TO 81
      I=I+1
      VMN(NVTBR)=1
      GO TO 65 
81    IF(INPUT(I).NE.'-') GO TO 82
      I=I+1
      VMN(NVTBR)=2
      GO TO 65
82    VMN(NVTBR)=3
C
C     FILL IN NAMES AND MODES FOR NUMBERS, AND MODES AND NUMBERS FOR NAMES
C
      DO 83 I=1,LBASE
      IREC=IBASE+I
      READ(IBNK#IREC) IO
      IREDY=(I-1)*6
      IEND=6
      IF((I*6).GT.NVB) IEND=NVB-IREDY
      DO 84 J=1,IEND
      DO 85 K=1,NVTBR
      M=STD(K)+1
      GO TO (87,86,85),M
86    IF(INV(K).NE.(IREDY+J)) GO TO 85
      NAMES(NVSF+K)=NNS(1,J)
      ICOND(K)=NNS(10,J)
      STD(K)=2
      GO TO 85
87    IF(NAMES(NVSF+K).NE.NNS(1,J)) GO TO 85
      INV(K)=IREDY+J
      ICOND(K)=NNS(10,J)
      STD(K)=2
85    CONTINUE
84    CONTINUE
83    CONTINUE
C
C     CHECK FOR NAMES THAT DIDN'T EXIST AND ALPHA VARIABLES
C
      DO 90 I=1,NVTBR
      IF(STD(I).NE.0) GO TO 92
      WRITE(IDLG,91) NAMES(NVSF+I)
91    FORMAT(' VARIABLE ',A5,' NOT USED IN THIS BANK')
      GO TO 147
92    IF(ICOND(I).NE.1) GO TO 90
      WRITE(IDLG,94) NAMES(NVSF+I)
94    FORMAT(' VARIABLE ',A5,' IS ALPHA - NO ALPHAS IN STP!')
      GO TO 147
90    CONTINUE
C
C     TAKE CARE OF RANGES
C
      KREC=0
      I=1
100   IF(VMN(I).EQ.1) GO TO 105
      IF(VMN(I).EQ.3) GO TO 110
      IBEG=INV(I)
      IEND=INV(I+1)
      INCRE=1
      IF(IBEG.GT.IEND) INCRE=-1
      IDIFF=(IEND-IBEG)*INCRE-1
      IF((IDIFF+NVTBR).GT.MV) GO TO 93
      IF(IDIFF.LT.1) GO TO 105
      DO 101 J=NVTBR,I+1,-1
      INV(IDIFF+J)=INV(J)
      ICOND(IDIFF+J)=ICOND(J)
      NAMES(NVSF+IDIFF+J)=NAMES(NVSF+J)
      VMN(IDIFF+J)=VMN(J)
101   CONTINUE
      DO 102 J=1,IDIFF
      INV(I+J)=INV(I+J-1)+INCRE
      IREC=(INV(I+J)+5)/6
      IF(IREC.EQ.KREC) GO TO 103
      KREC=IREC
      READ(IBNK#(KREC+IBASE)) IO
103   IONE=INV(I+J)-(KREC-1)*6
      IF(NNS(10,IONE).EQ.1) GO TO 93
      ICOND(I+J)=NNS(10,IONE)
      NAMES(NVSF+I+J)=NNS(1,IONE)
102   CONTINUE
      NVTBR=NVTBR+IDIFF
      I=I+IDIFF
105   I=I+1
      GO TO 100
C
C     ILLIMINATE DUPLICATES
C
110   I=2
      IF(NVTBR.LT.2) GO TO 118
116   DO 111 J=1,I-1
      IF(INV(J).EQ.INV(I)) GO TO 112
111   CONTINUE
      GO TO 114
112   IF(I.EQ.NVTBR) GO TO 117
      DO 113 J=I+1,NVTBR
      INV(J-1)=INV(J)
      ICOND(J-1)=ICOND(J)
      NAMES(NVSF+J-1)=NAMES(NVSF+J)
113   CONTINUE
117   NVTBR=NVTBR-1
      GO TO 115
114   I=I+1
115   IF(I.LE.NVTBR) GO TO 116
118   IF(NVTBR.GT.0) GO TO 122
      WRITE(IDLG,123)
123   FORMAT(' NO VARIABLES TO BE READ'/)
      GO TO 147
600   NVTBR=0
      DO 601 I=1,LBASE
      IREC=IBASE+I
      READ(IBNK#IREC) IO
      IREDY=(I-1)*6
      IEND=6
      IF((I*6).GT.NVB) IEND=NVB-IREDY
      DO 602 J=1,IEND
      IF(NNS(10,J).EQ.1) GO TO 602
      NVTBR=NVTBR+1
      IF(NVTBR.LE.MV)GO TO 604
      WRITE(IDLG,603)
603   FORMAT(' MORE VARIABLES IN BANK THAN ROOM ALLOCATED')
      GO TO 147
604   INV(NVTBR)=IREDY+J
      ICOND(NVTBR)=NNS(10,J)
      NAMES(NVSF+NVTBR)=NNS(1,J)
602   CONTINUE
601   CONTINUE
C
C     SELECTION PORTION 
C 
122   NUSED=NVTBR
      ISL=1
      IF(SWQ.EQ.0) GO TO 299 
      IF(ICC.NE.2) WRITE(IDLG,605)
605   FORMAT('0ENTER QUALIFIERS'/)
150   IF(ICC.NE.2) WRITE(IDLG,146)
146   FORMAT('+? ',$)
      READ(ICC,3,END=299) INPUT
      IF(INPUT(1).EQ.'!') GO TO 432 
      IF(INPUT(1).EQ.' ') GO TO 299 
      I=1
151   DO 152 J=1,5
152   NAME(J)=' '
      J=1
      NUM=0
153   IF(INPUT(I).EQ.'.') GO TO 158
      IF(INPUT(I).EQ.',') GO TO 158
      IF(INPUT(I).EQ.'<') GO TO 158
      IF(INPUT(I).EQ.'>') GO TO 158
      IF(INPUT(I).EQ.'=') GO TO 158
      IF(INPUT(I).EQ.' ') GO TO 158
      IF(J.NE.1) GO TO 154
      IF((INPUT(I).LT.'0').OR.(INPUT(I).GT.'9')) GO TO 156
      NUM=1
      GO TO 156
154   IF(NUM.EQ.0) GO TO 156
      IF((INPUT(I).LE.'9').AND.(INPUT(I).GE.'0')) GO TO 156
      WRITE(IDLG,155)
155   FORMAT('0VARIABLE NUMBER INCORRECT'/)
      GO TO 150
156   IF(J.GT.5) GO TO 157
      NAME(J)=INPUT(I)
      J=J+1
157   I=I+1
      GO TO 153
158   IF(NUM.EQ.1) GO TO 165
C
C     SELECT VARIABLE IS A NAME
C
      ENCODE(5,3,NAMCP) (NAME(J),J=1,5)
      DO 159 J=1,NUSED
      IF(NAMCP.NE.NAMES(NVSF+J)) GO TO 159
      IVSL(ISL)=-J
      MODE(ISL)=0
      IWTBP(ISL)=J
      GO TO 180
159   CONTINUE
      IF(NAMCP.NE.'HELP') GO TO 173
      WRITE(IDLG,174)
174   FORMAT('0UP TO 20 QUALIFIERS MAY BE ENTERED, 1 PER LINE'/
     1' IN RESPONSE TO A QUESTION MARK.  WHEN THE LAST QUALIFIER HAS'/
     2' BEEN ENTERED, TYPE A ^Z, BLANK LINE, OR STOP.  QUALIFIERS'/
     3' ARE COMPRISED OF A VARIABLE (SPECIFIED BY NAME OR NUMBER)'/
     4' A CONDITION (MAY BE SPECIFIED BY A COMBINATION OF THESE'/
     5' SYMBOLS: <>=, OR THE STANDARD FORTRAN NOTATION: NE,EQ,'/
     6' ETC.), AND THE VALUE TO BE COMPARED AGAINST (IF THE VARIABLE'/
     7' BEING CHECKED IS ALPHANUMERIC THEN THE VALUE MUST BE ENCLOSED'/
     8' IN QUOTES.'/)
      GO TO 150
173   IF(NAMCP.EQ.'STOP') GO TO 299
      IF(NAMCP.NE.'ALL') GO TO 171
      WRITE(IDLG,172)
172   FORMAT(' ALL MAY NOT BE USED IN A SELECT'/)
      GO TO 150
171   IF(NAMCP.EQ.'OBS') GO TO 163
      DO 160 J=1,LBASE
      READ(IBNK#(IBASE+J)) IO
      IEND=6
      IF((J*6).GT.NVB) IEND=NVB-J*6+6
      DO 160 K=1,IEND
      IF(NAMCP.EQ.NNS(1,K)) GO TO 161
160   CONTINUE
      WRITE(IDLG,162) NAMCP
162   FORMAT('0VARIABLE "',A5,'" DOES NOT EXIST'/)
      GO TO 150
161   IVSL(ISL)=(J-1)*6+K
      MODE(ISL)=NNS(10,K)
      GO TO 164
163   IVSL(ISL)=0
      MODE(ISL)=0
164   NVTBR=NVTBR+1
      IWTBP(ISL)=NVTBR
      GO TO 180
C
C     SELECT VARIABLE IS A NUMBER
C
165   IF(NAME(5).NE.' ') GO TO 167
      DO 166 J=5,2,-1
166   NAME(J)=NAME(J-1)
      NAME(1)=' '
      GO TO 165
167   ENCODE(5,3,NAMCP)(NAME(J),J=1,5)
      DECODE(5,149,NAMCP) IVSL(ISL)
      IF((IVSL(ISL).LE.NVB).AND.(IVSL(ISL).GE.1)) GO TO 169
      WRITE(IDLG,168) IVSL(ISL)
168   FORMAT('0VARIABLE NO ',I5,' DOES NOT EXIST'/)
      GO TO 150
169   DO 170 J=1,NUSED
      IF(INV(J).NE.IVSL(ISL)) GO TO 170
      IVSL(ISL)=-J
      MODE(ISL)=0
      IWTBP(ISL)=J
      GO TO 180
170   CONTINUE
      J=(IVSL(ISL)+5)/6
      IONE=IVSL(ISL)-(J-1)*6
      READ(IBNK#(IBASE+J)) IO
      MODE(ISL)=NNS(10,IONE)
      NVTBR=NVTBR+1
      IWTBP(ISL)=NVTBR
      GO TO 180
C
C     SELECT CONDITION
C
180   IF((INPUT(I).EQ.'.').OR.(INPUT(I).EQ.',')) GO TO 190
C
C     SIGNS USED (<>=)
C
      IE=0
      IG=0
      IL=0
181   IF(INPUT(I).NE.'=') GO TO 182
      IF(IE.EQ.1) GO TO 184
      IE=1
      GO TO 186
182   IF(INPUT(I).NE.'<') GO TO 183
      IF(IL.EQ.1) GO TO 184
      IL=1
      GO TO 186
183   IF(INPUT(I).NE.'>') GO TO 187
      IF(IG.EQ.1) GO TO 184
      IG=1
      GO TO 186
184   WRITE(IDLG,185) INPUT(I)
185   FORMAT('0CONDITION "',A1,'" SEPCIFIED TWICE'/)
      GO TO 150
186   I=I+1
      GO TO 181
187   ISLCOD(ISL)=IE*1+IL*2+IG*4
      IF((ISLCOD(ISL).GE.1).AND.(ISLCOD(ISL).LT.7)) GO TO 200
189   WRITE(IDLG,188)
188   FORMAT('0ILLEGAL CONDITION'/)
      GO TO 150
C
C     FOR SELECT 2 CHARACTER CODES WERE USED
C
190   IF(INPUT(I+3).NE.INPUT(I)) GO TO 189
      NAMCP=' '
      ENCODE(2,3,NAMCP) INPUT(I+1),INPUT(I+2)
      I=I+4
      ISLCOD(ISL)=0
      IF(NAMCP.EQ.'EQ') ISLCOD(ISL)=1
      IF(NAMCP.EQ.'LT') ISLCOD(ISL)=2
      IF(NAMCP.EQ.'LE') ISLCOD(ISL)=3
      IF(NAMCP.EQ.'GT') ISLCOD(ISL)=4
      IF(NAMCP.EQ.'GE') ISLCOD(ISL)=5
      IF(NAMCP.EQ.'NE') ISLCOD(ISL)=6
      IF(ISLCOD(ISL).EQ.0) GO TO 189
C
C     NOW VALUES TO BE COMPARED AGAINST
C
200   IF((INPUT(I).EQ.'M').AND.(INPUT(I+1).EQ.'I').AND.
     1(INPUT(I+2).EQ.'S').AND.(INPUT(I+3).EQ.'S')) GO TO 217
      IF(MODE(ISL).EQ.1) GO TO 210
C
C     VALUE IS NUMERIC
C
      DO 201 J=1,10
201   NAME(J)=' '
      J=1
202   IF((INPUT(I).EQ.'-').AND.(J.EQ.1)) GO TO 206
      IF(INPUT(I).EQ.'.') GO TO 206
      IF(INPUT(I).EQ.'E') GO TO 206
      IF(INPUT(I).EQ.' ') GO TO 205
      IF((INPUT(I).LE.'9').AND.(INPUT(I).GE.'0')) GO TO 206 
      WRITE(IDLG,203)
203   FORMAT('0VALUE TO BE COMPARED AGAINST MUST BE NUMERIC'/)
      GO TO 150
206   IF(J.GT.10) GO TO 204
      NAME(J)=INPUT(I)
      J=J+1
204   I=I+1
      IF(I.LT.80) GO TO 202
205   IF(J.EQ.1) GO TO 208
      IF(NAME(10).NE.' ') GO TO 208
      DO 207 J=10,2,-1
207   NAME(J)=NAME(J-1)
      NAME(1)=' '
      GO TO 205
208   ENCODE(10,3,XTRA) NAME
      DECODE(10,209,XTRA) VALUE(ISL)
209   FORMAT(F10.0)
      GO TO 220
217   VALUE(ISL)=AMISS
      GO TO 220
C
C     VALUE TO BE COMPARED AGAINST IS ALPHA
C
210   IF(INPUT(I).EQ.1H') GO TO 213
211   WRITE(IDLG,212)
212   FORMAT('0ALPHA VALUES MUST BE ENCLOSED IN QUOTES'/)
      GO TO 150
213   DO 214 J=1,5
214   NAME(J)=' '
      J=1
      I=I+1
215   IF(INPUT(I).EQ.1H') GO TO 216
      IF(J.GT.5) GO TO 216
      NAME(J)=INPUT(I)
      J=J+1
      I=I+1
      GO TO 215
216   ENCODE(5,3,VALUE(ISL)) (NAME(J),J=1,5)
220   ISL=ISL+1
      IF(ISL.LE.20) GO TO 150
C
C     NOW RECOVER DATA
C
299   ISL=ISL-1
      ISIZPV=IROOM/NVTBR
      IF(ISIZPV.GT.125) ISIZPV=125
      ONESW=0
      IBPOS=ISTART
      NC=1
      GO TO 303
302   IBPOS=IEPOS+1
      IF(IBPOS.GT.NOB) IBPOS=1
      IF((ONESW.EQ.1).AND.(IBPOS.EQ.ISTART)) GO TO 380
303   IBLO=(IBPOS+124)/125
      IEPOS=IBPOS+ISIZPV-1
      IF(IEPOS.GT.(IBLO*125)) IEPOS=IBLO*125
      IF(IEPOS.GT.NOB) IEPOS=NOB
      IF((ONESW.EQ.1).AND.(IEPOS.GT.ISTART)) IEPOS=ISTART-1
      JSUB=(IBLO-1)*125
      JADD=IBPOS-JSUB-1
      JEND=IEPOS-IBPOS+1
      DO 304 I=1,NUSED
      ISET=(I-1)*ISIZPV
      IF(INV(I).EQ.0) GO TO 308
      IREC=(INV(I)-1)*NOBASE+IBLO+1
      READ(IBNK#IREC) IO
      IF(ICOND(I).EQ.2) GO TO 306
      DO 305 J=1,JEND
305   ID(ISET+J)=IO(J+JADD)
      GO TO 304
306   DO 307 J=1,JEND
      D(ISET+J)=IO(J+JADD)
      IF(IO(J+JADD).EQ.MISS) ID(ISET+J)=IO(J+JADD)
307   CONTINUE
      GO TO 304
308   DO 309 J=1,JEND
309   D(ISET+J)=IBPOS+J-1
304   CONTINUE
      IF(ISL.LT.1) GO TO 350
      N=NUSED+1
      DO 320 I=1,ISL
      IF(IVSL(I).LT.0) GO TO 320
      ISET=(N-1)*ISIZPV
      IF(IVSL(I).GT.0) GO TO 335
      DO 330 J=1,JEND
330   D(ISET+J)=IBPOS+J-1
      GO TO 340
335   IREC=(IVSL(I)-1)*NOBASE+IBLO+1
      READ(IBNK#IREC) IO
      IF(MODE(I).EQ.2) GO TO 336
      DO 337 J=1,JEND
337   ID(ISET+J)=IO(J+JADD)
      GO TO 340
336   DO 338 J=1,JEND
      D(ISET+J)=IO(J+JADD)
      IF(IO(J+JADD).EQ.MISS) ID(ISET+J)=IO(J+JADD)
338   CONTINUE
340   N=N+1
320   CONTINUE
      IF(N.NE.(NVTBR+1)) PAUSE 'DONT EQUAL'
C 
C     CHECK IT OVER AND MOVE
C
350   DO 351 J=1,JEND
      IF(ISL.LT.1) GO TO 370
      DO 352 I=1,ISL
      L=(IWTBP(I)-1)*ISIZPV+J
      IF((VALUE(I).EQ.AMISS).AND.(ISLCOD(I).EQ.1)) GO TO 353
      IF(D(L).EQ.AMISS) GO TO 351
353   GO TO (361,362,363,364,365,366) ISLCOD(I)
361   IF(D(L).EQ.VALUE(I)) GO TO 352
      GO TO 351
362   IF(D(L).LT.VALUE(I)) GO TO 352
      GO TO 351
363   IF(D(L).LE.VALUE(I)) GO TO 352
      GO TO 351
364   IF(D(L).GT.VALUE(I)) GO TO 352
      GO TO 351
365   IF(D(L).GE.VALUE(I)) GO TO 352
      GO TO 351
366   IF(D(L).NE.VALUE(I)) GO TO 352
      GO TO 351
352   CONTINUE
370   IF(SWM.EQ.1) GO TO 372
      DO 371 I=1,NUSED
      L=(I-1)*ISIZPV+J
      IF(D(L).EQ.AMISS) GO TO 351
      DATA(NC,I+NVSF)=D(L)
371   CONTINUE
      NC=NC+1
      IF(NC.LE.NOSF) GO TO 351
      GO TO 380
372   DO 373 I=1,NUSED
      L=(I-1)*ISIZPV+J
      IF(D(L).EQ.AMISS) D(L)=-9999E-20
373   DATA(NC,I+NVSF)=D(L)
      NC=NC+1
      IF(NC.GT.NOSF) GO TO 380
351   CONTINUE
      IF(IEPOS.EQ.NOB) ONESW=1
      GO TO 302
380   NVSF=NVSF+NUSED
      NC=NC-1
      IF(NC.LT.NOSF) NOSF=NC
      IF(NOSF.LT.1) GO TO 430
      IF(SWI.EQ.1) GO TO 62
C
C     WRAP IT UP
C
400   NV=NVSF
      NC=NOSF
      IF((NV*NC).LT.1) GO TO 430
      DO 401 I=1,NV
      VMN(I)=0
      DO 406 K=1,NV
406   COR(K,I)=0
401   CONTINUE
      DO 410 I=1,NC
      DO 411 J=1,NV
      VMN(J)=VMN(J)+DATA(I,J)
      DO 411 K=1,J
411   COR(K,J)=COR(K,J)+DATA(I,J)*DATA(I,K)
410   CONTINUE
      DO 405 I=1,NV
      DO 405 J=1,NV
405   COR(J,I)=NC*COR(I,J)-VMN(J)*VMN(I)
      DO 416 I=1,NV
      STD(I)=0
      IF(NC.GT.1) STD(I)=SQRT(COR(I,I)/(NC*(NC-1.)))
416   VMN(I)=VMN(I)/NC
      DO 417 I=1,NV
      DO 417 J=I,NV
      IF(I.EQ.J) GO TO 417
      IF((COR(I,I)*COR(J,J)).EQ.0) GO TO 417
      COR(I,J)=COR(J,I)/SQRT(COR(I,I)*COR(J,J))
      COR(J,I)=COR(I,J)
      GO TO 417
418   COR(I,J)=0
      COR(J,I)=0
417   CONTINUE
      DO 419 I=1,NV
419   COR(I,I)=1.
      GO TO 433
430   WRITE(IDLG,431)
431   FORMAT(' NO OBSERVATIONS IN DATA REQUESTED')
432   NV=0
      NC=0
433   CALL RELEAS(IBNK)
440   RETURN
      END