      SUBROUTINE FRRD2
C
C     AEROELASTIC FREQUENCY RESPONSE SOLUTION MODULE
C
C     INPUTS      KHH,BHH,MHH,QHHL,PHF,FOL
C
C     OUTPUT      UHVF
C
C     SCRATCHES   NINE
C
C     PARAMETERS    BOV - REAL - INPUT
C                   Q   - REAL - INPUT
C                   M   - REAL - INPUT
C
C     COMMON FRD2BC WILL BE USED BY ROUTINES FRD2B AND FRD2C.
C
      INTEGER         BHH,QHHL,PHF,FOL,UHVF,
     1                SCR1,SCR2,SCR3,SCR4,SCR5,SCR6,SCR7,SCR8,SCR9,
     2                SYSBUF,IZ(1),MCB(7),NAME(2),PASS,ITAB(5)
      REAL            M,ZZZ(1)
      COMPLEX         A1,A2,A3,A4,A5
      COMMON /CONDAS/ PHI,TWOPI
      COMMON /FRRDST/ OVF(150),ICNT,IFRST
      COMMON /BLANK / BOV,Q,M
      COMMON /SYSTEM/ SYSBUF
      COMMON /CDCMPX/ DUMM32(32),IB
      COMMON /FRD2BC/ IH,IPFRDC
      COMMON /ZZZZZZ/ Z(1)
      EQUIVALENCE     (ZZZ(1),Z(1))
      EQUIVALENCE     (IZ(1) ,Z(1))
      DATA    KHH ,BHH ,MHH ,QHHL,PHF ,FOL, UHVF/
     1        101 ,102 ,103 ,104 ,105 ,106, 201 /
      DATA    SCR1,SCR2,SCR3,SCR4,SCR5,SCR6,SCR7,SCR8,SCR9/
     1        301 ,302 ,303 ,304 ,305 ,306 ,307 ,308 ,309 /
      DATA    NAME  / 4HFRRD,4H2   /
C     DATA    PASS  / 0 /
C
C     SETUP
C
      SCR9   = 309
      PASS   = 0
      IB     = 0
      IH     = 0
      IPFRDC = 0
      NZ     = KORSZ(Z)
      IBUF1  = NZ - SYSBUF - 1
      NZ     = NZ - SYSBUF
      NONCUP = 1
      MCB(1) = QHHL
      CALL RDTRL (MCB)
      IF (MCB(1).LE.0 .OR. Q.EQ.0.0) NONCUP = -1
C
C     IF QHHL IS PURGED AND MACH NUMBER IS NEGATIVE, THE COUPLED EQU.
C     (-M*W**2 + IW*B + K)*U = P IS SOLVED. COMPLEX D.P. IS USED.
C     THE VARIABLE IH WILL BE USED TO CONTROL SOLUTION LOGIC IN
C     ROUTINES FRRD2, FRD2B AND FRD2C.
C
      IF (MCB(1).LE.0 .AND. M.LT.0.0) NONCUP = 1
C
      MCB(1) = PHF
      CALL RDTRL (MCB)
      I = PHF
      IF (MCB(1) .LT. 0) GO TO 920
      I = FOL
      CALL OPEN (*920,FOL,IZ(IBUF1),0)
      CALL READ (*910,*10,FOL,IZ,2,0,NFREQ)
      CALL READ (*910,*10,FOL,IZ,NZ,0,NFREQ)
      CALL MESAGE (-8,0,NAME)
   10 CONTINUE
      CALL CLOSE (FOL,1)
      NLOAD = MCB(2)/NFREQ
      IF (NONCUP .EQ. -1) GO TO 200
      IF (NFREQ.EQ.1 .OR. NLOAD.EQ.1) SCR9 = UHVF
      ICNT  = 0
      IFRST = 0
C
C     BUILD INTERPOLATION MATRIX - ON SCR1
C
      CALL FRD2I (IZ(1),NFREQ,NZ+SYSBUF,QHHL,SCR1,SCR2,SCR3,SCR4,IH)
      NTO  = 0
      IHH  = MCB(3)
      ICOR = KORSZ(ZZZ) - 6*SYSBUF - 3
      NCORE= 2*(IH*IH + 2*(IHH*NLOAD)) + 50
      ICOR = ICOR - NCORE
