Changes needed by ICC/IFC compiler (Intel)
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / dzebra / dzmap.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:12 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:07 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 DZMAP
22#include "zebra/bankparq.inc"
23#include "zebra/divparq.inc"
24#include "zebra/storparq.inc"
25#include "zebra/mqsys.inc"
26#include "zebra/qequ.inc"
27#include "zebra/mzcn.inc"
28#include "zebra/zbcd.inc"
29#include "zebra/zbcdk.inc"
30#include "zebra/zunit.inc"
31#include "zebra/dzc1.inc"
32
33
34 PARAMETER ( NLMAPQ = 7 )
35 PARAMETER ( ISIDEQ = 6 )
36 PARAMETER ( ILINKQ = 15)
37 PARAMETER ( NLINKQ = 14)
38 PARAMETER ( IMAD1Q = 1 , IMAD2Q= 8)
39 PARAMETER ( IMTG1Q = 9 , IMTG2Q= 9)
40 PARAMETER ( IMID1Q = 10, IMID2Q= 13)
41
42 CHARACTER CHROUT*(*),CHSTAK*6
43 PARAMETER (CHROUT = 'DZMAP' )
44
45#include "zebra/q_jbit.inc"
46
47#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
48#include "zebra/debugvf2.inc"
49#endif
50
51
52 CHSTAK = CQSTAK(MCQSIQ:)
53 CQSTAK(MCQSIQ:) = CHROUT
54
55 IDOPT = IFLOPT(MPOSDQ)
56
57
58 IF (LN.GT.0) THEN
59 CALL MZCHLN(NCHEKQ,LN)
60 IF (IQFOUL.NE.0) GO TO 998
61 ELSE
62 CALL MZCHLS(NCHEKQ,LS)
63 IF (IQFOUL.NE.0) GO TO 998
64 ENDIF
65
66 IF (IQND.LT.0) THEN
67 IF (IFLOPT(MPOSHQ).NE.0) THEN
68
fe4da5cc 69#if !defined(CERNLIB_OCTMAP)
e22fdcea 70 WRITE(CQLINE,
fe4da5cc 71 W '(1X,''(*HO*'',1X,I8,''('',Z8,
e22fdcea 72 W '') -- HOLE of '',I8,'' words'')') IQLN,(IQLN+LQSTOR)
73#else
74 WRITE(CQLINE,
fe4da5cc 75 W '(1X,''(*HO*'',1X,I8,''('',O8,
fe4da5cc 76 W '') -- HOLE of '',I8,'' words'')') IQLN,(IQLN+LQSTOR)
e22fdcea 77#endif
fe4da5cc 78* MAP addresses are in BYTES
79#if !defined(CERNLIB_WORDMAP)
80 W *4
81#endif
82 W ,-IQND
83
84 CALL DZTEXT(0,CDUMMQ,1)
85 ENDIF
86 LX = IQNX
87 GO TO 999
88 ELSE
89 LS = IQLS
90 NL = IQNL
91 NS = IQNS
92 ND = IQND
93 LX = IQNX
94 ENDIF
95
96 IF (IFLOPT(MPOSKQ).EQ.0) THEN
97 JDROP = JBIT(IQ(KQS+IQLS),IQDROP)
98 ELSE
99 JDROP = 0
100 ENDIF
101 MARKD = 0
102 IF (JDROP.EQ.0) THEN
103 IF(IFLOPT(MPOSDQ).NE.0) THEN
104 MARKD = JRSBYT(0,IQ(KQS+LS),IQMARK,1)
105 IFLOPT(MPOSDQ) = 0
106 ENDIF
107 IF(IFLOPT(MPOSCQ).NE.0) THEN
108 MARKD = JRSBYT(0,IQ(KQS+LS),IQCRIT,1) + MARKD
109 ENDIF
110 IF (MARKD+IFLOPT(MPOSFQ).NE.0) THEN
111 IFLOPT(MPOSDQ) = 1
112 CALL DZSHPR(LS,0,0,0,0)
113 GO TO 999
114 ENDIF
115 IF (MARKD+IFLOPT(MPOSEQ).NE.0) THEN
116 IFLOPT(MPOSDQ) = 1
117 CALL DZSHPR(LS,0,0,0,-1)
118 GO TO 999
119 ENDIF
120 ENDIF
121
122 CALL DZBKHD
123 IF (IQUEST(1).NE.0) GO TO 998
124
125
126 IF (NL.EQ.0) GO TO 999
127
128
129 CQLINE = ' . LINKS'
130 LAST = LS - NL
131 L = LAST
132
133 DO 43 J=1,NL
134 IF (LQ(L+KQS).NE.0) GO TO 44
135 43 L = L+1
136 44 NP= LS - L
137
138 IF (NP.EQ.0) GO TO 999
139
140 IF (NP.GT.NLMAPQ) THEN
141 CQLINE(ISIDEQ+1:ISIDEQ+1) = '+'
142 NP = NLMAPQ
143 ENDIF
144
145 IF (JDROP.NE.0) CQLINE(ISIDEQ:ISIDEQ+1) = '**'
146
147 L = LS + KQS
148 DO 50 J=1,NP
149 I = (J-1)*NLINKQ + ILINKQ
150 LINK = LQ (L-J)
151 WRITE(CQLINE(I+IMAD1Q:I+IMAD2Q),'(I8)') LINK
152 IF (LINK.EQ.LNULL) GO TO 50
153 CALL MZCHLS(NCHEKQ,LINK)
154 WRITE(CQLINE(I+IMID1Q:I+IMID2Q),'(A4)') IQID
155
156 IF (IQFOUL.EQ.0) THEN
157 IF (JBIT(IQ(KQS+LINK),IQDROP).NE.0) THEN
158 CQLINE(I+IMTG1Q:I+IMTG2Q) = '('
159 IF (JDROP.EQ.0) CQLINE(ISIDEQ+1:ISIDEQ+1) = 'F'
160 IF (IQND.LT.0) CQLINE(I+IMID1Q:I+IMID2Q) = '*HO*'
161 ELSE
162 IF (JDROP.NE.0.AND.J.LE.NS.AND.J.GT.1) THEN
163 CQLINE(ISIDEQ+1:ISIDEQ+1) = 'F'
164 ENDIF
165 ENDIF
166 ELSEIF (IQFOUL.GT.0) THEN
167 IF (J.LE.NS) THEN
168 CQLINE(I+IMID1Q:I+IMID2Q) = '****'
169 CQLINE(ISIDEQ+1:ISIDEQ+1) = 'F'
170 ELSE
171 CQLINE(I+IMID1Q:I+IMID2Q) = '-'
172 ENDIF
173 ELSE
174 CQLINE(I+IMID1Q:I+IMID2Q) = '****'
175 CQLINE(ISIDEQ+1:ISIDEQ+1) = 'F'
176 ENDIF
177
178 50 CONTINUE
179
180
181 CALL DZTEXT(0,CDUMMQ,1)
182
183 GO TO 999
184
185 998 IQUEST(1) = 1
186
187 999 IFLOPT(MPOSDQ) = IDOPT
188 CQSTAK(MCQSIQ:) = CHSTAK
189 END