PDP-10 Archive: 43,50521/bnk.d20 from decuslib10-10

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50521/bnk.d20
There are 3 other files named bnk.d20 in the archive. Click here to see a list.
C                                      *** BANK ***
C
C     BANK FOR WESTERN MICHIGAN UNIVERSITY WRITTEN BY DICK HOUCHARD.
C     ORIGINAL IDEA FOR BANK CAME FROM STP, BUT QUICKLY EXPANDED UNTIL
C     BANK IS THE CENTRAL PROGRAM TO A SYSTEM OF PROGRAMS.  HOPEFULLY
C     THE REST OF THE PROGRAMS WILL ACCESS BOTH ASCII DATA AND BANK
C     DATA, WILL BE EASY TO RUN AND WILL ALL CONTAIN "HELP" AS 
C     STANDARD PROCEDURE.  IN ADDITION THEY SHOULD BE FASTER AND MORE
C     FLEXIBLE.
C
C     PROGRAMS NOW PLANNED IN THE SYSTEM:
C          BANK - DATA MANIPULATION
C          STP - SMALL SAMPLE STATISTICS
C          CORL - CORRELATIONS ABLE TO TREAT MISSING DATA AS PAIRS
C                 OR AS OBSERVATIONS
C          FREQ - FREQUENCY FOR ALPHA, FIXED OR FLOATING DATA
C          TAB - CROSS TABS OF ALPHA, FIXED OR FLOATING DATA WITH
C                 ALL ASSOCIATED TABLE STATISTICS.  ABILITY OF UP TO
C                 4 WAY CROSS TABS.
C          REGR - REGRESSION SIMPLE TO MULTIPLE, STEPWISE, AND POSSIBLY
C                 STEPWISE IN BOTH DIRECTIONS.
C
C     ALSO A SET OF ROUTINES HAVE BEEN WRITTEN WHICH CAN BE EASILY 
C     INCORPORATED INTO A FORTRAN PROGRAM TO ACCESS AND READ BANK DATA.
C
C     PROJECT BEGAN APRIL 1973.
C     EXPERIMENTAL VERSION RELEASED JAN 1974
C     FIRST VERSION RELEASED JAN 1975
C
C     PROGRAM WRITTEN TO BE RUN ON DIGITAL EQUIPMENT CORPORTATION PDP-10
C     COMPILER: F10, OR F40(WITH OPEN AND CLOSE)
C     LOADER: LOADER(WITH CHAINB), LINK(WITH OVERLAY-ONLY WITH F10)
C
C     THE FOLLOWING MODIFICATIONS FOR WESTERN MICHIGAN UNIVERSITY SYSTEM
C     ARE MADE USE OF IN BANK.
C     1. MODIFICATION TO CHAINB AND LOADER
C     2. CALLING TO PRINT ROUTINE THROUGH PRINTS
C
C     IN ADDITION THE FOLLOWING ROUTINES AS ACQUIRED THROUGH
C     NORM GRANTS PROGRAM LIBRARY ARE USED.
C     1. EXISTS - CHECK FOR EXISTANCE OF A FILE
C     2. GETPPN - RETURN PROJECT PROGRAMMER NUMBER OF USER
C     3. TYPEON - TURNS TYPE ON IF A CONTROL O HAS BEEN USED
C     4. RUNUUO - PERFORMS R, RUN, AND COMPILE CLASS COMMANDS
C     5. GES - TTY INPUT, BREAKS AT ALTMODE (ORIGINALLY WRITTEN BY SAM
C        ANEMA)
C
C
C AAR ================================================================
C AAR
C AAR    	*** ASSOCIATION OF AMERICAN R.R. UPDATES ***
C AAR    	*** MADE 10/10/77 BY W.E.BARKER TO RUN   ***
C AAR    	***         ON DECSYSTEM-20		 ***			
C AAR
C AAR    	CHANGES MADE:
C AAR
C AAR    	1) FOR ALL LINEPRINTER OUTPUT, REPLACE CALL 
C AAR    	   TO "PRINTS" ROUTINE (WHICH HANGS UP) BY
C AAR    	   PRINTING THE FILE WHEN IT IS CLOSED. THIS
C AAR    	   IS ACCOMPLISHED WITH THE DISPOSE='LIST'
C AAR    	   OPTION.
C AAR
C AAR    	2) CALL A MACRO ROUTINE, "EXPUNG", TO CLEAN
C AAR    	   UP DELETED FILES BEFORE EXITING, OR 
C AAR    	   BEFORE RUNNING ANOTHER BANK PROGRAM.
C AAR
C AAR
C AAR    NOTE: CHANGES MADE BY THE AAR ARE NUMBERED, AND ARE 
C AAR          SURROUNDED BY COMMENTS WITH "AAR" IN THE LEFT
C AAR          MARGIN. STATEMENTS WHICH WERE IN THE ORIGINAL
C AAR          VERSION AND HAVE BEEN COMMENTED OUT HAVE A
C AAR          "WMU" IN THE LEFT MARGIN.
C AAR
C AAR
C AAR =================================================================
C
C
      DIMENSION NAME(15),DATCR(2),ROOM(3)
      DIMENSION NNS(18,6),IPATH(3)
