C   07/06/96 606071848  MEMBER NAME  IBANK    (S4)          FORTG1
      FUNCTION IBANK(NAME,NR,NCA)
C
C
C     BAS04     FUNCTION IBANK  /  VERSION FOR F1EBLO.BOSLIB.S/L
C
C     IBANK CREATES OR CHANGES THE BANK (NAME,NR) AND RETURNS THE
C     INDEX OF THE BANK
C
C               ---- -- ----
C     IND=IBANK(NAME,NR,IOPT)
C     ---
C
C
C     IOPT   GE    0   CREATE THE BANK (NAME,NR) WITH IOPT DATA WORDS.
C                      ALL DATA WORDS ARE SET TO ZERO.
C
C     IOPT    = 'DL'   DELETE BANK (NAME,NR).
C
C     IOPT    = 'DLGC' DELETE BANK (NAME,NR) AND DO A GARBAGE COLLECTION
C                      IN THE REGION OF AND ABOVE THE DELETED BANK.
C
C     IOPT    = 'MV'   MOVE BANK (NAME,NR) TO THE END.
C
C     IOPT    = 'RN'   CHANGE THE NAME AND THE NUMBER OF THE BANK
C                      PREVIOUSLY USED IN IBANK OR ILINK TO (NAME,NR).
C
C     IOPT    = 'CP'   CREATE A BANK (NAME,NR) WITH THE SAME LENGTH AND
C                      CONTENT AS THE BANK PREVIOUSLY USED IN IBANK OR
C                      IN ILINK.
C
C     IOPT    = 'PR'   PRINT BANK (NAME,NR).
C
C     IND=IBANK(0,0,0)
C
C                      RETURN INDEX FOR THE FIRST UNUSED WORD BEHIND
C                      BANKS. THE LENGTH OF THE UNUSED SPACE IS STORED
C                      IN IW(IND)=NUS. THERE IS ENOUGH SPACE TO CREATE A
C                      BANK OF UP TO NUS WORDS, IF NUS IS NE 0.
C
C     ********************   ERROR CONDITIONS   **********************
C     IOPT
C     GE 0   IBANK=0, IF NOT ENOUGH SPACE.
C            IF THE BANK ALREADY EXISTS AND THE IOPT AGGREES WITH THE
C            ACTUAL LENGTH, THE INDEX IS RETURNED WITHOUT CHANGING TH
C            BANK CONTENT. IF THE LENGTH DIFFER, THE LENGTH OF THE BANK
C            IS CHANGED TO IOPT, ADDITIONAL WORDS ARE SET TO ZERO. IF
C            THE LENGTH DIFFER, THE CHANGE MAY REQUIRE A MOVE. IBANK=0
C            IN THIS CASE, IF THERE IS NOT ENOUGH SPACE. THUS THE CALL
C            MAY RETURN ZERO, ALTHOUGH THE BANK EXISTS.
C
C     'DL'   IBANK=0 IN ANY CASE. NO BANK IS DELETED, IF THE BANK CANNOT
C            BE FOUND.
C
C     'DLGC' IBANK=0 IN ANY CASE. NO BANK IS DELETED AND NO GARBAGE
C            COLLECTION IS DONE, IF THE BANK CANNOT BE FOUND.
C
C     'MV'   IBANK=0, IF NOT ENOUGH SPACE.
C
C     'RN'   IBANK=0, IF PREVIOUS BANK WAS NOT FOUND OR NEW BANK ALREADY
C            EXITS.
C
C     'CP'   IBANK=0, IF PREVIOUS BANK WAS NOT FOUND OR NEW BANK ALREADY
C            EXISTS OR NOT ENOUGH SPACE.
C
C     'PR'   IBANK=0, IF BANK CANNOT BE FOUND.
C
C
C
C     --------------------------------------------------------------
      COMMON/ACS/
     1   ICOND,NLAST,NDUMP,NSPL,NAMAX,NAMAX1,NLIST,NPRIM,NFRS,NLST,
     2   NEXT,NCI,NFRE,IN,KPOS,LIND,ILOW,LFDI,LFDK,NCPL,
     3   NHISTH(11),
     4        NCOL,NZT,IBFI,NLAST1,ISLST,IMLST,INAMV,IOLST,IPLST,
     5   NER(10),
     6   NRECL,NERRL,NRIN,NROUT,NS,NEXTI,NEXTA,NEXTB,ISAVB,NSAVB,
     7   NHISTL(11),
     8        MARKWR,NOUT(3),IASW,NPRE,IDUMMY(1),NEOTP,NDUMP1,
     9   JNAM,NLK,NLM,ILKNA,ILKIN,ILKND,LKNAME,LKNR,ICUST,IREV,
     *   NUNTB,DUMMY(9)
