[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / mq / mzinco.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/03/06 10:47:17  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE MZINCO (LIST)

C-    Initialise all passive COMMONs, normally called from MZEBRA
C-        but it may be user called for non-ZEBRA applications

#include "zebra/zbcd.inc"
#include "zebra/zbcdch.inc"
#include "zebra/zceta.inc"
#include "zebra/zheadp.inc"
#include "zebra/zmach.inc"
#include "zebra/znatur.inc"
#include "zebra/zstate.inc"
#include "zebra/zunit.inc"
#include "zebra/zvfaut.inc"
#include "zebra/quest.inc"
C--------------    End CDE                             --------------
      DIMENSION    LIST(9)

#include "zebra/q_jbit.inc"


C--                Clear /ZSTATE/

      CALL VZERO (IQUEST,100)
      CALL VZERO (IQVID,18)
      CALL VZERO (NQPHAS,15)
#include "zebra/qversion.inc"

C----              Ready /ZMACH/

      NQBITW = IQBITW
      NQBITC = IQBITC
      NQCHAW = IQCHAW
      NQLNOR = 58
      NQLMAX = 58
      NQLPTH =  0
      NQRMAX = 132
      IQLPCT = IQBLAN
      IQNIL  = 16744448
#if defined(CERNLIB_CRAY)
      IQNIL  = 0777770516040020000000B
#elif defined(CERNLIB_CDC)
      IQNIL  = O"17770516040000200000"
#endif


C----              Ready /ZBCD/ and /ZBCDCH/

      CQALLC = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-*/()$= ,.'
      CQALLC(65:90) = 'abcdefghijklmnopqrstuvwxyz'
      CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
      CQALLC(91:96) = '{|}~`?'
#if defined(CERNLIB_CDC)
      CQALLC(91:96) = '??????'
#endif
#if defined(CERNLIB_QEBCDIC)
      CQALLC(61:61) = CHAR(224)
#endif
#if !defined(CERNLIB_QEBCDIC)
      CQALLC(61:61) = CHAR(92)
#endif
      CALL UCTOH1 (CQALLC, IQLETT, 96)
      CALL UCTOH1 (' 1234567890', IQNUM2, 11)

      CALL IZHNUM (IQLETT,NQHOLL,95)
      NQHOL0 = NQHOLL(45)

C----              READY  /ZCETA/
C--   Table entry IQCETA(JH+1) contains the CETA value for
C-    the character of internal representation JH

      CALL VFILL (IQCETA,NQTCET,96)

      DO 24  JC=95,1,-1
      JH = NQHOLL(JC)
   24 IQCETA(JH+1) = JC

#if (defined(CERNLIB_QEBCDIC))&&(!defined(CERNLIB_CERNWYL))
      IQCETA(1+ 64) = 45
      IQCETA(1+189) = 54
      IQCETA(1+173) = 58
      IQCETA(1+224) = 61
      IQCETA(1+139) = 91
      IQCETA(1+192) = 91
      IQCETA(1+155) = 93
      IQCETA(1+208) = 93
#endif
#if (defined(CERNLIB_QEBCDIC))&&(defined(CERNLIB_CERNWYL))
      IQCETA(1+ 64) = 45
      IQCETA(1+189) = 54
      IQCETA(1+173) = 58
      IQCETA(1+224) = 61
      IQCETA(1+139) = 91
      IQCETA(1+192) = 91
      IQCETA(1+155) = 93
      IQCETA(1+208) = 93
      IQCETA(1+ 95) = 94
      IQCETA(1+161) = 94
#endif
#if defined(CERNLIB_QCDCODE)
      IQCETA(1) = 51
#endif
C--   Table IQTCET(JH+1) is like IQCETA but for 6-bit packing

      DO 26  JL=1,NQTCET
      J = IQCETA(JL)
      IF (J.GE.64)  THEN
        IF (J.GE.94)  THEN
          J = 57
        ELSEIF (J.EQ.93)  THEN
          J = 42
        ELSEIF (J.EQ.92)  THEN
          J = 40
        ELSEIF (J.EQ.91)  THEN
          J = 41
        ELSEIF (J.EQ.64)  THEN
          J = 51
        ELSE
C--       lower case mapped to upper case
          J = J - 64
        ENDIF
       ENDIF
   26 IQTCET(JL) = J

C----              Ready /ZNATUR/

      QPI    = 4.*ATAN(1.)
      QPI2   = 2.*QPI
      QPIBY2 = QPI/2.
      QPBYHR = .0002998

C----              Ready COMMON  /ZUNIT/

#include "mzeunit.inc"
      IQLOG  = IQPRNT
#include "mzeunit2.inc"
      ITYPE = IQTYPE
      IF (ITYPE.EQ.0)   ITYPE = IQLOG
      NLIST  = LIST(1)
      IF    (NLIST)          32, 38, 33
   32 NLIST = -NLIST
      IF (JBIT(NLIST,2).NE.0)  NQLOGD = -2
      IF (JBIT(NLIST,1).NE.0)  IQLOG = ITYPE
      IQPRNT = IQLOG
      GO TO 38

   33 NQLOGD = LIST(2)

      IF (NLIST.EQ.1)              GO TO 38
      IF     (LIST(3).NE.0)   THEN
          IF (LIST(3).LT.0)       THEN
              IQLOG = ITYPE
            ELSE
              IQLOG = LIST(3)
            ENDIF
        ENDIF
      IQPRNT = IQLOG

      IF (NLIST.EQ.2)              GO TO 38
      IF     (LIST(4).NE.0)   THEN
          IF (LIST(4).LT.0)        THEN
              IQPRNT = ITYPE
            ELSE
              IQPRNT = LIST(4)
            ENDIF
        ENDIF

   38 IQPR2  = IQPRNT
      NQLOGM = NQLOGD


      IQDLUN = IQPRNT
      IQFLUN = IQPRNT
      IQHLUN = IQPRNT
      NQUSED = 0

C----              Ready COMMON  /ZHEADP/

      CALL VBLANK (IQHEAD,20)
      CALL VZERO  (IQDATE,7)
      CALL DATIME (IQDATE,IQTIME)

#if defined(CERNLIB_CDC)
      CALL XSETIO
#endif

      RETURN
      END
*      ==================================================
#include "zebra/qcardl.inc"
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
	6	* Zebra
	7	*
	8	*
	9	#include "zebra/pilot.h"
	10	SUBROUTINE MZINCO (LIST)
	11
	12	C- Initialise all passive COMMONs, normally called from MZEBRA
	13	C- but it may be user called for non-ZEBRA applications
	14
	15	#include "zebra/zbcd.inc"
	16	#include "zebra/zbcdch.inc"
	17	#include "zebra/zceta.inc"
	18	#include "zebra/zheadp.inc"
	19	#include "zebra/zmach.inc"
	20	#include "zebra/znatur.inc"
	21	#include "zebra/zstate.inc"
	22	#include "zebra/zunit.inc"
	23	#include "zebra/zvfaut.inc"
	24	#include "zebra/quest.inc"
	25	C-------------- End CDE --------------
	26	DIMENSION LIST(9)
	27
	28	#include "zebra/q_jbit.inc"
	29
	30
	31	C-- Clear /ZSTATE/
	32
	33	CALL VZERO (IQUEST,100)
	34	CALL VZERO (IQVID,18)
	35	CALL VZERO (NQPHAS,15)
	36	#include "zebra/qversion.inc"
	37
	38	C---- Ready /ZMACH/
	39
	40	NQBITW = IQBITW
	41	NQBITC = IQBITC
	42	NQCHAW = IQCHAW
	43	NQLNOR = 58
	44	NQLMAX = 58
	45	NQLPTH = 0
	46	NQRMAX = 132
	47	IQLPCT = IQBLAN
	48	IQNIL = 16744448
	49	#if defined(CERNLIB_CRAY)
	50	IQNIL = 0777770516040020000000B
	51	#elif defined(CERNLIB_CDC)
	52	IQNIL = O"17770516040000200000"
	53	#endif
	54
	55
	56	C---- Ready /ZBCD/ and /ZBCDCH/
	57
	58	CQALLC = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-*/()$= ,.'
	59	CQALLC(65:90) = 'abcdefghijklmnopqrstuvwxyz'
	60	CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
	61	CQALLC(91:96) = '{\|}~`?'
	62	#if defined(CERNLIB_CDC)
	63	CQALLC(91:96) = '??????'
	64	#endif
65	#if defined(CERNLIB_QEBCDIC)
66	CQALLC(61:61) = CHAR(224)
67	#endif
68	#if !defined(CERNLIB_QEBCDIC)
69	CQALLC(61:61) = CHAR(92)
70	#endif
71	CALL UCTOH1 (CQALLC, IQLETT, 96)
72	CALL UCTOH1 (' 1234567890', IQNUM2, 11)
73
74	CALL IZHNUM (IQLETT,NQHOLL,95)
75	NQHOL0 = NQHOLL(45)
76
77	C---- READY /ZCETA/
78	C-- Table entry IQCETA(JH+1) contains the CETA value for
79	C- the character of internal representation JH
80
81	CALL VFILL (IQCETA,NQTCET,96)
82
83	DO 24 JC=95,1,-1
84	JH = NQHOLL(JC)
85	24 IQCETA(JH+1) = JC
86
87	#if (defined(CERNLIB_QEBCDIC))&&(!defined(CERNLIB_CERNWYL))
88	IQCETA(1+ 64) = 45
89	IQCETA(1+189) = 54
90	IQCETA(1+173) = 58
91	IQCETA(1+224) = 61
92	IQCETA(1+139) = 91
93	IQCETA(1+192) = 91
94	IQCETA(1+155) = 93
95	IQCETA(1+208) = 93
96	#endif
97	#if (defined(CERNLIB_QEBCDIC))&&(defined(CERNLIB_CERNWYL))
98	IQCETA(1+ 64) = 45
99	IQCETA(1+189) = 54
100	IQCETA(1+173) = 58
101	IQCETA(1+224) = 61
102	IQCETA(1+139) = 91
103	IQCETA(1+192) = 91
104	IQCETA(1+155) = 93
105	IQCETA(1+208) = 93
106	IQCETA(1+ 95) = 94
107	IQCETA(1+161) = 94
108	#endif
109	#if defined(CERNLIB_QCDCODE)
110	IQCETA(1) = 51
111	#endif
112	C-- Table IQTCET(JH+1) is like IQCETA but for 6-bit packing
113
114	DO 26 JL=1,NQTCET
115	J = IQCETA(JL)
116	IF (J.GE.64) THEN
117	IF (J.GE.94) THEN
118	J = 57
119	ELSEIF (J.EQ.93) THEN
120	J = 42
121	ELSEIF (J.EQ.92) THEN
122	J = 40
123	ELSEIF (J.EQ.91) THEN
124	J = 41
125	ELSEIF (J.EQ.64) THEN
126	J = 51
127	ELSE
128	C-- lower case mapped to upper case
129	J = J - 64
130	ENDIF
131	ENDIF
132	26 IQTCET(JL) = J
133
134	C---- Ready /ZNATUR/
135
136	QPI = 4.*ATAN(1.)
137	QPI2 = 2.*QPI
138	QPIBY2 = QPI/2.
139	QPBYHR = .0002998
140
141	C---- Ready COMMON /ZUNIT/
142
143	#include "mzeunit.inc"
144	IQLOG = IQPRNT
145	#include "mzeunit2.inc"
146	ITYPE = IQTYPE
147	IF (ITYPE.EQ.0) ITYPE = IQLOG
148	NLIST = LIST(1)
149	IF (NLIST) 32, 38, 33
150	32 NLIST = -NLIST
151	IF (JBIT(NLIST,2).NE.0) NQLOGD = -2
152	IF (JBIT(NLIST,1).NE.0) IQLOG = ITYPE
153	IQPRNT = IQLOG
154	GO TO 38
155
156	33 NQLOGD = LIST(2)
157
158	IF (NLIST.EQ.1) GO TO 38
159	IF (LIST(3).NE.0) THEN
160	IF (LIST(3).LT.0) THEN
161	IQLOG = ITYPE
162	ELSE
163	IQLOG = LIST(3)
164	ENDIF
165	ENDIF
166	IQPRNT = IQLOG
167
168	IF (NLIST.EQ.2) GO TO 38
169	IF (LIST(4).NE.0) THEN
170	IF (LIST(4).LT.0) THEN
171	IQPRNT = ITYPE
172	ELSE
173	IQPRNT = LIST(4)
174	ENDIF
175	ENDIF
176
177	38 IQPR2 = IQPRNT
178	NQLOGM = NQLOGD
179
180
181	IQDLUN = IQPRNT
182	IQFLUN = IQPRNT
183	IQHLUN = IQPRNT
184	NQUSED = 0
185
186	C---- Ready COMMON /ZHEADP/
187
188	CALL VBLANK (IQHEAD,20)
189	CALL VZERO (IQDATE,7)
190	CALL DATIME (IQDATE,IQTIME)
191
192	#if defined(CERNLIB_CDC)
193	CALL XSETIO
194	#endif
195
196	RETURN
197	END
198	* ==================================================
199	#include "zebra/qcardl.inc"