This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / jz91 / jzsetf.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.2  1996/04/18 16:11:08  mclareni
6 * Incorporate changes from J.Zoll for version 3.77
7 *
8 * Revision 1.1.1.1  1996/03/06 10:47:17  mclareni
9 * Zebra
10 *
11 *
12 #include "zebra/pilot.h"
13       SUBROUTINE JZSETF (CHPA1,IPA2,IPA3)
14
15 C-    Set flag word JFL for processor IAM
16
17 #include "zebra/mqsysh.inc"
18 #include "zebra/jzuc.inc"
19 #include "zebra/jzc.inc"
20 C--------------    END CDE                             -----------------  ------
21       DIMENSION    IPA2(7),IPA3(7)
22       CHARACTER    CHPA1*4
23 #if defined(CERNLIB_A4)
24       CHARACTER    CHIAM*4
25 #endif
26 #if defined(CERNLIB_A8)
27       CHARACTER    CHIAM*8
28 #endif
29 #if defined(CERNLIB_EQUHOLCH)
30       EQUIVALENCE (CHIAM, IAMID)
31 #endif
32 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
33       DIMENSION    NAMESR(2)
34       DATA  NAMESR / 4HJZSE, 4HTF   /
35 #endif
36 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
37       DATA  NAMESR / 6HJZSETF /
38 #endif
39 #if !defined(CERNLIB_QTRHOLL)
40       CHARACTER    NAMESR*8
41       PARAMETER   (NAMESR = 'JZSETF  ')
42 #endif
43
44
45 #include "zebra/qtraceq.inc"
46
47 #if defined(CERNLIB_QDEBUG)
48 #include "zebra/qstorjz.inc"
49       CHIAM = CHPA1
50 #endif
51 #if (defined(CERNLIB_QDEBUG))&&(!defined(CERNLIB_EQUHOLCH))
52       CALL UCTOH (CHIAM, IAMID,4,4)
53 #endif
54 #if defined(CERNLIB_QDEBUG)
55       JFL   = IPA2(1)
56       IVAL  = IPA3(1)
57
58 C----              Find SV bank
59
60    21 L = LQ(KQS+LQJZ-4)
61       IF (L.EQ.0)                  GO TO 24
62       J = IUCOMP (IAMID,IQ(KQS+L+2),IQ(KQS+L+1))
63       IF (J.EQ.0)                  GO TO 24
64       LSV = LQ(KQS+L-J)
65       GO TO 25
66
67    24 LSV   = LZFIND (IXSTJZ,LQ(KQS+LQJZ-3), IAMID,1)
68       IF (LSV.EQ.0)                GO TO 41
69    25 LFL = LSV + JQNACC
70       LFL = LFL + IQ(KQS+LFL) + 1
71       LFL = LFL + IQ(KQS+LFL) + 1 + IQ(KQS+LSV+4)
72       NFL = IQ(KQS+LFL)
73
74 C----              Set flag value
75
76    31 IF (JFL.GT.NFL)              GO TO 81
77       IF (JFL.LE.0)                GO TO 91
78       IQUEST(3) = IQ(KQS+LFL+JFL)
79       IQ(KQS+LFL+JFL) = IVAL
80       GO TO 82
81
82 C----              Find flag bank if processor not yet init.
83
84    41 LFL = LZFIND (IXSTJZ,LQ(KQS+LQJZ-2), IAMID,1)
85       IF (LFL.EQ.0)                GO TO 81
86       NFL = IQ(KQS+LFL-1) - 1
87       LFL = LFL + 1
88       GO TO 31
89
90 #endif
91 C----              Flag not available
92
93    81 LFL = 0
94    82 IQUEST(1) = LFL
95       IQUEST(2) = NFL
96 #include "zebra/qtrace99.inc"
97       RETURN
98
99 C----              Negative flag number
100
101    91 NQCASE = 1
102       NQFATA = 3
103       IQUEST(11) = NQME(1)
104       IQUEST(12) = IAMID
105       IQUEST(13) = JFL
106 #include "zebra/qtofatal.inc"
107       END
108 *      ==================================================
109 #include "zebra/qcardl.inc"