anchor.diff:  C   MODIFIED SEPT. 1971
   C
   C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  -      CHARACTER*6 TITLE
  -      COMPLEX X, AX
  -C
  -      DIMENSION X( 68), AX(3, 64), LL(3)
  -      COMMON /EQ/ MFOLD,MA2,TITLE(5),DT, MA , MMA, DF,MX
  -      COMMON/FRCUT/ NCUT,NZERO
  +      character*6 TITLE
  +      complex X, AX
  +C
  +      dimension X( 68), AX(3, 64), LL(3)
  +      common /EQ/ MFOLD,MA2,TITLE(5),DT, MA , MMA, DF,MX
  +      common/FRCUT/ NCUT,NZERO
   C
         F1 = .5/DT
         FR = FLOAT(IFR)
  
positive.code:       NN = 4
        NCARDS=MA/8
        NC = NCARDS
        IF (K2.EQ.0) NC = 0
  C     IF (KK.EQ.5) GO TO 252
        IF (KK.EQ.6) GO TO 252
        IF (LT.EQ.0)  WRITE(6,2000) LH, (IDNT(I),I=1,6)
        IF (LT.EQ.1)  WRITE(6,2002) LH, (IDNT(I),I=1,6)
        WRITE(6, 2005) SFX
        WRITE(6,2003) XMAX, TMAX
    252 IF (KK.EQ.6.AND.LT.EQ.0)  WRITE(6,2001) DPTH,XMAX,TMAX,SFX,XEND,NC
        IF (KK.EQ.6.AND.LT.EQ.1) WRITE(6,2010) DPTH,XMAX,TMAX,SFX, XEND,NC
        IF (K2.EQ.0) GO TO 262
        WRITE(7,2006) XMAX, (TITLE(I),I=1,5)
        IF (LT.EQ.1)  WRITE(7,2002) LH, (IDNT(I),I=1,6)
        IF (LT.EQ.0)  WRITE(7,2000) LH, (IDNT(I),I=1,6)
        DO 26 I = 1,NCARDS
        K = 0
        DO 261 J = N,NN
        K = K+ 1
        XR(K) = REAL(X(J))
        K = K + 1
        XR(K) = AIMAG(X(J))
    261 CONTINUE
        WRITE(7,2009) (XR(J),J=1,8),I
        IF (K2 .EQ. 2) WRITE(6,2019) (XR(J), J = 1,8), I
        NN = 4 + NN
        N = N + 4
     26 CONTINUE
    262 CALL RFFT(X,MX,INV,S,IFERR,2)
        IF (LS.EQ.0)   RETURN
        DO 27 I = 1,MFOLD
        SAVE = AX(LS,I)
        AX(LS,I) = X(I)
     27 X(I) = SAVE
        RETURN
  C
   2000 FORMAT(43H  ACCELERATION VALUES AT OUTCROPPING LAYER I3,3H - 6A6)
   2001 FORMAT(5X,6HOUTCR. F15.1,F15.5,2F15.2,F20.3,I20)
   2010 FORMAT(5X,6HWITHIN F15.1,F15.5,2F15.2,F20.3,I20)
   2002 FORMAT(42H  ACCELERATION VALUES AT THE TOP OF LAYER I3,3H - 6A6)
   2003 FORMAT(/15H  MAX. ACC. =  F9.6,11H AT TIME = F6.3, 5H SEC. /)
   2005 FORMAT(/26H   MEAN SQUARE FREQUENCY = F10.2/)
   2006 FORMAT(21X,6HXMAX= F7.4,5A6)
   2008 FORMAT(2X, I5, 5X, 8F15.6)
   2009 FORMAT(8F9.6,I7)
   2019 FORMAT(8F14.6,I10)
        END
  C**************************************
        SUBROUTINE REDUCE(IFR,X,AX,LL)
  C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  C   THIS ROUTINE INCREASES TIME INTERVAL AND REDUCES NUMBER OF VALUES
  C
  
negative.code: C   modified to increase number of sublayers to 50
  C   February 1991
  C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
        complex G, V, PLUS, MINUS
        complex E, F, EE, FF, A, EX, AIN, IPI2,AA
        character*60 ABSIS
        character*6 ID,IDNT,IDAMP
  C
        dimension IDAMP (27,11),T(200)
        common /JOE4/ ST(27,200)
        common /SOILA/ IDNT(6),BL(51),GL(51),FACT(51),H(51),R(51),BF(51)
        common /CSOIL/ G(51), V(51), PLUS(51), MINUS(51)
        common /CCG/ ID(27,11)
  C
        ABSIS = ' CYCLES/SEC. '
  C
        IPI2 = CMPLX(0., 6.283185307)
        FREQ = 0.
        ST(NA,1) = 1.
        do 19 I = 2,200
        E = 1.
        FF = 1.
        FREQ = FREQ + DF
        A = FREQ*IPI2
        do 191 K = 1,N1
        if (K.NE.IN) go to 192
        AIN = E + FF
        if (INT.EQ.0) AIN = 2.*E
    192 if (K.NE.LL) go to 11
        AA    = E + FF
        if (LT.EQ.0) AA = 2.*E
     11 EX = CEXP(H(K)*A/V(K))
        EE = E*EX
        F = FF/EX
        E = EE*PLUS(K) + MINUS(K)*F
        FF = PLUS(K)*F + MINUS(K)*EE
    191 continue
        if (IN.NE.N1+1) go to 193
        AIN = E + FF
        if (INT.EQ.0) AIN = 2.*E
    193 if (LL   .NE.N1+1) go to 21
        AA    = E + FF
        if (LT.EQ.0)  AA = 2.*E
     21 ST(NA,I) = CABS(AA/AIN)
     19 continue
        do 23 I = 1,200
     23 T(I) = DF*FLOAT(I-1)
        AMAX = 0.
        write(6,2)
        do 22 I = 1,200
        if (KPL .GE. 2) write(6,1) T(I), ST(NA,I)
        if (ST(NA,I) .LT.  AMAX) go to 22
        TMAX = T(I)
        AMAX = ST(NA,I)
     22 continue
        if (NA.LT.9) NA=NA+1
        PERIOD = 1./TMAX
        if (TMAX.LT. .0001)  write(6,1001) AMAX, TMAX
        if (TMAX.GT. .0001)  write(6,1001) AMAX, TMAX,PERIOD
        if (KPL.EQ.0) return
        write(6,1000)
        N = NA-1
        NA = 1
        return
      1 format(1X,F10.4, 3X, F10.4)
      2 format(/2X,'FREQUENCY    AMPLITUDE')
   1000 format(33H1  PLOT OF AMPLIFICATION SPECTRA  /)
   1001 format(25H MAXIMUM AMPLIFICATION =   F6.2/
       1 25H FOR FREQUENCY         = F6.2, 7H C/SEC. /
       1 25H     PERIOD            =  F6.2, 5H SEC. )
        end
  C******************************************
        subroutine UTPR(KK,DPTH,LS,K2,LH,LT,X,AX,S,INV)
  C***********************************************************************
  C
  C   THIS ROUTINE TRANSFERS THE VALUES IN AX(LH, ) INTO THE TIME DOMAIN
  