Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

C                                      *** BANK ***
C
C     SUBROUTINE TO SORT BANK DATA INTO ASCENDING ORDER BASED
C     ON A USER SPECIFIED MAJOR TO MINOR SORT SEQUENCE.
C
      SUBROUTINE BSORT
      COMMON /MTM/ NMTM,IVARSQ(20)
      COMMON /GEN/ IPROJA,IPROGA,NV,NO,BNKNM,DATCR,NPROJR,NPROGR
      COMMON /DEV/ IDLG,ICC,IBNK
      DIMENSION ID(12000),IN(125),IOLD(125),INEW(125),IU(16),IL(16)
      DIMENSION IG(21),IM(125),IO(125),NNS(18,6),ITYPEV(20)
      EQUIVALENCE (ID(11876),IOLD),(ID(11751),INEW),(MISS,AMISS)
      EQUIVALENCE (IN,NNS)
      DOUBLE PRECISION BNKNM
      DATA MISS/"400000000000/
      ISW=0
      ITMP=21
      NL=NMTM+1
      NOBASE=(NO+124)/125
      IF((NL*NO).LE.12000) GO TO 7
      WRITE(IDLG,2)
2     FORMAT(' THE INCORE SORT WILL NOT ACCOMODATE THE DATASET YOU'/
     1' HAVE, WORK IS BEING DONE TO HANDLE LARGER DATA SETS'/
     2' PLEASE CONTACT DICK HOUCHARD 3830095 TO ESTABLISH THE NEED')
      RETURN
7     IF(NMTM.GT.0) GO TO 1
      WRITE(IDLG,8)
8     FORMAT(' NO MAJOR TO MINOR SEQUENCE')
      RETURN