C
C     COMMON STATEMENTS ARE MAINLY USED TO PASS DATA BETWEEN
C     SUBROUTINES.
C
      COMMON/DEV/IDLG,ICC,IBNK,IUPGR,ITMPRY,MPROG,I2TMP
      COMMON/RM/LV(125)
      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 /CNST/ LICCON,CNVAL,ICNVAL,NUMCNS
      COMMON /IDINFO/ LICID,LICIN,LICWO
      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/TRNS/INSTR(25),IVAR1(25),IVAR2(25),CONST(25),SV(99),ITO(25)
      COMMON/LSTOUT/LSTDEV,IPAGE,ONEPP
      COMMON /MTM/ NMTM,IVARSQ(20)
      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)
      DOUBLE PRECISION BNKNM,XTRARM,FNAM,FNAMST,FNAMSV,HLPR
      DATA IBRKL,IBRKR/"555004020100,"565004020100/
      DATA IALT/"155004020100/
      DATA FNAMSV/'OUT.DAT'/
      DATA HLPR/'HELP.BNK'/
      DATA PRGRUN/'STP','CORL','FREQ','TAB','REGR',25*' '/
C
C     ADDS 1 TO COUNT OF NUMBER OF TIMES BANK HAS BEEN USED
C
C      CALL USAGEB('BANK  ')
C
C     ALL CHANNELS USED ARE LISTED BELOW EXCEPT FOR 2 WHICH IS
C     RESERVED FOR ANY SUBROUTINE IN WHICH DEVCHG MUST BE USED
C     IBNK - CHANNEL FOR BANK IO
C     IDLG - MESSAGES TO USER
C     ICC - USER TTY INPUT
C     IUPGR - TEMPORARY STORAGE
C     LSTDEV - OUTPUT DEVICE (STDES COMMAND)
C     I2TMP - SECOND TEMPORARY STORAGE
C     MPROG - COMMAND FILE INPUT
C
      BNKCHN='BANK1'
      IBNK=1
      IDLG=5
      ICC=-4
      IUPGR=21
      LSTDEV=20
      ITMPRY=3
      I2TMP=4
      MPROG=6
      WRITE(IDLG,72)
