Changes needed by ICC/IFC compiler (Intel)
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / dzebra / dzare1.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1999/05/18 15:55:22  fca
6 * AliRoot sources
7 *
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) = ' '
174 #if !defined(CERNLIB_OCTMAP)
175              WRITE(CQMAP(2),
176      W       '('' This '',A9,'' LINK AREA is at absolute address '',Z8,
177      W       '' with NL/NS ='',I7,''/'',I7,4X,'' and is '',A8)'      )
178      W        CLATYP(JTEMP),(LLAAR1+LQSTOR)
179 #else
180              WRITE(CQMAP(2),
181      W       '('' This '',A9,'' LINK AREA is at absolute address '',O11,
182      W       '' with NL/NS ='',I7,''/'',I7,4X,'' and is '',A8)'      )
183      W        CLATYP(JTEMP),(LLAAR1+LQSTOR)
184 #endif
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