MINICERN/packlib/zebra/mqs/mzixco.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:13:07  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:22  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       FUNCTION MZIXCO (IXAA,IXBB,IXCC,IXDD)
  14
  15 C-    join IXAA, IXBB, ... into composite division index
  16 C-    ignore zero,  user called
  17
  18 #include "zebra/mqsys.inc"
  19 C--------------    END CDE                             --------------
  20       DIMENSION    IXAA(9), IXBB(9), IXCC(9), IXDD(9), IXV(4)
  21       EQUIVALENCE (IXV(1),IQUEST(11))
  22 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  23       DIMENSION    NAMESR(2)
  24       DATA  NAMESR / 4HMZIX, 4HCO   /
  25 #endif
  26 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  27       DATA  NAMESR / 6HMZIXCO /
  28 #endif
  29 #if !defined(CERNLIB_QTRHOLL)
  30       CHARACTER    NAMESR*8
  31       PARAMETER   (NAMESR = 'MZIXCO  ')
  32 #endif
  33
  34 #include "zebra/q_jbyt.inc"
  35 #include "zebra/q_sbit1.inc"
  36 #include "zebra/q_sbyt.inc"
  37 #include "zebra/q_mbytor.inc"
  38
  39
  40       IXV(1) = IXAA(1)
  41       IXV(2) = IXBB(1)
  42       IXV(3) = IXCC(1)
  43       IXV(4) = IXDD(1)
  44       IXCOMP = 0
  45
  46       DO  49  JL=1,4
  47       IXIN = IXV(JL)
  48       IF (IXIN.EQ.0)               GO TO 49
  49       JDV = JBYT (IXIN,1,26)
  50       JST = JBYT (IXIN,27,6)
  51       IF (JST.LT.16)               GO TO 31
  52
  53 C--                COMPOSITE INDEX
  54
  55       JST = JST - 16
  56       IF (JST.GT.NQSTOR)           GO TO 91
  57       IF (JDV.GE.16777216)         GO TO 92
  58       IF (JL.NE.1)                 GO TO 24
  59       IXCOMP = IXIN
  60       JSTORU = JST
  61       GO TO 49
  62
  63    24 IF (JST.NE.JSTORU)           GO TO 93
  64       IXCOMP = MBYTOR (JDV,IXCOMP,1,26)
  65       GO TO 49
  66
  67 C--                SINGLE DIVISION INDEX
  68
  69    31 IF (JST.GT.NQSTOR)           GO TO 91
  70       IF (JDV.GE.25)               GO TO 92
  71       IF (JDV.EQ.0)                GO TO 92
  72       IF (JL.NE.1)                 GO TO 34
  73       IXCOMP = MSBYT (JST+16,IXCOMP,27,5)
  74       JSTORU = JST
  75       GO TO 47
  76
  77    34 IF (JST.EQ.JSTORU)           GO TO 47
  78       IF (JST.NE.0)                GO TO 93
  79       IF (JDV.LT.3)                GO TO 47
  80       IF (JDV.LT.21)               GO TO 93
  81
  82    47 IXCOMP = MSBIT1 (IXCOMP,JDV)
  83    49 CONTINUE
  84
  85    59 MZIXCO = IXCOMP
  86       RETURN
  87
  88 C------            ERROR CONDITIONS
  89
  90    93 NQCASE = 1
  91    92 NQCASE = NQCASE + 1
  92    91 NQCASE = NQCASE + 1
  93       NQFATA = 7
  94       IQUEST(15) = JL
  95       IQUEST(16) = JST
  96       IQUEST(17) = JDV
  97 #include "zebra/qtrace.inc"
  98 #include "zebra/qtofatal.inc"
  99       MZIXCO = 0
 100       END
 101 *      ==================================================
 102 #include "zebra/qcardl.inc"