Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

C                                               *** BANK ***

C
C     SUBROUTINE TO SETUP DEFAULTS PROVIDED BY USER.  ONLY USED WHEN
C     USER WISHES TO MODIFY DEFAULTS WITH A SET COMMAND
C
      SUBROUTINE SETUP
      DIMENSION CC(2)
      COMMON/DEV/ IDLG,ICC,IBNK
      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 /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 /OOUT/ LICDEV,DEV,FNAM
      COMMON /IDINFO/ LICID,LICIN,LICWO
      DOUBLE PRECISION FNAM,FNAMST,DATCR,BNKNM
      EQUIVALENCE(CC,FNAMST)
100   LSETWO=LICWO
      NHVSET=NHV
      IF(NHV.EQ.0) GO TO 102
      DO 101 J=1,NHV
      IVSET(1,J)=IV(1,J)
101   IVSET(2,J)=IV(2,J)
      GO TO 103
102   NHVSET=1
      IVSET(1,1)=1
      IVSET(2,1)=NV
103   NHOSET=NHO
      IF(NHO.EQ.0) GO TO 105
      DO 104 J=1,NHO
      IOSET(1,J)=IO(1,J)
104   IOSET(2,J)=IO(2,J)
      GO TO 106
105   NHOSET=1
      IOSET(1,1)=1
      IOSET(2,1)=NO
106   NSSET=NS
      IF(NSSET.EQ.0) GO TO 108
      DO 107 J=1,NSSET
      ISELST(1,J)=ISEL(1,J)
      ISELST(2,J)=ISEL(2,J)
      ISELST(3,J)=ISEL(3,J)
      ISELST(4,J)=ISEL(4,J)
      ISELST(5,J)=ISEL(5,J)
107   CONTINUE
      DO 112 I=1,20
      DO 112 J=1,20
112   DATCST(I,J)=DATC(I,J)
108   LFMTST=LICFMT
      IF(LICFMT.NE.1) GO TO 110
      DO 109 J=1,48
109   FORMST(J)=FORM(J)
      LFMTST=1
110   IF(LICDEV.EQ.1) GO TO 111
      CC(1)='OUT.D'
      CC(2)='AT'
      DEVSET='DSK'
      JDSET=0
      GO TO 900
111   FNAMST=FNAM
      DEVSET=DEV
      LDEVST=1
900   RETURN
      END
C                                               *** BANK  ***
C   
C     SUBROUTINE PROVIDES USER WITH A BACKUP FILE OF THE BANK WITH THE
C     SAME NAME AND A ".BAK" EXTENSION.
C
      SUBROUTINE BACKUP
      DIMENSION LV(125),IV(10)
      COMMON /GEN/ IPROJA,IPROGA,NV,NO,BNKNM,DATCR,NPROJR,NPORGR
      COMMON /DEV/ IDLG,ICC,IBNK,IUPGR,ITMPRY
      DOUBLE PRECISION BNKNM,BAKNM,DATCR
      DO 102 I=1,10
102   IV(I)=' '
      DECODE(10,101,BNKNM) IV
101   FORMAT(10A1)
      DO 103 I=1,7
      IF(IV(I).EQ.'.') GO TO 104
103   CONTINUE
      PAUSE 'PROBLEM LOCATING PEROID'
104   IV(I+1)='B'
      IV(I+2)='A'
      IV(I+3)='K'
      ENCODE(10,101,BAKNM) IV
      OPEN(UNIT=ITMPRY,FILE=BAKNM,ACCESS='SEQOUT',DEVICE='DSK',
     1MODE='BINARY',RECORD SIZE=126,PROTECTION="077)
      I=1
105   READ(IBNK#I,END=106) LV
      WRITE(ITMPRY),LV
      I=I+1
      GO TO 105
106   CLOSE(UNIT=ITMPRY)
      RETURN
      END