CTITLESAHGRAM - DETERMINE CLIPPING LEVELS FOR HISTOGRAM SCALING.
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
C@PROCESS VECTOR(LEVEL(2) REPORT(XLIST))
C
CA    AUTHOR                 H. W. SWAN
CA    DESIGNER               H. W. SWAN
CA    SYSTEM                 IBM/CRAY
CA    LANGUAGE               VS FORTRAN VERSION 2.3
CA    WRITTEN                03-19-90
CA    LAST REVISED
C     REVISED      05-23-91  JJC - CHANGED IMPLICIT NONE TO (A-Z).
C                                - REMOVED DO WHILE FOR CRAY.
C     REVISED      12-17-91  JJC - MODIFIED TO MEET SPARC STANDARDS.
CA
CA    CALLING SEQUENCE:
CA      CALL SAHGRAM(HGRAM, HSIZE, KPWKD2, NRECS, OH, OTR,
CA                 USCALE, ASCALE, BIN)
CA
CA   IN/OUT   ARGUMENT   TYPE   DESCRIPTION
CA   ______   ________   ____   ___________
CA
CA    OUT      IGRAM    (I4)   THE DATA HISTOGRAM  (INTEGER FORMAT)
CA                             (DIMENSIONED -HSIZE:HSIZE)
CA    OUT      HGRAM    (R4)   THE DATA HISTOGRAM  (REAL FORMAT)
CA                             (DIMENSIONED -HSIZE:HSIZE)
CA    IN       HSIZE     I4    THE HISTOGRAM LENGTH
CA    IN       KPWKD2    I4    THE POINTER TO THE FILE CONTAINING THE
CA                                 DATA
CA    IN       NRECS     I4    THE NUMBER OF RECORDS IN THE FILE + 1.
CA    OUT      OH       (I4)   SCRATCH ARRAY FOR THE TRACE HEADERS
CA    OUT      OTR      (R4)   SCRATCH ARRAY FOR THE TRACE DATA
CA                             (MUST BE CONTIGUOUS TO "OH".)
CA    IN       THL       I4    THE TRACE HEADER LENGTH
CA    IN       NS        I4    THE TRACE LENGTH
CA    IN       USCALE    R4    THE PERCENTAGE OF DATA VALUES TO
CA                             BE CLIPPED
CA   IN/OUT    ASCALE    R4    INPUT:  THE MAXIMUM ABSOLUTE VALUE
CA                                     OF THE DATA
CA                       R4    OUTPUT:  THE SMALLEST DATA VALUE GREATER
CA                                     THAN "USCALE" % OF THE ABSOLUTE
CA                                     VALUES IN THE FILE
CA    OUT      BIN       I4    THE LARGEST BIN NUMBER (OUT OF 'HSIZE'
CA                                 BINS) TO BE PLOTTED.
CA                             SET TO (-1) ON ERROR.
CA
CA   PURPOSE:
CA
CA      INSTEAD OF SCALING COLOR PLOTS BASED ON THE MAXIMUM ABSOLUTE
CA      VALUE (OPTION 'Z'), THIS ROUTINE ALLOWS A CERTAIN PREDETERMINED
CA      PERCENTAGE TO BE CLIPPED.   THIS PROVIDES A MORE ROBUST SCALING
CA      ALGORITHM.
CA
CA   SUBROUTINES CALLED:   ARSET, FORDSD
CA
CA
        SUBROUTINE SAHGRAM (IGRAM, HGRAM, HSIZE, KPWKD2, NRECS, OH, OTR,
     +      THL, NS, USCALE, ASCALE, BIN)
C
C
        IMPLICIT INTEGER (A-Z)
C
C  DECLARATION OF CALLING PARAMETERS:
C
        INTEGER          HSIZE, IGRAM(-HSIZE:HSIZE), KPWKD2, NRECS
        INTEGER          THL, NS, BIN, OH(THL)
        REAL             OTR(NS), HGRAM(-HSIZE:HSIZE), USCALE, ASCALE
C
C  DECLARATION OF LOCAL PARAMETERS:
C
        INTEGER          REC, I
        REAL             SCALE, VALUE, SVAL
        DOUBLE PRECISION TOTAL, SUM, BIG
        EXTERNAL         FORDSD, ARSET
C
C  INITIALIZATION
C
        IF(ASCALE .LE. 0.0) GO TO 1000
        SCALE = HSIZE**2 / ASCALE
        CALL ARSET(IGRAM(-HSIZE), 2*HSIZE + 1, 0)
        REC = 1
        TOTAL = 0
C
C  BEGIN READING THE FILE
C
CJJ     DO WHILE (REC .LT. NRECS)
   10   IF (REC .GE. NRECS) GO TO 20
            CALL FORDSD(KPWKD2, REC, OH)
            REC = REC + 1
C
C  TAKE SQUARE ROOT OF TRACE TO INCREASE DYNAMIC RANGE.
C     (VECTOR OPERATION)
C
            DO 50 I=1, NS
                 VALUE = OTR(I) * SCALE
                 SVAL  = SQRT(ABS(VALUE))
                 IF(VALUE .LT. 0.0) SVAL = -SVAL
 50              OTR(I) = SVAL
C
C  BUILD THE HISTOGRAM STATISTICS
C  DON'T INCLUDE VALUES FALLING WITHIN BIN 0 IN THE TOTAL COUNT.
C
            DO 100 I=1, NS
                 BIN = OTR(I)
                 IF(IABS(BIN) .GT. HSIZE) BIN = ISIGN(HSIZE, BIN)
                 IGRAM(BIN) = IGRAM(BIN) + 1
                 IF(BIN .NE. 0) TOTAL = TOTAL + 1D0
 100             CONTINUE
CJJ         ENDDO
            GO TO 10
   20       CONTINUE
C
C  SCAN THE HISTOGRAM, LOOKING FOR THE BIGGEST VALUE AND FOR OVERFLOW.
C  OVERLOOK THE SPIKE AT 0.
C
        BIG = 0D0
        DO 150 I=-HSIZE, HSIZE
             IF(I .NE. 0) THEN
                  IF(IGRAM(I) .GT. BIG) BIG = IGRAM(I)
                  IF(IGRAM(I) .LT. 0) GO TO 1000
                  ENDIF
 150         CONTINUE
C
C  SCAN THE HISTOGRAM TO DETERMINE THE DATA SCALING LEVEL
C
        BIN = 0
        SUM = 0
        TOTAL = TOTAL * (100.0 - USCALE) / 1D2
        DO 200 I=1, HSIZE
             BIN = I
             IF(SUM .GE. TOTAL) GO TO 220
             SUM = SUM + IGRAM(BIN) + IGRAM(-BIN)
 200         CONTINUE
C
C  GENERATE THE SCALED HISTOGRAM
C
 220    DO 250 I=-HSIZE, HSIZE
             VALUE = IGRAM(I)
             IF(VALUE .GT. BIG) VALUE = BIG
 250         HGRAM(I) = VALUE / BIG
C
C  COMPUTE THE DATA SCALING LEVEL.
C
        ASCALE = BIN**2 / SCALE
        RETURN
C
C  INTEGER OVERFLOW - NO HISTOGRAM COMPUTED.
C
 1000   BIN = -1
        RETURN
        END