*
* $Id$
*
* $Log$
* Revision 1.3  1999/06/18 13:29:00  couet
* - qcardl.inc was empty: It is now removed and not used.
*   Comment END CDE removed.
*
* Revision 1.2  1996/04/18 16:10:34  mclareni
* Incorporate changes from J.Zoll for version 3.77
*
* Revision 1.1.1.1  1996/03/06 10:47:14  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE FZIMTB

C-    ready memory occupation table for input
C-    ready space for the relocation table
C-    called from FZIN

#include "zebra/zbcd.inc"
#include "zebra/zmach.inc"
#include "zebra/zunit.inc"
#include "zebra/mqsys.inc"
#include "zebra/eqlqf.inc"
#include "zebra/mzcn.inc"
#include "zebra/mzct.inc"
#include "zebra/fzci.inc"
#include "zebra/fzcseg.inc"
#include "zebra/fzcocc.inc"
*

      DIMENSION    ITOSOR(20), ISORDV(20), ISORSP(20)
      DIMENSION    LSTAV(20),             LENDV(20)
      EQUIVALENCE (LSTAV(1),IQUEST(60)), (LENDV(1),IQUEST(80))

#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      DIMENSION    NAMESR(2)
      DATA  NAMESR / 4HFZIM, 4HTB   /
#endif
#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      DATA  NAMESR / 6HFZIMTB /
#endif
#if !defined(CERNLIB_QTRHOLL)
      CHARACTER    NAMESR*8
      PARAMETER   (NAMESR = 'FZIMTB  ')
#endif

#include "zebra/q_shiftl.inc"
#include "zebra/q_jbyt.inc"

C----              Input information

C-    if NQSEG = 0 :   read non-segmented

C-    if NQSEG > 0 :   read segmented according to :
C-       IQSEGD        segment selection table set by the user
C-       IQ(LFISEG+1)  copy of the segmentation table from the pilot

C----              Output information

C-    The memory occupation table at LQ(LQMTA) ready for the material
C-    to be accepted :
C-        skip :   LQ(LMT)   = 0
C-                 LQ(LMT+1) = 0
C-                 LQ(LMT+3) = -NW words to be skipped

C-        read :   LQ(LMT)   = JDIV
C-                 LQ(LMT+1) = 1
C-                 LQ(LMT+3) = LSTA
C-                 LQ(LMT+4) = LEND

C-    The space at LQ(LQTA) ready (and big enough) to receive
C-    the relocation table.

C-    The common /FZOCC/ indicates the amount of space IQOCSP(J)
C-    reserved at the end/start of division IQOCDV(J) for J=1,NQOCC
C-    and blocked by a dummy bank.


#include "zebra/qtrace.inc"

      IFLGAR = 0
      IF (NQSEG.LE.0)  THEN

C--                Single segment

          NQSEG = 1
          NSOR  = 1
          NOCC  = 1
          ITOSOR(1) = 1
          IQSEGD(1) = JQDIVI
          ISORDV(1) = JQDIVI
          IQOCDV(1) = JQDIVI
          ISORSP(1) = NWBKI
          IQOCSP(1) = NWBKI
          GO TO 41
        ENDIF

C--                Multiple segments, tidy division numbers

#if defined(CERNLIB_QDEBPRI)
      IF (LOGLVI.GE.3)   WRITE (IQLOG,9016)  (J,
     +                   IQSEGH(1,J),IQSEGH(2,J),IQSEGD(J),J=1,NQSEG)
 9016 FORMAT (1X/' FZIMTB-  Segment Selection Table as set by the user'
#endif
#if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_HEX))
     F/(10X,I2,1X,2A4,O23))
#endif
#if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_HEX))
     F/(10X,I2,1X,2A4,Z17))
#endif

      LFISEG = LQFI + JAUSEG
      IF (3*NQSEG.NE.IQ(KQSP+LFISEG))  GO TO 715
      LSPACE = KQSP + LFISEG + 2*NQSEG

      DO 27  JS=1,NQSEG
      IXDIV = IQSEGD(JS)
      IF   (IXDIV)           22, 23, 24
   22 IF (IXDIV.LT.-7)             GO TO 714
      ITOSOR(JS) = -IQ(LSPACE+JS)
      GO TO 27

   23 JDIV = JQDIVI
      GO TO 25

   24 JDIV = JBYT (IXDIV,1,26)
      IF (JDIV.GT.20)              GO TO 714
      JSTO = JBYT (IXDIV,27,4)
      IF   (JSTO.NE.0)  THEN
          IF (JSTO.NE.JQSTOR)      GO TO 714
        ENDIF

      IF (JDIV.EQ.0)               GO TO 23
      IF   (JDIV.GT.JQDVLL)  THEN
          IF (JDIV.LT.JQDVSY)      GO TO 714
        ENDIF

   25 IQSEGD(JS) = JDIV
      ITOSOR(JS) = 0
   27 CONTINUE

