C
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CTITLESAEQMOD -- COMPUTE THE BINNING FROM X TO X**2
CA
CA   DESIGNER     PETER LUH
CA   AUTHOR       PETER LUH
CA   LANGUAGE     FORTRAN 77
CA   SYSTEM       IBM / CRAY
CA   WRITTEN      11/16/90
C    REVISED      02/12/92 JJC - RENAMED XNTLZ TO SAEQMOD.
C                                FOR CRAY CONVERSION.
CA
CA
CA CALLING PROCEDURE:
CA     SUBROUTINE SAEQMOD(NX,XNR,XFR,DX,IPR,KBUGF,KNX,DP,DR,BN,IFLAG,
CA                      X, MX, KONT )
CA
C   CALLING ARGUMENTS
CA
CA     IN     NX      NUMBER OF PARTIAL STACK TRACES               I4
CA     IN     XNR     MINIMUM NEAR OFFSET                          R4
CA     IN     XFR     MAXIMUM FAR  OFFSET                          R4
CA     IN     DX      OFFSET INCREMENT                             R4
CA     IN     IPR     PRINT UNIT                                   I4
CA     IN     KBUGF   DEBUG FLAG                                   I4
CA     IN     KNX     FFT LENGTH MAGNITUDE (2**KNX)                I4
CA     IN/OUT DP      FORWARD DIP                                  R4
CA     IN/OUT DR      REVERSE DIP                                  R4
CA     IN     BN
CA     IN     IFLAG
CA     OUT    X       BINNED NEW OFFSET                            R4
CA     OUT    MX      OFFSET IN INTEGER                            I4
CA     OUT    KONT    NUMBER OF TRACES POSSIBLE PER BIN            I4
CA
      SUBROUTINE SAEQMOD(NX,XNR,XFR,DX,IPR,KBUGF,KNX,DP,DR,BN,IFLAG,
     +                 X      ,MX     ,KONT    )
C
      IMPLICIT INTEGER (A-Z)
C
C
      DIMENSION X(2,*),MX(*),KONT(*)
C
      REAL    AMAX1
      REAL    AMIN1
      REAL    B
      REAL    BN
      REAL    DP
      REAL    DR
      REAL    DX
      REAL    DX2
      REAL    DX2H
      REAL    SQRT
      REAL    X
      REAL    XFR
      REAL    XFR2
      REAL    XM
      REAL    XN
      REAL    XNR
      REAL    XX
      DX2 = XFR * XFR / (NX / 2 - 0.5 )  + 0.5
C     ENDIF
      DX2H = DX2 * 0.5
      B = 0.5 * (BN * DX + 1. )
C
C-12/06/90
      DO 120 K = 1, 2
         IFL = K - 2
         XFR2 = 0.
         XN = 0.
C-12/06/90 DO 20 I=1,NX
         DO 100 I = K, NX, 2
C-12/06/90FLAG.GE.0) XFR2=XFR2+DX2H
            IF (IFL .GE. 0) XFR2 = XFR2 + DX2H
            XM = SQRT ( XFR2 )
C ----------------------------------------------- EXPAND BIN RANGE BY DX
C     X(1,I)=      XN
            X(1, I) = AMIN1 ( XN, XM - B )
            MX(I) = NINT ( XM )
            XFR2 = XFR2 + DX2H
            XX = SQRT ( XFR2 )
C ----------------------------------------------- EXPAND BIN RANGE BY DX
C     X(2,I)=      XX
            X(2, I) = AMAX1 ( XX, XM + B )
C-12/06/90FLAG.LT.0) XFR2=XFR2+DX2H
            IF (IFL .LT. 0) XFR2 = XFR2 + DX2H
C     KONT(I)=0
            KONT(I) = (AMIN1 ( XFR, XX )  - AMAX1 ( XNR, XN )  )  / DX
            XN = XX
 100     CONTINUE
 120  CONTINUE
C ------------------------------- IFLAG --------------------------------
C
C         IFLAG >=0 :    XN    XM   XX
C                         0     .    º
C
C         IFLAG < 0 :    XN=XM XX
C                         0     º
C
      IFLAG = IABS ( IFLAG )
C
C     I=1
C     XFR2=XNR
C  30 CONTINUE
C     IF(XFR2.LE.XFR+1.) THEN
C        IF(XFR2.GT.X(2,I)) I=I+1
C        KONT(I)=KONT(I)+1
C        XFR2=XFR2+DX
C        GO TO 30
C     ENDIF
C
      IF (KBUGF .GT. 0) WRITE ( IPR,
     1   '(2(1X,3I5,F12.1,I10,F12.1,5H  |  ))' )  ( I, KONT(I),  ( KONT(
     2   I) + 1 )  / 2, X(1, I), MX(I), X(2, I), I = 1, NX )
C
      DO 140 I = 1, NX
         KONT(I) = MAX0 ( 1, (KONT(I) + 1 )  / 2 )
 140  CONTINUE
C
C-12/06/90
C     DP= (0.004*SQRT(DX2*KNX)/XFR)*DP*0.96
C     DR=-(0.004*SQRT(DX2*KNX)/XFR)*DR
      DP = (0.004 * SQRT ( DX2H * KNX )  / XFR )  * DP * 0.96
      DR = -(0.004 * SQRT ( DX2H * KNX )  / XFR )  * DR * 0.96
C
      IF (KBUGF .GT. 0) WRITE ( IPR, * ) DP, DR
C
      WRITE ( IPR, '(A,I5,A/(5(1X,I5,I10,5H  |  )))' )
     1   '0PARTIAL-STACK FOLD =', NX, '  ;  XDST =',  ( I, MX(I), I = 1
     2   , NX )
C
      RETURN
      END