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: C   MODIFIED PBS AUG. 1971
  C   modified to increase number of layers to 50
  C***********************************************************************
        CHARACTER*6 TITLE,IDNT
        COMPLEX SAVE
        COMPLEX X, AX
  C
        DIMENSION XR(8)
        DIMENSION X(300),AX(3,270),S(70),INV(70)
        COMMON /SOILA/ IDNT(6),BL(51),GL(51),FACT(51),H(51),R(51),BF(51)
        COMMON /EQ/ MFOLD,MA2,TITLE(5),DT, MA , MMA, DF,MX
  C
        FREQ = 0.
        SFX = 0.
        SXX = 0.
  C   TRANSFORM VALUES IN X OR IN AX INTO THE TIME DOMAIN
        DO 24  I = 1,MFOLD
        IF (LS.EQ.0) GO TO 241
        SAVE = X(I)
        X(I) = AX(LS,I)
        AX(LS,I) = SAVE
  
negative.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
  