]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
5 | * Revision 1.1.1.1 1996/03/06 10:47:07 mclareni | |
6 | * Zebra | |
7 | * | |
8 | * | |
9 | *----------------------------------------------------------- | |
10 | #include "zebra/pilot.h" | |
11 | #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT)) | |
12 | #include "zebra/debugvf1.inc" | |
13 | #endif | |
14 | SUBROUTINE DZZERO (IXSTOR,LBANK) | |
15 | #include "zebra/mqsys.inc" | |
16 | #include "zebra/mzcn.inc" | |
17 | #include "zebra/mzioc.inc" | |
18 | ||
19 | CHARACTER CLZERO*4 | |
20 | DOUBLE PRECISION DLZERO | |
21 | INTEGER HLZERO , ILZERO | |
22 | REAL RLZERO | |
23 | SAVE CLZERO,DLZERO,HLZERO,ILZERO,RLZERO,IFIRST | |
24 | DATA CLZERO,DLZERO,ILZERO,RLZERO /' ',0.0D0,0,0.0/ ,IFIRST /1/ | |
25 | ||
26 | #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT)) | |
27 | #include "zebra/debugvf2.inc" | |
28 | #endif | |
29 | ||
30 | ||
31 | ||
32 | ||
33 | IF (IFIRST.EQ.1) THEN | |
34 | IFIRST=0 | |
35 | CALL UCTOH(CLZERO,HLZERO,4,4) | |
36 | ENDIF | |
37 | ||
38 | ||
39 | CALL MZSDIV(IXSTOR,-1) | |
40 | CALL MZCHLS(-7,LBANK) | |
41 | CALL MZIOCR(LQ(KQS+IQLN)) | |
42 | IF(IQFOUL.NE.0) GO TO 999 | |
43 | ||
44 | JDATA = 0 | |
45 | JFOCUR = 0 | |
46 | ||
47 | ||
48 | 10 ITYPE = MFO(JFOCUR+1) | |
49 | IF (ITYPE.EQ.7) GO TO 40 | |
50 | NWSEC = MFO(JFOCUR+2) | |
51 | IF (NWSEC) 20, 30, 60 | |
52 | ||
53 | ||
54 | 20 NWSEC = IQND - JDATA | |
55 | GO TO 60 | |
56 | ||
57 | ||
58 | 30 JDATA = JDATA + 1 | |
59 | IWORD = IQ(KQS+LBANK+JDATA) | |
60 | NWSEC = IWORD | |
61 | GO TO 50 | |
62 | ||
63 | ||
64 | 40 JDATA = JDATA + 1 | |
65 | IWORD = IQ(KQS+LBANK+JDATA) | |
66 | ITYPE = MOD (IWORD,16) | |
67 | NWSEC = IWORD/16 | |
68 | ||
69 | 50 IF (ITYPE.GT.5.OR.ITYPE.LT.0) THEN | |
70 | ITYPE = 0 | |
71 | NWSEC = IQND - JDATA | |
72 | ELSEIF (NWSEC.LE.0) THEN | |
73 | NWSEC = IQND - JDATA | |
74 | ENDIF | |
75 | ||
76 | ||
77 | 60 IDBLE = 0 | |
78 | DO 100 I=JDATA+1,JDATA+NWSEC | |
79 | IF (IDBLE.EQ.1) THEN | |
80 | IDBLE = 0 | |
81 | ELSEIF (ITYPE.EQ.3) THEN | |
82 | Q(KQS+LBANK+I) = RLZERO | |
83 | ELSEIF (ITYPE.EQ.4) THEN | |
84 | CALL UCOPY(DLZERO,Q(KQS+LBANK+I),2) | |
85 | IDBLE = 1 | |
86 | ELSEIF (ITYPE.EQ.5) THEN | |
87 | IQ(KQS+LBANK+I) = HLZERO | |
88 | ELSE | |
89 | IQ(KQS+LBANK+I) = ILZERO | |
90 | ENDIF | |
91 | ||
92 | 100 CONTINUE | |
93 | ||
94 | ||
95 | JDATA = JDATA + NWSEC | |
96 | ||
97 | IF (JDATA.GE.IQND) GO TO 999 | |
98 | ||
99 | IF (JDATA.LT.IQND) THEN | |
100 | JFOCUR = JFOCUR + 2 | |
101 | IF (JFOCUR.LT.JFOEND) GO TO 10 | |
102 | JFOCUR = JFOREP | |
103 | GO TO 10 | |
104 | ENDIF | |
105 | ||
106 | ||
107 | 999 RETURN | |
108 | END |