]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/fq/fzoffx.F
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 / fq / fzoffx.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.3 1996/04/24 17:26:27 mclareni
6* Extend the include file cleanup to dzebra, rz and tq, and also add
7* dependencies in some cases.
8*
9* Revision 1.2 1996/04/18 16:10:48 mclareni
10* Incorporate changes from J.Zoll for version 3.77
11*
12* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
13* Zebra
14*
15*
16#include "zebra/pilot.h"
17 SUBROUTINE FZOFFX (IUHEAD)
18
19C- Write to buffer operations for file format Exchange,
20C- subsidiary to FZOUT
21
22C- Controlling parameter : IDX(2)
23C-
24C- IDX(2) = 1 write start/end-of-run
25C- > 1 write pilot for d/s
26C- = 0 write bank material for d/s
27C- = -1 flush the buffer
28C- = -2 End-of-File
29C- = -3 End-of-Data
30
31#include "zebra/zunit.inc"
32#include "zebra/mqsys.inc"
33#include "zebra/eqlqf.inc"
34#include "zebra/mzct.inc"
35#include "zebra/mzcn.inc"
36#include "zebra/mzioc.inc"
37#include "zebra/fzcx.inc"
38#include "zebra/fzcseg.inc"
39C-------------- End CDE --------------
40 DIMENSION IUHEAD(99)
41#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
42 DIMENSION NAMESR(2)
43 DATA NAMESR / 4HFZOF, 4HFX /
44#endif
45#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
46 DATA NAMESR / 6HFZOFFX /
47#endif
48#if !defined(CERNLIB_QTRHOLL)
49 CHARACTER NAMESR*8
50 PARAMETER (NAMESR = 'FZOFFX ')
51#endif
52#if !defined(CERNLIB_FQXISN)
53#include "zebra/q_jbyt.inc"
54#endif
55
56#include "zebra/qtraceq.inc"
57
58 IF (IDX(2)) 71, 41, 11
59 11 IF (IDX(2).EQ.1) GO TO 61
60
61C-----------------------------------------------------------
62C------ WRITE PILOT INFORMATION, STARTING LR AND D/S
63C-----------------------------------------------------------
64
65 IDX(1) = 10 + NWUHCX + NWSEGX + NWTXX + NWTABX + NWBKX
66#if !defined(CERNLIB_FQXISN)
67 IF (IDAFOX.EQ.0) GO TO 31
68
69C-----------------------------------------------------------
70C-- Pilot in exchange data format
71C-----------------------------------------------------------
72
73 MFO(1) = 3
74 MFO(2) = 1
75 MFO(3) = 1
76 MFO(4) = -1
77 JFOEND = 4
78 CALL FZOTRX (IPILX, 10+NWIOX)
79
80C-- User header
81
82 IF (NWUHCX.NE.0) THEN
83 CALL MZIOCR (IOCHX)
84 CALL FZOTRX (IUHEAD, NWUHX)
85 ENDIF
86
87C-- Segment table
88
89 IF (NWSEGX.NE.0) THEN
90 MFO(1) = 5
91 MFO(2) = -1
92 JFOEND = 2
93 CALL FZOTRX (IQSEGH, 2*NQSEG)
94 MFO(1) = 1
95 MFO(2) = -1
96 CALL FZOTRX (IQSEGD, NQSEG)
97 ENDIF
98
99C-- Text vector
100
101 IF (NWTXX.NE.0) THEN
102 MFO(1) = 5
103 MFO(2) = 0
104 JFOEND = 2
105 JFOREP = 0
106 CALL FZOTRX (IQ(KQSP+LTEXTX+5), NWTXX)
107 ENDIF
108
109C-- Relocation table, only FZOUT, not FZCOPY
110
111 IF (ICOPYX.NE.0) GO TO 39
112 IF (NWTABX.NE.0) THEN
113 MFO(1) = 1
114 MFO(2) = -1
115 JFOEND = 2
116 CALL FZOTRX (LQ(LQTA), NWTABX)
117 ENDIF
118 GO TO 39
119#endif
120
121C-----------------------------------------------------------
122C-- Pilot in native data format
123C-----------------------------------------------------------
124
125 31 CALL FZOTRN (IPILX,10+NWIOX)
126
127C-- User header
128
129 IF (NWUHCX.NE.0) CALL FZOTRN (IUHEAD, NWUHX)
130
131C-- Segment table
132
133 IF (NWSEGX.NE.0) THEN
134 CALL FZOTRN (IQSEGH, 2*NQSEG)
135 CALL FZOTRN (IQSEGD, NQSEG)
136 ENDIF
137
138C-- Text vector
139
140 IF (NWTXX.NE.0) THEN
141 CALL FZOTRN (IQ(KQSP+LTEXTX+5), NWTXX)
142 ENDIF
143
144C-- Relocation table, only FZOUT, not FZCOPY
145
146 IF (ICOPYX.NE.0) GO TO 39
147 IF (NWTABX.NE.0) CALL FZOTRN (LQ(LQTA), NWTABX)
148 39 IF (NWBKX.NE.0) GO TO 999
149 GO TO 991
150
151C-----------------------------------------------------------
152C-- WRITE BANK MATERIAL
153C-----------------------------------------------------------
154
155 41 LTB = LQTA
156#if !defined(CERNLIB_FQXISN)
157 IF (IDAFOX.EQ.0) GO TO 51
158
159C-----------------------------------------------------------
160C-- Bank groups in exchange data format
161C-----------------------------------------------------------
162
163 42 L = LQ(LTB)
164 LE = LQ(LTB+1)
165
166C-- Next bank
167
168 44 IQLN = L
169 IWD = LQ(KQS+L)
170 NST = JBYT (IWD,1,16) - 12
171 IF (NST.LT.0) GO TO 48
172
173C-- True bank
174
175 IQLS = L + NST + 1
176 IQNIO = JBYT (IQ(KQS+IQLS),19,4)
177 IQNL = IQ(KQS+IQLS-3)
178 IQND = IQ(KQS+IQLS-1)
179 IQNX = IQLS + IQND + 9
180
181C- first word, I/O words, links, next-link, up-link
182 N = IQNIO + IQNL
183 MFO(1) = 1
184 MFO(2) = N + 3
185
186C- origin, numeric ID
187 MFO(3) = 2
188 MFO(4) = 2
189
190C- Hollerith ID
191 MFO(5) = 5
192 MFO(6) = 1
193
194C- NL, NS, ND, status
195 MFO(7) = 1
196 MFO(8) = -1
197 JFOEND = 8
198 CALL FZOTRX (LQ(KQS+L), N+10)
199
200C- data words
201 IF (IQND.EQ.0) GO TO 46
202 CALL MZIOCR (LQ(KQS+IQLN))
203 CALL FZOTRX (IQ(KQS+IQLS+1), IQND)
204
205 46 L = IQNX
206 IF (L.LT.LE) GO TO 44
207 LTB = LTB + 2
208 IF (LTB.LT.LQTE) GO TO 42
209 GO TO 991
210
211C-- Short dead region
212
213 48 NWD = NST + 12
214 IQNX = L + NWD
215 MFO(1) = 1
216 MFO(2) = -1
217 JFOEND = 2
218 CALL FZOTRX (LQ(KQS+L), NWD)
219 GO TO 46
220#endif
221
222C-----------------------------------------------------------
223C-- Bank-groups in native data format
224C-----------------------------------------------------------
225
226 51 L = LQ(LTB)
227 LE = LQ(LTB+1)
228 CALL FZOTRN (LQ(KQS+L), LE-L)
229 LTB = LTB + 2
230 IF (LTB.LT.LQTE) GO TO 51
231
232 991 CALL FZOREC
233#include "zebra/qtrace99.inc"
234 RETURN
235
236C-----------------------------------------------------------
237C-- WRITE START/END-OF-RUN
238C-----------------------------------------------------------
239
240 61 JRUN = IQUEST(11)
241 NWUHU = IDX(1) - 1
242#if !defined(CERNLIB_FQXISN)
243 IF (IDAFOX.EQ.0) GO TO 64
244 MFO(1) = 2
245 MFO(2) = -1
246 JFOEND = 2
247 CALL FZOTRX (JRUN,1)
248 IF (NWUHU.EQ.0) GO TO 991
249 CALL FZOTRX (IUHEAD,NWUHU)
250 GO TO 991
251#endif
252 64 CALL FZOTRN (JRUN,1)
253 IF (NWUHU.NE.0) CALL FZOTRN (IUHEAD,NWUHU)
254 GO TO 991
255
256C-----------------------------------------------------------
257C-- FLUSH BUFFER / ENDFILE
258C-----------------------------------------------------------
259
260 71 GO TO 991
261 END
262* ==================================================
263#include "zebra/qcardl.inc"