[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / fq / fzirel.F

*
* $Id$
*
* $Log$
* Revision 1.2  1996/04/18 16:10:43  mclareni
* Incorporate changes from J.Zoll for version 3.77
*
* Revision 1.1.1.1  1996/03/06 10:47:15  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE FZIREL

C-    RELOCATE DATA-STRUCTURE READ
C-    USE THE MEMORY OCCUPATION TABLE READY
C-    AND THE RELOCATION VECTOR READ INTO LQ(LQTA+NWTABI)
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"
C--------------    End CDE                             --------------
      DIMENSION    LADESV(6)
#if defined(CERNLIB_QMVDS)
      SAVE         LADESV
#endif
#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      DIMENSION    NAMESR(2)
      DATA  NAMESR / 4HFZIR, 4HEL   /
#endif
#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      DATA  NAMESR / 6HFZIREL /
#endif
#if !defined(CERNLIB_QTRHOLL)
      CHARACTER    NAMESR*8
      PARAMETER   (NAMESR = 'FZIREL  ')
#endif
      DATA  LADESV / 6, 5*0 /


#include "zebra/qtrace.inc"

      IF (NWTABI.EQ.0)             GO TO 61

C------            Ready the relocation table

      LPUT  = LQTA
      LTAKE = LQTA + NWTABI

C--                Loop for all segments in the memory occupation tb.

      LMT = LQMTA
   22 IF (LQ(LMT+1).NE.0)          GO TO 24

C--                Skipped segment

      NWSG  = LQ(LMT+3)
   23 IF (NWSG.GE.0)               GO TO 29
      IF (LTAKE.GE.LQTE)           GO TO 731
      NWSG  = NWSG + (LQ(LTAKE+1)-LQ(LTAKE))
      LTAKE = LTAKE + 2
      GO TO 23

C--                Accepted segment

   24 LSTA  = LQ(LMT+3)
      LEND  = LQ(LMT+4)
      NWSG  = LSTA - LEND
      NREL  = 0
      LE    = LSTA
   25 IF (LTAKE.GE.LQTE)           GO TO 731
      LA    = LQ(LTAKE)
      NREL  = NREL - (LA-LE)
      LE    = LQ(LTAKE+1)

      LQ(LPUT)   = LA
      LQ(LPUT+1) = LE
      LQ(LPUT+2) = NREL
      LQ(LPUT+3) = 0
      LTAKE = LTAKE + 2
      LPUT  = LPUT  + 4
      NWSG  = NWSG + (LE-LA)
      IF (NWSG.LT.0)               GO TO 25
   29 IF (NWSG.NE.0)               GO TO 732
      LMT = LMT + 8
      IF (LMT.LT.LQMTE)            GO TO 22
      IF (LTAKE.NE.LQTE)           GO TO 733
      LQTE = LPUT

      LQ(LQTE)   =  LQ(LQTE-3)
      LQ(LQTA-1) =  LQ(LQTA)
#if defined(CERNLIB_QDEVZE)
      IF (LOGLVI.GE.4)
     +  WRITE (IQLOG,9167) LENTRI,(LQ(J),J=LQTA,LQTE-1)
 9167 FORMAT (' FZIREL-  Relocation Table, LENTRY before=',I10/
     F (15X,3I9,I4))
#endif

C----              Relocate the bank links

      IQFLIO = 7
      CALL MZRELB
      IF (IQFLIO.LT.0)             GO TO 734

C--                Relocate the entry link

      LADESV(2) = LOCF(LENTRI) - LQSTOR
      LADESV(3) = LADESV(2) + 1
      LADESV(5) = IQLETT(9)
      LADESV(6) = IQLETT(15)
      CALL MZRELL (LADESV)
#if defined(CERNLIB_QDEVZE)
      IF (LOGLVI.GE.4)  WRITE (IQLOG,9037) LENTRI
 9037 FORMAT (10X,'LENTRY after=',I10)
#endif
      LQ(KQS+LENTRI+1) = 0
      LQ(KQS+LENTRI+2) = 0
      GO TO 999

C------            Chain banks into one linear structure

   61 CALL FZILIN
      IF (IQFOUL.NE.0)             GO TO 734
      LENTRI = IQUEST(1)
#include "zebra/qtrace99.inc"
      RETURN

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

C----              BAD DATA

C-    JERROR = 34  bank chaining clobbered in the input data
  734 JERROR = 34
      IQUEST(14)= IQLN
      NWERR  = 1
      GO TO 739

C-    JERROR = 33  ends of segment and rel. tables do not match
  733 JERROR = 33
      IQUEST(14)= LTAKE
      IQUEST(15)= LQTE
      NWERR  = 2
      GO TO 739

C-    JERROR = 32  segment limit does not match a rel. table entry
  732 JERROR = 32
      IQUEST(14)= NWSG
      NWERR  = 1
      GO TO 739

C-    JERROR = 31  segment table tries to overshoot rel. table
  731 JERROR = 31
      IQUEST(14)= NWSG
      NWERR  = 1
  739 JRETCD = 5
      GO TO 999
      END
*      ==================================================
#include "zebra/qcardl.inc"
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.2 1996/04/18 16:10:43 mclareni
	6	* Incorporate changes from J.Zoll for version 3.77
	7	*
	8	* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
	9	* Zebra
	10	*
	11	*
	12	#include "zebra/pilot.h"
	13	SUBROUTINE FZIREL
	14
	15	C- RELOCATE DATA-STRUCTURE READ
	16	C- USE THE MEMORY OCCUPATION TABLE READY
	17	C- AND THE RELOCATION VECTOR READ INTO LQ(LQTA+NWTABI)
	18	C- CALLED FROM FZIN
	19
	20	#include "zebra/zbcd.inc"
	21	#include "zebra/zmach.inc"
	22	#include "zebra/zunit.inc"
	23	#include "zebra/mqsys.inc"
	24	#include "zebra/eqlqf.inc"
	25	#include "zebra/mzcn.inc"
	26	#include "zebra/mzct.inc"
	27	#include "zebra/fzci.inc"
	28	C-------------- End CDE --------------
	29	DIMENSION LADESV(6)
	30	#if defined(CERNLIB_QMVDS)
	31	SAVE LADESV
	32	#endif
	33	#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
	34	DIMENSION NAMESR(2)
	35	DATA NAMESR / 4HFZIR, 4HEL /
	36	#endif
	37	#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
	38	DATA NAMESR / 6HFZIREL /
	39	#endif
	40	#if !defined(CERNLIB_QTRHOLL)
	41	CHARACTER NAMESR*8
	42	PARAMETER (NAMESR = 'FZIREL ')
	43	#endif
	44	DATA LADESV / 6, 5*0 /
	45
	46
	47	#include "zebra/qtrace.inc"
	48
	49	IF (NWTABI.EQ.0) GO TO 61
	50
	51	C------ Ready the relocation table
	52
	53	LPUT = LQTA
	54	LTAKE = LQTA + NWTABI
	55
	56	C-- Loop for all segments in the memory occupation tb.
	57
	58	LMT = LQMTA
	59	22 IF (LQ(LMT+1).NE.0) GO TO 24
	60
	61	C-- Skipped segment
	62
	63	NWSG = LQ(LMT+3)
	64	23 IF (NWSG.GE.0) GO TO 29
65	IF (LTAKE.GE.LQTE) GO TO 731
66	NWSG = NWSG + (LQ(LTAKE+1)-LQ(LTAKE))
67	LTAKE = LTAKE + 2
68	GO TO 23
69
70	C-- Accepted segment
71
72	24 LSTA = LQ(LMT+3)
73	LEND = LQ(LMT+4)
74	NWSG = LSTA - LEND
75	NREL = 0
76	LE = LSTA
77	25 IF (LTAKE.GE.LQTE) GO TO 731
78	LA = LQ(LTAKE)
79	NREL = NREL - (LA-LE)
80	LE = LQ(LTAKE+1)
81
82	LQ(LPUT) = LA
83	LQ(LPUT+1) = LE
84	LQ(LPUT+2) = NREL
85	LQ(LPUT+3) = 0
86	LTAKE = LTAKE + 2
87	LPUT = LPUT + 4
88	NWSG = NWSG + (LE-LA)
89	IF (NWSG.LT.0) GO TO 25
90	29 IF (NWSG.NE.0) GO TO 732
91	LMT = LMT + 8
92	IF (LMT.LT.LQMTE) GO TO 22
93	IF (LTAKE.NE.LQTE) GO TO 733
94	LQTE = LPUT
95
96	LQ(LQTE) = LQ(LQTE-3)
97	LQ(LQTA-1) = LQ(LQTA)
98	#if defined(CERNLIB_QDEVZE)
99	IF (LOGLVI.GE.4)
100	+ WRITE (IQLOG,9167) LENTRI,(LQ(J),J=LQTA,LQTE-1)
101	9167 FORMAT (' FZIREL- Relocation Table, LENTRY before=',I10/
102	F (15X,3I9,I4))
103	#endif
104
105	C---- Relocate the bank links
106
107	IQFLIO = 7
108	CALL MZRELB
109	IF (IQFLIO.LT.0) GO TO 734
110
111	C-- Relocate the entry link
112
113	LADESV(2) = LOCF(LENTRI) - LQSTOR
114	LADESV(3) = LADESV(2) + 1
115	LADESV(5) = IQLETT(9)
116	LADESV(6) = IQLETT(15)
117	CALL MZRELL (LADESV)
118	#if defined(CERNLIB_QDEVZE)
119	IF (LOGLVI.GE.4) WRITE (IQLOG,9037) LENTRI
120	9037 FORMAT (10X,'LENTRY after=',I10)
121	#endif
122	LQ(KQS+LENTRI+1) = 0
123	LQ(KQS+LENTRI+2) = 0
124	GO TO 999
125
126	C------ Chain banks into one linear structure
127
128	61 CALL FZILIN
129	IF (IQFOUL.NE.0) GO TO 734
130	LENTRI = IQUEST(1)
131	#include "zebra/qtrace99.inc"
132	RETURN
133
134	C-------------------------------------------------
135	C- ERROR CONDITIONS
136	C-------------------------------------------------
137
138	C---- BAD DATA
139
140	C- JERROR = 34 bank chaining clobbered in the input data
141	734 JERROR = 34
142	IQUEST(14)= IQLN
143	NWERR = 1
144	GO TO 739
145
146	C- JERROR = 33 ends of segment and rel. tables do not match
147	733 JERROR = 33
148	IQUEST(14)= LTAKE
149	IQUEST(15)= LQTE
150	NWERR = 2
151	GO TO 739
152
153	C- JERROR = 32 segment limit does not match a rel. table entry
154	732 JERROR = 32
155	IQUEST(14)= NWSG
156	NWERR = 1
157	GO TO 739
158
159	C- JERROR = 31 segment table tries to overshoot rel. table
160	731 JERROR = 31
161	IQUEST(14)= NWSG
162	NWERR = 1
163	739 JRETCD = 5
164	GO TO 999
165	END
166	* ==================================================
167	#include "zebra/qcardl.inc"