C
C *** HASKELL'S MATRIX FROM THE (N-1) BOUNDARY TO THE LL LAYER FOR R WAVE ***
C
      SUBROUTINE FRA2(AA,LL,DEP,CV,WN,DNS,VP,VS,THK,ML,NL)
C
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION DNS(ML),THK(ML),VP(ML),VS(ML)
      COMPLEX*16 AA(4,4),SA(4,4),SB(4,4)
C
      WN2=WN*WN
      CV2=CV*CV
C
      DO 100 I=1,4
        DO 110 J=1,4
          AA(I,J) =(0.0D0,0.0D0)
  110   CONTINUE
        AA(I,I)=(1.0D0,0.0D0)
  100 CONTINUE
C
      DO 200 IL=NL-1,LL,-1
C
        DO 210 I=1,4
          DO 220 J=1,4
            SA(I,J)=AA(I,J)
  220     CONTINUE
  210   CONTINUE
C
C    ** CQ,STQ,SDQ,CP,STP AND SDP **
C
        BM=VS(IL)
        CB2=CV2/(BM*BM)
        AM=VP(IL)
        CA2=CV2/(AM*AM)
        IF(IL.EQ.LL)THEN
          CALL CSTD(WN,BM,CV,CB2,THK(IL)-DEP,CQ,STQ,SDQ)
          CALL CSTD(WN,AM,CV,CA2,THK(IL)-DEP,CP,STP,SDP)
        ELSE
          CALL CSTD(WN,BM,CV,CB2,THK(IL),CQ,STQ,SDQ)
          CALL CSTD(WN,AM,CV,CA2,THK(IL),CP,STP,SDP)
        END IF
C
C    ** HASKELL'S SUB MATRIX **
C
        CALL FRSB(DNS(IL),CB2,CV,CQ,STQ,SDQ,CP,STP,SDP,SB)
C
C    ** AA MATRIX **
C
        DO 250 I=1,4
          DO 260 J=1,4
            AA(I,J)=(0.D0,0.D0)
            DO 270 K=1,4
              AA(I,J)=AA(I,J)+SA(I,K)*SB(K,J)
  270       CONTINUE
  260     CONTINUE
  250   CONTINUE
C
  200 CONTINUE
C
      RETURN
      END
