22674b772631f02e9fdf62e6d106de66493e4e52
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / dzebra / dzare1.F
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