Trailing-Edge
-
PDP-10 Archives
-
decuslib10-09
-
43,50466/bnk.ban
There are 3 other files named bnk.ban 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
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
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
998 CLOSE(UNIT=LSTDEV)
IPAGE=IPAGE+2
CALL PRINTS('OUTPU.DAT',2,1,1,IPAGE)
997 IF(IWHICH.NE.23) CALL EXIT
70 ENCODE(10,71,ROOM) RUNUO
71 FORMAT('R ',A5,3X)
ROOM(3)=0
CLOSE (UNIT=IBNK)
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