72    FORMAT('0BANK V2 - WMU'///)
      CALL GETPPN (NPROJR,NPROGR)
      OPEN(UNIT=LSTDEV,FILE='OUTPU.DAT',ACCESS='SEQOUT',DEVICE='DSK')
      IPAGE=0
1     IPROJ=0
      IPROG=0
      IWHICH=0
      WRITE(IDLG,2)
2     FORMAT(' BANK? ',$)
      CALL GES(INPUT,80,ICHECK)
      IF(ICHECK.EQ.2) GO TO 999
      IF(INPUT(1).NE.'/') GO TO 36
      IWHICH=23
      DO 37 J=2,6
      IF(INPUT(J).EQ.IALT) INPUT(J)=' '
37    CONTINUE
      ENCODE(5,3,RUNUO)(INPUT(J),J=2,6)
      DO 38 J=1,30
      IF(RUNUO.EQ.PRGRUN(J)) GO TO 999
38    CONTINUE
      WRITE(IDLG,39)
39    FORMAT(' PROGRAM NOT AVAILABLE FOR BANK')
      GO TO 1
36    I=1
4     IF(INPUT(I).EQ.' ') GO TO 8
      IF(INPUT(I).EQ.IALT) GO TO 8
      IF(INPUT(I).EQ.'.') GO TO 6
      IF(INPUT(I).EQ.IBRKL) GO TO 8
      NAME(I)=INPUT(I)
      I=I+1
      IF(I.LE.6) GO TO 4
      IF(INPUT(I).EQ.' ') GO TO 8
      IF(INPUT(I).EQ.'.') GO TO 6
      IF(INPUT(I).EQ.IBRKL) GO TO 8
      WRITE(IDLG,5)
5     FORMAT(' MAXIMUM OF 6 CHARACTERS FOR BANK NAME')
      GO TO 1
6     WRITE(IDLG,7)
7     FORMAT(' NO EXTENSION NECESSARY - ".BNK" WILL BE ADDED')
8     J=I
      NAME(J)='.'
      J=J+1
      NAME(J)='B'
      J=J+1
      NAME(J)='N'
      J=J+1
      NAME(J)='K'
9     J=J+1
      IF(J.GE.11) GO TO 10
      NAME(J)=' '
      GO TO 9
10    ENCODE(10,3,BNKNM) (NAME(J),J=1,10)
3     FORMAT(80A1)
      IF(BNKNM.NE.HLPR) GO TO 12
      WRITE(IDLG,11)
11    FORMAT(' THE BANK SYSTEM IS A HIGHLY FLEXIABLE DATA RECOVERY'/
     1' SYSTEM PROVIDING THE USER WITH AN EASY METHOD FOR'/
     2' HANDLING DATA.  NO FORMATING IS NECESSARY AFTER THE INITIAL'/
     3' CREATION OF THE BANK, AND DATA MAY BE REFERENCED BY EITHER'/
     4' VARIABLE NAMES OR NUMBERS.  FIXED, FLOATING, AND ALPHANUMERIC'/
     5' VALUES ARE STORED.  TO ACCESS A DATA BANK SIMPLY TYPE'/
     6' THE BANK NAME (WITHOUT EXTENSION) AND THE PROJECT-PROGRAMMER'/
     7' NUMBER OF THE AREA WHERE THE BANK IS STORED ENCLOSED IN'/
     8' BRACKETS.  IF NO PROJECT-PROGRAMMER NUMBER IS SPECIFIED'/
     9' THE FILE WILL BE ASSUMED TO BE IN YOUR AREA.  TO CREATE A'/
     1' BANK, SIMPLY SPECIFY A BANK NOT YET CREATED, WITHOUT A PROJECT'/
     2' PROGRAMMER NUMBER.  NOTE: ONLY THE PERSON WHO CREATED A BANK'/
     3' MAY MODIFY THE DATA IN IT.')
      GO TO 1
12    IF(INPUT(I).EQ.' ') GO TO  55
      IF(INPUT(I).EQ.IALT) GO TO 55
      IF(INPUT(I).EQ.IBRKL) GO TO 14
C     USER ADDED EXTENSION GET RID OF IT
      I=I+1
      IF(I.LE.30) GO TO 12
16    WRITE(IDLG,13)
13    FORMAT(' INPUT UNRECOGNIZABLE PAST NAME')
      GO TO 1
C     PROJECT NUMBER
14    J=1
      DO 15 K=1,6
15    NAME(K)=' '
19    I=I+1
      IF(I.GT.30) GO TO 16
      IF((INPUT(I).LE.'7').AND.(INPUT(I).GE.'0')) GO TO 18
      IF(INPUT(I).EQ.',') GO TO 21
      WRITE(IDLG,17) INPUT(I)
17    FORMAT(' THE CHARACTER "',A1,'" IS NOT VALID IN A PROJECT NUM.')
      GO TO 1
18    NAME(J)=INPUT(I)
      J=J+1
      IF(J.LE.7) GO TO 19
      WRITE(IDLG,20)
20    FORMAT(' PROJECT NUMBER MAY NOT BE LONGER THAN 6 CHARACTERS')
      GO TO 1
21    IF(NAME(6).NE.' ') GO TO 23
      DO 22 J=5,1,-1
22    NAME(J+1)=NAME(J)
      NAME(1)=' '
      GO TO 21
23    ENCODE(6,3,XTRARM) (NAME(J),J=1,6)
      DECODE(6,24,XTRARM) IPROJ
24    FORMAT(O6)
      J=1
      DO 25 K=1,6
25    NAME(K)=' '
28    I=I+1
      IF(I.GT.30) GO TO 16
      IF((INPUT(I).LE.'7').AND.(INPUT(I).GE.'0')) GO TO 26
      IF(INPUT(I).EQ.IBRKR) GO TO 29
      WRITE(IDLG,17) INPUT(I)
      GO TO 1
26    NAME(J)=INPUT(I)
      J=J+1
      IF(J.LE.7) GO TO 28
      WRITE(IDLG,27)
27    FORMAT(' PROGRAMMER NUMBER MAY NOT BE LONGER THAN 6 CHARACTERS')
      GO TO 1
29    IF(NAME(6).NE.' ') GO TO 31
      DO 30 J=5,1,-1
30    NAME(J+1)=NAME(J)
      NAME(1)=' '
      GO TO 29
31    ENCODE(6,3,XTRARM)(NAME(J),J=1,6)
      DECODE(6,24,XTRARM) IPROG
55    IPATH(1)=IPROJ
      IPATH(2)=IPROG
      IPATH(3)=0
      CALL EXIST(BNKNM,IERR,IPROJ,IPROG)
      IF(IERR.EQ.0) GOTO 56
      IF(IERR.EQ.-1) GO TO 33
      IF((IPROJ.EQ.0).AND.(IPROG.EQ.0)) GO TO 35
      WRITE(IDLG,32)
32    FORMAT(' FILE DOES NOT EXIST')
      GO TO 1
33    WRITE(IDLG,34)
34    FORMAT(' ILLEGAL FILE NAME')
      GO TO 1
C
C     CREATE DATA BANK
C
40    IF((IPATH(1).EQ.0).AND.(IPATH(2).EQ.0)) GO TO 42
      WRITE(IDLG,41)
41    FORMAT(' THIS BANK CANNOT BE ACCESSED')
      GO TO 1
42    CLOSE(UNIT=IBNK,DISPOSE='DELETE')
35    OPEN(UNIT=IBNK,DEVICE='DSK',FILE=BNKNM,ACCESS='RANDOM',
     1MODE='BINARY',RECORD SIZE=126,DIRECTORY=IPATH,PROTECTION="155)
      CALL CHAINB(1,BNKCHN)
      CALL MABNK
      CALL EXIST(BNKNM,IERR,IPROJ,IPROG)
      IF(IERR.NE.0) GO TO 1
56    OPEN(UNIT=IBNK,DEVICE='DSK',FILE=BNKNM,ACCESS='RANDOM',
     1MODE='BINARY',RECORD SIZE=126,DIRECTORY=IPATH)
      READ(IBNK#1,END=40) NV,NO,NAMANS,DATCR,IPROJA,IPROGA,VERSIN,
     1(K,I=1,117)
      IF(VERSIN.EQ.'V2') GO TO 58
      WRITE(IDLG,59)
59    FORMAT(
     1' THIS BANK WAS CREATED WITH EXPERIMENTAL VERSION OF BANK.'/
     2' PLEASE UPDATE THE BANK BY RUNNING BANKUP FROM AREA 220,220'/
     3' IF YOU ARE NOT RESPONSIBLE FOR THE BANK CONTACT THE'/
     4' OWNER AND ASK HIM TO RUN THE UPDATEING PROGRAM')
      CALL EXIT
58    IBASE=((((NO-1)/125)+1)*NV)+1
      LINK=0
      IOUTOF=0
      LDEVST=0
      LSETWO=0
      NHVSET=1
      NHOSET=1
      NSSET=0
      DEVSET='DSK'
      FNAMST=FNAMSV
      FNAM=FNAMSV
      LFMTST=0
      IVSET(1,1)=1
      IVSET(2,1)=NV
      IOSET(1,1)=1
      IOSET(2,1)=NO
      LICRUN=0
      LBELL=0
C
C     CALLING FOR LINKAGE - USES OVERLAY PRINCIPLE, TOTAL MAIN
C     LINE HELD IN CORE FOR TOTAL PEROID OF RUN - LINK SECTION
C     OVERLAYED EACH TIME A NEW CHAIN IS CALLED FOR.  THE IF STATEMENTS
C     ARE USED TO DETERMINE IF THE CORRECT LINK IS IN CORE AT
C     THAT POINT.  ONCE THE CORRECT OVERLAY HAS BEEN INTRODUCED
C     THE CALL WILL BE THE SAME AS ORDINARY FORTRAN PROGRAM.
C
C     IN CALL CHAINB(N,CHNFIL)
C     THE N IS THE NUMBER OF THE OVERLAY AS ASSOCIATED WITH THE 
C     LOADING PROCEDURE.  CHNFIL IS THE NAME OF THE CHAIN FILE
C     HERE CALLED BANK1.CHN ON THE DISK.  THE W.M.U. MODIFICATION
C     TO THE LOADER SPECIFIES THE AREA 1,5 AS THE CHAIN AREA, IT
C     HOWEVER SEARCHES THE USER'S AREA FIRST
C
50    CALL CHAINB(2,BNKCHN)
      CALL INTERP(IWHICH)
      IF(IWHICH.NE.99) GO TO 99
      CLOSE (UNIT=IBNK)
      GO TO 1
99    GO TO (107,107,107,104,104,104,112,103,103,103,103,105,
     1106,101,101,101,113,102,108,110,111,114,999) IWHICH
101   CALL CHAINB(8,BNKCHN)
      CALL PRINT
      GO TO 50
102   CALL CHAINB(6,BNKCHN)
      CALL TYPE
      GO TO 50
103   CALL CHAINB(11,BNKCHN)
      CALL CREATE
      GO TO 50
104   CALL CHAINB(10,BNKCHN)
      CALL DELET (IWHERE)
      IF(IWHERE.EQ.0) GO TO 50
      IF(IWHERE.EQ.2) GO TO 1
      OPEN(UNIT=IBNK,DEVICE='DSK',FILE=BNKNM,ACCESS='RANDOM',
     1MODE='BINARY',RECORD SIZE=126,DIRECTORY=IPATH)
      GO TO 50
105   CALL CHAINB(5,BNKCHN)
      CALL OUTPUT
      GO TO 50
106   CALL CHAINB(14,BNKCHN)
      CALL MERGE (IWHICH)
      IF(IWHICH.EQ.1) OPEN(UNIT=IBNK,DEVICE='DSK',FILE=BNKNM,
     1MODE='BINARY',RECORD SIZE=126,DIRECTORY=IPATH,ACCESS='RANDOM')
      GO TO 50
107   CALL CHAINB(3,BNKCHN)
      CALL REPLAC
      GO TO 50
108   CALL CHAINB(12,BNKCHN)
      CALL BSORT
      GO TO 50
109   WRITE(IDLG,100)
      GO TO 50
110   CALL CHAINB(4,BNKCHN)
      CALL SETUP
      GO TO 50
111   CALL CHAINB(7,BNKCHN)
      CALL TRANS
      GO TO 50
112   CALL CHAINB(4,BNKCHN)
      CALL BACKUP
      GO TO 50
113   CALL CHAINB(9,BNKCHN)
      CALL STDES
      GO TO 50
114   CALL CHAINB(13,BNKCHN)
      CALL PROGRM
      GO TO 50
100   FORMAT(' THIS PORTION NOT COMPLETE YET')
999   IF(IPAGE.NE.0) GO TO 998
      CLOSE(UNIT=LSTDEV,DISPOSE='DELETE')
      GO TO 997
C AAR
C AAR			*** AAR CHANGES 1 AND 2 ***
C AAR	     CHANGES MADE TO EXPUNGE DELETED FILES, AND TO PRINT 
C AAR     	WITHOUT USING THE "CALL PRINTS" (IT GETS HUNG!).
C AAR
C
C WMU
C WMU  998  CLOSE(UNIT=LSTDEV)
C WMU
C
C AAR
C AAR ----
C AAR    !
998   CLOSE(UNIT=LSTDEV,DISPOSE='LIST')
C AAR    !
C AAR ----
C AAR
      IPAGE=IPAGE+2
C WMU
C WMU
C WMU      CALL PRINTS('OUTPU.DAT',2,1,1,IPAGE)
C WMU
C WMU
997   IF(IWHICH.EQ.23) GO TO 70
C
C AAR
C AAR ----
C AAR    !
	CALL EXPUNG
C AAR    !
C AAR ----
C
	CALL EXIT
70      ENCODE(10,71,ROOM) RUNUO
71    FORMAT('R ',A5,3X)
      ROOM(3)=0
      CLOSE (UNIT=IBNK)
C AAR
C AAR ----
C AAR    !
	CALL EXPUNG
C AAR    !
C AAR ----
C AAR
      CALL RUNUUO(ROOM)
      END
C
C     NOTE: BANK IS NOT WRITTEN TO BE USED AT THE SAME LEVEL
C           AS STP.  IT DOES NOT PROMPT FOR EXTRA INFORMATION.  IT 
C           ASSUMES THE USER IS AWARE OF HIS OPTIONS, AND KNOWS
C           WHAT HE WANTS TO DO.  OUTSIDE OF STDES NO STATISTICAL
C           ROUTINES ARE INCORPORATED INTO IT.  IT DOES ALLOW THE USER
C           TO QUITE EASILY MANAGE DATA IN THE FORM OF A BANK FILE.
C
C     WARNING: WHEN THE SYSTEM WAS TRANSLATED TO BE USED WITH FOROTS
C              A MONITOR BUG WAS UNCOVERED.  IT HAS TO DO WITH EXTENDED
C              RIB BLOCKS ON DISK FILES.  THE ERROR WILL SHOW AS A 
C              MONITOR ERROR TYPED ON THE TELETYPE.
C