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