MINICERN/packlib/zebra/qutil/zsorvh.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.3  1998/09/25 09:33:27  mclareni
   6 * Modifications for the Mklinux port flagged by CERNLIB_PPC
   7 *
   8 * Revision 1.2  1996/04/18 16:13:47  mclareni
   9 * Incorporate changes from J.Zoll for version 3.77
  10 *
  11 * Revision 1.1.1.1  1996/03/06 10:47:15  mclareni
  12 * Zebra
  13 *
  14 *
  15 #include "zebra/pilot.h"
  16 #if (defined(CERNLIB_VAX))||((defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)))||(defined(CERNLIB_QMVMI))||(defined(CERNLIB_QMDOS))
  17 #include "qutyvax/zsorvh.F"
  18 #else
  19       SUBROUTINE ZSORVH (IXSTOR,LGOP,JWORD,NWORDS)
  20
  21 C-    SORT BANKS AT LGO SUCH THAT THE 'NWORDS' LONG HOLLERITH STRINGS
  22 C-    STARTING AT Q(L+JWORD) ARE IN INCREASING ORDER
  23
  24 C-    ALPHABETIC SORT DONE WITH INTEGER COMPARISON
  25 C-    THE SIGN-BIT IS CONSIDERED AS AN ORDINARY BIT, FOR CONSISTENCY
  26 C-    ON ANY GIVEN MACHINE THIS MAY NOT BE VERY SATISFACTORY
  27
  28 #include "zebra/mqsys.inc"
  29 C--------------    END CDE                             --------------
  30       DIMENSION    JWORD(9), NWORDS(9), LGOP(9)
  31 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  32       DIMENSION    NAMESR(2)
  33       DATA  NAMESR / 4HZSOR, 4HVH   /
  34 #endif
  35 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  36       DATA  NAMESR / 6HZSORVH /
  37 #endif
  38 #if !defined(CERNLIB_QTRHOLL)
  39       CHARACTER    NAMESR*8
  40       PARAMETER   (NAMESR = 'ZSORVH  ')
  41 #endif
  42
  43 #include "zebra/q_jbyt.inc"
  44
  45       LGO = LGOP(1)
  46       IF (LGO.EQ.0)          RETURN
  47
  48 #include "zebra/qtraceq.inc"
  49 #include "zebra/qstore.inc"
  50
  51       JW    = JWORD(1)
  52       JWN   = JW-1 + NWORDS(1)
  53       IF (JWN.LE.JW)               GO TO 88
  54       KGONG = LQSTA(KQT+2) - 1
  55       LLNG  = KGONG
  56       KGOPL = KGONG - 1
  57       LLPL  = KGOPL
  58       KEYPL = -1
  59       KEYNG =  0
  60       IFL   =  0
  61
  62       LN    = LGO
  63       KEYN  = IQ(KQS+LN+JW)
  64       IF (KEYN.GE.0 )              GO TO 22
  65       GO TO 62
  66
  67 C--------          +VE IN-SEQUENCE LOOP FOR BANKS WITH +VE KEY
  68 C--                          KEEP GOING FOR INCREASING KEYS
  69
  70    21 IFL = 7
  71    22 LQ(KQS+LLPL) = LN
  72       GO TO 24
  73
  74    23 KEYPL = KEYN
  75       LLPL  = LN
  76       LN    = LQ(KQS+LN)
  77       IF (LN.EQ.0)                 GO TO 81
  78       KEYN  = IQ(KQS+LN+JW)
  79       IF (KEYN.LT.0 )              GO TO 62
  80    24 IF (KEYN-KEYPL)        28, 25, 23
  81
  82    25 JSW = 7
  83       LC  = LLPL
  84       GO TO 71
  85
  86    28 LS = KGOPL
  87
  88 C--------          OUT-SEQUENCE LOOP, FIND PLACE FOR BANK IN THE CHAIN
  89 C--                          OF BANKS ALREADY SORTED, +VE OR -VE CHAIN
  90
  91    41 LNX = LQ(KQS+LN)
  92       IFL = 7
  93    43 KS  = LS
  94       LS  = LQ(KQS+LS)
  95       IF (KEYN-IQ(KQS+LS+JW))   48, 45, 43
  96
  97    45 JSW = 0
  98       LC  = LS
  99       GO TO 71
 100
 101    48 LQ(KQS+LN) = LS
 102       LQ(KQS+KS) = LN
 103       IF (LNX.EQ.0)                GO TO 81
 104       LN   = LNX
 105       KEYN = IQ(KQS+LN+JW)
 106       IF (KEYN.GE.0 )              GO TO 22
 107
 108 C--------          -VE IN-SEQUENCE LOOP FOR BANKS WITH -VE KEY
 109 C--                          KEEP GOING FOR INCREASING KEYS
 110
 111    62 LS = KGONG
 112       LQ(KQS+LLNG) = LN
 113       IF (KEYNG.NE.0 )             GO TO 64
 114
 115    63 KEYNG = KEYN
 116       LLNG  = LN
 117       LN    = LQ(KQS+LN)
 118       IF (LN.EQ.0)                 GO TO 81
 119       KEYN  = IQ(KQS+LN+JW)
 120       IF (KEYN.GE.0 )              GO TO 21
 121    64 IF (KEYN-KEYNG)        41, 65, 63
 122
 123    65 JSW = -7
 124       LC  = LLNG
 125
 126 C--------          COMPARE 2 STRINGS STARTING WITH THE SAME WORD
 127
 128    71 J   = JW
 129    72 J   = J+1
 130       KYC = IQ(KQS+LC+J)
 131       KYN = IQ(KQS+LN+J)
 132
 133 C--                  KYN < KYC
 134       IF (KYN.GE.0 )               GO TO 74
 135       IF (KYC.GE.0 )               GO TO 79
 136       GO TO 75
 137
 138 C--                  KYN > KYC
 139    74 IF (KYC.LT.0 )               GO TO 78
 140
 141    75 IF   (KYN-KYC)         79, 76, 78
 142    76 IF (J.LT.JWN)                GO TO 72
 143
 144 C--                KEYS/N .GE. KEYS/C
 145
 146    78 IF   (JSW)             63, 43, 23
 147
 148 C--                KEYS/N .LT. KEYS/C
 149
 150    79 IF   (JSW)             41, 48, 28
 151
 152 C----              FINISHED, LINK +VE AND -VE STREAMS, CHAIN K-LINKS
 153
 154    81 IF (IFL.EQ.0)                GO TO 999
 155       LQ(KQS+LLNG) = 0
 156       LQ(KQS+LLPL) = LQ(KQS+KGONG)
 157
 158       K = LQ(KQS+LGO+2)
 159       L = LQ(KQS+KGOPL)
 160       LQ(KQS+L+2) = K
 161       IF (K.NE.0)  LQ(KQS+K)=L
 162       LGOP(1) = L
 163
 164    84 K = L
 165       L = LQ(KQS+K)
 166       IF (L.EQ.0)                  GO TO 999
 167       LQ(KQS+L+2) = K
 168       GO TO 84
 169
 170 C----              SPECIAL CASE NWORDS=1
 171
 172    88 CALL ZSORTH (IXSTOR,LGOP,JW)
 173
 174 #include "zebra/qtrace99.inc"
 175       RETURN
 176       END
 177 *      ==================================================
 178 #include "zebra/qcardl.inc"
 179 #endif