CTITLESALSL  -- CREATE LITHOLOGIC AUX TRACES                            00000203
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA    AUTHOR                 M.J.MAROLDA                                00000303
CA    DESIGNER               M.J.MAROLDA                                00000403
CA    LANGUAGE               FORTRAN                                    00000503
CA    SYSTEM                 IBM                                        00000603
CA    WRITTEN                02/85                                      00000703
CA    REVISED                06-03-87 BY CMP. CHECK FOR MISSING OFFSETS
CA                                                                      00001603
CA                                                                      00001703
CA    CALL SALSL (X,Y,N,XI,S,SIGMAS,R)                                  00001803
CA       INPUT        X = OFFSET ARRAY                              R4  00001903
CA       INPUT        Y = AMPLITUDE ARRAY                           R4  00002003
CA       INPUT        N = NUMBER OF OFFSETS                         I4  00002003
CA       OUTPUT      XI = XI TRACE ARRAY                            I4  00002003
CA       OUTPUT       S = S TRACE ARRAY                             I4  00002003
CA       OUTPUT  SIGMAS =                                           R4  00002103
CA       OUTPUT       R = CORRELATION COEFFICIENT ARRAY             R4  00002203
CA                                                                      00002303
CA                                                                      00002403
CA       THIS SUBROUTINE IS CALLED BY SDLITH TO CREATE THE AUXILIARY    00002503
CA       TRACE VALUES ON A SAMPLE BY SAMPLE BASIS.                      00002603
CA                                                                      00002803
C====================================================================== 00002903
C                                                                       00003003
      SUBROUTINE SALSL(X,Y,N,XI,S,SIGMAS,R)                             00000100
C
      DIMENSION X(N),Y(N)                                               00000200
C                                                                       00000300
      A = 0.0                                                           00000400
      B = 0.0                                                           00000410
      C = 0.0                                                           00000420
      D = 0.0                                                           00000430
      AA = 0.0                                                          00000440
      BB = 0.0                                                          00000450
      SXY= 0.0                                                          00000460
      ERR= 0.0                                                          00000470
      XN  = 0.                                                          00000480
C                                                                       00000500
      DO 10 I=1,N                                                       00000600
           IF (Y(I) .NE. 0) THEN
                 A = A + Y(I)
                 B = B + X(I)
                 C = C + X(I) * Y(I)
                 D = D + X(I) * X(I)
                 XN = XN + 1.
C                WRITE (6, 7200) I, X(I), Y(I)
           ENDIF
   10 CONTINUE                                                          00001200
C       WRITE(6,7100) A,B,C,D                                           00001210
C7100   FORMAT(' A,B,C,D = ',4(E12.4))                                  00001220
C7200   FORMAT(' I,X(I),Y(I)', I3, F20.5,2X,F20.5)                      00001220
C
C        CHECK FOR ALL ZEROES
C
      IF (XN .LT. 2.) THEN
           R = 0
           S = 0
           SIGMAS = 0
           XI = 0
           GO TO 100
      ENDIF
C                                                                       00001300
      YAV=A/XN                                                          00001301
      XAV=B/XN                                                          00001302
C                                                                       00001303
      DO 20 I=1,N                                                       00001304
      IF (Y(I) .EQ. 0.0) GO TO 20
      AA=AA+(X(I)-XAV)**2                                               00001305
      BB=BB+(Y(I)-YAV)**2                                               00001310
      SXY=SXY+(X(I)-XAV)*(Y(I)-YAV)                                     00001320
 20   CONTINUE                                                          00001330
C                                                                       00001340
      SX=SQRT(AA)                                                       00001350
      SY=SQRT(BB)                                                       00001360
C
C        CHECK FOR ALL ZEROES
C
      IF (SX .EQ. 0 .OR. SY .EQ. 0) THEN
           R = 0
           S = 0
           SIGMAS = 0
           XI = 0
           GO TO 100
      ENDIF
C
      R=ABS(SXY/(SX*SY))                                                00001370
C                                                                       00001391
      S1 = XN * C - A * B                                               00001400
      S2 = XN * D - B * B                                               00001500
      S  = S1 / S2                                                      00001600
C                                                                       00001610
      XI = (C - S * D)/B                                                00001700
C                                                                       00001701
      DO 30 I=1,N                                                       00001702
      IF (Y(I) .EQ. 0.0) GO TO 30
      YH=XI+S*X(I)                                                      00001703
      ERR=ERR+(Y(I)-YH)**2                                              00001704
 30   CONTINUE                                                          00001705
C                                                                       00001706
      IF (XN .LE. 2) THEN
           SIGMAU = ERR
      ELSE
           SIGMAU=ERR/(XN-2)
      ENDIF
C
      SIGMAS=SIGMAU/AA                                                  00001708
C                                                                       00001709
  100 CONTINUE
C     WRITE(6,7101) XI,S,N,XN,R,SIGMAU,SIGMAS
C7101 FORMAT(' XI.S,N,XN = ',2(E14.8,1X),I10,F6.2,
C    * ' R,SIGS=',2(E14.8,1X))
C                                                                       00001800
      RETURN                                                            00001900
      END                                                               00002000