[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / jz91 / jzlift.F

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

C-    Initialize processor SV bank for support variables

C-    Parameters in /JZC/ :
C-    IAM(1)  IAMID  = processor ID in A4
C-        2   IAFLDW = down-call flag
C-             0  no further down transfer
C-             1  with down transfer, level JQMLEV must not be reached
C-        3   IANAN  = number of processor constants
C-        4   IANCR  = number of conditions to be recorded
C-        5   IANLSV = number of wsp links to be saved
C-        6   IANDSV = number of wsp data words to be saved

#include "zebra/zstate.inc"
#include "zebra/zunit.inc"
#include "zebra/mqsysh.inc"
#include "zebra/jzuc.inc"
#include "zebra/jzc.inc"
C--------------    END CDE                             -----------------  ------
      DIMENSION    IDPR(7)
      EQUIVALENCE (IDPR(1),IAMID)

      DIMENSION    MMSV(5)
#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      DIMENSION    NAMESR(2)
      DATA  NAMESR / 4HJZLI, 4HFT   /
#endif
#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      DATA  NAMESR / 6HJZLIFT /
#endif
#if !defined(CERNLIB_QTRHOLL)
      CHARACTER    NAMESR*8
      PARAMETER   (NAMESR = 'JZLIFT  ')
#endif
      DATA  MMSV   / 4HJZSV, -7, 0, -7, 0 /

#include "zebra/q_jbit.inc"

#include "zebra/qtraceq.inc"

C----              Create SV bank

      IANCR   = MAX (IANCR,1)
      MMSV(4) = JQNACC + IANCR + IANAN + IANDSV + 2
      IANFL   = 0
#if defined(CERNLIB_QDEBUG)
      LTFL   = LZFIND (IXSTJZ,LQ(KQS+LQJZ-2), IAMID,1)
      IF (LTFL.NE.0)  IANFL = IQ(KQS+LTFL-1) - 1
      MMSV(4) = MMSV(4) + IANFL
#endif
      MMSV(2) = IANLSV + 3
      CALL MZLIFT (IXDVJZ,LSV,LQJZ,-3,MMSV,0)
      LCR = LSV + JQNACC
      LAN = LCR + IANCR + 1
#if defined(CERNLIB_QDEBUG)
      LFL = LAN + IANAN + 1 + IANDSV
#endif
      CALL SBYT (JQLEV+1, IQ(KQS+LSV),1,8)
      IQ(KQS+LSV+1) = IAMID
      IQ(KQS+LSV+3) = IANLSV
      IQ(KQS+LSV+4) = IANDSV

      IQ(KQS+LCR) = IANCR
      IQ(KQS+LAN) = IANAN
      NANTL    = IANAN

C----              Find and copy JQAN title, if any

      LTAN = LZFIND (IXSTJZ,LQ(KQS+LQJZ-1), IAMID,1)
      IF (LTAN.NE.0)  THEN
          NANTL = IQ(KQS+LTAN-1) - 1
          N     = MIN (NANTL,IANAN)
          CALL UCOPY (IQ(KQS+LTAN+2),IQ(KQS+LAN+1),N)
          CALL SBIT1 (IQ(KQS+LSV),17)
          CALL MZDROP (IXSTJZ,LTAN, '.')
        ENDIF

C----              Find and copy JQFL flag titles, if any

#if defined(CERNLIB_QDEBUG)
      IF (LTFL.NE.0)  THEN
          LTFL = LZFIND (IXSTJZ,LQ(KQS+LQJZ-2), IAMID,1)
          IF (IANFL.NE.0)
     +      CALL UCOPY (IQ(KQS+LTFL+2),IQ(KQS+LFL+1),IANFL)
          IQ(KQS+LFL) = IANFL
          CALL MZDROP (IXSTJZ,LTFL, '.')
        ENDIF
#endif

C----              Print and check discrepancies

      LEV = JQLLEV
      IF (IANAN.NE.NANTL)  LEV = LEV + 1

      IF (LEV.GE.2)  WRITE (IQLOG,9042) IDPR
 9042 FORMAT (/' JZLIFT.  Init of "',A4,
     F ' with  IFDW,NAN,NCD,NLSV,NDSV,NFL =',6I4)

      IF (IANAN.EQ.NANTL)          GO TO 47

      IF (LEV.GE.2)  WRITE (IQLOG,9043) NANTL
 9043 FORMAT (10X,'!!! NAN from title =',I8,' !!!')

C----              Exit

   47 IQUEST(1) = -7
      IQUEST(2) = LSV
      IF (JBIT(IQ(KQS+LSV),17).EQ.0)  GO TO 999
      IF (JQLLEV.GE.2)  WRITE (IQLOG,9048)
 9048 FORMAT (10X,'with title.')
      IQUEST(1) = 0
#include "zebra/qtrace99.inc"
      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 JZLIFT
	11
	12	C- Initialize processor SV bank for support variables
	13
	14	C- Parameters in /JZC/ :
	15	C- IAM(1) IAMID = processor ID in A4
	16	C- 2 IAFLDW = down-call flag
	17	C- 0 no further down transfer
	18	C- 1 with down transfer, level JQMLEV must not be reached
	19	C- 3 IANAN = number of processor constants
	20	C- 4 IANCR = number of conditions to be recorded
	21	C- 5 IANLSV = number of wsp links to be saved
	22	C- 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"
	29	C-------------- 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
	51	C---- 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
77	C---- 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
88	C---- 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
100	C---- 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
114	C---- 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"