Next: About this document ...
Up: REFERENCES
Previous: Listing of the Objective
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
Next: About this document ...
Up: REFERENCES
Previous: Listing of the Objective
Stanford Exploration Project
11/18/1997