MINICERN/packlib/zebra/dzebra/dzzero.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:07  mclareni
   6 * Zebra
   7 *
   8 *
   9 *-----------------------------------------------------------
  10 #include "zebra/pilot.h"
  11 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  12 #include "zebra/debugvf1.inc"
  13 #endif
  14       SUBROUTINE DZZERO (IXSTOR,LBANK)
  15 #include "zebra/mqsys.inc"
  16 #include "zebra/mzcn.inc"
  17 #include "zebra/mzioc.inc"
  18
  19       CHARACTER        CLZERO*4
  20       DOUBLE PRECISION DLZERO
  21       INTEGER          HLZERO , ILZERO
  22       REAL             RLZERO
  23       SAVE CLZERO,DLZERO,HLZERO,ILZERO,RLZERO,IFIRST
  24       DATA CLZERO,DLZERO,ILZERO,RLZERO /'    ',0.0D0,0,0.0/ ,IFIRST /1/
  25
  26 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  27 #include "zebra/debugvf2.inc"
  28 #endif
  29
  30
  31
  32
  33       IF (IFIRST.EQ.1) THEN
  34           IFIRST=0
  35           CALL UCTOH(CLZERO,HLZERO,4,4)
  36       ENDIF
  37
  38
  39       CALL MZSDIV(IXSTOR,-1)
  40       CALL MZCHLS(-7,LBANK)
  41       CALL MZIOCR(LQ(KQS+IQLN))
  42       IF(IQFOUL.NE.0)                                      GO TO 999
  43
  44       JDATA  = 0
  45       JFOCUR = 0
  46
  47
  48    10 ITYPE  = MFO(JFOCUR+1)
  49       IF (ITYPE.EQ.7)                                      GO TO 40
  50       NWSEC = MFO(JFOCUR+2)
  51       IF   (NWSEC)           20, 30, 60
  52
  53
  54    20 NWSEC = IQND - JDATA
  55                                                            GO TO 60
  56
  57
  58    30 JDATA = JDATA + 1
  59       IWORD = IQ(KQS+LBANK+JDATA)
  60       NWSEC = IWORD
  61                                                            GO TO 50
  62
  63
  64    40 JDATA = JDATA + 1
  65       IWORD = IQ(KQS+LBANK+JDATA)
  66       ITYPE = MOD (IWORD,16)
  67       NWSEC = IWORD/16
  68
  69    50 IF (ITYPE.GT.5.OR.ITYPE.LT.0) THEN
  70           ITYPE      = 0
  71           NWSEC      = IQND - JDATA
  72       ELSEIF (NWSEC.LE.0) THEN
  73           NWSEC      = IQND - JDATA
  74       ENDIF
  75
  76
  77    60 IDBLE  = 0
  78       DO 100 I=JDATA+1,JDATA+NWSEC
  79           IF (IDBLE.EQ.1)           THEN
  80               IDBLE  = 0
  81           ELSEIF (ITYPE.EQ.3)  THEN
  82                Q(KQS+LBANK+I) = RLZERO
  83           ELSEIF (ITYPE.EQ.4)  THEN
  84               CALL UCOPY(DLZERO,Q(KQS+LBANK+I),2)
  85               IDBLE  = 1
  86           ELSEIF (ITYPE.EQ.5)  THEN
  87               IQ(KQS+LBANK+I) = HLZERO
  88           ELSE
  89               IQ(KQS+LBANK+I) = ILZERO
  90           ENDIF
  91
  92   100 CONTINUE
  93
  94
  95       JDATA = JDATA + NWSEC
  96
  97       IF (JDATA.GE.IQND)                                   GO TO 999
  98
  99       IF (JDATA.LT.IQND)   THEN
 100           JFOCUR = JFOCUR + 2
 101           IF (JFOCUR.LT.JFOEND)                            GO TO 10
 102           JFOCUR = JFOREP
 103                                                            GO TO 10
 104       ENDIF
 105
 106
 107   999 RETURN
 108       END