MINICERN/packlib/zebra/qutil/qutyvax/zsorvh.F

   1       SUBROUTINE ZSORVH (IXSTOR,LGOP,JWORD,NWORDS)
   2
   3 C-    SORT BANKS AT LGO SUCH THAT THE 'NWORDS' LONG KEY STRINGS
   4 C-    STARTING AT Q(L+JWORD) ARE IN INCREASING ORDER
   5
   6 #include "zebra/mqsys.inc"
   7 C--------------    END CDE                             --------------
   8       DIMENSION    JWORD(9), NWORDS(9), LGOP(9)
   9 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  10       DIMENSION    NAMESR(2)
  11       DATA  NAMESR / 4HZSOR, 4HVH   /
  12 #endif
  13 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  14       DATA  NAMESR / 6HZSORVH /
  15 #endif
  16 #if !defined(CERNLIB_QTRHOLL)
  17       CHARACTER    NAMESR*8
  18       PARAMETER   (NAMESR = 'ZSORVH  ')
  19 #endif
  20
  21 #include "zebra/q_jbyt.inc"
  22
  23
  24       LGO = LGOP(1)
  25       IF (LGO.EQ.0)          RETURN
  26
  27 #include "zebra/qtraceq.inc"
  28 #include "zebra/qstore.inc"
  29
  30       JW  = JWORD(1)
  31       NCH = 4*NWORDS(1)
  32       KGO = LQSTA(KQT+2) - 1
  33       LQ(KQS+KGO) = LGO
  34       LL  = LGO
  35       IFL = 0
  36
  37    11 LN = LQ(KQS+LL)
  38       IF (LN.EQ.0)                 GO TO 81
  39       IF (IUCOMH(IQ(KQS+LN+JW),IQ(KQS+LL+JW),NCH).LT.0)   GO TO 21
  40       LL = LN
  41       GO TO 11
  42
  43 C--                BANK  LN  OUT OF SEQUENCE
  44
  45    21 LQ(KQS+LL)   = LQ(KQS+LN)
  46       IFL = 7
  47       K   = KGO
  48
  49    24 L = LQ(KQS+K)
  50       IF (IUCOMH(IQ(KQS+LN+JW),IQ(KQS+L+JW),NCH).LT.0)   GO TO 29
  51       K = L
  52       GO TO 24
  53
  54 C--                PLACE FOR BANK  LN  FOUND
  55
  56    29 LQ(KQS+LN)  = L
  57       LQ(KQS+K)   = LN
  58       GO TO 11
  59
  60 C----              FINISHED, CHAIN K-LINKS
  61
  62    81 IF (IFL.EQ.0)                GO TO 999
  63       K = LQ(KQS+LGO+2)
  64       L = LQ(KQS+KGO)
  65       LQ(KQS+L+2) = K
  66       IF (K.NE.0)  LQ(KQS+K)=L
  67       LGOP(1) = L
  68
  69    84 K = L
  70       L = LQ(KQS+K)
  71       IF (L.EQ.0)                  GO TO 999
  72       LQ(KQS+L+2) = K
  73       K = L
  74       GO TO 84
  75
  76 #include "zebra/qtrace99.inc"
  77       RETURN
  78       END