*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/15 17:49:48  mclareni
* Initial revision
*
*
#include "kerngen/pilot.h"
      SUBROUTINE SORCHA (A,ICH1,ICH2,NPOINT,ITYPE)
C
C CERN PROGLIB# M104    SORCHA          .VERSION KERNFOR  4.08  840613
C ORIG. 29/05/84 H.RENSHALL/CERN
C
C  FORTRAN 77 SUBROUTINE TO DO SLOW LINEAR SORT OF A CHARACTER ARRAY
C  INTO ITSELF IN ASCENDING OR DESCENDING ORDER USING EITHER THE
C  LOGICAL COLLATION SEQUENCE FUNCTIONS (LLE,LGE) OR THE RELATIONAL
C  FUNCTIONS (LE,GE). ON CDC AND VAX THE RESULTS ARE THE SAME AND
C  MATCH THE COLLATION SEQUENCE ORDERING ON IBM IN WHICH BLANK IS
C  LESS THAN NUMBERS WHICH ARE LESS THAN LETTERS. THE SORT MAY BE
C  DONE ON ARRAYS OF UP TO LENGTH 256 CHARACTERS PER ARRAY ELEMENT
C  AND MAY BE DONE ON ANY POSITIONS IN THE CHARACTER FIELD.
C
C A     = INPUT CHARACTER ARRAY OF DIMENSION NPOINT TO BE SORTED.
C         MAXIMUM LENGTH OF A IS CHARACTER*256
C ICH1  = FIRST CHARACTER POSTION IN EACH ELEMENT OF A
C                                OF THE FIELD TO BE SORTED
C ICH2  = LAST CHARACTER POSITION IN EACH ELEMENT OF A
C                                OF THE FIELD TO BE SORTED
C NPOINT= THE FIRST NPOINT ELEMENTS OF A WILL BE SORTED INTO THEMSELVES
C ITYPE = INTEGER BETWEEN 1 AND 4 CONTROLLING THE TYPE OF SORT.
C 1 = ASCENDING SORT (A(1) WILL BE LOWER THAN A(2))
C                            USING COLLATING SEQUENCE
C 2 = DESCENDING SORT (A(2) WILL BE LOWER THAN A(1))
C                            USING COLLATING SEQUENCE
C 3 = ASCENDING SORT (A(1) WILL BE LOWER THAN A(2))
C                            USING RELATIONAL SEQUENCE
C 4 = DESCENDING SORT (A(2) WILL BE LOWER THAN A(1))
C                            USING RELATIONALIEQUENCE
C          FOR PORTABLE RESULTS ITYPE= 1 OR 2 SHOULD BE USED.
C          ON SOME MACHINES (CDC/FTN5 AND VAX/VMS) RESULTS
C          ARE THE SAME AS ITYPE= 3 OR 4. NOTE THAT ITYPE= 3 OR 4
C          MAY BE SUBSTANTIALLY FASTER THAN ITYPE= 1 OR 2.
C
      CHARACTER*(*) A(NPOINT),STORE*256
      LENA= LEN(A(1))
      GO TO (5,25,45,75),ITYPE
    5 CONTINUE
C
C  ASCENDING COLLATION SEQUENCE SORT USING LLE FUNCTION
C    ON MOST MACHINES THIS IS THE ASCII ORDER WHERE
C       BLANK IS LESS THAN NUMBERS IS LESS THAN LETTERS
C    THIS IS TRUE ON IBM/FACOM COMPILER, CDC/FTN5 AND VAX/VMS.
C
        DO 20 I=1,NPOINT-1
        IPOINT= I
        STORE(1:LENA)= A(I)
          DO 10 J=I+1,NPOINT
          IF(LLE(A(I)(ICH1:ICH2),A(J)(ICH1:ICH2))) GO TO 10
          A(I)= A(J)
          IPOINT= J
   10     CONTINUE
        A(IPOINT)= STORE(1:LENA)
   20   CONTINUE
      RETURN
   25 CONTINUE
C
C  DESCENDING COLLATION SEQUENCE SORT USING LGE FUNCTION
C    ON MOST MACHINES THIS IS THE ASCII ORDER WHERE
C       BLANK IS LESS THAN NUMBERS IS LESS THAN LETTERS
C    THIS IS TRUE ON IBM/FACOM COMPILER, CDC/FTN5 AND VAX/VMS.
C
        DO 40 I=1,NPOINT-1
        IPOINT= I
        STORE(1:LENA)= A(I)
          DO 30 J=I+1,NPOINT
          IF(LGE(A(I)(ICH1:ICH2),A(J)(ICH1:ICH2))) GO TO 30
          A(I)= A(J)
          IPOINT= J
   30     CONTINUE
        A(IPOINT)= STORE(1:LENA)
   40   CONTINUE
      RETURN
   45 CONTINUE
C
C  ASCENDING RELATIONAL SEQUENCE SORT USING LE RELATION
C    ON MANY MACHINES THIS IS THE ASCII ORDER WHERE
C       BLANK IS LESS THAN NUMBERS IS LESS THAN LETTERS
C    THIS IS TRUE ON  CDC/FTN5 AND VAX/VMS.
C    ON IBM/FACOM COMPILER HOWEVER THE EBCDIC ORDER IS USED WHERE
C       BLANK IS LESS THAN LETTERS IS LESS THAN NUMBERS
C
        DO 60 I=1,NPOINT-1
        IPOINT= I
        STORE(1:LENA)= A(I)
          DO 50 J=I+1,NPOINT
          IF(A(I)(ICH1:ICH2).LE.A(J)(ICH1:ICH2)) GO TO 50
          A(I)= A(J)
          IPOINT= J
   50     CONTINUE
        A(IPOINT)= STORE(1:LENA)
   60   CONTINUE
      RETURN
   75 CONTINUE
C
C  DESCENDING RELATIONAL SEQUENCE SORT USING GE RELATION
C    ON MANY MACHINES THIS IS THE ASCII ORDER WHERE
C       BLANK IS LESS THAN NUMBERS IS LESS THAN LETTERS
C    THIS IS TRUE ON  CDC/FTN5 AND VAX/VMS.
C    ON IBM/FACOM COMPILER HOWEVER THE EBCDIC ORDER IS USED WHERE
C       BLANK IS LESS THAN LETTERS IS LESS THAN NUMBERS
C
        DO 90 I=1,NPOINT-1
        IPOINT= I
        STORE(1:LENA)= A(I)
          DO 80 J=I+1,NPOINT
          IF(A(I)(ICH1:ICH2).GE.A(J)(ICH1:ICH2)) GO TO 80
          A(I)= A(J)
          IPOINT= J
   80     CONTINUE
        A(IPOINT)= STORE(1:LENA)
   90   CONTINUE
      RETURN
      END
