Mostly minor style modifications to be ready for cloning with EMCAL
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / jz91 / jzsetf.F
CommitLineData
fe4da5cc 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
15C- Set flag word JFL for processor IAM
16
17#include "zebra/mqsysh.inc"
18#include "zebra/jzuc.inc"
19#include "zebra/jzc.inc"
20C-------------- 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
58C---- 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
74C---- 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
82C---- 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
91C---- 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
99C---- 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"