1     DO 9 I=1,NMTM
      IONE=(IVARSQ(I)+5)/6
      LWHICH=IVARSQ(I)-(IONE-1)*6
      IBLK=IONE+NV*NOBASE+1
      READ(IBNK#IBLK) IN
9     ITYPEV(I)=NNS(10,LWHICH)
      DO 3 I=1,NO,125
      NEND=I+124
      IF(NEND.GT.NO) NEND=NO
      NCELL=(I+124)/125
      DO 4 J=1,NMTM
      IBLK=(IVARSQ(J)-1)*NOBASE+1+NCELL
      READ(IBNK#IBLK) IN
      NK=J*NO
      IF(ITYPEV(J).EQ.1) GO TO 10
      DO 5 K=I,NEND
5     ID(NK+K)=IN(K-I+1)
      GO TO 4
10    DO 81 K=I,NEND
81    ID(NK+K)=ISHIFT(IN(K-I+1))
4     CONTINUE
      DO 6 K=I,NEND
6     ID(K)=K
3     CONTINUE
C
C     SORT FROM ACM (SINGLETON METHOD)
C
      M=1
      II=1
      J=NO
11    IF(II.GE.J) GO TO 18
12    K=II
      IJ=(J+II)/2
      I=0
31    I=I+1
      IF(I.GT.NMTM) GO TO 33
      IT1=ID(I*NO+IJ)
      IT2=ID(I*NO+II)
      IF(IT2.EQ.IT1) GO TO 31
      IF(IT2.LT.IT1) GO TO 13
      GO TO 32
33    IF(ID(II).LE.ID(IJ)) GO TO 13
32    DO 60 N=0,NMTM
      ISUB=(N*NO+IJ)
      ISUB1=(N*NO+II)
      ISAV=ID(ISUB)
      ID(ISUB)=ID(ISUB1)
60    ID(ISUB1)=ISAV
13    LL=J
      I=0
34    I=I+1
      IF(I.GT.NMTM) GO TO 36
      IT1=ID(I*NO+IJ)
      IT2=ID(I*NO+J)
      IF(IT2.EQ.IT1) GO TO 34
      IF(IT2.GT.IT1) GO TO 55
      GO TO 35
36    IF(ID(J).GE.ID(IJ)) GO TO 55
35    DO 61 N=0,NMTM
      ISUB=(N*NO+IJ)
      ISUB1=(N*NO+J)
      ISAV=ID(ISUB)
      ID(ISUB)=ID(ISUB1)
61    ID(ISUB1)=ISAV
      I=0
37    I=I+1
      IF(I.GT.NMTM) GO TO 39
      IT1=ID(I*NO+IJ)
      IT2=ID(I*NO+II)
      IF(IT2.EQ.IT1) GO TO 37
      IF(IT2.LT.IT1) GO TO 55
      GO TO 38
39    IF(ID(II).LE.ID(IJ)) GO TO 55
38    DO 62 N=0,NMTM
      ISUB=(N*NO+IJ)
      ISUB1=(N*NO+II)
      ISAV=ID(ISUB)
      ID(ISUB)=ID(ISUB1)
62    ID(ISUB1)=ISAV
55    DO 56 L=0,NMTM
56    IG(L+1)=ID(L*NO+IJ)
      GO TO 15
14    DO 63 N=0,NMTM
      ISUB=(N*NO+LL)
      ISUB1=(N*NO+K)
      ISAV=ID(ISUB)
      ID(ISUB)=ID(ISUB1)
63    ID(ISUB1)=ISAV
15    LL=LL-1
      I=0
40    I=I+1
      IF(I.GT.NMTM) GO TO 41
      IT1=IG(I+1)
      IT2=ID(I*NO+LL)
      IF(IT2.EQ.IT1) GO TO 40
      IF(IT2.GT.IT1) GO TO 15
      GO TO 16
41    IF(ID(LL).GT.IG(1)) GO TO 15
16    K=K+1
      I=0
42    I=I+1
      IF(I.GT.NMTM) GO TO 44
      IT1=IG(I+1)
      IT2=ID(I*NO+K)
      IF(IT2.EQ.IT1) GO TO 42
      IF(IT2.LT.IT1) GO TO 16
      GO TO 43
44    IF(ID(K).LT.IG(1)) GO TO 16
43    IF(K.LE.LL) GO TO 14
      IF((LL-II).LE.(J-K)) GO TO 17
      IL(M)=II
      IU(M)=LL
      II=K
      M=M+1
      GO TO 19
17    IL(M)=K
      IU(M)=J
      J=LL
      M=M+1
      GO TO 19
18    M=M-1
      IF(M.EQ.0) GO TO 70
      II=IL(M)
      J=IU(M)
19    IF((J-II).GE.11) GO TO 12
      IF(II.EQ.1) GO TO 11
C
C
      II=II-1
20    II=II+1
      IF(II.EQ.J) GO TO 18
      DO 64 N=0,NMTM
64    IG(N+1)=ID(N*NO+II+1)
      I=0
45    I=I+1
      IF(I.GT.NMTM) GO TO 47
      IT1=IG(I+1)
      IT2=ID(I*NO+II)
      IF(IT2.EQ.IT1) GO TO 45
      IF(IT2.LT.IT1) GO TO 20
      GO TO 46
47    IF(ID(II).LE.IG(1)) GO TO 20
46    K=II
21    DO 65 N=0,NMTM
65    ID(N*NO+K+1)=ID(N*NO+K)
      K=K-1
      I=0
48    I=I+1
      IF(I.GT.NMTM) GO TO 50
      IT1=IG(I+1)
      IT2=ID(I*NO+K)
      IF(IT2.EQ.IT1) GO TO 48
      IF(IT1.LT.IT2) GO TO 21
      GO TO 49
50    IF(IG(1).LT.ID(K)) GO TO 21
49    DO 66 N=0,NMTM
66    ID(N*NO+K+1)=IG(N+1)
      GO TO 20
C
C     DONE WITH SORT
C
70    DO 71 I=1,NO
71    ID(NO+ID(I))=I
      DO 72 I=1,NO
72    ID(I)=ID(I+NO)
      DO 80 I=1,NV
      IBASE=(I-1)*NOBASE+1
      DO 73 J=1,NOBASE
      READ(IBNK#(IBASE+J)) INEW
      KBG=(J-1)*125+1
      KMIN=KBG-1
      KEND=KBG+124
      IF(KEND.GT.NO) KEND=NO
      DO 74 K=KBG,KEND
74    ID(NO+ID(K))=INEW(K-KMIN)
73    CONTINUE
      DO 75 J=1,NOBASE
      KBG=(J-1)*125+1
      KMIN=KBG-1
      KEND=KBG+124
      IF(KEND.GT.NO)KEND=NO
      DO 76 K=KBG,KEND
76    INEW(K-KMIN)=ID(NO+K)
      IF((KEND-KMIN).EQ.125) GO TO 75
      DO 77 K=(KEND-KMIN+1),125
77    INEW(K)=MISS
75    WRITE(IBNK#(IBASE+J)) INEW
80    CONTINUE
      RETURN
      END
C                                     *** BANK ***
C
C     FUNCTION TO SHIFT ALPHA VALUE ONE BIT TO RIGHT TO FACILITATE COMPARES
C
      FUNCTION ISHIFT(N)
      ISHIFT=(N.AND."377777777777)/2
      IF(N.LT.0)ISHIFT=ISHIFT.OR."200000000000
      RETURN
      END