previous up next print clean
Next: About this document ... Up: REFERENCES Previous: Listing of the Objective

Preprocessed Subroutine

      SUBROUTINE TOLDIJ(NT,SLOWINT,SEMBLANCE,DT,DATA,NX,DX,GRAD,YGRAD,LY
     *GRAD,RFS,IFS,LFS)
      INTEGER LFS,IFS(LFS)
      REAL RFS(LFS),TGRA(543)
      INTEGER NT,NX,IT,LQ00,LQ01,LQ02,LQ03,J,LQ04,LQ05,IX,LYGRAD,IGRAD,R
     *GRAD,ISLOWI
      REAL SLOWINT(NT),SEMBLANCE,DT,DATA(NT,NX),DX,GRAD(NT),DATAVAL,VALU
     *E,RMS,SUM,W,TAU,X,NUMERATOR,DENOMINATOR,SQRT,YGRAD(LYGRAD)
      ISLOWI = 549
      CALL SPINIT(ISLOWI+NT,LYGRAD)
      CALL EMIT0(1,RFS,IFS,LFS)
      SEMBLANCE = 0.
      LQ00 = 1
      LQ01 = NT
      DO 90001 IT = LQ00,LQ01
      CALL EMIT0(3,RFS,IFS,LFS)
      SUM = 0.
      LQ02 = 1
      LQ03 = IT
      DO 90002 J = LQ02,LQ03
      CALL EMIT2(ISLOWI+J,SLOWINT(J),ISLOWI+J,SLOWINT(J),8,RFS,IFS,LFS)
      TGRA(2) = SLOWINT(J)*SLOWINT(J)
      CALL EMIT1(8,-(DT/(TGRA(2)**2)),7,RFS,IFS,LFS)
      TGRA(1) = DT/TGRA(2)
      CALL EMIT2(3,1.,7,1.,3,RFS,IFS,LFS)
      SUM = SUM+TGRA(1)
90002 CONTINUE
      TAU = IT*DT
      CALL EMIT1(3,-(TAU/(SUM**2)),7,RFS,IFS,LFS)
      TGRA(1) = TAU/SUM
      W = SQRT(TGRA(1))
      CALL EMIT1(7,.5/W,4,RFS,IFS,LFS)
      CALL EMIT0(5,RFS,IFS,LFS)
      NUMERATOR = 0.
      CALL EMIT0(6,RFS,IFS,LFS)
      DENOMINATOR = 0.
      LQ04 = 1
      LQ05 = NX
      DO 90003 IX = LQ04,LQ05
      CALL EMIT0(2,RFS,IFS,LFS)
      VALUE = DATAVAL(IX,IT,W,DATA,NT,NX,DT,DX)
      CALL EMIT2(5,1.,2,1.,5,RFS,IFS,LFS)
      NUMERATOR = NUMERATOR+VALUE
      CALL EMIT2(2,VALUE,2,VALUE,7,RFS,IFS,LFS)
      TGRA(1) = VALUE*VALUE
      CALL EMIT2(6,1.,7,1.,6,RFS,IFS,LFS)
      DENOMINATOR = DENOMINATOR+TGRA(1)
90003 CONTINUE
      CALL EMIT2(5,NUMERATOR,5,NUMERATOR,5,RFS,IFS,LFS)
      NUMERATOR = NUMERATOR*NUMERATOR
      IF (.NOT.(DENOMINATOR.GT.0.001))GO TO 23006
      CALL EMIT1(6,NX+0.,8,RFS,IFS,LFS)
      TGRA(2) = DENOMINATOR*NX
      CALL EMIT2(5,1./TGRA(2),8,-(NUMERATOR/(TGRA(2)**2)),7,RFS,IFS,LFS)
      TGRA(1) = NUMERATOR/TGRA(2)
      CALL EMIT2(1,1.,7,1.,1,RFS,IFS,LFS)
      SEMBLANCE = SEMBLANCE+TGRA(1)
      CALL SRITE('SEMB.H',NUMERATOR/(DENOMINATOR*NX),4)
      GO TO 23007
23006 CONTINUE
      CALL SRITE('SEMB.H',0.,4)
23007 CONTINUE
90001 CONTINUE
90000 CONTINUE
      RGRAD = 0
      CALL SPGRAD(YGRAD,LYGRAD,1,RGRAD,IGRAD,RFS,IFS,LFS)
      CALL SPCOPY(GRAD,IGRAD,1,YGRAD(ISLOWI+1),NT)
      RETURN
      END

 


previous up next print clean
Next: About this document ... Up: REFERENCES Previous: Listing of the Objective
Stanford Exploration Project
11/18/1997