MINICERN/packlib/kernlib/kerngen/tcgen/sorcha.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:49  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       SUBROUTINE SORCHA (A,ICH1,ICH2,NPOINT,ITYPE)
  11 C
  12 C CERN PROGLIB# M104    SORCHA          .VERSION KERNFOR  4.08  840613
  13 C ORIG. 29/05/84 H.RENSHALL/CERN
  14 C
  15 C  FORTRAN 77 SUBROUTINE TO DO SLOW LINEAR SORT OF A CHARACTER ARRAY
  16 C  INTO ITSELF IN ASCENDING OR DESCENDING ORDER USING EITHER THE
  17 C  LOGICAL COLLATION SEQUENCE FUNCTIONS (LLE,LGE) OR THE RELATIONAL
  18 C  FUNCTIONS (LE,GE). ON CDC AND VAX THE RESULTS ARE THE SAME AND
  19 C  MATCH THE COLLATION SEQUENCE ORDERING ON IBM IN WHICH BLANK IS
  20 C  LESS THAN NUMBERS WHICH ARE LESS THAN LETTERS. THE SORT MAY BE
  21 C  DONE ON ARRAYS OF UP TO LENGTH 256 CHARACTERS PER ARRAY ELEMENT
  22 C  AND MAY BE DONE ON ANY POSITIONS IN THE CHARACTER FIELD.
  23 C
  24 C A     = INPUT CHARACTER ARRAY OF DIMENSION NPOINT TO BE SORTED.
  25 C         MAXIMUM LENGTH OF A IS CHARACTER*256
  26 C ICH1  = FIRST CHARACTER POSTION IN EACH ELEMENT OF A
  27 C                                OF THE FIELD TO BE SORTED
  28 C ICH2  = LAST CHARACTER POSITION IN EACH ELEMENT OF A
  29 C                                OF THE FIELD TO BE SORTED
  30 C NPOINT= THE FIRST NPOINT ELEMENTS OF A WILL BE SORTED INTO THEMSELVES
  31 C ITYPE = INTEGER BETWEEN 1 AND 4 CONTROLLING THE TYPE OF SORT.
  32 C 1 = ASCENDING SORT (A(1) WILL BE LOWER THAN A(2))
  33 C                            USING COLLATING SEQUENCE
  34 C 2 = DESCENDING SORT (A(2) WILL BE LOWER THAN A(1))
  35 C                            USING COLLATING SEQUENCE
  36 C 3 = ASCENDING SORT (A(1) WILL BE LOWER THAN A(2))
  37 C                            USING RELATIONAL SEQUENCE
  38 C 4 = DESCENDING SORT (A(2) WILL BE LOWER THAN A(1))
  39 C                            USING RELATIONALIEQUENCE
  40 C          FOR PORTABLE RESULTS ITYPE= 1 OR 2 SHOULD BE USED.
  41 C          ON SOME MACHINES (CDC/FTN5 AND VAX/VMS) RESULTS
  42 C          ARE THE SAME AS ITYPE= 3 OR 4. NOTE THAT ITYPE= 3 OR 4
  43 C          MAY BE SUBSTANTIALLY FASTER THAN ITYPE= 1 OR 2.
  44 C
  45       CHARACTER*(*) A(NPOINT),STORE*256
  46       LENA= LEN(A(1))
  47       GO TO (5,25,45,75),ITYPE
  48     5 CONTINUE
  49 C
  50 C  ASCENDING COLLATION SEQUENCE SORT USING LLE FUNCTION
  51 C    ON MOST MACHINES THIS IS THE ASCII ORDER WHERE
  52 C       BLANK IS LESS THAN NUMBERS IS LESS THAN LETTERS
  53 C    THIS IS TRUE ON IBM/FACOM COMPILER, CDC/FTN5 AND VAX/VMS.
  54 C
  55         DO 20 I=1,NPOINT-1
  56         IPOINT= I
  57         STORE(1:LENA)= A(I)
  58           DO 10 J=I+1,NPOINT
  59           IF(LLE(A(I)(ICH1:ICH2),A(J)(ICH1:ICH2))) GO TO 10
  60           A(I)= A(J)
  61           IPOINT= J
  62    10     CONTINUE
  63         A(IPOINT)= STORE(1:LENA)
  64    20   CONTINUE
  65       RETURN
  66    25 CONTINUE
  67 C
  68 C  DESCENDING COLLATION SEQUENCE SORT USING LGE FUNCTION
  69 C    ON MOST MACHINES THIS IS THE ASCII ORDER WHERE
  70 C       BLANK IS LESS THAN NUMBERS IS LESS THAN LETTERS
  71 C    THIS IS TRUE ON IBM/FACOM COMPILER, CDC/FTN5 AND VAX/VMS.
  72 C
  73         DO 40 I=1,NPOINT-1
  74         IPOINT= I
  75         STORE(1:LENA)= A(I)
  76           DO 30 J=I+1,NPOINT
  77           IF(LGE(A(I)(ICH1:ICH2),A(J)(ICH1:ICH2))) GO TO 30
  78           A(I)= A(J)
  79           IPOINT= J
  80    30     CONTINUE
  81         A(IPOINT)= STORE(1:LENA)
  82    40   CONTINUE
  83       RETURN
  84    45 CONTINUE
  85 C
  86 C  ASCENDING RELATIONAL SEQUENCE SORT USING LE RELATION
  87 C    ON MANY MACHINES THIS IS THE ASCII ORDER WHERE
  88 C       BLANK IS LESS THAN NUMBERS IS LESS THAN LETTERS
  89 C    THIS IS TRUE ON  CDC/FTN5 AND VAX/VMS.
  90 C    ON IBM/FACOM COMPILER HOWEVER THE EBCDIC ORDER IS USED WHERE
  91 C       BLANK IS LESS THAN LETTERS IS LESS THAN NUMBERS
  92 C
  93         DO 60 I=1,NPOINT-1
  94         IPOINT= I
  95         STORE(1:LENA)= A(I)
  96           DO 50 J=I+1,NPOINT
  97           IF(A(I)(ICH1:ICH2).LE.A(J)(ICH1:ICH2)) GO TO 50
  98           A(I)= A(J)
  99           IPOINT= J
 100    50     CONTINUE
 101         A(IPOINT)= STORE(1:LENA)
 102    60   CONTINUE
 103       RETURN
 104    75 CONTINUE
 105 C
 106 C  DESCENDING RELATIONAL SEQUENCE SORT USING GE RELATION
 107 C    ON MANY MACHINES THIS IS THE ASCII ORDER WHERE
 108 C       BLANK IS LESS THAN NUMBERS IS LESS THAN LETTERS
 109 C    THIS IS TRUE ON  CDC/FTN5 AND VAX/VMS.
 110 C    ON IBM/FACOM COMPILER HOWEVER THE EBCDIC ORDER IS USED WHERE
 111 C       BLANK IS LESS THAN LETTERS IS LESS THAN NUMBERS
 112 C
 113         DO 90 I=1,NPOINT-1
 114         IPOINT= I
 115         STORE(1:LENA)= A(I)
 116           DO 80 J=I+1,NPOINT
 117           IF(A(I)(ICH1:ICH2).GE.A(J)(ICH1:ICH2)) GO TO 80
 118           A(I)= A(J)
 119           IPOINT= J
 120    80     CONTINUE
 121         A(IPOINT)= STORE(1:LENA)
 122    90   CONTINUE
 123       RETURN
 124       END