git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Changes needed by ICC/IFC compiler (Intel)
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / dzebra / dzare1.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
e22fdcea 5* Revision 1.1.1.1 1999/05/18 15:55:22 fca
6* AliRoot sources
7*
fe4da5cc 8* Revision 1.2 1996/04/24 17:26:00 mclareni
9* Extend the include file cleanup to dzebra, rz and tq, and also add
10* dependencies in some cases.
11*
12* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
13* Zebra
14*
15*
16*-----------------------------------------------------------
17#include "zebra/pilot.h"
18#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
19#include "zebra/debugvf1.inc"
20#endif
21 SUBROUTINE DZARE1 (CHTEXT,CLA,LLA,CHOPT)
22 SAVE CLATYP
23#include "zebra/mqsys.inc"
24#include "zebra/qequ.inc"
25#include "zebra/mzcn.inc"
26#include "zebra/zbcdch.inc"
27#include "zebra/zbcdk.inc"
28#include "zebra/zstate.inc"
29#include "zebra/zunit.inc"
30#include "zebra/dzc1.inc"
31#include "zebra/questparq.inc"
32#include "zebra/storparq.inc"
33 CHARACTER *(*) CLA,CHOPT,CHTEXT
34 INTEGER ILANAM(2)
35
36 CHARACTER CHROUT*(*),CHSTAK*6, CLATYP(0:1)*9, CLA8*8, CAKTIV*8
37 PARAMETER (CHROUT = 'DZARE1')
38 DATA CLATYP /'PERMANENT','TEMPORARY'/
39
40#include "zebra/q_jbit.inc"
41#include "zebra/q_jbyt.inc"
42
43#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
44#include "zebra/debugvf2.inc"
45#endif
46
47
48 CHSTAK = CQSTAK(MCQSIQ:)
49 CQSTAK(MCQSIQ:) = CHROUT
50
51 IF (LQSTA(KQT+JQDVSY).EQ.LQEND(KQT+JQDVSY)) THEN
52 IQUEST(1) = 0
53 GO TO 999
54 ENDIF
55
56 LSYSB = LQSYSS(KQT+MSYLAQ)
57 CALL MZCHLS(NCHEKQ,LSYSB)
58 IF (IQFOUL.NE.0) THEN
59 WRITE(CQINFO,'(''Store = '',2A4)') NQSNAM(1),NQSNAM(2)
60 CALL DZTEXT(MARE1Q,CHTEXT,0)
61 GO TO 999
62 ENDIF
63
64
65 NWTAB = IQ(KQS+LSYSB+MLAUSQ)
66 IF(NWTAB.LE.1) THEN
67 WRITE(CQINFO,'(''Store = '',2A4)') NQSNAM(1),NQSNAM(2)
68 CALL DZTEXT(MARE2Q,CHTEXT,0)
69 GO TO 999
70 ENDIF
71
72 IF (IFLOPT(MPOSNQ).NE.0) THEN
73
74
75 CLA8 = CLA
76 CALL UCTOH (CLA8,ILANAM,4,8)
77 ELSE
78
79
80 LLINK = LOCF(LLA) - LQSTOR
81 ENDIF
82
83
84 LENTRY = LSYSB + KQS + MLAUSQ
85
86 IFOUND = 0
87
88 DO 100 IENTRY = 1,(NWTAB-1)/NLAENQ
89
90
91 IF (IFLOPT(MPOSNQ).NE.0) THEN
92 IF(CLA.NE.' ') THEN
93 IF (ILANAM(1).NE.IQ(LENTRY+MLAN1Q) .OR.
94 X ILANAM(2).NE.IQ(LENTRY+MLAN2Q) ) GO TO 100
95 ELSE
96 IF(IENTRY.LE.2) GO TO 100
97 ENDIF
98
99 ELSE
100
101
102 IF (LLINK.LT.IQ(LENTRY+MLAADQ) .OR.
103 X LLINK.GT.IQ(LENTRY+MLALTQ) ) GO TO 100
104
105 ENDIF
106
107
108 LLAAR1 = IQ(LENTRY+MLAADQ)
109 LLAARL = IQ(LENTRY+MLALTQ)
110 NLANS = IQ(LENTRY+MLANSQ)
111 JTEMP = JBIT(NLANS,JLATMQ)
112 NTEMP = NLATMQ*JTEMP
113 NLANS = JBYT(NLANS,JLANSQ,NLANSQ)-NTEMP
114 IF(JTEMP.EQ.0.OR.
115 + (JTEMP.EQ.1.AND.LQ(KQS+LLAAR1+MLACTQ-1).NE.0)) THEN
116 CAKTIV = ' ACTIVE'
117 ELSE
118 CAKTIV = 'INACTIVE'
119 ENDIF
120
121
122 DO 50 I = NTEMP,NLANS-1
123 LS = LQ(KQS+LLAAR1+I)
124 IF (LS.EQ.0) GO TO 50
125 CALL MZCHLS(NCHEKQ,LS)
126 ID = IQID
127 IF (JBIT(IQ(KQS+LS),IQDROP).EQ.1) GO TO 50
128 IF (IQFOUL.EQ.0) THEN
129 LUP = LQLUP(KQS+LS)
130 IF (LUP.EQ.0) GO TO 40
131 CALL MZCHLS(NCHEKQ,LUP)
132 IF (IQFOUL.NE.0) THEN
133 WRITE(CQINFO,
134 X '(2A4,''/'',I5,''= '',A4,2I10)')
135 X IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),
136 X I+1,ID,LS,LUP
137 CALL DZTEXT(MARE3Q,CDUMMQ,0)
138 ENDIF
139 40 LORIG = LQLORG(KQS+LS)
140 IF (LORIG.EQ.0) GO TO 50
141 IF(LORIG.LT.IQTABV(KQT+13).OR.LORIG.GT.IQTABV(KQT+14))
142 X THEN
143 WRITE(CQINFO,'(2A4,''/'',I5,''= '',A4,2I10)')
144 X IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),
145 X I+1,ID,LS,LORIG
146 CALL DZTEXT(MARE4Q,CDUMMQ,0)
147 ELSEIF (LQ(KQS+LORIG).NE.LS) THEN
148 WRITE(CQINFO,'(2A4,''/'',I5,''= '',A4,2I10)')
149 X IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),
150 X I+1,ID,LS,LORIG
151 CALL DZTEXT(MARE4Q,CDUMMQ,0)
152 ENDIF
153 IF (IQND.LT.NQDCUT.AND.IFLOPT(MPOSTQ).NE.0)
154 X CALL SBIT1 (IQ(KQS+LS),IQCRIT)
155 ELSE
156 WRITE(CQINFO,'(2A4,''/'',I5,''='',I10)')
157 X IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),I+1,LS
158 CALL DZTEXT(MARE5Q,CDUMMQ,0)
159 ENDIF
160 50 CONTINUE
161
162 IF (IFLOPT(MPOSQQ).EQ.0) THEN
163 IF (CHTEXT.NE.CDUMMQ) THEN
164 CQMAP(1) = ' '
165 CQMAP(2) = ' DZAREA -- '
166 CQMAP(2)(12:) = CHTEXT
167 WRITE(CQMAP(2)(80:),'('' -- Dump of link area '',2A4,
168 W '' Options: '',A)')
169 W IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),CHOPT
170 CALL DZTEXT(0,CDUMMQ,2)
171 ENDIF
172
173 CQMAP(1) = ' '
fe4da5cc 174#if !defined(CERNLIB_OCTMAP)
e22fdcea 175 WRITE(CQMAP(2),
fe4da5cc 176 W '('' This '',A9,'' LINK AREA is at absolute address '',Z8,
e22fdcea 177 W '' with NL/NS ='',I7,''/'',I7,4X,'' and is '',A8)' )
178 W CLATYP(JTEMP),(LLAAR1+LQSTOR)
179#else
180 WRITE(CQMAP(2),
fe4da5cc 181 W '('' This '',A9,'' LINK AREA is at absolute address '',O11,
fe4da5cc 182 W '' with NL/NS ='',I7,''/'',I7,4X,'' and is '',A8)' )
183 W CLATYP(JTEMP),(LLAAR1+LQSTOR)
e22fdcea 184#endif
fe4da5cc 185#if !defined(CERNLIB_WORDMAP)
186 W *4
187#endif
188 W ,LLAARL-LLAAR1-NTEMP,NLANS,CAKTIV
189 CALL DZTEXT(0,CDUMMQ,2)
190 CALL DZTEXT(1,CDUMMQ,1)
191
192
193 LBASE = LLAAR1 + NTEMP - 1
194 IBASE = 0
195 NDW = LLAARL - LLAAR1 - NTEMP
196 JDFD = NDW + 1
197
198 CALL DZDATA(CDUMMQ)
199
200 IFOUND = 1
201 IF (IFLOPT(MPOSNQ).NE.0) THEN
202 IF (CLA.NE.' ') GO TO 999
203 ELSE
204 GO TO 999
205 ENDIF
206 ELSE
207 IQUEST(10) = IENTRY
208 IQUEST(11) = IQ(LENTRY+MLAN1Q)
209 IQUEST(12) = IQ(LENTRY+MLAN2Q)
210 IQUEST(13) = LLAAR1
211 IQUEST(14) = LLAAR1 + NLANS
212 IQUEST(15) = LLAARL
213 IQUEST(16) = NLANS
214 IQUEST(17) = LLAARL-LLAAR1
215 IQUEST(18) = JTEMP
216 IQUEST(19) = LQ(KQS+LLAAR1+MLACTQ-1)
217 GO TO 999
218 ENDIF
219 100 LENTRY = LENTRY + NLAENQ
220
221 IF (IFOUND.EQ.0) THEN
222 IF (IFLOPT(MPOSQQ).EQ.0) THEN
223 IF (IFLOPT(MPOSNQ).NE.0) THEN
224 WRITE(CQINFO,'(A)') CLA8
225 CALL DZTEXT(MARE6Q,CHTEXT,0)
226 ELSE
227 WRITE(CQINFO,'(I8)') LLINK
228 CALL DZTEXT(MARE7Q,CHTEXT,0)
229 ENDIF
230 ELSE
231 IQUEST(10) = 0
232 ENDIF
233 ENDIF
234
235 999 CQSTAK(MCQSIQ:) = CHSTAK
236 RETURN
237 END