C----              Construct tables sorted by division number

C-             ISOR  table :  one entry per segment
C-             IQOC  table :  one entry per target division

      NSOR  = 0
      NOCC  = 0
      JANX  = 1
      JENX  = NQSEG

C--                Find largest division number not yet done

   31 JDVBIG = 0
      JA   = JANX
      JANX = 0
      JE   = JENX
      JENX = 0
      DO 35  JS=JA,JE
      IF (ITOSOR(JS).NE.0)         GO TO 35
      JENX = JS
      IF (JANX.EQ.0)  JANX=JS
      JDIV = IQSEGD(JS)
      IF (JDIV.LE.JDVBIG)          GO TO 35
      JDVBIG = JDIV
      JSBIG  = JS
   35 CONTINUE
      IF (JDVBIG.EQ.0)             GO TO 41

      NSOR = NSOR + 1
      ITOSOR(JSBIG) = NSOR
      ISORDV(NSOR)  = JDVBIG
      ISORSP(NSOR)  = IQ(LSPACE+JSBIG)

      NOCC = NOCC + 1
      IQOCDV(NOCC) = JDVBIG
      IQOCSP(NOCC) = IQ(LSPACE+JSBIG)

C--                Find further segments for the same division

      IF (JSBIG.EQ.JENX)           GO TO 31
      DO 37  JS=JSBIG+1,JENX
      IF (ITOSOR(JS).NE.0)         GO TO 37
      IF (IQSEGD(JS).NE.JDVBIG)    GO TO 37
      NSOR = NSOR + 1
      ITOSOR(JS)   = NSOR
      ISORDV(NSOR) = JDVBIG
      ISORSP(NSOR) = IQ(LSPACE+JS)
      IQOCSP(NOCC) = IQOCSP(NOCC) + IQ(LSPACE+JS)
   37 CONTINUE
      GO TO 31

C----              Reserve space in divisions

   41 IF (NOCC.EQ.0)               GO TO 81
      JOCC   = 0
   42 JOCC   = JOCC + 1
      JQDIVI = IQOCDV(JOCC)
      NW     = IQOCSP(JOCC)
      CALL MZRESV
      NQRESV = NQRESV - NW
      IF (NQRESV.LT.0)       CALL MZGAR1

C--                Forward division

      IF (JQMODE.EQ.0)  THEN
          IQLN = LQEND(KQT+JQDIVI)
          IQNX = IQLN + NW
          LQEND(KQT+JQDIVI) = IQNX

C--                Reverse division

        ELSE
          IQNX = LQSTA(KQT+JQDIVI)
          IQLN = IQNX - NW
          LQSTA(KQT+JQDIVI) = IQLN
        ENDIF
      NQOCC = JOCC

C--                Fill space reserved with dummy bank

      LQ(KQS+IQLN)   = 12
      LQ(KQS+IQLN+1) = 0
      LQ(KQS+IQLN+2) = 0
      LQ(KQS+IQLN+3) = 0
      LQ(KQS+IQLN+5) = IQLETT(1)
      LQ(KQS+IQLN+6) = 0
      LQ(KQS+IQLN+7) = 0
      LQ(KQS+IQLN+8) = NW - 10
      LQ(KQS+IQLN+9) = 0
      IF (JOCC.NE.NOCC)            GO TO 42

C----              Allocate space for the relocation tables

   46 NWTR = 2*NWTABI + 2
      NWTM = 8*NQSEG
      IF (NWTR+NWTM.LT.NQWKTB)  THEN
C--                Both tables in the normal work area
          LQMTA = LQWKTB
          LQRTA = LQMTA + NWTM
        ELSE
          JQSTMV = -1
          CALL MZFGAP
          IF (NQGAPN.EQ.0)         GO TO 61
          IF (IQGAP(1,1).LT.NWTR)  THEN
C--                MO table in the (smaller) gap, LR table in area
              IF (NQWKTB.LT.NWTR)  GO TO 61
              LQMTA = IQGAP(2,1)
              LQRTA = LQWKTB
            ELSE
C--                MO table in area, LR table in (bigger) gap
              LQMTA = LQWKTB
              LQRTA = IQGAP(2,1)
            ENDIF
        ENDIF

      LQMTE = LQMTA + NWTM
      LQTA  = LQRTA + 1
      LQTE  = LQTA  + 2*NWTABI
      LQRTE = LQTE
