]>
Commit | Line | Data |
---|---|---|
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 | ||
19 | C- Write to buffer operations for file format Exchange, | |
20 | C- subsidiary to FZOUT | |
21 | ||
22 | C- Controlling parameter : IDX(2) | |
23 | C- | |
24 | C- IDX(2) = 1 write start/end-of-run | |
25 | C- > 1 write pilot for d/s | |
26 | C- = 0 write bank material for d/s | |
27 | C- = -1 flush the buffer | |
28 | C- = -2 End-of-File | |
29 | C- = -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" | |
39 | C-------------- 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 | ||
61 | C----------------------------------------------------------- | |
62 | C------ WRITE PILOT INFORMATION, STARTING LR AND D/S | |
63 | C----------------------------------------------------------- | |
64 | ||
65 | IDX(1) = 10 + NWUHCX + NWSEGX + NWTXX + NWTABX + NWBKX | |
66 | #if !defined(CERNLIB_FQXISN) | |
67 | IF (IDAFOX.EQ.0) GO TO 31 | |
68 | ||
69 | C----------------------------------------------------------- | |
70 | C-- Pilot in exchange data format | |
71 | C----------------------------------------------------------- | |
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 | ||
80 | C-- User header | |
81 | ||
82 | IF (NWUHCX.NE.0) THEN | |
83 | CALL MZIOCR (IOCHX) | |
84 | CALL FZOTRX (IUHEAD, NWUHX) | |
85 | ENDIF | |
86 | ||
87 | C-- 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 | ||
99 | C-- 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 | ||
109 | C-- 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 | ||
121 | C----------------------------------------------------------- | |
122 | C-- Pilot in native data format | |
123 | C----------------------------------------------------------- | |
124 | ||
125 | 31 CALL FZOTRN (IPILX,10+NWIOX) | |
126 | ||
127 | C-- User header | |
128 | ||
129 | IF (NWUHCX.NE.0) CALL FZOTRN (IUHEAD, NWUHX) | |
130 | ||
131 | C-- Segment table | |
132 | ||
133 | IF (NWSEGX.NE.0) THEN | |
134 | CALL FZOTRN (IQSEGH, 2*NQSEG) | |
135 | CALL FZOTRN (IQSEGD, NQSEG) | |
136 | ENDIF | |
137 | ||
138 | C-- Text vector | |
139 | ||
140 | IF (NWTXX.NE.0) THEN | |
141 | CALL FZOTRN (IQ(KQSP+LTEXTX+5), NWTXX) | |
142 | ENDIF | |
143 | ||
144 | C-- 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 | ||
151 | C----------------------------------------------------------- | |
152 | C-- WRITE BANK MATERIAL | |
153 | C----------------------------------------------------------- | |
154 | ||
155 | 41 LTB = LQTA | |
156 | #if !defined(CERNLIB_FQXISN) | |
157 | IF (IDAFOX.EQ.0) GO TO 51 | |
158 | ||
159 | C----------------------------------------------------------- | |
160 | C-- Bank groups in exchange data format | |
161 | C----------------------------------------------------------- | |
162 | ||
163 | 42 L = LQ(LTB) | |
164 | LE = LQ(LTB+1) | |
165 | ||
166 | C-- 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 | ||
173 | C-- 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 | ||
181 | C- first word, I/O words, links, next-link, up-link | |
182 | N = IQNIO + IQNL | |
183 | MFO(1) = 1 | |
184 | MFO(2) = N + 3 | |
185 | ||
186 | C- origin, numeric ID | |
187 | MFO(3) = 2 | |
188 | MFO(4) = 2 | |
189 | ||
190 | C- Hollerith ID | |
191 | MFO(5) = 5 | |
192 | MFO(6) = 1 | |
193 | ||
194 | C- NL, NS, ND, status | |
195 | MFO(7) = 1 | |
196 | MFO(8) = -1 | |
197 | JFOEND = 8 | |
198 | CALL FZOTRX (LQ(KQS+L), N+10) | |
199 | ||
200 | C- 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 | ||
211 | C-- 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 | ||
222 | C----------------------------------------------------------- | |
223 | C-- Bank-groups in native data format | |
224 | C----------------------------------------------------------- | |
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 | ||
236 | C----------------------------------------------------------- | |
237 | C-- WRITE START/END-OF-RUN | |
238 | C----------------------------------------------------------- | |
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 | ||
256 | C----------------------------------------------------------- | |
257 | C-- FLUSH BUFFER / ENDFILE | |
258 | C----------------------------------------------------------- | |
259 | ||
260 | 71 GO TO 991 | |
261 | END | |
262 | * ================================================== | |
263 | #include "zebra/qcardl.inc" |