C     --------------------------------------------------------------
      COMMON/BCS/IW(1)
C     --------------------------------------------------------------
      EQUIVALENCE (XNAME,INAME)
      REAL FF/Z000000FF/
      INTEGER ISTAR/Z0000005C/,NSUFF/10/
      INTEGER NTEXT(6)/2HDL,4HDLGC,2HMV,2HRN,2HCP,2HPR/
      REAL AND
      EXTERNAL AND
      NC=IABS(NCA)
      IF(NAME.NE.0)          GOTO 10
      IF(NR.NE.0.OR.NC.NE.0) GOTO 10
C
C     IBANK(0,0,0) - RETURN INDEX OF NEXT FREE WORD
C
      IBANK=NEXT
      IW(IBANK)=MAX0(0,NLST-NEXT-4)
      GOTO 110
C
C     CHECK TYPE OF ENTRY
C
   10 IF(NC.LE.NLST) GOTO 20
      DO 12 L=1,6
      IF(NCA.EQ.NTEXT(L)) GOTO 14
   12 CONTINUE
      GOTO 99
   14 NC=-L
   16 IF(NC+4.NE.0.AND.NC+5.NE.0) GOTO 20
C
C     FOR RENAME AND COPY SAVE PREVIOUS INDICES
C
      IF(LFDI.EQ.0) GOTO 99
      LFDKS=LFDK
      LFDIS=LFDI
      NL=0
      INAME=IW(LFDI-3)
      XNAME=AND(XNAME,FF)
      IF(INAME.EQ.ISTAR) NL=-IW(LFDI)-4
C
C     REDUCE LOOPS TO FIND INDEX, IF PREVIOUS BANK IS NEAR PRESENT BANK
C
C  20 IF(JNAM.EQ.0.OR.IW(INAMV+JNAM).NE.NAME) GOTO 21
C     IF(LFDI.EQ.0)      GOTO 23
C     IF(IW(LFDI-2)-NR) 24,25,23
   20 CONTINUE
C
C     LOOP TO FIND INDEX TO NAME (INLINE IBLN)
C
   21 IW(INAMV)=NAME
      JNAM=MOD(IABS(NAME),NPRIM)+NAMAX1
   22 JNAM=IW(JNAM+IPLST)
      IF(IW(JNAM+INAMV).NE.IW(INAMV)) GOTO 22
      IF(JNAM.NE.0) GOTO 23
      JNAM=IBLN(IW(INAMV))
C
C     LOOP TO FIND BANK WITH NUMBER NR
C
   23 LFDI=JNAM+1
   24 LFDK=LFDI
      LFDI=IW(LFDI-1)
      IF(LFDI.EQ.0)      GOTO 80
      IF(IW(LFDI-2)-NR) 24,25,80
   25 IBANK=LFDI
C
C     1.CASE - BANK IS FOUND     ----------
C
      INAME=NAME
      XNAME=AND(XNAME,FF)
      IF(NC.GE.0)  GOTO 52
      IBR=-NC
      IF(IBR.LE.2) GOTO 30
      IF(IBR.EQ.3.AND.LFDI+IW(LFDI)+1.EQ.NEXT) GOTO 110
      IF(IBR.EQ.3) GOTO 60
      IF(IBR-6)   99,40,50