#if defined(CERNLIB_QDEVZE)
      IF (LOGLVI.GE.4)  WRITE (IQLOG,9141) LQMTA,LQMTE,LQTA,LQTE
 9141 FORMAT (' FZIMTB-  Tables : LQMTA,LQMTE,LQTA,LQTE=',4I9)
#endif

C----              Calculate start adrs on the sorted table

      JSOR   = 1
      JOCC   = 1
   52 JQDIVI = ISORDV(JSOR)

      IF (IQMODE(KQT+JQDIVI).EQ.0)  THEN
          LSTA = LQEND(KQT+JQDIVI) - IQOCSP(JOCC)
        ELSE
          LSTA = LQSTA(KQT+JQDIVI)
        ENDIF

      LEND = LSTA + ISORSP(JSOR)

      LENDV(JSOR) = LEND
      LSTAV(JSOR) = LSTA
      JOCC = JOCC + 1

   54 IF (JSOR.EQ.NSOR)            GO TO 55
      JSOR = JSOR + 1
      IF (ISORDV(JSOR).NE.JQDIVI)  GO TO 52
      LSTA = LEND
      LEND = LSTA + ISORSP(JSOR)
      LENDV(JSOR) = LEND
      LSTAV(JSOR) = LSTA
      GO TO 54

C----              Transfer the information from the sorted table
C-                 to the memory occupation table

   55 LMT = LQMTA

      DO  59  JS=1,NQSEG
      JSOR = ITOSOR(JS)
      IF (JSOR.GE.0)               GO TO 57
      LQ(LMT)   = 0
      LQ(LMT+1) = 0
      LQ(LMT+2) = 0
      LQ(LMT+3) = JSOR
      LQ(LMT+4) = JSOR
      LQ(LMT+5) = 0
      LQ(LMT+6) = 0
      LQ(LMT+7) = 0
#if defined(CERNLIB_QDEBPRI)
      IF (LOGLVI.GE.3)   WRITE (IQLOG,9055) JS, -JSOR
 9055 FORMAT (' FZIMTB-  skip segment',I3,I9,' WORDS')
#endif
      GO TO 59

   57 LQ(LMT)   = ISORDV(JSOR)
      LQ(LMT+1) = 1
      LQ(LMT+2) = 0
      LQ(LMT+3) = LSTAV(JSOR)
      LQ(LMT+4) = LENDV(JSOR)
      LQ(LMT+5) = 0
      LQ(LMT+6) = 0
      LQ(LMT+7) = 0
#if defined(CERNLIB_QDEBPRI)
      IF (LOGLVI.GE.3)  THEN
          WRITE (IQLOG,9058)  JS,LQ(LMT),LQ(LMT+3),LQ(LMT+4)
        ENDIF
 9058 FORMAT (' FZIMTB-  read segment',I3,' into division/from/to'
     F,I3,2I9)
#endif
   59 LMT  = LMT + 8
#include "zebra/qtrace99.inc"
      RETURN

C------            Garbage collection to make room for the table

   61 IF (IFLGAR.GE.2)             GO TO 721
      IXSTOR = ISHFTL (JQSTOR,26)
      IF (IFLGAR.NE.0)             GO TO 63

      IXSTOR = MZIXCO (IXSTOR+21,22,23,24)
      CALL MZGARB (IXSTOR, 0)
      IFLGAR = 1
      IF (JQSTOR.NE.0)             GO TO 46
      IFLGAR = 2
      GO TO 46

C--                Collect also the primary store

   63 IFLGAR = 2
      J = MZIXCO (21,22,23,24)
      CALL MZGARB (J, 0)
      CALL MZSDIV (IXSTOR,-7)
      GO TO 46

C----              All segments to be skipped

   81 NWBKI  = 0
      JRETCD = -4
#if defined(CERNLIB_QDEBPRI)
      IF (LOGLVI.GE.3)   WRITE (IQLOG,9081)
 9081 FORMAT (' FZIMTB-  skip all segments')
#endif
      GO TO 999

C-------------------------------------------------
C-                 ERROR CONDITIONS
C-------------------------------------------------

C----              User error

C-    JERROR = 15  NQSEG has been changed by the user
  715 JERROR = 15
      IQUEST(14)= NQSEG
      IQUEST(15)= IQ(KQSP+LFISEG)
      NWERR = 2
      GO TO 719

C-    JERROR = 14  invalid division number in segment table
  714 JERROR = 14
      IQUEST(14)= JS
      IQUEST(15)= 0
      IQUEST(16)= IXDIV
      NWERR = 3

  719 JRETCD = 4
      GO TO 999

C----              Not enough space

C-    JERROR = 21  not enough space
  721 JERROR = 21

      JRETCD = 3
      GO TO 999
      END