C
C     IF IH = 0, COMPLEX D.P. COMPUTATION WILL BE USED.  NOTICE THAT THE
C     ROUTINE INCORE IS WRITTEN ONLY FOR COMPLEX S.P. OPERATION.
C
      IF (IH.EQ.0 .OR. ICOR.LT.500) GO TO 20
      NTO     = 1
      ITAB(1) = MHH
      ITAB(2) = BHH
      ITAB(3) = KHH
      ITAB(4) = PHF
      ITAB(5) = SCR1
      IHH     = 4
      IF (IH .NE. 0) IHH = 5
      CALL OPEN  (*21,MHH,IZ(IBUF1),0)
   21 CALL CLOSE (MHH,1)
      CALL OPEN  (*22,BHH,IZ(IBUF1),0)
   22 CALL CLOSE (BHH,1)
      CALL OPEN  (*23,KHH,IZ(IBUF1),0)
   23 CALL CLOSE (KHH,1)
      CALL OPEN  (*24,PHF,IZ(IBUF1),0)
   24 CALL CLOSE (PHF,1)
   20 CONTINUE
C
C     LOOP ON FREQUENCY
C
      DO 40 I = 1,NFREQ
C
C     PICK UP FREQUENCY
C
      IF (I .LE. ICNT+IFRST-1) GO TO 30
      CALL GOPEN  (FOL,IZ(IBUF1),0)
      CALL BCKREC (FOL)
      CALL FREAD  (FOL,OVF,-(I-1)-2,0)
      ICNT = MIN0(150,NFREQ-I+1)
      CALL FREAD (FOL,OVF,ICNT,0)
      IFRST = I
      CALL CLOSE (FOL,1)
   30 CONTINUE
      K = I - IFRST + 1
      W = OVF(K)*TWOPI
      IF (IH .EQ. 0) GO TO 35
C
C     INTERPOLATE QHHL
C
      CALL FRD2A (SCR1,SCR2,SCR3,IH,I)
      GO TO 38
   35 CONTINUE
C
C     CREATE NULL TRAILERS FOR SCR2 (QHR) AND SCR3 (QHI) IF IH = 0.
C     (THESE DATA BLOCKS ARE NORMALLY GENERATED BY FRD2A IF IH .NE. 0.
C     SINCE FRD2A IS NOT EXECUTED WHEN IH = 0, AND SINCE SCR2 AND SCR3
C     ARE ALSO USED BY FRD2C, WE NEED TO CLEAR THE TRAILERS.)
C
      CALL MAKMCB (MCB,SCR2,0,0,0)
      CALL WRTTRL (MCB)
      MCB(1) = SCR3
      CALL WRTTRL (MCB)
C
   38 CONTINUE
C
C     FOR DYNAMIC MATRIX
C
      A1 = CMPLX(-W*W,0.0)
      A2 = CMPLX(0.0,W)
      A3 = CMPLX(0.0,-W*Q*BOV)
      A4 = CMPLX(1.0,0.0)
      A5 = CMPLX(-Q,0.0)
      CALL FRD2B (MHH,A1,BHH,A2,SCR3,A3,KHH,A4,SCR2,A5,SCR4)
C
C     DECOMPOSE SCR4 AND SOLVE
C
      CALL FRD2C (SCR4,PHF,SCR7,SCR2,SCR3,SCR5,SCR6,SCR8,NLOAD,I)
C
C     COPY TO TEMPORARY UHVF
C
      CALL FRD2D (SCR7,SCR9,PASS)
      PASS = PASS + 1
   40 CONTINUE
      IF (NFREQ.EQ.1 .OR. NLOAD.EQ.1) GO TO 100
      CALL FRD2E (SCR9,UHVF,NLOAD,NFREQ)
C
C     FORM FINAL ANSWER
C
  100 RETURN
C
C     UNCOUPLED MODAL
C
  200 CONTINUE
C
C     THE FREQUENCIES FOL (ALREADY IN IZ ARRAY) IS CONVERTED FROM CPS
C     TO RADIAN UNITS (FRL), AND SAVED IN SCR1.  NO TRAILER NEEDED.
C
      CALL GOPEN (SCR1,IZ(IBUF1),1)
      DO 210 I = 1,NFREQ
      Z(I) = Z(I)*TWOPI
  210 CONTINUE
      CALL WRITE (SCR1,Z,NFREQ,1)
      CALL CLOSE (SCR1,1)
      CALL FRD2F (MHH,BHH,KHH,SCR1,1,NLOAD,NFREQ,PHF,UHVF)
      GO TO 100
  910 CALL MESAGE (-3,FOL,NAME)
  920 CALL MESAGE (-1,I,NAME)
      RETURN
      END
