Changes needed by ICC/IFC compiler (Intel)
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / jz91 / jzlift.F
CommitLineData
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 JZLIFT
11
12C- Initialize processor SV bank for support variables
13
14C- Parameters in /JZC/ :
15C- IAM(1) IAMID = processor ID in A4
16C- 2 IAFLDW = down-call flag
17C- 0 no further down transfer
18C- 1 with down transfer, level JQMLEV must not be reached
19C- 3 IANAN = number of processor constants
20C- 4 IANCR = number of conditions to be recorded
21C- 5 IANLSV = number of wsp links to be saved
22C- 6 IANDSV = number of wsp data words to be saved
23
24#include "zebra/zstate.inc"
25#include "zebra/zunit.inc"
26#include "zebra/mqsysh.inc"
27#include "zebra/jzuc.inc"
28#include "zebra/jzc.inc"
29C-------------- END CDE ----------------- ------
30 DIMENSION IDPR(7)
31 EQUIVALENCE (IDPR(1),IAMID)
32
33 DIMENSION MMSV(5)
34#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
35 DIMENSION NAMESR(2)
36 DATA NAMESR / 4HJZLI, 4HFT /
37#endif
38#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
39 DATA NAMESR / 6HJZLIFT /
40#endif
41#if !defined(CERNLIB_QTRHOLL)
42 CHARACTER NAMESR*8
43 PARAMETER (NAMESR = 'JZLIFT ')
44#endif
45 DATA MMSV / 4HJZSV, -7, 0, -7, 0 /
46
47#include "zebra/q_jbit.inc"
48
49#include "zebra/qtraceq.inc"
50
51C---- Create SV bank
52
53 IANCR = MAX (IANCR,1)
54 MMSV(4) = JQNACC + IANCR + IANAN + IANDSV + 2
55 IANFL = 0
56#if defined(CERNLIB_QDEBUG)
57 LTFL = LZFIND (IXSTJZ,LQ(KQS+LQJZ-2), IAMID,1)
58 IF (LTFL.NE.0) IANFL = IQ(KQS+LTFL-1) - 1
59 MMSV(4) = MMSV(4) + IANFL
60#endif
61 MMSV(2) = IANLSV + 3
62 CALL MZLIFT (IXDVJZ,LSV,LQJZ,-3,MMSV,0)
63 LCR = LSV + JQNACC
64 LAN = LCR + IANCR + 1
65#if defined(CERNLIB_QDEBUG)
66 LFL = LAN + IANAN + 1 + IANDSV
67#endif
68 CALL SBYT (JQLEV+1, IQ(KQS+LSV),1,8)
69 IQ(KQS+LSV+1) = IAMID
70 IQ(KQS+LSV+3) = IANLSV
71 IQ(KQS+LSV+4) = IANDSV
72
73 IQ(KQS+LCR) = IANCR
74 IQ(KQS+LAN) = IANAN
75 NANTL = IANAN
76
77C---- Find and copy JQAN title, if any
78
79 LTAN = LZFIND (IXSTJZ,LQ(KQS+LQJZ-1), IAMID,1)
80 IF (LTAN.NE.0) THEN
81 NANTL = IQ(KQS+LTAN-1) - 1
82 N = MIN (NANTL,IANAN)
83 CALL UCOPY (IQ(KQS+LTAN+2),IQ(KQS+LAN+1),N)
84 CALL SBIT1 (IQ(KQS+LSV),17)
85 CALL MZDROP (IXSTJZ,LTAN, '.')
86 ENDIF
87
88C---- Find and copy JQFL flag titles, if any
89
90#if defined(CERNLIB_QDEBUG)
91 IF (LTFL.NE.0) THEN
92 LTFL = LZFIND (IXSTJZ,LQ(KQS+LQJZ-2), IAMID,1)
93 IF (IANFL.NE.0)
94 + CALL UCOPY (IQ(KQS+LTFL+2),IQ(KQS+LFL+1),IANFL)
95 IQ(KQS+LFL) = IANFL
96 CALL MZDROP (IXSTJZ,LTFL, '.')
97 ENDIF
98#endif
99
100C---- Print and check discrepancies
101
102 LEV = JQLLEV
103 IF (IANAN.NE.NANTL) LEV = LEV + 1
104
105 IF (LEV.GE.2) WRITE (IQLOG,9042) IDPR
106 9042 FORMAT (/' JZLIFT. Init of "',A4,
107 F ' with IFDW,NAN,NCD,NLSV,NDSV,NFL =',6I4)
108
109 IF (IANAN.EQ.NANTL) GO TO 47
110
111 IF (LEV.GE.2) WRITE (IQLOG,9043) NANTL
112 9043 FORMAT (10X,'!!! NAN from title =',I8,' !!!')
113
114C---- Exit
115
116 47 IQUEST(1) = -7
117 IQUEST(2) = LSV
118 IF (JBIT(IQ(KQS+LSV),17).EQ.0) GO TO 999
119 IF (JQLLEV.GE.2) WRITE (IQLOG,9048)
120 9048 FORMAT (10X,'with title.')
121 IQUEST(1) = 0
122#include "zebra/qtrace99.inc"
123 RETURN
124 END
125* ==================================================
126#include "zebra/qcardl.inc"