C
C     DELETE WITHOUT OR INCLUDING GARBAGE COLLECTION
C
   30 NN=4+IW(LFDI)
      IW(LFDK-1)=IW(LFDI-1)
      IW(LFDI  )=-NN
      IF(INAME.EQ.ISTAR) NCPL=NCPL-NN
      IF(LFDI+NN-3.NE.NEXT) GOTO 32
      NEXT=NEXT-NN
      GOTO 34
   32 NFRE=NFRE+NN
      ILOW=MIN0(ILOW,IBANK)
   34 IBANK=0
      LFDJ=LFDI
      LFDI=0
      IF(NC+1.EQ.0) GOTO 100
      JLOW=ILOW
      ILOW=LFDJ
C                           V---------------------
      CALL BGAR(IGA)
C                           A---------------------
      IF(JLOW.LT.LFDJ) ILOW=JLOW
      GOTO 99
C
C     PRINT BANK (OPTION PR)
C
   40 IF(NUNTB.LE.0) GOTO 110
      WRITE(NUNTB,111) IW(INAMV),(IW(LFDI-3+K),K=1,3),LFDI
C                           V---------------------
      CALL UWU(IW(IBANK+1),1,IW(IBANK))
C                           A---------------------
      GOTO 110
C
C     CHANGE LENGTH OF BANK
C
   50 NC=0
   52 NW=NC-IW(LFDI)
      IF(NW.EQ.0) GOTO 100
      IF(LFDI+IW(LFDI)+1.EQ.NEXT) GOTO 70
      IF(NW)      54,110,60
   54 IF(NW+4.GT.0) GOTO 60
      IW(LFDI)=NC
      IND=LFDI+NC+4
      ILOW=MIN0(ILOW,IND)
      IW(IND)=NW
      NFRE=NFRE-NW
      IF(INAME.EQ.ISTAR) NCPL=NCPL+NW
      GOTO 110
C
C     MOVE BANK (OPTION MV)
C
   60 IF(NEXT+4+MAX0(IW(LFDI),NC).GE.NLST) GOTO 80
      NN=4+IW(LFDI)
      CALL UCOPY2(IW(LFDI-3),IW(NEXT),NN)
      ILOW=MIN0(ILOW,LFDI)
      IBANK=NEXT+3
      IW(LFDI  )=-NN
      LFDI=IBANK
      IW(LFDK-1)=LFDI
      NEXT=NEXT+NN
      NFRE=NFRE+NN
      IF(IBR.EQ.3) GOTO 100
C
C     CHANGE LAST BANK
C
   70 IF(NEXT+NW.GE.NLST) GOTO 98
      IF(INAME.NE.ISTAR)  GOTO 72
      IF(NCPL+NW.LT.NSPL) GOTO 72
      IF(NW.LT.0)         GOTO 72
      NHISTL(11)=NHISTL(11)+1
      GOTO 99
   72 ILOCC=IBANK+IW(IBANK)
      IW(IBANK)=IW(IBANK)+NW
      NEXT=NEXT+NW
      IF(INAME.EQ.ISTAR) NCPL=NCPL+NW
      IF(NW.LE.0) GOTO 100
      LL=ILOCC
      LT=LL+NW
      MC=NW/4
      GOTO 93
C
C     2.CASE - BANK IS NOT FOUND ----------
C
   80 LFDI=0
      INAME=NAME
      XNAME=AND(XNAME,FF)
      IF(NC.GE.0) GOTO 90
      IBR=-NC
      IF(IBR-4)  99,82,81
   81 IF(IBR-6)  84,99,86
C
C     RENAME BANK (OPTION RN)
C
   82 IW(LFDKS-1)=IW(LFDIS-1)
      IW(LFDIS-1)=IW(LFDK -1)
      IW(LFDK -1)=LFDIS
      IW(LFDIS-3)=NAME
      IW(LFDIS-2)=NR
      IBANK=LFDIS
      LFDI=LFDIS
      LFDK=LFDKS
      IF(INAME.EQ.ISTAR) NL=NL+IW(LFDIS)+4
      NCPL=NCPL+NL
C                            V--------------------
C     CALL BUPDTL(0)
C                            A--------------------
      JNAM=0
      GOTO 110
