]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
5 | * Revision 1.2 1996/04/24 17:26:59 mclareni | |
6 | * Extend the include file cleanup to dzebra, rz and tq, and also add | |
7 | * dependencies in some cases. | |
8 | * | |
9 | * Revision 1.1.1.1 1996/03/06 10:47:25 mclareni | |
10 | * Zebra | |
11 | * | |
12 | * | |
13 | #include "zebra/pilot.h" | |
14 | SUBROUTINE RZLIND(IDATA,NTOT,INEW,NEW) | |
15 | * | |
16 | ************************************************************************ | |
17 | * | |
18 | * To convert packed vectors into a portable format. | |
19 | * To extract integers from IDATA into bit pattern array INEW | |
20 | * The original IDATA are modified into characters. | |
21 | * | |
22 | * Called by RZTOF1 | |
23 | * | |
24 | * Author : R.Brun DD/US/PD | |
25 | * Written : 08.09.89 | |
26 | * Last mod: 08.09.89 | |
27 | * | |
28 | ************************************************************************ | |
29 | * | |
30 | DIMENSION IDATA(*),INEW(*) | |
31 | CHARACTER*4 KWORD | |
32 | * | |
33 | ||
34 | #include "zebra/q_jbit.inc" | |
35 | #include "zebra/q_jbyt.inc" | |
36 | ||
37 | NTOLD=NTOT | |
38 | KWORD=' ' | |
39 | IWORD=IDATA(NTOT+1) | |
40 | INEW(NEW)=IWORD | |
41 | IF(IWORD.EQ.0)THEN | |
42 | NTOT=NTOT+1 | |
43 | GO TO 90 | |
44 | ENDIF | |
45 | * | |
46 | IBIT31=JBIT(IWORD,31) | |
47 | IBIT32=JBIT(IWORD,32) | |
48 | IF(IBIT31.NE.0)THEN | |
49 | NWI=2 | |
50 | ELSE | |
51 | NWI=1 | |
52 | ENDIF | |
53 | KCODE=JBYT(IWORD,1,8) | |
54 | IF(IBIT32.NE.0)THEN | |
55 | * | |
56 | * Comment cards | |
57 | * | |
58 | ICODE=KCODE | |
59 | ICADRE=MOD(ICODE,2) | |
60 | * | |
61 | * Is there a frame ? | |
62 | * | |
63 | IF(ICADRE.NE.0)THEN | |
64 | NWI=NWI+1 | |
65 | NEW=NEW+1 | |
66 | INEW(NEW)=IDATA(NTOT+NWI) | |
67 | KWORD(1:1)=CHAR(JBYT(IDATA(NTOT+NWI),1,8)) | |
68 | IPOS1=JBYT(IDATA(NTOT+NWI),25,8) | |
69 | IF(IPOS1.NE.0)THEN | |
70 | KWORD(2:2)=CHAR(JBYT(IDATA(NTOT+NWI),17,8)) | |
71 | ENDIF | |
72 | ENDIF | |
73 | * | |
74 | * Is there a character to repeat? | |
75 | * | |
76 | ICAR=JBYT(IWORD,9,8) | |
77 | IF(ICAR.EQ.0)THEN | |
78 | * | |
79 | * No character to repeat. | |
80 | * | |
81 | IFWORD=JBYT(IWORD,17,7) | |
82 | ILASTW=JBYT(IWORD,24,7) | |
83 | IF(ILASTW.EQ.1) THEN | |
84 | NTOT=NTOT+NWI | |
85 | GO TO 90 | |
86 | ENDIF | |
87 | * | |
88 | IF (ILASTW.GT.20 .OR. IFWORD.GT.ILASTW)GO TO 100 | |
89 | * | |
90 | NTOT=NTOT+NWI+ILASTW-IFWORD+1 | |
91 | GO TO 90 | |
92 | ELSE | |
93 | * | |
94 | * Character must be repeated. | |
95 | * | |
96 | KWORD(3:3)=CHAR(ICAR) | |
97 | IFIRST=JBYT(IWORD,17,7) | |
98 | ILAST =JBYT(IWORD,24,7) | |
99 | * | |
100 | IF (ILAST.GT.80 .OR. IFIRST.GT.ILAST)GO TO 100 | |
101 | * | |
102 | NTOT =NTOT+NWI | |
103 | GO TO 90 | |
104 | ENDIF | |
105 | ELSE | |
106 | * | |
107 | * Other particular cases | |
108 | * | |
109 | ICODE = JBYT(IWORD,24,7) | |
110 | ICOD = ICODE-114 | |
111 | * | |
112 | IF(ICOD.LE.0)GO TO 40 | |
113 | IF (ICOD.LT.6 .OR. ICOD.GT.11) THEN | |
114 | IF (ICOD.EQ.1 .OR. ICOD.EQ.3 .OR. ICOD.EQ.5) THEN | |
115 | KWORD(1:1)=CHAR(KCODE) | |
116 | KWORD(2:2)=CHAR(JBYT(IWORD,9,8)) | |
117 | ENDIF | |
118 | NTOT=NTOT+NWI | |
119 | GO TO 90 | |
120 | ENDIF | |
121 | * | |
122 | IF (ICOD .EQ. 6) THEN | |
123 | NTOT=NTOT+1 | |
124 | GO TO 90 | |
125 | ENDIF | |
126 | * | |
127 | ILASTW=JBYT(IWORD,17,7) | |
128 | NTOT=NTOT+ILASTW | |
129 | GO TO 90 | |
130 | ENDIF | |
131 | * | |
132 | 40 CONTINUE | |
133 | * | |
134 | * Case of a normal line | |
135 | * | |
136 | KWORD(1:1)=CHAR(KCODE) | |
137 | ILASTW=ICODE | |
138 | IF(ILASTW.LT.2) THEN | |
139 | NTOT=NTOT+NWI | |
140 | GO TO 90 | |
141 | ENDIF | |
142 | IFWORD=JBYT(IWORD,17,7) | |
143 | * | |
144 | IF (ILASTW.GT.20 .OR. IFWORD.GT.ILASTW)GO TO 100 | |
145 | * | |
146 | NTOT=NTOT+NWI+ILASTW-IFWORD+1 | |
147 | * | |
148 | 90 CONTINUE | |
149 | CALL UCTOH(KWORD,IDATA(NTOLD+1),4,4) | |
150 | RETURN | |
151 | * | |
152 | 100 NTOT=1000000 | |
153 | 999 END |