5 * Revision 1.2 1996/04/18 16:13:43 mclareni
6 * Incorporate changes from J.Zoll for version 3.77
8 * Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
12 #include "zebra/pilot.h"
13 SUBROUTINE ZSHUNT (IXSTOR,LSHP,LSUPP,JBIASP,IFLAGP)
15 C- RE-CONNECT BANK OR LINEAR D/S, USER CALLED
17 #include "zebra/zunit.inc"
18 #include "zebra/mqsys.inc"
19 #include "zebra/mzcn.inc"
20 C-------------- END CDE --------------
21 DIMENSION LSHP(9),LSUPP(9),JBIASP(9),IFLAGP(9)
22 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
24 DATA NAMESR / 4HZSHU, 4HNT /
26 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
27 DATA NAMESR / 6HZSHUNT /
29 #if !defined(CERNLIB_QTRHOLL)
31 PARAMETER (NAMESR = 'ZSHUNT ')
34 #include "zebra/q_jbyt.inc"
35 #include "zebra/q_locf.inc"
37 #include "zebra/qtraceq.inc"
40 IF (LSH.EQ.0) GO TO 999
45 #include "zebra/qstore.inc"
47 #if defined(CERNLIB_QDEBUG)
49 IF (IQFOUL.NE.0) GO TO 91
51 #if defined(CERNLIB_QDEBPRI)
53 IF (JBIAS.GE.2) LSUP=0
54 WRITE (IQLOG,9011) JQSTOR,LSH,LSUP,JBIAS,IFLAG,IQID
56 9011 FORMAT (' ZSHUNT- Store',I3,' LSH/LSUP/JBIAS/IFLAG='
57 F,2I9,1X,I6,1X,I3,' IDH= ',A4)
60 C---- LINKS AT EXIT POINT
65 C---- LINKS AT INSERTION POINT
68 IF (JBIAS-1) 21, 25, 28
70 #if defined(CERNLIB_QDEBUG)
72 IF (IQFOUL.NE.0) GO TO 92
73 IF (IQNS+JBIAS.LT.0) GO TO 93
78 IF (JBIAS.NE.0) GO TO 29
84 IF (LNIN.EQ.0) GO TO 26
85 #if defined(CERNLIB_QDEBUG)
87 IF (IQFOUL.NE.0) GO TO 92
93 26 KIN = LOCF(LSUPP(1)) - LQSTOR
100 IF (KEX.EQ.0) GO TO 51
102 C-- CHECK INSERT POINT = EXIT POINT
104 29 IF (KIN.EQ.KEX) GO TO 999
106 C-- CHECK LINEAR STRUCTURE CONTAINED
108 #if defined(CERNLIB_QDEBUG)
112 IF (L.GE.LQEND(KQT+20)) GO TO 94
113 IF (L.GE.LQEND(KQT+JQDVLL)) GO TO 43
115 IF (L.GE.LQEND(KQT+2)) GO TO 44
116 IF (L.GE.LQSTA(KQT+2)) GO TO 45
120 43 JQDIVI = JQDVSY - 1
121 44 JQDIVI = JQDIVI + 1
122 IF (L.GE.LQEND(KQT+JQDIVI)) GO TO 44
124 45 IF (LSH.LT.LQSTA(KQT+JQDIVI)) GO TO 94
125 IF (LSH.GE.LQEND(KQT+JQDIVI)) GO TO 94
128 C---- SHUNT LINEAR STRUCTURE
130 51 IF (LNEX.EQ.0) GO TO 58
131 IF (IFLAG.EQ.0) GO TO 57
132 #if defined(CERNLIB_QDEBUG)
134 53 CALL MZCHLS (-7,LNEX)
135 IF (IQFOUL.NE.0) GO TO 95
138 IF (LNEX.NE.0) GO TO 53
144 IF (LNEX.NE.0) GO TO 55
147 C---- SHUNT SINGLE BANK
150 #if defined(CERNLIB_QDEBUG)
152 CALL MZCHLS (-7,LNEX)
153 IF (IQFOUL.NE.0) GO TO 95
160 C-- BRIDGE OLD POSITION
162 71 IF (KEX .NE.0) LQ(KQS+KEX) = LNEX
163 IF (LNEX.NE.0) LQ(KQS+LNEX+2) = KEX
177 IF (LNIN.NE.0) LQ(KQS+LNIN+2) = LEND
179 #include "zebra/qtrace99.inc"
182 C------ ERROR CONDITIONS
184 #if defined(CERNLIB_QDEBUG)
188 94 NQCASE = NQCASE + 1
191 93 NQCASE = NQCASE + 1
192 92 NQCASE = NQCASE + 1
194 91 NQCASE = NQCASE + 1
200 #include "zebra/qtofatal.inc"
202 * ==================================================
203 #include "zebra/qcardl.inc"