C
C     COPY BANK (OPTION CP)
C
   84 NC=IW(LFDIS)
      GOTO 90
C
C     CREATE BANK
C
   86 NC=0
   90 NN=4+NC
C
C     CHECK REMAINING SPACE
C
      IF(NEXT+NN.GE.NLST) GOTO 98
      IF(INAME.NE.ISTAR)  GOTO 92
      IF(NCPL+NN.LT.NSPL) GOTO 91
      NHISTL(11)=NHISTL(11)+1
      GOTO 99
   91 NCPL=NCPL+NN
   92 IBANK=NEXT+3
      LFDI=IBANK
C
C     INSERT BANK, UPDATE POINTER
C
      IW(LFDI-3)=NAME
      IW(LFDI-2)=NR
      IW(LFDI-1)=IW(LFDK-1)
      IW(LFDI  )=NC
      IW(LFDK-1)=LFDI
      NEXT=NEXT+NN
      LIND=LFDI
      IF(NC.EQ.0)    GOTO 100
      IF(IBR.EQ.5) GOTO  97
C
C     CLEAR BANK CONTENT
C
      LL=LFDI
      LT=LL+NC
      MC=NC/4
   93 IF(NC.LE.0) GOTO 100
      IF(MC .LE.0) GOTO 95
      DO 94 L=1,MC
      IW(LL+1)=0
      IW(LL+2)=0
      IW(LL+3)=0
      IW(LL+4)=0
   94 LL=LL+4
   95 DO 96 L=1,4
      IF(LL.EQ.LT) GOTO 100
      LL=LL+1
   96 IW(LL)=0
      GOTO 100
C
C     COPY BANK CONTENT
C
   97 CALL UCOPY(IW(LFDIS+1),IW(LFDI+1),NC)
      GOTO 100
C
C     INSUFFICIENT SPACE, INCREASE COUNTER
C
   98 NHISTH(11)=NHISTH(11)+1
      IF(NSUFF.LE.0) GOTO 99
      IF(NUNTB.LE.0) GOTO 99
      IF(NC.GE.0) WRITE(NUNTB,112) NAME,NR,NCA
      IF(NC.LT.0) WRITE(NUNTB,113) NAME,NR,NCA
      NSUFF=NSUFF-1
C
C     RETURN WITH FUNCTION VALUE ZERO
C
   99 IBANK=0
      LFDI=0
      GOTO 110
C
C     UPDATE INDEX ARRAYS AND RETURN
C                            V--------------------
  100 GOTO 110
C 100 IF(NLK.EQ.0) GOTO 110
C     DO 109 I=1,NLK
C     IF(JNAM.NE.IW(ILKNA+I)) GOTO 109
C     L=IW(ILKIN+I)
C     IF(IW(ILKND+I)-1) 101,102,103
C     BANK (NAME,0)
C 101 IF(NR.NE.0) GOTO 109
C     IW(L)=IBANK
C     GOTO 109
C 102 IW(L)=IW(JNAM)
C     GOTO 109
C     BANK (NAME,NR)
C 103 IF(NR.LE.0.OR.NR.GT.IW(ILKND+I)) GOTO 109
C     IW(L+NR)=IBANK
C     IF(IBANK.EQ.0) GOTO 104
C     IW(L)=MAX0(IW(L),NR)
C     GOTO 109
C 104 N=IW(L)+1
C 105 N=N-1
C     IF(N.EQ.0)       GOTO 106
C     IF(IW(L+N).EQ.0) GOTO 105
C 106 IW(L)=N
C 109 CONTINUE
C                            A--------------------
C     RETURN WITHOUT UPDATE
C
  110 RETURN
  111 FORMAT('0 BANK ',A4,5I12)
  112 FORMAT('0---- INSUFFICIENT SPACE FOR BANK (',A4,',',I8,
     1   ' WITH',I4,' WORDS')
  113 FORMAT('0---- INSUFFICIENT SPACE FOR BANK (',A4,',',I8,
     1   ' OPTION ',A4)
      END
