
      SUBROUTINE AGENR(BOAK,SB,A)
!
!***  GENERATES COEFFICIENTS FOR G/DELTA CALCULATIONS BY GDELTA
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD, kand
      DIMENSION F1(4),F2(4),F3(4),F4(4),BOCO16(4),BOAK(4)
      DIMENSION A(16),AL(16),C1(16),C2(16),C3(4)
      DATA C1 /-.07612,.00001  ,.21677,.54120  , -.29289,-.21677,.00001 &
     &     ,.32443 , -.61732,-.54120,-.32443,.00001  ,                  &
     &     -1.0,-.92388,-.70711,-.38267/
      DATA C2/1.92388,1.84776,1.63099,1.30656 , 1.70711,1.63099,1.41422,&
     &        1.08979 , 1.38268,1.30655,1.08979,.76536 ,                &
     &         1.0,.92388,.70711,.38267/
      DATA F1 /5.2262,1.0360,0.,.11208/
      DATA F2 /1.91433,2.8284,.91418,0.0/
      DATA F3 /0.0,1.1944,2.1634,1.5772/
      DATA F4 /.14645,0.0,.85357,2.0/
      DATA C3 /.92388,.70711,.38268,.00001 /
!
      K=1
      KP=0
      TANSB=TAN(DEG*SB)
      DO 1010 I=1,16
         IF(KP.EQ.K)GO TO 1000
         KP=K
         BOCH=BOAK(K)
         BOCO16(K)=-BOCH/16.
         RCPLBC=1.0/BOCH
         BOC2=BOCH**2
         BOCTN=BOCH  *TANSB
         TBOCTN=2.0*BOCTN
         DENOM=1.+C3(K)*TBOCTN
 1000    TMP=(1.+C1(I)*BOCTN)**2
         AL(I)=RCPLBC/C1(I)*(SQRT(TMP+BOC2*(C1(I)**2))-1.)              &
     &         -RCPLBC/C2(I)*(SQRT(TMP+BOC2*(C2(I)**2))/DENOM-1.0)      &
     &         -2.*TANSB*SQRT((1.+C3(K)*BOCTN)**2+BOC2*(C3(K)**2))/DENOM
         IF(4*(I/4).EQ.I)K=K+1
 1010 END DO
!
      K=1
      L=1
      DO 1020 I=1,4
         FST=-2.*F1(I)
         IF(I.EQ.1)FST=-FST
         A(L)=FST+BOCO16(I)*(2.6131*AL(K)+2.*(-.70711*AL(K+1)-.76537*   &
     &        AL(K+2)+.20711*AL(K+3)))
         L=L+1
         FST=-2.*F2(I)
         IF(I.EQ.2)FST=-FST
         A(L)=FST+BOCO16(I)*(-1.4142*AL(K)+2.*(1.8478*AL(K+1)-.50000*   &
     &   AL(K+2)-.76537*AL(K+3)))
         L=L+1
         FST=-2.*F3(I)
         IF(I.EQ.3)FST=-FST
         A(L)=FST+BOCO16(I)*(1.0824*AL(K)+2.*(-1.2071*AL(K+1)+1.8478    &
     &       *AL(K+2)-.70711*AL(K+3)))
         L=L+1
         FST=-2.*F4(I)
         IF(I.EQ.4)FST=-FST
         A(L)=FST+BOCO16(I)*(-.5*AL(K)+1.0824*AL(K+1)-1.4142*AL(K+2)    &
     &        +2.6131*AL(K+3))
         L=L+1
 1020    K=L
      RETURN
      END

      SUBROUTINE AIRFOL
!
!  CALCULATE NACA DESIGNATED AIRFOIL COORDINATES
!
      COMMON /IBODY/ PB,NACA(80),dum1(320)
      COMMON /IWING/ PW, X(60), dum13(340)
      COMMON / IHT / PHT, XU(60),XL(60), dum3(260)
      COMMON / IVT / PVT, YUN(60),YLN(60), dum4(260)
      COMMON / IBW / PBW,L,I,J,K,II,JJ,KK,III,JJJ,KKK,LLL, dum5(369)
      COMMON / IBH / PBH, THN(60),CAM(60), dum6(260)
      COMMON /IBWHV/ PBWHV, RHO,TMAX
      COMMON /FLOLOG/ DUM(29),PART
      LOGICAL DUM,PART
      INTEGER A4HW,A4HH,A4HV,A4HF
!!!      CHARACTER*4 A4HW,A4HH,A4HV,A4HF
      DIMENSION THN2(60)
      DATA A4HW,A4HH,A4HV,A4HF/4HW   ,4HH   ,4HV   ,4HF   /
!
!  DECODE THE USERS INPUT NACA DESIGNATION
!
      CALL DECODE(NACA,NA)
!
!  CALCULATE THE AIRFOIL COORDINATES
!
      IF(PART)WRITE(6,1100)
      IF(PART .AND. NACA(6).EQ.A4HW)WRITE(6,1230)
      IF(PART .AND. NACA(6).EQ.A4HH)WRITE(6,1240)
      IF(PART .AND. NACA(6).EQ.A4HV)WRITE(6,1250)
      IF(PART .AND. NACA(6).EQ.A4HF)WRITE(6,1260)
!
      GO TO (1000,1010,1020,1030,1040,1050,1060), NA
!
 1000 IF(PART)WRITE(6,1110)I,J,K,II
!
!**  CALCULATE NACA 4-DIGIT AIRFOIL COORDINATES
!
      CALL COORD4
      GO TO 1080
 1010 IF(PART)WRITE(6,1120)I,J,K,II,KK,III
!
!**  CALCULATE NACA MODIFIED 4-DIGIT AIRFOIL COORDINATES
!
      CALL CORD4M
      GO TO 1080
 1020 IF(PART)WRITE(6,1130)I,J,K,II,JJ
!
!**  CALCULATE NACA 5-DIGIT AIRFOIL COORDINATES
!
      CALL COORD5
      GO TO 1080
 1030 IF(PART)WRITE(6,1140)I,J,K,II,JJ,III,JJJ
!
!**  CALCULATE NACA MODIFIED 5-DIGIT AIRFOIL COORDINATES
!
      CALL CORD5M
      GO TO 1080
 1040 IF(PART)WRITE(6,1150)I,J,II,JJ,KK
!
!**  CALCULATE NACA 1-SERIES AIRFOIL COORDINATES
!
      CALL COORD1
      GO TO 1080
 1050 IF(PART .AND. (K .EQ. 0 .AND. II .EQ. 0))                         &
     &   WRITE(6,1160)I,J,JJ,KK,III
      IF(PART .AND. (K .NE. 0 .AND. II .EQ. 0))                         &
     &   WRITE(6,1170)I,J,K,JJ,KK,III
      IF(PART .AND. (K .EQ. 0 .AND. II .NE. 0))                         &
     &   WRITE(6,1180)I,J,JJ,KK,III
      IF(PART .AND. (K .NE. 0 .AND. II .NE. 0))                         &
     &   WRITE(6,1190)I,J,K,JJ,KK,III
      IF(PART .AND. (JJJ .GE. 1)) WRITE(6,1200)JJJ
!
!**  CALCULATE NACA 6-SERIES AIRFOIL COORDINATES
!
      CALL COORD6
      GO TO 1080
 1060 IF(I.NE.2)GO TO 1070
      J=5
      K=0
      II=0
 1070 IF(PART)WRITE(6,1270)I,J,K,II,JJ,KK,III,JJJ,KKK,LLL
!
!**   CALCULATE GEOMTRY FOR SUPERSONIC AIRFOILS
!
      CALL CORDSP
!
!**   CALCULATE AIRFIOL SECTION X Y COORDINATES OR THICKNESS/CAMBER
!               DISTRIBUTION
!
      CALL XYCORD(0,0)
 1080 IF(PART)WRITE(6,1210)
!
      DO 1090 M=1,L
         THN2(M)=2.*THN(M)
 1090 END DO
      IF(PART)WRITE(6,1220)(XU(M),YUN(M),XL(M),YLN(M),X(M),CAM(M),      &
     &              THN2(M),M=1,L)
      RETURN
!
 1100 FORMAT(1H1,29X,75HAUTOMATED STABILITY AND CONTROL METHODS PER APRI&
     &L 1976 VERSION OF DATCOM     )
 1110 FORMAT(1H ,62X,6H NACA ,4I1)
 1120 FORMAT(1H ,60X,6H NACA ,4I1,3H - ,2I1)
 1130 FORMAT(1H ,62X,6H NACA ,5I1)
 1140 FORMAT(1H ,60X,6H NACA ,5I1,3H - ,2I1)
 1150 FORMAT(1H ,61X,6H NACA ,2I1,3H - ,3I1)
 1160 FORMAT(1H ,62X,6H NACA ,2I1,1H-,3I1)
 1170 FORMAT(1H ,60X,6H NACA ,2I1,1H,,I1,1H-,3I1)
 1180 FORMAT(1H ,61X,6H NACA ,2I1,1HA,3I1)
 1190 FORMAT(1H ,60X,6H NACA ,2I1,1H,,I1,1HA,3I1)
 1200 FORMAT(1H ,65X,4HA=0.,I1)
 1210 FORMAT(1H ,3X,15H UPPER ABSCISSA,4X,15H UPPER ORDINATE,4X,        &
     &              15H LOWER ABSCISSA,4X,15H LOWER ORDINATE,6X,        &
     &              16HX-FRACTION CHORD,4X,9HMEAN LINE,4X,9HTHICKNESS)
 1220 FORMAT(8X,F8.5,11X,F8.5,10X,F8.5,10X,F8.5,13X,F8.5,10X,           &
     &       F8.5,6X,F8.5)
 1230 FORMAT(1H ,55X,23HWING SECTION DEFINITION)
 1240 FORMAT(1H ,50X,34HHORIZONTAL TAIL SECTION DEFINITION)
 1250 FORMAT(1H ,51X,32HVERTICAL TAIL SECTION DEFINITION)
 1260 FORMAT(1H ,52X,30HVENTRAL FIN SECTION DEFINITION )
 1270 FORMAT(1H ,54X,8H NACA S-,I1,1H-,2I1,1H.,I1,1H-,2I1,1H.,I1,       &
     & 1H-,2I1,1H.,I1)
      END

! following routine now CONTAINED in OUTPT4
! RLC  23Dec97

!!!      SUBROUTINE ALDLPR(ALPHA,DELTA,VAR,NALPHA,NDELTA)
!!!C
!!!      DIMENSION VAR(200),ALPHA(20),DELTA(10)
!!!      DIMENSION VFOR(23),VFS(3)
!!!      EQUIVALENCE (VFOR(1),VFS(1))
!!!      CHARACTER*4 VAR,VFOR,BLANK,VFS,E9P2,C1XC,RP,RP1,RP2,RP3
!!!      DATA BLANK/'    '/
!!!      DATA VFS /'(3X,','F5.1',',7X,'/
!!!      DATA E9P2/'E9.2'/
!!!      DATA C1XC/',1X,'/
!!!      DATA RP1/'6X,A'/
!!!      DATA RP2/'4,  '/
!!!      DATA RP /')   '/
!!!      DATA RP3/'4)  '/
!!! 1000 FORMAT(1H0,7X,8HDELTA =  ,F5.1,5X,F5.1,5X,F5.1,5X,F5.1,5X,F5.1,
!!!     1F5.1,5X,F5.1,5X,F5.1,5X,F5.1,5X,F5.1)
!!! 1010 FORMAT(3X,5HALPHA/1H0)
!!!C     ----BUILD FORMAT
!!!      K=4
!!!      DO 1020 I=1,10
!!!      VFOR(K)=E9P2
!!!      K=K+1
!!!      VFOR(K)=C1XC
!!! 1020 K=K+1
!!!      K=K-1
!!!      VFOR(K)=RP
!!!      WRITE(6,1000)(DELTA(I),I=1,NDELTA)
!!!      WRITE(6,1010)
!!!      JA=1
!!!      DO 1050 I=1,NALPHA
!!!      JN=JA+NDELTA-1
!!!      IF(I.GT.1)GO TO 1040
!!!C     ----LOGIC TO PRINT BLANKS *NOTE* COMPLETE COLUMN OF BLANKS ASSU
!!!      K=1
!!!      DO 1030 J=JA,JN
!!!      IF(VAR(J).NE.BLANK)GO TO 1030
!!!      II=2*(K-1)+4
!!!      VFOR(II)=RP1
!!!      VFOR(II+1)=RP2
!!!      IF(K.NE.10)GO TO 1030
!!!      VFOR(II+1)=RP3
!!! 1030 K=K+1
!!! 1040 WRITE(6,VFOR) ALPHA(I),(VAR(J),J=JA,JN)
!!! 1050 JA=JA+10
!!!      RETURN
!!!      END


      FUNCTION ALI(Q,R,XST,XRT,XSLT)
!
!***  CPMPUTES VORTEX INTERFERENCE FACTORS
!
      DIMENSION AL(4)
      FF=R
      F=R
      H=Q
      DO 1030 MK=1,4
         AB=ALOG((H**2+(F-XST)**2)/(H**2+(F-XRT)**2))
!
!     ----MUST TEST FOR H=0.
!
         IF(H.NE.0.0) GO TO 1000
         BB=XST-XRT
         GO TO 1010
 1000    FST=(F-XST)/H
         FRT=(F-XRT)/H
         BB=(FST/ABS(FST))*H*ATAN(ABS(FST))
         BB=BB-(FRT/ABS(FRT))*H*ATAN(ABS(FRT))+(XST-XRT)
 1010    AL(MK)=((XST-XRT*XSLT)-F*(1.0-XSLT))/(2.*(XST-XRT))
         AL(MK)=AL(MK)*AB-((1.0-XSLT)/(XST-XRT))*BB
         F=-F
         IF(MK-2)1030,1020,1030
 1020    RT2=XRT*XRT
         H2=H*H
         F=(F*RT2)/((F**2)+H2)
         H=(H*RT2)/((FF**2)+H2)
 1030 END DO
      ALI=2.0/(1.+XSLT)*(AL(1)-AL(2)-AL(3)+AL(4))
!
      RETURN
      END
      SUBROUTINE ANGDET(MACH,DELEFF)
!
!  SUBROUTINE TO DETERMINE THE EFFECTIVE WEDGE TURN ANGLE
!  (ALPHA + DELTA) IN WHICH THE SHOCK WILL BECOME DETACHED
!
      REAL MACH
      DATA GAM / 1.4 /
!
!  COMPUTE THE SHOCK ANGLE AT DELTA-MAX, NACA TR 1135 EQN 168
!
      SIN2TM=((1.+GAM)*MACH**2-4.+SQRT((GAM+1.)*((GAM+1.)*MACH**4       &
     &       +8.*(GAM-1.)*MACH**2+16.)))/(4.*GAM*MACH**2)
      TDM=ARCSIN(SQRT(SIN2TM))
!
!  USE THIS ANGLE IN EQN 138
!
      COTD=TAN(TDM)*(((GAM+1.)*MACH**2)/(2.*(MACH**2*(SIN(TDM))**2      &
     &     -1.))-1.)
      DELEFF=ATAN(1./COTD)
      RETURN
      END
      SUBROUTINE   ANGLES(INTRY,ARG)
!
!        A ROUTINE TO COMPUTE THE FOLLOWING ELEMENTS OF AN ANGLE,
!        GIVEN ANY OF THEM.  INTERNAL TESTING IS DONE TO PRECLUDE
!        RECALCULATION OF ANY OR ALL KNOWN ELEMENTS.
!        ARG(1)---ANGLE IN DEGREES
!        ARG(2)---ANGLE IN RADIANS
!        ARG(3)---SINE OF THE ANGLE
!        ARG(4)---COSINE OF THE ANGLE
!        ARG(5)---TANGENT OF THE ANGLE
!        ARG(6)---TEST VALUE (SET INTERNALLY)
!        ROUTINES CALLED --- ABS,DABS,DATAN2,
!                            DCOS,DMOD,DSIGN,
!                            DSIN,DSQRT,IABS
!        SINGLE PRECISION --- NO STOPS
!
      REAL         ARG(6), C, S, T
      DATA         CON/1.74532925199433E-2/, HPI/1.57079632679489E+0/,  &
     &             OPI/3.14159265358979E+0/, TPI/6.28318530717959E+0/,  &
     &             EPS/1.52587890625000E-5/, SPE/1.04857600000000E+6/,  &
     &             ZER/0.E+0/, ONE/1.E+0/
!
      I=IABS(INTRY)
      ASSIGN 1050 TO J
      GO TO (1020,1030,1080,1100,1120,1140), I
 1000 DO 1010 I=1,6
 1010 ARG(I)=ZER
      ARG(4)=ONE
!
      RETURN
!
 1020 A2=ARG(1)*CON
      GO TO 1040
 1030 A2=ARG(2)
 1040 A2=AMOD(A2+TPI,TPI)
      IF(A2.GT.OPI) A2=A2-TPI
      IF( ABS(A2-ARG(6)).LE.EPS) RETURN
      IF( ABS(A2).LE.EPS) GO TO 1000
      ARG(1)=A2/CON
      ARG(2)=A2
!
      GO TO J, (1050,1070)
!
 1050 ARG(3)= SIN(A2)
      IF(ABS(ARG(3)).LE.EPS) ARG(3)=ZER
      ARG(4)= COS(A2)
      IF(ABS(ARG(4)).GT.EPS) GO TO 1060
      ARG(4)=ZER
      ARG(5)= SIGN(SPE,A2)
      GO TO 1070
 1060 ARG(5)=ARG(3)/ARG(4)
 1070 ARG(6)=A2
!
      RETURN
!
 1080 A3=ARG(3)
 1090 IF( ABS(A3).LE.EPS) GO TO 1000
      IF( ABS(A3).GE.ONE-EPS) GO TO 1160
      A4= SQRT(ONE-A3**2)
      IF( ABS(A4-ARG(4)).LE.EPS.AND.A3*ARG(3).GE.ZER) RETURN
      GO TO 1150
 1100 A4=ARG(4)
 1110 IF( ABS(A4).GE.ONE-EPS) A4= SIGN(ONE,A4)
      A3= SQRT(ONE-A4**2)
      IF( ABS(A4).LE.EPS) GO TO 1160
      IF( ABS(A3-ARG(3)).LE.EPS.AND.A4*ARG(4).GE.ZER) RETURN
      GO TO 1150
 1120 A1=ARG(5)
 1130 IF( ABS(A1).GT.SPE) A1= SIGN(SPE,A1)
      A2=A1/ SQRT(ONE+A1**2)
      A3= SIGN(A2,A1)
      GO TO 1090
 1140 A3=ARG(3)
      A4=ARG(4)
      A1= SQRT(A3**2+A4**2)
      IF(A1.EQ.ZER) GO TO 1000
      A3=A3/A1
      A4=A4/A1
 1150 IF( ABS(A4).LE.EPS) GO TO 1160
      IF( ABS(A3).LE.EPS) A3=ZER
      A2= ATAN2(A3,A4)
      ARG(3)=A3
      ARG(4)=A4
      ARG(5)=A3/A4
      ASSIGN 1070 TO J
      GO TO 1040
 1160 A2= SIGN(HPI,A3)
      ARG(3)= SIGN(ONE,A3)
      ARG(4)=ZER
      ARG(5)= SIGN(SPE,A3)
      ASSIGN 1070 TO J
      GO TO 1040
      END
      FUNCTION ARCCOS(A)
!
!     -----USED TO FIND ARCCOS USING STANDARD FORTRAN ONLY.
!
      COMMON/CONSNT/ PI,deg,unused,rad,kand
      IF(A.EQ.0.0)GO TO 1030
      IF(ABS(A).LE.1.0)GO TO 1000
!
!     ----IF HERE USE THE INVERSE COSH IF A .GT. 1.0
!
      X=ALOG(ABS(A+SQRT(A**2-1.)))
      GO TO 1010
 1000 X=ATAN(SQRT(1.-A**2)/A)
      IF(X.LT.0.0)GO TO 1020
 1010 ARCCOS=X
      RETURN
 1020 X=PI+X
      GO TO 1010
 1030 X=PI/2.
      GO TO 1010
      END
      SUBROUTINE ARCLSS(A)
!
!     ----CLASSIFIES ASPECT RATIO
!
      DIMENSION ROUTID(2)
      DIMENSION Q3417B(3)
      DIMENSION X(11),Y(11),C(6),A(195)
      DATA ROUTID /4HARCL,4HSS  /
      DATA Q3417B /4H4.1.,4H3.4-,4H24B /
      DATA X /0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
      DATA Y /0.,.225,.47,.496,.43,.32,.21,.125,.075,.0475,.0/
      DATA IN /0/
      DATA NP /11/
!
!     ----FIGURE 4.1.3.4-24B
!
      CALL TBFUNX(A(27),A(123),DYDX,NP,X,Y,C,IN,MI,NG,                  &
     &            0,0,Q3417B,3,ROUTID)
      CALL ANGLES(1,A(34))
      A(124)=(A(123)+1.)*A(37)
      A(125)=A(128)/A(124)
      RETURN
      END
      FUNCTION ARCSIN(A)
!
!     ----TAKES ARCSIN OF ARGUMENT USING STANDARD FORTRAN.
!
      COMMON/CONSNT/ PI,deg,unused,rad,kand
      IF(ABS(A).EQ.1.)GO TO 1020
      IF(ABS(A).GT.1.0)GO TO 1000
      ARCSIN=ATAN(A/SQRT(1.-A**2))
      RETURN
 1000 WRITE(6,1010)A
      ARCSIN=1000.
 1010 FORMAT(17H0ERROR-ARCSIN OF ,E12.5)
      GO TO 1030
 1020 ARCSIN=PI/2.*A/ABS(A)
      RETURN
 1030 CONTINUE
      RETURN
      END
      SUBROUTINE AREA1 (X,Y,AREA,NSUM)
!
!***  CALCULATES INCREMEMTAL AREA OF VERTICAL TAIL SHADOWED BY MACH LINE
!
      DIMENSION X(4),Y(4)
      AREA2=0.
      A=SQRT((X(2)-X(1))**2+(Y(2)-Y(1))**2)
      B=SQRT((X(3)-X(2))**2+(Y(3)-Y(2))**2)
      C=SQRT((X(1)-X(3))**2+(Y(1)-Y(3))**2)
      S=(A+B+C)/2.
      AREA=SQRT(S*(S-A)*(S-B)*(S-C))
      IF(NSUM.NE.4.AND.NSUM.NE.6) GO TO 40
      A2=SQRT((X(4)-X(3))**2+(Y(4)-Y(3))**2)
      B2=SQRT((X(1)-X(4))**2+(Y(1)-Y(4))**2)
      S2=(A2+B2+C)/2.
      AREA2=SQRT(S2*(S2-A2)*(S2-B2)*(S2-C))
   40 AREA=AREA+AREA2
      RETURN
      END
      SUBROUTINE AREA2(X,Y,AREA,INUM,AX,AY)
!
!***  CALCULATES INCREMENTAL AREA OF BODY SHADOWED BY MACH LINE
!
      DIMENSION X(4),Y(4)
!
!**** HERE FOR TRIANGLE OF TYPE 1 ****
!
      A=SQRT((X(2)-X(1))**2+(Y(2)-Y(1))**2)
      B=SQRT((X(3)-X(2))**2+(Y(3)-Y(2))**2)
      C=SQRT((X(1)-X(3))**2+(Y(1)-Y(3))**2)
      S=(A+B+C)/2.
      AREA=SQRT(S*(S-A)*(S-B)*(S-C))
      X1=(X(1)+X(2))/2.
      Y1=(Y(1)+Y(2))/2.
      X2=(X(1)+X(3))/2.
      Y2=(Y(1)+Y(3))/2.
      DNUM1=(Y(3)-Y1)/(X(3)-X1)
      DNUM2=(Y2-Y(2))/(X2-X(2))
      ANUM1=DNUM1*X1-Y1
      ANUM2=DNUM2*X(2)-Y(2)
      XBAR=(ANUM1-ANUM2)/(DNUM1-DNUM2)
      YBAR=(XBAR-X1)*DNUM1+Y1
      AX=AREA*XBAR
      AY=AREA*YBAR
      IF(INUM.EQ.3) GO TO 70
   30 A2=SQRT((X(4)-X(3))**2+(Y(4)-Y(3))**2)
!
!**** HERE FOR TRIANGLE OF TYP2 1 ****
!
      B2=SQRT((X(1)-X(4))**2+(Y(1)-Y(4))**2)
      C2=SQRT((X(3)-X(1))**2+(Y(3)-Y(1))**2)
      S2=(A2+B2+C2)/2.
      AREA22=SQRT(S2*(S2-A2)*(S2-B2)*(S2-C2))
      YBAR2=Y(3)/3.
      XBAR2=(YBAR2-Y(1))*(X(3)-(X(1)+X(4))/2.)/(Y(3)-Y(1))+(X(1)+X(4))/2&
     &.
      AX2=AREA22*XBAR2
      AY2=AREA22*YBAR2
      AREA=AREA+AREA22
      AX=AX+AX2
      AY=AY+AY2
   70 CONTINUE
      RETURN
      END
      SUBROUTINE ASMINT (NPT,X,Y,NVAL,XVAL,YVAL)
!
!***  NON-LINEAR INTERPOLATION ROUTINE FOR AIRFOIL MODULE
!
      INTEGER RP
      DIMENSION X(1),Y(1),XVAL(1),YVAL(1),YP(2)
!
!   METHOD - SLOPES ARE DEFINED AT EACH DATA POINT AS A VALUE HALF WAY
!            BETWEEN THE LINEAR SLOPES TO THE RIGHT AND LEFT OF THE
!            POINT. A THIRD ORDER POLYNOMIAL IS DETERMINED FOR EACH
!            INTERVAL BETWEEN DATA POINTS BY USING THE TWO END POINTS
!            AND TWO END POINT SLOPES. SECOND ORDER POLYNOMIALS ARE
!            DETERMINED FOR THE LEFT AND RIGHT END INTERVALS (AND FOR
!            LEFT AND RIGHT EXTRAPOLATION) USING THE TWO END POINTS
!            AT EACH END OF THE DATA AND THE SLOPES AT THE NEXT-TO-THE
!            LAST DATA POINTS AT EACH END OF THE DATA. HENCE, THE OVER-
!            ALL CURVE CONSISTS OF A LEFT END PARABOLA JOINED TO A
!            SERIES OF JOINED CUBIC CURVES FINALLY JOINED TO A RIGHT
!            END PARABOLA. THE OVERALL CURVE IS CONTINUOUS EVERYWHERE,
!            HAS CONTINUOUS DERIVATIVES EVERYWHERE, AND CAN BE EXTRAP-
!            OLATED TO THE RIGHT AND LEFT INDEFINITELY.
!
!   NPT      NUMBER OF POINTS IN X AND Y ARRAYS
!   X        ABSCISSAS OF INPUT DATA
!   Y        ORDINATES OF INPUT DATA
!
!   NVAL     NUMBER OF POINTS TO BE INTERPOLATED
!   XVAL     ABSCISSA VALUES AT WHICH INTERPOLATION TO BE PERFORMED
!   YVAL     INTERPOLATED ORDINATE VALUES
!
      NP1= NPT-1
      NP2= NPT-2
      DO 1080 I=1,NVAL
         IF(XVAL(I).LT.X(2)) GO TO 1020
         IF(XVAL(I).GT.X(NP1)) GO TO 1030
            DO 1010 J=2,NP2
            IF(XVAL(I).NE.X(J)) GO TO 1000
            YVAL(I)= Y(J)
            GO TO 1080
 1000       K= J+1
            IF(XVAL(I).GE.X(K))GO TO 1010
            LOCATE= 2
            GO TO 1040
 1010    CONTINUE
         YVAL(I)= Y(K)
         GO TO 1080
 1020    J=2
         K=3
         LOCATE= 1
         GO TO 1040
 1030    J=NP1
         K=NPT
         LOCATE= 3
         GO TO 1040
 1040    DO 1050 N=1,2
            LP= J+N-2
            MP= J+N-1
            RP= K+N-1
            SL= (Y(LP)-Y(MP))/(X(LP)-X(MP))
            SR= (Y(MP)-Y(RP))/(X(MP)-X(RP))
            ANGL= ATAN(SL)
            ANGR= ATAN(SR)
            ANGAV=(ANGL+ANGR)/2.0
            YP(N)= SIN(ANGAV)/COS(ANGAV)
            GO TO (1070,1050,1070),LOCATE
 1050    CONTINUE
!
         X1S = X(J)*X(J)
         X2S = X(K)*X(K)
         X12F = X(J)-X(K)
         Y12F = Y(J)-Y(K)
         X12S = X1S-X2S
         X12C = X1S*X(J)-X2S*X(K)
         Y12P = YP(1)-YP(2)
!
         TW = 2.0
         TH = 3.0
         RED = TW*X(K)*X12F - X12S
         GRN = TH*X2S*X12F - X12C
         YEL = YP(2)*X12F-Y12F
         E = TH*X12S*RED - TW*X12F*GRN
         A = Y12P*RED - TW*X12F*YEL
         A = A/E
         B = TH*X12S*YEL - Y12P*GRN
         B = B/E
         C = (Y12F-A*X12C-B*X12S)/X12F
         D = Y(K)-A*X2S*X(K)-B*X2S-C*X(K)
!
 1060    YVAL(I)=(((A*XVAL(I) +B)*XVAL(I))+C)*XVAL(I)+D
         GO TO 1080
!
 1070    J=1
         IF(LOCATE.EQ.3) J=NP1
         K=J+1
         L=2
         IF(LOCATE.EQ.3) L=NP1
         Z=(Y(J)-Y(K))/(X(J)-X(K))
         A=0.0
         B=(YP(1)-Z)/(2.0*X(L)-X(J)-X(K))
         C=YP(1)-2.0*B*X(L)
         D=Y(J)-((B*X(J)+C)*X(J))
         GO TO 1060
 1080 END DO
      RETURN
      END
      SUBROUTINE ATMOS (A3,A8,A4)
!
!     THIS ROUTINE CALCULATES ATMOSPHERIC PROPERTIES OF THE
!     US STANDARD ATMOSPHERE,1962,ASSUMING AN INVERSE SQUARE
!     GRAVITATIONAL FIELD. THIS ASSUMPTION YIELDS DATA THAT
!     AGREES WITH THE COESA DOCUMENT WITHIN 1 PER CENT AT
!     ALL ALTITUDES UP TO 700 KILOMETERS (2296588 FEET). THE
!     DATA IS ARRANGED IN THE ATMOSPHERE ARRAY, A, AS
!     FOLLOWS
!     A(1) = CS, SPEED OF SOUND, FT/SEC
!     A(2) = (1/CS)(DCS/DZ), SOUND DERIVATIVE, 1/FT
!     A(3) = Z, GEOMETRIC ALTITUDE, FT
!     A(4) = P, PRESSURE, LB/FT2
!     A(5) = DP/DZ, PRESSURE DERIVATIVE, LB/FT3
!     A(6) = RHO, DENSITY, SLUGS/FT3
!     A(7) = (1/RHO)(DRHO/DZ), DENSITY DERIVATIVE, 1/FT
!     A(8) = T, TEMPERATURE, DEG RANKINE
!     A(9) = DT/DZ, TEMPERATURE DERIVATIVE, DEG RANKINE/FT
!
!     VARIOUS CONSTANTS USED
!      EARTH RADIUS                = 20890855 FT
!      SPECIFIC HEAT RATIO FOR AIR = 1.4
!     SEA LEVEL VALUES
!      GRAVITATIONAL ACCELERATION  = 32.1740484 FT/SEC2
!      MOLECULAR WEIGHT            = 28.9644
!      GO*MO/R*                    = 0.018743418 DEG RANK/FT
!
      DIMENSION  A( 9),HG(10),ZM(14),WM(14),TM(23),PM(22)
!
!     SET ARRAYS AND CONSTANT VALUES
      DATA G0,WM0,R0/32.1740484,28.9644,20890855.0/
      DATA GMRS/0.018743418/
      DATA HG/-16404.,0.0,36089.,65617.,104987.,154199.,170604.,        &
     &     200131.,250186.,291160./,ZM/295276.,328084.,                 &
     &     360892.,393701.,492126.,524934.,557743.,623360.,             &
     &     754593.,984252.,1312336.,1640420.,1968504.,                  &
     &     2296588./
      DATA WM/28.9644,28.88,28.56,                                      &
     &     28.07,26.92,26.66,26.4,25.85,24.7,22.66,19.94,               &
     &     17.94,16.84,16.17/
!
      DATA TM/577.17,518.67,389.97,389.97,411.57                        &
     &     ,487.17,487.17,454.77,325.17,325.17,379.17,469.17            &
     &     ,649.17,1729.17,1999.17,2179.17,2431.17,2791.17              &
     &     ,3295.17,3889.17,4357.17,4663.17,4861.17/
      DATA PM/3711.0839,2116.2165,472.67563,114.34314,                  &
     &     18.128355,2.3162178,1.2321972,3.8030279E-01,                 &
     &     2.1671352E-02,3.4313478E-03,6.2773411E-04,1.5349091E-04,     &
     &     5.2624212E-05,1.0561806E-05,7.7083076E-06,                   &
     &     5.8267151E-06,3.5159854E-06,1.4520255E-06,                   &
     &     3.9290563E-07,8.4030242E-08,2.2835256E-08,7.1875452E-09/
!
      A(3) = A3
!
!     CALCULATE G, Z, AND CHECK
!
 1000 Z = A(3)
      G = G0*(R0/(R0+Z))**2
      IF (Z .GT. 295276.0) GO TO 1040
!
!     TMS LINEAR WITH GEOPOTENTIAL. CALCULATE H AND SEARCH
!
      H     = R0*Z/(R0+Z)
      DO 1010 I= 2,10
         J     = I - 1
         IF (HG(I) .GE. H) GO TO 1020
 1010 END DO
!
!     CALCULATE TMS SLOPE,TMS, AND SET MOL WT STUFF
!
 1020 ELH   = (TM(J+1) - TM(J))/(HG(J+1) - HG(J))
      TMS   = TM(J) + ELH*(H - HG(J))
      ELZ   = ELH*G/G0
      DMDZ  = 0.0
      EM    = WM0
!
!     CHECK TMS SLOPE AND CALCULATE PRESSURE
!
      IF (ELH .EQ. 0.0) GO TO 1030
!
!     NON - ZERO SLOPE PRESSURE EQUATION
!
      A(4) = PM(J)*(TM(J)/TMS)**(GMRS/ELH)
      GO TO 1070
!
!     ZERO SLOPE PRESSURE EQUATION
!
 1030 A(4) = PM(J)*EXP(GMRS*(HG(J)-H)/TMS)
      GO TO 1070
!
!     TMS LINEAR WITH Z. SEARCH MATRIX
!
 1040 DO 1050 I = 2,14
         J      = I + 8
         K      = I - 1
         IF (ZM(I) .GE. Z) GO TO 1060
 1050 END DO
!
!     CALCULATE TMS, SLOPE, AND STUFF
!
 1060 ELZ  = (TM(J+1) - TM(J))/(ZM(K+1) - ZM(K))
      TMS  = TM(J) + ELZ*(Z - ZM(K))
      DMDZ = (WM(K+1) - WM(K))/(ZM(K+1) - ZM(K))
      EM = WM(K) + DMDZ*(Z - ZM(K))
      ZLZ  = Z - TMS/ELZ
!
!     PRESSURE EQUATION FOR TMS LINEAR WITH Z
!
      A(4) = PM(J)*EXP(GMRS/ELZ*(R0/(R0+ZLZ))**2*((Z-ZM(K))*            &
     &       (R0+ZLZ)/(R0+Z)/(R0+ZM(K)) - ALOG(TMS*(R0+ZM(K)            &
     &       )/TM(J)/(R0+Z))))
!
!     CALCULATE SOUND SPEED AND DERIVATIVE
!
 1070 A(1) = 49.022164*SQRT(TMS)
      A(2) = 0.5*ELZ/TMS
!
!     CALCULATE DENSITY, DERIVATIVE, AND PRESSURE DERIVATIVE
!
      A(6) = GMRS*A(4)/G0/TMS
      A(7) = - (A(6)*G/A(4) + ELZ/TMS)
      A(5) = -A(6)*G
!
!     CALCULATE TEMPERATURE, DERIVATIVE, AND LEAVE
!
      A(8) = EM*TMS/WM0
      A(9) = (EM*ELZ + TMS*DMDZ)/WM0
      A8 = A(8)
      A4 = A(4)
      A1 = A(1)
      A6 = A(6)
      RETURN
      END
      SUBROUTINE AUXOUT
!
!     WRITE AUXILIARY AND PARTIAL OUTPUTS
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K
      COMMON /IWING/  PWING, WING(400)
      COMMON /IHT/    PHT, HT(380)
      COMMON /IVT/    PVT, VT(380)
      COMMON /IVF/    PVF, VF(380)
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ SYNA(19)
      COMMON /POWR/   DYN(213)
      COMMON /WINGI/  WINGIN(100)
      COMMON /HTI/    HTIN(154)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /WINGD/  A(195)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /BDATA/  BD(762)
      COMMON /WHWB/   FACT(182), WB(39), HB(39)
      COMMON /WBHCAL/ WBT(156)
      COMMON /HTDATA/ AHT(195)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55), DVF(55)
      COMMON /SUPWBB/  SWB(61), SHB(61)
      COMMON /SUPBOD/ SBD(229)
      COMMON /SUPWH/  SLG(141), STG(141)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /CONSNT/ PI, DEG, UNUSED, RAD,kand
      COMMON /LEVEL2/ SECOND(23)
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),IDIM
!
      DIMENSION STP(155),FOR1(34),FOR2(26),ICON(8),JCON(6),FOR3(14)
      DIMENSION H(1),O(1),P(1),Q(1),R(1),S(1),T(1),ANONE(20),KCON(3)
      DIMENSION SLA(31),FOR3A(3)
      DIMENSION ICONT(11), FOR(46), OPT(4)
!
      EQUIVALENCE (OPT(1),SREF)
      EQUIVALENCE (WBT(1),STP(1))
      EQUIVALENCE (SLA(1),STB(1)),(DOL2,SECOND(16))
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL NN,NM,DOL2,SUPHYP
      DATA FOR   /    4H(   ,4H1H0 ,                                    &
     &  4H,0P ,4HF6.3,4H,1X ,4H,1X ,  4H,1X,,4HF8.2,4H,1X ,4H,1X ,      &
     &  4H,1X,,4HF8.2,4H,1X ,4H,2X ,  4H,1P ,4HE10.,4H4   ,4H,3X ,      &
     &  4H,0P ,4HF9.3,4H,1X ,4H,4X ,  4H,1P ,4HE10.,4H4   ,4H,9X ,      &
     &  4H,0P ,4HF9.3,4H,1X ,4H,1X ,  4H,1X,,4HF8.3,4H,1X ,4H    ,      &
     &  4H,1X,,4HF8.3,4H,1X ,4H    ,  4H,1X,,4HF8.3,4H,1X ,4H    ,      &
     &  4H,1X,,4HF8.3,4H,1X ,4H)   /
      DATA FOR1 /                                                       &
     & 4H(1H , 4H,10X, 4H,1X,, 4HE11.,                                  &
     & 4H4,1X, 4H,1X , 4H,1X,, 4HF6. ,                                  &
     & 4H2,1X, 4H,1X , 4H,1X,, 4HF5. ,                                  &
     & 4H2,1X, 4H,2X , 4H,1X,, 4HF9. ,                                  &
     & 4H4,1X, 4H,5X , 4H,1X,, 4HE11.,                                  &
     & 4H4,1X, 4H,1X , 4H,1X,, 4HE11.,                                  &
     & 4H4,1X, 4H,1X , 4H,1X,, 4HE11.,                                  &
     & 4H4,1X, 4H,3X , 4H,1X,, 4HE11.,                                  &
     & 4H4   , 4H)   /
      DATA FOR2 /                                                       &
     & 4H(1H , 4H,13X, 4H,1X,, 4HF7. ,                                  &
     & 4H3,1X, 4H,4X , 4H,1X,, 4HE11.,                                  &
     & 4H4,1X, 4H,4X , 4H,1X,, 4HE11.,                                  &
     & 4H4,1X, 4H,4X , 4H,1X,, 4HE11.,                                  &
     & 4H4,1X, 4H,4X , 4H,1X,, 4HE11.,                                  &
     & 4H4,1X, 4H,12X, 4H,1X,, 4HE11.,                                  &
     & 4H4   , 4H)   /
      DATA FOR3 /                                                       &
     & 4H(   , 4H44X , 4H,1X,, 4HF7. ,                                  &
     & 4H3,1X, 4H,5X , 4H,1X,, 4HE11.,                                  &
     & 4H4,1X, 4H,5X , 4H,1X,, 4HE11.,                                  &
     & 4H4   , 4H)   /
      DATA ICON / 13,7,7,11,4*13 /
      DATA JCON / 9,5*13 /
      DATA KCON / 9,2*13 /
      DATA ICONT / 7, 10*10 /
      DATA FOR3A/4HE11.,4H4,1X,4H,5X /
!
!                     WRITE AUXILIARY OUTPUTS
!
      NN = .FALSE.
      NM = .FALSE.
      SUPHYP = SUPERS .OR. HYPERS
      ANA = 2.*UNUSED
      DO 1000   J=1,NALPHA
 1000 ANONE(J) = ANA
      IF(BO) LAST=1
      IF(WGPL) LAST=2
      IF(HTPL) LAST=3
      IF(VTPL .OR. VFPL) LAST=4
      IF(BO .AND. WGPL) LAST=5
      IF(BO .AND. HTPL) LAST=6
      IF(BO .AND. (VTPL .OR. VFPL)) LAST=7
      IF(BO .AND. WGPL .AND. HTPL) LAST=8
      IF(BO .AND. WGPL .AND. (VTPL .OR. VFPL)) LAST=9
      IF(BO .AND. WGPL .AND. HTPL .AND. (VTPL .OR. VFPL)) LAST=10
      WRITE(6,1550 )
      WRITE(6,1560 )
      GO TO (1010  ,1020  ,1030  ,1040  ,1050  ,1060  ,1070  ,1080  ,109&
     &0 ,1100 ), LAST
 1010 WRITE(6,1570 )
      GO TO 1110
 1020 WRITE(6,1580 )
      GO TO 1110
 1030 WRITE(6,1590 )
      GO TO 1110
 1040 WRITE(6,1600 )
      GO TO 1110
 1050 WRITE(6,1610 )
      GO TO 1110
 1060 WRITE(6,1620 )
      GO TO 1110
 1070 WRITE(6,1630 )
      GO TO 1110
 1080 WRITE(6,1640 )
      GO TO 1110
 1090 WRITE(6,1650 )
      GO TO 1110
 1100 WRITE(6,1660 )
 1110 IF(HEAD) CALL PRCSID
      WRITE(6,1670 )
      IF(IDIM .EQ. 1) WRITE(6,1680 )
      IF(IDIM .EQ. 2) WRITE(6,1690 )
      IF(IDIM .EQ. 3) WRITE(6,1700 )
      IF(IDIM .EQ. 4) WRITE(6,1710 )
      SC = SYNA(13)
      XL = 1.0
      XR = 1.0
      XP = 1.0
      XT = 1.0
      IF(IDIM .EQ. 2) XL = 12.0
      IF(IDIM .EQ. 2) XP = 144.0
      IF(IDIM .GE. 3) XP = 0.0208854
      IF(IDIM .GE. 3) XR = 0.3048
      IF(IDIM .GE. 3) XT = 1.8
      IF(IDIM .EQ. 3) XL = 0.3048
      IF(IDIM .EQ. 4) XL = 30.48
      ALT  = FLC(K+96)
      VINF = FLC(I+136)
      PINF = FLC(K+73)
      TINF = FLC(K+116)
      IF(ALT  .NE. -UNUSED) ALT  = ALT *XL
      IF(VINF .NE. -UNUSED) VINF = VINF*XL
      IF(PINF .NE. -UNUSED) PINF = PINF/XP
      IF(TINF .NE. -UNUSED) TINF = TINF/XT
      RN   = FLC(I+42)/XR
      SRF  = OPT(1)*XL*XL/(SC*SC)
      CBAR = OPT(2)*XL/SC
      BLRF = OPT(4)*XL/SC
      XCG  = SYNA(1)
      ZCG  = SYNA(5)
      IF(XCG .EQ. UNUSED) XCG = 0.0
      IF(ZCG .EQ. UNUSED) ZCG = 0.0
      IF(BD(11) .NE. UNUSED) XCG = XCG+BD(11)
      XBN = BD(11)
      XCG  = XCG*XL/SC
      ZCG  = ZCG*XL/SC
      CALL SWRITE(11,FOR,46,ICONT,1,FLC(I+2),ALT,VINF,PINF,             &
     &            TINF,RN,SRF,CBAR,BLRF,XCG,ZCG,DUM,                    &
     &            DUM,DUM,NDMF,NAF)
      IF(VTPL) XCGMAC=(XCG-SYNA(9)*XL/SC-AVT(195)*XL/SC)-XBN*XL/SC
      IF(HTPL) XCGMAC=(XCG-SYNA(6)*XL/SC-AHT(195)*XL/SC)-XBN*XL/SC
      IF(WGPL) XCGMAC=(XCG-SYNA(2)*XL/SC-A  (195)*XL/SC)-XBN*XL/SC
      IF(.NOT. BO) GO TO 1120
!
!     WRITE BODY AUXILIARY OUTPUTS IF BODY PRESENT
!
      BD93   = BD(93)*XL*XL/(SC*SC)
      BD57   = BD(57)*XL*XL/(SC*SC)
      SBD19  = SBD(19)*XL*XL/(SC*SC)
      SBD111 = SBD(111)*XL*XL/(SC*SC)
      WRITE(6,1470 )
      IF(SUBSON)CALL SWRITE(8,FOR1,34,ICON,1,BD93,XCG,ZCG,BD57,         &
     &  BD(61),BD(60),BD(59),ANA,O,P,Q,R,S,T,NN,NM)
      IF(TRANSN)CALL SWRITE(8,FOR1,34,ICON,1,BD93,XCG,ZCG,BD57,         &
     &  TRA(78),TRA(76),TRA(79),TRA(80),O,P,Q,R,S,T,NN,NM)
      IF(SUPHYP)CALL SWRITE(8,FOR1,34,ICON,1,SBD111,XCG,ZCG,SBD19,      &
     &  SBD(124),SBD(123),SBD(115),ANA,O,P,Q,R,S,T,NN,NM)
 1120 IF(WGPL .OR. HTPL .OR. VTPL) WRITE(6,1480 ) XCGMAC
!
!     WRITE WING DATA IF WING PRESENT
!
      IF(.NOT. WGPL) GO TO 1130
      WRITE(6,1490 )
      IF(SUBSON)                                                        &
     & CALL AXPRNT(A,WINGIN,D(11),D(12),D(20),D(10),SYNA(2),            &
     &             NN,NM,XL,SC,XBN)
      IF(TRANSN)                                                        &
     & CALL AXPRNT(A,WINGIN,ANA,ANA,WING(1),TRA(42),SYNA(2),            &
     &             NN,NM,XL,SC,XBN)
      IF(SUPHYP)                                                        &
     & CALL AXPRNT(A,WINGIN,SLG(84),SLG(83),SLG(80),SLG(88),SYNA(2),    &
     &             NN,NM,XL,SC,XBN)
!
!     WRITE H.T. DATA IF H.T. PRESENT
!
 1130 IF(.NOT. HTPL) GO TO 1140
      WRITE(6,1500 )
      IF(SUBSON)                                                        &
     & CALL AXPRNT(AHT,HTIN,DHT(11),DHT(12),DHT(20),DHT(10),SYNA(6),    &
     &             NN,NM,XL,SC,XBN)
      IF(TRANSN)                                                        &
     & CALL AXPRNT(AHT,HTIN,ANA,ANA,HT(1),TRAH(42),SYNA(6),             &
     &             NN,NM,XL,SC,XBN)
      IF(SUPHYP)                                                        &
     & CALL AXPRNT(AHT,HTIN,STG(84),STG(83),STG(80),STG(88),SYNA(6),    &
     &             NN,NM,XL,SC,XBN)
!
!     WRITE V.T. DATA IF V.T. PRESENT
!
 1140 IF(.NOT. VTPL) GO TO 1150
      WRITE(6,1510 )
      IF(SUBSON)                                                        &
     & CALL AXPRNT(AVT,VTIN,DVT(11),DVT(12),DVT(20),DVT(10),SYNA(9),    &
     &             NN,NM,XL,SC,XBN)
      IF(TRANSN)                                                        &
     & CALL AXPRNT(AVT,VTIN,ANA,ANA,ANA,ANA,SYNA(9),                    &
     &             NN,NM,XL,SC,XBN)
      IF(SUPHYP)                                                        &
     & CALL AXPRNT(AVT,VTIN,ANA,ANA,VT(1),ANA,SYNA(9),                  &
     &             NN,NM,XL,SC,XBN)
!
!     WRITE V.F. DATA IF V.F. PRESENT
!
 1150 IF(.NOT. VFPL) GO TO 1160
      WRITE(6,1520 )
      IF(SUBSON)                                                        &
     & CALL AXPRNT(AVF,VFIN,DVF(11),DVF(12),DVF(20),DVF(10),SYNA(12),   &
     &             NN,NM,XL,SC,XBN)
      IF(TRANSN)                                                        &
     & CALL AXPRNT(AVF,VFIN,ANA,ANA,ANA,ANA,SYNA(12),                   &
     &             NN,NM,XL,SC,XBN)
      IF(SUPHYP)                                                        &
     & CALL AXPRNT(AVF,VFIN,ANA,ANA,VF(1),ANA,SYNA(12),                 &
     &             NN,NM,XL,SC,XBN)
 1160 IF(NN) WRITE(6,1770 )
      IF(NM) WRITE(6,1780 )
      NN = .FALSE.
      NM = .FALSE.
!
!****                  WRITE PARTIAL OUTPUTS
!
      IF(.NOT. BO) GO TO 1340
      IF(LAST .EQ. 1 .OR. LAST .EQ. 7) GO TO 1340
      WRITE(6,1550 )
      WRITE(6,1560 )
      GO TO (1170 ,1180 ,1190 ,1200 ,1210 ,1220 ,1230 ,1240 ,1250 ,1260 &
     &), LAST
 1170 WRITE(6,1570 )
      GO TO 1270
 1180 WRITE(6,1580 )
      GO TO 1270
 1190 WRITE(6,1590 )
      GO TO 1270
 1200 WRITE(6,1600 )
      GO TO 1270
 1210 WRITE(6,1610 )
      GO TO 1270
 1220 WRITE(6,1620 )
      GO TO 1270
 1230 WRITE(6,1630 )
      GO TO 1270
 1240 WRITE(6,1640 )
      GO TO 1270
 1250 WRITE(6,1650 )
      GO TO 1270
 1260 WRITE(6,1660 )
 1270 IF(HEAD) CALL PRCSID
      WRITE(6,1670 )
      IF(IDIM .EQ. 1) WRITE(6,1680 )
      IF(IDIM .EQ. 2) WRITE(6,1690 )
      IF(IDIM .EQ. 3) WRITE(6,1700 )
      IF(IDIM .EQ. 4) WRITE(6,1710 )
      CALL SWRITE(11,FOR,46,ICONT,1,FLC(I+2),ALT,VINF,PINF,             &
     &            TINF,RN,SRF,CBAR,BLRF,XCG,ZCG,DUM,                    &
     &            DUM,DUM,NDMF,NAF)
      IF(.NOT. WGPL) GO TO 1280
      IF(SUBSON)WRITE(6,1720 )WB(5),WB(4),WB(3),WB(2),WB(13)
      IF(TRANSN)WRITE(6,1720 )TRA(72),TRA(71),SWB(11),SWB(35),TRA(106)
      IF(SUPHYP)WRITE(6,1720 )SWB(7),SWB(33),SWB(11),SWB(35),SWB(8)
 1280 IF(.NOT. HTPL) GO TO 1290
      IF(SUBSON)WRITE(6,1730 )WBT(4),WBT(3),WBT(2),WBT(1),HB(13)
      IF(TRANSN)WRITE(6,1730 )TRAH(72),TRAH(71),SHB(11),SHB(35),TRAH(106&
     &)
      IF(SUPHYP)WRITE(6,1730 )STP(68),STP(67),STP(65),STP(66),SHB(8)
 1290 IF(.NOT. (WGPL .OR. HTPL)) GO TO 1340
      IF(STB(117) .EQ. UNUSED) GO TO 1300
      IF(WGPL .AND. (SUBSON .OR. TRANSN)) WRITE(6,1540 ) STB(117)
 1300 IF(.NOT. SUBSON) GO TO 1310
      WRITE(6,1740 )
      IF(WGPL .AND. HTPL)                                               &
     & CALL SWRITE(6,FOR2,26,JCON,NALPHA,FLC(23),FACT(2),FACT(42),      &
     & FACT(143),FACT(22),WBT(46),H,H,O,P,Q,R,S,T,NN,NM)
      IF(WGPL .AND. .NOT. HTPL)                                         &
     & CALL SWRITE(6,FOR2,26,JCON,NALPHA,FLC(23),FACT(2),ANONE,         &
     & ANONE,FACT(22),ANONE,H,H,O,P,Q,R,S,T,NN,NM)
      GO TO 1320
 1310 IF(TRANSN) GO TO 1320
      WRITE(6,1740 )
      IF(WGPL .AND. HTPL)                                               &
     & CALL SWRITE(6,FOR2,26,JCON,NALPHA,FLC(23),SWB(12),STP(71),       &
     & STP(133),SWB(40),STP(111),H,H,O,P,Q,R,S,T,NN,NM)
      IF(WGPL .AND. .NOT. HTPL)                                         &
     & CALL SWRITE(6,FOR2,26,JCON,NALPHA,FLC(23),SWB(12),ANONE,         &
     & ANONE,SWB(40),ANONE,H,H,O,P,Q,R,S,T,NN,NM)
 1320 CONTINUE
      IF(TRANSN .OR. HYPERS .OR. .NOT. DAMP) GO TO 1330
      WRITE(6,1760 )DYN(176),DYN(68),DYN(95),DYN(177),DYN(180)
      WRITE(6,1790 )
      KSAVE=KCON(1)
      KCON(1)=11
      FORSAV=FOR3(4)
      FORSAW=FOR3(5)
      FORSAX=FOR3(6)
      FOR3(4)=FOR3A(1)
      FOR3(5)=FOR3A(2)
      FOR3(6)=FOR3A(3)
      STB67=STB(67)
      SLA9=SLA(9)
      C4=C(4)
      CHT4=CHT(4)
      IF(STB(67) .EQ. UNUSED) STB67=2.*UNUSED
      IF(SLA(9) .EQ. UNUSED) SLA9=2.*UNUSED
      IF(C(4) .EQ. UNUSED) C4=2.*UNUSED
      IF(CHT(4) .EQ. UNUSED) CHT4=2.*UNUSED
      IF(SUBSON)CALL SWRITE(3,FOR3,14,KCON,1,STB67,C4,CHT4,             &
     & H,O,P,Q,R,S,T,Q,R,S,T,NN,NM)
      IF(SUPERS)CALL SWRITE(3,FOR3,14,KCON,1,SLA9,C4,CHT4,              &
     & H,O,P,Q,R,S,T,Q,R,S,T,NN,NM)
      KCON(1)=KSAVE
      FOR3(4)=FORSAV
      FOR3(5)=FORSAW
      FOR3(6)=FORSAX
 1330 CONTINUE
      IF(.NOT. (WGPL .AND. HTPL)) GO TO 1340
      IF(WINGIN(4)/HTIN(4) .GE. 1.5) GO TO 1340
      WRITE(6,1750 )
      CALL SWRITE(3,FOR3,14,KCON,NALPHA,FLC(23),FACT(102),FACT(122),    &
     & H,O,P,Q,R,S,T,Q,R,S,T,NN,NM)
 1340 CONTINUE
      IF(NN) WRITE(6,1770 )
      IF(NM) WRITE(6,1780 )
      IF(LAST .EQ. 1 .OR. LAST .EQ. 4 .OR. LAST .EQ. 7) GO TO 1460
!
!     WRITE SECOND LEVEL METHOD DATA IF AVAILABLE
!
      IF(.NOT. TRANSN) GO TO 1460
      IF(.NOT. DOL2)   GO TO 1460
      WRITE(6,1550 )
      WRITE(6,1560 )
      GO TO (1350 ,1360 ,1370 ,1380 ,1390 ,1400 ,1410 ,1420 ,1430 ,1440 &
     &), LAST
 1350 WRITE(6,1570 )
      GO TO 1450
 1360 WRITE(6,1580 )
      GO TO 1450
 1370 WRITE(6,1590 )
      GO TO 1450
 1380 WRITE(6,1600 )
      GO TO 1450
 1390 WRITE(6,1610 )
      GO TO 1450
 1400 WRITE(6,1620 )
      GO TO 1450
 1410 WRITE(6,1630 )
      GO TO 1450
 1420 WRITE(6,1640 )
      GO TO 1450
 1430 WRITE(6,1650 )
      GO TO 1450
 1440 WRITE(6,1660 )
 1450 IF(HEAD) CALL PRCSID
      WRITE(6,1670 )
      IF(IDIM .EQ. 1) WRITE(6,1680 )
      IF(IDIM .EQ. 2) WRITE(6,1690 )
      IF(IDIM .EQ. 3) WRITE(6,1700 )
      IF(IDIM .EQ. 4) WRITE(6,1710 )
      CALL SWRITE(11,FOR,46,ICONT,1,FLC(I+2),ALT,VINF,PINF,             &
     &            TINF,RN,SRF,CBAR,BLRF,XCG,ZCG,DUM,                    &
     &            DUM,DUM,NDMF,NAF)
      CALL PRNSEC(LAST)
 1460 WRITE(6,1530 )
!
      RETURN
 1470 FORMAT(//55X,21HBASIC BODY PROPERTIES//12X,11HWETTED AREA,6X,     &
     & 3HXCG,5X,3HZCG,5X,9HBASE AREA,5X,14HZERO LIFT DRAG,3X,           &
     & 9HBASE DRAG,3X,13HFRICTION DRAG,3X,13HPRESSURE DRAG)
 1480 FORMAT(//41X,45HXCG RELATIVE TO THEORETICAL LEADING EDGE MAC=,F7.2&
     & ///55X,25HBASIC PLANFORM PROPERTIES//36X,5HTAPER,5X,6HASPECT,3X, &
     & 13HQUARTER CHORD,13X,13HQUARTER CHORD,14X,9HZERO LIFT,4X,        &
     & 8HFRICTION/25X,4HAREA,7X,5HRATIO,6X,5HRATIO,7X,5HSWEEP,8X,       &
     & 3HMAC,8X,6HX(MAC),7X,6HY(MAC),8X,4HDRAG,5X,11HCOEFFICIENT)
 1490 FORMAT(1H0,6X,4HWING)
 1500 FORMAT(1H0,2X,15HHORIZONTAL TAIL)
 1510 FORMAT(1H0,3X,13HVERTICAL TAIL)
 1520 FORMAT(1H0,4X,11HVENTRAL FIN)
 1530 FORMAT(1H1)
 1540 FORMAT(1H0,38X,38HSIDEWASH, (1 + D(SIGMA)/D(BETA))QV/Q =,1PE14.7)
 1550 FORMAT(1H1,29X,72HAUTOMATED STABILITY AND CONTROL METHODS PER APRI&
     &L 1976 VERSION OF DATCOM)
 1560 FORMAT(45X,42HCONFIGURATION AUXILIARY AND PARTIAL OUTPUT)
 1570 FORMAT(51X,31HDATCOM BODY ALONE CONFIGURATION)
 1580 FORMAT(54X,24HWING ALONE CONFIGURATION)
 1590 FORMAT(52X,29HHORIZONTAL TAIL CONFIGURATION)
 1600 FORMAT(53X,27HVERTICAL TAIL CONFIGURATION)
 1610 FORMAT(55X,23HWING-BODY CONFIGURATION)
 1620 FORMAT(49X,34HBODY-HORIZONTAL TAIL CONFIGURATION)
 1630 FORMAT(50X,32HBODY-VERTICAL TAIL CONFIGURATION)
 1640 FORMAT(47X,39HWING-BODY-HORIZONTAL TAIL CONFIGURATION)
 1650 FORMAT(48X,37HWING-BODY-VERTICAL TAIL CONFIGURATION)
 1660 FORMAT(40X,53HWING-BODY-VERTICAL TAIL-HORIZONTAL TAIL CONFIGURATIO&
     &N)
 1670 FORMAT(55H -----------------------  FLIGHT CONDITIONS  ----------,&
     &       14H--------------,11X,25H--------------  REFERENCE,        &
     &       25H DIMENSIONS  ------------/2X,16HMACH    ALTITUDE,       &
     &       3X,48HVELOCITY    PRESSURE    TEMPERATURE     REYNOLDS,    &
     &       13X,47HREF.      REFERENCE LENGTH   MOMENT REF. CENTER/    &
     &       7H NUMBER,55X,6HNUMBER,14X,4HAREA,7X,5HLONG.,5X,4HLAT.,    &
     &       5X,15HHORIZ      VERT)
 1680 FORMAT(13X,2HFT,7X,6HFT/SEC,5X,8HLB/FT**2,7X,5HDEG R,9X,4H1/FT,   &
     &       15X,5HFT**2,1X,4(7X,2HFT,1X))
 1690 FORMAT(13X,2HIN,7X,6HIN/SEC,5X,8HLB/IN**2,7X,5HDEG R,9X,4H1/FT,   &
     &       15X,5HIN**2,1X,4(7X,2HIN,1X))
 1700 FORMAT(13X,2H M,7X,6H M/SEC,5X,8H N/ M**2,7X,5HDEG K,9X,4H1/ M,   &
     &       15X,5H M**2,1X,4(7X,2H M,1X))
 1710 FORMAT(13X,2HCM,7X,6HCM/SEC,5X,8H N/CM**2,7X,5HDEG K,9X,4H1/ M,   &
     &       15X,5HCM**2,1X,4(7X,2HCM,1X))
 1720 FORMAT(1H0,10X,9HCLA-B(W)=,1PE10.3,5X,9HCLA-W(B)=,E10.3,5X,       &
     &  7HK-B(W)=,E10.3,5X,7HK-W(B)=,E10.3,5X,11HXAC/C-B(W)=,E10.3)
 1730 FORMAT(1H0,10X,9HCLA-B(H)=,1PE10.3,5X,9HCLA-H(B)=,E10.3,5X,       &
     &  7HK-B(H)=,E10.3,5X,7HK-H(B)=,E10.3,5X,11HXAC/C-B(H)=,E10.3)
 1740 FORMAT(///16X,5HALPHA,9X,7HIV-B(W),10X,7HIV-W(H),                 &
     & 10X,7HIV-B(H),10X,6HGAMMA/,18X,6HGAMMA//78X,14H2*PI*ALPHA*V*R,   &
     & 9X,17H(2*PI*ALPHA*V*R)T)
 1750 FORMAT(///55X,25HCANARD EFFECTIVE DOWNWASH/47X,5HALPHA,6X,        &
     & 12H(EPSOLN)EFF.,5X,23HD(EPSOLN)/D(ALPHA) EFF.)
 1760 FORMAT(//50X,31HDYNAMIC DERIVATIVE INCREMENTALS /                 &
     & 10X,17HCLP(GAMMA=CL=0) =,1PE11.4,                                &
     &  5X,26HCLP(GAMMA)/CLP (GAMMA=0) =,E11.4,                         &
     &  6X,11HCNP/THETA =,E11.4/                                        &
     & 30X,11HCYP/GAMMA =,E11.4,                                        &
     & 20X,15HCYP/CL (CL=0) =,E11.4/)
 1770 FORMAT(45H0*** NDM PRINTED WHEN NO DATCOM METHODS EXIST)
 1780 FORMAT(42H0*** NA PRINTED WHEN METHOD NOT APPLICABLE)
 1790 FORMAT(45X,9HCLB/GAMMA,8X,12H(CMO/THETA)W,5X,12H(CMO/THETA)H)
      END
      SUBROUTINE AXPRNT(A,AIN,CDFI,CDFO,CDO,CDF,XW,NN,NM,XL,SC,XBN)
!
!     PRINT AUXILIARY PANEL OUTPUTS
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      DIMENSION A(*),AIN(*),WTYPE(4),FOR(38),DATA(9),                   &
     &          P(1),Q(1),R(1),S(1),T(1),ICAR(9)
! above,  DIMENSION A(195),AIN(154) changed to A(*),AIN(*)   RLC  2020Dec14
      LOGICAL NN,NM
      DATA WTYPE / 4HSTRA, 4HDOUB, 4HCRAN, 4HCURV /
      DATA FOR /                                                        &
     & 4H(1H+, 4H,19X, 4H,1X,, 4HE11., 4H4,1X, 4H,1X , 4H,1X,, 4HF6. ,  &
     & 4H3,1X, 4H,1X , 4H,1X,, 4HE11., 4H4,1X, 4H,1X , 4H,1X,, 4HF7. ,  &
     & 4H3,1X, 4H,1X , 4H,1X,, 4HE10., 4H3,1X, 4H,1X , 4H,1X,, 4HE10.,  &
     & 4H3,1X, 4H,1X , 4H,1X,, 4HE10., 4H3,1X, 4H,1X , 4H,1X,, 4HE10.,  &
     & 4H3,1X, 4H,1X , 4H,1X,, 4HE10., 4H3   , 4H)   /
      DATA ICAR / 13,8,13,9,5*12 /
!
!     INBOARD THEORITICAL
!
      SOT=0.
      IF(AIN(15) .EQ. WTYPE(1)) GO TO 1000
      DATA(1)=(AIN(6)+AIN(5))*(AIN(4)-AIN(2))
      SOT=DATA(1)
      DATA(1)=DATA(1)*XL*XL/(SC*SC)
      DATA(2)=AIN(5)/AIN(6)
      DATA(3)=(2.*(AIN(4)-AIN(2)))**2/DATA(1)
      DATA(4)=A(64)
      DATA(5)=2.*AIN(6)*(1.+DATA(2)*(1.+DATA(2)))/(3.*(1.+DATA(2)))
      DATA(7)=(AIN(4)-AIN(2))*(1.+2.*DATA(2))/(3.*(1.+DATA(2)))
      DATA(6)=A(62)*DATA(7)+XW+0.25*DATA(5)+XBN
      DATA(5)=DATA(5)*XL/SC
      DATA(6)=DATA(6)*XL/SC
      DATA(7)=DATA(7)*XL/SC
      DATA(8)=-UNUSED
      DATA(9)=-UNUSED
      WRITE(6,1010)
      CALL SWRITE(9,FOR,38,ICAR,1,DATA(1),DATA(2),DATA(3),DATA(4),      &
     & DATA(5),DATA(6),DATA(7),DATA(8),DATA(9),P,Q,R,S,T,NN,NM)
!
!     INBOARD EXPOSED
!
      DATA(1)=A(1)
      DATA(1)=DATA(1)*XL*XL/(SC*SC)
      DATA(2)=A(26)
      DATA(3)=A(5)
      DATA(4)=A(64)
      DATA(5)=A(15)
      DATA(7)=A(32)+AIN(4)-AIN(3)
      DATA(6)=A(62)*DATA(7)+XW+0.25*DATA(5)+XBN
      DATA(5)=DATA(5)*XL/SC
      DATA(6)=DATA(6)*XL/SC
      DATA(7)=DATA(7)*XL/SC
      DATA(8)=-UNUSED
      DATA(9)=CDFI
      IF(CDFI .EQ. UNUSED) DATA(9)=2.*UNUSED
      WRITE(6,1020)
      CALL SWRITE(9,FOR,38,ICAR,1,DATA(1),DATA(2),DATA(3),DATA(4),      &
     & DATA(5),DATA(6),DATA(7),DATA(8),DATA(9),P,Q,R,S,T,NN,NM)
!
!     OUTBOARD PANEL
!
      DATA(1)=A(2)
      DATA(1)=DATA(1)*XL*XL/(SC*SC)
      DATA(2)=A(28)
      DATA(3)=A(6)
      DATA(4)=A(88)
      DATA(5)=A(17)
      DATA(7)=A(33)
      DATA(6)=A(86)*DATA(7)+XW+0.25*DATA(5)+XBN
      DATA(5)=DATA(5)*XL/SC
      DATA(6)=DATA(6)*XL/SC
      DATA(7)=DATA(7)*XL/SC
      DATA(8)=-UNUSED
      DATA(9)=CDFO
      IF(CDFO .EQ. UNUSED) DATA(9)=2.*UNUSED
      WRITE(6,1030)
      CALL SWRITE(9,FOR,38,ICAR,1,DATA(1),DATA(2),DATA(3),DATA(4),      &
     & DATA(5),DATA(6),DATA(7),DATA(8),DATA(9),P,Q,R,S,T,NN,NM)
 1000 CONTINUE
!
!     TOTAL THEORITICAL
!
      DATA(1)=A(4)
      DATA(1)=DATA(1)*XL*XL/(SC*SC)
      DATA(2)=A(118)
      DATA(3)=A(120)
      DATA(4)=ARCCOS((SOT*COS(A(64)/RAD)+A(2)*COS(A(88)/RAD))/A(4))*RAD
      IF(AIN(15) .EQ. WTYPE(1)) DATA(4)=A(40)
      DATA(5)=A(122)
      DATA(6)=A(161)+XW+XBN
      DATA(7)=A(136)
      DATA(5)=DATA(5)*XL/SC
      DATA(6)=DATA(6)*XL/SC
      DATA(7)=DATA(7)*XL/SC
      DATA(8)=-UNUSED
      DATA(9)=-UNUSED
      WRITE(6,1040)
      CALL SWRITE(9,FOR,38,ICAR,1,DATA(1),DATA(2),DATA(3),DATA(4),      &
     & DATA(5),DATA(6),DATA(7),DATA(8),DATA(9),P,Q,R,S,T,NN,NM)
!
!     TOTAL EXPOSED
!
      DATA(1)=A(3)
      DATA(1)=DATA(1)*XL*XL/(SC*SC)
      DATA(2)=A(27)
      DATA(3)=A(7)
      DATA(4)=A(40)
      DATA(5)=A(16)
      DATA(6)=A(30)+XW+(A(21)-A(23))*TAN(A(35))-0.25*DATA(5)+XBN
      DATA(7)=A(31)+AIN(4)-AIN(3)
      DATA(5)=DATA(5)*XL/SC
      DATA(6)=DATA(6)*XL/SC
      DATA(7)=DATA(7)*XL/SC
      DATA(8)=CDO
      DATA(9)=CDF
      IF(CDO .EQ. UNUSED) DATA(8)=2.*UNUSED
      IF(CDF .EQ. UNUSED) DATA(9)=2.*UNUSED
      WRITE(6,1050)
      CALL SWRITE(9,FOR,38,ICAR,1,DATA(1),DATA(2),DATA(3),DATA(4),      &
     & DATA(5),DATA(6),DATA(7),DATA(8),DATA(9),P,Q,R,S,T,NN,NM)
 1010 FORMAT(20H THEORITICAL INBOARD)
 1020 FORMAT(20H     EXPOSED INBOARD)
 1030 FORMAT(20H            OUTBOARD)
 1040 FORMAT(20H   TOTAL THEORITICAL)
 1050 FORMAT(20H       TOTAL EXPOSED)
      RETURN
      END
      SUBROUTINE BDAREA(ABORT)
!
!***  EXECUTIVE FOR BODY PARTS SHADOWED BY MACH LINES
!
      LOGICAL ABORT
      DIMENSION A(3),X(4),Y(4),XL(42),YL(42),XLI(42),YLI(42),XT(42),    &
     &YT(42),XTI(42),YTI(42)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG
      COMMON /FLGTCD/ FLC(73), dumflgtcd(87)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD, kand
      COMMON /HTI/    HTIN(154)
      COMMON /HTDATA/ AHT(195)
      COMMON /BODYI/  XNX,XB(20),SB(20),PB(20),RB(20), dum2(48)
      COMMON /SYNTSS/ SYNA(10)
!
      NX=XNX
      ILI=0
      ILIE=0
      ITI=0
      ITIE=0
      SAXB=0
      SAYB=0
      AREA=0.
      AREAB=0.
 1000 AMUU=ATAN(1./SQRT(FLC(I+2)**2-1.))
      DO 1050 K=1,2
         IF(K.NE.1) GO TO 1020
 1010    A(1)=SYNA(6)+(HTIN(4)-HTIN(3))*AHT(62)*COS(SYNA(8)/RAD)
         A(2)=SYNA(7)-(A(1)-SYNA(6))*SIN(SYNA(8)/RAD)/COS(SYNA(8)/RAD)
         A(3)=SYNA(8)
         GO TO 1030
 1020    A(1)=A(1)+AHT(10)*COS(SYNA(8)/RAD)
         A(2)=A(2)-AHT(10)*SIN(SYNA(8)/RAD)
         GO TO 1040
 1030    CALL PTINT2(XB,RB,A,AMUU,XL,YL,XLI,YLI,NX,ILUI,ILLI,ILUIE,     &
     &               ILLIE,ABORT)
         IF(ABORT) RETURN
         GO TO 1050
 1040    CALL PTINT2(XB,RB,A,AMUU,XT,YT,XTI,YTI,NX,ITUI,ITLI,ITUIE,     &
     &              ITLIE,ABORT)
         IF(ABORT) RETURN
 1050 END DO
      DO 1210 K=1,2
         SAXB=0.
         SAYB=0.
         AREA=0.
         AREAB=0.
!
!     CHECK FOR UPPER OR LOWER AREA
!
         IF(K.NE.1) GO TO 1060
         ILI=ILUI
         ILIE=ILUIE
         ITI=ITUI
         ITIE=ITUIE
         GO TO 1070
 1060    ILI=ILLI
         ILIE=ILLIE
         ITI=ITLI
         ITIE=ITLIE
         NX=NX+21
 1070    IF(ITIE.NE.0) GO TO 1080
!
!**** NEITHER MACH LINE INTERSECTS BODY PROFILE EXTENSION ****
!
         KIND=1
         GO TO 1100
 1080    IF(ILIE.NE.0) GO TO 1090
!
!**** ONLY THE TRAILING EDGE MACH LINE INTERSECTS BODY PROFILE EXTENSION
!
         KIND=2
         GO TO 1100
!
!**** BOTH MACH LINES INTERSECT BODY PROFILE EXTENSION ****
!
 1090    KIND=3
 1100    GO TO (1110,1150,1180) KIND
 1110    IF(ILI.NE.ITI) GO TO 1120
         X(1)=0.
         X(2)=XLI(ILI)
         X(3)=XTI(ITI)+AHT(10)
         X(4)=AHT(10)
         Y(1)=0.
         Y(2)=YLI(ILI)
         Y(3)=YTI(ITI)
         Y(4)=0.
         CALL AREA2(X,Y,SAREA,2,AX,AY)
         AREA=SAREA
         AREAB=AREA
         SAXB=AX
         SAYB=AY
         GO TO 1190
 1120    II=1
         X(1)=0.
         X(2)=XLI(ILI)
         X(3)=XL(ILI+II)
         X(4)=AHT(10)
         Y(1)=0.
         Y(2)=YLI(ILI)
         Y(3)=YL(ILI+II)
         Y(4)=0.
         CALL AREA2(X,Y,SAREA,2,AX,AY)
         AREA=AREA+SAREA
         SAXB=SAXB+AX
         SAYB=SAYB+AY
 1130    II=II+1
         IF(XL(ILI+II).GT.(XTI(ITI)+AHT(10))) GO TO 1140
         X(1)=XL(ILI+II-1)
         X(2)=XL(ILI+II)
         X(3)=AHT(10)
         Y(1)=YL(ILI+II-1)
         Y(2)=YL(ILI+II)
         Y(3)=0.
         CALL AREA2(X,Y,SAREA,3,AX,AY)
         AREA=AREA+SAREA
         SAXB=SAXB+AX
         SAYB=SAYB+AY
         GO TO 1130
 1140    X(1)=XL(ILI+II-1)
         X(2)=XTI(ITI)+AHT(10)
         X(3)=AHT(10)
         Y(1)=YL(ILI+II-1)
         Y(2)=YTI(ITI)
         Y(3)=0.
         CALL AREA2(X,Y,SAREA,3,AX,AY)
         AREA=AREA+SAREA
         AREAB=AREA
         SAXB=SAXB+AX
         SAYB=SAYB+AY
         GO TO 1190
 1150    II=1
         X(1)=0.
         X(2)=XLI(ILI)
         X(3)=XL(ILI+II)
         X(4)=AHT(10)
         Y(1)=0.
         Y(2)=YLI(ILI)
         Y(3)=YL(ILI+II)
         Y(4)=0.
         CALL AREA2(X,Y,SAREA,2,AX,AY)
         AREA=AREA+SAREA
         SAXB=SAXB+AX
         SAYB=SAYB+AY
 1160    IF((ILI+II).EQ.NX) GO TO 1170
         X(1)=XL(ILI+II)
         X(2)=XL(ILI+II+1)
         X(3)=AHT(10)
         Y(1)=YL(ILI+II)
         Y(2)=YL(ILI+II+1)
         Y(3)=0.
         CALL AREA2(X,Y,SAREA,3,AX,AY)
         AREA=AREA+SAREA
         SAXB=SAXB+AX
         SAYB=SAYB+AY
         II=II+1
         GO TO 1160
 1170    X(1)=XL(ILI+II)
         X(2)=XTI(ITIE)+AHT(10)
         X(3)=AHT(10)
         Y(1)=YL(ILI+II)
         Y(2)=YTI(ITIE)
         Y(3)=0.
         CALL AREA2(X,Y,SAREA,3,AX,AY)
         AREA=AREA+SAREA
         SAXB=SAXB+AX
         SAYB=SAYB+AY
         X(3)=XTI(ITI)+AHT(10)
         Y(3)=YTI(ITI)
         CALL AREA2(X,Y,EXTARE,3,AX,AY)
         AREAB=AREA-EXTARE
         SAXB=SAXB-AX
         SAYB=SAYB-AY
         GO TO 1190
 1180    X(1)=0.
         X(2)=XLI(ILIE)
         X(3)=XTI(ITIE)+AHT(10)
         Y(1)=0.
         Y(2)=YLI(ILIE)
         Y(3)=YTI(ITIE)
         X(4)=AHT(10)
         Y(4)=0.
         CALL AREA2(X,Y,SAREA,2,AX,AY)
         AREA=AREA+SAREA
         X(2)=XLI(ILI)
         X(3)=XTI(ITI)+AHT(10)
         Y(2)=YLI(ILI)
         Y(3)=YTI(ITI)
         CALL AREA2(X,Y,SAREA,2,AX,AY)
         AREAB=AREAB+SAREA
         SAXB=SAXB+AX
         SAYB=SAYB+AY
 1190    IF(K.EQ.2) GO TO 1200
         AREAU=AREA
         AREAUB=AREAB
         SAXUB=SAXB
         SAYUB=SAYB
         GO TO 1210
 1200    AREAL=AREA
         AREALB=AREAB
         SAXLB=SAXB
         SAYLB=SAYB
 1210 END DO
      HTIN(114+I)=AREAUB+AREALB
      HTIN(134+I)=AREAU+AREAL
      AXTB=SAXUB+SAXLB
      AYTB=SAYUB+SAYLB
      XCB=AXTB/HTIN(114+I)
      YCB=AYTB/HTIN(114+I)
      XBARB=XCB*COS(-SYNA(8)/RAD)-YCB*SIN(-SYNA(8)/RAD)+SYNA(6)         &
     &      +(HTIN(4)-HTIN(3))*AHT(62)*COS(SYNA(8)/RAD)
      HTIN(94+I)=XBARB-SYNA(1)
      RETURN
      END
      BLOCK DATA BLOCKD
!
!     SET PROGRAM CONSTANTS
!
      COMMON /IBODY/   PBODY, LEN2(18),LDM2(18),FLTCON(81),DUM1(283)
      COMMON /BODYI/          LEN3(4),LDM3(4),OPTINS(20),DUM2(101)
      COMMON /IHT/     PHT,   LEN4(15),LDM4(15),BODY(44),DUM3(306)
      COMMON /IVT/     PVT,   LEN5(21),LDM5(21),PLNF(103),DUM4(235)
      COMMON /IBW/     PBW,   LEN6(36),LDM6(36),SCHR(170),DUM5(138)
      COMMON /IBH/     PBH,   LEN7(19),LDM7(19),SYNTHS(60),DUM6(282)
      COMMON /IBV/     PBV,   LENC(14),LDMC(14),PRPOWR(78),DUM7(274)
      COMMON /IBWH/    PBWH,  LEND(15),LDMD(15),JETPWR(89),DUM8(261)
      COMMON /IBWV/    PBWV,  LENE(21),LDME(21),LARWB(89),DUM9(249)
      COMMON /IPOWER/  PPOWR, LENF(2),LDMF(2),GRNDEF(8),DUM10(188)
      COMMON /IDWASH/  PDWAS, LENG(8),LDMG(8),TVTPAN(23),DUM11(21)
      COMMON /IBWHV/   PBWHV, LENH(32),LDMH(32),EXPR(131),DUM12(185)
      COMMON /IWING/   PWING, LENI(27),LDMI(27),SYMFLP(139),DUM13(207)
      COMMON /VTI/            LENJ(14),LDMJ(14),ASYFLP(78),DUM14(210)
      COMMON /WINGI/          LENK(7),LDMK(7),HYPEFF(32),DUM15(55)
      COMMON /HTI/            LENL(12),LDML(12),TRNJET(38),DUM16(92)
      COMMON /IVF/     PVF,   LENM(22),LDMM(22),CONTAB(76),DUM17(260)
      COMMON /CONSNT/         CONST(5)
!
      INTEGER FLTCON, OPTINS, BODY, PLNF, SCHR, PRPOWR, SYNTHS,         &
     &        JETPWR, LARWB, GRNDEF, TVTPAN, EXPR, SYMFLP,              &
     &        ASYFLP, HYPEFF, TRNJET, CONTAB
!
      DIMENSION SCH1(158),SCH2(12)
      EQUIVALENCE (SCH1(1),SCHR(1)),(SCH2(1),SCHR(159))
!
!
      DATA CONST / 3.141592654,0.01745329,1.E-30,57.2957795,4H$   /
!
      DATA LEN2 / 5,4,6,6,5,6,4,6,6,2,3,4,4,2,5,4,4,5 /
      DATA LDM2 / 1,20,1,20,20,-1,20,3*1,3*20,4*1,20 /
      DATA FLTCON /   4HN   ,4HM   ,4HA   ,4HC   ,4HH   ,4HM   ,        &
     &  4HA   ,4HC   ,4HH   ,4HN   ,4HA   ,4HL   ,4HP   ,4HH   ,        &
     &  4HA   ,4HA   ,4HL   ,4HS   ,4HC   ,4HH   ,4HD   ,4HR   ,        &
     &  4HN   ,4HN   ,4HU   ,4HB   ,4HH   ,4HY   ,4HP   ,4HE   ,        &
     &  4HR   ,4HS   ,4HP   ,4HI   ,4HN   ,4HF   ,4HS   ,4HT   ,        &
     &  4HM   ,4HA   ,4HC   ,4HH   ,4HT   ,4HS   ,4HM   ,4HA   ,        &
     &  4HC   ,4HH   ,4HT   ,4HR   ,4HA   ,4HL   ,4HT   ,4HT   ,        &
     &  4HI   ,4HN   ,4HF   ,4HV   ,4HI   ,4HN   ,4HF   ,4HW   ,        &
     &  4HT   ,4HG   ,4HA   ,4HM   ,4HM   ,4HA   ,4HN   ,4HA   ,        &
     &  4HL   ,4HT   ,4HL   ,4HO   ,4HO   ,4HP   ,4HA   ,4HL   ,        &
     &  4HP   ,4HH   ,4HA   /
!
      DATA LEN3 / 4,5,6,5 /
      DATA LDM3 / 4*1 /
      DATA OPTINS /   4HS   ,4HR   ,4HE   ,4HF   ,4HC   ,4HB   ,        &
     &  4HA   ,4HR   ,4HR   ,4HR   ,4HO   ,4HU   ,4HG   ,4HF   ,        &
     &  4HC   ,4HB   ,4HL   ,4HR   ,4HE   ,4HF   /
!
      DATA LEN4 / 2,4*1,2,2,5,5,3,3,2,5,6,5 /
      DATA LDM4 / 1,6*20,8*1 /
      DATA BODY /     4HN   ,4HX   ,4HX   ,4HS   ,4HP   ,4HR   ,        &
     &  4HZ   ,4HU   ,4HZ   ,4HL   ,4HB   ,4HN   ,4HO   ,4HS   ,        &
     &  4HE   ,4HB   ,4HT   ,4HA   ,4HI   ,4HL   ,4HB   ,4HL   ,        &
     &  4HN   ,4HB   ,4HL   ,4HA   ,4HD   ,4HS   ,4HI   ,4HT   ,        &
     &  4HY   ,4HP   ,4HE   ,4HM   ,4HE   ,4HT   ,4HH   ,4HO   ,        &
     &  4HD   ,4HE   ,4HL   ,4HL   ,4HI   ,4HP   /
!
      DATA LEN5 / 6,5,6,6,4,5,6,3*5,6,4,3*6,3,3*4,3,4 /
      DATA LDM5 / 15*1,6*20 /
      DATA PLNF /     4HC   ,4HH   ,4HR   ,4HD   ,4HB   ,4HP   ,        &
     &  4HC   ,4HH   ,4HR   ,4HD   ,4HR   ,4HC   ,4HH   ,4HR   ,        &
     &  4HD   ,4HT   ,4HP   ,4HC   ,4HH   ,4HS   ,4HT   ,4HA   ,        &
     &  4HT   ,4HS   ,4HS   ,4HP   ,4HN   ,4HS   ,4HS   ,4HP   ,        &
     &  4HN   ,4HE   ,4HS   ,4HS   ,4HP   ,4HN   ,4HO   ,4HP   ,        &
     &  4HS   ,4HA   ,4HV   ,4HS   ,4HI   ,4HS   ,4HA   ,4HV   ,        &
     &  4HS   ,4HO   ,4HS   ,4HW   ,4HA   ,4HF   ,4HP   ,4HT   ,        &
     &  4HW   ,4HI   ,4HS   ,4HT   ,4HA   ,4HT   ,4HY   ,4HP   ,        &
     &  4HE   ,4HS   ,4HS   ,4HP   ,4HN   ,4HD   ,4HD   ,4HD   ,        &
     &  4HH   ,4HD   ,4HA   ,4HD   ,4HI   ,4HD   ,4HH   ,4HD   ,        &
     &  4HA   ,4HD   ,4HO   ,4HS   ,4HH   ,4HB   ,4HS   ,4HE   ,        &
     &  4HX   ,4HT   ,4HR   ,4HL   ,4HP   ,4HH   ,4HS   ,4HV   ,        &
     &  4HW   ,4HB   ,4HS   ,4HV   ,4HB   ,4HS   ,4HV   ,4HH   ,        &
     &  4HB   /
!
      DATA LEN6 / 4,6,4,3,6,6,5,6,3,5,4,4,4,5,3,4,5,6,6,5,5,5,3,        &
     &            5,6,4,5,6,6,4,5,3,3,4,6,6 /
      DATA LDM6 / 5*1,20,20,-1,11*1,6,1,1,20,3*1,5*50,5*1 /
      DATA SCH1 /     4HT   ,4HO   ,4HV   ,4HC   ,4HD   ,4HE   ,        &
     &  4HL   ,4HT   ,4HA   ,4HY   ,4HX   ,4HO   ,4HV   ,4HC   ,        &
     &  4HC   ,4HL   ,4HI   ,4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,        &
     &  4HI   ,4HC   ,4HL   ,4HA   ,4HL   ,4HP   ,4HA   ,4HC   ,        &
     &  4HL   ,4HM   ,4HA   ,4HX   ,4HC   ,4HA   ,4HM   ,4HB   ,        &
     &  4HE   ,4HR   ,4HC   ,4HM   ,4H0   ,4HX   ,4HO   ,4HV   ,        &
     &  4HC   ,4HO   ,4HC   ,4HM   ,4H0   ,4HT   ,4HL   ,4HE   ,        &
     &  4HR   ,4HI   ,4HL   ,4HE   ,4HR   ,4HO   ,4HT   ,4HO   ,        &
     &  4HV   ,4HC   ,4HO   ,4HC   ,4HM   ,4HO   ,4HC   ,4HM   ,        &
     &  4HO   ,4HT   ,4HT   ,4HC   ,4HE   ,4HF   ,4HF   ,4HK   ,        &
     &  4HS   ,4HH   ,4HA   ,4HR   ,4HP   ,4HC   ,4HL   ,4HM   ,        &
     &  4HA   ,4HX   ,4HL   ,4HS   ,4HL   ,4HO   ,4HP   ,4HE   ,        &
     &  4HC   ,4HL   ,4HA   ,4HM   ,4HO   ,4HC   ,4HL   ,4HA   ,        &
     &  4HM   ,4H0   ,4HX   ,4HA   ,4HC   ,4HD   ,4HW   ,4HA   ,        &
     &  4HS   ,4HH   ,4HT   ,4HY   ,4HP   ,4HE   ,4HI   ,4HN   ,        &
     &  4HN   ,4HP   ,4HT   ,4HS   ,4HX   ,4HC   ,4HO   ,4HR   ,        &
     &  4HD   ,4HY   ,4HU   ,4HP   ,4HP   ,4HE   ,4HR   ,4HY   ,        &
     &  4HL   ,4HO   ,4HW   ,4HE   ,4HR   ,4HM   ,4HE   ,4HA   ,        &
     &  4HN   ,4HT   ,4HH   ,4HI   ,4HC   ,4HK   ,4HY   ,4HC   ,        &
     &  4HM   ,4HC   ,4HL   ,4HD   ,4HA   ,4HR   ,4HC   ,4HL   /
      DATA SCH2 /     4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,4HO   ,        &
     &  4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,4H0   /
!
      DATA LEN7 / 3,2,2,4,3,2,2,4,2,6,5,3,5,2,3,2,2,4,4 /
      DATA LDM7 / 9*1,-1,9*1 /
      DATA SYNTHS /   4HX   ,4HC   ,4HG   ,4HX   ,4HW   ,4HZ   ,        &
     &  4HW   ,4HA   ,4HL   ,4HI   ,4HW   ,4HZ   ,4HC   ,4HG   ,        &
     &  4HX   ,4HH   ,4HZ   ,4HH   ,4HA   ,4HL   ,4HI   ,4HH   ,        &
     &  4HX   ,4HV   ,4HV   ,4HE   ,4HR   ,4HT   ,4HU   ,4HP   ,        &
     &  4HH   ,4HI   ,4HN   ,4HA   ,4HX   ,4HX   ,4HV   ,4HF   ,        &
     &  4HS   ,4HC   ,4HA   ,4HL   ,4HE   ,4HZ   ,4HV   ,4HZ   ,        &
     &  4HV   ,4HF   ,4HY   ,4HV   ,4HY   ,4HF   ,4HP   ,4HH   ,        &
     &  4HI   ,4HV   ,4HP   ,4HH   ,4HI   ,4HF   /
!
      DATA LENC / 12*6,4,2 /
      DATA LDMC / 12*1,-1,1 /
      DATA PRPOWR /   4HA   ,4HI   ,4HE   ,4HT   ,4HL   ,4HP   ,        &
     &  4HN   ,4HE   ,4HN   ,4HG   ,4HS   ,4HP   ,4HT   ,4HH   ,        &
     &  4HS   ,4HT   ,4HC   ,4HP   ,4HP   ,4HH   ,4HA   ,4HL   ,        &
     &  4HO   ,4HC   ,4HP   ,4HH   ,4HV   ,4HL   ,4HO   ,4HC   ,        &
     &  4HP   ,4HR   ,4HP   ,4HR   ,4HA   ,4HD   ,4HE   ,4HN   ,        &
     &  4HG   ,4HF   ,4HC   ,4HT   ,4HB   ,4HW   ,4HA   ,4HP   ,        &
     &  4HR   ,4H3   ,4HB   ,4HW   ,4HA   ,4HP   ,4HR   ,4H6   ,        &
     &  4HB   ,4HW   ,4HA   ,4HP   ,4HR   ,4H9   ,4HN   ,4HO   ,        &
     &  4HP   ,4HB   ,4HP   ,4HE   ,4HB   ,4HA   ,4HP   ,4HR   ,        &
     &  4H7   ,4H5   ,4HC   ,4HR   ,4HO   ,4HT   ,4HY   ,4HP   /
!
      DATA LEND / 14*6,5 /
      DATA LDMD / 15*1 /
      DATA JETPWR /   4HA   ,4HI   ,4HE   ,4HT   ,4HL   ,4HJ   ,        &
     &  4HN   ,4HE   ,4HN   ,4HG   ,4HS   ,4HJ   ,4HT   ,4HH   ,        &
     &  4HS   ,4HT   ,4HC   ,4HJ   ,4HJ   ,4HI   ,4HA   ,4HL   ,        &
     &  4HO   ,4HC   ,4HJ   ,4HE   ,4HV   ,4HL   ,4HO   ,4HC   ,        &
     &  4HJ   ,4HE   ,4HA   ,4HL   ,4HO   ,4HC   ,4HJ   ,4HI   ,        &
     &  4HN   ,4HL   ,4HT   ,4HA   ,4HJ   ,4HE   ,4HA   ,4HN   ,        &
     &  4HG   ,4HL   ,4HJ   ,4HE   ,4HV   ,4HE   ,4HL   ,4HO   ,        &
     &  4HA   ,4HM   ,4HB   ,4HT   ,4HM   ,4HP   ,4HJ   ,4HE   ,        &
     &  4HS   ,4HT   ,4HM   ,4HP   ,4HJ   ,4HE   ,4HL   ,4HL   ,        &
     &  4HO   ,4HC   ,4HJ   ,4HE   ,4HT   ,4HO   ,4HT   ,4HP   ,        &
     &  4HA   ,4HM   ,4HB   ,4HS   ,4HT   ,4HP   ,4HJ   ,4HE   ,        &
     &  4HR   ,4HA   ,4HD   /
!
      DATA LENE / 2,4,6,6,2,6,6,1,4,6,5,2,2,3,3,6,6,3,5,6,5 /
      DATA LDME / 13*1,-1,1,1,-1,4*1 /
      DATA LARWB  /   4HZ   ,4HB   ,4HS   ,4HR   ,4HE   ,4HF   ,        &
     &  4HD   ,4HE   ,4HL   ,4HT   ,4HE   ,4HP   ,4HS   ,4HF   ,        &
     &  4HR   ,4HO   ,4HN   ,4HT   ,4HA   ,4HR   ,4HR   ,4H3   ,        &
     &  4HL   ,4HE   ,4HO   ,4HB   ,4HD   ,4HE   ,4HL   ,4HT   ,        &
     &  4HA   ,4HL   ,4HL   ,4HS   ,4HW   ,4HE   ,4HT   ,4HP   ,        &
     &  4HE   ,4HR   ,4HB   ,4HA   ,4HS   ,4HS   ,4HB   ,4HA   ,        &
     &  4HS   ,4HE   ,4HH   ,4HB   ,4HB   ,4HB   ,4HB   ,4HL   ,        &
     &  4HF   ,4HX   ,4HC   ,4HG   ,4HT   ,4HH   ,4HE   ,4HT   ,        &
     &  4HA   ,4HD   ,4HR   ,4HO   ,4HU   ,4HN   ,4HD   ,4HN   ,        &
     &  4HS   ,4HB   ,4HS   ,4HS   ,4HB   ,4HS   ,4HL   ,4HB   ,        &
     &  4HX   ,4HC   ,4HE   ,4HN   ,4HS   ,4HB   ,4HX   ,4HC   ,        &
     &  4HE   ,4HN   ,4HW   /
!
      DATA LENF / 3,5 /
      DATA LDMF / 1,20 /
      DATA GRNDEF /   4HN   ,4HG   ,4HH   ,4HG   ,4HR   ,4HD   ,        &
     &  4HH   ,4HT   /
!
      DATA LENG / 3,2,3,2,2,6,3,2 /
      DATA LDMG / 8*1 /
      DATA TVTPAN /   4HB   ,4HV   ,4HP   ,4HB   ,4HV   ,4HB   ,        &
     &  4HD   ,4HV   ,4HB   ,4HH   ,4HS   ,4HV   ,4HV   ,4HP   ,        &
     &  4HH   ,4HI   ,4HT   ,4HE   ,4HV   ,4HL   ,4HP   ,4HZ   ,        &
     &  4HP   /
!
      DATA LENH / 3*3,4,4,3*3,4,4,3*3,5*4,5,5,6,6,5,3,5*5,4,5,4 /
      DATA LDMH / 23*20,9*1 /
      DATA EXPR /     4HC   ,4HD   ,4HB   ,4HC   ,4HL   ,4HB   ,        &
     &  4HC   ,4HM   ,4HB   ,4HC   ,4HL   ,4HA   ,4HB   ,4HC   ,        &
     &  4HM   ,4HA   ,4HB   ,4HC   ,4HD   ,4HW   ,4HC   ,4HL   ,        &
     &  4HW   ,4HC   ,4HM   ,4HW   ,4HC   ,4HL   ,4HA   ,4HW   ,        &
     &  4HC   ,4HM   ,4HA   ,4HW   ,4HC   ,4HD   ,4HH   ,4HC   ,        &
     &  4HL   ,4HH   ,4HC   ,4HM   ,4HH   ,4HC   ,4HL   ,4HA   ,        &
     &  4HH   ,4HC   ,4HM   ,4HA   ,4HH   ,4HC   ,4HD   ,4HW   ,        &
     &  4HB   ,4HC   ,4HL   ,4HW   ,4HB   ,4HC   ,4HM   ,4HW   ,        &
     &  4HB   ,4HC   ,4HL   ,4HA   ,4HW   ,4HB   ,4HC   ,4HM   ,        &
     &  4HA   ,4HW   ,4HB   ,4HQ   ,4HO   ,4HQ   ,4HI   ,4HN   ,        &
     &  4HF   ,4HE   ,4HP   ,4HS   ,4HL   ,4HO   ,4HN   ,4HD   ,        &
     &  4HE   ,4HO   ,4HD   ,4HA   ,4HC   ,4HD   ,4HV   ,4HA   ,        &
     &  4HL   ,4HP   ,4HO   ,4HW   ,4HA   ,4HL   ,4HP   ,4HL   ,        &
     &  4HW   ,4HA   ,4HL   ,4HP   ,4HO   ,4HH   ,4HA   ,4HL   ,        &
     &  4HP   ,4HL   ,4HH   ,4HA   ,4HC   ,4HL   ,4HM   ,4HW   ,        &
     &  4HC   ,4HL   ,4HM   ,4HW   ,4HA   ,4HC   ,4HL   ,4HM   ,        &
     &  4HH   ,4HC   ,4HL   ,4HM   ,4HH   /
!
      DATA LENI / 6*6,3*5,4,2,2,4,5,6,6,4,4,3,8*6 /
      DATA LDMI / 13*1,5*10,1,10,1,4*10,2*1 /
      DATA SYMFLP /   4HC   ,4HH   ,4HR   ,4HD   ,4HF   ,4HI   ,        &
     &  4HC   ,4HH   ,4HR   ,4HD   ,4HF   ,4HO   ,4HS   ,4HP   ,        &
     &  4HA   ,4HN   ,4HF   ,4HI   ,4HS   ,4HP   ,4HA   ,4HN   ,        &
     &  4HF   ,4HO   ,4HN   ,4HD   ,4HE   ,4HL   ,4HT   ,4HA   ,        &
     &  4HP   ,4HH   ,4HE   ,4HT   ,4HE   ,4HP   ,4HP   ,4HH   ,        &
     &  4HE   ,4HT   ,4HE   ,4HF   ,4HT   ,4HY   ,4HP   ,4HE   ,        &
     &  4HN   ,4HT   ,4HY   ,4HP   ,4HE   ,4HS   ,4HC   ,4HH   ,        &
     &  4HA   ,4HC   ,4HB   ,4HT   ,4HC   ,4HS   ,4HC   ,4HH   ,        &
     &  4HD   ,4HD   ,4HE   ,4HL   ,4HT   ,4HA   ,4HC   ,4HP   ,        &
     &  4HR   ,4HM   ,4HE   ,4HI   ,4HC   ,4HP   ,4HR   ,4HM   ,        &
     &  4HE   ,4HO   ,4HS   ,4HC   ,4HL   ,4HD   ,4HS   ,4HC   ,        &
     &  4HM   ,4HD   ,4HC   ,4HM   ,4HU   ,4HD   ,4HE   ,4HL   ,        &
     &  4HJ   ,4HE   ,4HT   ,4HJ   ,4HE   ,4HT   ,4HF   ,4HL   ,        &
     &  4HP   ,4HE   ,4HF   ,4HF   ,4HJ   ,4HE   ,4HT   ,4HC   ,        &
     &  4HA   ,4HP   ,4HI   ,4HN   ,4HB   ,4HC   ,4HA   ,4HP   ,        &
     &  4HO   ,4HU   ,4HT   ,4HD   ,4HO   ,4HB   ,4HD   ,4HE   ,        &
     &  4HF   ,4HD   ,4HO   ,4HB   ,4HC   ,4HI   ,4HN   ,4HD   ,        &
     &  4HO   ,4HB   ,4HC   ,4HO   ,4HT   /
!
      DATA LENJ / 4*6,4,4,5,6*6,5 /
      DATA LDMJ / 6*10,8*1 /
      DATA ASYFLP /   4HD   ,4HE   ,4HL   ,4HT   ,4HA   ,4HL   ,        &
     &  4HD   ,4HE   ,4HL   ,4HT   ,4HA   ,4HR   ,4HD   ,4HE   ,        &
     &  4HL   ,4HT   ,4HA   ,4HD   ,4HD   ,4HE   ,4HL   ,4HT   ,        &
     &  4HA   ,4HS   ,4HX   ,4HS   ,4HO   ,4HC   ,4HH   ,4HS   ,        &
     &  4HO   ,4HC   ,4HS   ,4HT   ,4HY   ,4HP   ,4HE   ,4HX   ,        &
     &  4HS   ,4HP   ,4HR   ,4HM   ,4HE   ,4HN   ,4HD   ,4HE   ,        &
     &  4HL   ,4HT   ,4HA   ,4HC   ,4HH   ,4HR   ,4HD   ,4HF   ,        &
     &  4HI   ,4HC   ,4HH   ,4HR   ,4HD   ,4HF   ,4HO   ,4HS   ,        &
     &  4HP   ,4HA   ,4HN   ,4HF   ,4HI   ,4HS   ,4HP   ,4HA   ,        &
     &  4HN   ,4HF   ,4HO   ,4HP   ,4HH   ,4HE   ,4HT   ,4HE   /
!
      DATA LENK / 5,3,5,2,5,6,6 /
      DATA LDMK / 4*1,-1,1,10 /
      DATA HYPEFF /   4HA   ,4HL   ,4HI   ,4HT   ,4HD   ,4HX   ,        &
     &  4HH   ,4HL   ,4HT   ,4HW   ,4HO   ,4HT   ,4HI   ,4HC   ,        &
     &  4HF   ,4HL   ,4HA   ,4HM   ,4HN   ,4HR   ,4HH   ,4HN   ,        &
     &  4HD   ,4HL   ,4HT   ,4HA   ,4HH   ,4HD   ,4HE   ,4HL   ,        &
     &  4HT   ,4HA   /
!
      DATA LENL / 4,2,5,6,2,2,3,4,3,2,2,3 /
      DATA LDML / 3*10,-10,8*1 /
      DATA TRNJET /   4HT   ,4HI   ,4HM   ,4HE   ,4HF   ,4HC   ,        &
     &  4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,4HL   ,4HA   ,4HM   ,        &
     &  4HN   ,4HR   ,4HJ   ,4HN   ,4HT   ,4HM   ,4HE   ,4HI   ,        &
     &  4HS   ,4HP   ,4HS   ,4HP   ,4HA   ,4HN   ,4HP   ,4HH   ,        &
     &  4HE   ,4HG   ,4HP   ,4HC   ,4HC   ,4HL   ,4HF   ,4HP   /
!
      DATA LENM / 5*5,4*4,7*2,2*5,2,2,3,4 /
      DATA LDMM / 22*1 /
      DATA CONTAB /   4HT   ,4HT   ,4HY   ,4HP   ,4HE   ,4HC   ,        &
     &  4HF   ,4HI   ,4HT   ,4HC   ,4HC   ,4HF   ,4HO   ,4HT   ,        &
     &  4HC   ,4HC   ,4HF   ,4HI   ,4HT   ,4HT   ,4HC   ,4HF   ,        &
     &  4HO   ,4HT   ,4HT   ,4HB   ,4HI   ,4HT   ,4HC   ,4HB   ,        &
     &  4HO   ,4HT   ,4HC   ,4HB   ,4HI   ,4HT   ,4HT   ,4HB   ,        &
     &  4HO   ,4HT   ,4HT   ,4HB   ,4H1   ,4HB   ,4H2   ,4HB   ,        &
     &  4H3   ,4HB   ,4H4   ,4HD   ,4H1   ,4HD   ,4H2   ,4HD   ,        &
     &  4H3   ,4HG   ,4HC   ,4HM   ,4HA   ,4HX   ,4H    ,4H    ,        &
     &  4H    ,4H    ,4H    ,4HK   ,4HS   ,4HR   ,4HL   ,4HB   ,        &
     &  4HG   ,4HR   ,4HD   ,4HE   ,4HL   ,4HR   /
!
      END
      SUBROUTINE BODOPT
!
!***  COMPUTES ASYMMETRICAL BODY AERODYNAMICS
!
      COMMON /WINGD/  A(195), B(48)
      COMMON /BDATA/  BD(762)
      COMMON /IBODY/  PBODY, BODY(400)
      COMMON /BODYI/  XNX,X(20),S(20),P(20),R(20),ZU(20),ZL(20),        &
     &                BNOSE,BTAIL,BLN,BLA,DS, dum2(3)
      COMMON /WINGI/  CHRDTP,SSPNOP,SSPNE,SSPN,CHRDBP,CHRDR,SAVSI,SAVSO,&
     &                CHSTAT,SWAFP,TWISTA,SSPNDD,DHDADI,DHDADO,         &
     &                TYPE,                                             &
     &                TOVC,DELTAY,XOVC,CLI,ALPHAI,CLALPA(20),           &
     &                CLMAX(20),CMO,LERI,LERO,CAMBER,TOVCO,XOVCO,CMOT,  &
     &                CLMAXL,CLAMO,TCEFF,KSHARP,SLOPE(6)
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA,IG
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /FLGTCD/ FLC(73), dumflgtcd(87)
      COMMON /OPTION/ SREF,LREF,ROUGFC
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /CONSNT/ CONST(5)
!
      EQUIVALENCE (PI,CONST(1)), (RAD,CONST(4))
      EQUIVALENCE (UNUSED,CONST(3))
      LOGICAL PBODY
      LOGICAL VERTUP
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,           &
     &        TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,                &
     &        HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                     &
     &        VFPL,VFSC,CTAB
      REAL LREF
!
      DIMENSION ROUTID(2),Q15127(3),Q95MX(3),QKPARB(3),QKVARB(3)        &
     &,QALFR(3)
      DIMENSION ALPH(20),CMP(20)
      DIMENSION D(20)
      DIMENSION XE(20),XOLE(20),ZPOLE(20),SE(20),DSEDX(20),YE(20),PE(20)
      DIMENSION CY95(6)
      DIMENSION XBA1(9),YBA1(9),CBA1(6)
      DIMENSION XBA2(9),YBA2(9),CBA2(6)
      DIMENSION X1BA3(5),X2BA3(12),YBA3(60)
      DIMENSION TX95(20),TY95(20)
      DIMENSION XE95(20),YE95(20),PE95(20),SE95(20),DYEDX(20)
      DIMENSION RP(20),RS(20)
      DIMENSION DELA(20)
      DIMENSION X27M(4),X27I(4),C27(6)
!
      DATA ROUTID /4HBODO,4HPT  /,   Q15127 /4H4.1.,4H5.1-,4H27  /,     &
     & Q95MX/4HFIND,4H .95,4HYMAX/,  QKPARB /4H4.2.,4H1.2-,4H36A /,     &
     & QKVARB/4H4.2.,4H1.2-,4H36B /, QALFR/4H4.2.,4H1.2-,4H37  /
      DATA X27I /1.57780,1.67221,1.98509,2.28874/
      DATA X27M /0.0,1.0,2.0,3.0/
      DATA I27  /0/
      DATA RP   /20*1./,  RS/20*1./
!
!---------     FIGURE  BA1   ( KP VS ASPECT RATIO )         ------------
!
      DATA XBA1 /0.0,0.5,1.0,1.5,2.0,2.5,3.0,3.5,4.0/
      DATA YBA1 /0.0,.72,1.33,1.83,2.225,2.575,2.88,3.125,3.37/
!
!---------     FIGURE BA2    ( KV VS ASPECT RATIO )         ------------
!
      DATA XBA2 /0.0,0.5,1.0,1.5,2.0,2.5,3.0,3.5,4.0/
      DATA YBA2 /3.14,3.14,3.15,3.19,3.21,3.626,3.31,3.9,3.47/
!
!---------  FIGURE 4.2.1.2-37
!
      DATA X1BA3 /1.,2.,3.,4.,100./
      DATA X2BA3 /0.,1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,100./
      DATA YBA3  /34.85,31.20,27.55,23.90,20.25,16.60,12.95,11.25,      &
     &     10.30,9.75,9.40,0.,  30.65,25.90,21.15,16.40,11.65,9.10,     &
     &     7.60,6.70,6.10,5.70,5.50,0.,  26.70,20.00,13.30,9.10,        &
     &     7.50,4.90,4.00,3.50,3.10,2.90,2.75,0.,  22.70,16.00,9.30,    &
     &     7.20,5.00,3.95,3.00,2.40,2.05,1.85,1.70,0.,  12*0./
!
      IY95=0
      IBA1=0
      IBA2=0
!
!     ------CALCULATE CD0 -------------
!
      NX=XNX+.5
      BD(1)=X(NX)
      BD(57)=S(NX)
      CALL GETMAX(X,S,NX,BD(2),BD(3),IMAX)
      BD(56)=BD(3)
!
!*****ADJUST BASE AREA IF BODY IS BOAT TAILED ********
!
      IF(BD(57).LE.0.3*BD(56)) BD(57)=0.30*BD(56)
      BD(55)=12.0*BD(1)/ROUGFC
!
!     ------FIGURE 4.1.5.1-27-----------
!
      CALL TBFUNX(B(1),CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,             &
     &           0,0,Q15127,3,ROUTID)
      BD(91)=BD(55)**1.0482*10.0**CEPT
      BD(90)=FLC(M+42)*BD(1)
      RUSE=BD(90)
      IF(BD(91).LT.BD(90))RUSE=BD(91)
!
!     ------FIGURE 4.1.5.1-26-----------
!
      CALL FIG26(RUSE,B(1),BD(92))
!
!     ------CALCULATE SS=PIN -----------
!
      CALL EQSPCE(X,R,P,S,NX,XE,YE,PE,SE,20,DSEDX)
      CALL TRAPZ (PE,20,XE,PIN,1)
      BD(93)=PIN
      BD(86)=SQRT(BD(57)*4./PI)
      BD(85)=SQRT(BD(56)*4./PI)
      BD(75)=BD(1)/BD(85)
      BD(59)=BD(92)*(1.+60./(BD(75)**3)+.0025*BD(75))*BD(93)/BD(56)
      BD(60)=.029*((BD(86)/BD(85))**3/SQRT(BD(59))*BD(56)/SREF)
      BD(59)=BD(59)*BD(56)/SREF
      BD(61)=BD(59)+BD(60)
      BD(10)=BD(61)
!
!---------     COMPUTE SLOPE OF LINE CONNECTING END MIDPOINTS    -------
!
      N=1
      Z0= 0.5*(ZU(N)+ZL(N))
      N=NX
      ZNX= 0.5*(ZU(N)+ZL(N))
      DZDX= (ZNX-Z0)/(X(N)-X(1))
 1020 TEMPD=ATAN(DZDX)*RAD
!
      DO 1050 N=1,NX
!
!---------     COMPUTE BODY DEPTH ARRAY, D                       -------
!
         D(N)= ZU(N)-ZL(N)
         IF(D(N).EQ.0. .AND. N.NE.1)D(N)=UNUSED
!
!---------     COMPUTE LOCUS OF BODY MIDPOINTS (Z-PRIME ARRAY ) --------
!
 1030    BD(N+740)=ZL(N)+ 0.5*D(N) - (X(N)*DZDX + Z0 )
!
!---------     COMPUTE Z-PRIME OVER REFERENCE LENGTH (ZPOL-ARRAY ) -----
!
 1040    BD(N+720)=BD(N+740)/X(NX)
!
!---------     COMPUTE (X)N OVER REFERENCE LENGTH   ( XOL-ARRAY ) ------
!
 1050 BD(N+700)=X(N)/X(NX)
!
!---------     COMPUTE (X)CG/L,  XOVLCG
!
      XOVLCG= XCG/X(NX)
!
!---------     EQUAL SPACE X,XOL,ZPOL, AND S                ------------
!
      CALL EQSPCE (X,BD(701),BD(721),S,NX,XE,XOLE,ZPOLE,SE,             &
     &             20,DSEDX)
!
!---------     COMPUTE NEW ARRAYS OF VALUES TO BE INTEGRATED     -------
!
      DO 1080 L=1,20
         IF(L.GT.1) GO TO 1060
         ALPH(L)=0.0
         CMP(L)=0.0
         GO TO 1080
 1060    CONTINUE
         IF(L.LT.20) GO TO 1070
         ALPH(L)=0.0
         CMP(L)=0.0
         GO TO 1080
 1070    CONTINUE
         ALPH(L) = ZPOLE(L)/((1.0-XOLE(L))*SQRT(XOLE(L)-XOLE(L)**2))
         CMP(L)= ZPOLE(L)*((1.-2.*XOLE(L))/SQRT(XOLE(L)-XOLE(L)**2))
 1080 END DO
!
!---------     COMPUTE ALPHA-ZERO                      -----------------
!
      CALL TRAPZ(ALPH,19,XOLE,ALZERO,1)
 1090 ALPHZR=-ALZERO/PI
 1100 ALPHZD=ALPHZR*RAD
      BD(81)=ALPHZD
!
!---------     COMPUTE TOTAL BODY PLANFORM AREA, SP              -------
!
 1110 CALL EQSPCE(X,R,BD(701),S,NX,XE,YE,XOLE,SE,20,                    &
     &            DSEDX)
      CALL TRAPZ(YE,20,XE,SP,1)
 1120 SP = 2.0 * SP
!
!---------     COMPUTE CM-ZERO                              ------------
!
      CALL TRAPZ(CMP,20,XOLE,CMZP,1)
 1130 CM0=2.*CMZP*(SP/SREF)*(X(NX)/LREF)
      BD(62)=CM0
!
!---------     COMPUTE ASPECT RATIO FOR BODY ALONE, ARB     ------------
!              FIND Y-MAX OF PLANFORM VIEW
!
      CALL GETMAX(X,R,NX,XMAX,YMAX,IMAX)
 1140 ARB= (4.0*YMAX*YMAX)/SP
!
!     -------    LOCATE BODY STATION OF .96 YMAX  ------
!
 1150 Y95=0.96*YMAX
      IM=IMAX-1
      X95=X(IM)+(X(IMAX)-X(IM))*(Y95-R(IM))/(R(IMAX)-R(IM))
!
!---------     FIGURE BA-1 ( KP VS ARB )                    ------------
!
      CALL TBFUNX(ARB,AKP,DKPDAR,9,XBA1,YBA1,CBA1,IBA1,MI,NG,           &
     &            0,2,QKPARB,3,ROUTID)
!
!---------     FIGURE BA-2 (KV VS ARB )                     ------------
!
 1160 CALL TBFUNX(ARB,AKV,DKVDAR,9,XBA2,YBA2,CBA2,IBA2,MI,NG,           &
     &             0,2,QKVARB,3,ROUTID)
!
!---------     FIND SMAX, XSMAX, AND NMAX AT DSDX= ZERO          -------
!
      SMAX=S(NX)
      DEFF=SQRT(4.0*SMAX/PI)
      IF(DEFF.EQ.0.)GO TO 1190
!
!---------     COMPUTE FINENESS RATIO, FR                   ------------
!
 1170 FR= X(NX)/DEFF
!
!---------     FIND DEPTH AND WIDTH AT SMAX                 ------------
!
      YSMAX=R(NX)
      DSMAX=D(NX)
 1180 RATIO= 2.0*YSMAX/DSMAX
      GO TO 1200
 1190 RATIO=3.0
      FR=10.0
 1200 CONTINUE
!
!     -------    COMPUTE PLANFORM AREA FOR BODY LENGTH X95 AT .96YMAX --
!     -------    FIND INDEX OF LOCATION OF .96XMAX
!
      DO 1210  I= 1,NX
         TX95(I)= X(I)
         TY95(I)= R(I)
         IF(X95.GT.X(I)) GO TO 1210
         N95= I
         TX95(I)= X95
         TY95(I)= Y95
         GO TO 1220
 1210 END DO
 1220 CONTINUE
!
!---------     EQUAL SPACE X AND Y ARRAYS FROM X(1) TO X95       -------
!
      CALL EQSPCE(TX95,TY95,RP,RS,N95,XE95,YE95,PE95,SE95,20,DYEDX)
!
!---------     COMPUTE PLANFORM AREA FOR BODY LENGTH X95         -------
!
 1230 CALL TRAPZ(YE95,20,XE95,A95,1)
 1240 A95MAX=2.0*A95
!
!---------     FIGURE BA-3 ( ALPHV VS FR FOR SEVERAL A/B )       -------
!
      CALL TLINEX(X1BA3,X2BA3,YBA3,5,12,RATIO,FR,ALPHV,                 &
     &            2,2,2,2,QALFR,3,ROUTID)
!
!---------     COMPUTE EXPONENT FOR (X/L) CNP CALCULATIONS       -------
!
 1250 EXPON= (2.0*Y95*X95)/A95MAX-1.00
!
!---------     COMPUTE ( X/L )CNP,  XOLCNP                       -------
!
      XOLCNP= 2.0*EXPON/(2.0*EXPON+1.0)
!
!---------     COMPUTE   DELTA(X)/L , DELXOL                     -------
!
      DELXOL= XOVLCG-XOLCNP*(X95  /X(NX))
!
!              COMPUTE AREA ARRAY, DELA
!
      CALL TRAPZ(YE,20,XE,DELA,0)
      DO 1260 J= 1,19
 1260 DELA(J)= DELA(J+1)-DELA(J)
      SUM=0.0
!
!---------     COMPUTE PLANFORM AREA MOMENT OF BODY, SUM         -------
!
      DO 1270 NUM=1,19
 1270 SUM = SUM + 2.0*DELA(NUM) * (XE(NUM)+(XE(NUM+1)-XE(NUM))/2.0)
!
!---------     COMPUTE (X/L).CA.,  XOVLCA                        -------
!
      XOVLCA= (SUM/SP)/X(NX)
!
!********           ALPHA LOOP
!
      BD(94)=FLC(2)
      NALPHA=BD(94)+.5
      DO 1300 J=1,NALPHA
!
!     ---------     REVISED ANGLE-OF-ATTACK  (29 MARCH 71 )
!
 1280    ANGD= FLC(J+22) - ALPHZD
         ANGR= ANGD/RAD
         SA= SIN(ANGR)
         CA=COS(ANGR)
!
!---------     COMPUTE (CNP)J,   BD(680+J)                       -------
!
         BD(J+680)=AKP*SA*CA
!
!---------     COMPUTE (CNV)J,   BD(660+J)                       -------
!
         BD(J+660)=AKV*(SIN((FLC(J+22)-ALPHV)/RAD))**2
         IF(FLC(J+22).LE.ALPHV) BD(J+660)=0.0
!
!---------     COMPUTE (CNTOT)J   BODY(J+40)                     -------
!
 1290    BODY(J+60)=(BD(J+680)+BD(J+660))*(SP/SREF)
!
!-----------------COMPUTE (CD)J -----------------------
!
         BODY(J)=BODY(J+60)*SA + BD(10)
!
!---------     COMPUTE  (CM)CNP ,   BD(234+J)                    -------
!
         BD(J+234)= BD(J+680)*(DELXOL       )*(SP/SREF)*(X(NX)/LREF)
!
!---------     COMPUTE (CM) CNV     BD(114+J)                    -------
!
         BD(J+114)= BD(J+660)*(XOVLCG-XOVLCA)*(SP/SREF)*(X(NX)/LREF)
!
!---------     COMPUTE (CM)J,  BODY(40+J)                        -------
!
         BODY(J+40)= CM0 + BD(J+234) + BD(J+114)
!
!     ------CALCULATE CL AND CA --------
!
         BODY(J+20)=(BODY(J+60)-BODY(J)*SIN(FLC(J+22)/RAD))/COS         &
     &              (FLC(J+22)/RAD)
         BODY(J+80)=BODY(J)*COS(FLC(J+22)/RAD)-BODY(J+20)*SIN(FLC(J+22)/&
     &              RAD)
         B(J+22)=FLC(J+22)+ALIW
         BD(J+214)=BODY(J+60)*SA
 1300 END DO
      BODY(121)=AKP*DELXOL*(SP/SREF)*(X(NX)/LREF)/RAD
      BODY(101)=(AKP*SP)/(RAD*SREF)
      RETURN
      END
      SUBROUTINE BODOWG(ALPHA,XCBO4,RCREO2,BWO2,TRAT,IVBW,GO2PAV,NA)
!
!***  COMPUTES BODY VORTEX EFFECTS ON THE WINGS
!
      COMMON /CONSNT/CONST(5)
      COMMON /BDATA/ BD(762)
      COMMON /BODYI/ XNX,X(20),S(20),P(20),R(20),ZU(20),ZL(20),         &
     &               BNOSE,BTAIL,BLN,BLA,DS, dum2(3)
      EQUIVALENCE (RAD,CONST(4)),(PI,CONST(1))
      DIMENSION ROUTID(2),Q1313A(3),Q1313B(3),Q31314(3),Q31315(3)
!
!     ----BODY EFFECT ON WING
!
      REAL   IVBW
      DIMENSION ALPHA(1),IVBW(1),GO2PAV(1)
      DIMENSION X1313B(11),Y1313B(11),C1313B(6)
      DIMENSION X31314(15),Y31314(15),C31314(6)
      DIMENSION X31315(15),Y31315(15),C31315(6)
!
!     ----FIG 4.3.1.3-13A
!
      DIMENSION X1313A(16),Y1313A(16),C1313A(6)
      DATA Q1313A/4H4.3.,4H1.3-,4H13A /,Q1313B/4H4.3.,4H1.3-,4H13B /,   &
     &     Q31314/4H4.3.,4H1.3-,4H14  /,Q31315/4H4.3.,4H1.3-,4H15  /    &
     &     ,ROUTID/4HBODO,4HWG  /
      DATA I1313A /0/
      DATA X1313A /6.8,7.2,7.5,8.,8.4,9.,9.6,10.4,11.2,12.1,13.4,15.,16.&
     &             ,17.1,18.,20./
      DATA Y1313A /20.,19.,18.,17.,16.,15.,14.,13.,12.,11.,10.,9.,8.5,8.&
     &             ,7.7,7./
!
!     ----FIG 4.3.13-13B
!
      DATA I1313B /0/
      DATA X1313B /0.,.5,1.,2.,2.5,3.3,4.,4.7,5.5,6.,7./
      DATA Y1313B /.86,1.02,1.2,1.52,1.65,1.8,1.92,2.,2.09,2.14,2.23/
!
!     ----FIG 4.3.1.3-14
!
      DATA I31314 /0/
      DATA X31314 /0.,.5,1.,1.5,2.,2.5,3.,3.5,4.,4.5,5.,5.5,6.,6.5,7./
      DATA Y31314 /.5,.57,.62,.66,.69,.71,.72,.735,.75,.755,.76,4*.765/
!
!     ----4.3.1.3-15
!
      DATA I31315 /0/
      DATA X31315 /0.,.5,1.,1.5,2.,2.5,3.,3.5,4.,4.5,5.,5.5,6.,6.5,7./
      DATA Y31315 /.4,.5,.6,.7,.81,.91,1.02,1.13,1.24,1.35,1.47,1.6,1.74&
     &             ,1.88,2.02/
!
!***  GETMAX CROSS SECTIONAL AREA
!
      NX=XNX+.5
      CALL GETMAX(X,S,NX,BD(2),BD(3),IMAX)
      RCREO2=SQRT(BD(3)/PI)
      XRT=XCBO4/RCREO2
      DO 1010 I=1,NA
         ARG=ABS(ALPHA(I))
         IF(ARG.GE.6.)GO TO 1000
         IVBW(I)=0.
         GO2PAV(I)=0.
         GO TO 1010
!
!     ----FIG. 4.3.1.3-13A
!
 1000    CALL TBFUNX(ARG,XOR,DYDX,16,X1313A,Y1313A,C1313A,I1313A,MI,N,  &
     &               0,0,Q1313A,3,ROUTID)
         XD=ARG*(XRT-XOR)/RAD
         IF(XD.LE.0.)GO TO 1005
!
!     ----FIG. 4.3.1.3-13B
!
         CALL TBFUNX(XD,ZOR,DYDX,11,X1313B,Y1313B,C1313B,I1313B,MI,N,   &
     &               0,0,Q1313B,3,ROUTID)
!
!     ----FIG  4.3.1.3-14
!
         CALL TBFUNX(XD,YOR,DYDX,15,X31314,Y31314,C31314,I31314,MI,N,   &
     &               0,1,Q31314,3,ROUTID)
!
!     ----FIG  4.3.1.3-15
!
         CALL TBFUNX(XD,GO2PAV(I),DYDX,15,X31315,Y31315,C31315,I31315,  &
     &               MI,N,0,1,Q31315,3,ROUTID)
         Z0=ZOR*RCREO2
         Y0=YOR*RCREO2
         IVBW(I)=ALI(Z0,Y0,BWO2,RCREO2,TRAT)
 1005    IF(XD.LE.0.)IVBW(I)=0.0
 1010 END DO
      RETURN
      END
      SUBROUTINE BODYJM
!
!***  COMPUTE BODY AERODYNAMICS USING JORGENSEN'S METHOD
!
      COMMON /IBODY/  PBODY,  BODY(400)
      COMMON /BODYI/  XNX, X(20), S(20), P(20), R(20), ZU(20),          &
     &                ZL(20), BNOSE, BTAIL, BLN, BLA, DS,               &
     &                ITYPE,METHOD,ELLIP
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      LOGICAL VERTUP
      COMMON /BDATA/  BD(762)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,II,NALPHA,IG,NF,LF,K
!
      DIMENSION CD(20), CL(20), CM(20), CN(20), CA(20), CDC(20)
      DIMENSION RX(20)
      DIMENSION REQ(20),CNVIS(20),CNPOT(20),CMVIS(20),CMPOT(20)
      EQUIVALENCE (CD(1),BODY(1 )), (CL(1),BODY(21)), (CM(1),BODY(41))
      EQUIVALENCE (CN(1),BODY(61)), (CA(1),BODY(81)), (CDC(1),BD(135))
      EQUIVALENCE (SB,BD(57)), (SP,BD(275)), (ETA,BD(76)), (LB,BD(1))
      EQUIVALENCE (CD0,BD(61))
      EQUIVALENCE (VB,BD(34)),(XC,BD(35))
      EQUIVALENCE (REQ(1),BD(536)),(CNPOT(1),BD(556)),                  &
     & (CNVIS(1),BD(576)),(CMPOT(1),BD(596)),(CMVIS(1),BD(616))
!
      REAL LB, METHOD, ITYPE
!
!***  CALCULATE VB AND XC
!
      NX = XNX+0.5
      DO 1000 I=1,NX
         REQ(I)=SQRT(S(I)/PI)
         RX(I)=REQ(I)*X(I)
 1000 END DO
      CALL TRAPZ(REQ,NX,X,VB,-1)
      CALL TRAPZ(RX ,NX,X,XC, 1)
      CALL TRAPZ(REQ,NX,X,SP, 1)
      SP = 2.0*SP
      XC = 2.0*XC/SP
!
!***  CALCULATE CN, CM, CA, CL, AND CD
!
      A1 = (VB-SB*(LB-XCG))/(SREF*CBARR)
      A2 = (SP*(XCG-XC))/(SREF*CBARR)
      A3 = SB
      IF(ELLIP .LE. UNUSED) ELLIP = 1.0
      IF(ELLIP .EQ. 1.0) A1 = BODY(121)*RAD/2.0
      IF(ELLIP .EQ. 1.0) A3 = BODY(101)*SREF*RAD/2.0
      DO 1010 I=1,NALPHA
        ALP = FLC(I+22)/RAD
        SA  = SIN(ALP)
        CS  = COS(ALP)
        FA  = SIN(2.0*ALP)*COS(ALP/2.0)
        IF(ELLIP.LT.1.)AOB=1./ELLIP
        IF(ELLIP.GE.1.)AOB=ELLIP
        IF(ELLIP.GE.1.)CNOCNS=1./AOB
        IF(ELLIP.LT.1.)CNOCNS=AOB
        CNOCNN=1.0
        IF(ELLIP.LT.1.)CNOCNN=1.5*SQRT(AOB)*(-1./AOB**2/(1.-1./AOB**2)  &
     &     **1.5*ALOG(AOB*(1.+SQRT(1.-1./AOB**2)))+1./(1.-1./AOB**2))
        IF(ELLIP.GT.1.)CNOCNN=1.5*SQRT(1./AOB)*(AOB**2/(AOB**2-1.)**1.5 &
     &                 *ATAN(SQRT(AOB**2-1.))-1./(AOB**2-1.))
        CN(I) = (A3*FA*CNOCNS+SP*ETA*CDC(I)*SA*ABS(SA)*CNOCNN)/SREF
        CM(I) = A1*FA*CNOCNS+A2*ETA*CDC(I)*SA*ABS(SA)*CNOCNN
        CA(I) = CD0*CS**2
        CL(I) = CN(I)*CS-CA(I)*SA
        CD(I) = CA(I)*CS+CN(I)*SA
        CNPOT(I)=A3*FA*CNOCNS/SREF
        CNVIS(I)=SP*ETA*CDC(I)*SA*ABS(SA)*CNOCNN/SREF
        CMPOT(I)=A1*FA*CNOCNS
        CMVIS(I)=A2*ETA*CDC(I)*SA*ABS(SA)*CNOCNN
 1010 END DO
      RETURN
      END
      SUBROUTINE BODYRT
!
!***  COMPUTES AXISYMMETRIC BODY CL,CD,CM
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA,IG
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /OPTION/ SREF, CBARR, ROUGFC
      COMMON /WINGD/  A(195), B(48)
      COMMON /BDATA/  BD(762)
      COMMON /IBODY/  PBODY, BODY(400)
      COMMON /BODYI/  XNX,X(20),S(20),P(20),R(20),ZU(20),ZL(20),        &
     &                BNOSE,BTAIL,BLN,BLA,DS, dum2(3)
      COMMON /CONSNT/ PI, DEG, UNUSED, RAD,kand
!
      LOGICAL PBODY
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
!
      DIMENSION ROUTID(2),QSLNSE(4),QDSDX(3),QS0X0(4),QSLNLN(5),Q21120(3&
     &          ),Q15127(3),Q1217B(3),Q1217A(3)
      DIMENSION XE(20),RE(20),PE(20),SE(20),DSEDX(20)                   &
     &          ,TST(20),DPEDX(20),DREDX(20)
      DIMENSION CXS(6),CXNOSE(6)
      DIMENSION X1217A(8),Y1217A(8),C1217A(6)
      DIMENSION X21120(10),Y21120(10),C21120(6)
      DIMENSION CNSE(6)
      DIMENSION C(6)
      DIMENSION X1217B(14),Y1217B(14),C1217B(6)
      DIMENSION X27M(4),X27I(4),C27(6)
      DATA ROUTID/4HBODY,4HRT  /,QSLNSE/4HCOMP,4HUTE ,4HSLNO,4HSE  /,   &
     & QDSDX/4HFIND,4H DSD,4HX   /,QS0X0/4HFIND,4H S0 ,4HAT X,4H0   /,  &
     & QSLNLN/4HFIND,4H SLN,4HOSE ,4HAT L,4HNOSE/,Q21120/4H4.2.,4H1.1-, &
     & 4H20  /,Q15127/4H4.1.,4H5.1-,4H27  /,Q1217A/4H4.2.,4H1.2-,4H35A /&
     &,Q1217B/4H4.2.,4H1.2-,4H35B /
      DATA X27I/1.57780,1.67221,1.98509,2.28874/
      DATA X27M/0.0,1.0,2.0,3.0/
      DATA I27/0/
!
!     ----FIGURE 4.2.1.2-35B MC LT 1.
!
      DATA I1217B /0/
      DATA X1217B /0.,.2,.3,.36,.4,.5,.6,.7,.77,.8,.86,.9,.98,1./
      DATA Y1217B /1.2,1.2,1.21,1.23,1.27,1.36,1.5,1.67,1.75,1.77,3*1.8,&
     &             1.79/
!
!     ----FIG 4.2.1.2-35A
!
      DATA I1217A /0/
      DATA X1217A/2.,4.,8.,12.,16.,20.,24.,28./
      DATA Y1217A /.56,.6,.66,.71,.74,.76,.775,.79/
!
!     ----4.2.1.1-20
!
      DATA X21120 /4.,5.,6.,8.,10.,12.,14.,16.,18.,20./
      DATA Y21120 /.77,.825,.865,.91,.94,.955,.965,.97,.973,.975/
      DATA I21120 /0/
      NX = XNX + .5
      INSE=0
      IXS=0
      INOSE=0
      IN=0
      BD(1)=X(NX)
      BD(57)=S(NX)
      BD(94)=FLC(2)
      BD(55)=12.*BD(1)/ROUGFC
!
!     ----SET LNOSE IF BODY ALONE
!
      BD(5) = X(NX)
!
!     ----COMPUTE SLNOSE
!
      CALL TBFUNX(BD(5),BD(4),DYDX,NX,X,S,CNSE,INSE,MI,NG,              &
     & 0,0,QSLNSE,4,ROUTID)
!
!     ----SEARCH FOR SMAX
!
      CALL GETMAX(X,S,NX,BD(2),BD(3),IMAX)
      BD(56)=BD(3)
!
!*****ADJUST BASE AREA IF BODY IS BOAT TAILED ********
!
      IF(BD(57).LE.0.3*BD(56)) BD(57)=0.30*BD(56)
      DO 1000 K=2,NX
         IF(S(K).GE.S(K-1))GO TO 1000
         GO TO 1010
 1000 END DO
!
!     ----HERE FOR BODY NEVER DECREASING
!
      X1=X(NX)
      GO TO 1030
!
!     ----FIG 4.2.1.1-20
!
 1010 DO 1020 K=1,NX
         CALL TBFUNX(X(K),SX,DSDX,NX,X,S,C,IN,MI,NG,                    &
     &               2,1,QDSDX,3,ROUTID)
         BD(K+174)=-DSDX
 1020 END DO
      CALL GETMAX(X,BD(175 ),NX,X1,DSDXM,IMAX)
 1030 BD(7)=0.378*BD(1)+0.527*X1
      IF(BD(7).GT.BD(5)) GO TO 1040
!
!     ----X0.LE.LNOSE     ----FIND S0 AT X0
!
      CALL TBFUNX(BD(7),BD(6),DYDX,NX,X,S,CXS,IXS,MI,NG,                &
     &            0,0,QS0X0,4,ROUTID)
      TMP1 = BD(6)
      TMP2 = BD(3)
      TMP3 = BD(1)
      TMP5 = BD(7)
      GO TO 1050
!
!     ----X0.GT.LNOSE     ----CALCULATE SLNOSE AT LNOSE
!
 1040 CALL TBFUNX(BD(5),BD(4),DYDX,NX,X,S,CXNOSE,INOSE,MI,NG,           &
     &            0,0,QSLNLN,5,ROUTID)
      TMP1 = BD(4)
      TMP2 = BD(4)
      TMP3 = BD(5)
      TMP5 = BD(5)
 1050 TMP4 = TMP3/SQRT(TMP2*4./PI)
!
!     ----4.2.1.1-20
!
      CALL TBFUNX(TMP4,BD(9),DYDX,10,X21120,Y21120,C21120,I21120,MI,NG, &
     &            2,1,Q21120,3,ROUTID)
      BODY(101)=2. * BD(9)*TMP1 /(RAD*SREF)
!
!     -----EQUAL SPACE P AND X ---------
!
      CALL EQSPC1(X,P,NX,XE,PE,20,DPEDX)
      CALL TRAPZ(PE,20,XE,PIN,1)
      DO 1060 L=1,NX
         IF(X(L) .GE. TMP5) GO TO 1070
 1060 END DO
 1070 CONTINUE
      SAVE1 = X(L)
      SAVE2 = S(L)
      X(L)  = TMP5
      S(L)  = TMP1
      DO 1075 K=2,L
      IF(S(K)-S(K-1).EQ.0.0)GO TO 1075
      IL=K
 1075 END DO
      CALL EQSPC1(X,S,IL,XE,SE,20,DSEDX)
!
!     ----CMA COMPUTATION
!
      CONST=2.*BD(9)/(RAD*SREF*CBARR)
      DO 1080 I=1,20
 1080 TST(I)=DSEDX(I)*XE(I)
      CALL TRAPZ(TST,20,XE,TMP,1)
      BODY(121)=(BD(33)*BODY(101)/CBARR)-CONST*TMP
!
!     ----COMPUTE PITCHING MOMENT
!
      CALL EQSPC1(X(L),R(L),NX-L+1,XE,RE,20,DREDX)
      CALL TRAPZ(RE,20,XE,RIN,1)
      BD(88)=RIN
      DO 1090 I=1,20
 1090 TST(I)=RE(I)*XE(I)
      CALL TRAPZ(TST,20,XE,RXDFI,1)
      BD(90)=FLC(M+42)*BD(1)
!
!     ----FIG 4.1.5.1-27 EQUATION
!
      CALL TBFUNX(B(1),CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,             &
     &            0,0,Q15127,3,ROUTID)
      BD(91)=BD(55)**1.0482*10.0**CEPT
      RUSE=BD(90)
      IF(BD(91).LT.BD(90))RUSE=BD(91)
!
!     ----FIG 4.1.5.1-26
!
      ARG=B(1)
      IF(TRANSN)ARG=.60
      CALL FIG26(RUSE,ARG,BD(92))
      BD(93)=PIN
      BD(86)=SQRT(BD(57)*4./PI)
      BD(85)=SQRT(BD(56)*4./PI)
      BD(75)=BD(1)/BD(85)
      BD(59)=BD(92)*(1.+60./(BD(75)**3)+.0025*BD(75))*BD(93)/BD(56)
      BD(60)=.029*((BD(86)/BD(85))**3/SQRT(BD(59))*BD(56)/SREF)
      BD(59)=BD(59)*BD(56)/SREF
      BD(61)=BD(59)+BD(60)
      BD(10)=BD(61)
      X(L) = SAVE1
      S(L) = SAVE2
      IF(TRANSN)RETURN
!
!     ----LOOP ON ALPHA
!
      NALPHA = BD(94)+.5
      DO 1100 J=1,NALPHA
         AP=BD(J+254)
         SINA=SIN(AP/RAD)
         SINA2=SINA**2
         BD(J+154)=BODY(101)*AP
         AMSNA=B(1)*ABS(SINA)
!
!     ----FIGURE 4.2.1.2-35B
!
         CALL TBFUNX(AMSNA,BD(J+134),DYDX,14,X1217B,Y1217B,C1217B,      &
     &               I1217B,MI,NG,0,0,Q1217B,3,ROUTID)
!
!     ----FIGURE 4.2.1.2-35A
!
         CALL TBFUNX(BD(75),BD(76),DYDX,8,X1217A,Y1217A,C1217A,I1217A,  &
     &               MI,NG,2,2,Q1217A,3,ROUTID)
         SGN=1.0
         IF(AP.LT.0.)SGN=-1.0
         BD(J+194)=2.*SINA2*BD(76)*BD(J+134)*BD(88)/SREF*SGN
         BODY(J+20)=BD(J+154)+BD(J+194)
!
!     ----CMJ COMPUTATION
!
         BODY(J+40)=BODY(121)*AP-2.*SINA2*BD(J+134)*BD(76)*(RXDFI-      &
     &              BD(33)*BD(88))/(CBARR*SREF)*SGN
!
!     ----COMPUTE  CDJ
!
         BD(J+214)=BD(J+154)*SINA+BD(J+194)*SINA
         BODY(J)=BD(61)+BD(J+214)
         BODY(J+60)=BODY(J+20)*COS(AP/RAD)+BODY(J)*SINA
         BODY(J+80)=BODY(J)*COS(AP/RAD)-BODY(J+20)*SINA
 1100 END DO
      RETURN
      END
      SUBROUTINE CACALC(B,WING)
!
!***  COMPUTES WING CN,CA
!
      DIMENSION B(1),WING(1)
      COMMON/CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON/OVERLY/ NLOG,NMACH,I,NALPHA
      DO 1000 M=1,NALPHA
!
!*********     REVISED EQUATION FOR (CN)WING AND (CA)WING
!              COMPUTE SIN(ALPHA) AND COS(ALPHA)
!
         CA=COS(B(M+22)/RAD)
         SA= SIN(B(M+22)/RAD)
!
!***     COMPUTE REVISED (CN)WING AND STORE IN WING(M+60)
!
         WING(M+60)= WING(M+20)*CA + WING(M)*SA
!
!***     COMPUTE (CA) WING AND STORE IN WING(M+80)
!
         WING(M+80)= WING(M)*CA - WING(M+20)*SA
 1000 END DO
      RETURN
      END
      SUBROUTINE CALCA(DYN,A,WINGIN)
!
!***  COMPUTES WING ACCELERATION PARAMETERS
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      REAL MACOE
      REAL KGIN
      REAL   K6,LAME,KCMQ,KCLQ,KPG,MACH,LAMTR
      DIMENSION DYN(213),A(195),WINGIN(77)
      DIMENSION ROUTID(2)
      DIMENSION IEGIN(4),IGM(4),IKGIN(4),IEDM(4)
      DIMENSION XEGIN(14),YEGIN(14)
      DIMENSION XKGIN(17),YKGIN(17)
      DIMENSION XGM(12),YGM(12)
      DIMENSION XEDM(14),YEDM(14)
      DIMENSION QEGIN(2),QGM(1),QKGIN(2),QEDM(1)
      DATA ROUTID /4HCALC,4HA   /
      DATA IEGIN  /14,3*0/,IGM/12,3*0/,IKGIN/17,3*0/,IEDM/14,3*0/
      DATA QEGIN  /4HQEGI,4HN   /
      DATA QGM    /4HQGM /
      DATA QKGIN  /4HQKGI,4HN   /
      DATA QEDM   /4HQEDM/
      DATA XEGIN  /0.,.025,.05,.1,.15,.2,.3,.4,.5,.6,.7,.8,.9,1.0 /
      DATA YEGIN  /1.,1.,.996,.984,.969,.951,.912,.868,.827,.782,.743,  &
     &             .706,.669,.637/
      DATA XGM    /0.,.05,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
      DATA YGM/1.,.984,.96,.883,.802,.728,.657,.595,.540,.495,.459,.425/
      DATA XKGIN /0.,.025,.05,.1,.15,.2,.25,.3,.35,.4,.45,.5,.6,.7,.8,  &
     &            .9,1./
      DATA YKGIN /.14,.198,.229,.272,.305,.334,.358,.381,.401,.424,.444,&
     &            .464,.501,.537,.571,.605,.637/
      DATA XEDM  /0.,.025,.05,.1,.15,.2,.3,.4,.5,.6,.7,.8,.9,1./
      DATA YEDM  /1.,1.,.997,.985,.969,.952,.913,.87,.827,.782,.743,    &
     &            .707,.669,.637/
!
      MACH=FLC(IM+2)
      BETA=SQRT(MACH**2-1.)
      B2=BETA
      PIO2=PI/2.
      D=(WINGIN(4)-WINGIN(3))*2.
      B=2.*WINGIN(4)
      DB=D/B
      K6=BETA/TAN(A(58)/RAD)
      CR=A(9)
      S=(CR+WINGIN(1))*WINGIN(4)
      SE=A(3)
      ARE=A(7)
      LAME=A(27)
      GG=BETA/(TAN(A(58)/RAD)+(4./ARE)*((LAME-1.)/(LAME+1.)))
      CALL INTERX(1,XEGIN,GG,IEGIN,YEGIN,EGIN,14,14,1,0,0,0,1,0,0,0,    &
     &            QEGIN,2,ROUTID)
      CALL INTERX(1,XGM,K6,IGM,YGM,GM,12,12,1,0,0,0,1,0,0,0,            &
     &            QGM,2,ROUTID)
      CALL INTERX(1,XKGIN,GG,IKGIN,YKGIN,KGIN,17,17,1,0,0,0,1,0,0,0,    &
     &            QKGIN,2,ROUTID)
      CALL INTERX(1,XEDM,K6,IEDM,YEDM,EDM,14,14,1,0,0,0,1,0,0,0,        &
     &            QEDM,2,ROUTID)
      EPM=1./EDM
      EPG=1./EGIN
      KPG=1./KGIN
      W=(4.*K6)/(ARE*B2*(1.+LAME))
      SN=1.-(1.-LAME)*W
      A1=(1.+K6)
      A2=(1.+SN)
      A3=(A1*A2+W*(K6-1.))*(W+SN-1.)
      A4=1.-K6
      A5=A1*SN+K6*W
      A6=A2+W
      A7=A2-W
      A8=A1-W
      A9=SN+K6
      IF(A2.LT.0.0)RETURN
      IF(A3.LT.0.0)RETURN
      IF(SN.GE.1.0.OR.(SN.LT.0.0))RETURN
      A4SQ=A4**2
      A1SR=SQRT(A1)
      A2SR=SQRT(A2)
      A3SR=SQRT(A3)
      A4SR=SQRT(A4)
      A31P5=A3*A3SR
      A11P5=A1*A1SR
      A3A1SR=A3SR*A1SR
      A42P5=A4SQ*A4SR
      A21P5=A2*A2SR
      A41P5=A4*A4SR
      A43PR=A4SQ*A4*A4SR
      SN2=SN**2
      SN3=SN*SN2
      SN2M1=SN2-1.
      SN2M1S=SQRT(-SN2M1)
      CM1=3.*(1.-PIO2/KPG)
      CM2=W*CM1
      CM3=(EPG-GG**2*KPG)/(KPG-EPG)
      SN4=SN2**2
      SN5=SN4*SN
      CM4=4.*SN5-12.*SN3+23.*SN
      A10=ARCSIN((A1*(SN2M1   )+W*(1.+SN*K6))/(W*A9))-ARCSIN(SN)
      A11=ARCSIN((W-1.-K6*(W+SN))/A9)+PIO2
      A12=(SN+W)*(SN-K6)-A9+2.*(W-1.)
      A13=ARCSIN(A12/(A6*A9))+PIO2
      OO=0.
      OOO=0.
      O4=0.
      IF(GG.GE.1..OR.GG.LE.0.)GO TO 1000
      OO=  ((8.0*K6*W**2)/GG)*(CM1 +(SN/W)*(2.-(EPG/KPG)                &
     &   -CM3)+(SN2/(2.0*W**2))*(1.-((PI*(1.-GG**2))/(4.0*(KPG-EPG)))))
      OOO=(2.*K6/(3.*GG))*(CM2  +SN*(1.-CM3))
      O4=(K6/GG)*(SN*(1.-EPG/KPG)+CM2)
 1000 CONTINUE
      Q=3.*GM*((W**4/(SN2M1   )**3)*((A8**2*(2.*SN**5+12.*SN**3+SN)+A5* &
     &  (A8*(-27.*SN**2-3.)+A5*CM4   ))/(W**3*A9**3)*                   &
     &  (A3A1SR     )+A10*                                              &
     &  (3.0*(2.*SN**2+3.)/(SN2M1S        ))-CM4       )+               &
     &  (A1SR  /A4**3)*((3.0*(2.*K6**2+3.)/A4SR  )*A11                  &
     &  +((A8**2*(-2.*K6**5-12.*K6**3-K6)+A5*(A8*(-27.                  &
     &  *K6**2-3.)+A5*(-4.*K6**5+12.*K6**3-23.*K6)))/(A9**3*A1**2))*A3SR&
     &   )-OO)
!
      C=((8.0*A4*A9*(3.+27.*K6+37.*K6**2+13.*K6**3)+(12.+14.*K6+21.*K6**&
     &2+13.*K6**3)*(-3.*A4*A8+5.0*K6*A9))/(3.*A4**2*A9**4))*A3**1.5+((15&
     &.*(8.+6.*K6+3.*K6**2+3.0*K6**3))/(2.*A4**3))*((((W-1.)-K6*(W+SN))/&
     &(-A9**2))*A3**.5-(1.0/A4**.5)*A11)                                &
     &-((((4.-2.*SN+9.*SN**2)*(3.+2.*K6)+5.*K6**2*(SN-2.))*(-6.*A2*A8-5.&
     &*A9*A7)-2.0*A2*A9*(8.*W*(3.+2.*K6)*(9.*SN-1.)+20.*K6*(K6*W+(2.-SN)&
     &*A1)))/(6.0*A2**2*A9**4))*A3**1.5
!
      F=(((4.0-2.*SN+9.*SN**2)*(3.+2.*K6)+5.*K6**2*(SN-2.))*(5.*A7**2+4.&
     &*W*A2)+2.*A2*A7*(8.0*W*(3.+2.*K6)*(9.*SN-1.)+20.*K6*(K6*W+(2.-SN)*&
     &A1))+16.0*W*A2**2*(9.*W*(3.+2.*K6)-5.*K6*A1))*((A12/              &
     &(-A9**2))*A3**.5-((A6**2)/(2.0*A2**.5))*A13)
!
      KCMQ=(-2.*K6**2)/(ARE*B2**2*(3.*W**2-3.*W*(1.0-SN)+(1.0-SN)**2)**2&
     &)*(Q+(8.0/(5.*PI*A1**1.5))*(C-(1./(16.*A2**3))*F))
!
      O=((W*((2.*SN**2-1.0)*(SN**2-1.)*A1-W*(2.*SN**2*(1.-SN*K6)+(5.*SN*&
     &K6+1.))))/(3.0*(SN**2-1.)**2*A9**2))*(A3*A1)**.5-((W**3*(2.*SN**3-&
     &5.0*SN))/(3.*(SN**2-1.)**2))-(W**3/((SN**2-1.)**2*(1.-SN**2)**.5))&
     &*A10+(A1**.5/A4**2.5)*A11-(((-2.*K6**3*SN+5.*SN*K6+2.*K6**2+1.)-W*&
     &(2.*K6**2-1.)*(K6-1.))/(3.*(K6-1.)**2*A9**2))*(A3*A1)**.5-OOO
!
      P=(((A9*(3.0-K6)*A1))/(3.*A2*A4*A9**3))*A3**1.5+((3.+K6)/A4**2)*((&
     &((W-1.0)-K6*(W+SN))/(-2.*A9**2))*A3**.5-(1./(2.*A4**.5))*A11)-((A7&
     &*(3.0*SN+2.*SN*K6+K6**2)+2.*A2*(W*(3.+2.*K6)-K6*A1))/A2**2)*((A12/&
     &(-8.*A9**2))*A3**.5-(A6**2/(16.*A2**.5))*A13)
!
      KCLQ=((4.*K6)/(B2*(3.*W**2-3.*W*(1.-SN)+(1.-SN)**2)))*(3.*GM*O+(8.&
     &/(PI*A1**1.5))*P)
!
      CMA=((2.*K6)/(B2*(3.*W**2-3.*W*(1.-SN)+(1.-SN)**2)))*((1./EPM)*(((&
     &W*SN*(K6-1.0)**2*(3.*W*SN-W*K6*(SN**2-4.)-SN*(SN**2-1.)*A1)+K6*(SN&
     &**2-1.0)**2*(4.*SN+3.*K6-SN*K6**2+K6*W*A4))/((SN**2-1.)**2*(K6-1.)&
     &**2*A9**2))*(A3*A1)**.5+((W**3*(SN**2+2.))/((SN**2-1.)**2*(1.-SN**&
     &2)**.5))*A10+((W**3*(SN**3-4.*SN))/((SN**2-1.)**2))-((A1**.5*(K6**&
     &2+2.0))/A4**2.5)*A11+O4                                           &
     &  )+(8.0/(PI*A1**.5))*(((-(A3**1.5))/(A9**2*A4*A2))-((A7*(2.-SN)-2&
     &.0*W*A2)/A2)*((A12/(-8.*A2*A9**2))*A3**.5-((A6**2)/(16.*A2**1.5))*&
     &A13)-((2.*K6+1.)/A4)*((((W-1.)-K6*(W+SN))/(-2.*A4*A9**2))*A3**.5-(&
     &1./(2.*A4**1.5))*A11)))
!
      CLDA2=((4.*K6)/(B2**3*(3.*W**2-3.*W*(1.-SN)+(1.-SN)**2)))*(EDM*(((&
     &2.0*W*(K6**2-1.)*(SN**2-1.)                                       &
     &                +(1.+SN*K6)*(W**2*(K6-1.)+A1*(SN**2-1.)))/((SN**2-&
     &1.)*(K6-1.)*A9**2))*(A3*A1)**.5+(W**3/((SN**2-1.)*(1.-SN**2)**.5))&
     &*A10-((SN*W**3)/(SN**2-1.))+(A1/A4)**1.5*A11)+(8./(PI*A1**.5))*(((&
     &(K6-1.)*A6*(2.*A2*A8-A7*A9)+4.*A2*((1.+SN*K6)+W*(K6-1.)))/(4.*A2*A&
     &4*A9**2))*A3**.5+(A6**3/(8.*A2**1.5))*A13-(1./A4**1.5)*A11))
!
      CMDA2A=                                                           &
     &      ((6.*K6**2)/(ARE*B2**4*(3.0*W**2-3.*W*(1.-SN)+(1.-SN)**2)**2&
     &))
!
      CMDA2B=                                                           &
     &   (3.0*EDM*((1./(3.*(SN**2-1.)**3*(K6-1.)**3*A1**1.5*A9**3))*(A8*&
     &*2*(W*(K6-1.)**3*A1**2*(-2.*SN**5+SN**3+SN)-(SN**2-1.)**3*(2.*K6**&
     &5-K6**3-K6))+A5*A8*(W*(K6-1.)**3*A1**2*(3.*SN**4-3.)-(SN**2-1.)**3&
     &*(3.0*K6**4-3.))+A5**2*(W*(K6-1.)**3*A1**2*(2.*SN**5-7.*SN**3+5.0*&
     &SN)+(SN**2-1.0)**3*(2.*K6**5-7.*K6**3+5.*K6)))*A3**.5+(A1**1.5/A4*&
     &*2.5)*A11-((W**4*(2.*SN**5-7.*SN**3+5.*SN))/(3.*(SN**2-1.)**3))   &
     &                                                      -(W**4/(1.-S&
     &N**2)**2.5)*A10))
!
      CMDA2C=         ((8./(5.*PI*A1**.5))*((((5.0*SN*((SN+W)*A4+A1)+10.&
     &*K6)*A3**1.5)/(A2*A4*A9**3))+((5.0*(2.+K6))/A4**2)*(((W*A4-(1.+SN*&
     &K6))/(-A9**2))*A3**.5-(1./A4**.5)*A11)-((5.0*(2.*(3.*W+2.)*(W+SN**&
     &2)-(2.+SN-10.*SN*W-3.*SN**3-3.*SN*W**2)))/(8.*A2**2))*(((-2.*A2*A8&
     &+A9*A7)/(-A9**2))*A3**.5-(A6**2/(2.0*A2**.5))*A13)))
!
      CMDA2=CMDA2A*(CMDA2B+CMDA2C)
      CMDA2=-CMDA2
      CMDA3A=                                                           &
     &      (2.*MACH**2/(B2**2))
      CMDA3B=                                                           &
     &                           ((3.0*K6**2)/(ARE*B2**2*(3.0*W**2-3.*W*&
     &(1.-SN)+(1.-SN)**2)**2))*((3.0/EPM)*((1./(3.*A9**3*(SN**2-1.)**3*(&
     &K6-1.)**3*A1**1.5))*(A8**2*(W*(K6-1.)**3*A1**2*(11.*SN**3+4.*SN**5&
     &)+(SN**2-1.)**3*(11.0*K6**3+4.*K6**5))-A5*A8*(W*(K6-1.)**3*A1**2*(&
     &27.*SN**2+3.*SN**4)-(SN**2-1.0)**3*(27.*K6**2+3.*K6**4))+A5**2*(W*&
     &(K6-1.)**3*A1**2*(2.0*SN**5-5.*SN**3+18.*SN)-(SN**2-1.)**3*(5.*K6*&
     &*3-18.0*K6-2.*K6**5)))*A3**.5-((W**4*(2.*SN**5-5.*SN**3+18.*SN))/(&
     &3.0*(SN**2-1.)**3))+((W**4*(3.*SN**2+2.))/((SN**2-1.)**3*(1.-SN**2&
     &)**.5))*A10+(((3.0*K6**2+2.)*A1**.5)/A4**3.5)*A11))
!
      CMDA3C=                                                           &
     &                                                  ((4./(5.*PI*A1**&
     &.5))*(((A4**2*A9*(5.*A7*(8.0-4.*SN+3.*SN**2)-16.*W*A2*(2.-3.*SN))+&
     &6.0*A2*A4*A8*(A4*(8.-4.*SN+3.*SN**2)-A2*(8.+4.*K6+3.*K6**2))+2.*A2&
     &**2*A9*(16.0+64.*K6+4.*K6**2-9.*K6**3))/(3.*A2**2*A4**2*A9**4))*A3&
     &**1.5-((5.*(4.*W*A2*(3.*SN**2+4.*W)+A7**2*(8.-4.*SN+3.*SN**2)))/(8&
     &.0*A2**3))*(((-2.*A2*A8+A7*A9)/(-A9**2))*A3**.5-(A6**2/(2.*A2**.5)&
     &)*A13)+((5.0*(4.+4.*K6+7.*K6**2))/A4**3)*(((W*A4-(1.+SN*K6))/(-A9*&
     &*2))*A3**.5-(1./A4**.5)*A11)))
!
      CMDA3=CMDA3A*(CMDA3B+CMDA3C)
      DYN(16)=CLDA2*B2**2
      DYN(27)=CMDA2*B2**2
      DYN(22)=KCLQ+2.*CMA
      DYN(26)= KCMQ+CMDA3*B2**2/MACH**2
      RETURN
      END
      SUBROUTINE CALCA0(A,B,AIN)
!
!***  COMPUTES LIFTING SURFACE ALPHA ZERO LIFT
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      DIMENSION ROUTID(2)
      DIMENSION A(195),B(49),AIN(64)
      DIMENSION TR(3),AR(4),SAQC(22),DA0OT(22,10),DA(220)
      DIMENSION DAP(132),DAPP(88)
      EQUIVALENCE (DAP(1),DA(1)),(DAPP(1),DA(133))
      DIMENSION NPT(7),LOCX(7),LOCY(7),CC(6,7),IN(7),MI(7)
      DIMENSION TOC(7) , CX(12),CY(33)
      LOGICAL CAMBER,NOINTP,NOINT2 , NOINT3
      EQUIVALENCE (CAMBER,CAFAKE)
      EQUIVALENCE (DA0OT(1,1) , DA(1))
      DIMENSION Q41315(3)
      DATA Q41315 /4H4.1.,4H3.1-,4H5   /
      DATA ROUTID /4HCALC,4HA0  /
      DATA TR     /0.,.5,1./ , AR/1.5,3.5,6.0,10./
      DATA SAQC   /-45.,-40.,-35.,-30.,-25.,-20.,-15.,-10.,-5.,0.,      &
     &    5.,10.,15.,20.,25.,30.,35.,40.,45.,50.,55.,60./
      DATA DAP/-.399  ,-.3995 ,-.400  ,-.400  ,-.4005 ,-.4005 ,-.4005 , &
     & -.4005 ,-.4005 ,-.400  ,-.400  ,-.400  ,-.3995 ,-.3990 ,-.3985 , &
     & -.398  ,-.397  ,-.3955 ,-.3940 ,-.385  ,-.380  ,-.372  ,         &
     &         -.384  ,-.385  ,-.3855 ,-.386  ,-.386  ,-.3865 ,-.386  , &
     & -.3855 ,-.3845 ,-.384  ,-.3825 ,-.3815 ,-.380  ,-.378  ,-.375  , &
     & -.372  ,-.369  ,-.364  ,-.358  ,-.350  ,-.3435 ,-.335  ,         &
     &         -.375  ,-.375  ,-.375  ,-.3745 ,-.374  ,-.373  ,-.372  , &
     & -.371  ,-.370  ,-.3685 ,-.367  ,-.365  ,-.362  ,-.359  ,-.355  , &
     & -.3515 ,-.347  ,-.342  ,-.336  ,-.331  ,-.325  ,-.318  ,         &
     &         -.417  ,-.4155 ,-.414  ,-.413  ,-.412  ,-.411  ,-.4105 , &
     & -.410  ,-.4095 ,-.409  ,-.408  ,-.4075 ,-.407  ,-.4065 ,-.406  , &
     & -.405  ,-.404  ,-.4025 ,-.401  ,-.396  ,-.393  ,-.387  ,         &
     &         -.430  ,-.427  ,-.424  ,-.422  ,-.420  ,-.4175 ,-.4155 , &
     & -.414  ,-.412  ,-.410  ,-.4085 ,-.407  ,-.405  ,-.403  ,-.401  , &
     & -.399  ,-.396  ,-.393  ,-.390  ,-.385  ,-.381  ,-.375  ,         &
     &         -.437  ,-.434  ,-.431  ,-.428  ,-.4245 ,-.422  ,-.419  , &
     & -.417  ,-.414  ,-.412  ,-.409  ,-.407  ,-.404  ,-.402  ,-.399  , &
     & -.3965 ,-.394  ,-.391  ,-.3885 ,-.3875 ,-.386  ,-.380/
      DATA DAPP/-.419 ,-.417  ,-.416  ,-.414  ,-.413  ,-.413  ,-.412  , &
     & -.411  ,-.4105 ,-.410  ,-.4095 ,-.409  ,-.408  ,-.4075 ,-.407  , &
     & -.406  ,-.405  ,-.4035 ,-.402  ,-.400  ,-.395  ,-.390  ,         &
     &         -.4405 ,-.4365 ,-.433  ,-.430  ,-.427  ,-.425  ,-.422  , &
     & -.4205 ,-.419  ,-.4175 ,-.416  ,-.415  ,-.413  ,-.412  ,-.410  , &
     & -.409  ,-.407  ,-.406  ,-.406  ,-.4055 ,-.405  ,-.405  ,         &
     &         -.456  ,-.451  ,-.447  ,-.442  ,-.439  ,-.436  ,-.433  , &
     & -.431  ,-.4285 ,-.426  ,-.424  ,-.422  ,-.420  ,-.419  ,-.417  , &
     & -.416  ,-.415  ,-.414  ,-.415  ,-.416  ,-.417  ,-.418  ,         &
     &         -.469  ,-.465  ,-.460  ,-.456  ,-.452  ,-.449  ,-.445  , &
     & -.442  ,-.439  ,-.437  ,-.434  ,-.432  ,-.429  ,-.428  ,-.426  , &
     & -.425  ,-.424  ,-.423  ,-.423  ,-.423  ,-.424  ,-.425/
      DATA IN   /7*0/
      DATA TOC  /16.,14.,12.,10.,9.,8.,7./
      DATA NPT  /7,6,4,4,3,4,5/
      DATA LOCX /1,3,5,6,8,8,8/
      DATA LOCY /1,8,14,18,22,25,29/
      DATA CX   /.4,.45,.5,.55,.6,.65,.7,.75,.8,.85,.9,.95/
      DATA CY /1.,.95,.85,.65,.35,-.15,-1. , 1.,.95,.75,.45,-.06,-1.25 ,&
     & 1.,.9,.6,-.5 , 1.,1.,.85,.1 , 1.,.8,0. , 1.,.95,.65,0. ,         &
     & 1.,1.,.95,.85,.55/
!
      CAFAKE = AIN(64)
      IF(AIN(10).EQ.UNUSED) GO TO 1000
      A(134)=AIN(10)
      GO TO 1010
 1000 A(134)=AIN(20)-AIN(19)/A(131)
!
!     ----TEST FOR TWIST
!
 1010 IF(ABS(AIN(11)).LT.0.5) GO TO 1160
!
!     ----HAVE TWIST-CALCULATE CORRECTED ALPHA0
!
      NOINTP = .FALSE.
      NOINT2 = .FALSE.
      NOINT3  = .FALSE.
      DO 1030 I=1,3
         II = I
         TEMP = A(27) - TR(I)
         IF(ABS(TEMP).LT.2.E-2) GO TO 1040
         IF(TEMP.LT.0.) GO TO 1050
         TEMPP = TEMP
 1030 END DO
 1040 NOINTP = .TRUE.
 1050 ITR = 3*(II-1)
      IF(II.EQ.1) NOINTP =.TRUE.
      IF(.NOT.NOINTP) TRR = TEMPP/(TEMPP-TEMP)
      DO 1060 I=1,4
         II = I
         TEMP2 = A(7) - AR(I)
         IF(ABS(TEMP2).LT.2.E-2) GO TO 1070
         IF(TEMP2.LT.0.) GO TO 1080
         TEMPP2 = TEMP2
 1060 END DO
 1070 NOINT2 = .TRUE.
 1080 IAR = II
      IF(II.EQ.1) NOINT2 =.TRUE.
      IF(.NOT.NOINT2) ARR = TEMPP2/(TEMPP2-TEMP2)
      DO 1090 I=1,22
         II = I
         TEMP3 = A(40) - SAQC(I)
         IF(ABS(TEMP3).LT.2.E-2) GO TO 1100
         IF(TEMP3.LT.0.0) GO TO 1110
         TEMPP3 = TEMP3
 1090 END DO
 1100 NOINT3= .TRUE.
 1110 IF(II.EQ.1) NOINT3 = .TRUE.
      IF(.NOT.NOINT3) SAR = TEMPP3/(TEMPP3-TEMP3)
      IP1=1
      IF(IAR.EQ.4.AND.A(7).LE.0.5)IAR=3
 1120 IDX=ITR+IAR
      D2=DA0OT(II,IDX)
      IF(.NOT.NOINT3)D2=DA0OT(II-1,IDX)+SAR*(D2-DA0OT(II-1,IDX))
      IF(NOINT2) GO TO 1130
      IDX=IDX-1
      D1=DA0OT(II,IDX)
      IF(.NOT.NOINT3)D1=DA0OT(II-1,IDX)+SAR*(D1-DA0OT(II-1,IDX))
      D2=D1+ARR*(D2-D1)
 1130 IF(NOINTP) GO TO 1150
      IF(IP1.EQ.2) GO TO 1140
      IP1=IP1+1
      ITR=ITR-3
      DSV=D2
      IF(IAR.EQ.4) IAR=3
      GO TO 1120
 1140 D2=D2+TRR*(DSV-D2)
 1150 A(135)=D2
      A(134) = AIN(11) * A(135) + A(134)
!
!     ----TEST FOR CAMBER
!
 1160 CONTINUE
      IF(.NOT.CAMBER) GO TO 1230
!
!     ----HAVE CAMBER-CALCULATE ALPHA0 FOR EACH MACH NUMBER
!
      NOINTP = .FALSE.
      DO 1170 I=1,7
         II = I
         TEMP = 100.*AIN(16) - TOC(I)
         IF(ABS(TEMP).LT.2.E-2) GO TO 1180
         IF(TEMP.GT.0.0) GO TO 1190
         TEMPP = TEMP
 1170 END DO
 1180 NOINTP = .TRUE.
 1190 IF(II.EQ.1.OR.TEMP.LT.0.) NOINTP = .TRUE.
      IF(.NOT.NOINTP)FACT=TEMPP/(TEMPP-TEMP)
      XAG = A(43) * B(1)
      I=1
 1200 NP = NPT(II)
      IX = LOCX(II)
      IY = LOCY(II)
      CALL TBFUNX(XAG,YAG1,DYDX,NP,CX(IX),CY(IY),CC(1,II),IN(II),MI(II),&
     &            NG,-1,0,Q41315,3,ROUTID)
      IF(I.EQ.2) GO TO 1210
      IF(NOINTP) GO TO 1220
      I=I+1
      II=II-1
      YSV = YAG1
      GO TO 1200
 1210 YAG1=YAG1+(YSV-YAG1)*FACT
      II=II+1
 1220 B(49) = YAG1 * A(134)
      A(137) = YAG1
      RETURN
 1230 CONTINUE
      B(49) = A(134)
      RETURN
      END
      SUBROUTINE CCARD(KOL)
!
!***  CHECK FOR LEGAL CONTROL CARDS
!
      DIMENSION KOL(80), PART(4), IDIM(3), IDIMT(8), NMLIST(8)
      DIMENSION BUILD(5), NACA(4), DERD(9), DERR(9), KASE(6)
      DIMENSION SAVE(4), NEXT(9), IDMP(5), IDMC(4), TRIM(4)
      DIMENSION DAMP(4), NACAT(4), PLOT(4)
      DIMENSION KEYDP(224),  NDP(75)
      DIMENSION KEYARY(136), NDPARY(48)
      DIMENSION KEYINP(47),  NDPINP(13)
      DIMENSION KEYIOM(41),  NDPIOM(14)
      EQUIVALENCE (KEYDP( 1 ),KEYARY(1)), (NDP(1 ),NDPARY(1))
      EQUIVALENCE (KEYDP(137),KEYINP(1)), (NDP(49),NDPINP(1))
      EQUIVALENCE (KEYDP(184),KEYIOM(1)), (NDP(62),NDPIOM(1))
      INTEGER BUILD, DERD, DERR, SAVE, TRIM, DAMP, PART, PLOT
      LOGICAL NMTEST
      INTEGER EXTRAP
      DIMENSION EXTRAP(12)
!
!**   VALID CONTROL CARDS
!
      DATA EXTRAP /4HP   ,4HR   ,4HI   ,4HN   ,4HT   ,4H    ,           &
     &             4HE   ,4HX   ,4HT   ,4HR   ,4HA   ,4HP   /
      DATA BUILD  /4HB   ,4HU   ,4HI   ,4HL   ,4HD   /
      DATA NACA   /4HN   ,4HA   ,4HC   ,4HA   /
      DATA NACAT  /4HW   ,4HH   ,4HV   ,4HF   /
      DATA DERD   /4HD   ,4HE   ,4HR   ,4HI   ,4HV   ,4H    ,           &
     &             4HD   ,4HE   ,4HG   /
      DATA DERR   /4HD   ,4HE   ,4HR   ,4HI   ,4HV   ,4H    ,           &
     &             4HR   ,4HA   ,4HD   /
      DATA PART   /4HP   ,4HA   ,4HR   ,4HT   /
      DATA IDIM   /4HD   ,4HI   ,4HM    /
      DATA IDIMT  /4HF   ,4HT   ,4HI   ,4HN   ,4HM   ,4H    ,           &
     &             4HC   ,4HM   /
      DATA NMLIST /4HN   ,4HA   ,4HM   ,4HE   ,4HL   ,                  &
     &             4HI   ,4HS   ,4HT   /
      DATA KASE   /4HC   ,4HA   ,4HS   ,4HE   ,4HI   ,4HD   /
      DATA SAVE   /4HS   ,4HA   ,4HV   ,4HE    /
      DATA NEXT   /4HN   ,4HE   ,4HX   ,4HT   ,4H    ,4HC   ,4HA   ,    &
     &             4HS   ,4HE   /
      DATA IDMP   /4HD   ,4HU   ,4HM   ,4HP   ,4H    /
      DATA IDMC   /4HC   ,4HA   ,4HS   ,4HE   /
      DATA TRIM   /4HT   ,4HR   ,4HI   ,4HM   /
      DATA DAMP   /4HD   ,4HA   ,4HM   ,4HP   /
      DATA PLOT   /4HP   ,4HL   ,4HO   ,4HT   /
!
      DATA IBLNK  /4H    /,KOMMA /4H,   /
      DATA KEYARY  /                                                    &
     &       4HB   ,4HA   ,4HB   ,4HD   ,4HA   ,4HV   ,4HF   ,4HF   ,   &
     &       4HA   ,4HC   ,4HT   ,4HW   ,4HB   ,4HT   ,4HB   ,4HH   ,   &
     &       4HT   ,4HA   ,4HV   ,4HT   ,4HA   ,4HH   ,4HT   ,4HC   ,   &
     &       4HD   ,4HW   ,4HB   ,4HC   ,4HH   ,4HT   ,4HD   ,4HH   ,   &
     &       4HT   ,4HD   ,4HY   ,4HN   ,4HH   ,4HD   ,4HV   ,4HT   ,   &
     &       4HG   ,4HR   ,4HL   ,4HB   ,4HP   ,4HW   ,4HS   ,4HT   ,   &
     &       4HB   ,4HS   ,4HB   ,4HD   ,4HS   ,4HL   ,4HG   ,4HS   ,   &
     &       4HW   ,4HB   ,4HS   ,4HT   ,4HP   ,4HD   ,4HW   ,4HA   ,   &
     &       4HS   ,4HT   ,4HG   ,4HS   ,4HL   ,4HA   ,4HT   ,4HR   ,   &
     &       4HA   ,4HX   ,4HP   ,4HD   ,4HD   ,4HV   ,4HF   ,4HF   ,   &
     &       4HL   ,4HP   ,4HF   ,4HH   ,4HG   ,4HF   ,4HC   ,4HM   ,   &
     &       4HT   ,4HC   ,4HD   ,4HF   ,4HL   ,4HA   ,4HT   ,4HR   ,   &
     &       4HM   ,4HS   ,4HP   ,4HR   ,4HT   ,4HR   ,4HN   ,4HT   ,   &
     &       4HR   ,4HM   ,4H2   ,4HH   ,4HY   ,4HP   ,4HD   ,4HY   ,   &
     &       4HN   ,4HJ   ,4HE   ,4HT   ,4HH   ,4HB   ,4HS   ,4HH   ,   &
     &       4HB   ,4HT   ,4HR   ,4HA   ,4HH   ,4HS   ,4HT   ,4HB   ,   &
     &       4HH   ,4HS   ,4HE   ,4HC   ,4HS   ,4HL   ,4HA   ,4HH   /
      DATA NDPARY / 1,1,2,3,4,4*3,2*1,2,2*3,4,3,3*2,19*3,4,3*3,2,3,     &
     &              4,4,3,4 /
!
      DATA KEYINP  /                                                    &
     &       4HI   ,4HN   ,4HP   ,4HT   ,4HF   ,4HL   ,4HC   ,4HO   ,   &
     &       4HP   ,4HT   ,4HN   ,4HS   ,4HY   ,4HN   ,4HA   ,4HB   ,   &
     &       4HD   ,4HI   ,4HN   ,4HW   ,4HG   ,4HI   ,4HN   ,4HV   ,   &
     &       4HT   ,4HI   ,4HN   ,4HT   ,4HV   ,4HT   ,4HV   ,4HF   ,   &
     &       4HI   ,4HN   ,4HH   ,4HT   ,4HI   ,4HN   ,4HP   ,4HW   ,   &
     &       4HI   ,4HN   ,4HL   ,4HB   ,4HI   ,4HN   ,4HF   /
      DATA NDPINP / 4,3,5*4,3,4*4,1 /
!
      DATA KEYIOM  /                                                    &
     &       4HI   ,4HO   ,4HM   ,4HB   ,4HO   ,4HD   ,4HY   ,4HW   ,   &
     &       4HI   ,4HN   ,4HG   ,4HH   ,4HT   ,4HV   ,4HT   ,4HV   ,   &
     &       4HF   ,4HB   ,4HW   ,4HB   ,4HH   ,4HB   ,4HV   ,4HB   ,   &
     &       4HW   ,4HH   ,4HB   ,4HW   ,4HV   ,4HB   ,4HW   ,4HH   ,   &
     &       4HV   ,4HP   ,4HO   ,4HW   ,4HR   ,4HD   ,4HW   ,4HS   ,   &
     &       4HH   /
      DATA NDPIOM / 3,4,4,6*2,3,3,4,4,4 /
!
      NA = 0
      NB = 0
!
!***  TEST FOR - NEXT CASE
!
      DO 1000 I=1,9
         IF(KOL(I) .NE. NEXT(I)) GO TO 1010
 1000 END DO
      GO TO 1380
!
!***  TEST FOR - DUMP
!
 1010 DO 1020 I=1,5
         IF(KOL(I) .NE. IDMP(I)) GO TO 1100
 1020 END DO
!
!***  TEST FOR - DUMP CASE
!
      J=1
      DO 1030 L=6,9
         IF(KOL(L) .NE. IDMC(J)) GO TO 1040
 1030 J=J+1
      GO TO 1380
!
!***  TEST FOR ARRAY NAMES
!
 1040 I=5
 1050 I=I+1
      IF(I.GT.80) GO TO 1380
      IF(KOL(I) .EQ. IBLNK .OR. KOL(I) .EQ. KOMMA)GO TO 1050
      NS=I
      NCHAR=1
 1060 I=I+1
      IF(I.GT.80)GO TO 1380
      IF(KOL(I) .EQ. IBLNK .OR. KOL(I) .EQ. KOMMA) GO TO 1070
      NCHAR=NCHAR+1
      GO TO 1060
 1070 IF(NCHAR .LT. 7) GO TO 1080
      NA = NA + 1
      GO TO 1050
 1080 LOC = 1
      DO 1090 J=1,75
         IF(J .GT. 1) LOC = LOC + NDP(J-1)
         IF(NDP(J) .NE. NCHAR) GO TO 1090
         IF(NMTEST(KOL(NS),KEYDP(LOC),NDP(J))) GO TO 1050
 1090 END DO
      NA = NA + 1
      GO TO 1050
!
!***  TEST FOR - SAVE
!
 1100 DO 1110 I=1,4
         IF(KOL(I) .NE. SAVE(I)) GO TO 1120
 1110 END DO
      GO TO 1380
!
!***  TEST FOR - CASEID
!
 1120 DO 1130 I=1,6
         IF(KOL(I) .NE. KASE(I)) GO TO 1140
 1130 END DO
      GO TO 1380
!
!***  TEST FOR - TRIM
!
 1140 DO 1150 I=1,4
         IF(KOL(I) .NE. TRIM(I)) GO TO 1160
 1150 END DO
      GO TO 1380
!
!***  TEST FOR - PRINT EXTRAP
!
 1160 DO 1170 I=1,12
         IF(KOL(I) .NE. EXTRAP(I)) GO TO 1180
 1170 END DO
      GO TO 1380
!
!***  TEST FOR - DAMP
!
 1180 DO 1190 I=1,4
         IF(KOL(I) .NE. DAMP(I)) GO TO 1200
 1190 END DO
      GO TO 1380
!
!***  TEST FOR - BUILD
!
 1200 DO 1210 I=1,5
         IF(KOL(I) .NE. BUILD(I)) GO TO 1220
 1210 END DO
      GO TO 1380
!
!***  TEST FOR - NACA
!
 1220 DO 1230 I=1,4
         IF(KOL(I) .NE. NACA(I)) GO TO 1250
 1230 END DO
      DO 1240 I=1,4
         IF(KOL(6) .EQ. NACAT(I)) GO TO 1380
 1240 END DO
      NB = 1
      GO TO 1380
!
!***  TEST FOR - DERIV DEG
!
 1250 DO 1260 I=1,9
         IF(KOL(I) .NE. DERD(I)) GO TO 1270
 1260 END DO
      GO TO 1380
!
!***  TEST FOR - DERIV RAD
!
 1270 DO 1280 I=1,9
         IF(KOL(I) .NE. DERR(I)) GO TO 1290
 1280 END DO
      GO TO 1380
!
!***  TEST FOR - PART
!
 1290 DO 1300 I=1,4
         IF(KOL(I) .NE. PART(I)) GO TO 1310
 1300 END DO
      GO TO 1380
!
!***  TEST FOR DIMENSION CARD
!
 1310 DO 1320 I=1,3
         IF(KOL(I) .NE. IDIM(I)) GO TO 1330
 1320 END DO
      IF((KOL(5) .EQ. IDIMT(1) .AND. KOL(6) .EQ. IDIMT(2)) .OR.         &
     &   (KOL(5) .EQ. IDIMT(3) .AND. KOL(6) .EQ. IDIMT(4)) .OR.         &
     &   (KOL(5) .EQ. IDIMT(5) .AND. KOL(6) .EQ. IDIMT(6)) .OR.         &
     &   (KOL(5) .EQ. IDIMT(7) .AND. KOL(6) .EQ. IDIMT(8)))             &
     &   GO TO 1380
!
!***  TEST FOR NAMELIST CARD
!
 1330 DO 1340 I=1,8
         IF(KOL(I) .NE. NMLIST(I)) GO TO 1350
 1340 END DO
      GO TO 1380
!
!***  TEST FOR PLOT CARD
!
 1350 DO 1360 I=1,4
         IF(KOL(I) .NE. PLOT(I)) GO TO 1370
 1360 END DO
      GO TO 1380
!
!***   CARD NOT FOUND
!
 1370 WRITE(6,1400) (KOL(I),I=1,80)
      GO TO 1390
!
!***  CARD FOUND
!
 1380 NC = NA+NB
      IF(NA .GT. 0) WRITE(6,1410) (KOL(I),I=1,80), NA
      IF(NB .GT. 0) WRITE(6,1420) (KOL(I),I=1,80)
      IF(NC .EQ. 0) WRITE(6,1430) (KOL(I),I=1,80)
 1390 WRITE(11,1440) (KOL(I),I=1,80)
!
      RETURN
!
!***  FORMAT
!
 1400 FORMAT(1X,80A1,3X,23H** ILLEGAL CONTROL CARD)
 1410 FORMAT(1X,80A1,3X,11H** ERROR **,I4,                              &
     &                  22H INCORRECT ARRAY NAMES)
 1420 FORMAT(1X,80A1,3X,29H** ERROR ** INCORRECT LIFTING,/84X,          &
     &                    33H SURFACE DESIGNATION ON NACA CARD)
 1430 FORMAT(1X,80A1)
 1440 FORMAT(80A1)
      END
      SUBROUTINE CDRAG(A,B,D,AIN,AINN)
!
!***  COMPUTES LIFTING SURFACE CD
!
      COMMON/OVERLY/NLOG,NMACH,I,NALPHA,IG
      DIMENSION ROUTID(2)
      DIMENSION Q15127(3),Q5128B(3),Q5253B(3),Q15242(3),Q15248(3),      &
     &          Q128BD(5),Q15254(3),Q121OA(3)
      DIMENSION A(195),B(49),D(55)
      DIMENSION AIN(77),AINN(380)
      DIMENSION Y42(432)
      DIMENSION WTYPE(4)
      DIMENSION X228B(11), X128B(4), Y28B(44)
      DIMENSION X228BD(9),X128BD(4),Y28BD(36)
      DIMENSION X342(9),X242(12),X142(4),Y42A(144)
      DIMENSION X27M(4),X27I(4),C27(6)
      EQUIVALENCE(Y42(1),Y42A(1)),(Y42(145),Y42B(1)),(Y42(241),Y42C(1))
      EQUIVALENCE (Y42(337),Y42D(1))
      DIMENSION Y42B(96)
      DIMENSION Y42C(96)
      DIMENSION Y42D(96)
      DIMENSION X348(9),X248(10),X148(4),Y48(360),Y48A(120),Y48B(120),  &
     &          Y48C(120)
      EQUIVALENCE (Y48(1),Y48A(1)),(Y48(121),Y48B(1)),(Y48(241),Y48C(1))
      DIMENSION X53B(8),Y53B(8),C53B(6)
      DIMENSION X254(14),X154(12),Y54(168)
      DIMENSION X1OA(11),Y1OA(11),C1OA(6),SAVE2(20)
      COMMON /CONSNT/ PI, DEG, UNUSED, RAD,kand
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC           &
     &        ,HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN                         &
     &        ,SUPERS,SUBSON,TRANSN,HYPERS
      DATA ROUTID /4HCDRA,4HG   /
      DATA Q15127 /4H4.1 ,4H5.1-,4H27  /                                &
     &,    Q5253B /4H4.1 ,4H5.2-,4H53-B/,Q15242/4H4.1 ,4H5.2-,4H42  /   &
     &,    Q15248 /4H4.1.,4H5.2-,4H48  /                                &
     &,    Q128BD /4H4.1.,4H5.1-,4H28-B,4H(DAS,4HHED)/                  &
     &,    Q5128B /4H4.1.,4H5.1-,4H28-B/                                &
     &,    Q15254 /4H4.1.,4H5.2-,4H54  /
      DATA WTYPE  /4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA X27M   /0.0,1.0,2.0,3.0/
      DATA X27I   /1.57780,1.67221,1.98509,2.28874/
      DATA I27    /0/
!
!              FIGURE 4.3.1.2-10-A (KW(B) VS D/B)
!
      DATA X1OA /0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y1OA /1.0,1.08,1.16,1.26,1.36,1.46,1.56,1.67,1.78,1.89,2.0/
      DATA I1OA /0/
      DATA Q121OA/4H4.3.,4H1.2-,4H10-A/
!
!---------          FIGURE 4.1.5.1-28B            ----------------------
!
!----     X228B=COS(SWEEP ANGLE(T/C)MAX)   X128B= MACH NUMBER
!----     Y28B= (R)LS
!
      DATA X228B /0.5,.55,.60,.65,.70,.75,.80,.85,.90,.95,1.0/
      DATA X128B /0.9,.80,.60,.25/
      DATA Y28B / 1.1,1.13,1.17,1.20,1.24,1.27,1.3,1.33,1.34,1.35,1.36 ,&
     &1.0,1.04,1.08,1.11,1.15,1.18,1.21,1.23,1.25,1.25,1.26 , 0.88, .92,&
     &.96,1.0,1.04,1.08,1.11,1.13,1.14,1.14,1.15 , 0.81,.85,.89,.925,   &
     &.96,1.0,1.03,1.05,1.06,1.06,1.07/
!
!---------          FIGURE 4.1.5.1-28B-DASHED     ----------------------
!----          X228BD= COS(T/C)MAX      X128BD= MACH NUMBER
!----          Y28BD= (R)LS
!
      DATA X228BD/0.45,.65,.70,.75,.80,.85,.90,.95,1.0/
      DATA X128BD/0.9,.80,.60,.25/
      DATA Y28BD/1.20,1.20,1.24,1.27,1.30,1.33,1.34,1.35,1.36 , 1.11,   &
     &1.11,1.15,1.18,1.21,1.23,1.25,1.25,1.26 , 1.0,1.0,1.04,1.08,1.11, &
     &1.13,1.14,1.14,1.15 , 0.925,0.925,.96,1.0,1.03,1.05,2*1.06,1.07/
!
!---------          FIGURE 4.1.5.2-42             ----------------------
!----          X342= TAPER RATIO   X142= ATAN(TAN(SAE025)/BETA)
!----          X242= LIFT-DEPEND DRAG FACTOR   Y42= V(12,4,9)
!
      DATA X342 /0.1,0.2,0.25,0.30,0.40,0.50,0.60,0.75,1.0/
      DATA X142 /60.0,45.0,30.0,0.0/
      DATA X242 /2.,2.5,3.,3.5,4.,4.5,5.0,6.0,8.0,10.0,12.0,14.0/
      DATA Y42A /.00025,.0002,.0001,0.0,-.0002,-.00028,-.00038,-.00055, &
     & -.0008,-.00093,-.00097,-.0009 , -.0004,-.00042,-.00046,-.00052,  &
     &-.00062,-.00069,-.00075,-.00088,-.00111 ,2*-.00127,-.00125,-.0009,&
     &-.001,-.0011,-.00118,-.00127,-.00136,-.00144,-.00157,-.00177,     &
     &-.00180,-.00188,-.00181 , -.00193,-.00225,-.00253,-.00273,-.00292,&
     &-.00308,-.00318,-.00336,-.0035,-.0035,-.00345,-.0034,.0012,       &
     &.00135,.00144,.00149,.00148,.00145,.00136,.00113,.00077,.00052,   &
     &.00032,.000175 , .0002,.0004,.00053,.00062,.00067,.0007,.00068,   &
     &.00063,.00042,.00023,.00014,.0001 , -.00039,-.00032,-.00028,      &
     &-.00024,-.0002,-.00019,-.00018,-.0002,-.00028,-.00043,-.00052,    &
     &-.00053 , -.0013,-.0015,-.00166,-.0018,-.00192,-.00203,-.00211,   &
     &-.0022,-.0023,-.00229,-.0022,-.00214 , .00155,.0018,.00197,.00207,&
     &0.00209,.00203,.00192,.00173,.00142,.0011,.00085,.00072 , .00055, &
     &.00075,.00092,.00106,.00115,.00123,.00127,.00125,.00105,.00085,   &
     &.0007,.00065 , -.00018,-.00008,0.0,.0001,.00017,.00023,.00027,    &
     &.00032,.0003,.00025,.00018,.00005 , -.00106,-.00122,-.00133,      &
     &-.00145,-.00154,-.00162,-.00166,-.00175,-.00178,-.00174,-.00172,  &
     &-.0017/
!
      DATA Y42B/0.00188,.00225,.00248,.00262,.00267,.00263,.00257,.00243&
     &,.00212,.00176,.00151,.0014, .00065,.001,.0013,.00152,.00165,     &
     &.00173,                                                           &
     &.00175,.00178,.0017,.0015,.00132,.00123 , 0.0,.00018,.00033,.00048&
     &,.00058,.00069,.00075,.00083,.00085,.0008,.00069,.00064 , -.00088,&
     &-.001,-.00108,-.00114,-.00119,-.00124,-.00126,2*-.0013,-.00125,   &
     &-.00117,-.00108, .00242,.003,.00342,.00365,.00369,.00365,.00362,  &
     &.0035,.00318,.0028,.00245,.00221 , .00107,.0015,.0019,.00218,     &
     &.00239,.00255,.00266,.00275,.00272,.0026,.00240,.00214 , .00033,  &
     &.00072,.001,.00117,.0013,.00142,.00153,.00167,.00178,.00175,.00165&
     &,.00163 , -.00057,-.00062,-.00063,3*-.00064,-.00061,-.00055,      &
     &-.00042,-.00031,-.00025,-.00026/
!
      DATA Y42C/.0029,.00395,.00427,.00443,.0045,.00452,.0045,.00443,   &
     &.00413,.0037,.00334,.003 , .00135,.00207,.0025,.0028,.00305,.00325&
     &,.0034,.0036,.00365,.00345,.00325,.003 , .0006,.00096,.0013,.00156&
     &,.0018,.00198,.00216,.00238,.00262,.00265,.0026,.0025 , -.0003,   &
     &-.00027,-.00022,-.00018,-.000125,-.00007,0.0,.00013,.0003,.00046, &
     & .00057,.00063,                                                   &
     & .0033,.00395,.0045,.00495,.0052,.0053,.00534,.00527,.00488,.00445&
     &,.00402,.00378 , .0017,.0024,.0029,.0033,.0036,.00385,.004,.00428,&
     &.00434,.0042,.00402,.00375 ,.00085,.00127,.00165,.002,.00225,.0025&
     &,.00267,.00298,.00328,.00335,.00333,.00323, -.0001,0.0,.00012     &
     &,.0002,.00032,.00046,.0005,.00065,.00092,.0011,.00124,.0013/
!
      DATA Y42D/.004,.0053,.00576,.006,.00613,.0062,.00625,.00626,.00595&
     &,.0054,.00495,.0046 , .002 ,.00285,.00345,.00393,.00433,.00465,   &
     &.00487,.00513,.00532,.00517,.00495,.00468 , .00115,.00172,.00218, &
     &.00257,.0029,.00318,.0034,.00373,.0041,.00423,.00425,.0042 , .0002&
     &,.00035,.0005,.00067,.00084,.001,.00113,.00137,.00175,.002,.00212,&
     &.00216 , .0047,.006,.0068,.00712,.0073,.00742,.00748,.00746,.00712&
     &,.00658,.00615,.00575 , .0026,.00365,.00442,.00495,.00535,.00567, &
     &.00582,.00625,.00643,.00636,.00618,.00592 , .00155,.00225,.00282, &
     &.0033,.00372,.00405,.00435,.00478,.0053,.00545,.00543,.00535 ,    &
     &.00055,.00085,.00112,.00138,.0016,.00182,.00202,.00237,.00288,    &
     &.00317,.00335,.00345/
!
!*********          FIGURE 4.1.5.2-48
!****          X148= ATAN(TAN(QUARTER-CHORDSWEEP ANGLE)/BETA)
!****          X348= TAPER RATIO        X248= ZERO-LIFT DRAG FACTOR
!****          Y48=  BETA * W
!
      DATA X348 /0.1,0.2,0.25,0.3,0.4,0.5,0.6,0.75,1.0/
      DATA X148 /0.0,30.0,45.0,60.0/
      DATA X248 /2.0,3.0,4.0,5.0,6.0,7.0,8.0,10.0,12.0,14.0/
      DATA Y48A/.00084,.00113,.00136,.00152,.00162,.00169,.00175,.00178,&
     &.00177,.00172 , .00084,.00113,.00133,.00146,.00154,.00158,.00159, &
     &.00158,.00154,.00149 ,.00083,.00109,.00124,.00133,.00136,.00137,  &
     &.00134,.00127,.00121,.00116 , .0008,.00095,.00101,.00102,.0010,   &
     &.00098,.00093,.00083,.00075,.0007 , .00086,.00118,.00145,.00163,  &
     &.00176,.00185,.00192,.00198,.002,.00198 , .00086,.00118,.00145,   &
     &.0016,.0017,.00176,.0018,.00179,.00173,.00169 , .00086,.00118,    &
     &.00136,.00147,.00152,.00154,.00153,.00147,.0014,.00135 , .00084,  &
     &.00105,.00113,.00114,.00112,.00109,.00104,.00095,.00086,.0008,    &
     &.00087,.00122,.00147,.00166,.00181,.00192,.00199,.00206,.00207,   &
     &.00203 , .00087,.00122,.00145,.00163,.00174,.0018,.00184,.00187,  &
     &.00184,.00177 , .00087,.00119,.00137,.00148,.00155,.00157,.00157, &
     &.00153,.001445,.0014 , .00085,.00105,.00114,.00117,.00116,.00113, &
     &.00109,.0010,.00091,.00085/
!
      DATA Y48B/.00088,.00121,.00149,.0017,.00185,.00195,.00203,.00211, &
     &.00212,.00207 , .00088,.00121,.00149,.00166,.00177,.00185,.00189, &
     &.00191,.00188,.00181 , .00088,.00121,.00141,.00153,.00159,.00161, &
     &.00162,.00159,.00152,.00146 , .00085,.00107,.00117,.0012,.001195, &
     &.00116,.00113,.00104,.00097,.00091 , .00088,.00124,.00153,.00173, &
     &.00189,.002,.00209,.00218,.0022,.00217 , .00088,.00124,.00149,    &
     &.00169,.00182,.0019,.00195,.00199,.00195,.0019 , .00088,.00123,   &
     &.00143,.00156,.00163,.00167,.00168,.00165,.00158,.00149 , .00088, &
     &.0011,.0012,.00124,.001235,.00122,.00119,.00109,.001,.00093 ,     &
     &.00089,.00125,.00152,.00175,.00191,.00203,.00211,.00221,.00225,   &
     &.00223 , .00089,.00125,.00152,.0017,.00184,.00192,.00198,.00202,  &
     &.002,.00195 , .00089,.00124,.00143,.00158,.00166,.00169,.00171,   &
     &.001685,.00162,.00154 , .00089,.00113,.00123,.00126,.00127,.00125,&
     &.00121,.00114,.00105,.00097/
!
      DATA Y48C/.0009,.00125,.00154,.00175,.00192,.00205,.00213,.00223, &
     &.00226,.00225 , .0009,.00125,.00151,.0017,.00183,.00192,.00199,   &
     &.00203,.00202,.00197 , .0009,.00125,.00146,.00159,.00166,.0017,   &
     &.00171,.00169,.00164,.00156 , .0009,.0011,.00123,.00129,.00128,   &
     &.00125,.00121,.00114,.00106,.00102 , .00087,.00124,.00153,.00176, &
     &.00193,.00205,.00213,.00223,.00226,.00224 , .00087,.00124,.00151, &
     &.0017,.00182,.00191,.00197,.002025,.00203,.00199 , .00087,.00124, &
     &.00143,.00157,.00167,.00172,.00173,.00171,.00165,.00157 , .00087, &
     &.00111,.00122,.00126,.00127,.00126,.00124,.00115,.00107,.00102 ,  &
     &.00087,.00123,.00151,.00173,.0019,.00203,.00212,.00221,.00225,    &
     &.00224 , .00087,.00123,.0015,.00167,.0018,.00191,.00196,.002,.002,&
     &.00198 , .00087,.00123,.00142,.00155,.00164,.00168,.00169,.00169, &
     &.00165,.00159 , .00087,.00111,.0012,.00125,.00126,.00125,.00121,  &
     &.00115,.00109,.00103/
!
!*********          FIGURE 4.1.5.2-53-B                          *******
!
      DATA X53B /0.0,1.0,2.0,3.0,4.0,6.0,8.0,10.0/
      DATA Y53B/0.72956, 0.91078, 0.93209, 0.94530, 0.95850,            &
     &          0.96226, 0.96601, 0.96977 /
      DATA I53B/0/
!
!*********          FIGURE 4.1.5.2-54                            *******
!
      DATA X254/3.0,3.5,4.0,4.5,5.25,5.50,5.75,6.,6.5,7.,7.5,8.,8.5,9.0/
      DATA X154/.24,.22,.20,.18,.16,.14,.12,.11,.10,.09,.08,0.0/
      DATA Y54/.07,.18,12*.18 , .047,.12,.177,11*.177 , .03,.08,.124,   &
     &.162,.197,9*.197 , .017,.06,.091,.116,.147,9*.147 , .0075,.0425,  &
     &.063,.079,.0975,9*.0975 , .00225,.023,.039,.05,.0625,9*.0625 , .0,&
     &.01,.019,.028,.0385,.0375,.039,.044,.08,.133,4*.133 , 0.0,.005,   &
     &.0125,.019,.0265,.024,.022,.0215,.0385,.068,.11,.16,2*.16 , 0.0,  &
     &.0025,.008,.0125,.0175,.0135,.009,.0075,.012,.025,.048,.0825,2*.13&
     & , 0.0,0.0,.0035,.0075,.01,.0065,.003,.001,0.0,.005,.012,.026,.05,&
     &.096 , .00,0.0,.0015,.003,.0045,.001,6*0.0,.01,.0295 , 14*0.0/
!
      D(2)=12.0*A(16)/ROUGFC
      D(3)=1.0
      D(9)= A(129)*AIN(62)*A(15)
      D(8)= A(129)*AIN(63)*A(17)
      TYPE=A (161)
      IF(A(38).EQ.0.0) A(38)=.00001
      IF(A(62).EQ.0.0) A(62)=.00001
      IF(A(86).EQ.0.0) A(86)=.00001
!
!++++++++      ALPHA LOOP     ++++++++++
!
      IF(.NOT.BO)GO TO 1010
      RATIO=(AIN(4)-AIN(3))/AIN(4)
      CALL TBFUNX(RATIO,RKWB,DYDX,11,X1OA,Y1OA,C1OA,I1OA,MI,NG,         &
     &            0,0,Q121OA,3,ROUTID)
      SAVE1=AINN(101)
      AINN(101)=AINN(101)*RKWB
      DO 1000 KK=1,NALPHA
         SAVE2(KK)=AINN(KK+20)
         AINN(KK+20)=AINN(KK+20)*RKWB
 1000 END DO
 1010 CONTINUE
!
!---------     DETERMINE WING CONFIGURATION       ----------------------
!
      IF(AIN(15).NE.WTYPE(1)) GO TO 1050
!
!*********     FOR STRAIGHT-TAPER WING CONFIGURATION        ************
!---------     COMPUTE REYNOLDS NUMBER, (RN)
!
      D(17)=A(16)*A(129)
!
!---------     COMPUTE RL FROM EQUATION FOR FIG.4.1.5.1-27
!*********          FIGURE 4.1.5.1-27 EQUATION
!
      CALL TBFUNX (FLC(I+2),CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG         &
     &             ,0,0,Q15127,3,ROUTID)
      D(14)=D(2)**1.0482*10.0**CEPT
      IF(D(14) .LT. D(17)) D(17)=D(14)
!
!*********          FIGURE 4.1.5.1-26 EQUATIONS (SUBROUTINE FIG26 )
!
      CALL FIG26  (D(17),FLC(I+2),D(10) )
!
!*********          FIGURE 4.1.5.1-28-B
!
      CALL TLINEX(X128B,X228B,Y28B,4,11,FLC(I+2),A(178),D(13)           &
     &            ,0,2,-1,2,Q5128B,3,ROUTID)
      CAPL=2.0
      IF(AIN(18) .GE. 0.30) CAPL=1.20
      D(20)=D(10)*(1.+CAPL*AIN(16)+100.*AIN(16)**4)*D(13)*(2.*A(3)/SREF)
!
!*********     FOR STRAIGHT-TAPER WING CONFIGURATION        ************
!-------   COMPUTE RLER,D(26)
!
      D(26)=A(129)*AIN(62)*A(16)
!
!-------   COMPUTE RV,D(27)
!
      D(27)=D(26)/ABS(A(38))*SQRT(1.0-(FLC(I+2)**2*A(37)**2))
      D(28)=A(7)*A(27)/A(37)
!
!-------   IF RV.LT.1.3*10**5, USE FIG 4.1.5.2-53-A
!
      IF(D(27) .GT. 1.30E+05) GO TO 1020
      CALL FIG53A(D(27),D(28),D(29))
      GO TO 1030
 1020 CALL TBFUNX(D(28),D(29),DYDX,8,X53B,Y53B,C53B,I53B,MI,NG          &
     &             ,0,0,Q5253B,3,ROUTID)
!
!--------  COMPUTE E,D(30)
!
 1030 TEMP=(AINN(101)*SREF/A(3))*RAD/A(7)
      D(30)=1.1*TEMP/(D(29)*TEMP+(1.-D(29))*PI)
      D(31)=A(7)*B(2)
!
!--------  FIGURE 4.1.5.2-42
!
      ANGLE= ATAN(A(44)/B(2))*RAD
      CALL TLIN3X(X142,X242,X342,Y42,4,12,9,ANGLE,D(31),A(27),D(33)     &
     &            ,0,2,0,2,2,0,Q15242,3,ROUTID)
!
!--------  FIGURE 4.1.5.2-48
!
      CALL TLIN3X(X148,X248,X348,Y48,4,10,9,ANGLE,D(31),A(27),D(32)     &
     &            ,0,2,0,2,2,0,Q15248,3,ROUTID)
!
!--------  COMPUTE (CDL)J, D(34)
!
      W=D(32)/B(2)
      TEMP=PI*AIN(11)/RAD
      TEMP2=2.0*TEMP
      DO 1040 M=1,NALPHA
         CLJ=AINN(M+20)
         D(34)=(CLJ**2/(PI*A(7)*D(30)))*SREF/A(3)+TEMP2*CLJ*D(33)+      &
     &         TEMP2**2*W*A(3)/SREF
         D(M+35)= D(34)
!
!-------  COMPUTE (CD),J, D(35)
!
         D(35)= D(20)+D(34)
         AINN(M)=D(35)
 1040 END DO
      GO TO 1130
!
!                  ***** INBOARD CALCUALTIONS *****
!
 1050 D(18)=A(15)*A(129)
!
!------- FIGURE 4.1.5.1-27 EQUATION
!
      CALL TBFUNX (FLC(I+2),CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG         &
     &             ,0,0,Q15127,3,ROUTID)
      D(15)=D(2)**1.0482*10.0**CEPT
!
!------- IF RLI.LT.RNI  SET RNI=RLI
!
      IF( D(15).LT.D(18) ) D(18)= D(15)
!
!*********     FIGURE 4.1.5.1-26 SUBROUTINE
!
      CALL FIG26 ( D(18),FLC(I+2),D(11) )
!
!---------          FIGURE 4.1.5.1-28-B (DASHED)
!
      CALL TLINEX(X128BD,X228BD,Y28BD,4,9,FLC(I+2),A(190),D(23)         &
     &            ,-1,0,0,0,Q128BD,5,ROUTID)
!
!*********     IF XTI GREATER TAN 0.30, THEN CAPL= 2.0          ********
!
      CAPL= 1.20
      IF(AIN(18) .LT. 0.30) CAPL=2.00
      D(21)=D(11)*(1.+CAPL*AIN(16)+100.*AIN(16)**4)*D(23)*(2.*A(1)/SREF)
!
!                   ***** OUTBOARD CALCULATIONS *****
!
      D(19)=A(17)*A(129)
!
!     FIGURE 4.1.5.1-27 EQUATION
!
      D(16)=D(15)
!
!     IF RLO .LT. RNO, SET RNO= RLO
!
      IF(D(16).LT.D(19)) D(19)=D(16)
!
!     FIGURE 4.1.5.1-26 SUBROUTINE
!
      CALL FIG26( D(19),FLC(I+2),D(12) )
!
!*********     FIGURE 4.1.5.1-28-B
!
      CALL TLINEX(X128B,X228B,Y28B,4,11,FLC(I+2),A(184),D(24)           &
     &            ,0,2,0,2,Q5128B,3,ROUTID)
!
!*********     IF XTO GREATER THAN 0.30, THEN CAPL= 2.0          *******
!
      CAPL=1.20
      IF(AIN(66).LT.0.30) CAPL=2.00
      D(22)=D(12)*(1.+CAPL*AIN(65)+100.*AIN(65)**4)*D(24)*(2.*A(2)/SREF)
!
!*********     COMPUTE CDO FROM PAGE 3-2
!
      D(20)=D(21)+D(22)
      IF(AIN(15).NE.WTYPE(3)) GO TO 1110
!
!*********          CRANKED WING CONFIGURATION                   *******
!*********          INBOARD  COMPUTATIONS                        *******
!
!     COMPUTE RVI, D(7)
!
      D(7)= (D(9)/ABS(A(62))) * SQRT(1.-(FLC(I+2)*A(61))**2)
      TEMPI=0.0
!
!*********     IF RVI .GT. 1.3*10**5, USE FIGURE 4.1.5.2-53-B
!
      IF(D(7).GT.1.30E+05) GO TO 1060
      CALL FIG53A(D(7),TEMPI,D(5))
      GO TO 1070
 1060 CALL TBFUNX(TEMPI,D(5),DYDX,8,X53B,Y53B,C53B,I53B,MI,NG           &
     &            ,0,0,Q5253B,3,ROUTID)
!
!*********          OUTBOARD COMPUTATIONS                        *******
!     COMPUTE RVO, D(6)
!
 1070 D(6)= (D(8)/ABS(A(86))) * SQRT(1.-(FLC(I+2)*A(85))**2)
      TEMPO=A(6)*A(28)/A(85)
!
!*********     IF RVO .T. 1.3*10**5, USE FIGURE 4.1.5.2-53-B
!
      IF(D(6).GT.1.30E+05) GO TO 1080
      CALL FIG53A(D(6),TEMPO,D(4))
      GO TO 1090
 1080 CALL TBFUNX(TEMPO,D(4),DYDX,8,X53B,Y53B,C53B,I53B,MI,NG           &
     &            ,0,0,Q5253B,3,ROUTID)
!
!*********     COMPUTE R-PRIME,D(1)
!
 1090 D(1)=D(5)*A(23)/AIN(3)+D(4)*(1.-(A(23)/AIN(3)))
      TEMP=(AINN(101)*SREF/A(3))*RAD/A(7)
!
!*********     COMPUTE E, D(30)
!
      D(30)=TEMP/(D(1)*TEMP+(1.-D(1))*PI)
!
!*********               CRANKED WING CONFIGURATION
!*********     FIGURE 4.1.5.2-54 ( TO GET DELTA(CDL)J,  D(25) )
!
      DO 1100 M=1,NALPHA
         TEMP=(ABS(AINN(M+20))/A(7))*SREF/A(3)
         CALL TLINEX(X154,X254,Y54,12,14,TEMP,A(7),D(25)                &
     &              ,0,0,0,0,Q15254,3,ROUTID)
!
!*********     COMPUTE (CDL)J AND CDJ
!
         D(34)=(AINN(M+20)**2/(PI*D(30)*A(7)))*SREF/A(3)+D(25)*A(3)/SREF
         D(M+35)= D(34)
         D(35)=D(20)+D(34)
         AINN(M)=D(35)
 1100 END DO
      GO TO 1130
!
!*********     DOUBLE-DELTA OR CURVED WING CONFIGURATION         *******
!*********     COMPUTE (CDL) J AND CDJ
!
 1110 CONTINUE
      DO 1120 M=1,NALPHA
         D(34)=0.95*AINN(M+20)*TAN(B(M+22)/RAD)*D(3)
         D(M+35)= D(34)
         D(35)=D(20)+D(34)
         AINN(M)=D(35)
 1120 END DO
 1130 CONTINUE
      B(46)=D(20)
      IF(A(38) .EQ. 0.00001) A(38)=0.0
      IF(A(62) .EQ. 0.00001) A(62)=0.0
      IF(A(86) .EQ. 0.00001) A(86)=0.0
      IF(.NOT.BO)RETURN
      AINN(101)=SAVE1
      DO 1140 KK=1,NALPHA
         AINN(KK+20)=SAVE2(KK)
 1140 END DO
      RETURN
      END
      SUBROUTINE CDWBT
!
!**** TRANSONIC WING-BODY-TAIL CD - DATCOM SECTION 4.5.3.2
!
      COMMON /IBODY/  PBOD, CDB(20)
      COMMON /IHT/    PHT,  CDH(20),CLH(20), dum3(340)
      COMMON /IVT/    PVT,  CDOV, dum4(379)
      COMMON /IBW/    PBW,  CDWB(20), dum5(360)
      COMMON /IBV/    PBV,  CDBV(20), dum6(360)
      COMMON /IBWH/   PBWH, CDBWH(20), dum7(360)
      COMMON /IBWV/   PBWV, CDBWV(20), dum8(360)
      COMMON /IBWHV/  PBWT, WBTCD(20), dum9(360)
      COMMON /IDWASH/ PDWA, QOQI(20),EPS(20)
      COMMON /SBETA/  STB(135),TRA(108),TRAH(108)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,NZ,NALPHA
!
      EQUIVALENCE (TRA(73),CDOWB), (TRAH(108),CDOH), (TRA(75),CDOWBT)
      LOGICAL FLAG
!
      CDOWBT = WBTCD(1)
      IF(CDOV.EQ.UNUSED.AND.CDOWBT.EQ.UNUSED) GO TO 1010
      IF(CDOV.EQ.UNUSED)CDOV=CDOWBT-CDOWB-CDOH
      DO 1000 I=1,NALPHA
      FLAG = ABS(CDWB(I)) .EQ. UNUSED .OR. ABS(CDH(I)) .EQ. UNUSED      &
     &  .OR. ABS(QOQI(I)) .EQ. UNUSED .OR. ABS(CLH(I)) .EQ. UNUSED      &
     &  .OR. ABS( EPS(I)) .EQ. UNUSED
      IF(FLAG) GO TO 1000
      WBTCD(I)=CDOV+CDWB(I)+QOQI(I)*(CDH(I)*COS(EPS(I))+CLH(I)*         &
     &         SIN(EPS(I)))
 1000 END DO
 1010 CONTINUE
      DO 1020 I=1,NALPHA
         FLAG = CDOV .NE. UNUSED .AND. ABS(CDB(I)) .NE. UNUSED
         IF(FLAG) CDBV(I)=CDB(I)+CDOV
         FLAG = CDOV .NE. UNUSED .AND. ABS(WBTCD(I)) .NE. UNUSED
         IF(FLAG) CDBWH(I)=WBTCD(I)-CDOV
         FLAG = CDOV .NE. UNUSED .AND. ABS(CDWB(I)) .NE. UNUSED
         IF(FLAG) CDBWV(I)=CDWB(I)+CDOV
 1020 END DO
      RETURN
      END
      SUBROUTINE CHECK
!
!      CHECK MACH REGIME LIMITS AND SET PRINT FLAGS
!
!***  IDEAL OUTPUT MATRIX
!             BLOCK    PRINT     IOM
!             NAME     FLAG     ARRAY
!
      COMMON /IBODY/   PBODY,  BODY(400)
      COMMON /IWING/   PWING,  WING(400)
      COMMON /IHT/     PHT,    HT(380)
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
      COMMON /IBWH/    PBWH,   BWH(380)
      COMMON /IBWV/    PBWV,   BWV(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
      COMMON /IPOWER/  PPOWER, POWER(200)
      COMMON /IDWASH/  PDWASH, DWASHI(60)
!
      LOGICAL PBODY, PWING, PHT, PVT, PVF, PBW, PBH, PBV, PBWH, PBWV,   &
     &        PBWHV, PPOWER, PDWASH
!
!***  INPUT DATA BLOCKS
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /BODYI/  XNX,X(20),S(20),P(20),R(20),ZU(20),ZL(20),        &
     &                BNOSE,BTAIL,BLN,BLA,DS,ITYPE,METHOD,ELLIP
      COMMON /WINGI/  WGIN(101)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /HTI/    HTIN(154)
      COMMON /POWER/  PWIN(29), LBIN(21)
      COMMON /FLAPIN/ F(138)
!
      EQUIVALENCE (F(14),SPANI), (DWASH,WGIN(101))
      LOGICAL FLP,FLAG,VERTUP
      LOGICAL IMACH, IRN, IVEL, IALT, IPT, IATM
      REAL METHOD
!
!***  REFERENCE DATA BLOCKS
!
      COMMON /CASEID/ ID(175), IDIM
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB,PLOT
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB,PLOT
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
!***  CHECK BODY METHOD, ASPECT RATIO CLASSIFICATION, AND DOWNWASH
!
      IF(METHOD .LE. 1.5) METHOD = 1.0
      IF(METHOD .GT. 1.5) METHOD = 2.0
!
      IF(WGIN(92) .EQ. UNUSED) WGIN(92) = 3.5
      IF(WGIN(92) .LT. 3.0)    WGIN(92) = 3.0
      IF(WGIN(92) .GT. 4.0)    WGIN(92) = 4.0
      IF(HTIN(92) .EQ. UNUSED) HTIN(92) = 3.5
      IF(HTIN(92) .LT. 3.0)    HTIN(92) = 3.0
      IF(HTIN(92) .GT. 4.0)    HTIN(92) = 4.0
      IF(VTIN(92) .EQ. UNUSED) VTIN(92) = 3.5
      IF(VTIN(92) .LT. 3.0)    VTIN(92) = 3.0
      IF(VTIN(92) .GT. 4.0)    VTIN(92) = 4.0
      IF(VFIN(92) .EQ. UNUSED) VFIN(92) = 3.5
      IF(VFIN(92) .LT. 3.0)    VFIN(92) = 3.0
      IF(VFIN(92) .GT. 4.0)    VFIN(92) = 4.0
!
      IF(.NOT. (WGPL .AND. HTPL)) GO TO 1000
        SPANR  = WGIN(4)/HTIN(4)
        IF((DWASH .EQ. UNUSED) .AND. (SPANR .LT. 1.5)) DWASH = 3.0
        IF(DWASH .LE. 1.5) DWASH = 1.0
        IF(DWASH .GE. 2.5) DWASH = 3.0
        IDWASH = DWASH+0.5
        IF(IDWASH .EQ. 2 .AND. SPANR .LT. 1.25) IDWASH = 3
        IF(IDWASH .EQ. 2 .AND. SPANR .GT. 3.60) IDWASH = 1
        IF(IDWASH .EQ. 1 .AND. SPANR .LE. 1.00) IDWASH = 3
        IF(IDWASH .EQ. 3 .AND. SPANR .GT. 1.50) IDWASH = 1
        DWASH = IDWASH
 1000 CONTINUE
!
!***  SET IOM PRINT FLAGS
!
      IF(BO .AND. .NOT. BUILD) GO TO 1010
        IF(BO)   PBODY = .TRUE.
        IF(WGPL) PWING = .TRUE.
        IF(HTPL)   PHT = .TRUE.
        IF(VFPL)   PVF = .TRUE.
        IF((VTPL .OR. TVTPAN))   PVT = .TRUE.
 1010 CONTINUE
      IF(.NOT. BO) GO TO 1040
        IF(WGPL .AND. .NOT. BUILD) GO TO 1020
          IF(WGPL) PBW = .TRUE.
          IF(HTPL) PBH = .TRUE.
          IF((VTPL .OR. TVTPAN)) PBV = .TRUE.
          IF(WGPL .AND. HTPL) PBWH = .TRUE.
          IF(WGPL .AND. (VTPL .OR. TVTPAN)) PBWV = .TRUE.
          IF(.NOT. HTPL .AND. .NOT. (VTPL .OR. TVTPAN)) PBODY = .TRUE.
 1020     CONTINUE
        IF(.NOT. WGPL) GO TO 1030
          IF(HTPL .AND. (VTPL .OR. TVTPAN)) PBWHV = .TRUE.
          IF(.NOT. HTPL .AND. (VTPL .OR. TVTPAN)) PBWV = .TRUE.
          IF(.NOT. (VTPL .OR. TVTPAN) .AND. HTPL) PBWH = .TRUE.
          IF(.NOT. HTPL .AND. .NOT. (VTPL .OR. TVTPAN)) PBW = .TRUE.
 1030     CONTINUE
          IF(WGPL .AND. HTPL) PDWASH = .TRUE.
          IF(PRPOWR .OR. JETPOW) PPOWER = .TRUE.
 1040 CONTINUE
      IF(LOASRT) PBW = .TRUE.
!
!***  CHECK FLAP INBOARD STATION
!
      FLP = SYMFP .OR. ASYFP
      IF(.NOT. FLP) GO TO 1070
      IF(ASYFP .AND. (ABS(F(18)-5.) .LE. 0.1)) GO TO 1070
      SSPN  = WGIN(4)
      SSPNE = WGIN(3)
      IF(.NOT. HTPL) GO TO 1050
          SSPN  = HTIN(4)
          SSPNE = HTIN(3)
 1050 CONTINUE
      SBOD = SSPN-SSPNE
      IF(SPANI .GE. SBOD) GO TO 1070
          WRITE(6,1060) SPANI, SBOD
 1060     FORMAT(1H0,35HERROR ** FLAP INBOARD SPAN, SPANI =,E12.5,      &
     &      52H, IT IS INSIDE THE BODY AS DEFINED BY SSPN AND SSPNE /   &
     &      10X,40HSPANI IS REDEFINED, SPANI = SSPN-SSPNE =,E12.5/)
          SPANI = SBOD
 1070 CONTINUE
!
!***  CHECK FOR MISSING ESSENTIAL NAMELISTS
!
      FLAG = LOASRT .OR. HYPEF .OR. TRAJET
      IF(.NOT. FLAG) CALL MAJERR
!
!***  TEST INPUT UNITS, NOSE LOCATION, AND SCALING
!***  TEST FLIGHT CONDITION INPUTS
!
      IF(SCALE .LE. UNUSED) SCALE = 1.0
      CALL CONV(IDIM,SCALE)
!
      IF(FLC(160) .LT. 1.0) FLC(160) = 1.0
      IF(FLC(160) .GT. 3.0) FLC(160) = 3.0
      LOOP  = FLC(160)+0.5
      NMACH = FLC(1)  +0.5
      NALT  = FLC(159)+0.5
      IMACH = FLC(3)   .NE. UNUSED
      IRN   = FLC(43)  .NE. UNUSED
      IVEL  = FLC(137) .NE. UNUSED
      IALT  = FLC(97)  .NE. UNUSED
      IPT   =(FLC(117) .NE. UNUSED) .AND. (FLC(74) .NE. UNUSED)
      IATM  = IALT .OR. IPT
!
      IF(IMACH) GO TO 1130
        IF(IVEL) GO TO 1090
          WRITE(6,1080)
 1080     FORMAT(1H0,41H*** ERROR *** NO SPEED REFERENCE IS INPUT,      &
     &               27H MACH(1) = VINF(1) = UNUSED/                    &
     &               15X,31HTHE NEXT CASE WILL BE ATTEMPTED/)
          IERR = .TRUE.
 1090   CONTINUE
        IF(.NOT. IVEL) GO TO 1120
        IF(IATM)       GO TO 1120
          WRITE(6,1100)
 1100     FORMAT(1H0,35H*** ERROR *** VELOCITY IS INPUT AND,            &
     &               43H ATMOSPHERIC DATA ARE NOT DEFINED (ALT(1) = ,   &
     &               27HPINF(1) = TINF(1) = UNUSED)/                    &
     &               15X,41HMACH WILL BE CALCULATED USING A SPEED-OF-,  &
     &               17HSOUND OF 1000 FPS/)
          DO 1110 I=1,NMACH
            FLC(I+2) = FLC(I+136)/1000.0
 1110     CONTINUE
 1120   CONTINUE
 1130 CONTINUE
      IF(IRN .OR. IATM) GO TO 1160
        WRITE(6,1140)
 1140   FORMAT(1H0,43H*** ERROR *** REYNOLDS NUMBER IS NOT INPUT ,      &
     &             46HAND ATMOSPHERIC DATA ARE NOT DEFINED (ALT(1) =,   &
     &             28H PINF(1) = TINF(1) = UNUSED)/                     &
     &             15X,38HREYNOLDS NUMBER WILL BE SET TO 5*10**6/)
        DO 1150 I=1,NMACH
          FLC(I+42) = 5.0E6
 1150   CONTINUE
 1160 CONTINUE
!
!***  CHECK PROGRAM LOOPING
!
      FLAG = (LOOP .EQ. 1) .AND. IATM
      IF(.NOT. FLAG) GO TO 1190
        IF(FLC(159) .EQ. UNUSED) NALT = NMACH
        IF(NALT .EQ. NMACH) GO TO 1180
          I = MIN0(NALT,NMACH)
          WRITE(6,1170) NMACH, NALT, I
 1170     FORMAT(1H0,39H*** ERROR *** LOOP = 1 AND NALT IS NOT ,        &
     &               23HEQUAL TO NMACH (NALT = ,I2,10H, NMACH = ,       &
     &               I2,1H)/15X,31HNMACH AND NALT ARE BOTH SET TO ,     &
     &               I2/)
          NMACH = I
          NALT  = I
 1180   CONTINUE
 1190 CONTINUE
!
      FLAG = (LOOP .GT. 1) .AND. (.NOT. IATM)
      IF(.NOT. FLAG) GO TO 1210
        WRITE(6,1200) LOOP
 1200   FORMAT(1H0,21H*** ERROR *** LOOP = ,I2,16H AND ATMOSPHERIC ,    &
     &             34HDATA ARE NOT DEFINED, SET LOOP = 1/)
        LOOP = 1
 1210 CONTINUE
      FLC(160) = LOOP
      FLC(1)   = NMACH
      FLC(159) = NALT
!
!***  CALCULATE ATMOSPHERIC PRESSURE AND TEMPERATURE
!
      IF(.NOT. IALT) GO TO 1230
      IF(IPT)        GO TO 1230
        DO 1220 I=1,NALT
          IF(ABS(FLC(I+96)) .LE. UNUSED) FLC(I+96) = 0.0
          CALL ATMOS(FLC(I+96), FLC(I+116), FLC(I+73))
 1220   CONTINUE
 1230 CONTINUE
!
!***  WRITE ARRAY FLC FOR PLOTTING
!
      IF(PLOT) WRITE(13,1240) FLC
 1240 FORMAT(1P,10E12.4)
!
      RETURN
      END
      SUBROUTINE CLBCLC(CLBCL,DATA)
!
!***  CALCULATES TRANSONIC WING AND WING BODY CLLB AND CLLB/CL
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      DIMENSION DATA(380)
      LOGICAL FLAG
!
      DO 1000 J=1,NALPHA
        FLAG = ABS(DATA(J+20))  .GT. UNUSED .AND.                       &
     &         ABS(DATA(J+180)) .NE. UNUSED
        IF(FLAG) CLBCL = DATA(J+180)/DATA(J+20)
        IF(FLAG) GO TO 1010
 1000 END DO
      CLBCL = UNUSED
 1010 CONTINUE
      RETURN
      END
      SUBROUTINE CLEARA(IFIG,ROUTL,MSSCLL)
!
!***  CLEAR STORAGE ARRAYS FOR EXTRAPOLATION MESSAGES
!
      INTEGER ROUT,ROUTL
      COMMON /IBODY/   PB, AFIG01(121), AFIG02(121), dum1(158)
      COMMON /IWING/   PW, AFIG03(121), AFIG04(121), dum13(158)
      COMMON /IHT/    PHT, AFIG05(121), AFIG06(121), dum3(138)
      COMMON /IVT/    PVT, AFIG07(121), AFIG08(121), dum4(138)
      COMMON /IVF/    PVF, AFIG09(121), AFIG10(121), dum17(138)
      COMMON /IBW/    PBW, AFIG11(121), AFIG12(121), dum5(138)
      COMMON /IBH/    PBH, AFIG13(121), AFIG14(121), dum6(138)
      COMMON /IBV/    PBV, JFIG01(121), JFIG02(121), dum7(138)
      COMMON /IBWH/  PBWH, JFIG03(121), JFIG04(121), dum8(138)
      COMMON /IBWV/  PBWV, JFIG05(121), JFIG06(121), dum9(138)
      COMMON /IBWHV/PBWHV, JFIG07(121), JFIG08(121), dum12(138)
      COMMON /WINGD/       JFIG09(121)
      COMMON /SBETA/       JFIG10(121), JFIG11(121), JFIG12(121)
      COMMON /BDATA/       JFIG13(121), JFIG14(121), JFIG15(121),       &
     &                     JFIG16(121), JFIG17(121)
      COMMON /WHWB/        JFIG18(121)
      COMMON /WBHCAL/      JFIG19(121)
      COMMON /HTDATA/      JFIG20(121)
      COMMON /VTDATA/ LFIGN(121),LFIGO(121),IOVLY,IOVL,NSTQ,NSTP,FINALR,&
     &                NFIG,IFIGN
      COMMON /WHAERO/ LFIGS(121), IFIGST(20), IEXCD(4), MSSCL(2),       &
     &                ROUT(2), XLL(4), XUL(4), IEXTRL(4,2),             &
     &                IEXTRU(4,2), XVAL(4), LDUM(121)
      DIMENSION IFIG(20,121)
      DATA IHBL/4H    /
      DO 1000 I=1,121
      AFIG01(I)=0.
      AFIG02(I)=0.
      AFIG03(I)=0.
      AFIG04(I)=0.
      AFIG05(I)=0.
      AFIG06(I)=0.
      AFIG07(I)=0.
      AFIG08(I)=0.
      AFIG09(I)=0.
      AFIG10(I)=0.
      AFIG11(I)=0.
      AFIG12(I)=0.
      AFIG13(I)=0.
      AFIG14(I)=0.
      JFIG01(I)=0
      JFIG02(I)=0
      JFIG03(I)=0
      JFIG04(I)=0
      JFIG05(I)=0
      JFIG06(I)=0
      JFIG07(I)=0
      JFIG08(I)=0
      JFIG09(I)=0
      JFIG10(I)=0
      JFIG11(I)=0
      JFIG12(I)=0
      JFIG13(I)=0
      JFIG14(I)=0
      JFIG15(I)=0
      JFIG16(I)=0
      JFIG17(I)=0
      JFIG18(I)=0
      JFIG19(I)=0
      JFIG20(I)=0
      LFIGN(I)=0
      LFIGO(I)=0
      LFIGS(I)=0
      LDUM(121)=0
 1000 END DO
      DO 1010 I=1,4
         IEXCD(I)=0
         XLL(I)=0.
         XUL(I)=0.
         IEXTRL(I,1)=0
         IEXTRU(I,1)=0
         IEXTRL(I,2)=0
         IEXTRU(I,2)=0
         XVAL(I)=0.
 1010 END DO
      DO 1020 I=1,2
         ROUT(I)=IHBL
         MSSCL(I)=IHBL
 1020 END DO
      DO 1030 I=1,20
         IFIGST(I)=IHBL
 1030 END DO
      IOVLY=999
      IOVL=0
      NSTQ=0
      NSTP=0
      FINALR=0.
      NFIG=0
      IFIGN=0
      ROUTL=IHBL
      MSSCLL=IHBL
      DO 1040 I=1,121
         DO 1040 J=1,20
            IFIG(J,I)=IHBL
 1040 CONTINUE
      RETURN
      END
      SUBROUTINE CLMCH0(A,B,CLALPA,CLMAX,CLMAXL,CLAMO,WING,ITTY)
!
!***  COMPUTES LIFTING SURFACE CL AT MACH=0
!
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA,IG
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &      HEAD,PRPOWR,JEQPOW,LOASRT,TVTPAN,SUPERS,SUBSON,TRANSN,HYPERS
      LOGICAL       FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,    &
     &      HEAD,PRPOWR,JEQPOW,LOASRT,TVTPAN,SUPERS,SUBSON,TRANSN,HYPERS
      DIMENSION A(1),B(1),CLALPA(1),CLMAX(1),WING(1)
!
!     ----COMPUTE CLW S FOR MACH=0.
!
      B(1)=0.
      A(131)=CLALPA(1)
      IF(TRANSN)A(131)=CLAMO
      A(132)=CLMAXL
      B(2)=1.0
      WSAVE=CLMAX(1)
      CLMAX(1)=CLMAXL
      DO 1000 K=1,20
         WING(K)=0.0
 1000 END DO
      M=1
      IF(ITTY .EQ. 0) CALL M15O17
      IF(ITTY .NE. 0) CALL M16O20
!
!     ----STORE ALL CLWS FOR MACH=0.
!
      B(48)=WING(101)
      NALPHA=FLC(2)+.5
      DO 1010 J=1,NALPHA
         B(J+2)=WING(J+20)
 1010 END DO
      A(127)=B(43)
      A(126)=B(49)
      CLMAX(1)=WSAVE
      RETURN
      END
      SUBROUTINE CLMXB1 (BU4,CLSMAX,A,AIN)
!
!*** COMPUTES CLMAX AT MACH=0.6 WHICH IS USED IN SUBROUTINE TRSONI
!
      DIMENSION ROUTID(2)
      DIMENSION Q3417A(3),Q3416A(3),Q3416B(3)
      COMMON /OPTION/ SREF
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                SUPERS,SUBSON,TRANSN,HYPERS,HEAD,PRPOWR,JEQPOW,   &
     &                LOASRT,TVTPAN
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,HEAD,    &
     &         PRPOWR,JEQPOW,LOASRT,TVTPAN,SUPERS,SUBSON,TRANSN,HYPERS
      DIMENSION A(195),AIN(18)
!
!     ----4.1.3.4-16(A+B)
!
      DIMENSION C1ABC(19) , DYAG(6) , BASE(19,12)  ,CBASE(228)
      EQUIVALENCE(BASE(1,1),CBASE(1))
      DIMENSION C2A(15) , AMN(3) , DV(15,3) , DE(45)
      EQUIVALENCE (DV(1,1),DE(1))
      DATA ROUTID/4HCLMX,4HB1  /
      DATA Q3417A/4H4.1.,4H3.4-,4H17A /,Q3416A/4H4.1.,4H3.4-,4H16A /,   &
     &     Q3416B/4H4.1.,4H3.4-,4H16B /
      DATA C1ABC/0.,.2,.4,.6,.8,1.,1.2,1.4,1.6,1.8,2.,2.2,2.4,2.6,2.8,3.&
     &     ,3.2,3.4,3.6/
      DATA DYAG /0.,.25,.5,.75,1.,1.35/
      DATA CBASE /.9,1.38,1.58,1.65,1.65,1.58,1.45,1.32,1.21,1.13,1.06, &
     &1.02,.99,.96,.94,.92,.91,2*.9 , .75,1.28,1.47,1.55,1.56,1.5,1.38, &
     &1.27,1.17,1.08,1.02,.98,.94,.92,.9,.89,.88,2*.87 , .65,1.21,1.39, &
     &1.47,1.47,1.4,1.27,1.17,1.08,1.02,.97,.94,.92,.90,.88,.87,.86,.85,&
     &.84 , .6,1.11,1.3,1.37,1.38,1.33,1.22,1.13,1.06,1.01,.96,.92,.90, &
     &.88,.86,.85,.84,2*.83 , .4,1.02,1.2,1.29,1.31,1.26,1.18,1.11,1.04,&
     &.98,.94,.9,.88,.86,.84,.83,2*.82,.81 , .4,1.02,1.2,1.29,1.31,1.26,&
     &1.18,1.09,1.02,.96,.91,.87,.85,.84,.82,.81,3*.8 , .68,1.18,1.37,  &
     &1.43,1.44,1.37,1.24,1.17,1.10,1.06,1.02,.99,.96,.94,.92,.91,.9,.89&
     &,.88 , .65,1.11,1.29,1.36,1.37,1.31,1.2,1.13,1.07,1.03,.99,.96,.94&
     &,.92,.9,.89,.88,.87,.86 , .6,1.07,1.23,1.29,1.3,1.25,1.16,1.1,1.05&
     &,1.01,.97,.94,.92,.9,.88,.87,.86,.85,.84 , .55,.99,1.15,1.23,1.25,&
     &1.21,1.14,1.09,1.04,.99,.95,.92,.9,.88,.86,.85,.84,2*.83 , .5,.91,&
     &1.08,1.17,1.2,1.17,1.13,1.07,1.03,.98,.94,.9,.88,.86,.84,.83,3*.82&
     & , .5,.91,1.08,1.17,1.2,1.17,1.11,1.06,1.01,.96,.91,.88,.85,.83,  &
     &.82,.81,3*.8 /
!
!     ----4.1.3.4-17(A)
!
      DATA C2A /0.,1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.,13.,14./
      DATA AMN /.2,.4,.6/
      DATA DE /-.11,-.10,-.085,-.045,0.,.055,.115,.175,.23,.285,.335,   &
     & .365,.36,.315,.225 , -.11,-.1,-.085,-.045,0.,.05,.1,.15,.2,.255, &
     &.3,.33,.32,.275,.185 , -.11,-.1,-.085,-.045,0.,.04,.08,.115,.15,  &
     &.18,.21,.225,.21,.16,.08 /
!
!     ----4.1.3.4-17(A)
!
      ARG=0.60
      CALL TLINEX(AMN,C2A,DV,3,15,ARG,A(160),DCLMAX,                    &
     &           -1,2,0,2,Q3417A,3,ROUTID)
!
!     ----TEST (X/C)TMAX
!
      IF(AIN(18).GT.0.35) GO TO 1000
!
!     ----4.1.3.4-16(A)
!
      CALL TLINEX(DYAG,C1ABC,CBASE,6,19,AIN(17),BU4,CLBASE,             &
     &            0,0,-1,0,Q3416A,3,ROUTID)
      GO TO 1010
!
!     ----4.1.3.4-16(B)
!
 1000 CALL TLINEX(DYAG,C1ABC, BASE(1,7),6,19,AIN(17),BU4,CLBASE,        &
     &             0,0,-1,0,Q3416B,3,ROUTID)
 1010 CLSMAX=(CLBASE+DCLMAX)*A(3)/SREF
      RETURN
      END
      SUBROUTINE CLMXBS(BU4,CLSMAX,A,B,AIN)
!
!***  COMPUTES LIFTING SURFACE CLMAX
!
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      DIMENSION ROUTID(2)
      DIMENSION Q3417A(3),Q3416A(3),Q3416B(3)
      DIMENSION A(195),B(49),AIN(18)
      DIMENSION C2A(15) , AMN(3) , DV(15,3) , DE(45)
      DIMENSION C1ABC(19) , DYAG(6) , BASE(19,12)  ,CBASE(228)
!
      EQUIVALENCE(BASE(1,1),CBASE(1))
      EQUIVALENCE (DV(1,1),DE(1))
!
      DATA ROUTID/4HCLMX,4HBS  /
      DATA Q3417A/4H4.1.,4H3.4-,4H24A /,Q3416A/4H4.1.,4H3.4-,4H23A /,   &
     &     Q3416B/4H4.1.,4H3.4-,4H23B /
!
!     ----4.1.3.4-23(A+B)
!
      DATA C1ABC/0.,.2,.4,.6,.8,1.,1.2,1.4,1.6,1.8,2.,2.2,2.4,2.6,2.8,3.&
     &           ,3.2,3.4,3.6/
      DATA DYAG /0.,.25,.5,.75,1.,1.35/
      DATA CBASE /.9,1.38,1.58,1.65,1.65,1.58,1.45,1.32,1.21,1.13,1.06, &
     &1.02,.99,.96,.94,.92,.91,2*.9 , .75,1.28,1.47,1.55,1.56,1.5,1.38, &
     &1.27,1.17,1.08,1.02,.98,.94,.92,.9,.89,.88,2*.87 , .65,1.21,1.39, &
     &1.47,1.47,1.4,1.27,1.17,1.08,1.02,.97,.94,.92,.90,.88,.87,.86,.85,&
     &.84 , .6,1.11,1.3,1.37,1.38,1.33,1.22,1.13,1.06,1.01,.96,.92,.90, &
     &.88,.86,.85,.84,2*.83 , .4,1.02,1.2,1.29,1.31,1.26,1.18,1.11,1.04,&
     &.98,.94,.9,.88,.86,.84,.83,2*.82,.81 , .4,1.02,1.2,1.29,1.31,1.26,&
     &1.18,1.09,1.02,.96,.91,.87,.85,.84,.82,.81,3*.8 , .68,1.18,1.37,  &
     &1.43,1.44,1.37,1.24,1.17,1.10,1.06,1.02,.99,.96,.94,.92,.91,.9,.89&
     &,.88 , .65,1.11,1.29,1.36,1.37,1.31,1.2,1.13,1.07,1.03,.99,.96,.94&
     &,.92,.9,.89,.88,.87,.86 , .6,1.07,1.23,1.29,1.3,1.25,1.16,1.1,1.05&
     &,1.01,.97,.94,.92,.9,.88,.87,.86,.85,.84 , .55,.99,1.15,1.23,1.25,&
     &1.21,1.14,1.09,1.04,.99,.95,.92,.9,.88,.86,.85,.84,2*.83 , .5,.91,&
     &1.08,1.17,1.2,1.17,1.13,1.07,1.03,.98,.94,.9,.88,.86,.84,.83,3*.82&
     & , .5,.91,1.08,1.17,1.2,1.17,1.11,1.06,1.01,.96,.91,.88,.85,.83,  &
     &.82,.81,3*.8 /
!
!     ----4.1.3.4-24(A)
!
      DATA C2A /0.,1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.,13.,14./
      DATA AMN /.2,.4,.6/
      DATA DE /-.11,-.10,-.085,-.045,0.,.055,.115,.175,.23,.285,.335,   &
     & .365,.36,.315,.225 , -.11,-.1,-.085,-.045,0.,.05,.1,.15,.2,.255, &
     &.3,.33,.32,.275,.185 , -.11,-.1,-.085,-.045,0.,.04,.08,.115,.15,  &
     &.18,.21,.225,.21,.16,.08 /
!
!     ----4.1.3.4-24(A)
!
      CALL TLINEX(AMN,C2A,DV,3,15,B(1),A(160),DCLMAX,                   &
     &            -1,2,0,2,Q3417A,3,ROUTID)
!
!     ----TEST (X/C)TMAX
!
      IF(AIN(18).GT.0.35) GO TO 1000
!
!     ----4.1.3.4-23(A)
!
      CALL TLINEX(DYAG,C1ABC,CBASE,6,19,AIN(17),BU4,CLBASE,             &
     &            0,0,-1,0,Q3416A,3,ROUTID)
      GO TO 1010
!
!     ----4.1.3.4-23(B)
!
 1000 CALL TLINEX(DYAG,C1ABC, BASE(1,7),6,19,AIN(17),BU4,CLBASE,        &
     &            0,0,-1,0,Q3416B,3,ROUTID)
 1010 CLSMAX=(CLBASE+DCLMAX)*A(3)/SREF
      RETURN
      END
      SUBROUTINE CLRDER
!
!  CALCULATE DYNAMIC DERIVATIVE CLR (ROLL DUE TO YAW RATE)
!      FOR BODY, WING, WING-BODY, AND WING-BODY-HORIZONAL-VERTICAL
!  CALCULATE VERTICAL TAIL CLP
!  CALCULATE BODY-HORIZONTAL-TAIL CLQ,CMQ,CLAD,CMAD,CYP,CNP, AND CNR
!  CALCULATE BODY-VERTICAL-TAIL CLQ,CMQ,CLAD,CMAD,CLP,CYP,CNP, AND CNR
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /WINGD/  A(195)
      COMMON /WINGI/  WINGIN(77)
      COMMON /WBHCAL/ WBT(156)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /SUPWBB/  SWB(61),SHB(61)
      COMMON /IWING/  PWING,WING(400)
      COMMON /IVT/    PVT,VT(380)
      COMMON /IVF/    PVF,VF(380)
      COMMON /IBODY/  PBODY,BODY(400)
      COMMON /IBW/    PBW,BW(380)
      COMMON /IHT/    PHT, HT(380)
      COMMON /IBH/    PBH, BH(380)
      COMMON /IBV/    PBV, BV(380)
      COMMON /IBWHV/  PBWHV,BWHV(380)
      COMMON /IBWV /  PBWV,BWV(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      DIMENSION VAR(3),LGH(3),ROUTID(2),CLR(20),CLRWBT(20),             &
     & X73210(20),Y73210(40),F73210(3),X73211(18),Y73211(36),F73211(3), &
     & UNITS(5),UNITI(5),OMEGA(5),ALPHA(20),CL(20)
      REAL MACH,LP,LPF
      DIMENSION STP(156)
      EQUIVALENCE(STP(1),WBT(1))
      EQUIVALENCE(ALPHA(1),FLC(23)),(CL(1),WING(21)),(CLR(1),WING(361)),&
     & (CLRWBT(1),BWHV(361))
      DATA ROUTID / 4HCLRD, 4HER  /
!
!     DATA FOR FIGURE 7.1.3.2-10
!
      DATA X73210/1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,0.,.25,.5,1.,6*0./
      DATA Y73210/2.,3.3,3.9,4.2,4.5,4.8,4.9,4.95,5.,5.,3.,4.15,4.95,   &
     & 5.4,5.8,6.,6.2,6.4,6.45,6.5,3.95,5.5,6.25,6.8,7.15,7.45,7.75,    &
     & 7.8,7.9,7.95,5.,6.8,7.5,8.05,8.5,8.85,9.,9.15,9.2,9.25/
      DATA F73210/ 4H7.1., 4H3.2-, 4H10  /
!
!     DATA FOR FIGURE 7.1.3.2-11
!
      DATA X73211/2.,3.,4.,5.,6.,7.,8.,9.,10.,0.,.2,.4,99.,5*0./
      DATA Y73211/.0014,.00175,.00205,.0022,.00215,.0021,.00215,.00225, &
     & .00255,.0017,.0022,.0025,.00285,.0032,.00323,.00325,.00335,.0036,&
     & .002,.00245,.0028,.00315,.0035,.0036,.00375,.00397,.0043,        &
     & .002,.00245,.0028,.00315,.0035,.0036,.00375,.00397,.0043/
      DATA F73211 / 4H7.1., 4H3.2-, 4H11  /
      DATA UNITS  /.025,.03,.03571428571,.04444444444,.056/
      DATA UNITI  /.05,.06,.07857142857,.1,.12/
      DATA OMEGA  /0.,15.,30.,45.,60./
!
      IF(.NOT. BO) GO TO 1010
!
!      SET BODY CLR DATA TO ZERO
!
      DO 1000 J=1,NALPHA
 1000 BODY(J+360)=0.0
 1010 CONTINUE
      IF(.NOT.SUBSON) GO TO 1060
      MACH=FLC(I+2)
      SWEC4=A(41)
      TAPRE=A(27)
      AR=A(7)
      GAMMA=STB(122)/RAD
      TWIST=WINGIN(11)
      LP=STB(11)
      ZP=STB(12)
      LPF=STBH(11)
      ZPF=STBH(12)
      DCYBV=VT(141)
      DCYBF=VF(141)
      IF(.NOT. WGPL)  GO TO 1040
      BEE=SQRT(1.-(MACH*COS(SWEC4))**2)
      AB=AR*BEE
      CS=COS(SWEC4)
      TS=TAN(SWEC4)
      CON=(1.+(AR*(1.-BEE**2)/(2.*BEE*(AB+2.*CS)))+(AB+2.*CS)/(AB+4.*CS)&
     &     *TS**2/8.)/(1.+(AR+2.*CS)/(AR+4.*CS)*TS**2/8.)
      DCLRG=PI*AR*SIN(SWEC4)/(12.*(AR+4.*CS))
!
!---- FIGURE 7.1.3.2-10
!
      VAR(1)=AR
      VAR(2)=TAPRE
      LGH(1)=10
      LGH(2)=4
      CALL INTERX(2,X73210,VAR,LGH,Y73210,UNIT,10,40,1,1,0,0,1,1,0,0,   &
     &            F73210,3,ROUTID)
      DO 1020 J=1,4
         IF((SWEC4*RAD) .GE. OMEGA(J)) JJ=J
 1020 END DO
      IF(SWEC4 .LT. 0.) GO TO 1040
      CLRCLO=(UNITI(JJ+1)-UNITI(JJ))/15.*(OMEGA(JJ+1)-SWEC4*RAD) -      &
     &       UNITI(JJ+1) + ((UNITS(JJ+1)-UNITS(JJ))/15.*(OMEGA(JJ+1)-   &
     &       SWEC4*RAD)-UNITS(JJ+1))*UNIT
!
!---- FIGURE 7.1.3.2-11
!
      VAR(1)=AR
      VAR(2)=TAPRE
      LGH(1)=9
      LGH(2)=4
      CALL INTERX(2,X73211,VAR,LGH,Y73211,DCLRT,9,36,0,0,0,0,0,0,0,0,   &
     &            F73211,3,ROUTID)
      CLRCLM=-CLRCLO*CON
!
!---- CLR VERSUS ALPHA
!
      DO 1030 J=1,NALPHA
         CLR(J)=(CL(J)*CLRCLM+DCLRG*GAMMA+DCLRT*TWIST)/RAD
         IF(.NOT. BO) GO TO 1030
!
!  SET IOM SINCE WING-BODY IS THE SAME AS WING ALONE
!
         BW(J+360)=CLR(J)
 1030 END DO
 1040 IF(.NOT. (VTPL.OR.VFPL)) GO TO 1060
      DO 1050 J=1,NALPHA
         SA=SIN(ALPHA(J)*DEG)
         CA=COS(ALPHA(J)*DEG)
         IF(SWEC4 .LT. 0.) GO TO 1050
         CLRWBT(J)=CLR(J)
         IF(VTPL)CLRWBT(J)=CLRWBT(J)-2.*DCYBV*(LP*CA+ZP*SA)             &
     &           *(ZP*CA-LP*SA)/BLREF**2
         IF(VFPL)CLRWBT(J)=CLRWBT(J)-2.*DCYBF*(LPF*CA+ZPF*SA)           &
     &           *(ZPF*CA-LPF*SA)/BLREF**2
         IF(VTPL)VT(J+280)=2.*DCYBV*(ZP*CA-LP*SA)*(ZP*CA-LP*SA-ZP)/     &
     &           BLREF**2
         IF(VFPL)VF(J+280)=2.*DCYBV*(ZPF*CA-LPF*SA)*(ZPF*CA-LPF*SA-ZPF)/&
     &           BLREF**2
         BWV(J+360)=CLRWBT(J)
         IF(VTPL) VT(J+360)=-2.*DCYBV*(LP*CA+ZP*SA)*(ZP*CA-LP*SA)/      &
     &            BLREF**2
         IF(VFPL) VF(J+360)=-2.*DCYBF*(LPF*CA+ZPF*SA)*(ZPF*CA-LPF*SA)   &
     &                    /BLREF**2
 1050 END DO
 1060 IF(.NOT. BO) GO TO 1120
      IF(.NOT. HTPL) GO TO 1100
      IF(SUBSON)AKHB=WBT(1)
      IF(SUBSON)AKBH=WBT(2)
      IF(TRANSN)AKHB=SHB(35)
      IF(TRANSN)AKBH=SHB(11)
      IF(SUPERS)AKHB=STP(66)
      IF(SUPERS)AKBH=STP(65)
      IF(AKHB.EQ.UNUSED .OR. AKBH.EQ.UNUSED) GO TO 1080
!
!----- BODY-HORIZONTAL-TAIL CLQ,CMQ,CLAD,CMAD
!
      DO 1070 K=1,4
         KK=(K-1)*20+1
         IF(HT(KK+200).EQ.UNUSED .OR. BODY(KK+200).EQ.UNUSED) GO TO 1070
         BH(KK+200)=(AKBH+AKHB)*HT(KK+200)+BODY(KK+200)
 1070 END DO
!
!----- BODY-HORIZONTAL-TAIL CYP,CNP,CNR
!
 1080 DO 1090 K=1,3
         KK=(K-1)*20+1
         IF(HT(KK+300).EQ.UNUSED .OR. BODY(KK+300).EQ. UNUSED)          &
     &            GO TO 1090
         BH(KK+300)=HT(KK+300)+BODY(KK+300)
 1090 END DO
 1100 IF(.NOT. VTPL) GO TO 1120
!
!----- BODY-VERTICAL-TAIL CLQ,CMQ,CLAD,CMAD,CLP,CYP,CNR
!
      DO 1110 K=1,8
         KK=(K-1)*20+1
         IF((VT(KK+200).EQ.UNUSED .AND. VF(KK+200).EQ.UNUSED) .OR.      &
     &      BODY(KK+200).EQ.UNUSED) GO TO 1110
         BV(KK+200)=VT(KK+200)+BODY(KK+200)+VF(KK+200)
 1110 END DO
 1120 CONTINUE
      RETURN
      END
      SUBROUTINE CLWBT
!
!***  COMPUTES TRANSONIC WING BODY TAIL CL
!
      COMMON /IBODY/  PBOD, CDB(20),CLB(20)
      COMMON /IHT/    PHT,  CDH(20),CLH(20),HT(60),CLAH, dum3(279)
      COMMON /IBW/    PBW,  CDBW(20),CLBW(20),BW(60),CLABW, dum5(279)
      COMMON /IBV/    PBV,  CDBV(20),CLBV(20),BV(60),CLABV, dum7(279)
      COMMON /IBWH/   PBWH, CDBWH(20),CLBWH(20),BWH(60),CLABWH(20)
      COMMON /IBWV/   PBWV, CDBWV(20),CLBWV(20)
      COMMON /IBWHV/  PBWT, CDBWT(20),CLBWT(20),BWT(60),CLABWT(20)
      COMMON /IDWASH/ PDWA, QOQI(20),EPS(20),DEODA(20)
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /WHWB/   FACT(182)
      COMMON /HTDATA/ AHT(195),BHT(49)
      COMMON /SUPWBB/  SWB(61),SHB(61)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
!
      EQUIVALENCE (SHB(2),KKHB), (SHB(11),KBH), (SHB(35),KHB),          &
     &            (SHB(37),KKBH)
      DIMENSION C(6),ROUTID(2)
      LOGICAL FLAG,VERTUP
      REAL KHB,KBH,KKHB,KKBH
      DATA ROUTID /4HCLWB, 4HT   /
!
      IY = 0
      DO 1000 J=1,NALPHA
         FLAG = ABS(CLBW(J)) .NE. UNUSED
         IF(FLAG) CLBWV(J) = CLBW(J)
         IF(ABS(CLB(J))  .NE. UNUSED) CLBV(J) = CLB(J)
!
         FLAG = ABS(CLBW(J)) .NE. UNUSED .AND. ABS(CLH(J)) .NE. UNUSED  &
     &    .AND. ABS(QOQI(J)) .NE. UNUSED .AND. ABS(EPS(J)) .NE. UNUSED
         IF(.NOT. FLAG) GO TO 1000
         ALPT = BHT(J+22)-EPS(J)
         FLAG = ABS(DEODA(J)) .NE. UNUSED
         IF(FLAG) CLABWH(J) = CLABW+(KHB+KBH)*CLAH*                     &
     &           (1.0-DEODA(J))*QOQI(J)
         IF(FLAG) CLABWT(J) = CLABWH(J)
         CALL TBFUNX(ALPT,CLHJ,DYDX,NALPHA,FLC(23),CLH,C,IY,            &
     &              MI,NG,0,0,4HCLH ,1,ROUTID)
         CLI = CLAH*ALIH
         CLBWH(J) = (CLHJ-CLI)*(KHB+KBH)+CLI*(KKHB+KKBH)+FACT(141)*     &
     &             FACT(J+141)*FACT(J+161)*CLAH*ALPT
         CLBWH(J) = CLBWH(J)*QOQI(J)+CLBW(J)
         CLBWT(J) = CLBWH(J)
 1000 END DO
      RETURN
      END
      SUBROUTINE CMALPH(A,B,C,WINGIN,WING)
!
!***  COMPUTES LIFTING SURFACE CMA
!
      LOGICAL TANRAT
      LOGICAL CONST
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
!
      DIMENSION ROUTID(2)
      DIMENSION Q41412(3),Q4222A(3),Q4222B(3),Q4311B(3),Q4311C(3),      &
     &    Q4311A(3),Q4312A(3),Q4313A(3),Q313B1(4),Q313B2(4),Q312B1(4),  &
     &    Q312B2(4)
     
!      DIMENSION A(195),B(49),C(51),WINGIN(100),WING(400)
      DIMENSION A(*),B(*),C(*),WINGIN(*),WING(*)
!  changed by RLC  2021Jan18      
      
      DIMENSION CC11A(6),CC11B(6)
      DIMENSION X21412(22),X11412(5),X31412(3),Y41412(330)
      DIMENSION Y415A(110),Y415B(110),Y415C(110)
      DIMENSION X322A(6),X222A(6),X122A(6),Y22A(216)
      DIMENSION X322B(6),X222B(6),X122B(6),Y22B(216)
      DIMENSION X211A(12),Y11A(12)
      DIMENSION X111C(4),X211C(15),Y11C(60)
      DIMENSION X212A(6),X112A(11),Y12A(66)
      DIMENSION X212B1(25),X112B1(6),Y12B1(150)
      DIMENSION X212B2(21),X112B2(3),Y12B2(63)
      DIMENSION X213A(15),X113A(9),Y13A(135)
      DIMENSION X213B1(9),X113B1(6),Y13B1(54)
      DIMENSION X213B2(9),X113B2(3),Y13B2(27)
      DIMENSION XCMOM(15), YCMOM(15), CCMOM(6), QCMOM(3)
      DIMENSION WTYPE(4)
      DIMENSION X211B(7),Y11B(7)
!
      EQUIVALENCE (Y41412(1),Y415A(1)),(Y41412(111),Y415B(1))
      EQUIVALENCE (Y41412(221),Y415C(1))
!
      DATA ROUTID/4HCMAL,4HPH  /
      DATA Q41412/4H4.1.,4H4.1-,4H5   /,Q4222A/4H4.1.,4H4.2-,4H26A /,   &
     & Q4222B/4H4.1.,4H4.2-,4H26B /,Q4311B/4H4.1.,4H4.3-,4H21B /,       &
     & Q4311C/4H4.1.,4H4.3-,4H22A /,Q4311A/4H4.1.,4H4.3-,4H21A /,       &
     & Q4312A/4H4.1.,4H4.3-,4H22A /,Q4313A/4H4.1.,4H4.3-,4H24A /,       &
     & Q313B1/4H4.1.,4H4.3-,4H24B-,4H1   /,Q313B2/4H4.1.,4H4.3-,4H24B-, &
     &4H2   /,Q312B1/4H4.1.,4H4.3-,4H23A ,4H    /,                      &
     & Q312B2 /4H4.1.,4H4.3-,4H23B ,4H    /,                            &
     & QCMOM  /4H4.1.,4H4.1-,4H6    /
      DATA IN11A/0/
      DATA IN11B/0/
!
!---------    FIGURE 4.1.4.1-6
!
      DATA ICMOM / 0 /
      DATA XCMOM / 0., .25, .30, .35, .40, .45, .50, .55, .60, .65,     &
     &            .70, .75, .80, .85, .90 /
      DATA YCMOM / 1.000, 1.000, 1.005, 1.017, 1.031, 1.050, 1.072,     &
     &             1.101, 1.132, 1.162, 1.197, 1.237, 1.287, 1.355,     &
     &             1.445 /
!
!---------    FIGURE 4.1.4.1-5 - MODIFIED FOR FORWARD SWEPT WINGS
!     ----Y41412(22,5,3) , X31412=TAPER RATIO  X11416= ASPECT RATIO
!     ----X21412=QUARTER CHORD SWEEP ANGLE
!
      DATA X31412 /0.,.5,1./
      DATA X11412 /10.,8.,6.,3.5,1.5/
      DATA X21412 /-45.,-40.,-35.,-30.,-25.,-20.,-15.,-10.,-5.,         &
     &             0.,5.,10.,15.,20.,25.,30.,35.,40.,45.,50.,           &
     &             55.,60./
      DATA Y415A /                                                      &
     &  .0116,  .0100,  .0085,  .0072,  .0060,  .0048,  .0036,  .0024,  &
     &  .0012,  .0000, -.0012, -.0024, -.0037, -.0050, -.0063, -.0076,  &
     & -.0090, -.0104, -.0118, -.0131, -.0145, -.0159,                  &
     &  .0081,  .0070,  .0061,  .0051,  .0042,  .0034,  .0025,  .0017,  &
     &  .0008,  .0000, -.0009, -.0017, -.0026, -.0035, -.0045, -.0055,  &
     & -.0065, -.0076, -.0086, -.0097, -.0108, -.0119,                  &
     &  .0052,  .0045,  .0039,  .0033,  .0027,  .0022,  .0016,  .0011,  &
     &  .0005,  .0000, -.0005, -.0011, -.0017, -.0023, -.0029, -.0035,  &
     & -.0042, -.0049, -.0057, -.0063, -.0070, -.0078,                  &
     &  .0022,  .0019,  .0016,  .0014,  .0011,  .0009,  .0007,  .0004,  &
     &  .0002,  .0000, -.0002, -.0004, -.0007, -.0009, -.0012, -.0014,  &
     & -.0017, -.0021, -.0024, -.0027, -.0032, -.0036,                  &
     &  .0005,  .0004,  .0004,  .0003,  .0002,  .0002,  .0001,  .0001,  &
     &  .0000,  .0000, -.0000, -.0001, -.0001, -.0002, -.0002, -.0003,  &
     & -.0004, -.0004, -.0005, -.0006, -.0007, -.0008/
      DATA Y415B /                                                      &
     &  .0204,  .0177,  .0152,  .0128,  .0105,  .0083,  .0061,  .0041,  &
     &  .0020,  .0000, -.0020, -.0040, -.0060, -.0080, -.0100, -.0121,  &
     & -.0141, -.0162, -.0182, -.0208, -.0232, -.0257,                  &
     &  .0144,  .0125,  .0107,  .0090,  .0073,  .0058,  .0043,  .0028,  &
     &  .0014,  .0000, -.0014, -.0028, -.0042, -.0056, -.0071, -.0086,  &
     & -.0102, -.0117, -.0133, -.0153, -.0172, -.0193,                  &
     &  .0091,  .0078,  .0066,  .0055,  .0045,  .0035,  .0026,  .0017,  &
     &  .0009,  .0000, -.0009, -.0017, -.0026, -.0035, -.0044, -.0054,  &
     & -.0064, -.0075, -.0087, -.0099, -.0113, -.0128,                  &
     &  .0036,  .0030,  .0026,  .0021,  .0017,  .0013,  .0010,  .0007,  &
     &  .0003,  .0000, -.0003, -.0007, -.0010, -.0013, -.0017, -.0021,  &
     & -.0025, -.0030, -.0036, -.0043, -.0050, -.0058,                  &
     &  .0007,  .0006,  .0005,  .0004,  .0003,  .0003,  .0002,  .0001,  &
     &  .0001,  .0000, -.0001, -.0001, -.0002, -.0003, -.0003, -.0004,  &
     & -.0005, -.0006, -.0007, -.0008, -.0009, -.0010/
      DATA Y415C /                                                      &
     &  .0218,  .0189,  .0162,  .0135,  .0111,  .0087,  .0064,  .0042,  &
     &  .0021,  .0000, -.0020, -.0041, -.0061, -.0081, -.0101, -.0121,  &
     & -.0141, -.0162, -.0182, -.0202, -.0222, -.0243,                  &
     &  .0154,  .0133,  .0113,  .0095,  .0077,  .0060,  .0044,  .0029,  &
     &  .0014,  .0000, -.0014, -.0028, -.0043, -.0057, -.0072, -.0087,  &
     & -.0102, -.0117, -.0133, -.0148, -.0163, -.0179,                  &
     &  .0097,  .0083,  .0070,  .0058,  .0047,  .0037,  .0027,  .0018,  &
     &  .0009,  .0000, -.0009, -.0018, -.0027, -.0036, -.0045, -.0055,  &
     & -.0065, -.0075, -.0086, -.0098, -.0108, -.0119,                  &
     &  .0038,  .0032,  .0027,  .0022,  .0018,  .0014,  .0010,  .0007,  &
     &  .0003,  .0000, -.0003, -.0007, -.0010, -.0014, -.0018, -.0022,  &
     & -.0026, -.0031, -.0036, -.0043, -.0050, -.0057,                  &
     &  .0008,  .0006,  .0005,  .0004,  .0003,  .0003,  .0002,  .0001,  &
     &  .0001,  .0000, -.0001, -.0001, -.0002, -.0003, -.0003, -.0004,  &
     & -.0005, -.0006, -.0007, -.0008, -.0009, -.0010/
!
!---------FIGURE  4.1.4.2-26A
!---------Y22A(6,6,6)  X322A=TAPER RATIO  X122A=A*(L.E.S.A)
!---------X222A=LEADING EDGE SWEEP ANGLE(L.E.S.A)
!
      DATA X322A/0.,.2,.25,.333,.5,1./
      DATA X122A/6.,5.,4.,3.,2.,1./
      DATA X222A/0.,.20,.40,.60,.80,1.0/
      DATA Y22A/.68,.7,.72,.74,.76,.78,.58,.6,.62,.64,.66,.68,.51,.52,  &
     &.53,.54,.55,.56,.42,.425,.435,.44,.445,.445,6*.335,.25,.245,.24,  &
     &.235,.230,.225,.87,.88,.89,.905,.915,.925,.75,.76,.775,.785,.8,   &
     &.81,.64,.65,.66,.675,.685,.695,.52,.525,.535,.54,.5425,.55,.4,    &
     &5*.405,.28,.275,.265,.26,.255,.25,.93,.94,.95,.96,.97,.98,.8,.81, &
     &.82,.83,.84,.85,.67,.68,.69,.70,.71,.72,.54,.55,.56,.57,.575,.58, &
     &2*.41,2*.42,.428,.43,.3,.29,2*.28,.275,.27,2*1.04,2*1.05,1.06,    &
     &1.08,2*.89,.90,2*.91,.92,.73,.74,.75,.758,.76,.77,.59,3*.6,.61,   &
     &.618,4*.46,2*.45,.32,.318,.31,.308,.30,.29,3*1.2,1.21,1.22,1.23,  &
     &2*1.04,2*1.05,2*1.06,3*.88,.882,.89,.90,5*.70,.705,2*.53,4*.52,   &
     &.36,.35,.34,.335,.33,.32 , 4*1.74,2*1.73,6*1.50,6*1.22,6*1.0,     &
     &4*.76,2*.74,.52,.50,.483,.480,.463,.460/
!
!---------FIGURE  4.1.4.2-26B
!---------Y22B(6,6,6)  X322B=TAPER RATIO  X122B=A*(L.E.S.A.)
!---------X222B=LEADING EDGE SWEEP ANGLE(L.E.S.A.)
!
      DATA X322B /0.,.2,.25,.333,.5,1./
      DATA X122B /6.,5.,4.,3.,2.,1./
      DATA X222B /1.0,.80,.60,.40,.20,0.0/
      DATA Y22B /.78,.79,.805,.83,.87,.99,.68,.695,.71,.725,.76,        &
     &.83,.56,.57,.58,.595,.62,.66,.455,3*.46,.47,.5,6*.335,.225,.22,   &
     &.21,.2,.185,.17,.925,.94,.96,1.,1.05,1.15,.81,.82,.84,.87,.91,.97,&
     &.695,.7,.71,.73,.76,.8,.55,.555,.56,.57,.58,.6,.405,.402,4*.4,    &
     &.25,.245,.24,.23,.22,.2,.98,.99,1.01,1.05,1.1,1.25,.85,.86,.88,   &
     &.9,.95,1.03,.72,.73,.74,.76,.79,.82,.58,.59,.595,.6,.61,.63,4*.43,&
     &.42,.418,.27,.26,.255,.25,.24,.23,1.08,1.09,1.1,1.12,1.16,1.26,   &
     &.92,.93,.94,.96,1.,1.07,.77,.78,.79,.8,.83,.88,.618,.62,.63,.64,  &
     &.65,.67,5*.45,.44,.29,.28,.27,.26,.24,.22,1.23,1.23,1.24,1.26,    &
     &1.3,1.38,1.06,1.07,1.08,1.09,1.12,1.19,3*.9,.91,.94,.98,2*.71,    &
     &.715,.72,.73,.75,3*.52, .51,.505,.5,.32,.31,.305,.30,.28,.25,     &
     &4*1.72,1.7,1.66,4*1.48,1.46,1.42,4*1.24,1.22,1.2,4*1.,.98,        &
     &.94,.74,.723,.72,.72,.70,.66,.46,.44,.42,.40,.38,.32/
!
!---------FIGURE  4.1.4.3-21A
!--------- X211A= DELTA-Y       Y11A= (XCP/CR)(1)
!
      DATA X211A /.15,.30,.42,.50,.60,.80,1.0,1.2,1.4,1.6,1.8,2.0/
      DATA Y11A /.7,.62,.58,.56,.55,.56,.575,.59,.60,.61,.62,.625/
!
!---------FIGURE  4.1.4.3-21B
!
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
!--------- X211B= TAPER RATIO     Y11B= C3
!
      DATA Y11B  /0.,.45,.85,1.05,1.25,1.75,2.25/
      DATA X211B /0.,.20,.40,.50,.60,.80,1.0/
!
!---------FIGURE 4.1.4.3-22A
!--------- Y11C(4,16)    X111C= ASPECT RATIO    Y11A=(XCP/CR)2
!--------- X211C= ARGUMENT (C3+1)A TAN(L.E.S.A.)
!
      DATA X111C /1.,2.,4.,6./
      DATA X211C /0.,1.,2.,2.5,3.0,3.5,4.0,5.,6.,7.,8.,10.,12.,15.,17./
      DATA Y11C /-.17,-.153,-.13,-.112,-.07,0.,.046,.115,.171,.221,.268,&
     &.37,.48,.664,.81 , -.18,-.172,-.157,-.14,-.108,-.058,0.,.073,.14, &
     &.2,.257,.368,.48,.664,.81 , -.22,-.21,-.19,-.174,-.15,-.11,-.047, &
     &.056,.126,.187,.244,.356,.47,.653,.80 , -.24,-.228,-.21,-.195,    &
     &-.173,-.132,-.065,.04,.11,.173,.232,.338,.45,.632,.780 /
!
!---------FIGURE 4.1.4.3-22A
!--------- X112A= A TAN(L.E.S.A.)    X212A= TAPER RATIO
!--------- Y12A= STABILITY INDEX
!
      DATA X112A /0.,1.,2.,3.,4.,5.,6.,7.,8.,9.,10./
      DATA X212A /0.,.2,.4,.6,.8,1.0/
      DATA Y12A /5.,4.7,4.15,3.5,2.9,2.3 , 4.35,3.75,3.15,2.5,1.9,1.3 , &
     &3.35,2.7,2.15,1.5,.999,.43 , 2.3,1.7,1.1,.5,-.1,-.7 , 1.35,.7,.1, &
     &-.5,-1.1,-1.65 , .35,-.25,-.9,-1.5,-2.1,-2.7 , -.6,-1.2,-1.8,-2.45&
     &,-3.05,-3.65 , -1.65,-2.2,-2.85,-3.50,-4.1,-4.65 , -2.65,-3.25,   &
     &-3.85,-4.45,-5.0,-5.0 , -3.65,-4.3,-4.85,3*-5.0 , -4.60,5*-5.0 /
!
!---------FIGURE 4.1.4.3-23A
!---------X112B1= TAN(ALPHA)/TAN(ALPHA(CLMAX))   X212B1= STABILITY INDEX
!---------Y12B1= DEL(XCP/CR)(3)
!
      DATA X112B1 /.2,.3,.4,.6,.8,1./
      DATA X212B1 /4.,3.5,3.,2.5,2.,1.75,1.5,1.25,1.,.75,.5,.25,0.,-.25,&
     &-.5,-.75,-1.,-1.25,-1.5,-1.75,-2.,-2.5,-3.,-3.5,-4./
      DATA Y12B1 /0.,-.08,-.148,-.203,-.244,-.26,-.271,-.277,-.278,-.27,&
     &-.252,-.175,.025,.2,.305,.38,.418,.44,.449,.451,.44,.4,.347,.284, &
     &.20 , .07,0.,-.053,-.12,-.17,-.193,-.212,-.227,-.239,-.241,-.22,  &
     &-.16,.05,.35,.43,.452,.454,.438,.4,.325,.215,.038,-.056,-.115,    &
     &-.150 , .13,.062,-.003,-.064,-.118,-.14,-.16,-.178,-.19,-.193,    &
     &-.186,-.175,.04,.2,.27,.312,.328,.322,.275,.17,0.,-.2,-.303,-.376,&
     &-.430 ,.07,.058,.04,.012,-.018,-.035,-.052,-.067,-.08,-.088,-.089,&
     &-.067,-.014,.045,.095,.124,.132,.116,.073,0.,-.093,-.18,-.21,-.23,&
     &-.25 , .13,.08,.06,.045,.03,.0275,.025,.0225,.02,.0175,.015,.0125,&
     &.01,.0075,.005,.0025,.0,-.01,-.02,-.03,-.04,-.05,-.06,-.07,-.08,  &
     &25*0.0/
!
!---------FIGURE 4.1.4.3-23B
!--------- X112B2= TAN(ALPHA(CLMAX))/TAN(ALPHA)  X212B2= STABILITY INDEX
!--------- Y12B2= DEL(XCP/CR)(3)
!
      DATA X112B2 /.60,.80,1./
      DATA X212B2/ 4.0,3.5,3.0,2.75,2.50,2.25,2.0,1.5,1.0,.50,.25,0.0,  &
     &-.25,-.50,-1.0,-1.5,-2.0,-2.5,-3.0,-3.5,-4.0/
      DATA Y12B2 /-.12,-.2,-.27,-.285,-.29,-.287,-.268,-.178,-.072,0.,  &
     &.025,.04,.048,.05,.037,.011,-.01,-.02,-.03,-.039,-.04,-.085,-.11, &
     &-.13,2*-.135,-.13,-.12,-.09,-.052,-.01,.017,.04,.058,.068,.065,   &
     &.05,.03,.02,.029,.03,.02, 21*0./
!
!---------     FIGURE 4.1.4.3-24A
!----     X213A= TAPER RATIO       X113A= A COS(L.E.S.A)
!----     Y13A=  ASPECT RATIO INDEX
!
      DATA X213A /0.,.1,.15,.2,.25,.3,.4,.45,.5,.55,.6,.7,.8,.9,1.0/
      DATA X113A/.25,.5,1.,1.5,2.,3.,4.,5.,6./
      DATA Y13A /0.,.17,.235,.28,.297,.282,.242,.215,.21,.227,.262,.378,&
     &.56,.80,1.04 , .14,.24,.276,.3,.31,.298,.242,.215,.193,.193,.218, &
     &.287,.383,.50,.63 , .14,.24,.264,.28,.29,.277,.197,.132,.082,.045,&
     &.03,.02,.03,.063,.10 , 0.1,.2,.228,.24,.228,.2,.097,.022,-.05,    &
     &-.095,-.12,-.13,-.128,-.125,-.12 , 0.0,.14,.155,.154,.138,.105,   &
     &0.0,-.085,-.162,-.195,-.214,-.235,-.240,-.240,-.230 , -.10,-.022, &
     &-.002,0.0,-.02,-.058,-.195,-.257,-.30,-.336,-.362,-.388,2*-.40,   &
     &-.39 , -.24,-.20,-.19,-.198,-.223,-.26,-.355,-.392,-.418,-.442,   &
     &-.46,-.487,-.50,-.507,-.51 , -.38,-.37,-.382,-.397,-.417,-.436,   &
     &-.483,-.505,-.526,-.54,-.552,-.57,-.58,-.582,-.58 , -.50,-.513,   &
     &-.522,-.53,-.54,-.55,-.568,-.577,-.585,-.59,-.60,-.612,-.62,-.625,&
     &-.63 /
!
!---------     FIGURE 4.1.4.3-24B-1          ---------------------------
!----     X213B1= ASPECT RATIO INDEX    X113B1= TAN(ALPHA)/TAN(ALPHA)CL-
!----     Y13B1=  DEL(XCP/CR(4))
!
      DATA X213B1 /1.0,.8,.6,.4,.2,0.,-.2,-.4,-.6/
      DATA X113B1 /.2,.3,.4,.6,.8,1./
      DATA Y13B1 / 1.,.8,.6,.4,.2,0.,-.2,-.4,-.6 , .64,.482,.35,.23,.12,&
     &0.0,-.16,-.36,-.59 , .38,.26,.15,.07,.02,0.,-.1,-.23,-.42 , .12,  &
     &.048,0.0,-.032,-.035,-.030,-.12,-.31,-.56 , .05,-.02,-.05,-.06,   &
     &-.058,-.050,-.068,-.110,-.170, 9*0./
!
!---------     FIGURE 4.1.4.3-24B-2          ---------------------------
!----     X213B2= ASPECT RATIO INDEX    X113B2= TAN(ALPHA)CL-MAX/TAN(ALP
!----     Y13B2=  DEL(XCP/CR(4))
!
      DATA X213B2 /1.0,.8,.6,.4,.2,0.,-.2,-.4,-.6/
      DATA X113B2 /.6,.8,1./
      DATA Y13B2 / .3,.29,.29,.28,.26,.20,.23,.25,.28,  5*.14,.10,.11,  &
     &.13,.14,  9*0./
!
!
!*********     PAGE NO. 2-1
!
      C(1) = WINGIN(61)
      C(2)=WINGIN(67)
      A(170)=A(173)/A(10)
      C(48)=A(10)/CBARR
      CONST=.FALSE.
!
!-----IF WING IS CONSTANT SECTION,SET CONST EQUAL TO TRUE
!
      IF( ABS(C(1)).LT.1.E-10.OR.ABS(C(2)).LT.1.E-10) CONST=.TRUE.
      IF(.NOT.CONST) C(1)= 0.50*(C(1)+C(2))
      IF(.NOT.CONST) ATOVCA=0.50*(WINGIN(16)+WINGIN(65))
      IF(.NOT.CONST) GO TO 1000
      ATOVCA=WINGIN(16)
 1000 CONTINUE
      CALL TBFUNX(B(1), CALM, DYDX, 15, XCMOM, YCMOM, CCMOM,ICMOM,      &
     &            MI, NG, 0, 0, QCMOM, 3, ROUTID)
      CALM = A(3)*A(16)*CALM/(SREF*CBARR)
      C(5)=(A(7)*A(43)**2/(A(7)+2.0*A(43)))*C(1)*CALM
!
!     DETERMINE IF WING IS TWISTED
!
      IF(ABS(WINGIN(11)).LT.1.E-20) GO TO 1010
!
!     CALL TABLE LOOK-UP FOR CMO/THETA FROM MODIFIED FIG 4.1.4.1-5
!
      CALL TLIN3X(X11412,X21412,X31412,Y41412,5,22,3,A(7),A(40),        &
     &            A(27),C(4),2,2,0,2,2,0,Q41412,3,ROUTID)
!
!     COMPUTE CMOTH (FOR TWISTED WING)
!
      C(5)=C(5)+C(4)*WINGIN(11)*CALM
 1010 CONTINUE
      C(3)=CALM
      B(47)=C(5)
!
!*********     TEST FOR WING TYPE
!
      C(9)=A(7)*A(38)
      TYPE=WINGIN(15)
      IF(WINGIN(15).NE.WTYPE(1)) GO TO 1030
!
!*********     PAGE NUMBER 2-2                    **********************
!+++++++++     STRAIGHT TAPERED OR CONVENTIONAL   ++++++++++++++++++++++
!
      IF(A(38) .EQ. 0.) A(38)=0.0001
      C(10)=A(38)/B(2)
      C(11)=B(2)/A(38)
      IF(A(7) .GT. A(125)) GO TO 1025
!
! ***** IF WING HAS FORWARD SWEEP, GO TO SUBROUTINE FWDXAC
!
      IF (A(38) .LT. 0.0) GO TO 1075
!
!--------- IF C(10).GE.1.0 USE FIG. 4.1.4.2-26B
!
      IF(C(10).GE.1.0) GO TO 1020
!
!---------     FIGURE 4.1.4.2-26A       --------------------------------
!
      CALL TLIN3X(X122A,X222A,X322A,Y22A,6,6,6,C(9),C(10),A(27),C(6),   &
     &            2,0,0,2,0,0,Q4222A,3,ROUTID)
      GO TO 1080
!
!---------     FIGURE 4.1.4.2-26B       --------------------------------
!
 1020 CALL TLIN3X(X122B,X222B,X322B,Y22B,6,6,6,C(9),C(11),A(27),C(6),   &
     &            2,0,0,2,0,0,Q4222B,3,ROUTID)
      GO TO 1080
!
!***  COMPUTE XAC/CR AT QUARTER CHORD OF MAC OR
!***  USE INPUT SECTION AC ON MAC
!
 1025 CONTINUE
      C(6)=(A(30)-0.25*A(16))/A(10)
      IF(WINGIN(I+71) .NE. UNUSED) C(6)=C(6)+A(16)*                     &
     &                                  (WINGIN(I+71)-0.25)/A(10)
      GO TO 1080
!
!*********     PAGE NUMBER 2-3                    **********************
!+++++++++     DOUBLE-DELTA,CRANKED,OR CURVED     ++++++++++++++++++++++
!
 1030 CONTINUE
      IF(A(62).EQ.0.0) A(62)=1.0E-15
      C(12)=A(5)*A(62)
      C(13)=A(62)/B(2)
      C(14)=1.0/C(13)
      C(15)= A(168)*A(86)
      C(16)=A(86)/B(2)
      C(17)= 1.0/C(16)
!
! ***** IF INBOARD PANEL HAS FORWARD SWEEP, GO TO SUBROUTINE FWDXAC
!
      IF (A(62) .LT. 0.0) GO TO 1045
!
!*     IF C(13).GE.1.0, USE FIGURE 4.1.4.2-26B (INBOARD DATA)
!
      IF(C(13).GE.1.0) GO TO 1040
!
!---------     FIGURE 4.1.4.2-26A       --------------------------------
!
      CALL TLIN3X(X122A,X222A,X322A,Y22A,6,6,6,C(12),C(13),A(26),C(18), &
     &            2,0,0,2,0,0,Q4222A,3,ROUTID)
      GO TO 1050
!
!---------     FIGURE 4.1.4.2-26B       --------------------------------
!
 1040 CALL TLIN3X(X122B,X222B,X322B,Y22B,6,6,6,C(12),C(14),A(26),C(18), &
     &            2,0,0,2,0,0,Q4222B,3,ROUTID)
      GO TO 1050
 1045 CALL FWDXAC (C(12),A(26),C(13),B(1),ROUTID,C(18))
!
! ***** IF OUTBOARD PANEL HAS FORWARD SWEEP, GO TO SUBROUTINE FWDXAC
!
      IF (A(86) .LT. 0.0) GO TO 1065
!
!**** IF C(16).GE.1.0 USE FIGURE 4.1.4.2-26B (OUTBOARD DATA)
!
 1050 IF(C(16).GE.1.0) GO TO 1060
!
!---------     FIGURE 4.1.4.2-26A
!
      CALL TLIN3X(X122A,X222A,X322A,Y22A,6,6,6,C(15),C(16),A(169),C(19),&
     &            2,0,0,2,0,0,Q4222A,3,ROUTID)
      GO TO 1070
!
!---------     FIGURE 4.1.4.2-26B
!
 1060 CALL TLIN3X(X122B,X222B,X322B,Y22B,6,6,6,C(15),C(17),A(169),C(19),&
     &            2,0,0,2,0,0,Q4222B,3,ROUTID)
      GO TO 1070
 1065 CALL FWDXAC (C(15),A(169),C(16),B(1),ROUTID,C(19))
 1070 C(20)= C(19)*A(166)/A(10)-A(164)*A(86)/A(10)+A(23)*A(62)/A(10)
      ANUM= A(171)*A(1)*C(18)+A(172)*A(167)*C(20)
      ADEN= A(171)*A(1)+A(172)*A(167)
      C(6)=ANUM/ADEN
      GO TO 1080
 1075 CALL FWDXAC (C(9),A(27),C(10),B(1),ROUTID,C(6))
!
!*********     COMPUTE DCM/DCL AND CMALPHA
!
 1080 C(7)= (A(170)-C(6))*(A(10)/CBARR)
      C(8)=C(7)*WING(101)
      WING(121)=C(8)
!
!*********     DETERMINE ASPECT RATIO             **********************
!
 1090 IF(A(7).GT.(6./A(124)))GO TO 1270
!
!*********     PAGE NO. 2-5 DATA
!
 1110 CONTINUE
      IF(A(34) .LT. 0.0)GO TO 1270
      C(21)=A(7)*(1.+A(27))*A(38)/4.0
      C(22)=(A(27)+C(21)+((1.+C(21)*A(27))/(1.+A(27))))/3.0
      IF(A(7) .GE. 6./A(124) .OR. WINGIN(15) .EQ. WTYPE(1))             &
     &  GO TO 1115
      YBSI=A(23)*(1.+2.*A(26))/(3.*(1.+A(26)))
      XBLE=(YBSI*A(1)*A(62)+(A(23)*A(62)+(A(133)-A(21))*A(86))*A(2))    &
     &      /A(3)
      C(22)=(XBLE+A(16)/2.0)/A(10)
 1115 CONTINUE
!
!---------     FIGURE 4.1.4.3-21B
!
      CALL TBFUNX(A(27),C(23),DYDX,7,X211B,Y11B,CC11B,IN11B,MI,NG,      &
     &            0,0,Q4311B,3,ROUTID)
      C(24)=(C(23)+1.0)*C(9)
!
!---------     FIGURE 4.1.4.3-22A
!
      CALL TLINEX(X111C,X211C,Y11C,4,15,A(7),C(24),C(25),               &
     &            2,0,2,1,Q4311C,3,ROUTID)
!
!---------     FIGURE 4.1.4.3-21A
!
      CALL TBFUNX(WINGIN(17),C(26),DYDX,12,X211A,Y11A,CC11A,IN11A,MI,NG,&
     &            2,2,Q4311A,3,ROUTID)
      C(27)=C(25)+C(26)
!
!*********     COMPUTE (XCP/CR)REF, C(30)
!
      C(28)=SIN(B(43)/RAD)
      C(29)=TAN(B(43)/RAD)
      C(30)=C(27)/C(28)-C(6)/C(29)
      DO 1260 M=1,NALPHA
         C(31)=SIN(B(M+22)/RAD)
         C(32)=COS(B(M+22)/RAD)
         C(33)=C(31)/C(32)
         C(34)=A(7)*A(37)
         C(35)=ABS(C(33)/C(29))
         TANRAT = .FALSE.
!
!     ----TEST FOR TAN(ALPHA) .GT. TAN(ALPHA CLMAX)
!
         IF(C(33).GT.C(29)) TANRAT = .TRUE.
!
!***** TO COMPUTE (ALPHA) REF AND RELATED DATA ON FIRST PASS ONLY
!
         IF(M.GT.1) GO TO 1150
         C(36)=ATAN(TAN(B(43)/RAD)/0.6)
         TEMP2=C(29)/TAN(C(36))
         C(47)= TEMP2
!
!---------     FIGURE 4.1.4.3-22B
!
         CALL TLINEX(X112A,X212A,Y12A,11,6,C(9),A(27),C(40),            &
     &               1,0,1,0,Q4312A,3,ROUTID)
!
!---------     FIGURE 4.1.4.3-24A
!
         CALL TLINEX(X113A,X213A,Y13A,9,15,C(34),A(27),C(37),           &
     &               0,0,2,0,Q4313A,3,ROUTID)
!
!---------     FIGURE 4.1.4.3-24B2
!
 1120    CALL TLINEX(X113B2,X213B2,Y13B2,3,9,TEMP2,C(37),C(51),         &
     &               2,0,2,0,Q313B2,4,ROUTID)
!
!---------     FIGURE 4.1.4.3-23B
!
 1130    CALL TLINEX(X112B2,X212B2,Y12B2,3,21,TEMP2,C(40),C(50),        &
     &               2,0,2,0,Q312B2,4,ROUTID)
 1140    C(49)=C(6)*COS(C(36))+SIN(C(36))*(C(30)+C(51)+C(50))
!
!*********     IF ALPHA .GE. ALPHA(REF) GO TO PAGE 2-7
!
 1150    IF( B(M+22)/RAD.GT.C(36) ) GO TO 1220
!
!*********     PAGE NO. 2-6                       **********************
!
      IF(TANRAT) GO TO 1170
!
!---------     FIGURE 4.1.4.3-24B-1
!
 1160    CALL TLINEX(X113B1,X213B1,Y13B1,6,9,C(35),C(37),C(38),         &
     &               2,0,2,0,Q313B1,4,ROUTID)
         GO TO 1180
!
!---------     FIGURE 4.1.4.3-24B-2          ---------------------------
!
 1170    C(46) = C(29)/C(33)
         CALL TLINEX(X113B2,X213B2,Y13B2,3,9,C(46),C(37),C(38),         &
     &               2,0,2,0,Q313B2,4,ROUTID)
 1180    IF(TANRAT) GO TO 1200
!
!---------     FIGURE 4.1.4.3-23A
!
 1190    CALL TLINEX(X112B1,X212B1,Y12B1,6,25,C(35),C(40),C(39),        &
     &               2,0,2,0,Q312B1,4,ROUTID)
         GO TO 1210
!
!---------     FIGURE 4.1.4.3-23B            ---------------------------
!
 1200    CALL TLINEX(X112B2,X212B2,Y12B2,3,21,C(46),C(40),C(39),        &
     &               2,0,2,0,Q312B2,4,ROUTID)
!
!---------     COMPUTE C(44) AND C(45) FOR PAGE 2-6    -----------------
!
 1210    C(44)=C(6)*C(32)+(C(30)+C(39)+C(38))*C(31)
         WING(M+40)=WING(M+60)*(A(173)/A(10)-C(44))*C(48)+C(5)
         GO TO 1250
!
!*********     PAGE 2-7                      ***************************
!
 1220    C(41)=C(22)-C(49)
         C(42)=PI/2.-C(36)
         C(43)=C(41)/C(42)
!
!*********     COMPUTE CM(ALPHA)J
!
         C(44)=C(49)+C(43)*(B(M+22)/RAD-C(36))
 1230    WING(M+40)= WING(M+60)*(A(170)-C(44))*(A(10)/CBARR)+C(5)
 1250    CONTINUE
 1260 END DO
!
      RETURN
!
 1270 DO 1280 N=1,NALPHA
 1280 WING(N+40)=WING(N+60)*C(7)+C(5)
!
      RETURN
      END
      SUBROUTINE CMALPO(A,B,WINGIN,DYN)
!
!***  COMPUTES LIFTING SURFACE CMA AT MACH=0
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      DIMENSION ROUTID(2)
      DIMENSION Q41412(3),Q4222A(3),Q4222B(3)
      LOGICAL CONST
      DIMENSION C(51),A(195),B(49),WINGIN(101),DYN(213)
      DIMENSION X21412(22),X11412(5),X31412(3),Y41412(330)
      DIMENSION Y415A(110),Y415B(110),Y415C(110)
      DIMENSION XCMOM(15), YCMOM(15), CCMOM(6), QCMOM(3)
      DIMENSION X322A(6),X222A(6),X122A(6),Y22A(216)
      DIMENSION X322B(6),X222B(6),X122B(6),Y22B(216)
      DIMENSION WTYPE(4)
      DIMENSION X211B(7),Y11B(7)
      EQUIVALENCE (Y41412(1),Y415A(1)),(Y41412(111),Y415B(1))
      EQUIVALENCE (Y41412(221),Y415C(1))
      DATA ROUTID/4HCMAL,4HPO  /
      DATA Q41412/4H4.1.,4H4.1-,4H5   /,Q4222A/4H4.1.,4H4.2-,4H26A /,   &
     &     Q4222B/4H4.1.,4H4.2-,4H26B /,                                &
     &     QCMOM  /4H4.1.,4H4.1-,4H6    /
!
!---------    FIGURE 4.1.4.1-6
!
      DATA ICMOM / 0 /
      DATA XCMOM / 0., .25, .30, .35, .40, .45, .50, .55, .60, .65,     &
     &            .70, .75, .80, .85, .90 /
      DATA YCMOM / 1.000, 1.000, 1.005, 1.017, 1.031, 1.050, 1.072,     &
     &             1.101, 1.132, 1.162, 1.197, 1.237, 1.287, 1.355,     &
     &             1.445 /
!
!---------    FIGURE 4.1.4.1-5
!     ----Y41412(16,5,3) , X31412=TAPER RATIO  X11416= ASPECT RATIO
!     ----X21412=QUARTER CHORD SWEEP ANGLE
!
      DATA X31412 /0.,.5,1./
      DATA X11412 /10.,8.,6.,3.5,1.5/
      DATA X21412 /-45.,-40.,-35.,-30.,-25.,-20.,-15.,-10.,-5.,         &
     &             0.,5.,10.,15.,20.,25.,30.,35.,40.,45.,50.,           &
     &             55.,60./
      DATA Y415A /                                                      &
     &  .0116,  .0100,  .0085,  .0072,  .0060,  .0048,  .0036,  .0024,  &
     &  .0012,  .0000, -.0012, -.0024, -.0037, -.0050, -.0063, -.0076,  &
     & -.0090, -.0104, -.0118, -.0131, -.0145, -.0159,                  &
     &  .0081,  .0070,  .0061,  .0051,  .0042,  .0034,  .0025,  .0017,  &
     &  .0008,  .0000, -.0009, -.0017, -.0026, -.0035, -.0045, -.0055,  &
     & -.0065, -.0076, -.0086, -.0097, -.0108, -.0119,                  &
     &  .0052,  .0045,  .0039,  .0033,  .0027,  .0022,  .0016,  .0011,  &
     &  .0005,  .0000, -.0005, -.0011, -.0017, -.0023, -.0029, -.0035,  &
     & -.0042, -.0049, -.0057, -.0063, -.0070, -.0078,                  &
     &  .0022,  .0019,  .0016,  .0014,  .0011,  .0009,  .0007,  .0004,  &
     &  .0002,  .0000, -.0002, -.0004, -.0007, -.0009, -.0012, -.0014,  &
     & -.0017, -.0021, -.0024, -.0027, -.0032, -.0036,                  &
     &  .0005,  .0004,  .0004,  .0003,  .0002,  .0002,  .0001,  .0001,  &
     &  .0000,  .0000, -.0000, -.0001, -.0001, -.0002, -.0002, -.0003,  &
     & -.0004, -.0004, -.0005, -.0006, -.0007, -.0008/
      DATA Y415B /                                                      &
     &  .0204,  .0177,  .0152,  .0128,  .0105,  .0083,  .0061,  .0041,  &
     &  .0020,  .0000, -.0020, -.0040, -.0060, -.0080, -.0100, -.0121,  &
     & -.0141, -.0162, -.0182, -.0208, -.0232, -.0257,                  &
     &  .0144,  .0125,  .0107,  .0090,  .0073,  .0058,  .0043,  .0028,  &
     &  .0014,  .0000, -.0014, -.0028, -.0042, -.0056, -.0071, -.0086,  &
     & -.0102, -.0117, -.0133, -.0153, -.0172, -.0193,                  &
     &  .0091,  .0078,  .0066,  .0055,  .0045,  .0035,  .0026,  .0017,  &
     &  .0009,  .0000, -.0009, -.0017, -.0026, -.0035, -.0044, -.0054,  &
     & -.0064, -.0075, -.0087, -.0099, -.0113, -.0128,                  &
     &  .0036,  .0030,  .0026,  .0021,  .0017,  .0013,  .0010,  .0007,  &
     &  .0003,  .0000, -.0003, -.0007, -.0010, -.0013, -.0017, -.0021,  &
     & -.0025, -.0030, -.0036, -.0043, -.0050, -.0058,                  &
     &  .0007,  .0006,  .0005,  .0004,  .0003,  .0003,  .0002,  .0001,  &
     &  .0001,  .0000, -.0001, -.0001, -.0002, -.0003, -.0003, -.0004,  &
     & -.0005, -.0006, -.0007, -.0008, -.0009, -.0010/
      DATA Y415C /                                                      &
     &  .0218,  .0189,  .0162,  .0135,  .0111,  .0087,  .0064,  .0042,  &
     &  .0021,  .0000, -.0020, -.0041, -.0061, -.0081, -.0101, -.0121,  &
     & -.0141, -.0162, -.0182, -.0202, -.0222, -.0243,                  &
     &  .0154,  .0133,  .0113,  .0095,  .0077,  .0060,  .0044,  .0029,  &
     &  .0014,  .0000, -.0014, -.0028, -.0043, -.0057, -.0072, -.0087,  &
     & -.0102, -.0117, -.0133, -.0148, -.0163, -.0179,                  &
     &  .0097,  .0083,  .0070,  .0058,  .0047,  .0037,  .0027,  .0018,  &
     &  .0009,  .0000, -.0009, -.0018, -.0027, -.0036, -.0045, -.0055,  &
     & -.0065, -.0075, -.0086, -.0098, -.0108, -.0119,                  &
     &  .0038,  .0032,  .0027,  .0022,  .0018,  .0014,  .0010,  .0007,  &
     &  .0003,  .0000, -.0003, -.0007, -.0010, -.0014, -.0018, -.0022,  &
     & -.0026, -.0031, -.0036, -.0043, -.0050, -.0057,                  &
     &  .0008,  .0006,  .0005,  .0004,  .0003,  .0003,  .0002,  .0001,  &
     &  .0001,  .0000, -.0001, -.0001, -.0002, -.0003, -.0003, -.0004,  &
     & -.0005, -.0006, -.0007, -.0008, -.0009, -.0010/
!
!---------FIGURE  4.1.4.2-26A
!---------Y22A(6,6,6)  X322A=TAPER RATIO  X122A=A*(L.E.S.A)
!---------X222A=LEADING EDGE SWEEP ANGLE(L.E.S.A)
!
      DATA X322A /0.,.2,.25,.333,.5,1./
      DATA X122A /6.,5.,4.,3.,2.,1./
      DATA X222A /0.,.20,.40,.60,.80,1.0/
      DATA Y22A  /.68,.7,.72,.74,.76,.78,.58,.6,.62,.64,.66,.68,.51,.52,&
     &.53,.54,.55,.56,.42,.425,.435,.44,.445,.445,6*.335,.25,.245,.24,  &
     &.235,.230,.225,.87,.88,.89,.905,.915,.925,.75,.76,.775,.785,.8,   &
     &.81,.64,.65,.66,.675,.685,.695,.52,.525,.535,.54,.5425,.55,.4,    &
     &5*.405,.28,.275,.265,.26,.255,.25,.93,.94,.95,.96,.97,.98,.8,.81, &
     &.82,.83,.84,.85,.67,.68,.69,.70,.71,.72,.54,.55,.56,.57,.575,.58, &
     &2*.41,2*.42,.428,.43,.3,.29,2*.28,.275,.27,2*1.04,2*1.05,1.06,    &
     &1.08,2*.89,.90,2*.91,.92,.73,.74,.75,.758,.76,.77,.59,3*.6,.61,   &
     &.618,4*.46,2*.45,.32,.318,.31,.308,.30,.29,3*1.2,1.21,1.22,1.23,  &
     &2*1.04,2*1.05,2*1.06,3*.88,.882,.89,.90,5*.70,.705,2*.53,4*.52,   &
     &.36,.35,.34,.335,.33,.32 , 4*1.74,2*1.73,6*1.50,6*1.22,6*1.0,     &
     &4*.76,2*.74,.52,.50,.483,.480,.463,.460/
!
!---------FIGURE  4.1.4.2-26B
!---------Y22B(6,6,6)  X322B=TAPER RATIO  X122B=A*(L.E.S.A.)
!---------X222B=LEADING EDGE SWEEP ANGLE(L.E.S.A.)
!
      DATA X322B /0.,.2,.25,.333,.5,1./
      DATA X122B /6.,5.,4.,3.,2.,1./
      DATA X222B /1.0,.80,.60,.40,.20,0.0/
      DATA Y22B /.78,.79,.805,.83,.87,.99,.68,.695,.71,.725,.76,        &
     &.83,.56,.57,.58,.595,.62,.66,.455,3*.46,.47,.5,6*.335,.225,.22,   &
     &.21,.2,.185,.17,.925,.94,.96,1.,1.05,1.15,.81,.82,.84,.87,.91,.97,&
     &.695,.7,.71,.73,.76,.8,.55,.555,.56,.57,.58,.6,.405,.402,4*.4,    &
     &.25,.245,.24,.23,.22,.2,.98,.99,1.01,1.05,1.1,1.25,.85,.86,.88,   &
     &.9,.95,1.03,.72,.73,.74,.76,.79,.82,.58,.59,.595,.6,.61,.63,4*.43,&
     &.42,.418,.27,.26,.255,.25,.24,.23,1.08,1.09,1.1,1.12,1.16,1.26,   &
     &.92,.93,.94,.96,1.,1.07,.77,.78,.79,.8,.83,.88,.618,.62,.63,.64,  &
     &.65,.67,5*.45,.44,.29,.28,.27,.26,.24,.22,1.23,1.23,1.24,1.26,    &
     &1.3,1.38,1.06,1.07,1.08,1.09,1.12,1.19,3*.9,.91,.94,.98,2*.71,    &
     &.715,.72,.73,.75,3*.52, .51,.505,.5,.32,.31,.305,.30,.28,.25,     &
     &4*1.72,1.7,1.66,4*1.48,1.46,1.42,4*1.24,1.22,1.2,4*1.,.98,        &
     &.94,.74,.723,.72,.72,.70,.66,.46,.44,.42,.40,.38,.32/
      DATA WTYPE /4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
      C(1) = WINGIN(61)
      C(2)=WINGIN(67)
      BETA=1.0
      ZMACH=0.0
      A170=A(173)/A(10)
      C(48)=WINGIN(6)/CBARR
      CONST=.FALSE.
!
!-----IF WING IS CONSTANT SECTION,SET CONST EQUAL TO TRUE
!
      IF( ABS(C(1)).LT.1.E-10.OR.ABS(C(2)).LT.1.E-10) CONST=.TRUE.
      IF(.NOT.CONST) C(1)= 0.50*(C(1)+C(2))
      IF(.NOT.CONST) ATOVCA=0.50*(WINGIN(16)+WINGIN(65))
      IF(.NOT.CONST) GO TO 1000
      ATOVCA=WINGIN(16)
 1000 CONTINUE
      CALL TBFUNX(B(1), CALM, DYDX, 15, XCMOM, YCMOM, CCMOM,ICMOM,      &
     &            MI, NG, 0, 0, QCMOM, 3, ROUTID)
      CALM = A(3)*A(16)*CALM/(SREF*CBARR)
      C(5)=(A(7)*A(43)**2/(A(7)+2.0*A(43)))*C(1)*CALM
!
!     DETERMINE IF WING IS TWISTED
!
      IF(ABS(WINGIN(11)).LT.1.E-20) GO TO 1010
!
!     CALL TABLE LOOK-UP FOR CMO/THETA FROM MODIFIED FIG 4.1.4.1-5
!
      CALL TLIN3X(X11412,X21412,X31412,Y41412,5,22,3,A(7),A(40),        &
     &            A(27),C(4),2,2,0,2,2,0,Q41412,3,ROUTID)
!
!     COMPUTE CMOTH (FOR TWISTED WING)
!
      C(5)=C(5)+C(4)*WINGIN(11)*CALM
 1010 CONTINUE
      B47=C(5)
!
!*********     TEST FOR WING TYPE                 **********************
!
      C(9)=A(7)*A(38)
      TYPE=WINGIN(15)
      IF(WINGIN(15).NE.WTYPE(1)) GO TO 1040
!
!*********     PAGE NUMBER 2-2                    **********************
!+++++++++     STRAIGHT TAPERED OR CONVENTIONAL   ++++++++++++++++++++++
!
      C(10)=A(38)/BETA
      C(11)=BETA/A(38)
      IF(A(7) .GT. A(125)) GO TO 1030
!
! ***** IF WING HAS FORWARD SWEEP, GO TO SUBROUTINE FWDXAC
!
      IF (A(38) .LT. 0.0) GO TO 1110
!
!--------- IF C(10).GE.1.0 USE FIG. 4.1.4.2-26B
!
      IF(C(10).GE.1.0) GO TO 1020
!
!---------     FIGURE 4.1.4.2-26A
!
      CALL TLIN3X(X122A,X222A,X322A,Y22A,6,6,6,C(9),C(10),A(27),C(6),   &
     &            2,0,0,2,0,0,Q4222A,3,ROUTID)
      GO TO 1120
!
!---------     FIGURE 4.1.4.2-26B
!
 1020 CALL TLIN3X(X122B,X222B,X322B,Y22B,6,6,6,C(9),C(11),A(27),C(6),   &
     &            2,0,0,2,0,0,Q4222B,3,ROUTID)
      GO TO 1120
!
!***  COMPUTE XAC/CR AT QUARTER CHORD OF MAC
!
 1030 CONTINUE
      C(6)=(A(161)-(WINGIN(4)-WINGIN(3))*A(62))/A(10)
      GO TO 1120
!
!*********     PAGE NUMBER 2-3                    **********************
!+++++++++     DOUBLE-DELTA,CRANKED,OR CURVED     ++++++++++++++++++++++
!
 1040 CONTINUE
      IF(A(62).EQ.0.0) A(62)=1.0E-15
      C(12)=A(5)*A(62)
      C(13)=A(62)/BETA
      C(14)=1.0/C(13)
      C(15)= A(168)*A(86)
      C(16)=A(86)/BETA
      C(17)= 1.0/C(16)
!
! ***** IF INBOARD PANEL HAS FORWARD SWEEP, GO TO SUBROUTINE FWDXAC
!
      IF (A(62) .LT. 0.0) GO TO 1060
!
!*********     IF C(13).GE.1.0, USE FIGURE 4.1.4.2-26B (INBOARD DATA)
!
      IF(C(13).GE.1.0) GO TO 1050
!
!---------     FIGURE 4.1.4.2-26A
!
      CALL TLIN3X(X122A,X222A,X322A,Y22A,6,6,6,C(12),C(13),A(26),C(18), &
     &            2,0,0,2,0,0,Q4222A,3,ROUTID)
      GO TO 1070
!
!---------     FIGURE 4.1.4.2-26B       --------------------------------
!
 1050 CALL TLIN3X(X122B,X222B,X322B,Y22B,6,6,6,C(12),C(14),A(26),C(18), &
     &            2,0,0,2,0,0,Q4222B,3,ROUTID)
      GO TO 1070
 1060 CALL FWDXAC (C(12),A(26),C(13),B(1),ROUTID,C(18))
!
! ***** IF OUTBOARD PANEL HAS FORWARD SWEEP, GO TO SUBROUTINE FWDXAC
!
      IF (A(86) .LT. 0.0) GO TO 1090
!
!*********     IF C(16).GE.1.0 USE FIGURE 4.1.4.2-26B (OUTBOARD DATA)
!
 1070 IF(C(16).GE.1.0) GO TO 1080
!
!---------     FIGURE 4.1.4.2-26A
!
      CALL TLIN3X(X122A,X222A,X322A,Y22A,6,6,6,C(15),C(16),A(169),C(19),&
     &            2,0,0,2,0,0,Q4222A,3,ROUTID)
      GO TO 1100
!
!---------     FIGURE 4.1.4.2-26B
!
 1080 CALL TLIN3X(X122B,X222B,X322B,Y22B,6,6,6,C(15),C(17),A(169),C(19),&
     &            2,0,0,2,0,0,Q4222B,3,ROUTID)
      GO TO 1100
 1090 CALL FWDXAC (C(15),A(169),C(16),B(1),ROUTID,C(19))
 1100 C(20)= C(19)*A(166)/A(10)-A(164)*A(86)/A(10)+A(23)*A(62)/A(10)
      TEMP1=2.*PI*A(168)*DEG
      TEMP2=ABS(1.-FLC(3)**2)*(TEMP1/WINGIN(21))**2
      TEMP3=A(98)**2
      A172=TEMP1/(2.+SQRT(TEMP2*(1.+TEMP3)+4.))
      TEMP1=2.*PI*A(5)*DEG
      TEMP2=ABS(1.-FLC(3)**2)*(TEMP1/WINGIN(21))**2
      TEMP3=A(74)**2
      A171=TEMP1/(2.+SQRT(TEMP2*(1.+TEMP3)+4.))
      ANUM=A171*A(1)*C(18)+A172*A(167)*C(20)
      ADEN=A171*A(1)+A172*A(167)
      C(6)=ANUM/ADEN
      GO TO 1120
 1110 CALL FWDXAC (C(9),A(27),C(10),B(1),ROUTID,C(6))
 1120 DCMDCL=(A170-C(6))*(A(10)/CBARR)
      DYN(21)=DCMDCL
      RETURN
      END
      SUBROUTINE CNCA
!
!***  CALCULATES CN AND CA
!
      COMMON /IBODY/  PBOD, BODY(400)
      COMMON /IWING/  PWNG, WING(400)
      COMMON /IHT/    PHT,  HT(380)
      COMMON /IBW/    PBW,  BW(380)
      COMMON /IBH/    PBH,  BH(380)
      COMMON /IBV/    PBV,  BV(380)
      COMMON /IBWH/   PBWH, BWH(380)
      COMMON /IBWV/   PBWV, BWV(380)
      COMMON /IBWHV/  PBWT, BWT(380)
      COMMON /FLGTCD/ FLC(22),ALP(20), dumflgtcd(118)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,I,NA
      DIMENSION C(6),ROUTID(2)
      LOGICAL FLAG
      DATA ROUTID /4HCNCA, 4H    /
!
      DO 1000 J=1,NA
         SA = SIN(ALP(J)/RAD)
         CA = COS(ALP(J)/RAD)
!
         FLAG = ABS(BODY(J+20)) .NE. UNUSED
         IN = 0
         IF(FLAG .AND. J .GE. 2) CALL TBFUNX(ALP(J),Y,BODY(J+100),NA,   &
     &       ALP,BODY(21),C,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         FLAG = FLAG .AND. ABS(BODY(J)) .NE. UNUSED
         IF(FLAG) BODY(J+60) = BODY(J+20)*CA+BODY(J)*SA
         IF(FLAG) BODY(J+80) = BODY(J)*CA-BODY(J+20)*SA
!
         FLAG = ABS(WING(J+40)) .NE. UNUSED .AND.                       &
     &          ABS(WING(42  )) .NE. UNUSED
         IN = 0
         IF(FLAG) CALL TBFUNX(ALP(J),Y,WING(J+120),NA,ALP,WING(41),C,IN,&
     &         MI,NG,0,0,4HCMA ,1,ROUTID)
         FLAG = ABS(WING(J+20)) .NE. UNUSED
         IN = 0
         IF(FLAG .AND. J .GE. 2) CALL TBFUNX(ALP(J),Y,WING(J+100),NA,   &
     &      ALP,WING(21),C,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
!
         FLAG = FLAG .AND. ABS(WING(J)) .NE. UNUSED
         IF(FLAG) WING(J+60) = WING(J+20)*CA+WING(J)*SA
         IF(FLAG) WING(J+80) = WING(J)*CA-WING(J+20)*SA
!
         FLAG = ABS(HT(J+20)) .NE. UNUSED
         IN = 0
         IF(FLAG .AND. J .GE. 2) CALL TBFUNX(ALP(J),Y,HT(J+100),NA,ALP, &
     &      HT(21),C,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         FLAG = FLAG .AND. ABS(HT(J)) .NE. UNUSED
         IF(FLAG) HT(J+60) = HT(J+20)*CA+HT(J)*SA
         IF(FLAG) HT(J+80) = HT(J)*CA-HT(J+20)*SA
!
         FLAG = ABS(BW(J+20)) .NE. UNUSED
         IN = 0
         IF(FLAG .AND. J .GE. 2) CALL TBFUNX(ALP(J),Y,BW(J+100),NA,ALP, &
     &      BW(21),C,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         FLAG = FLAG .AND. ABS(BW(J)) .NE. UNUSED
         IF(FLAG) BW(J+60) = BW(J+20)*CA+BW(J)*SA
         IF(FLAG) BW(J+80) = BW(J)*CA-BW(J+20)*SA
!
         FLAG = ABS(BH(J+20)) .NE. UNUSED
         IN = 0
         IF(FLAG .AND. J .GE. 2) CALL TBFUNX(ALP(J),Y,BH(J+100),NA,ALP, &
     &      BH(21),C,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         FLAG = FLAG .AND. ABS(BH(J)) .NE. UNUSED
         IF(FLAG) BH(J+60) = BH(J+20)*CA+BH(J)*SA
         IF(FLAG) BH(J+80) = BH(J)*CA-BH(J+20)*SA
!
         FLAG = ABS(BV(J+20)) .NE. UNUSED
         IN = 0
         IF(FLAG .AND. J .GE. 2) CALL TBFUNX(ALP(J),Y,BV(J+100),NA,ALP, &
     &      BV(21),C,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         FLAG = FLAG .AND. ABS(BV(J)) .NE. UNUSED
         IF(FLAG) BV(J+60) = BV(J+20)*CA+BV(J)*SA
         IF(FLAG) BV(J+80) = BV(J)*CA-BV(J+20)*SA
!
         FLAG = ABS(BWH(J+20)) .NE. UNUSED
         IN = 0
         IF(FLAG .AND. J .GE. 2) CALL TBFUNX(ALP(J),Y,BWH(J+100),NA,ALP,&
     &      BWH(21),C,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         FLAG = FLAG .AND. ABS(BWH(J)) .NE. UNUSED
         IF(FLAG) BWH(J+60) = BWH(J+20)*CA+BWH(J)*SA
         IF(FLAG) BWH(J+80) = BWH(J)*CA-BWH(J+20)*SA
!
         FLAG = ABS(BWV(J+20)) .NE. UNUSED
         IN = 0
         IF(FLAG .AND. J .GE. 2) CALL TBFUNX(ALP(J),Y,BWV(J+100),NA,ALP,&
     &      BWV(21),C,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         FLAG = FLAG .AND. ABS(BWV(J)) .NE. UNUSED
         IF(FLAG) BWV(J+60) = BWV(J+20)*CA+BWV(J)*SA
         IF(FLAG) BWV(J+80) = BWV(J)*CA-BWV(J+20)*SA
!
         FLAG = ABS(BWT(J+20)) .NE. UNUSED
         IN = 0
         IF(FLAG .AND. J .GE. 2) CALL TBFUNX(ALP(J),Y,BWT(J+100),NA,ALP,&
     &      BWT(21),C,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         FLAG = FLAG .AND. ABS(BWT(J)) .NE. UNUSED
         IF(FLAG) BWT(J+60) = BWT(J+20)*CA+BWT(J)*SA
         IF(FLAG) BWT(J+80) = BWT(J)*CA-BWT(J+20)*SA
 1000 END DO
      RETURN
      END

      SUBROUTINE CONERR
!
!***  EXECUTIVE FOR INPUT ERROR DIAGNOSTICS
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      DIMENSION KOL(80), NUM(10)
      DIMENSION NLNAME(138), LOC(24), LEN(24)
      LOGICAL NMTEST
!
      DATA NNAME / 24 /, IBLANK / 4H     /
      DATA NUM /4H0   ,4H1   ,4H2   ,4H3   ,4H4   ,4H5   ,4H6   ,       &
     &          4H7   ,4H8   ,4H9   /
      DATA LOC /1,4,10,16,20,26,32,38,44,50,56,62,68,74,79,85,91,97,    &
     &          103,109,115,121,127,133/
      DATA LEN /3,2*6,4,9*6,5,2*6,4,7*6/
      DATA NLNAME /                                                     &
     & 4HE   ,4HN   ,4HD   ,4HF   ,4HL   ,4HT   ,4HC   ,4HO   ,         &
     & 4HN   ,4HO   ,4HP   ,4HT   ,4HI   ,4HN   ,4HS   ,4HB   ,4HO   ,  &
     & 4HD   ,4HY   ,4HW   ,4HG   ,4HP   ,4HL   ,4HN   ,4HF   ,4HW   ,  &
     & 4HG   ,4HS   ,4HC   ,4HH   ,4HR   ,4HS   ,4HY   ,4HN   ,4HT   ,  &
     & 4HH   ,4HS   ,4HH   ,4HT   ,4HP   ,4HL   ,4HN   ,4HF   ,4HH   ,  &
     & 4HT   ,4HS   ,4HC   ,4HH   ,4HR   ,4HV   ,4HT   ,4HP   ,4HL   ,  &
     & 4HN   ,4HF   ,4HV   ,4HT   ,4HS   ,4HC   ,4HH   ,4HR   ,4HP   ,  &
     & 4HR   ,4HO   ,4HP   ,4HW   ,4HR   ,4HJ   ,4HE   ,4HT   ,4HP   ,  &
     & 4HW   ,4HR   ,4HL   ,4HA   ,4HR   ,4HW   ,4HB   ,4HG   ,4HR   ,  &
     & 4HN   ,4HD   ,4HE   ,4HF   ,4HT   ,4HV   ,4HT   ,4HP   ,         &
     & 4HA   ,4HN   ,4HE   ,4HX   ,4HP   ,4HR   ,4H    ,4H    ,4HS   ,  &
     & 4HY   ,4HM   ,4HF   ,4HL   ,4HP   ,4HA   ,4HS   ,4HY   ,4HF   ,  &
     & 4HL   ,4HP   ,4HH   ,4HY   ,4HP   ,4HE   ,4HF   ,4HF   ,4HT   ,  &
     & 4HR   ,4HN   ,4HJ   ,4HE   ,4HT   ,4HC   ,4HO   ,4HN   ,4HT   ,  &
     & 4HA   ,4HB   ,4HV   ,4HF   ,4HS   ,4HC   ,4HH   ,4HR   ,4HV   ,  &
     & 4HF   ,4HP   ,4HL   ,4HN   ,4HF   /
!
!***  READ ONE CARD AND CHECK TYPE -
!***           K = 1 FIRST CARD OF NAMELIST
!***           K = 2 CONTINUATION CARD IN NAMELIST
!***           K = 3 CONTROL CARD
!
      WRITE(6,1120)
!
!***  THE FOLLOWING TWO CARDS ARE FOR FORTRAN-IV
!
!1000 READ(5,1020) (KOL(I),I=1,80)
!     IF(EOF(5)) 1110,1030
!
!***  THE FOLLOWING CARD IS FOR FORTRAN-V
!
 1000 READ(5,1020,END=1110) (KOL(I),I=1,80)
 1020 FORMAT(80A1)
 1030 K = 2
      IF(KOL(2) .EQ. KAND)   K = 1
      IF(KOL(1) .NE. IBLANK) K = 3
!
!***  CHECK NAMELIST NAME IF K = 1
!
      L = 2
      IF(K .NE. 1) GO TO 1100
        IERR = 0
        DO 1080 NAME = 1,NNAME
           I = LOC(NAME)
           L = LEN(NAME)
           IF(.NOT. NMTEST(KOL(3),NLNAME(I),L)) GO TO 1080
           IF(NAME .NE. 17) GO TO 1070
           L=L+2
           M=L+1
           MNUM = 0
 1040      DO 1050 J=1,10
              IF(KOL(M) .EQ. NUM(J)) GO TO 1060
 1050      CONTINUE
           IERR = 1
           GO TO 1080
 1060      M=M+1
           MNUM = 10*MNUM + J
           IF(M .EQ. (L+2)) GO TO 1040
           IF(MNUM .LT. 1 .OR. MNUM .GT. 20) IERR=1
 1070      CONTINUE
           IF(KOL(L+3) .EQ. IBLANK) GO TO 1090
 1080   CONTINUE
        IERR = 1
 1090   L = L+3
 1100 CONTINUE
!
!***  CHECK NAMELIST VARIABLES IF K = 1 OR 2
!***  CHECK CONTROL CARD IF K = 3
!
      IF(K .LE. 2) CALL NMLIST(KOL,L,NAME,K,IERR)
      IF(K .EQ. 3) CALL CCARD (KOL)
      GO TO 1000
 1110 CONTINUE
      REWIND 11
 1120 FORMAT(1H1,25X,29HCONERR - INPUT ERROR CHECKING/                  &
     &    1H0,39H ERROR CODES - N* DENOTES THE NUMBER OF,               &
     &        25H OCCURENCES OF EACH ERROR/                             &
     &    1H0,26H A - UNKNOWN VARIABLE NAME/                            &
     &    1H0,47H B - MISSING EQUAL SIGN FOLLOWING VARIABLE NAME/       &
     &    1H0,44H C - NON-ARRAY VARIABLE HAS AN ARRAY ELEMENT,          &
     &        18H DESIGNATION - (N)/                                    &
     &    1H0,52H D - NON-ARRAY VARIABLE HAS MULTIPLE VALUES ASSIGNED/  &
     &    1H0,43H E - ASSIGNED VALUES EXCEED ARRAY DIMENSION/           &
     &    1H0,17H F - SYNTAX ERROR//                                    &
     &    1H0,30H******************************,                        &
     &        20H  INPUT DATA CARDS  ,                                  &
     &        30H******************************/)
      RETURN
      END
      SUBROUTINE CONV(IDIM,SCALE)
!
!***  THIS SUBROUTINE PERFORMES THREE FUNCTIONS
!***     1. CONVERTS INPUT DIMENSIONS TO FT-LB-SEC SYSTEM
!***     2. SCALES DATA
!***     3. SHIFTS COORDINATE SYSTEM TO X = 0 AT BODY NOSE
!
      COMMON /FLGTCD/ FLC(42), RN(20), NGH, GRDH(10), PINF(20), FLC1(3),&
     &                ALT(20), TINF(20), VINF(20), WT, dumflgtcd(3)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ SYNA(19)
      COMMON /BODYI/  XNX, X(20), S(20), P(20), R(20), ZU(20),          &
     &                ZL(20), BTY(2), BL(3), dum2(3)
      COMMON /WINGI/  WGIN(101)
      COMMON /HTI/    HTIN(154)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /POWER/  PWIN(29), LBIN(21)
      COMMON /FLAPIN/ F(138)
!
      COMMON /BDATA/  BD(762)
      COMMON /CONSNT/ PI, DEG, UNUSED, RAD,kand
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      REAL LBIN
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
!
      EQUIVALENCE (BD(11),X0)
!
      DIMENSION IDIMT(8)
      DATA IDIMT / 4HF   ,4HT   ,4HI   ,4HN   ,                         &
     &             4HM   ,4H    ,4HC   ,4HM   /
!
!
!***  SET CONVERSION FACTORS
!
      XL = 1.0
      XA = 1.0
      XR = 1.0
      XP = 1.0
      XT = 1.0
      XW = 1.0
      XF = 1.0
      IF(IDIM .NE. 2) GO TO 1000
        XL = 12.0
        XA = 144.0
        XP = 144.0
 1000 CONTINUE
      IF(IDIM .LT. 3) GO TO 1010
        XL = 0.3048
        XA = 0.09290304
        XR = 0.3048
        XP = 0.0208854
        XT = 1.8
        XW = 0.2248089
        XF = 2.54
 1010 CONTINUE
      IF(IDIM .NE. 4) GO TO 1020
        XL = 30.48
        XA = 929.0304
        XP = 208.854
 1020 CONTINUE
      ASCALE = SCALE**2
!
!***  INPUT UNITS CONVERSION AND SCALING
!
      IF((IDIM .EQ. 1) .AND. (SCALE .EQ. 1.0)) GO TO 1160
        DO 1030 I=1,20
          IF(RN(I)   .NE. UNUSED) RN(I)   = RN(I)*XR
          IF(ALT(I)  .NE. UNUSED) ALT(I)  = ALT(I)/XL
          IF(PINF(I) .NE. UNUSED) PINF(I) = PINF(I)*XP
          IF(TINF(I) .NE. UNUSED) TINF(I) = TINF(I)*XT
          IF(VINF(I) .NE. UNUSED) VINF(I) = VINF(I)/XL
          IF(I .LE. 10 .AND. GRDH(I) .NE. UNUSED) GRDH(I) = GRDH(I)/XL
 1030   CONTINUE
        IF(WT .NE. UNUSED) WT = WT*XW
!
        IF(ROUGFC .NE. UNUSED) ROUGFC = ROUGFC/XF
        IF(SREF   .NE. UNUSED) SREF   = SREF*ASCALE/XA
        IF(CBARR  .NE. UNUSED) CBARR  = CBARR*SCALE/XL
        IF(BLREF  .NE. UNUSED) BLREF  = BLREF*SCALE/XL
!
        DO 1040 I=1,19
          IF(I .EQ. 4 ) GO TO 1040
          IF(I .EQ. 8 ) GO TO 1040
          IF(I .EQ. 10) GO TO 1040
          IF(I .EQ. 13) GO TO 1040
          IF(I .EQ. 18) GO TO 1040
          IF(I .EQ. 19) GO TO 1040
          IF(SYNA(I) .EQ. UNUSED) GO TO 1040
            SYNA(I) = SYNA(I)*SCALE/XL
 1040   CONTINUE
        IF(BD(33) .NE. UNUSED) BD(33) = BD(33)*SCALE/XL
        IF(BD(65) .NE. UNUSED) BD(65) = BD(65)*SCALE/XL
        IF(BD(74) .NE. UNUSED) BD(74) = BD(74)*SCALE/XL
        IF(BD(82) .NE. UNUSED) BD(82) = BD(82)*SCALE/XL
!
        DO 1050 I=1,20
          IF(X(I)  .NE. UNUSED) X(I)  = X(I)*SCALE/XL
          IF(S(I)  .NE. UNUSED) S(I)  = S(I)*ASCALE/XA
          IF(P(I)  .NE. UNUSED) P(I)  = P(I)*SCALE/XL
          IF(R(I)  .NE. UNUSED) R(I)  = R(I)*SCALE/XL
          IF(ZU(I) .NE. UNUSED) ZU(I) = ZU(I)*SCALE/XL
          IF(ZL(I) .NE. UNUSED) ZL(I) = ZL(I)*SCALE/XL
          IF((I .LE. 3) .AND. (BL(I) .NE. UNUSED))                      &
     &                          BL(I) = BL(I)*SCALE/XL
 1050   CONTINUE
!
        DO 1060 I=1,6
          IF(WGIN(I) .NE. UNUSED) WGIN(I) = WGIN(I)*SCALE/XL
          IF(HTIN(I) .NE. UNUSED) HTIN(I) = HTIN(I)*SCALE/XL
          IF(VTIN(I) .NE. UNUSED) VTIN(I) = VTIN(I)*SCALE/XL
          IF(VFIN(I) .NE. UNUSED) VFIN(I) = VFIN(I)*SCALE/XL
 1060   CONTINUE
        IF(WGIN(12) .NE. UNUSED) WGIN(12) = WGIN(12)*SCALE/XL
        IF(HTIN(12) .NE. UNUSED) HTIN(12) = HTIN(12)*SCALE/XL
        IF(VTIN(12) .NE. UNUSED) VTIN(12) = VTIN(12)*SCALE/XL
        IF(VFIN(12) .NE. UNUSED) VFIN(12) = VFIN(12)*SCALE/XL
        DO 1070 I=95,154
          IF(VTIN(I) .NE. UNUSED) VTIN(I) = VTIN(I)*ASCALE/XA
          IF(VFIN(I) .NE. UNUSED) VFIN(I) = VFIN(I)*ASCALE/XA
          IF((I .GE. 115) .AND. (HTIN(I) .NE. UNUSED))                  &
     &                            HTIN(I) = HTIN(I)*ASCALE/XA
          IF((I .LE. 114) .AND. (HTIN(I) .NE. UNUSED))                  &
     &                            HTIN(I) = HTIN(I)*SCALE/XL
 1070   CONTINUE
!
        IF(PWIN(4)  .NE. UNUSED) PWIN(4)  = PWIN(4)*SCALE/XL
        IF(PWIN(5)  .NE. UNUSED) PWIN(5)  = PWIN(5)*SCALE/XL
        IF(PWIN(6)  .NE. UNUSED) PWIN(6)  = PWIN(6)*SCALE/XL
        IF(PWIN(8)  .NE. UNUSED) PWIN(8)  = PWIN(8)*SCALE/XL
        IF(PWIN(9)  .NE. UNUSED) PWIN(9)  = PWIN(9)*SCALE/XL
        IF(PWIN(10) .NE. UNUSED) PWIN(10) = PWIN(10)*SCALE/XL
        IF(PWIN(16) .NE. UNUSED) PWIN(16) = PWIN(16)*SCALE/XL
        IF(PWIN(17) .NE. UNUSED) PWIN(17) = PWIN(17)*SCALE/XL
        IF(PWIN(18) .NE. UNUSED) PWIN(18) = PWIN(18)*SCALE/XL
        IF(PWIN(19) .NE. UNUSED) PWIN(19) = PWIN(19)*ASCALE/XA
        IF(PWIN(21) .NE. UNUSED) PWIN(21) = PWIN(21)/XL
        IF(PWIN(22) .NE. UNUSED) PWIN(22) = PWIN(22)*XT
        IF(PWIN(23) .NE. UNUSED) PWIN(23) = PWIN(23)*XT
        IF(PWIN(24) .NE. UNUSED) PWIN(24) = PWIN(24)*SCALE/XL
        IF(PWIN(25) .NE. UNUSED) PWIN(25) = PWIN(25)*XP
        IF(PWIN(26) .NE. UNUSED) PWIN(26) = PWIN(26)*XP
        IF(PWIN(27) .NE. UNUSED) PWIN(27) = PWIN(27)*SCALE/XL
        IF(PWIN(28) .NE. UNUSED) PWIN(28) = PWIN(28)*SCALE/XL
!
        DO 1080 I=1,4
          IF(TVTIN(I) .NE. UNUSED) TVTIN(I) = TVTIN(I)*SCALE/XL
 1080   CONTINUE
        IF(TVTIN(5) .NE. UNUSED) TVTIN(5) = TVTIN(5)*ASCALE/XA
        IF(TVTIN(7) .NE. UNUSED) TVTIN(7) = TVTIN(7)*SCALE/XL
        IF(TVTIN(8) .NE. UNUSED) TVTIN(8) = TVTIN(8)*SCALE/XL
!
        IF(.NOT. SYMFP) GO TO 1100
          DO 1090 I=12,125
            IF((I .GE. 16)  .AND. (I .LE. 38))  GO TO 1090
            IF((I .GE. 61)  .AND. (I .LE. 84))  GO TO 1090
            IF((I .GE. 105) .AND. (I .LE. 114)) GO TO 1090
            IF( I .EQ. 117)                     GO TO 1090
            IF(F(I) .NE. UNUSED) F(I) = F(I)*SCALE/XL
 1090     CONTINUE
          IF(F(133) .NE. UNUSED) F(133) = F(133)*XL
          IF(F(134) .NE. UNUSED) F(134) = F(134)*XL
          IF(F(135) .NE. UNUSED) F(135) = F(135)*XP
 1100   CONTINUE
        IF(.NOT. ASYFP) GO TO 1120
          DO 1110 I=12,15
            IF(F(I) .NE. UNUSED) F(I) = F(I)*SCALE/XL
 1110     CONTINUE
 1120   CONTINUE
        IF(.NOT. TRAJET) GO TO 1140
          DO 1130 I=12,21
            IF(F(I) .NE. UNUSED) F(I) = F(I)*XW
 1130     CONTINUE
          IF(F(34) .NE. UNUSED) F(34) = F(34)/XL
          IF(F(38) .NE. UNUSED) F(38) = F(38)/XL
 1140   CONTINUE
        IF(.NOT. HYPEF) GO TO 1150
          IF(F(1) .NE. UNUSED) F(1) = F(1)/XL
          IF(F(2) .NE. UNUSED) F(2) = F(2)/XL
          IF(F(4) .NE. UNUSED) F(4) = F(4)/XL
 1150   CONTINUE
!
        IF(LBIN(2)  .NE. UNUSED) LBIN(2)  = LBIN(2)/XA
        IF(LBIN(4)  .NE. UNUSED) LBIN(4)  = LBIN(4)/XA
        IF(LBIN(9)  .NE. UNUSED) LBIN(9)  = LBIN(9)/XA
        IF(LBIN(11) .NE. UNUSED) LBIN(11) = LBIN(11)/XA
        IF(LBIN(18) .NE. UNUSED) LBIN(18) = LBIN(18)/XA
        IF(LBIN(19) .NE. UNUSED) LBIN(19) = LBIN(19)/XA
        IF(LBIN(1)  .NE. UNUSED) LBIN(1)  = LBIN(1)/XL
        IF(LBIN(8)  .NE. UNUSED) LBIN(8)  = LBIN(8)/XL
        IF(LBIN(10) .NE. UNUSED) LBIN(10) = LBIN(10)/XL
        IF(LBIN(12) .NE. UNUSED) LBIN(12) = LBIN(12)/XL
        IF(LBIN(13) .NE. UNUSED) LBIN(13) = LBIN(13)/XL
        IF(LBIN(15) .NE. UNUSED) LBIN(15) = LBIN(15)/XL
        IF(LBIN(20) .NE. UNUSED) LBIN(20) = LBIN(20)/XL
        IF(LBIN(21) .NE. UNUSED) LBIN(21) = LBIN(21)/XL
 1160 CONTINUE
!
!***  SET NOSE LOCATION
!
      X0 = X(1)
      IF(ABS(X0) .LE. UNUSED) GO TO 1180
        NX = XNX+0.5
        DO 1170 I=1,NX
          X(I) = X(I)-X0
 1170   CONTINUE
        SYNA(1)  = SYNA(1) -X0
        SYNA(2)  = SYNA(2) -X0
        SYNA(6)  = SYNA(6) -X0
        SYNA(9)  = SYNA(9) -X0
        IF(SYNA(11) .NE. UNUSED) SYNA(11) = SYNA(11)-X0
        IF(SYNA(12) .NE. UNUSED) SYNA(12) = SYNA(12)-X0
        PWIN(4)  = PWIN(4) -X0
        PWIN(16) = PWIN(16)-X0
        PWIN(18) = PWIN(18)-X0
        BD(33)   = BD(33)  -X0
        BD(65)   = BD(65)  -X0
 1180 CONTINUE
      I1 = 1+2*(IDIM-1)
      I2 = I1+1
      WRITE(6,1190) (IDIMT(I),I=I1,I2), SCALE
      RETURN
 1190 FORMAT(1H0,25H INPUT DIMENSIONS ARE IN ,2A1,                      &
     &           18H, SCALE FACTOR IS ,F6.4/)
      END
      SUBROUTINE COORD1
!
!***** CALCULATE NACA 1-SERIES AIRFOIL COORDINATES
!
      COMMON /IWING/ PW, X(60),dum13(340)
      COMMON / IHT / PHT, XU(60),XL(60), dum3(260)
      COMMON / IVT / PVT, YUN(60),YLN(60), dum4(260)
      COMMON / IBW / PBW,L,I,J,K,II,JJ,KK,III,JJJ, dum5(369)
      COMMON / IBH / PBH, THN(60),CAM(60), dum6(260)
      COMMON /IBWH/  PBWH,ALPHAI,ALPHAO,AII
      COMMON /IBWHV/ PBWHV, RHO,T
      COMMON /CONSNT/PI,DEG,UNUSED,RAD,kand
      DIMENSION A(2,3),B(2),XN(2)
      DIMENSION AA(3,4),BA(3),XM(3)
!
      AI=I
      AJ=J
      AK=K
      AII=II
      AJJ=JJ
      AKK=KK
      AIII=III
      AJJJ=JJJ
      ZT=AJ*.1-.1
      T=AJJ*.1+AKK*.01+AIII*.001+AJJJ*.0001
      NN=2
      IF(J.EQ.6)ZT=AJ*.1-.2
      D0=0.0
      IF(J.EQ.6)D1=2.157*T
      IF(J.EQ.6)SM=4.
      IF(J.EQ.8)D1=3.6833*T
      IF(J.EQ.8)SM=3.
      IF(J.EQ.9)D1=5.5283*T
      IF(J.EQ.9)SM=3.
      A(1,1)=-2.*(1.-ZT)
      A(1,2)=-3.*((1.-ZT)**2)
      A(2,1)=(1.-ZT)**2
      A(2,2)=(1.-ZT)**3
      B(1)=D1
      B(2)=T/2.-D0-D1*(1.-ZT)
      LL=NN+1
      CALL SLEQ(A,XN,B,NN,LL)
      D2=XN(1)
      D3=XN(2)
      A0=SQRT(2.*1.1019*((T*SM/6.)**2))
      RHO=.5*A0**2
      AA(1,1)=0.0
      AA(1,2)=2.
      AA(1,3)=6.*ZT
      BA(1)=2.*D2+6.*D3*(1.-ZT)+A0/(4.*ZT**1.5)
      AA(2,1)=1.
      AA(2,2)=2.*ZT
      AA(2,3)=3.*ZT**2
      BA(2)=-A0/(2.*ZT**.5)
      AA(3,1)=ZT
      AA(3,2)=ZT**2
      AA(3,3)=ZT**3
      BA(3)=-A0*ZT**.5+T/2.
      NN=3
      LL=NN+1
      CALL SLEQ(AA,XM,BA,NN,LL)
      A1=XM(1)
      A2=XM(2)
      A3=XM(3)
      LL=L-1
      AII=AII*.1
      DO 1000 M=2,LL
        YC=-(AII/(4.*PI))*((1.-X(M))*ALOG(1.-X(M))+X(M)*ALOG(X(M)))
        ALPHA=ATAN((-AII/(4.*PI))*(ALOG(X(M))-ALOG(1.-X(M))))
        IF(X(M).EQ.ZT)YT=T/2.
        IF(X(M).LT.ZT)YT=A0*X(M)**.5+A1*X(M)+A2*X(M)**2+A3*X(M)**3
        IF(X(M).GT.ZT)YT=D0+D1*(1.-X(M))+D2*(1.-X(M))**2+D3*(1.-X(M))**3
        XU(M)=X(M)-YT*SIN(ALPHA)
        YUN(M)=YC+YT*COS(ALPHA)
        XL(M)=X(M)+YT*SIN(ALPHA)
        YLN(M)=YC-YT*COS(ALPHA)
        CAM(M)=YC
        IF(CAM(M) .LT. 1.E-05) CAM(M)=0.0
        THN(M)=YT
 1000 END DO
      THN(1)=0.0
      THN(L)=0.0
      CAM(1)=0.0
      CAM(L)=0.0
      XU(L)=1.
      YUN(L)=0.0
      XL(L)=1.
      YLN(L)=0.0
      XL(1)=0.0
      YLN(1)=0.0
      XL(1)=0.0
      YLN(1)=0.0
      ALPHAI=0.0
      ALPHAO=-RAD*AII/(2.*PI)
      RETURN
      END
      SUBROUTINE COORD4
!
!***** CALCULATE NACA FOUR DIGIT AIRFOIL COORDINATES
!
      COMMON /IWING/ PW, X(60),dum13(340)
      COMMON / IHT / PHT, XU(60),XL(60), dum3(260)
      COMMON / IVT / PVT, YUN(60),YLN(60), dum4(260)
      COMMON / IBW / PBW,L,I,J,K,II,JJ,KK,III,JJJ, dum5(369)
      COMMON / IBH / PBH, THN(60),CAM(60), dum6(260)
      COMMON /IBWHV/ PBWHV, RHO,T,DELTAY,XOVC,TOVC,ZM,ZP
      AI=I
      AJ=J
      AK=K
      AII=II
      AJJ=JJ
      AKK=KK
      ZM=AI*.01
      ZP=AJ*.1
      T=AK*.1+AII*.01+AJJ*.001+AKK*.0001
      RHO=1.1019*T**2
      DO 1000 M=1,L
         YT=5.*T*(.2969*SQRT(X(M))-.126*X(M)-.3516*X(M)**2+.2843*X(M)**3&
     &      -.1015*X(M)**4)
         IF(X(M).EQ.ZP)YC=ZM
         IF(X(M).EQ.ZP)ALPHA=0.0
         IF(X(M).LT.ZP)YC=(2.*ZP*X(M)-X(M)**2)*ZM/ZP**2
         IF(X(M).LT.ZP)ALPHA=ATAN((2.*ZM/(ZP**2))*(ZP-X(M)))
         IF(X(M).GT.ZP)                                                 &
     &   YC=(ZM/((1.-ZP)**2))*(1.-2.*ZP+2.*ZP*X(M)-X(M)**2)
         IF(X(M).GT.ZP)ALPHA=ATAN((2.*ZM/((1.-ZP)**2))*((ZP-X(M))))
         XU(M)=X(M)-YT*SIN(ALPHA)
         YUN(M)=YC+YT*COS(ALPHA)
         XL(M)=X(M)+YT*SIN(ALPHA)
         YLN(M)=YC-YT*COS(ALPHA)
         CAM(M)=YC
         IF(CAM(M) .LT. 1.E-05) CAM(M)=0.0
         THN(M)=YT
 1000 END DO
      THN(1)=0.0
      THN(L)=0.0
      CAM(1)=0.0
      CAM(L)=0.0
      XU(L)=1.
      YUN(L)=0.0
      XL(L)=1.
      YLN(L)=0.0
      XU(1)=0.0
      YLN(1)=0.0
      RETURN
      END
      SUBROUTINE COORD5
!
!***** CALCULATE NACA FIVE DIGIT AIRFOIL COORDINATES
!
      COMMON /IWING/ PW, X(60),dum13(340)
      COMMON / IHT / PHT, XU(60),XL(60), dum3(260)
      COMMON / IVT / PVT, YUN(60),YLN(60), dum4(260)
      COMMON / IBW / PBW,L,I,J,K,II,JJ,KK,III,JJJ, dum5(369)
      COMMON / IBH / PBH, THN(60),CAM(60),dum6(260)
      COMMON /IBWHV/ PBWHV, RHO,T,DELTAY,XOVC,TOVC,ZM,ZP
      AI=I
      AJ=J
      AK=K
      AII=II
      AJJ=JJ
      AKK=KK
      AIII=III
      T=AII*.1+AJJ*.01+AKK*.001+AIII*.0001
      RHO=1.1019*T**2
      ZP=AJ*.1/2.
      A=6.*ZP-3.
      B=-2.+6.*ZP-3.*ZP**2
      G=B*B/4.+A*A*A/27.
      IF(G.LT.0.) GO TO 1000
      D=(-B/2.+G**.5)**(1./3.)
      E=(-B/2.-G**.5)**(1./3.)
      ZM=D+E+1.
      GO TO 1010
 1000 PHI=ARCCOS((-B/2.)/((-A**3/27.)**.5))
      ZM=1.+2.*((-A/3.)**.5)*COS(PHI/3.+4.18879)
 1010 XK=(6.*AI*.01)/(ZP**3-3.*ZM*ZP**2+ZM**2*(3.-ZM)*ZP)
      DO 1040 M=1,L
         IF(AK.NE.0.)GO TO 1020
         YT=5.*T*(.2969*SQRT(X(M))-.126*X(M)-.3516*X(M)**2+.2843*X(M)**3&
     &      -.1015*X(M)**4)
         IF(X(M).LT.ZM)YC=(1./6.)*XK*(X(M)**3-3.*ZM*X(M)**2+ZM**2*(3.   &
     &      -ZM)*X(M))
         IF(X(M).LT.ZM)ALPHA=ATAN((1./6.)*XK*(3.*X(M)**2-6.*ZM*X(M)+    &
     &     ZM**2*(3.-ZM)))
         IF(X(M).EQ.ZP)YC=AI*.01
         IF(X(M).EQ.ZP)ALPHA=0.0
         IF(X(M).GT.ZM)YC=(1./6.)*XK*ZM**3*(1.-X(M))
         IF(X(M).GT.ZM)ALPHA=ATAN(-(1./6.)*XK*ZM**3)
         IF(AK.EQ.0.0)GO TO 1030
 1020    RK=(3.*((ZM-ZP)**2)-ZM**3)/((1.-ZM)**3)
         ZMX=AI*.01
         XK=(6.*ZMX)/((ZP-ZM)**3-RK* (1.-ZM)**3*ZP-(ZM**3)*ZP+ZM**3)
         YT=5.*T*(.2969*SQRT(X(M))-.126*X(M)-.3516*X(M)**2+.2843*X(M)**3&
     &      -.1015*X(M)**4)
         IF(X(M).LT.ZM)YC=(1./6.)*XK*((X(M)-ZM)**3-RK*X(M)*(1.-ZM)**3   &
     &      -ZM**3*X(M)+ZM**3)
         IF(X(M).LT.ZM)ALPHA=ATAN((1./6.)*XK*(3.*(X(M)-ZM)**2-RK*(1.    &
     &      -ZM)**3-ZM**3))
         IF(X(M).EQ.ZP)YC=AI*.01
         IF(X(M).EQ.ZP)ALPHA=0.0
         IF(X(M).GT.ZM)YC=(1./6.)*XK*(RK*(X(M)-ZM)**3-RK*X(M)*(1.-ZM)**3&
     &      -X(M)*ZM**3+ZM**3)
         IF(X(M).GT.ZM)ALPHA=ATAN((1./6.)*XK*(3.*RK*(X(M)-ZM)**2-RK*    &
     &      (1.-ZM)**3-ZM**3))
 1030    XU(M)=X(M)-YT*SIN(ALPHA)
         YUN(M)=YC+YT*COS(ALPHA)
         XL(M)=X(M)+YT*SIN(ALPHA)
         YLN(M)=YC-YT*COS(ALPHA)
         CAM(M)=YC
         IF(CAM(M) .LT. 1.E-05) CAM(M)=0.0
         THN(M)=YT
 1040 END DO
      THN(1)=0.0
      THN(L)=0.0
      CAM(1)=0.0
      CAM(L)=0.0
      XU(L)=1.
      YUN(L)=0.0
      XL(L)=1.
      YLN(L)=0.0
      XU(1)=0.0
      YLN(1)=0.0
      RETURN
      END
      SUBROUTINE COORD6
!
!***** CALCULATE NACA 6-SERIES AIRFOIL COORDINATES
!
      COMMON /IWING/ PW, X(60),dum13(340)
      COMMON / IHT / PHT, XU(60),XL(60), dum3(260)
      COMMON / IVT / PVT, YUN(60),YLN(60), dum4(260)
      COMMON / IBW / PBW,L,I,J,K,II,JJ,KK,III,JJJ, dum5(369)
      COMMON / IBH / PBH, THN(60),CAM(60),dum6(260)
      COMMON /IBWH/  PBWH,ALPHAI,ALPHAO,AJJ
      COMMON /IBWHV/ PBWHV, RHO,T
      COMMON /CONSNT/PI,DEG,UNUSED,RAD,kand
      DIMENSION A(2,3),B(2),XN(2)
      DIMENSION AA(3,4),BA(3),XM(3)
      AI=I
      AJ=J
      AK=K
      AII=II
      AJJ=JJ
      AKK=KK
      AIII=III
      AJJJ=JJJ
      T=AKK*.1+AIII*.01
      NN=2
      IF(J.EQ.3)GO TO 1000
      IF(J.EQ.4)GO TO 1010
      IF(J.EQ.5)GO TO 1020
      ZT=.45
      SM=-1.268
      R=SM*(T-.06)+.873
      D1=R*T
      GO TO 1030
 1000 ZT=.35
      SM=-.6116
      R=SM*(T-.06)+.46
      D1=R*T
      IF(II.GT.0)D1=T
      GO TO 1030
 1010 ZT=.40
      SM=-.6888
      R=SM*(T-.06)+.523
      D1=R*T
      IF(II.GT.0)D1=1.04*T
      GO TO 1030
 1020 ZT=.4
      SM=-.8833
      R=SM*(T-.06)+.65
      D1=R*T
      IF(II.GT.0)D1=1.17*T
 1030 D0=0.0
      A(1,1)=-2.*(1.-ZT)
      A(1,2)=-3.*((1.-ZT)**2)
      A(2,1)=(1.-ZT)**2
      A(2,2)=(1.-ZT)**3
      B(1)=D1
      B(2)=T/2.-D0-D1*(1.-ZT)
      LL=NN+1
      CALL SLEQ(A,XN,B,NN,LL)
      D2=XN(1)
      D3=XN(2)
      RLE=.01*(68.682*T**2+.0182*T+.0014)
      RHO=RLE
      A0=SQRT(2.*RLE)
      AA(1,1)=0.0
      AA(1,2)=2.
      AA(1,3)=6.*ZT
      BA(1)=2.*D2+6.*D3*(1.-ZT)+A0/(4.*ZT**1.5)
      AA(2,1)=1.
      AA(2,2)=2.*ZT
      AA(2,3)=3.*ZT**2
      BA(2)=-A0/(2.*ZT**.5)
      AA(3,1)=ZT
      AA(3,2)=ZT**2
      AA(3,3)=ZT**3
      BA(3)=-A0*ZT**.5+T/2.
      NN=3
      LL=NN+1
      CALL SLEQ(AA,XM,BA,NN,LL)
      A1=XM(1)
      A2=XM(2)
      A3=XM(3)
      ZA=AJJJ*.1
      IF(AJJJ.LT.1.)ZA=1.
      IF(ZA.EQ.1.)GO TO 1040
      C=1.-ZA
      G=(-1./C)*((ZA**2)*(.5*ALOG(ZA)-.25)+.25)
      H=(1./C)*((.5*C**2)*ALOG(C)-.25*C**2)+G
 1040 AJJ=AJJ*.1
      LL=L-1
      DO 1100 M=2,LL
         IF(ZA.EQ.1.)GO TO 1050
         S=1.-X(M)
         D=ZA-X(M)
      IF(D.EQ.0.0) D=1.0E-10
         YC=(AJJ/(2.*PI*(ZA+1.)))*((1./C)*((.5*D**2)*ALOG(ABS(D))-      &
     &    (.5*S**2)*ALOG(S)+.25*S**2-.25*D**2)-X(M)*ALOG(X(M))+G-X(M)*H)
         ALPHA=ATAN((AJJ/(2.*PI*(1.+ZA)))*((1./C)*(-D*ALOG(ABS(D))      &
     &         +S*ALOG(S))-ALOG(X(M))-1.-H))
         GO TO 1060
 1050    YC=-(AJJ/(4.*PI))*((1.-X(M))*ALOG(1.-X(M))+X(M)*ALOG(X(M)))
         ALPHA=ATAN((-AJJ/(4.*PI))*(ALOG(X(M))-ALOG(1.-X(M))))
 1060    IF(X(M).EQ.ZT)YT=T/2.
         IF(X(M).LT.ZT)YT=A0*X(M)**.5+A1*X(M)+A2*X(M)**2+A3*X(M)**3
        IF(X(M).GT.ZT)YT=D0+D1*(1.-X(M))+D2*(1.-X(M))**2+D3*(1.-X(M))**3
         XU(M)=X(M)-YT*SIN(ALPHA)
         YUN(M)=YC+YT*COS(ALPHA)
         XL(M)=X(M)+YT*SIN(ALPHA)
         YLN(M)=YC-YT*COS(ALPHA)
         IF(XU(M).GE..80.AND.II.GT.0)GO TO 1080
         NO=1
 1070    CONTINUE
         CAM(M)=YC
         IF(CAM(M) .LT. 1.E-05) CAM(M)=0.0
         THN(M)=YT
         GO TO 1100
 1080    IF(NO.NE.1)GO TO 1090
         SXU=XU(M)
         SXL=XL(M)
         SYU=YUN(M)
         SYL=YLN(M)
         SMU=-SYU/(1.-SXU)
         SML=-SYL/(1.-SXL)
         NO=2
         GO TO 1070
 1090    XU(M)=XU(M)-SXU
         XL(M)=XL(M)-SXL
         YUN(M)=SMU*XU(M)+SYU
         YLN(M)=SML*XL(M)+SYL
         XU(M)=XU(M)+SXU
         XL(M)=XL(M)+SXL
         GO TO 1070
 1100 END DO
      THN(1)=0.0
      THN(L)=0.0
      CAM(1)=0.0
      CAM(L)=0.0
      XU(L)=1.
      YUN(L)=0.0
      XL(L)=1.
      YLN(L)=0.0
      XU(1)=0.0
      YLN(1)=0.0
      XL(1)=0.0
      YUN(1)=0.0
      ALPHAI=0.0
      ALPHAO=-RAD*AJJ/(2.*PI)
      IF(ZA .EQ. 1.) RETURN
      ALPHAI=ALPHAO*H/(ZA+1.)
      ALPHAO=ALPHAO+ALPHAI
      RETURN
      END
      SUBROUTINE CORD4M
!
!***** CALCULATE NACA FOUR DIGIT (MODIFIED) AIRFOIL COORDINATES
!
      COMMON /IWING/ PW, X(60),dum13(340)
      COMMON / IHT / PHT, XU(60),XL(60), dum3(260)
      COMMON / IVT / PVT, YUN(60),YLN(60), dum4(260)
      COMMON / IBW / PBW,L,I,J,K,II,JJ,KK,III,JJJ, dum5(369)
      COMMON / IBH / PBH, THN(60),CAM(60),dum6(260)
      COMMON /IBWHV/ PBWHV, RHO,T,DELTAY,XOVC,TOVC,ZM,ZP
      COMMON /CONSNT/PI,DEG,UNUSED,RAD,kand
      DIMENSION A(2,3),B(2),XN(2)
      DIMENSION AA(3,4),BA(3),XM(3)
      AI=I
      AJ=J
      AK=K
      AII=II
      AJJ=JJ
      AKK=KK
      AIII=III
      ZM=AI*.01
      ZP=AJ*.1
      ZT=AIII*.1
      T=AK*.1+AII*.01
      NN=2
      IF(ZT.GT..18.AND.ZT.LT..22) D1=T
      IF(ZT.GT..28.AND.ZT.LT..32) D1=1.17*T
      IF(ZT.GT..38.AND.ZT.LT..42) D1=1.575*T
      IF(ZT.GT..48.AND.ZT.LT..52) D1=2.325*T
      IF(ZT.GT..58.AND.ZT.LT..62) D1=3.5*T
      D0=.01*T
      A(1,1)=-2.*(1.-ZT)
      A(1,2)=-3.*((1.-ZT)**2)
      A(2,1)=(1.-ZT)**2
      A(2,2)=(1.-ZT)**3
      B(1)=D1
      B(2)=T/2.-D0-D1*(1.-ZT)
      LL=NN+1
      CALL SLEQ(A,XN,B,NN,LL)
      D2=XN(1)
      D3=XN(2)
      A0=SQRT(2.*1.1019*((T*AKK/6.)**2))
      RHO=.5*A0**2
      AA(1,1)=0.0
      AA(1,2)=2.0
      AA(1,3)=6.*ZT
      BA(1)=2.*D2+6.*D3*(1.-ZT)+A0/(4.*ZT**1.5)
      AA(2,1)=1.0
      AA(2,2)=2.*ZT
      AA(2,3)=3.*ZT**2
      BA(2)=-A0/(2.*ZT**.5)
      AA(3,1)=ZT
      AA(3,2)=ZT**2
      AA(3,3)=ZT**3
      BA(3)=-A0*ZT**.5+T/2.
      NN=3
      LL=NN+1
      CALL SLEQ(AA,XM,BA,NN,LL)
      A1=XM(1)
      A2=XM(2)
      A3=XM(3)
      DO 1000 M=1,L
        IF(X(M).EQ.ZT)YT=T/2.
        IF(X(M).EQ.ZP)YC=ZM
        IF(X(M).EQ.ZP)ALPHA=0.0
        IF(X(M).LT.ZP)YC=(ZM/ZP**2)*(2.*ZP*X(M)-X(M)**2)
        IF(X(M).LT.ZP)ALPHA=ATAN((2.*ZM/ZP**2)*(ZP-X(M)))
        IF(X(M).LT.ZT)YT=A0*X(M)**.5+A1*X(M)+A2*X(M)**2+A3*X(M)**3
        IF(X(M).GT.ZP)YC=(ZM/((1.-ZP)**2))*(1.-2.*ZP+2.*ZP*X(M)-X(M)**2)
        IF(X(M).GT.ZP)ALPHA=ATAN((2.*ZM/((1.-ZP)**2))*(ZP-X(M)))
        IF(X(M).GT.ZT)YT=D0+D1*(1.-X(M))+D2*(1.-X(M))**2+D3*(1.-X(M))**3
        XU(M)=X(M)-YT*SIN(ALPHA)
        YUN(M)=YC+YT*COS(ALPHA)
        XL(M)=X(M)+YT*SIN(ALPHA)
        YLN(M)=YC-YT*COS(ALPHA)
        CAM(M)=YC
        IF(CAM(M) .LT. 1.E-05) CAM(M)=0.0
        THN(M)=YT
 1000 END DO
      THN(1)=0.0
      THN(L)=0.0
      CAM(1)=0.0
      CAM(L)=0.0
      XU(L)=1.
      YUN(L)=0.0
      XL(L)=1.
      YLN(L)=0.0
      XU(1)=0.0
      YLN(1)=0.0
      RETURN
      END
      SUBROUTINE CORD5M
!
!***** CALCULATE NACA FIVE DIGIT (MODIFIED) AIRFOIL COORDINATES
!
      COMMON /IWING/ PW, X(60),dum13(340)
      COMMON / IHT / PHT, XU(60),XL(60), dum3(260)
      COMMON / IVT / PVT, YUN(60),YLN(60), dum4(260)
      COMMON / IBW / PBW,L,I,J,K,II,JJ,KK,III,JJJ, dum5(369)
      COMMON / IBH / PBH, THN(60),CAM(60),dum6(260)
      COMMON /IBWHV/ PBWHV, RHO,T,DELTAY,XOVC,TOVC,ZM,ZP
      DIMENSION A(2,3),B(2),XN(2)
      DIMENSION AA(3,4),BA(3),XM(3)
      AI=I
      AJ=J
      AK=K
      AII=II
      AJJ=JJ
      AKK=KK
      AIII=III
      AJJJ=JJJ
      T=AII*.1+AJJ*.01
      ZP=AJ*.1/2.
      ZT=AJJJ*.1
      R=6.*ZP-3.
      S=-2.+6.*ZP-3.*ZP**2
      G=S*S/4.+R*R*R/27.
      IF(G.LT.0.)GO TO 1000
      D=(-S/2.+G**.5)**(1./3.)
      F=(-S/2.-G**.5)**(1./3.)
      ZM=D+F+1.
      GO TO 1010
 1000 PHI=ARCCOS((-S/2.)/((-R**3/27.)**.5))
      ZM=1.+2.*((-R/3.)**.5)*COS(PHI/3.+4.18879)
 1010 XK=(6.*AI*.01)/(ZP**3-3.*ZM*ZP**2+ZM**2*(3.-ZM)*ZP)
      NN=2
      IF(ZT.GT..18.AND.ZT.LT..22) D1=T
      IF(ZT.GT..28.AND.ZT.LT..32) D1=1.17*T
      IF(ZT.GT..38.AND.ZT.LT..42) D1=1.575*T
      IF(ZT.GT..48.AND.ZT.LT..52) D1=2.325*T
      IF(ZT.GT..58.AND.ZT.LT..62) D1=3.5*T
      D0=.01*T
      A(1,1)=-2.*(1.-ZT)
      A(1,2)=-3.*((1.-ZT)**2)
      A(2,1)=(1.-ZT)**2
      A(2,2)=(1.-ZT)**3
      B(1)=D1
      B(2)=T/2.-D0-D1*(1.-ZT)
      LL=NN+1
      CALL SLEQ(A,XN,B,NN,LL)
      D2=XN(1)
      D3=XN(2)
      A0=SQRT(2.*1.1019*((T*AIII/6.)**2))
      RHO=.5*A0**2
      AA(1,1)=0.0
      AA(1,2)=2.
      AA(1,3)=6.*ZT
      BA(1)=2.*D2+6.*D3*(1.-ZT)+A0/(4.*ZT**1.5)
      AA(2,1)=1.
      AA(2,2)=2.*ZT
      AA(2,3)=3.*ZT**2
      BA(2)=-A0/(2.*ZT**.5)
      AA(3,1)=ZT
      AA(3,2)=ZT**2
      AA(3,3)=ZT**3
      BA(3)=-A0*ZT**.5+T/2.
      NN=3
      LL=NN+1
      CALL SLEQ(AA,XM,BA,NN,LL)
      A1=XM(1)
      A2=XM(2)
      A3=XM(3)
      DO 1040 M=1,L
        IF(AK.NE.0.)GO TO 1020
        IF(X(M).EQ.ZT)YT=T/2.
        IF(X(M).EQ.ZP)YC=AI*.01
        IF(X(M).EQ.ZP)ALPHA=0.0
        IF(X(M).LT.ZM)YC=(1./6.)*XK*(X(M)**3-3.*ZM*X(M)**2+ZM**2        &
     &     *(3.-ZM)*X(M))
        IF(X(M).LT.ZM)ALPHA=ATAN((1./6.)*XK*(3.*X(M)**2-6.*ZM*X(M)+     &
     &     ZM**2*(3.-ZM)))
        IF(X(M).LT.ZT)YT=A0*X(M)**.5+A1*X(M)+A2*X(M)**2+A3*X(M)**3
        IF(X(M).GT.ZT)YT=D0+D1*(1.-X(M))+D2*(1.-X(M))**2+D3*(1.-X(M))**3
        IF(X(M).GT.ZM)YC=(1./6.)*XK*ZM**3*(1.-X(M))
        IF(X(M).GT.ZM)ALPHA=ATAN(-(1./6.)*XK*ZM**3)
        IF(AK.EQ.0.)GO TO 1030
 1020   RK=(3.*((ZM-ZP)**2)-ZM**3)/((1.-ZM)**3)
        ZMX=AI*.01
        XK=(6.*ZMX)/((ZP-ZM)**3-RK*(1.-ZM)**3*ZP-ZM**3*ZP+ZM**3)
        IF(X(M).LT.ZT)YT=A0*X(M)**.5+A1*X(M)+A2*X(M)**2+A3*X(M)**3
        IF(X(M).LT.ZM)YC=(1./6.)*XK*((X(M)-ZM)**3-RK*X(M)*(1.-ZM)**3    &
     &     -ZM**3*X(M)+ZM**3)
        IF(X(M).LT.ZM)ALPHA=ATAN((1./6.)*XK*(3.*(X(M)-ZM)**2-RK*(1.-ZM) &
     &     **3-ZM**3))
        IF(X(M).EQ.ZT)YT=T/2.
        IF(X(M).EQ.ZP)YC=AI*.01
        IF(X(M).EQ.ZP)ALPHA=0.0
        IF(X(M).GT.ZT)YT=D0+D1*(1.-X(M))+D2*(1.-X(M))**2+D3*(1.-X(M))**3
        IF(X(M).GT.ZM)YC=(1./6.)*XK*(RK*(X(M)-ZM)**3-RK*X(M)*(1.-ZM)**3 &
     &     -X(M)*ZM**3+ZM**3)
        IF(X(M).GT.ZM)ALPHA=ATAN((1./6.)*XK*(3.*RK*(X(M)-ZM)**2-RK*     &
     &     (1.-ZM)**3-ZM**3))
 1030   XU(M)=X(M)-YT*SIN(ALPHA)
        YUN(M)=YC+YT*COS(ALPHA)
        XL(M)=X(M)+YT*SIN(ALPHA)
        YLN(M)=YC-YT*COS(ALPHA)
        CAM(M)=YC
        IF(CAM(M) .LT. 1.E-05) CAM(M)=0.0
        THN(M)=YT
 1040 END DO
      THN(1)=0.0
      THN(L)=0.0
      CAM(1)=0.0
      CAM(L)=0.0
      XU(L)=1.
      YUN(L)=0.0
      XL(L)=1.
      YLN(L)=0.0
      XU(1)=0.0
      YLN(1)=0.0
      RETURN
      END
      SUBROUTINE CORDSP
!
!     CALCULATE SUPERSONIC AIRFOIL COORDINATES FROM NACA CARD
!
      COMMON /IWING/  PW,X(60),dum13(340)
      COMMON /IHT/    PHT,XU(60),XL(60),YUU(60),YLL(60), dum3(140)
      COMMON /IVT/    PVT,YU(60),YL(60), dum4(260)
      COMMON /IBW/    PBW,L,I,J,K,II,JJ,KK,III,JJJ,KKK,LLL, dum5(369)
      COMMON /WINGI/  WGIN(100)
      COMMON /HTI/    HTIN(154)
      COMMON /VTI/    VTIN(154),TVTIN(8),VFIN(154)
      COMMON /IBWHV/  PBWHV,RHO,TOC
      COMMON /IBODY/  PB,NACA(80)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      REAL KSHARP
      INTEGER A4HH,A4HV,A4HF,A4HSTR
      DATA A4HH,A4HV,A4HF,A4HSTR/4HH   ,4HV   ,4HF   ,4HSTRA/
!
      XT=(100.*J+10.*K+II)/1000.
      TOC=(100.*JJ+10.*KK+III)/1000.
      XF=(100.*JJJ+10.*KKK+LLL)/1000.
      RHO=0.
      GO TO (1020,1000,1050), I
 1000 CONTINUE
!
!     HERE FOR BICONVEX (CIRCULAR ARC)
!
      XT=0.50
      KSHARP=16./3.
      RC=(TOC**2+1.)/(4.*TOC)
      DO 1010 IL=1,60
         XU(IL)=X(IL)
         XL(IL)=X(IL)
         YU(IL)=TOC/2.-RC+SQRT(RC**2-(X(IL)-.5)**2)
         YL(IL)=-YU(IL)
 1010 END DO
      GO TO 1090
 1020 CONTINUE
!
!     HERE FOR DOUBLE WEDGE
!
      KSHARP=(1./XT)/(1.-XT)
      DO 1040 IL=1,60
         XU(IL)=X(IL)
         XL(IL)=X(IL)
         IF(X(IL).GT.XT)GO TO 1030
         YU(IL)=X(IL)*TOC/(2.*XT)
         YL(IL)=-YU(IL)
         GO TO 1040
 1030    YU(IL)=TOC/2.-(X(IL)-XT)*TOC/(2.*(1.-XT))
         YL(IL)=-YU(IL)
 1040 END DO
      GO TO 1090
 1050 CONTINUE
!
!     HERE FOR HEXAGONAL
!
      KSHARP=(1.-XF)/(XT*(1.-XT-XF))
      DO 1080 IL=1,60
         XU(IL)=X(IL)
         XL(IL)=X(IL)
         IF(X(IL).GE.(XT+XF))GO TO 1070
         IF(X(IL).GE.(XT   ))GO TO 1060
         YU(IL)=X(IL)*TOC/(2.*XT)
         YL(IL)=-YU(IL)
         GO TO 1080
 1060    YU(IL)=TOC/2.
         YL(IL)=-YU(IL)
         GO TO 1080
 1070    YU(IL)=TOC/2.-(X(IL)-XT-XF)*TOC/(2.*(1.-XT-XF))
         YL(IL)=-YU(IL)
 1080 END DO
 1090 CONTINUE
!
!     SET SOME OF THE CALCULATED VALUES IN THE INPUT ARRAYS
!
      IF(NACA(6).EQ.A4HH)GO TO 1100
      IF(NACA(6).EQ.A4HV)GO TO 1110
      IF(NACA(6).EQ.A4HF)GO TO 1120
!
!     HERE FOR WING
!
      IF(WGIN(16).EQ.UNUSED)WGIN(16)=TOC
      IF(WGIN(18).EQ.UNUSED)WGIN(18)=XT
      IF(WGIN(70).EQ.UNUSED)WGIN(70)=TOC
      IF(WGIN(71).EQ.UNUSED)WGIN(71)=KSHARP
      IF(WGIN(62).EQ.UNUSED)WGIN(62)=0.
      IF(WGIN(15).NE.A4HSTR.AND.WGIN(63).EQ.UNUSED)WGIN(63)=0.0
      GO TO 1130
 1100 CONTINUE
!
!     HERE FOR HORIZONTAL TAIL
!
      IF(HTIN(16).EQ.UNUSED)HTIN(16)=TOC
      IF(HTIN(18).EQ.UNUSED)HTIN(18)=XT
      IF(HTIN(70).EQ.UNUSED)HTIN(70)=TOC
      IF(HTIN(71).EQ.UNUSED)HTIN(71)=KSHARP
      IF(HTIN(62).EQ.UNUSED)HTIN(62)=0.
      IF(HTIN(15).NE.A4HSTR.AND.HTIN(63).EQ.UNUSED)HTIN(63)=0.0
      GO TO 1130
 1110 CONTINUE
!
!     HERE FOR VERTICAL TAIL
!
      IF(VTIN(16).EQ.UNUSED)VTIN(16)=TOC
      IF(VTIN(18).EQ.UNUSED)VTIN(18)=XT
      IF(VTIN(70).EQ.UNUSED)VTIN(70)=TOC
      IF(VTIN(71).EQ.UNUSED)VTIN(71)=KSHARP
      IF(VTIN(62).EQ.UNUSED)VTIN(62)=0.
      IF(VTIN(15).NE.A4HSTR.AND.VTIN(63).EQ.UNUSED)VTIN(63)=0.0
      GO TO 1130
 1120 CONTINUE
!
!     HERE FOR VENTRAL FIN
!
      IF(VFIN(16).EQ.UNUSED)VFIN(16)=TOC
      IF(VFIN(18).EQ.UNUSED)VFIN(18)=XT
      IF(VFIN(70).EQ.UNUSED)VFIN(70)=TOC
      IF(VFIN(71).EQ.UNUSED)VFIN(71)=KSHARP
      IF(VFIN(62).EQ.UNUSED)VFIN(62)=0.
      IF(VFIN(15).NE.A4HSTR.AND.VFIN(63).EQ.UNUSED)VFIN(63)=0.0
 1130 CONTINUE
      DO 1140 IL=1,60
         YUU(IL)=YU(IL)
         YLL(IL)=YL(IL)
 1140 END DO
!
!     REST OF THE SUPERSONIC OUTPUTS ARE SET IN SECO
!
      RETURN
      END
      SUBROUTINE CSLOPE
!
!     CALCULATE VARIABLE SLOPE FOR WING
!
      COMMON /IHT/    PHT,XU(60),XL(60), dum3(260)
      COMMON /IBW/    PBW,LL, dum5(379)
      COMMON /IVT/    PVT,YU(60),YL(60), dum4(260)
      COMMON /WINGI/  WGIN(100)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLOLOG/ DD(6),HTPL
      EQUIVALENCE(ZW,SYNA(3)),(ZH,SYNA(7))
      DIMENSION WGINT(6),C(6),ROUT(2)
      LOGICAL HTPL
      DATA ROUT/4HCSLO, 4HPE   /
!
!     IF NO HORIZONTAL TAIL, RETURN
!
      DO 1000 I=1,6
 1000 WGINT(I)=UNUSED
      IF(.NOT.HTPL)RETURN
      IF(ZH.GT.ZW)GO TO 1010
!
!     HERE FOR HORIZONTAL TAIL BELOW THE WING
!
!     AT THE 0 PERCENT CHORD
!
      IN=0
      IF(WGIN(95).EQ.UNUSED)CALL TBFUNX(0.,Y,DYDX,LL,XL,YL,C,IN,MI,     &
     &   NG,0,0,4HCSLP,1,ROUT)
      IF(WGIN(95).EQ.UNUSED)WGINT(1)=-DYDX
!
!     AT THE 20 PERCENT CHORD
!
      IN=0
      IF(WGIN(96).EQ.UNUSED)CALL TBFUNX(.2,Y,DYDX,LL,XL,YL,C,IN,MI,     &
     &   NG,0,0,4HCSLP,1,ROUT)
      IF(WGIN(96).EQ.UNUSED)WGINT(2)=-DYDX
!
!     AT THE 40 PERCENT CHORD
!
      IN=0
      IF(WGIN(97).EQ.UNUSED)CALL TBFUNX(.4,Y,DYDX,LL,XL,YL,C,IN,MI,     &
     &   NG,0,0,4HCSLP,1,ROUT)
      IF(WGIN(97).EQ.UNUSED)WGINT(3)=-DYDX
!
!     AT THE 60 PERCENT CHORD
!
      IN=0
      IF(WGIN(98).EQ.UNUSED)CALL TBFUNX(.6,Y,DYDX,LL,XL,YL,C,IN,MI,     &
     &   NG,0,0,4HCSLP,1,ROUT)
      IF(WGIN(98).EQ.UNUSED)WGINT(4)=-DYDX
!
!     AT THE 80 PERCENT CHORD
!
      IN=0
      IF(WGIN(99).EQ.UNUSED)CALL TBFUNX(.8,Y,DYDX,LL,XL,YL,C,IN,MI,     &
     &   NG,0,0,4HCSLP,1,ROUT)
      IF(WGIN(99).EQ.UNUSED)WGINT(5)=-DYDX
!
!     AT THE 100 PERCENT CHORD
!
      IN=0
      IF(WGIN(100).EQ.UNUSED)CALL TBFUNX(1.,Y,DYDX,LL,XL,YL,C,IN,MI,    &
     &   NG,0,0,4HCSLP,1,ROUT)
      IF(WGIN(100).EQ.UNUSED)WGINT(6)=-DYDX
      GO TO 1020
 1010 CONTINUE
!
!     HERE FOR THE HORIZONTAL TAIL ABOVE THE WING
!
!     AT THE 0 PERCENT CHORD
!
      IN=0
      IF(WGIN(95).EQ.UNUSED)CALL TBFUNX(0.,Y,DYDX,LL,XU,YU,C,IN,MI,     &
     &   NG,0,0,4HCSLP,1,ROUT)
      IF(WGIN(95).EQ.UNUSED)WGINT(1)=DYDX
!
!     AT THE 20 PERCENT CHORD
!
      IN=0
      IF(WGIN(96).EQ.UNUSED)CALL TBFUNX(.2,Y,DYDX,LL,XU,YU,C,IN,MI,     &
     &   NG,0,0,4HCSLP,1,ROUT)
      IF(WGIN(96).EQ.UNUSED)WGINT(2)=DYDX
!
!     AT THE 40 PERCENT CHORD
!
      IN=0
      IF(WGIN(97).EQ.UNUSED)CALL TBFUNX(.4,Y,DYDX,LL,XU,YU,C,IN,MI,     &
     &   NG,0,0,4HCSLP,1,ROUT)
      IF(WGIN(97).EQ.UNUSED)WGINT(3)=DYDX
!
!     AT THE 60 PERCENT CHORD
!
      IN=0
      IF(WGIN(98).EQ.UNUSED)CALL TBFUNX(.6,Y,DYDX,LL,XU,YU,C,IN,MI,     &
     &   NG,0,0,4HCSLP,1,ROUT)
      IF(WGIN(98).EQ.UNUSED)WGINT(4)=DYDX
!
!     AT THE 80 PERCENT CHORD
!
      IN=0
      IF(WGIN(99).EQ.UNUSED)CALL TBFUNX(.8,Y,DYDX,LL,XU,YU,C,IN,MI,     &
     &   NG,0,0,4HCSLP,1,ROUT)
      IF(WGIN(99).EQ.UNUSED)WGINT(5)=DYDX
!
!     AT THE 100 PERCENT CHORD
!
      IN=0
      IF(WGIN(100).EQ.UNUSED)CALL TBFUNX(1.,Y,DYDX,LL,XU,YU,C,IN,MI,    &
     &   NG,0,0,4HCSLP,1,ROUT)
      IF(WGIN(100).EQ.UNUSED)WGINT(6)=DYDX
 1020 CONTINUE
      DO 1030 I=1,6
         A=WGINT(I)
         IF(A.EQ.UNUSED)GO TO 1030
         WGIN(I+94)=ATAN(A)*RAD
 1030 END DO
      RETURN
      END
      SUBROUTINE CTABS
!
!***  CONTROL TAB METHODS
!
      REAL KS,KQ,MACH
      COMMON /IBW/    PBW,    BW(380)
      COMMON /IBH/    PBH,    BH(380)
      COMMON /IBV/    PBV,    BV(380)
      COMMON /IBWH/   PBWH,   BWH(380)
      COMMON /IBWHV/  PBWHV,  BWHV(380)
      COMMON /FLGTCD/ NNNNN,MMMMMM,MACH(20),ALPHA(20),RNNUB(20),NGH     &
     &                ,GRDHT(10),PINF(20),STMACH,TSMACH,TR,ALT(20)      &
     &                ,TINF(20),VINF(20),WT,GAMMA,NALT,LOOP
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /FLAPIN/ F(116),TTYPE,CFITC,CFOTC,BITC,BOTC,CFITT,CFOTT,   &
     &                BITT,BOTT,B1,B2,B3,B4,D1,D2,D3,GCMAX,             &
     &                KS,RL,BGR,DELR
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,II,NALPHA,IG,NF,LF,K
      DIMENSION CHCTF(20,9),CHCTL(20,9),DELT(9),DCHCG(20,9)
      DIMENSION DTT(20,9),CFC(20,9),FC(20,9)
      EQUIVALENCE (FC(1,1),CFC(1,1),BW(201)),(CHCTF(1,1),BH(201)),      &
     &            (CHCTL(1,1),BV(201)),(DCHCG(1,1),BWH(201)),           &
     &            (DELT(1),F(1)),(DTT(1,1),BWHV(201))
!
!***  CALCULATE R1 AND R2
!
      STC=(CFITC+CFOTC)*(BOTC-BITC)
      CTC=2.0*(CFITC+CFOTC-CFITC*CFOTC/(CFITC+CFOTC))/3.0
      AC=STC*CTC/(SREF*CBARR)
      Q=0.0
      KQ=0.0
      IF(PINF(II) .EQ. UNUSED) GO TO 1000
         Q=0.7*PINF(II)*MACH(II)**2
         KQ=KS/Q
 1000 CONTINUE
      IF(RL .GE. 0.0) GO TO 1010
         R1 = 0.0
         R2 = 1.0
 1010 CONTINUE
      IF(RL .NE. 0.0) GO TO 1020
         D = B2/(AC*D2)+KQ*BGR/D2
         R1 = DELR/D
         R2 = -R1*(KQ/D2)
 1020 CONTINUE
      IF(RL .LE. 0.0) GO TO 1030
         D = RL+B2/(AC*D2)-KQ*(RL-BGR)/D2
         R1 = (RL+DELR)/D
         R2 = -R1*(KQ/D2)
 1030 CONTINUE
!
!***  CALCULATE CONTROL FORCE
!
      ITYPE = TTYPE+0.5
      DO 1050 I=1,NALPHA
         NDELTA = F(16)+0.5
         DO 1040 J=1,NDELTA
            CHCTF(I,J) = (B1+D1*B2/D2)*DELT(J)+(B3-D3*B2/D2)*ALPHA(I)
            CHCTL(I,J) = B1*DELT(J)+B3*ALPHA(I)
            DCHCG(I,J) = (BGR*B2+BGR*AC*D1+BGR*BGR*AC*D2)*DELT(J)       &
     &                   + BGR*AC*D3*ALPHA(I)
            CFC(I,J) = GCMAX*(R1*CHCTF(I,J)+R2*CHCTL(I,J)+R2*DCHCG(I,J))
            IF(ITYPE .EQ. 2) DTT(I,J) = -(B1*DELT(J)+B3*ALPHA(I))/B4
            IF(ITYPE .EQ. 3) DTT(I,J) = CFC(I,J)/(B4*(R1+R2)*GCMAX)
            IF(Q .GT. 0.0)   FC(I,J) = CFC(I,J)/(Q*SREF*CBARR)
 1040    CONTINUE
 1050 END DO
      RETURN
      END
!+
      PROGRAM DATCOM
! ----------------------------------------------------------------------
! modified 13 Dec 2001 by Public Domain Aeronautical Software to
! ask for input file name
! modified 21 Dec 2004 to correct an error in PRPWEF and defend against
! possible square root of negative argument. 
! Thanks to Remzi Barlas for the debugging effort.
! Old subroutine named EXIT was changed to CloseFiles to prevent any 
! conflict with EXIT keyword.


! REFERENCE - AFFDL-TR-79-3032
!    NTIS Document # ADA-086557

!***  NOTE - THE FOLLOWING THREE CARDS ARE REQUIRED FOR CYBER

!     PROGRAM DATCOM(INPUT=100,OUTPUT,TAPE5=INPUT,TAPE6=OUTPUT,
!    1               TAPE8=100,TAPE9=100,TAPE10=100,TAPE11=100,
!    2               TAPE12,TAPE13,TAPE14)





!     ----DATCOM MAIN PROGRAM


!***  IDEAL OUTPUT MATRIX

!             BLOCK    PRINT     IOM
!             NAME     FLAG     ARRAY

      COMMON /IBODY/   PBODY,  BODY(400)
      COMMON /IWING/   PWING,  WING(400)
      COMMON /IHT/     PHT,    HT(380)
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
      COMMON /IBWH/    PBWH,   BWH(380)
      COMMON /IBWV/    PBWV,   BWV(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
      COMMON /IPOWER/  PPOWER, POWER(200)
      COMMON /IDWASH/  PDWASH, DWASH(60)

      LOGICAL PBODY, PWING, PHT, PVT, PVF, PBW, PBH, PBV, PBWH, PBWV
      LOGICAL PBWHV, PPOWER, PDWASH

!***  INPUT DATA BLOCKS

      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF, IRUN
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /BODYI/  BODYIN(129)
      COMMON /WINGI/  WINGIN(101)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /HTI/    HTIN(154)
      COMMON /POWER/  PWIN(29), LBIN(21)
      COMMON /FLAPIN/ F(138)

      DIMENSION MACH(20), VINF(20), ALT(20), PINF(20), TINF(20)
      DIMENSION ZL(20), RNNUB(20)
      EQUIVALENCE (ZL(1),BODYIN(102))
      EQUIVALENCE (FLC(3),MACH(1)), (FLC(43),RNNUB(1)), (FLC(97),ALT(1))
      EQUIVALENCE (FLC(117),TINF(1)), (FLC(137),VINF(1))
      EQUIVALENCE (FLC(74),PINF(1))
      LOGICAL VERTUP
      REAL MACH

!***  COMPUTATIONAL BLOCKS

      COMMON /WINGD/  A(195), B(49)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /BDATA/  BD(762)
      COMMON /WHWB/   FACT(182), WB(39), HB(39)
      COMMON /WBHCAL/ WBT(156)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55), DVF(55)
      COMMON /POWR/   PW(315)
      COMMON /SUPWBB/  SWB(61), SHB(61)
      COMMON /SUPDW/  DWA(237)
      COMMON /SUPWH/  GR(303)
      COMMON /SUPBOD/ SBD(229)
      COMMON /LEVEL2/ SECOND(23)

      DIMENSION SLG(141), STG(141), FCM(287), LB(200), DYN(213)
      DIMENSION SPR(59),FLA(45), FLP(189), STP(156), JET(26), SLA(31)
      DIMENSION FHG(35), TCD(58), TRM(22), TRM2(22), TRN(7), DYNH(213)
      DIMENSION SLAH(31)

      EQUIVALENCE (GR(1), FCM(1), SLG(1)), (GR(142), STG(1))
      EQUIVALENCE (DWA(1), LB(1), JET(1), FHG(1)), (WBT(1), STP(1))
      EQUIVALENCE (PW(1), DYN(1), SPR(1)), (PW(60), FLA(1))
      EQUIVALENCE (PW(105), FLP(1)), (PW(294), TRM(1), TRM2(1), TRN(1))
      EQUIVALENCE (STB(1), SLA(1)), (DWA(36), TCD(1)), (DYNH(1),BD(301))
      EQUIVALENCE (STB(32), SLAH(1))

!***   CONTROL DATA BLOCKS

      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K,NOVLY
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),IDIM
      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,          &
     &                KBODY, KWING, KHT, KVT, KWB, KDWASH(3),           &
     &                ALPOW, ALPLW, ALPOH, ALPLH
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB,PLOT
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH,LIST

      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB,PLOT
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH,LIST

      LOGICAL IM, IRN, IATM
      INTEGER:: errCode
      CHARACTER(LEN=132):: fileName
!----------------------------------------------------------------------------
      WRITE(*,*) 'Digital Datcom'
      DO
        WRITE(*,*) 'Enter the input file name:'
        READ(*,'(A)') fileName
        IF (fileName == ' ') STOP
        OPEN(UNIT=5,  FILE=fileName, STATUS='OLD',                              &
     &    IOSTAT=errCode, ACTION='READ', POSITION='REWIND')
        IF (errCode == 0) EXIT
        WRITE(*,*) "Unable to open this file. Try again"
      END DO    
      
      OPEN(UNIT=6,  FILE='datcom.out', STATUS='REPLACE', ACTION='WRITE')
      OPEN(UNIT=8,  STATUS='SCRATCH', ACTION='READWRITE')
      OPEN(UNIT=9,  STATUS='SCRATCH', ACTION='READWRITE')
      OPEN(UNIT=10, STATUS='SCRATCH', ACTION='READWRITE')
      OPEN(UNIT=11, STATUS='SCRATCH', ACTION='READWRITE')
      OPEN(UNIT=12, STATUS='SCRATCH', ACTION='READWRITE')
      OPEN(UNIT=13, FILE='for013.dat', STATUS='REPLACE')
      OPEN(UNIT=14, FILE='for014.dat', STATUS='REPLACE')

!  DISCLAIMER REQUIRED BY HQ USAF FOR PUBLIC RELEASE APPROVAL

      PRINT*,'THIS SOFTWARE AND ANY ACCOMPANYING DOCUMENTATION'
      PRINT*,'IS RELEASED "AS IS".  THE U.S. GOVERNMENT MAKES NO'
      PRINT*,'WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, CONCERNING'
      PRINT*,'THIS SOFTWARE AND ANY ACCOMPANYING DOCUMENTATION,'
      PRINT*,'INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OF'
      PRINT*,'MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.'
      PRINT*,'IN NO EVENT WILL THE U.S. GOVERNMENT BE LIABLE FOR ANY'
      PRINT*,'DAMAGES, INCLUDING LOST PROFITS, LOST SAVINGS OR OTHER'
      PRINT*,'INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE '
      PRINT*,'USE, OR INABILITY TO USE, THIS SOFTWARE OR ANY'
      PRINT*,'ACCOMPANYING DOCUMENTATION, EVEN IF INFORMED IN ADVANCE'
      PRINT*,'OF THE POSSIBILITY OF SUCH DAMAGES.'


      WRITE(6,*) " ****************************************************"
      WRITE(6,*) " *    USAF STABILITY AND CONTROL  DIGITAL DATCOM    *"
      WRITE(6,*) " *    PROGRAM REV. JAN 96   DIRECT INQUIRIES TO:    *"
      WRITE(6,*) " *    WRIGHT LABORATORY  (WL/FIGC)  ATTN: W. BLAKE  *"
      WRITE(6,*) " *      WRIGHT PATTERSON AFB, OHIO  45433           *"
      WRITE(6,*) " *    PHONE (513) 255-6764,   FAX (513) 258-4054    *"
      WRITE(6,*) " ****************************************************"

!***  CASE INITIALIZATION AND READ INPUTS

      IRUN  = 0
      NLOG  = 34
      IDIM  = 1
      IEND  = .FALSE.
      SAVE  = .FALSE.
      FIRST = .TRUE.
      REWIND 12
      REWIND 13

      WRITE(*,*) "Preparing to start the big loop"
      WRITE(*,*) "At 1000"

                     ! start of big loop
 1000 CALL M01O01
      WRITE(*,*) "Return to main program from M01O01"

                      ! airfoil section module (overlay 50)
      CALL M50O62
      WRITE(*,*) "Return to main program from M50O62"

      IF(ASYFP) THEN
        TRIMC = .FALSE.
        TRIM  = .FALSE.
      END IF

!***  CATALOG EXPERIMENTAL DATA NAMELISTS, SET CASE DATA

      IF (KLIST .GT. 0) THEN
        CALL M34O42
        WRITE(*,*) "Return to main program from M01O01"
      END IF

      NALPHA = FLC(2)+0.5
      NMACH  = FLC(1)+0.5
      LOOP   = FLC(160)+0.5
      NALT   = FLC(159)+0.5
      IF(ROUGFC .LT. 1.E-10) ROUGFC = 1.6E-4
      IF(BLREF .EQ. UNUSED)  BLREF  = 2.0*WINGIN(4)

!***  SET LIFTING SURFACE PARAMETERS FOR SUBSONIC AND TRANSONIC MACHS

      CALL M02O02
      WRITE(*,*) "Return to main program from M02O02"

      IF(.NOT. (SUBSON .OR. TRANSN)) GO TO 1020
        IF(WGPL) CALL CLMCH0(A,B,WINGIN(21),WINGIN(41),WINGIN(68),      &
     &                       WINGIN(69),WING,0)
        IF(HTPL) CALL CLMCH0(AHT,BHT,HTIN(21),HTIN(41),HTIN(68),        &
     &                       HTIN(69),HT,1)
 1020 CONTINUE

      IG = 1
      CALL M51O63
      WRITE(*,*) "Return to main program from M51O63"

      IM   = FLC(3) .NE. UNUSED
      IRN  = FLC(43) .NE. UNUSED
      IATM = (FLC(97) .NE. UNUSED) .OR.                                 &
     &       ((FLC(117) .NE. UNUSED) .AND. (FLC(74) .NE. UNUSED))

!***  LOOP MACH AND ALTITUDE TOGETHER -- LOOP = 1

      IF(LOOP .NE. 1) GO TO 1040
        DO 1030 I=1,NMACH
          K = I
          IF(IM .AND. IATM) VINF(I) = MACH(I)*49.01685*SQRT(TINF(K))
          IF(.NOT. IM)      MACH(I) = VINF(I)/(49.01685*SQRT(TINF(K)))
          IF(.NOT. IRN)    RNNUB(I) = 1.2527E6*PINF(K)*MACH(I)*         &
     &                                (TINF(K)+198.6)/(TINF(K)**2)
          IF(VINF(I) .EQ. UNUSED) VINF(I) = -UNUSED
          IF(ALT(K)  .EQ. UNUSED) ALT(K)  = -UNUSED
          IF(PINF(K) .EQ. UNUSED) PINF(K) = -UNUSED
          IF(TINF(K) .EQ. UNUSED) TINF(K) = -UNUSED
          CALL MAIN00
 1030   CONTINUE

 1040 CONTINUE

!***  FIX ALTITUDE AND VARY MACH -- LOOP = 2

      IF(LOOP .NE. 2) GO TO 1070
        DO 1060 K=1,NALT
          DO 1050 I=1,NMACH
            IF(IM .AND. IATM) VINF(I) = MACH(I)*49.01685*SQRT(TINF(K))
            IF(.NOT. IM)      MACH(I) = VINF(I)/(49.01685*SQRT(TINF(K)))
            IF(.NOT. IRN)    RNNUB(I) = 1.2527E6*PINF(K)*MACH(I)*       &
     &                                  (TINF(K)+198.6)/(TINF(K)**2)
            IF(VINF(I) .EQ. UNUSED) VINF(I) = -UNUSED
            IF(ALT(K)  .EQ. UNUSED) ALT(K)  = -UNUSED
            IF(PINF(K) .EQ. UNUSED) PINF(K) = -UNUSED
            IF(TINF(K) .EQ. UNUSED) TINF(K) = -UNUSED
            CALL MAIN00
 1050     CONTINUE
 1060   CONTINUE
 1070 CONTINUE

!***  FIX MACH AND VARY ALTITUDE -- LOOP = 3

      IF(LOOP .NE. 3) GO TO 1100
        DO 1090 I=1,NMACH
          DO 1080 K=1,NALT
            IF(IM .AND. IATM) VINF(I) = MACH(I)*49.01685*SQRT(TINF(K))
            IF(.NOT. IM)      MACH(I) = VINF(I)/(49.01685*SQRT(TINF(K)))
            IF(.NOT. IRN)    RNNUB(I) = 1.2527E6*PINF(K)*MACH(I)*       &
     &                                  (TINF(K)+198.6)/(TINF(K)**2)
            IF(VINF(I) .EQ. UNUSED) VINF(I) = -UNUSED
            IF(ALT(K)  .EQ. UNUSED) ALT(K)  = -UNUSED
            IF(PINF(K) .EQ. UNUSED) PINF(K) = -UNUSED
            IF(TINF(K) .EQ. UNUSED) TINF(K) = -UNUSED
            CALL MAIN00
 1080     CONTINUE
 1090   CONTINUE
 1100 CONTINUE

!***  DUMP EXTRAPOLATION MESSAGES FOR CASE

      CALL M57O71
      WRITE(*,*) "Return to main program from M57O71"

      GO TO 1000                        
      END Program Datcom   ! ===========================================

      SUBROUTINE DECFIG(IFIG,N,IFIGN)
!
!   SUBROUTINE TO READ HOLLERITH FIGURE NUMBER AND TRANSLATE
!   INTO A NINE CHARACTER INTEGER WORD
!
      LOGICAL LAST,IALPHA,ILET,ILETT
      INTEGER BLANK,COMMA,POINT
      DIMENSION IFIG(N)
      DIMENSION NUM(10),LET(26)
      DATA NUM/4H0   , 4H1   , 4H2   , 4H3   , 4H4   , 4H5   ,          &
     &         4H6   , 4H7   , 4H8   , 4H9   /
      DATA LET/4HA   , 4HB   , 4HC   , 4HD   , 4HE   , 4HF   ,          &
     &         4HG   , 4HH   , 4HI   , 4HJ   , 4HK   , 4HL   ,          &
     &         4HM   , 4HN   , 4HO   , 4HP   , 4HQ   , 4HR   ,          &
     &         4HS   , 4HT   , 4HU   , 4HV   , 4HW   , 4HX   ,          &
     &         4HY   , 4HZ   /
      DATA BLANK,POINT,MINUS,COMMA/4H    , 4H.   , 4H-   , 4H,   /
      LAST=.FALSE.
      IALPHA=.FALSE.
      ILET=.FALSE.
      ILETT=.FALSE.
      IFIGN=0
      NCOUNT=0
      NSAVE=0
      KFIGN=0
      DO 1040 I=1,N
         IF(I.EQ.2.AND.ILET)ILETT=.TRUE.
         IF(IFIG(I).EQ.BLANK .OR. IFIG(I).EQ.POINT                      &
     &      .OR. IFIG(I).EQ.COMMA) GO TO 1040
         IF(IFIG(I).EQ.MINUS .AND. LAST) GO TO 1040
         IF(IFIG(I).EQ.MINUS) LAST=.TRUE.
         IF(IFIG(I).EQ.MINUS) GO TO 1030
         DO 1000 J=1,10
            NN=J-1
            IF(IFIG(I).EQ.NUM(J)) GO TO 1020
 1000    CONTINUE
         IF(.NOT. LAST)IALPHA=.TRUE.
         IF(.NOT. LAST)NCOUNT=NCOUNT+1
         IF(ILET)GO TO 1040
         IF(LAST)ILET=.TRUE.
         DO 1010 J=1,26
            NN=J
            IF(IFIG(I).EQ.LET(J)) GO TO 1020
 1010    CONTINUE
         ILET=.FALSE.
         GO TO 1040
 1020    CONTINUE
         IF(ILET)KFIGN=NN
         IF(ILET.AND.ILETT)GO TO 1040
         NCOUNT=NCOUNT+1
         IF(IALPHA .AND. NCOUNT.GT.8)GO TO 1040
         IF(NCOUNT .GT. 8) NCOUNT=8
         IFIGN=IFIGN+NN*10**(9-NCOUNT)
         GO TO 1040
 1030    NCOUNT=4
         NSAVE=IFIGN
 1040 END DO
!
!   POST-PROCESS FIGURE NUMBER
!
      JFIGN=IFIGN-NSAVE
      IF(NCOUNT.EQ.5)JFIGN=JFIGN/100
      IF(NCOUNT.EQ.6)JFIGN=JFIGN/10
      IFIGN=NSAVE+JFIGN+KFIGN
      RETURN
      END
      SUBROUTINE DECODE(NACA,NA)
!
!***  READ USER INPUT NACA DESIGNATION AND DECODE
!
      COMMON /IWING/ PW, X(60),dum13(340)
      COMMON / IBW / PBW,LLL,IUM(10)
      LOGICAL IEQL,IPOINT
      INTEGER A4H1,A4H4,A4H5,A4H6,A4HS
      DIMENSION NACA(80),LET(6),IVAL(10),NUM(10)
      DATA LET / 4H    , 4HA   , 4H-   , 4H=   , 4H.   , 4H,   /
      DATA NUM / 4H1   , 4H2   , 4H3   , 4H4   , 4H5   ,                &
     &           4H6   , 4H7   , 4H8   , 4H9   , 4H0   /
      DATA IVAL/1,2,3,4,5,6,7,8,9,0/
      DATA A4H1,A4H4,A4H5,A4H6,A4HS/4H1   ,4H4   ,4H5   ,4H6   ,4HS   /
!
      IEQL=.FALSE.
      IPOINT=.FALSE.
      IF(NACA(8).EQ.A4H1)NA=5
      IF(NACA(8).EQ.A4H4)NA=1
      IF(NACA(8).EQ.A4H5)NA=3
      IF(NACA(8).EQ.A4H6)NA=6
      IF(NACA(8).EQ.A4HS)NA=7
      JCOUNT=0
      ICOUNT=0
      DO 1000 L=1,10
 1000 IUM(L)=IVAL(10)
      IF(NA.EQ.6) GO TO 1030
      IF(NA.EQ.7)GO TO 1060
      DO 1020 ICOL=10,80
      ICOUNT=ICOUNT+1
      IF(ICOUNT.GT.10) GO TO 1120
      DO 1010 INUM=1,10
         IF(NACA(ICOL).EQ.NUM(INUM)) IUM(ICOUNT)=IVAL(INUM)
 1010 END DO
      IF(NACA(ICOL).EQ.LET(1)) ICOUNT=ICOUNT-1
      IF(NACA(ICOL).EQ.LET(3).AND.NA.NE.5) NA=NA+1
      IF(NACA(ICOL).EQ.LET(5)) ICOUNT=ICOUNT-1
 1020 END DO
      GO TO 1120
 1030 DO 1050 ICOL=10,80
         ICOUNT=ICOUNT+1
         IF(ICOUNT.GT.8) GO TO 1120
         DO 1040 INUM=1,10
            IF(NACA(ICOL).EQ.NUM(INUM)) IUM(ICOUNT)=IVAL(INUM)
 1040    CONTINUE
         IF(ICOUNT.EQ.3.AND.NACA(ICOL).EQ.LET(2)) ICOUNT=ICOUNT+1
         IF(ICOUNT.EQ.4.AND.NACA(ICOL).EQ.LET(2)) IUM(ICOUNT)=IVAL(1)
         IF(ICOUNT.GT.4.AND.NACA(ICOL).EQ.LET(2)) ICOUNT=ICOUNT-1
         IF(NACA(ICOL).EQ.LET(1)) ICOUNT=ICOUNT-1
         IF(NACA(ICOL).EQ.LET(6)) ICOUNT=ICOUNT-1
         IF(NACA(ICOL).EQ.LET(3).AND.ICOUNT.EQ.3) ICOUNT=ICOUNT+1
         IF(NACA(ICOL).EQ.LET(4)) IEQL=.TRUE.
         IF(IEQL.AND..NOT.IPOINT) ICOUNT=ICOUNT-1
         IF(NACA(ICOL).EQ.LET(1).AND.IEQL.AND..NOT.IPOINT)              &
     &      ICOUNT=ICOUNT+1
         IF(NACA(ICOL).EQ.LET(5)) IPOINT=.TRUE.
 1050 END DO
      GO TO 1120
 1060 CONTINUE
      ICOUNT=0
      NCOUNT=2
      DO 1110 ICOL=10,80
         IF(ICOUNT.EQ.10)GO TO 1110
         IF(NACA(ICOL).EQ.LET(1).AND.ICOL.EQ.80)GO TO 1090
         IF(NACA(ICOL).EQ.LET(1))GO TO 1110
         DO 1070 INUM=1,10
            IF(NACA(ICOL).NE.NUM(INUM))GO TO 1070
            NCOUNT=NCOUNT+1
            IF(NCOUNT.GT.3)GO TO 1110
            ICOUNT=ICOUNT+1
            IUM(ICOUNT)=IVAL(INUM)
            GO TO 1080
 1070    CONTINUE
         IF(NACA(ICOL).EQ.LET(3).AND.ICOUNT.GT.0)GO TO 1090
         IF(NACA(ICOL).EQ.LET(5).AND.ICOUNT.GT.0)GO TO 1100
 1080    IF(ICOL.EQ.80)GO TO 1090
         GO TO 1110
 1090    CONTINUE
         IF(NCOUNT.EQ.0)ICOUNT=ICOUNT+3
         IF(NCOUNT.EQ.1)IUM(ICOUNT+1)=IUM(ICOUNT)
         IF(NCOUNT.EQ.1)IUM(ICOUNT)=0
         IF(NCOUNT.EQ.1)ICOUNT=ICOUNT+2
         IF(NCOUNT.EQ.2)ICOUNT=ICOUNT+1
         IF(ICOUNT.EQ.1)NCOUNT=0
         IF(NCOUNT.GT.0)NCOUNT=0
         GO TO 1110
 1100    CONTINUE
         IF(NCOUNT.EQ.0)ICOUNT=ICOUNT+2
         IF(NCOUNT.EQ.0)NCOUNT=2
         IF(NCOUNT.EQ.1)IUM(ICOUNT+1)=IUM(ICOUNT)
         IF(NCOUNT.EQ.1)IUM(ICOUNT)=0
         IF(NCOUNT.EQ.1)ICOUNT=ICOUNT+1
         IF(NCOUNT.EQ.1)NCOUNT=2
 1110 END DO
 1120 CONTINUE
!
!  GET X-COORDINATES WHERE AIRFOIL COORDINATES ARE TO BE CALCULATED
!    X SPACING IS CLOSEST IN THE NEIGHBORHOOD OF THE L.E.
!
      DELX=0.00100
      X(1)=0.0
      DO 1130 LI=2,60
         LLL=LI
         X(LI)=X(LI-1)+DELX
         IF(X(LI) .GE. .01) DELX=.01
         IF(X(LI) .GT. .29) DELX=.05
         IF(X(LI) .GT. .79) DELX=.02
         IF(X(LI) .GE. 1.0) GO TO 1140
 1130 END DO
 1140 CONTINUE
      X(LLL)=1.0
      RETURN
      END
      SUBROUTINE DELY
!
!  CALCULATE THE PARAMETER DELTAY
!
      COMMON /IWING/ PW, X(60),dum13(340)
      COMMON / IBW / PBW,L
      COMMON / IBH / PBH, THN(60),CAM(60), dum6(260)
      COMMON /IBWHV/ PBWHV, RHO,TMAX,DELTAY
      DIMENSION C1(6),C2(6),ROUT(2),NAME(1)
      DATA ROUT / 4HM50O, 4H62  /
      DATA NAME /4HDELY/
      IN1=0
      IN2=0
      CALL TBFUNX(.0015,YU15,D,L,X ,THN,C1,IN1,MI,NG,0,0,NAME,1,ROUT)
      CALL TBFUNX(.0600,YU60,D,L,X ,THN,C2,IN2,MI,NG,0,0,NAME,1,ROUT)
      DELTAY=(YU60-YU15)*100.
      RETURN
      END
      SUBROUTINE DET4(A,D)
!
!     ----COMPUTES 4X4 DETERMINANT
!
      DIMENSION A(16),A3(9)
      P=0.
      DO 1020 M=1,4
         ISKP=M+4
         KK=1
         K=1
         DO 1010 I=5,16
            IF(I.NE.ISKP)GO TO 1000
            ISKP=ISKP+4
            GO TO 1010
 1000       A3(K)=A(I)
            K=K+1
 1010    KK=KK+1
         PP=A3(1)*(A3(5)*A3(9)-A3(6)*A3(8))-A3(2)*(A3(4)*A3(9)-A3(6)    &
     &      *A3(7))+ A3(3)*(A3(4)*A3(8)-A3(5)*A3(7))
         IF(M.EQ.2.OR.M.EQ.4) PP=-PP
 1020 P=P+A(M)*PP
      D=P
      RETURN
      END
      SUBROUTINE DFLCON(AA,DD,AFORLF,BETA,INBORD,TAPERD)
!
!***  CALCULATES SUPERSONIC LIFT, ROLL MOMENT AND HINGE MOMENT
!     DERIVATIVES
!
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /POWR/   SPR(59)
      LOGICAL INBORD,TAPERD
      DIMENSION P(2),TCP(2),PA(2),TCPA(2),PB(2),RCPB(2),PC(2),TCPC(2)
      DIMENSION PR(16)
      EQUIVALENCE (SPR(12),CLD),(SPR(13),CLLD),(SPR(17),CMD),           &
     &            (SPR(18),CHD)
      EQUIVALENCE (PSL1,PR(1 )),(PSLX1,PR(2)),(PSLY1,PR(3)),(PSLX1A,    &
     &            PR(4)),(PSLX1B,PR(5)),(PSLX1C,PR(6)),(PSL2,PSL3,      &
     &            PR(7)),(PSLY2,PSLY3,PR(8)),(PSLX2A,PSLX3A,PR(9)),     &
     &           (PSLX2B,PSLX3B,PR(10)),(PSLX2C,PSLX3,PR(11)),(PSLX2,   &
     &            PR(12)),(PSL1A,PR(13)),(PSL1B,PR(14)),(PSLY1A,PR(15)) &
     &          ,(PSLY1B,PR(16))
!
      SQRA(X)=SQRT(ABS(X))
      P(1)=0.5
      P(2)=0.5
      P3=0.5
      A=AA
      D=DD
      TWO3RD=2./3.
      A2=A**2
      OPA2=1.+A2
      OMA2=1.-A2
      TCP0OD=4./(RAD*BETA*SQRA(OMA2))
      A4=A2**2
      SQ3=SQRA(OMA2)
      OMA4=1.-A4
      IF(.NOT.TAPERD)GO TO 1110
      FLD=AFORLF
!
!     ----HERE FOR TAPERED
!
      IF(ABS(D).LE.1.0)GO TO 1000
      GO TO 1320
 1000 IF(FLD.EQ.0.0)  FLD=1.E-04
      D2=D**2
      OMD2=1.-D2
      SQ1=SQRA(OMA2*OMD2)
      SQ2=SQRA(OMA2/OMD2)
      OPD2=1.+D2
      SAVFLD=FLD
      DO 1080 K=1,2
         APD=A+D
         OPA=1.+A
         OPD=1.+D
         AMD=A-D
         OMA=1.-A
         OMD=1.-D
         FLD2=FLD**2
         AD=A*D
         OPAD=1.+AD
         OMAD=1.-AD
         OMFLD=1.-FLD
         AMD2=AMD**2
!
!     ----SIGN LOGIC
!
         IF(AMD.LT.0.0)GO TO 1020
         SIGN=-1.
         SIGN2=1.
         GO TO 1030
 1020    SIGN=1.
         SIGN2=-1.
!
!     ----COMPUTE INTERMEDIATE STUFF.
!
 1030    G1=1./(FLD*OMD-OMA)
         G2=FLD*OMAD
         G3=FLD*AMD
         G4=FLD/PI*ARCCOS((OMA2-G2)/G3)
         G5=SQ2/PI*ARCCOS((OMAD-FLD*OMD2)/AMD)
         G6=2.*FLD*OMAD-FLD2*OMD2-OMA2
         G7=OMFLD*SQ3/PI*ALOG(ABS((A-FLD*D+SIGN*SQRA(G6))/OMFLD))
         G8=ARCCOS(D)/PI
         G9=ARCCOS(A)/PI
         G10=1.+3.*(AD-D2)-AD*D2
         G11=OPD/OMD*(OMA2*OMD2-2.*D*OMA**2)
         G115=.5/(FLD*OMD-OMA)
         G12=G115/OPD
         G13=AMD*OPD
         G14=2.*FLD*OPAD
         G15=SQRA(OMA2*G6)/PI
         G16=1./(OPD*AMD2)
         G17=SQ2*(1.-G8)
         P(K)=.5*(SQ1-OMA*OPD)/AMD
         PA(K)=OMD*G1*(G4-G5)
         PB(K)=(AMD*G4+G7)*G1
         PC(K)=OMD/AMD*(G17+G9-OMA/OMD)
         TCP(K)=.25/(P(K)*AMD2)*(SQ2*G10-G11)
         TCPA(K)=G12/(PA(K)*AMD)*(OMD2*(2.*OPAD-FLD*OPD2)*G4-G5*G10+    &
     &           SIGN*OPD2*G15)
         RCPB(K)=G115/PB(K)*(AMD*(2.*A-FLD*APD)*G4/OMFLD+SIGN *G15+A*G7)
         TCPC(K)=.5*G16/PC(K)*(G10*G17+AMD*OPD2*SQ3/PI-G11+OMD2*(1.+2.* &
     &           AD-D2)*G9)
         IF(K.EQ.2)GO TO 1070
!
!     ----BYPASS 3S IF CONTROL INBOARD OF WING TIP.
!
         IF(INBORD)GO TO 1040
         T2=2.+A+D
         SQ4=SQRA(OPA*OPD)
         T1=1.0/(OPD-FLD*OPA)
         T3=ARCCOS((T2-2.*FLD*OPA)/AMD)/PI
         T4=FLD*ARCCOS((2.*OPD-FLD*T2)/(FLD*AMD))/PI
         T45=OMFLD*(FLD*OPA-OPD)
         SQ5=2.*SQRA(OPA*T45)/PI
         T5=(2.- AMD)*OMD2+2.*(AD*OPD+D*OPA)
         P3=(OPA-SQ4)/AMD
         P3A=T1*(OPD*T3-SQ4*T4)
         P3B=-T1*(AMD*T3+SIGN *SQ5)
         TCP3=.25*G16/P3 *(SQ4*T5-2.*(OMA2*OMD2+2.*D*(OPA**2)))
         TCP3A=-.25*T1/AMD*(2.*OPD/FLD*(2.*FLD*(1.+AD)-OPD2)*T3+SIGN2*  &
     &         OPD2*SQ5-T4*SQRA(OPA/OPD)*T5) /P3A
         RCP3B=1./(6.*P3B*T45)*(3.*AMD*(2.*A*FLD-(A+D))*T3+SIGN2*(2.*   &
     &         FLD*(1.-2.*A)-(2.-3.*A-D))*SQ5)
 1040    OPFLD=1.+FLD
         OMFLD2=1.-FLD2
         SL1=2.*AMD/(OMFLD2*OMD2)
         SL2=FLD2*SL1
         SL1A=FLD*OMD-OMA
         SL1B=SL1A/(OPFLD*AMD)
         SL1A=SL1A/(OMFLD2*OMD)
         SL3=.5*OMD2*SL2/OPD
         SL0=(OMA/OMD-FLD2*OPA/OPD)/OMFLD2
         H1=TWO3RD*AMD/(OMFLD*OPD2)
         SLBY1=SL1*H1*(TCP(1)-D)
         SLBY1A=SL1A*H1*(TCPA(1)-D)
         SLBY1B=TWO3RD*SL1B
         IF(INBORD)GO TO 1050
         SLBY3=SL3*(1.-H1*FLD*(TCP3+D))
 1050    SLY0=(OPA*OMFLD-AMD2*AMD/((OMFLD*OMD)**2)-(OPD-FLD*OPA)**3/    &
     &        ((OMFLD*OPD)**2))/(3.*AMD*OPFLD)
         FLD3=FLD2*FLD
         OMFLD3=1.-FLD3
         RAT=OMFLD2/OMFLD3
         RAT1=RAT/OPD2
         RAT2=AMD/(OMFLD3*OPD2)
         RAT3=1./(OMFLD3*OPD*OPD2)
         SLX0=.5*((OMA/OMD)**2-FLD3*(OPA/OPD)**2)/OMFLD3
         SLBX1=SL1*RAT1*(OPAD-AMD*TCP(1))
         SLBX1A=SL1A*RAT1*(OPAD-AMD*TCPA(1))
         SLBX1B=SL1B*RAT*(OMFLD*(RCPB(1)-A))/AMD
         SLBX1C=RAT2*(OPAD-AMD*TCPC(1))/OMD
         IF(INBORD)GO TO 1060
         SLBX3=FLD3*RAT2*(OPAD+AMD*TCP3)/OPD
         SLBX3A=RAT3*FLD2*(FLD*OPA-OPD)*(OPAD+AMD*TCP3A)
         SLBX3B=OMFLD**2*(FLD*OPA-OPD)*(RCP3B+A)/(OMFLD3*(AMD**2))
!
!     ----BYPASS 2S IF WING TIP CONTROL.
!
         GO TO 1160
 1060    FLD=1./FLD
 1070    A=-A
         D=-D
 1080 END DO
      FLD=SAVFLD
      FLD2=FLD**2
      OMFLD=1.-FLD
      OPAD=1.+A*D
      AMD=A-D
      OPD2=1.+D**2
      OPA=1.+A
      OPD=1.+D
      SLBY2=SL2*(1.-H1*FLD*(TCP(2)+D))
      SLBX2=SL2*FLD*RAT*(OPAD+AMD*TCP(2))/OPD2
      TMP=FLD*OPA-OPD
      SLBX2A=FLD2*TMP*(OPAD+AMD*TCPA(2))*RAT3
      SLBX2B=OMFLD**2*TMP*(RCPB(2)+A)/(OMFLD3*(AMD**2))
      SLBX2C=FLD3*AMD*(OPAD+AMD*TCPC(2))*RAT3
      GO TO 1160
!
!     ----HERE FOR UNTAPERED.
!
 1110 FLD=AFORLF
      FLD2=FLD**2
      DO 1140 K=1,2
         OPA=1.+A
         OMA=1.-A
         G1=1.+2.*A*FLD-OMA2*FLD2
         G2=OMA2*FLD-A
         G3=ARCCOS(G2)
         G4=1./((1.-OMA*FLD)*PI)
         G5=FLD*SQ3
         G6=SQRA(G1)
         G7=SQRA(OMA2*G1)
         G8=G4/OPA
         G9=ALOG(ABS(1.+A*FLD-G6)/FLD)
         G10=ARCCOS(A)
         G11=1.+A/PI*G10-SQ3/PI
         G12=G8/(4.*OMA2)
         G13=7.*A2-2.*A4+1.
         G14=2.*A+OPA2*FLD
         G15=2.*FLD*OMA2**2
         G16=A*(7.-A2)
         G17=1./(OPA*OMA2)
         PA(K)=G8*(G7-G2*G3)
         PB(K)=G4*(G3+G5*G9)
         PC(K)=G11/OPA
         TCP(K)=(8.*A+OPA2)/(4.*OMA2)
         TCPA(K)=G12/PA(K)*((G13-G14*G15)*G3+(G16+OMA4*FLD)*G7)
         RCPB(K)=G4/(2.*PB(K))*((1.+2.*A*FLD)*G3/FLD-G7+A*G5*G9)
         TCPC(K)=G17/(4.*PC(K))*(8.*A+OPA2+G13/PI*G10-G16/PI*SQ3)
         IF(K.EQ.2) GO TO 1130
         IF(INBORD) GO TO 1120
         T1=1.-OPA*FLD
         T2=2.*FLD*OPA-1.
         T3=5.*A2+8.*A-3.
         T4=OPA*T1
         T45=SQRA(T4*FLD)
         T5=ARCCOS(T2)
         P3A=0.5/(T1*PI)*(2.*T45-T2*T5)
         P3B=1./(PI*T1)*(T5-2.*T45)
         TCP3=(5.-8.*A-3.*A2)/(8.*OPA)
         TCP3A=-1./(T4*16.*P3A*PI)*((T3+8.*FLD*OPA**2*(FLD*OPA2-2.*A))  &
     &      *T5+2.*(T3-2.*FLD*OPA*OPA2)*T45)
         RCP3B=1./(6.*P3B*FLD*T1*PI)*(3.*(1.-2.*A*FLD)*T5-2.*(1.+2.*FLD*&
     &      (1.-2.*A))*T45)
         SL3=1./(2.*FLD*OPA)
         SLBY3=SL3*(1.-(5./(12.*FLD*OPA)))
         SLBX3=TWO3RD*SL3
         SLBX3A=(1.-FLD*OPA)/(3.*FLD*OPA)
         SLBX3B=FLD*(RCP3B+A)*(1.-FLD*OPA)/3.
 1120    SL1=1./(FLD*OMA2)
         SL1A=(1.-FLD*OMA)/(2.*FLD*OMA)
         SL1B=(1.-FLD*OMA)/2.
         SLBY1=SL1*(1.+4.*A)/(6.*FLD*OMA2)
         SLBY1A=SL1A*TWO3RD*(TCPA(1)-A)/(FLD*OPA2)
         SLBY1B=TWO3RD*SL1B
         SLBX1=TWO3RD*SL1
         SLBX1B=TWO3RD*SL1B*FLD*(RCPB(1)-A)
         SLBX1A=TWO3RD*SL1A
         SLBX1C=1./(3.*FLD*OMA)
         IF(.NOT.INBORD) GO TO 1150
         A=-A
         GO TO 1140
 1130    A=-A
         OMA=1.-A
         OPA=1.+A
         SL2=SL1
         SLBY2=SL2*(1.-(1.-4.*A)/(6.*FLD*OMA2))
         SLBX2=TWO3RD*SL2
         SLBX2A=(1.-FLD*OPA)/(3.*FLD*OPA)
         SLBX2B=FLD*(RCPB(2)+A)*(1.-FLD*OPA)/3.
         SLBX2C=1./(3.*FLD*OPA)
 1140 END DO
 1150 SL0=(FLD*OMA2-1.)/(FLD*OMA2)
      SLY0=(3.*FLD*OMA*OMA2*(FLD*OPA-1.)   -4.*A)/(6.*FLD2*OMA2**2)
      SLX0=(3.*FLD*OMA2-4.)/(6.*FLD*OMA2)
!
!     ----SET ALL PARTS OF GENERAL EQUATION TO 0.
!
 1160 DO 1170 I=1,16
         PR(I)=0.
 1170 END DO
      PSL1=P(1)*SL1
      PSLX1=P(1)*SLBX1
      PSLY1=P(1)*SLBY1
      PSLX1C=PC(1)*SLBX1C
      PSLX1A=PA(1)*SLBX1A
      PSLX1B=PB(1)*SLBX1B
      IF(.NOT.TAPERD) FLD=1./FLD
      TESTR1=1.-A
      TESTR2=1.+A
      IF(.NOT.TAPERD)GO TO 1180
      TESTR1=(1.-A)/(1.-D)
      TESTR2=(1.+D)/(1.+A)
 1180 IF(.NOT.INBORD)GO TO 1250
!
!     ----HERE FOR CONTROL LOCATED INBOARD FROM WING TIP.
!
      PSL2=P(2)*SL2
      PSLY2=P(2)*SLBY2
      PSLX2=P(2)*SLBX2
      PSLX2C=PC(2)*SLBX2C
      PSLX2A=PA(2)*SLBX2A
      PSLX2B=PB(2)*SLBX2B
      CLD=SL0+PSL1+PSL2
      CMD=-(SLX0+PSLX1+PSLX2)
      CLLD=SLY0+PSLY1+PSLY2
      CHD=-(SLX0+PSLX1C+PSLX2C)
      IF(.NOT.TAPERD) GO TO 1190
      IF(FLD.LT.1.) GO TO 1190
      IF(FLD.GE.TESTR1) GO TO 1210
      GO TO 1200
 1190 IF(FLD.LE.TESTR1) GO TO 1210
 1200 CHD=CHD-(PSLX1A-PSLX1B)
 1210 IF (.NOT.TAPERD) GO TO 1220
      IF(FLD.LT.1.) GO TO 1220
      IF(FLD.GE.TESTR2) GO TO 1240
      GO TO 1230
 1220 IF(TESTR2.GE. FLD) GO TO 1240
 1230 CHD=CHD-(PSLX2A-PSLX2B)
 1240 CONTINUE
      CMD=TCP0OD*CMD
      CLD=TCP0OD*CLD
      CLLD=TCP0OD*CLLD
      CHD=TCP0OD*CHD
      GO TO 1320
!
!     ----HERE FOR CONTROL LOCATED AT THE WING TIP.
!
 1250 PSL1A=PA(1)*SL1A
      PSL1B=PB(1)*SL1B
      PSL3=P3*SL3
      PSLX3=P3*SLBX3
      PSLY1A=PA(1)*SLBY1A
      PSLY1B=PB(1)*SLBY1B
      PSLY3=P3*SLBY3
      PSLX3A=P3A*SLBX3A
      PSLX3B=P3B*SLBX3B
      CLD=SL0+PSL1+PSL3
      CMD=-(SLX0+PSLX1+PSLX3)
      CLLD=SLY0+PSLY1+PSLY3
      CHD=-(SLX0+PSLX1C+PSLX3)
      IF(.NOT.TAPERD) GO TO 1270
      IF(FLD.LT.1.) GO TO 1270
      IF(FLD.GE.TESTR1) GO TO 1290
      GO TO 1280
 1270 IF(FLD.LE.TESTR1) GO TO 1290
 1280 CLD=CLD+PSL1A-PSL1B
      CMD=CMD-(PSLX1A-PSLX1B)
      CLLD=CLLD+PSLY1A-PSLY1B
      CHD=CHD-(PSLX1A-PSLX1B)
 1290 IF(.NOT.TAPERD) GO TO 1300
      IF(FLD.LT.1.) GOTO 1300
      IF(FLD.GE.TESTR2) GO TO 1240
      GO TO 1310
 1300 IF(TESTR2.GE.FLD) GO TO 1240
 1310 CHD=CHD-(PSLX3A-PSLX3B)
      GO TO 1240
 1320 RETURN
      END
      SUBROUTINE DMPARY(ARRAY, NPT, NAME, NLET)
!
!***  DUMP SPECIFIED ARRAY IN READABLE FORMAT
!
      DIMENSION ARRAY(NPT), IFOR(8), AFOR(4), BFOR(4)
      CHARACTER*4 IFOR, AFOR, BFOR
      DATA IFOR / '    ', '    ', ',1H(', ',I3,', '2H)=', '1P  ',       &
     &            ',E12', '.5))' /
      DATA AFOR / '(5(5', '(5(4', '(5(3', '(5(2'/
      DATA BFOR / 'X,A1', 'X,A2', 'X,A3', 'X,A4'/
!
!     SET FORMAT FOR THE NUMBER OF LETTERS IN NAME
!     AND WRITE OUT ARRAY
!
      IFOR(1) = AFOR(NLET)
      IFOR(2) = BFOR(NLET)
      WRITE(6,1000)
 1000 FORMAT(1H )
      WRITE(6,IFOR) (NAME, I, ARRAY(I), I=1,NPT)
      RETURN
      END
      SUBROUTINE DNPAWB
!
!     THIS ROUTINE YIELDS THE FOLLOWING WING-BODY DERIVATIVES-
!       SUB,TRAN,SUPER,HYPERSONIC-  CLQ
!                                   CMQ
!                                   CLADOT
!                                   CMADOT (NOT FOR TRANSONIC)
!
      REAL LAMDA,KWB,KBW,MACH
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /SUPWBB/  SWB(61)
      COMMON /WINGI/  WINGIN(100)
      COMMON /IBW/    PBW,BW(380)
      COMMON /WINGD/  A(195)
      COMMON /IBODY/  PBODY,BODY(400)
      COMMON /IWING/  PWING,WING(400)
      COMMON /WHWB/   FF(182),WB(39)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL         FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      DIMENSION ROUTID(2)
      DIMENSION WTYPE(4)
      EQUIVALENCE(ASTRW,A(7)),(LAMDA,A(27))
      EQUIVALENCE(CLQWB,BW(201)),(CMQWB,BW(221)),(CLADWB,BW(241)),      &
     &           (CMADWB,BW(261))
      DATA WTYPE /4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA ROUTID/4HDNPA,4HWB  /
      TYPE=WINGIN(15)
      MACH=FLC(IM+2)
      IF(SUBSON)GO TO 1000
      IF(TRANSN)GO TO 1010
      IF(HYPERS)GO TO 1020
      BETA=SQRT(MACH**2-1.)
      KWB=SWB(35)
      KBW=SWB(11)
      CLQW=WING(201)
      CLQB=BODY(201)
      CMQW=WING(221)
      CMQB=BODY(221)
      CLADW=WING(241)
      CLADB=BODY(241)
      CMADW=WING(261)
      CMADB=BODY(261)
      GO TO 1030
 1000 KWB=WB(2)
      KBW=WB(3)
      BETA=SQRT(1.-MACH**2)
      CLQW=WING(201)
      CLQB=BODY(201)
      CMQW=WING(221)
      CMQB=BODY(221)
      CLADW=WING(241)
      CLADB=BODY(241)
      CMADW=WING(261)
      CMADB=BODY(261)
      GO TO 1030
 1010 IF(TYPE.NE.WTYPE(1))GO TO 1040
      KWB=SWB(35)
      KBW=SWB(11)
      IF(MACH.GT.1.)BETA=SQRT(MACH**2-1.)
      IF(MACH.LT.1.)BETA=SQRT(1.-MACH**2)
      IF(MACH.EQ.1.)BETA=0.
      CLQW=WING(201)
      CLQB=BODY(201)
      CMQW=WING(221)
      CMQB=BODY(221)
      CLADW=WING(241)
      CLADB=BODY(241)
      CMADW=1000.
      CMADB=BODY(261)
      GO TO 1030
 1020 KWB=SWB(35)
      KBW=SWB(11)
      BETA=SQRT(MACH**2-1.)
      CLQW=WING(201)
      CLQB=BODY(201)
      CMQW=WING(221)
      CMQB=BODY(221)
      CLADW=WING(241)
      CLADB=0.
      CMADW=WING(261)
      CMADB=0.
 1030 CONTINUE
!
!    ---- WING-BODY PITCHING DERIVATIVES,CLQ,CMQ ----
!
      CLQWB=(KWB+KBW)*CLQW+CLQB
      CMQWB=(KWB+KBW)*CMQW+CMQB
!
!    ---- WING-BODY ACCELERATION DERIVATIVES,CLAD,CMAD ----
!
      BASTRW=BETA*ASTRW
      IF(.NOT.SUPERS .AND. BASTRW.LT.0.)RETURN
      IF(.NOT.SUPERS .AND. BASTRW.GT.4.)RETURN
      IF(.NOT.SUPERS .AND. LAMDA.NE.0.)RETURN
      CLADWB=(KWB+KBW)*CLADW+CLADB
      IF(CMADW.EQ.1000.)RETURN
      CMADWB=(KWB+KBW)*CMADW+CMADB
 1040 CONTINUE
      RETURN
      END
      SUBROUTINE DNPWBT
!
!     THIS ROUTINE YIELDS THE FOLLOWING WING-BODY-TAIL DERIVATIVES-
!       SUB,TRAN,SUPERSONIC  -CLQ
!                             CMQ
!                             CLADOT
!                             CMADOT
!
      REAL MACH,INFACT,KHB,KBH,LAMDA
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /FLGTCD/ FLC(93), dumflgtcd(73)
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
      COMMON /SYNTSS/ SYNA(19)
      COMMON /WINGI/  WINGIN(77)
      COMMON /HTI/    HTIN(131)
      COMMON /IBW/    PBW,BW(380)
      COMMON /IBWH/   PBWH,BWH(380)
      COMMON /WINGD/  A(195),B(49)
      COMMON /SUPWBB/  SWB(61),SHB(61)
      COMMON /WBHCAL/ WBT(155)
      COMMON /IDWASH/ PDWASH,DWASH(60)
      COMMON /IWING/  PWING,WING(400)
      COMMON /IHT/    PHT,HT(380)
      COMMON /HTDATA/ AHT(195)
      COMMON /SBETA/  STB(135),TRA(108)
      COMMON /BDATA/  BD(762)
      COMMON /IVT/    PVT,VT(380)
      COMMON /IVF/    PVF,VF(380)
      COMMON/IBWHV/   PBWHV,BWHV(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      DIMENSION ROUTID(2)
      DIMENSION WTYPE(4)
      DIMENSION CLQWBT(20),CMQWBT(20),CLDWBT(20),CMDWBT(20)
      DIMENSION DTJ(20),GOGOO(20),DEDA(20)
      EQUIVALENCE(CLQWB,BW(201)),(CMQWB,BW(221)),(CLADWB,BW(241)),      &
     &           (CMADWB,BW(261))
      EQUIVALENCE(LAMDA,A(27))
      EQUIVALENCE(SBW,WINGIN(4)),(BH,HTIN(4)),(XCG,SYNA(1))
      EQUIVALENCE(XH,SYNA(6))
      EQUIVALENCE(CLQWBT(1),BWH(201)),(CMQWBT(1),BWH(221)),             &
     &           (CLDWBT(1),BWH(241)),(CMDWBT(1),BWH(261))
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA ROUTID/4HDNPW,4HBT  /
!
      PI=4.*ATAN(1.)
      RAD=180./PI
      TYPE=WINGIN(15)
      ASTRW=A(7)
      MACH=FLC(IM+2)
      IF(SUBSON)BETA=B(2)
      IF(SUPERS)BETA=SWB(6)
      IF(.NOT.SUBSON.AND.(MACH.LT.1.))BETA=SQRT(1.-MACH**2)
      IF(.NOT.SUPERS.AND.(MACH.GT.1.))BETA=SQRT(MACH**2-1.)
      IF(MACH.EQ.1.)BETA=0.
      IF(SUPERS)GO TO 1010
      IF(TRANSN)GO TO 1030
      KHB=WBT(1)
      KBH=WBT(2)
      DXAC=BD(63)
      DO 1000 I=1,NALPHA
         DTJ(I)=WBT(25+I)
         GOGOO(I)=DWASH(I)
         DEDA(I)=DWASH(I+40)
 1000 END DO
      CLAH=HT(101)
      GO TO 1050
 1010 KHB=SHB(35)
      KBH=SHB(11)
      DXAC=BD(63)
      DO 1020 I=1,NALPHA
         DTJ(I)=WBT(I+25)
         GOGOO(I)=DWASH(I)
         DEDA(I)=DWASH(I+40)
 1020 END DO
      CLAH=HT(101)
      GO TO 1050
 1030 DXH=(BH-HTIN(3))*AHT(62)*COS(SYNA(8)/RAD)
      DXCGH=XCG-(XH+DXH)
      DXAC=DXCGH-AHT(30)+AHT(16)/2.
      KBH=SHB(35)
      KHB=SHB(11)
      DO 1040 I=1,NALPHA
      DTJ(I)=0.0
      GOGOO(I)=DWASH(I)
      DEDA(I)=DWASH(I+40)
      CLAH =HT(101)
 1040 END DO
 1050 BWBH=SBW/BH
      DXOCB=-DXAC/CBARR
      BA=BETA*ASTRW
      IF(BWBH.LT.1.5)GO TO 1080
      IF(TYPE.NE.WTYPE(1))GO TO 1120
      IF(BA.LT.0.0 .OR. BA.GT.4. .AND. .NOT.SUPERS)A(13) = 0.0
      DO 1060 I=1,NALPHA
         SAVTIM=2.*(KBH+KHB)*GOGOO(I)*DXOCB
         SAVTIM=SAVTIM*CLAH
         SAVTIX=SAVTIM*DXOCB
         STORE1=CLQWB+SAVTIM
         STORE2=CMQWB-SAVTIX
!
!     ---WING-BODY-TAIL PITCHING DERIVATIVES,CLQ,CMQ---
!
!    BW/BH .GE. 1.5
!    SET V.T. INCREMENTS TO ZERO
!
      VT(I+200) = 0.0
      VT(I+220) = 0.0
      VT(I+240) = 0.0
      VT(I+260) = 0.0
      VF(I+200) = 0.0
      VF(I+220) = 0.0
      VF(I+240) = 0.0
      VF(I+260) = 0.0
      CLQWBT(I)=STORE1
      CMQWBT(I)=STORE2
!
!     ---WING-BODY-TAIL ACCELERATION DERIVATIVES,CLAD,CMAD---
!
      IF(LAMDA .NE. 0.0) A(13) = 1.0
      CLDWBT(I)=CLADWB+SAVTIM*DEDA(I)
 1060 CMDWBT(I)=CMADWB-SAVTIX*DEDA(I)
!
!   IOM B-W-H-V DATA SET IDENTICAL TO B-W-H SINCE ALL VERTICAL
!       TAIL INCREMENTS ARE ZERO
!
      DO 1070 I=1,NALPHA
         BWHV(I+200) = BWH(I+200)
         BWHV(I+220) = BWH(I+220)
         BWHV(I+240) = BWH(I+240)
         BWHV(I+260) = BWH(I+260)
 1070 END DO
      GO TO 1120
 1080 IF(TYPE.NE.WTYPE(1))GO TO 1100
      DO 1090 I=1,NALPHA
      SAVE=2.*(KBH+KHB)*GOGOO(I)*CLAH
      IF(BA.LT.0.0.OR.BA.GT.4.) A(13) = 0.0
!
!    BW/BH .LT. 1.5
!    SET V.T. INCREMENTS TO ZERO
!
      VT(I+200) = 0.0
      VT(I+220) = 0.0
      VF(I+200) = 0.0
      VF(I+220) = 0.0
      CLQWBT(I)=CLQWB+(SAVE+DTJ(I))*DXOCB
      CMQWBT(I)=CMQWB-(SAVE+DTJ(I))*DXOCB**2
!
!   IOM B-W-H-V DATA SET IDENTICAL TO B-W-H SINCE ALL VERTICAL
!       TAIL INCREMENTS ARE ZERO
!
      BWHV(I+200) = BWH(I+200)
      BWHV(I+220) = BWH(I+220)
 1090 END DO
 1100 IF(TRANSN)GO TO 1120
      IF(LAMDA.NE.0.)GO TO 1120
      DXOCB=DXOCB*2.
      DXOCB2=DXOCB**2/2.
      DO 1110 I=1,NALPHA
!
!   BW/BH .LT. 1.5
!   SET V.T. INCREMENTS TO ZERO
!
         VT(I+240) = 0.0
         VT(I+260) = 0.0
         VF(I+240) = 0.0
         VF(I+260) = 0.0
         CLDWBT(I)=CLADWB-DXOCB*DTJ(I)
         CMDWBT(I)=CMADWB+DXOCB2*DTJ(I)
!
!   IOM B-W-H-V DATA SET IDENTICAL TO B-W-H SINCE ALL VERTICAL
!       TAIL INCREMENTS ARE ZERO
!
         BWHV(I+240) = BWH(I+240)
         BWHV(I+260) = BWH(I+260)
 1110 END DO
 1120 CONTINUE
      RETURN
      END
      SUBROUTINE DPRESR(ZJ,ZWAKE,ALPHJ,DWANGL,QQINFY,MJ)
!
!***  CALCULATES NON-VISCOUS DYNAMIC PRESSURE AT HORIZONTAL TAIL
!
      DIMENSION ROUTID(2)
      LOGICAL ZUPPER
      LOGICAL TE
      REAL KN(6)
      REAL KNU(7),M(7),MACH
      REAL MJ
      DIMENSION C1(6),C2(6),THETA(7)
      DIMENSION SLOPE(6),X(6),Z(6),DKNU(7),VAR(4),LGH(4),QQ(7),QQPT(7)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /SYNTSS/ SYNA(19)
      COMMON /SUPDW/  DWA(237)
      COMMON /WINGI/  WINGIN(100)
      COMMON /WINGD/  A(195)
      EQUIVALENCE (DELTE,DWA(235)),(THETE,DWA(236))
      EQUIVALENCE (THETA1,DWA(234)),(DLE,DWA(231)),(DELTAZ,DWA(232)),   &
     &            (XSUR,DWA(233))
      EQUIVALENCE (MACH,DWA(1)),(RL2,A(24))
      EQUIVALENCE (ZH,SYNA(7)),(ZW,SYNA(3)),(SLOPE(1),WINGIN(95)),      &
     &            (CR,WINGIN(6))
      DATA ROUTID/4HDPRE,4HSR  /
      DATA KN/0.0,0.2,0.4,0.6,0.8,1.0/
!
!  ***CALCULATE INTERSECTION OF MACH WAVES WITH SURVEY PLANE***
!
      QPT(XM) = 0.7*XM**2/(1.0+0.2*XM**2)**3.5
      TE=.FALSE.
      ZUPPER=.FALSE.
      ALPHA=ALPHJ
      ALPHA=ALPHA/RAD
      XSUR=(A(12)-(CR+RL2)*TAN(ALPHA))*SIN(ALPHA)+(RL2+CR)/COS(ALPHA)
      DELTAZ=CR*SIN(ALPHA)+(XSUR-CR*COS(ALPHA))*TAN(DWANGL)
      IF(ZJ.GT.0.0) ZUPPER=.TRUE.
      IF(ZUPPER)GO TO 1010
!
!                **TAIL BELOW WING***
!
      DLE=-ALPHA*RAD-SLOPE(1)
 1000 IF(DLE.GE.0.0)GO TO 1020
      GO TO 1040
!
!                ***TAIL ABOVE WING***
!
 1010 DLE= ALPHA*RAD-SLOPE(1)
      GO TO 1000
 1020 CONTINUE
!
!                ***EXPANSION***
!
      U=ATAN(1./SQRT(MACH**2-1.))
      ANG=U+ALPHA
      ARG1=XSUR*SIN(ALPHA)/TAN(ANG)
      ARG2=XSUR*COS(ALPHA)
      ARG3=SIN(ALPHA)+COS(ALPHA)/TAN(ANG)
      DO 1030 N=1,6
         X(N)= KN(N)*CR
         Z(N)= (-X(N)+ARG2-ARG1)/ARG3
         IF(ZUPPER)Z(N)=Z(N)+DELTAZ
 1030 IF(.NOT.ZUPPER)Z(N)=-ABS(Z(N))-DELTAZ
      GO TO 1080
 1040 CONTINUE
!
!                ***COMPRESSION***
!
      DELTA=ABS(DLE)
      MJ=UNUSED
 1050 CALL FIG68(MACH,DELTA,THETA1,IER)
      THETA(1)=THETA1
      IF(IER.NE.2)GO TO 1060
      DELTA=THETA1
      GO TO 1050
 1060 ANG=ALPHA-THETA(1)/RAD
      ARG1=XSUR*COS(ALPHA)-XSUR*SIN(ALPHA)/TAN(ANG)
      ARG2=SIN(ALPHA)+COS(ALPHA)/TAN(ANG)
      DO 1070 N=1,6
         X(N)=KN(N)*CR
         Z(N)= (-X(N)+ARG1)/ARG2
         IF(ZUPPER)Z(N)=ABS(Z(N))  +DELTAZ
         IF(.NOT.ZUPPER)Z(N)=Z(N)+DELTAZ
 1070 END DO
      GO TO 1130
!
!  ***SUPERSONIC DYNAMIC PRESSURE RATIO***
!                ***EXPANSION***
 1080 NN=2
      DKNU(1)=DLE
      ARG2=SQRT(MACH**2-1.)
      ARG1=.40825*ARG2
      KNUINF=(2.4495*ATAN(ARG1)-ATAN(ARG2))*RAD
      KNU(1)=KNUINF+DKNU(1)
      CALL MACH2(KNU(1),M(1),IER)
      QQINF = QPT(MACH)
      QQPT(1) = QPT(M(1))
      QQ(1)=QQPT(1)/QQINF
 1090 I=NN
 1100 DKNU(I)=SLOPE(I-1)-SLOPE(I)
 1110 KNU(I)=KNU(I-1)+DKNU(I)
      CALL MACH2(KNU(I),M(I),IER)
      QQPT(I) = QPT(M(I))
      QQ(I)= QQPT(I)*QQ(I-1)/QQPT(I-1)
      IF(TE)GO TO 1210
 1120 I=I+1
      IF(I.LE.6)GO TO 1100
      GO TO 1190
!
!                ***COMPRESSION***
!
 1130 CONTINUE
      DKNU(1)=DLE
      ANG=(THETA(1)+DLE)/RAD
      ANG=ABS(ANG)
      QQ(1)=(MACH**2*SIN(THETA(1)/RAD)**2+5.0)/                         &
     &      (6.0*MACH**2*SIN(ANG)**2)
      ARG1=(MACH*SIN(THETA(1)/RAD))**2+5.
      ARG2=7.*MACH**2*SIN(THETA(1)/RAD)**2-1.
      M(1)=(ARG1/ARG2)**.5/SIN(ANG)
      IF(M(1).LT.1.0) GO TO 1240
      ARG2=SQRT(M(1)**2-1.)
      ARG1=.40825*ARG2
      KNU(1)=(2.4495*ATAN(ARG1)-ATAN(ARG2))*RAD
 1140 I=2
 1150 CONTINUE
      DKNU(I)= SLOPE(I-1)-SLOPE(I)
      CALL FIG68(M(I-1),DKNU(I),THETA(I),IER)
      ARG=SIN(THETA(I)/RAD)**2
      IF(DKNU(I).GT.0.0)GO TO 1170
 1160 CONTINUE
      ANG=(THETA(I)+DKNU(I))/RAD
      ANG=ABS(ANG)
      QQ(I)=(M(I-1)**2*ARG+5.0)/(6.0*M(I-1)**2*SIN(ANG)**2)
      QQ(I)= QQ(I)*QQ(I-1)
      ARG1=(M(I-1)**2*ARG+5.)/(7.*M(I-1)**2*ARG-1.)
      M(I)= (ARG1**.5)/SIN(ANG)
      IF(TE)GO TO 1210
      GO TO 1180
 1170 QQPT(I-1) = QPT(M(I-1))
      ARG2=SQRT(M(I-1)**2-1.)
      ARG1=.40825*ARG2
      KNU(I-1)= (2.4495*ATAN(ARG1)-ATAN(ARG2))*RAD
      NN=I
      IF(TE)GO TO 1110
      GO TO 1090
 1180 I=I+1
      IF(I.LE.6)GO TO 1150
 1190 CONTINUE
!
!  ***CHECK FOR EXPANSION OR COMPRESSION AT THE TRAILING EDGE***
!
      TE=.TRUE.
      IF(M(6).LE.MACH) GO TO 1200
!
!  ***FLOW IS COMPRESSED TO FREESTREAM***
!
      I=7
      DKNU(I)=-ALPHA*RAD+SLOPE(6)
      DELTE=ABS(DKNU(I))
      CALL FIG68(M(6),DELTE,THETE,IER)
      IF(IER .NE. 2) GO TO 1195
        DKNU(I) = -THETE
        DELTE   = THETE
        CALL FIG68(M(6),DELTE,THETE,IER)
 1195 CONTINUE
      THETA(I)=THETE
      ARG=SIN(THETE/RAD)**2
      GO TO 1160
 1200 CONTINUE
!
!  ***FLOW IS EXPANDED TO FREESTREAM***
!
      I=7
      DKNU(I)=ALPHA*RAD+SLOPE(6)
      GO TO 1170
 1210 CONTINUE
!
!  ***FIND Q AND M AT ZJ***
!
      IF(ZJ/Z(6).LE.1.0)GO TO 1220
      I1=0
      I2=0
      CALL TBFUNX(ZJ,QQINFY,DYDX,6,Z,QQ,C1,I1,MI,NG,0,0,4HQNFY,1,ROUTID)
      CALL TBFUNX(ZJ,MJ,DYDX,6,Z,M,C2,I2,MI,NG,0,0,4HMJ  ,1,ROUTID)
      GO TO 1230
 1220 CONTINUE
      ARG=(ZJ-ZWAKE)/(Z(6)-ZWAKE)
      QQINFY=1.0+(QQ(7)-1.0)*ARG
      MJ=MACH
 1230 CONTINUE
      RETURN
 1240 MJ=M(1)
      RETURN
      END
      SUBROUTINE DRAGFP
!
!***  CALCULATES SUBSONIC FLAP INDUCED DRAG
!
      REAL KPRM,KB
      COMMON /OVERLY/ NLOG,NMACH,IZO,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
      COMMON /IDWASH/ PDWASH, DWASH(60)
      COMMON /IWING/  PWING, WING(400)
      COMMON /IBODY/  PBODY, BODY(400)
      COMMON /IHT/    PHT, HT(380)
      COMMON /SUPWH/  FCM(282)
      COMMON /SUPDW/  DWA(35),TCD(58)
      COMMON /FLAPIN/ F(69)
      COMMON /POWR/   PW(104),FLP(189)
      COMMON /WINGD/  A(195),B(49)
      COMMON /HTDATA/ AHT(195),BHT(49)
      DIMENSION CXX(6),DCDI(200),CDI(200)
      DIMENSION X11722(15),X21722(9),Y11722(135),F11722(2)
      DIMENSION X21724(10),X11724(3),Y61724(30),F61724(3)
      DIMENSION X11723(6),X21723(5),F11723(2),Y11723(30)
      DIMENSION ROUTID(2)
      DIMENSION DELCDM(10),DELCDF(10),DCL(10),ETA(5),RKB(4)
      DIMENSION GD1(12),GD2(12),GD3(12),ADAVE(10),DELTA(10),ALPHA(20)
      DIMENSION GPP(12),DG(12),GPPA(12),CD(20),CL(20),CDF(200),CLF(200)
      DIMENSION TEC(5),TOTC(10),SC1(5),SC2(6),SC3(5),SC4(6),SC5(5),     &
     &         SC6(6),SC7(5),SC8(6),SC9(5),SC10(6),Q(12),SPU(12),SUM(10)
      EQUIVALENCE (F(1),DELTA(1)),(Q(1),EN1),(Q(2),EN2),                &
     &           (Q(3),SM1),(Q(4),SM2),(Q(5),SM3),(Q(6),SM4),(Q(7),SM5),&
     &        (Q(8),SM6),(Q(9),SM7),(Q(10),SM8),(Q(11),SM9),(Q(12),SM10)
      EQUIVALENCE (Q(3),SUM(1))
      EQUIVALENCE (FCM(63),ADAVE(1)),(TCD(29),GD1(1)),(TCD(1),GD2(1)),  &
     &            (TCD(15),GD3(1))
      EQUIVALENCE (KPRM,TCD(47)),(DELCDM(1),WING(231)),                 &
     &            (DELCDF(1),TCD(49))
      EQUIVALENCE (CFOCA,FLP(61)),(DCL(1),WING(201))
      EQUIVALENCE (DCDI(1),BODY(201))
      EQUIVALENCE (ETA(1),FLP(1)),(RKB(1),FLP(20))
      DATA ROUTID/4HDRAG,4HFP  /
!
!        ---- FIGURE 6.1.7-22  TWO-DIMENSIONAL DRAG INCREMENT
!                              DUE TO PLAIN FLAPS
!
      DATA X11722/0.,10.,15.,20.,25.,30.,35.,40.,45.,50.,55.,60.,65.,   &
     & 70.,75./,X21722/0.,.10,.16,.20,.249,.28,.32,.36,.42/,            &
     & F11722/4H6.1.,4H7-22/,                                           &
     & Y11722/9*0.,0.,.002,.003,.004,.007,.008,.012,                    &
     &.016,.025 , 0.,.005,.008,.012,.016,.019,.025,.032,.045 , 0.,.009, &
     &.015,.020,.027,.032,.039,.048,.070 , 0.,.014,.024,.030,.041,.048, &
     &.060,.074,.105 , 0.,.019,.033,.043,.057,.069,.088,.11,.151 , 0.,  &
     &.026,.043,.057,.077,.092,.114,.14,.191 , 0.,.033,.054,.071,.097,  &
     &.117,.150,.187,.247 , 0.,.040,.067,.088,.119,.143,.184,.232,.305  &
     & , 0.,.048,.080,.104,.140,.170,.218,.264,.337 , 0.,.057,.093,.122,&
     &.165,.20,.254,.307,.388 , 0.,.065,.108,.14,.192,.238,.303,.366,   &
     &.462 , 0.,.075,.122,.16,.22,.273,.342,.414,.521 , 0.,.083,.138,   &
     &.179,.25,.305,.38,.451,.564 , 0.,.09,.15,.199,.28,.345,.433,.52,  &
     & .658/
!
!        ---- FIGURE 6.1.7-23  TWO-DIMENSIONAL DRAG INCREMENT
!                              DUE TO SLOTTED FLAPS
!
      DATA X11723/0.,10.,20.,30.,40.,50./,X21723/0.,.10,.23,.36,.40/,   &
     &     F11723/4H6.1.,4H7-23/,                                       &
     &     Y11723/5*0.,0.,.002,.004,.009,.012,0.,.004,.01,.018,.023,    &
     &     0.,.011,.029,.05,.058,0.,.02,.057,.101,.117,                 &
     &     0.,.031,.088,.171,.205/
!
!     ----FIGURE 6.1.7-24 A-C
!
      DATA X21724/.2,.25,.3,.4,.5,.6,.7,.8,.9,1.0/,X11724/4.,6.,12./,   &
     &F61724/4H6.1.,4H7-24,4HA-C /,                                     &
     & Y61724/2.34,1.74,1.41,.96,.62,.38,.22,.11,.03,.0 , 3.2,2.54,2.04,&
     &1.24,.79,.50,.30,.15,.07,.0 , 4.9,3.8,2.8,1.7,1.06,.65,.37,.18,.06&
     &,0. /
      DATA TEC/4.444,.4794,.1602,.06946,.02782/,TOTC/38.65,19.52,13.24, &
     & 10.17,8.398,7.278,6.538,6.046,5.732,5.557/
      DATA SPU/0.,.1423,.2817,.4153,.5407,.6549,.7557,.8412,.9097,.9595 &
     &,.9898,1.0/
      DATA SC1  /.09772,.1463,.3188,1.120,13.95/
      DATA SC2  /.0493,.1232,.2310,.7268,7.616,7.046/
      DATA SC3  /.1170,.1928,.5431,5.246,5.167/
      DATA SC4  /.06423,.1739,.4384,4.084,4.029,.2948/
      DATA SC5  /.1753,.3869,3.398,3.372,.3127/
      DATA SC6  /.1060,.3628,2.951,2.945,.2984,.06003/
      DATA SC7  /.3799,2.673,2.658,.2850,.07869/
      DATA SC8  /.2635,2.533,2.459,.2785,.08798,.02287/
      DATA SC9  /2.565,2.401,.2858,.09800,.03618/
      DATA SC10 /2.244,2.487,.2883,.1160,.04910,.01405/
      ASPECT=A(7)
      SCALE=A(3)/SREF
      IF(AHT(3).NE.UNUSED)SCALE=AHT(3)/SREF
      IF(AHT(7).NE.UNUSED)ASPECT=AHT(7)
      DO 1000 I=1,12
         GPP(I)=GD1(I)/RAD
 1000 DG(I)=GD3(I)-GD2(I)
      A31422=PI*ASPECT/22.
      NDP1=F(16)+1.5
      DO 1070 M=1,NDP1
         IF(M.GT.1)ADAVED=ADAVE(M-1)*DELTA(M-1)/RAD
         DO 1060 J=1,NALPHA
            ALPHA(J)=B(J+22)-B(49)
            IF(BHT(J+22).NE.UNUSED)ALPHA(J)=BHT(J+22)-B(49)-DWASH(J+20)
            DO 1010 L=1,12
 1010       Q(L)=0.
            K=1
            L=1
            DO 1030 I=1,11
               GPPA(I)=GPP(I)*ALPHA(J)
               IF(M.GT.1)GPPA(I)=GPPA(I)-DG(I)*ADAVED
               IF(2*(I/2).NE.I)GO TO 1020
!
!     ----HERE FOR EVEN
!
               EN1=EN1+TEC(K)*GPPA(I)
               SM1=SM1+SC1(K)*GPPA(I)
               SM3=SM3+SC3(K)*GPPA(I)
               SM5=SM5+SC5(K)*GPPA(I)
               SM7=SM7+SC7(K)*GPPA(I)
               SM9=SM9+SC9(K)*GPPA(I)
               K=K+1
               GO TO 1030
!
!     ----HERE FOR ODD
!
 1020          SM2=SM2+SC2(L)*GPPA(I)
               SM4=SM4+SC4(L)*GPPA(I)
               SM6=SM6+SC6(L)*GPPA(I)
               SM8=SM8+SC8(L)*GPPA(I)
               SM10=SM10+SC10(L)*GPPA(I)
               L=L+1
 1030       CONTINUE
            EN1=GPPA(1)*(5.5*GPPA(1)-EN1)
            CLSM=0.
            TOTSM=0.
            DO 1040 I=2,11
               II=13-I
               TEMP=SPU(I)*GPPA(II)
               TOTSM=TEMP*(TOTC(I-1)*GPPA(II)-SUM(I-1))+TOTSM
               CLSM=CLSM+TEMP
 1040       CONTINUE
            EN2=2.*TOTSM
            TCB=A31422*(EN1+EN2)
            TCL=A31422*(GPPA(1)+2.*CLSM)
            IF(M.GT.1)GO TO 1050
            CD(J)=TCB  *SCALE
            CL(J)=TCL  *SCALE
            GO TO 1060
 1050       IDX=J+NALPHA*(M-2)
            CLF(IDX)=TCL *SCALE
            CDF(IDX)=TCB *SCALE
 1060    CONTINUE
 1070 END DO
      NDELTA=F(16)+.5
      IF(F(17).GT.5.) GO TO 1090
!
!    -----CALCULATION OF DELTA CD(MIN) DUE TO FLAPS
!              FIGURE 6.1.7-24 A-C
!
      ARG1 = ETA(5)-ETA(1)
      CALL TLINEX(X11724,X21724,Y61724,3,10,ASPECT,ARG1,KPRM,           &
     &            2,0,0,0,F61724,3,ROUTID)
      KB=RKB(1)+RKB(2)+RKB(3)+RKB(4)
      ARG1=KPRM/(ASPECT*PI)
      DO 1080 J=1,NDELTA
         ARG2=ABS(DELTA(J))
!
!        FIGURE 6.1.7-22 OR 6.1.7-23, DELCDF
!
         IF(F(17).EQ.1..OR.F(17).EQ.5.) GO TO 1075
         CALL TLINEX(X11723,X21723,Y11723,6,5,ARG2,CFOCA,DELCDF(J),     &
     &               2,0,0,0,F11723,2,ROUTID)
         GO TO 1078
 1075    CALL TLINEX(X11722,X21722,Y11722,15,9,ARG2,CFOCA,DELCDF(J),    &
     &               2,0,0,0,F11722,2,ROUTID)
 1078    CONTINUE
 1080 DELCDM(J)= DELCDF(J)*KB*SCALE+ARG1*DCL(J)**2/SCALE
!
!    -----CALCULATE DELTA CDI AT SPECIFIC CL FROM SECTION 4 AND 5
!
 1090 IXX=0
      DO 1110 N=1,NDELTA
         L=1+NALPHA*(N-1)
         DO 1100 J=1,NALPHA
            IL=J+NALPHA*(N-1)
            DCDI(IL) = CDF(IL)-CD(J)
 1100    CONTINUE
 1110 END DO
!
      RETURN
      END
      SUBROUTINE DUMP2
      COMMON /FLAPIN/ F(138)
      COMMON /POWR/   SPR(59),FLA(45),FLP(189),TRM(22)
      COMMON /SUPDW/  FHG(35),TCD(58)
      COMMON /SUPWH/  FCM(287)
      COMMON /IBODY/  PBODY,BODY(400)
      COMMON /IWING/  PWING,WING(400)
      COMMON /IHT/    PHT,HT(380)
      COMMON /IVT/    PVT,VT(380)
      COMMON /IBW/    PBW,BW(380)
      COMMON /IBH/    PBH,BH(380)
      COMMON /IBV/    PBV,BV(380)
      COMMON /IBWH/   PBWH,BWH(380)
      COMMON /IBWV/   PBWV,BWV(380)
      COMMON /IBWHV/  PBWHV,BWHV(380)
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
      LOGICAL  DPBO,DPWG,DPHT,DPVT,DPBW,DPBH,DPBV,DPBWH,DPBWHV
!
      DIMENSION TRM2(22),TRN(7)
      EQUIVALENCE (TRM(1),TRM2(1),TRN(1))
      LOGICAL DUM(9)
      EQUIVALENCE (DUM(1),DPBO),(DUM(2),DPWG),(DUM(3),DPHT),            &
     &(DUM(4),DPVT),(DUM(5),DPBW),(DUM(6),DPBH),(DUM(7),DPBV),          &
     &(DUM(8),DPBWH),(DUM(9),DPBWHV)
      DO 1000 I=1,9
         DUM(I)=.FALSE.
 1000 END DO
!
      IF(.NOT. DMPCSE) GO TO 1010
        DPF    = .TRUE.
        DPFLP  = DPFLP  .OR. ((SUBSON .OR. TRANSN) .AND. SYMFP)
        DPFHG  = DPFHG  .OR. (SUBSON .AND. (F(17) .EQ. 1.0))
        DPFCM  = DPFCM  .OR. (SUBSON .AND. SYMFP)
        DPTCD  = DPTCD  .OR. (SUBSON .AND. (F(17) .LE. 6.0 .AND.        &
     &                       F(17) .NE. UNUSED)) .OR.                   &
     &                       (.NOT. SUPERS .AND. (F(18) .EQ. 5.0))
        DPFLA  = DPFLA  .OR. ((SUBSON .OR. TRANSN) .AND. ASYFP)
        DPTRM  = DPTRM  .OR. (TRIM .AND. SYMFP .AND. SUBSON)
        DPSPR  = DPSPR  .OR. (SUPERS .OR. HYPERS)
        DPTRN  = DPTRN  .OR. TRANSN
        DPTRM2 = DPTRM2 .OR. (SUBSON .AND. TRIM .AND. HTPL .AND.        &
     &                       .NOT. (SYMFP .OR. ASYFP))
        DPBO   = SUBSON .OR. (TRANSN .AND. ASYFP) .OR.                  &
     &                       (SUPERS .AND. F(18) .EQ. 4.0)
        DPWG   = SUBSON .OR. TRANSN .OR. ((SUPERS .OR. HYPERS)          &
     &                       .AND. (SYMFP .OR. F(18) .EQ. 5.0))
        DPHT   = (TRIM .AND. SUBSON) .OR. ASYFP
        DPVT   = (TRIM .AND. SUBSON)
        DPBW   = CTAB
        DPBH   = CTAB
        DPBV   = CTAB
        DPBWH  = CTAB
        DPBWHV = CTAB
 1010 CONTINUE
      IF(DPF)    CALL DMPARY(F,138,1HF,1)
      IF(DPFCM)  CALL DMPARY(FCM,287,3HFCM,3)
      IF(DPFHG)  CALL DMPARY(FHG,35,3HFHG,3)
      IF(DPFLA)  CALL DMPARY(FLA,45,3HFLA,3)
      IF(DPFLP)  CALL DMPARY(FLP,189,3HFLP,3)
      IF(DPSPR)  CALL DMPARY(SPR,59,3HSPR,3)
      IF(DPTCD)  CALL DMPARY(TCD,58,3HTCD,3)
      IF(DPTRM)  CALL DMPARY(TRM,22,3HTRM,3)
      IF(DPTRM2) CALL DMPARY(TRM2,22,4HTRM2,4)
      IF(DPTRN)  CALL DMPARY(TRN,7,3HTRN,3)
!
      IF(DPBO .OR. DPWG .OR. DPHT .OR. DPVT .OR. DPBW .OR.              &
     &   DPBH .OR. DPBV .OR. DPBWH .OR. DPBWHV) WRITE(6,1020)
!
      IF(DPBO)   CALL DMPARY(BODY(201),200,4HBODY,4)
      IF(DPWG)   CALL DMPARY(WING(201),200,4HWING,4)
      IF(DPHT)   CALL DMPARY(HT(201)  ,180,2HHT  ,2)
      IF(DPVT)   CALL DMPARY(VT(201)  ,180,2HVT  ,2)
      IF(DPBW)   CALL DMPARY(BW(201)  ,180,2HBW  ,2)
      IF(DPBH)   CALL DMPARY(BH(201)  ,180,2HBH  ,2)
      IF(DPBV)   CALL DMPARY(BV(201)  ,180,2HBV  ,2)
      IF(DPBWH)  CALL DMPARY(BWH(201) ,180,3HBWH ,3)
      IF(DPBWHV) CALL DMPARY(BWHV(201),180,4HBWHV,4)
      RETURN
 1020 FORMAT(55H0**** THE FOLLOWING ARE IDEAL OUTPUT MATRIX ARRAYS ****)
      END
      SUBROUTINE DUMPRT
!
!***  THIS SUBROUTINE HANDLES THE DUMP LOGIC
!
!***  IDEAL OUTPUT MATRIX
!
!             BLOCK    PRINT     IOM
!             NAME     FLAG     ARRAY
!
      COMMON /IBODY/   PBODY,  BODY(400)
      COMMON /IWING/   PWING,  WING(400)
      COMMON /IHT/     PHT,    HT(380)
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
      COMMON /IBWH/    PBWH,   BWH(380)
      COMMON /IBWV/    PBWV,   BWV(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
      COMMON /IPOWER/  PPOWER, POWER(200)
      COMMON /IDWASH/  PDWASH, DWASH(60)
!
      LOGICAL PBODY, PWING, PHT, PVT, PVF, PBW, PBH, PBV, PBWH, PBWV,   &
     &        PBWHV, PPOWER, PDWASH
!
!***  INPUT DATA BLOCKS
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ OPTN(4)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /BODYI/  BODYIN(129)
      COMMON /WINGI/  WINGIN(101)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /HTI/    HTIN(154)
      COMMON /POWER/  PWIN(29), LBIN(21)
      COMMON /FLAPIN/ F(138)
!
!***  COMPUTATIONAL BLOCKS
!
      COMMON /WINGD/  A(195), B(49)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /BDATA/  BD(762)
      COMMON /WHWB/   FACT(182), WB(39), HB(39)
      COMMON /WBHCAL/ WBT(156)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55), DVF(55)
      COMMON /POWR/   PW(315)
      COMMON /SUPWBB/  SWB(61), SHB(61)
      COMMON /SUPDW/  DWA(237)
      COMMON /SUPWH/  SLG(141), STG(141)
      COMMON /SUPBOD/ SBD(229)
      COMMON /LEVEL2/ SECOND(23)
!
      DIMENSION LB(200), STP(156), SLA(31), SLAH(31)
      DIMENSION XTYPE(4)
      EQUIVALENCE (DWA(1), LB(1)), (WBT(1), STP(1))
      EQUIVALENCE (STB(1), SLA(1)), (STB(32), SLAH(1))
!
!***   CONTROL DATA BLOCKS
!
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
      LOGICAL  LEQV(81)
!
      EQUIVALENCE (LEQV(1),IERR)
      DATA XTYPE / 4HSTRA, 4HDOUB, 4HCRAN, 4HCURV /
!
      DO 1000 I=1,4
      IF(WINGIN(15).EQ.XTYPE(I))WINGIN(15)=FLOAT(I)
      IF(  HTIN(15).EQ.XTYPE(I))  HTIN(15)=FLOAT(I)
      IF(  VTIN(15).EQ.XTYPE(I))  VTIN(15)=FLOAT(I)
      IF(  VFIN(15).EQ.XTYPE(I))  VFIN(15)=FLOAT(I)
 1000 END DO
!
!
!***  DUMP LOGIC
!
      IF(.NOT. DMPALL) GO TO 1020
        DO 1010 I=5,81
          IF((I .EQ. 20) .OR. (I .EQ. 21)) GO TO 1020
          LEQV(I) = .TRUE.
 1010   CONTINUE
 1020 CONTINUE
!
!***  DUMP CASE LOGIC
!
      IF(.NOT. DMPCSE .OR. DMPALL) GO TO 1030
        DPA    = DPA    .OR. WGPL
        DPB    = DPB    .OR. (WGPL .AND. SUBSON)
        DPSTB  = DPSTB  .OR. ((BO .OR. WGPL .OR. VTPL .OR. TVTPAN)      &
     &                  .AND. (SUBSON .OR. TRANSN))
        DPTRA  = DPTRA  .OR. (WGPL .AND. TRANSN)
        DPTRAH = DPTRAH .OR. (HTPL .AND. TRANSN)
        DPSTBH = DPSTBH .OR. ((HTPL .OR. VTPL) .AND. (SUBSON .OR.       &
     &           TRANSN))
        DPBD   = DPBD   .OR. BO
        DPFACT = DPFACT .OR. ((WGPL .OR. HTPL) .AND. (SUBSON .OR.       &
     &                       (WINGIN(101) .GT. 2.5 .AND. .NOT. TRANSN)))
        DPWB   = DPWB   .OR. ((BO .AND. WGPL) .AND. (SUBSON .OR.        &
     &           TRANSN))
        DPHB   = DPHB   .OR. ((BO .AND. HTPL) .AND. (SUBSON .OR.        &
     &           TRANSN))
        DPWBT  = DPWBT  .OR. (WGPL .AND. HTPL .AND. SUBSON)
        DPAHT  = DPAHT  .OR. HTPL
        DPBHT  = DPBHT  .OR. (HTPL .AND. SUBSON)
        DPAVT  = DPAVT  .OR. VTPL
        DPAVF  = DPAVF  .OR. VFPL
        DPC    = DPC    .OR. (WGPL .AND. SUBSON)
        DPD    = DPD    .OR. (WGPL .AND. SUBSON)
        DPCHT  = DPCHT  .OR. (HTPL .AND. SUBSON)
        DPDHT  = DPDHT  .OR. (HTPL .AND. SUBSON)
        DPDVT  = DPDVT  .OR. (VTPL .AND. SUBSON)
        DPDVF  = DPDVF  .OR. (VFPL .AND. SUBSON)
        DPPW   = DPPW   .OR. ((PRPOWR .OR. JETPOW) .AND. SUBSON)
        DPSWB  = DPSWB  .OR. (BO .AND. WGPL .AND. .NOT. SUBSON)
        DPSHB  = DPSHB  .OR. (BO .AND. HTPL .AND. .NOT. SUBSON)
        DPDWA  = DPDWA  .OR. ((WGPL .AND. HTPL) .AND. (SUPERS .OR.      &
     &            HYPERS))
        DPSBD  = DPSWB  .OR. (BO .AND. (SUPERS .OR. HYPERS))
        DPSEC  = DPSEC  .OR. TRANSN
        DPSLG  = DPSLG  .OR. (WGPL .AND. .NOT. SUBSON)
        DPSTG  = DPSTG  .OR. (HTPL .AND. (SUPERS .OR. HYPERS))
        DPLB   = DPLB   .OR. LOASRT
        DPSTP  = DPSTP  .OR.  (((WGPL .AND. HTPL) .OR. VTPL .OR. VFPL)  &
     &            .AND. .NOT. SUBSON)
        DPSLA  = DPSLA  .OR. ((WGPL .OR. VTPL) .AND. (SUPERS .OR.       &
     &            HYPERS))
        DPSLAH = DPSLAH .OR. ((HTPL .OR. VFPL) .AND. (SUPERS .OR.       &
     &            HYPERS))
        DPINPT = .TRUE.
        DPIOM  = .TRUE.
 1030 CONTINUE
!
      IF(.NOT. DPINPT) GO TO 1040
        DPFLC  = .TRUE.
        DPOPTN = .TRUE.
        DPSYN  = .TRUE.
        DPBDIN = DPBDIN .OR. BO
        DPWGIN = DPWGIN .OR. (WGPL .OR. WGSC)
        DPVTIN = DPVTIN .OR. (VTPL .OR. VTSC)
        DPVFIN = DPVFIN .OR. (VFPL .OR. VFSC)
        DPTVT  = DPTVT  .OR. TVTPAN
        DPHTIN = DPHTIN .OR. (HTPL .OR. HTSC)
        DPPWIN = DPPWIN .OR. (PRPOWR .OR. JETPOW)
        DPLBIN = DPLBIN .OR. LOASRT
 1040 CONTINUE
!
      IF(.NOT. DPIOM) GO TO 1050
        DPIBDY = DPIBDY .OR. BO
        DPIWG  = DPIWG  .OR. WGPL
        DPIHT  = DPIHT  .OR. HTPL
        DPIVT  = DPIVT  .OR. VTPL .OR. TVTPAN
        DPIVF  = DPIVF  .OR. VFPL
        DPIBW  = DPIBW  .OR. (BO .AND. WGPL)
        DPIBH  = DPIBH  .OR. (BO .AND. HTPL)
        DPIBV  = DPIBV  .OR. (BO .AND. (VTPL .OR. VFPL .OR. TVTPAN))
        DPIBWH = DPIBWH .OR. (BO .AND. WGPL .AND. HTPL)
        DPIBWV = DPIBWV .OR. (BO .AND. WGPL .AND.                       &
     &                        (VTPL .OR. VFPL .OR. TVTPAN))
        DPITOT = DPITOT .OR. (BO .AND. WGPL .AND. HTPL .AND.            &
     &                        (VTPL .OR. VFPL .OR. TVTPAN))
        DPIPWR = DPIPWR .OR. (PRPOWR .OR. JETPOW)
        DPIDWH = DPIDWH .OR. (WGPL .AND. HTPL)
 1050 CONTINUE
!
!***  DUMP COMPUTATIONAL ARRAYS
!
      IF(DPA)    CALL DMPARY(A,195,1HA,1)
      IF(DPAHT)  CALL DMPARY(AHT,195,3HAHT,3)
      IF(DPAVF)  CALL DMPARY(AVF,195,3HAVF,3)
      IF(DPAVT)  CALL DMPARY(AVT,195,3HAVT,3)
      IF(DPB)    CALL DMPARY(B,49,1HB,1)
      IF(DPBD)   CALL DMPARY(BD,762,2HBD,2)
      IF(DPBHT)  CALL DMPARY(BHT,49,3HBHT,3)
      IF(DPC)    CALL DMPARY(C,51,1HC,1)
      IF(DPCHT)  CALL DMPARY(CHT,51,3HCHT,3)
      IF(DPD)    CALL DMPARY(D,55,1HD,1)
      IF(DPDHT)  CALL DMPARY(DHT,55,3HDHT,3)
      IF(DPDVF)  CALL DMPARY(DVF,55,3HDVF,3)
      IF(DPDVT)  CALL DMPARY(DVT,55,3HDVT,3)
      IF(DPDWA)  CALL DMPARY(DWA,237,3HDWA,3)
      IF(DPFACT) CALL DMPARY(FACT,182,4HFACT,4)
      IF(DPHB)   CALL DMPARY(HB,39,2HHB,2)
      IF(DPLB)   CALL DMPARY(LB,200,2HLB,2)
      IF(DPPW)   CALL DMPARY(PW,315,2HPW,2)
      IF(DPSBD)  CALL DMPARY(SBD,229,3HSBD,3)
      IF(DPSEC)  CALL DMPARY(SECOND,23,4HSECD,4)
      IF(DPSHB)  CALL DMPARY(SHB,61,3HSHB,3)
      IF(DPSLA)  CALL DMPARY(SLA,31,3HSLA,3)
      IF(DPSLAH) CALL DMPARY(SLAH,31,4HSLAH,4)
      IF(DPSLG)  CALL DMPARY(SLG,141,3HSLG,3)
      IF(DPSTB)  CALL DMPARY(STB,135,3HSTB,3)
      IF(DPSTBH) CALL DMPARY(STBH,135,4HSTBH,4)
      IF(DPSTG)  CALL DMPARY(STG,141,3HSTG,3)
      IF(DPSTP)  CALL DMPARY(STP,156,3HSTP,3)
      IF(DPSWB)  CALL DMPARY(SWB,61,3HSWB,3)
      IF(DPTRA)  CALL DMPARY(TRA,108,3HTRA,3)
      IF(DPTRAH) CALL DMPARY(TRAH,108,4HTRAH,4)
      IF(DPWB)   CALL DMPARY(WB,39,2HWB,2)
      IF(DPWBT)  CALL DMPARY(WBT,156,3HWBT,3)
!
!***  DUMP INPUT ARRAYS
!
      IF(DPFLC .OR. DPOPTN .OR. DPSYN .OR. DPBDIN .OR. DPWGIN .OR.      &
     &   DPHTIN .OR. DPVTIN .OR. DPVFIN .OR. DPTVT .OR. DPPWIN .OR.     &
     &   DPLBIN) WRITE(6,1060)
 1060 FORMAT(52H0**** FOLLOWING ARE THE BASIC INPUT DATA BLOCKS ****)
      IF(DPFLC)  CALL DMPARY(FLC,160,3HFLC,3)
      IF(DPOPTN) CALL DMPARY(OPTN,4,4HOPTI,4)
      IF(DPSYN)  CALL DMPARY(SYNA,19,4HSYNA,4)
      IF(DPBDIN) CALL DMPARY(BODYIN,129,4HBDIN,4)
      IF(DPWGIN) CALL DMPARY(WINGIN,101,4HWGIN,4)
      IF(DPHTIN) CALL DMPARY(HTIN,154,4HHTIN,4)
      IF(DPVTIN) CALL DMPARY(VTIN,154,4HVTIN,4)
      IF(DPVFIN) CALL DMPARY(VFIN,154,4HVFIN,4)
      IF(DPTVT)  CALL DMPARY(TVTIN,8,3HTVT,3)
      IF(DPPWIN) CALL DMPARY(PWIN,29,4HPWIN,4)
      IF(DPLBIN) CALL DMPARY(LBIN,21,4HLBIN,4)
!
!***  DUMP IOM ARRAYS
!
      IF(DAMP) GO TO 1080
        IF(DPIBDY .OR. DPIWG .OR. DPIHT .OR. DPIVT .OR. DPIVF .OR.      &
     &     DPIBW .OR. DPIBH .OR. DPIBV .OR. DPIBWH .OR. DPIBWV .OR.     &
     &     DPITOT .OR. DPIPWR .OR. DPIDWH) WRITE(6,1070)
 1070   FORMAT(44H0**** FOLLOWING ARE THE IOM DATA BLOCKS ****)
        IF(DPIBDY) CALL DMPARY(BODY,400,4HBODY,4)
        IF(DPIWG)  CALL DMPARY(WING,400,4HWING,4)
        IF(DPIHT)  CALL DMPARY(HT,380,2HHT,2)
        IF(DPIVT)  CALL DMPARY(VT,380,2HVT,2)
        IF(DPIVF)  CALL DMPARY(VF,380,2HVF,2)
        IF(DPIBW)  CALL DMPARY(BW,380,2HBW,2)
        IF(DPIBH)  CALL DMPARY(BH,380,2HBH,2)
        IF(DPIBV)  CALL DMPARY(BV,380,2HBV,2)
        IF(DPIBWH) CALL DMPARY(BWH,380,3HBWH,3)
        IF(DPIBWV) CALL DMPARY(BWV,380,3HBWV,3)
        IF(DPITOT) CALL DMPARY(BWHV,380,4HBWHV,4)
        IF(DPIPWR) CALL DMPARY(POWER,200,4HPOWR,4)
        IF(DPIDWH) CALL DMPARY(DWASH,60,4HDWSH,4)
 1080 CONTINUE
!
      DO 1090 I=1,4
      IF(WINGIN(15).EQ.FLOAT(I))WINGIN(15)=XTYPE(I)
      IF(  HTIN(15).EQ.FLOAT(I))  HTIN(15)=XTYPE(I)
      IF(  VTIN(15).EQ.FLOAT(I))  VTIN(15)=XTYPE(I)
      IF(  VFIN(15).EQ.FLOAT(I))  VFIN(15)=XTYPE(I)
 1090 END DO
      RETURN
      END
      SUBROUTINE DWASH
!
!***  CALCULATES SUBSONIC DOWNWASH AT ANGLE OF ATTACK
!
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG
      COMMON /BDATA/  BD(762)
      COMMON /WINGD/  A(195), B(49)
      COMMON /WHWB/   FACT(182), WB(39)
      COMMON /WINGI/  CHRDTP,SSPNOP,SSPNE,SSPN,CHRDBP,CHRDR,SAVSI,SAVSO,&
     &                CHSTAT,SWAFP,TWISTA,SSPNDD,DHDADI,DHDADO,         &
     &                TYPE,                                             &
     &                TOVC,DELTAY,XOVC,CLI,ALPHAI,CLALPA(20),           &
     &                CLMAX(20),CMO,LERI,LERO,CAMBER,TOVCO,XOVCO,CMOT,  &
     &                CLMAXL,CLAMO,TCEFF,KSHARP,XAC(20),ARCL,RSVD(2),   &
     &                SLOPE(6),TWASH
      COMMON /HTI/    HTIN(154)
      COMMON /IDWASH/ PDWASH, DWASHI(60)
      COMMON /IWING/  PWING, WING(400)
      COMMON /CONSNT/ PI, DEG, UNUSED, RAD,kand
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      DIMENSION ROUTID(2),ALPHA(21),DEDA(21)
      DIMENSION Q4157A(3),Q44155(2),Q4157B(3)
      DIMENSION X4157A(10),Y4157A(10)
      DIMENSION X157B2(14),X157B1(4),Y4157B(14,4)
      DIMENSION C4157A(6),CCLWJ(6),ANG(20)
      LOGICAL LESEPA,VERTUP
      EQUIVALENCE(SAC4,SWA4)
!
!     ----COMPUTE DOWNWASH ANGLES,SPAN OF VORTEX AT HORIZONTAL TAIL +
!     ----EFFECTIVE DISTANCE BETWEEN THE HORIZONTAL TAIL + THE VORTEX
!
      DATA ROUTID /4HDWAS,4HH   /
      DATA Q4157A/4H4.4.,4H1-68,4HA   /,Q44155/4H4.4.,4H1-66/           &
     &,Q4157B/4H4.4.,4H1-68,4HB   /
!
!     ----FIG 4.4.1-68A TYPE OF FLOW SEPARATION AS A FUNCTION OF AIRFOIL
!     ----AND WING SWEEP-SUBSONIC SPEEDS
!
      DATA X4157A /0.,19.,20.,25.,30.,35.,40.,45.,50.,54./
      DATA Y4157A /3*1.5,1.57,1.68,1.81,2.0,2.25,2.75,3./
!
!     ----FIGURE 4.4.1-68B AVERAGE DOWNWASH ACTING ON AFT LIFTING
!     ----SURFACE-LOW SPEEDS
!
      DATA X157B1 /.0,.2,.6,1./
      DATA X157B2 /.2,.3,.4,.5,.6,.7,.8,.833,1.,1.1 ,1.2,1.3,1.4,1.5/
      DATA Y4157B /1.,1.03,1.068,1.11,1.176,1.26,1.36,1.34,1.20,1.11,1.0&
     &,.88,.74,.6  , .96,.96,.965,.976,.98,1.016,1.036,1.04,.946,.88,.8,&
     &.69,.58,.46  , .74,.73,.72,.71,.69,.67,.644,.638,.582,.56,.52,.48,&
     &.44,.4  ,   .5,.5,.5,.49,.476,.46,.448,.44,.4,.372,.352,.32,.3,.27&
     & /
      DATA I4157A /0/
      DATA M4157A /0/
      DATA ICLWJ /0/, MCLWJ /0/
!
      IDWASH = TWASH+0.5
      SWA4=A(40)
      TRRT=A(27)
      CORR=BD(77)
      TL2OB=A(24)/SSPN
      LESEPA=.FALSE.
!
!     ----FIG 4.4.1-68A TO DETERMINE IF LEADING OR TRAILING EDGE SEP.
!
      CALL TBFUNX(SAC4,TESTDY,DYDX,10,X4157A,Y4157A,C4157A,I4157A,M4157A&
     &            ,NG,0,2,Q4157A,3,ROUTID)
      IF(TESTDY.GT.DELTAY) LESEPA=.TRUE.
      BVRUTP=0.78+0.10*(A(118)-0.40)+0.003*A(40)
      SRATIO=SREF/A(3)
      LEX=1
      DO 1000 J=1,NALPHA
 1000 ANG(J)=B(J+22)
      IF(A(126) .LT. ANG(1)) LEX=-1
!
!     ----LOOP ON ALPHA
!
      DO 1050 J=1,NALPHA
         ALP=FLC(J+22)+CORR
         NA=ABS(ALP)+1.5
         IF(NA .LT. 2)  NA=2
         IF(NA .GT. 21) NA=21
         XNA=NA-1
         DO 1040 K=1,NA
            ALPHA(K)=B(49)+(K-1)*(ALP-B(49))/XNA
            BJ22=A(126)+(K-1)*(ALP-A(126))/XNA
            ADOAD=ABS((BJ22-A(126))/(A(127)-A(126)))
            CALL TBFUNX(BJ22,CLWJ,CLAW,NALPHA,ANG,WING(21),CCLWJ,       &
     &                  ICLWJ,MCLWJ,NG,LEX,1,4HCLWJ,1,ROUTID)
            IF(LEX .LT. 0 .AND. BJ22 .LT. ANG(1))                       &
     &              CLWJ=CLWJ*(BJ22-A(126))/(ANG(1)-A(126))
            CLWJ=SRATIO*CLWJ*WB(2)
!
!     ----FIGURE 4.4.1-66
!
           AEEFOA=TRRT/3.+(1.-TRRT/3.)*(1.4-(1.4-A(43)+.04*A(44))*ADOAD)
           TEST=.4/(1.4-A(43)+.04*A(44))
           IF(ADOAD .LT. TEST)AEEFOA=1.0
           AEFF=A(7)*AEEFOA
           BEFFOB=2.*AEEFOA/(1.+TRRT+(AEEFOA*(1.-TRRT)))
!
!  COMPUTE FIGURE 4.4.1-67 WITH COMPRESSIBILITY
!
            DEDAI=1.62*CLAW/(PI*AEFF)*RAD*SRATIO*WB(2)
            TZOB=TL2OB+SQRT(0.5*(-1.+SQRT(1.+4./AEFF**2)))
            DDEDAV=(1.-DEDAI)/(AEFF*TZOB*SQRT(1.+TZOB**2))
            DEDAV=DEDAI+DDEDAV
            BEFF=2.*SSPN*BEFFOB
!
!     ----COMPUTE LEFF
!
            BDFF=SSPN-SSPNDD
            BEFFO2=BEFF/2.
            IF(SSPNOP.LE.UNUSED)CTEFF=(CHRDTP-CHRDR)/SSPN*BEFFO2+CHRDR
            IF(SSPNOP.LE.UNUSED)GO TO 1010
            CTEFF=((CHRDTP-CHRDBP)/SSPNOP)*(SSPNOP-(SSPN-BEFFO2))+CHRDBP
 1010       CONTINUE
            EFFL=BEFFO2*A(62)+CTEFF/4.
            A(20)=A(24)-EFFL+CHRDR
            WFACT=A(20)
            IF(LESEPA)WFACT=A(24)+A(22)
            BVRU=BVRUTP*BEFF
            FACT(J+61)=A(12)-WFACT*(BJ22/RAD-0.41*CLWJ/(PI*AEFF))       &
     &                 -.5*BEFF*TAN(DHDADI/RAD)
            IF(BEFFO2.GT.BDFF) FACT(J+61)=A(12)-WFACT*(BJ22/RAD-0.41*   &
     &         CLWJ/(PI*AEFF))-(BDFF*TAN(DHDADI/RAD)+(BEFFO2-BDFF)      &
     &         *TAN(DHDADO/RAD))
            IF(CLWJ.EQ.0.0) GO TO 1020
            ERU=0.56*A(7)/CLWJ
            FACT(J+81)=BEFF-(BEFF-BVRU)*SQRT(ABS(A(20)/(SSPN*ERU)))
            GO TO 1030
 1020       FACT(J+81)=BEFF
 1030       BHOBV=2.*HTIN(4)/FACT(J+81)
            AOBVO2=ABS(2.*FACT(J+61)/FACT(J+81))
!
!     ----FIGURE 4.4.1-68B
!
            CALL TLINEX(X157B1,X157B2,Y4157B,4,14,AOBVO2,BHOBV,DEBODE,  &
     &                  1,2,1,2,Q4157B,3,ROUTID)
            IF(DEBODE.LT.0.)DEBODE=0.
            DEDA(K)=DEDAV
            IF(IDWASH .NE. 2) GO TO 1040
            XKA=1./A(7) - 1./(1.+A(7)**1.7)
            XKL=(10.-3.*A(27))/7.
            XLH=(XH-AHT(161)*COS(ALIH/RAD))-(XW-A(161)*COS(ALIW/RAD))
            XKH=(1.-ABS(0.5*A(12)/SSPNE))/(XLH/SSPNE)**(1./3.)
            DEDA(K)=4.44*(XKA*XKL*XKH*SQRT(A(43)))**1.19
 1040    CONTINUE
         DWASHI(J+40)=DEDA(NA)
         CALL TRAPZ(DEDA,NA,ALPHA,DWASHI(J+20),1)
         IF(IDWASH.NE.2)DWASHI(J+20)=DWASHI(J+20)*DEBODE
 1050 END DO
!
!  COMPUTE D(EPSILON)/D(ALPHA) AT ALSCHD
!
      DO 1060 J=1,NALPHA
         CALL TBFUNX(FLC(J+22),Y,DWASHI(J+40),NALPHA,FLC(23),           &
     &               DWASHI(21),CCLWJ,IX,MX,NGX,1,1,4HDEDA,1,ROUTID)
 1060 END DO
      RETURN
      END
      SUBROUTINE DYNBOD
!
!     THIS ROUTINE YIELDS THE FOLLOWING BODY DERIVATIVES-
!       SUB,TRAN,SUPERSONIC    CLQ
!                              CMQ
!                              CLADOT
!                              CMADOT
!       HYPERSONIC             CNQ
!                              CMQ
!
      REAL LB,LN,LA,MACH,LAMN,LAMA,LAMF,NN,NA,NF
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /SYNTSS/ SYNA(19)
      COMMON /BDATA/  BD(762)
      COMMON /IBODY/  PBODY,BODY(400)
      COMMON /BODYI/  BODYIN(129)
      COMMON /SUPBOD/ SBD(227)
      COMMON /POWR/   DYN(213)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      DIMENSION ROUTID(2)
      DIMENSION F(20),SX(20),X(20)
      EQUIVALENCE (XCG,SYNA(1))
      EQUIVALENCE (X(1),BODYIN(2)),(SX(1),BODYIN(22)),(THETAN,SBD(127)),&
     &            (DN,SBD(4)),(D1,SBD(5)),(THETAA,SBD(130)),(D2,SBD(6))
      EQUIVALENCE (CNAN,SBD(128)),(LN,BODYIN(124)),(CNAA,SBD(133)),     &
     &            (LA,BODYIN(125)),(CNAF,SBD(138)),(CMAF,SBD(139))
      EQUIVALENCE (CMAN,SBD(129)),(CMAA,SBD(134))
      EQUIVALENCE (CLQB,BODY(201)),(CMQB,BODY(221)),(CLADB,BODY(241)),  &
     &  (CMADB,BODY(261)),(LAMN,DYN(28)),(LAMA,DYN(29)),(LAMF,DYN(30)), &
     &  (CNQPN,DYN(31)),(CNQPA,DYN(32)),(CNQPF,DYN(33)),(NN,DYN(34)),   &
     &  (NA,DYN(35)),(NF,DYN(36)),(CMQPN,DYN(37)),(CNQHYP,BODY(201)),   &
     &  (CMQPA,DYN(38)),(CMQPF,DYN(39)),(CMQN,DYN(41)),(CMQA,DYN(42)),  &
     &  (CMQF,DYN(43)),(CMQHYP,BODY(221))
      DATA ROUTID/4HDYNB,4HOD  /
!
      SB=BD(56)
      IF(TRANSN.AND.SB.EQ.UNUSED)SB=SBD(19)
      IF(SUPERS.OR.HYPERS)SB=SBD(19)
      IF(HYPERS)GO TO 1050
!
!***  METHOD NOT VALID FOR BOATTAILS OR FLARES DERIVATIVES WILL BE
!     COMPUTED FOR NOSE CYLINDER ONLY
!
      IF(BODYIN(123) .EQ. 1. .OR. BODYIN(123) .EQ. 2.)WRITE(6,1140)
      LB=LN+LA
      IF(LN.EQ.UNUSED.AND.LA.EQ.UNUSED) LB=BD(1)
      IF(SUPERS)GO TO 1000
      IF(TRANSN)GO TO 1010
      CLAB=BODY(101)
      CMAB=BODY(121)
      GO TO 1020
 1000 CLAB=SBD(18)
      CMAB=SBD(110)
      GO TO 1020
 1010 CLAB=BODY(101)
      CMAB=BODY(121)
 1020 CONTINUE
      NX=BODYIN(1)+.5
      CALL TRAPZ(SX,NX,X,VB,1)
      DO 1030 I=1,NX
 1030 F(I)=SX(I)*X(I)
      CALL TRAPZ(F,NX,X,TIM,1)
      XC=TIM/VB
 1040 SAVE=XCG/LB
      TEMP=VB/(SB*LB)
      DYN(40)=VB
!
!    ---- PITCHING DERIVATIVES, CLQ, CMQ - SUB,SUP ----
!
      CLQB=2.*CLAB*(1.-SAVE)
      CMQB=2.*CMAB*((1.-SAVE)**2-TEMP*(XC/LB-SAVE))/                    &
     &     (1.-SAVE-TEMP)
!
!    ---- ACCELERATION DERIVATIVES, CLAD, CMAD - SUB,SUP ----
!
      CLADB=2.*CLAB*TEMP
      CMADB=2.*CMAB*(TEMP*(XC/LB-SAVE))/                                &
     &      (1.-SAVE-TEMP)
!
!   CORRECT TO REFERENCE AREA AND LENGTH
!
      SBASE=BD(57)
      CLQB = CLQB*(SBASE/SR)*(LB/CBARR)**2
      CMQB = CMQB*(SBASE/SR)*(LB/CBARR)**2
      CLADB=CLADB*(SBASE/SR)*(LB/CBARR)
      CMADB=CMADB*(SBASE/SR)*(LB/CBARR)**2
      RETURN
 1050 CONTINUE
!
!    ---- HYPERSONIC PITCHING DERIVATIVE,CNQ ----
!***  METHOD NOT VALID FOR BOATTAILS IF BOATTAIL IS PRESENT DERIVATIVE
!     IS CALCUALTED FOR NOSE CENTERBODY ONLY
!
      THETAF=SBD(16)
      IF(THETAF .EQ. UNUSED)THETAF=0.0
      IF(THETAF .LE. 0.0)WRITE(6,1150)
      TANN=TAN(THETAN)
      SINN=SIN(THETAN)
      COSN=COS(THETAN)
      TANA=TAN(THETAA)
      SINA=SIN(THETAA)
      COSA=COS(THETAA)
      TANF=TAN(THETAF)
      SINF=SIN(THETAF)
      COSF=COS(THETAF)
      LAMN=0.
      ABC=PI/(4.*SR*CBARR)
      LAMA=DN/D1
      LAMF=D1/D2
      IF(D2.LT.1.E-10) D2=0.01
!
!     PREVENTS USE OF METHOD WITH BOATTAILS
!
      IF(THETAF .LE. 0.0)LAMF=1.0
!
!   ----FIGURE 7.2.1.1-9A  ----
!
      CNQPN=.66667/TANN*(2.*(1.-LAMN**3)-3.*LAMN*COSN**2*(1.-LAMN**2))
      CNQPN=CNQPN*ABC*DN**3
!
!   ----FIGURE 7.2.1.1-9A  ----
!
      IF(LAMA.EQ.1.)GO TO 1060
      CNQPA=.66667/TANA*(2.*(1.-LAMA**3)-3.*LAMA*COSA**2*(1.-LAMA**2))
      GO TO 1070
 1060 CNQPA=0.
 1070 CONTINUE
      CNQPA=CNQPA*ABC*D1**3
!
!   ----FIGURE 7.2.1.1-9A  ----
!
      IF(LAMF.EQ.1.)GO TO 1080
      CNQPF=.66667/TANF*(2.*(1.-LAMF**3)-3.*LAMF*COSF**2*(1.-LAMF**2))
      GO TO 1090
 1080 CNQPF=0.
 1090 CONTINUE
      CNQPF=CNQPF*ABC*D2**3
      NN=XCG/CBARR
      NA=(XCG-LN)/CBARR
      NF=(XCG-LA)/CBARR
      CNQN=CNQPN-2.*NN*CNAN
      CNQA=CNQPA-2.*NA*CNAA
      CNQF=CNQPF-2.*NF*CNAF
      CNQHYP=CNQN+CNQA+CNQF
!
!    ---- HYPERSONIC PITCHING DERIVATIVE,CMQ ----
!
      AN=6.*LAMN**2*(1.-LAMN**2)
      BN=-8.*LAMN*(1.-LAMN**3)
      CN=3.*(1.-LAMN**4)
      AA=6.*LAMA**2*(1.-LAMA**2)
      BA=-8.*LAMA*(1.-LAMA**3)
      CA=3.*(1.-LAMA**4)
      AF=6.*LAMF**2*(1.-LAMF**2)
      BF=-8.*LAMF*(1.-LAMF**3)
      CF=3.*(1.-LAMF**4)
      ABC=ABC/CBARR
!
!   ---- FIGURE 7.2.1.2-12 ----
!
      CMQPN=-(AN*COSN**4+ BN*COSN**2+CN)/(6.*SINN**2)-LAMN**4/2.
      CMQPN=CMQPN*ABC*DN**4
!
!   ---- FIGURE 7.2.1.2-12 ----
!
      IF(LAMA.EQ.1.)GO TO 1100
      CMQPA=-(AA*COSA**4+BA*COSA**2+CA)/(6.*SINA**2)-LAMA**4/2.
      GO TO 1110
 1100 CMQPA=0.
 1110 CONTINUE
      CMQPA=CMQPA*ABC*D1**4
!
!   ---- FIGURE 7.2.1.2-12 ----
!
      IF(LAMF.EQ.1.)GO TO 1120
      CMQPF=-(AF*COSF**4 +BF*COSF**2+CF)/(6.*SINF**2)-LAMF**4/2.
      GO TO 1130
 1120 CMQPF=0.
 1130 CONTINUE
      CMQPF=CMQPF*ABC*D2**4
      CMQN=CMQPN-2.*NN*CMAN+NN*CNQPN-2.*NN**2*CNAN
      CMQA=CMQPA-2.*NA*CMAA+NA*CNQPA-2.*NA**2*CNAA
      CMQF=CMQPF-2.*NF*CMAF+NF*CNQPF-2.*NF**2*CNAF
      CMQHYP=CMQN+CMQA+CMQF
      RETURN
!
 1140 FORMAT(52H WARNING*** BODY ALONE DYNAMIC DERIVATIVE METHOD VAL,   &
     & 25HID FOR NOSE CYLINDER ONLY,/12X,21HTAIL EFFECTS IGNORED])
 1150 FORMAT(52H WARNING*** BODY ALONE DYNAMIC DERIVATIVE METHOD NOT,   &
     &32H VALID FOR BODIES WITH BOATTAILS,/,12X,25HBOATTAIL EFFECTS IGNO&
     &RED])
      END
      SUBROUTINE DYPRLS(CDOW,I2,CBAR,CLJW,AW,GAMMA,ALPHA,QOQI,NA,KEPSLN)
!
!     ----LOSS OF DYNAMIC PRESSURE DUE TO WING
!
      REAL   I2,I2OCB
      LOGICAL KEPSLN
      DIMENSION ALPHA(20),QOQI(20),CLJW(20)
      COMMON /WINGD/  A(195), B(48)
      COMMON /IDWASH/ PDWASH, DWASH(60)
      COMMON /CONSNT/ PI, CONST(2), RAD,kand
      COMMON /OPTION/ SREF
!
      FACT=1.62/(PI*AW)
      DO 1000 J=1,NA
         EJ=FACT*CLJW(J)*SREF/A(3)
         IF(KEPSLN) EJ=DWASH(J+20)/RAD
         I2OCB=I2*COS(GAMMA-ALPHA(J)/RAD+EJ)/(COS(GAMMA)*A(16))
         ZWOCB=0.68*SQRT(CDOW*(I2OCB+0.15)*SREF/A(3))
         DQOQ0=2.42*SQRT(CDOW*SREF/A(3))/(I2OCB+0.3)
         ZOCB=I2OCB*TAN(EJ+GAMMA-ALPHA(J)/RAD)
         QOQI(J)=1.-DQOQ0*(COS(0.5*PI*ZOCB/ZWOCB)**2)
         IF(ABS(ZOCB/ZWOCB).GE.1.0) QOQI(J)=1.0
 1000 END DO
      RETURN
      END
      SUBROUTINE EQSPC1(X,S,NP,XE,SE,NE,DSEDX)
!
!     ----COMPUTE S AND DS/DX ON EQUAL SPACED X
!
      DIMENSION ROUTID(2)
      DIMENSION CS(6),X(1),S(1),XE(1),SE(1),DSEDX(1)
      DIMENSION VAR(4),LGH(4)
      DATA ROUTID/4HEQSP,4HC1  /
!
      IF(NP.EQ.1)GO TO 1020
      IS=0
      FNE=NE-1
      XIN=(X(NP)-X(1))/FNE
      XE(1)=X(1)
      SE(1)=S(1)
      XE(NE)=X(NP)
      SE(NE)=S(NP)
      NN=NE-1
      DO 1000 I=2,NN
         XE(I)=XE(I-1)+XIN
         VAR(1)=XE(I)
         LGH(1)=NP
         CALL INTERX(1,X,VAR,LGH,S,SE(I),NP,NP,0,0,0,0,0,0,0,0,         &
     &               4HSE  ,1,ROUTID)
 1000 END DO
      DO 1010 I=1,NE
         CALL TBFUNX(XE(I),DUMM,DSEDX(I),NE,XE,SE,CS,IS,MI,NG,0,0,      &
     &               4HDSED,1,ROUTID)
 1010 END DO
      RETURN
 1020 DO 1030 I=1,NE
         XE(I)=X(1)
         SE(I)=S(1)
 1030 DSEDX(I)=0.0
      RETURN
      END
      SUBROUTINE EQSPCE(X,R,P,S,NP,XE,RE,PE,SE,NE,DSEDX)
!
!***  TRANSFORMS 4-DIMENSIONAL ARRAY SO THAT THE 3 INDEPENDENT ARRAYS
!     ARE EQUALLY SPACED
!
      DIMENSION ROUTID(2)
      DIMENSION CR(6),CP(6),CS(6)
      DIMENSION X(1),R(1),P(1),S(1),XE(1),RE(1),PE(1),SE(1),            &
     &          DSEDX(20)
      DIMENSION VAR(4),LGH(4)
      DATA ROUTID/4HEQSP,4HCE  /
!
      IF(NP.EQ.1)GO TO 1020
      IR=0
      IP=0
      IS=0
!
!     ----EQUAL SPACE ON NEW X S
!
      FNE=NE-1
      XIN=(X(NP)-X(1))/FNE
      XE(1)=X(1)
      RE(1)=R(1)
      PE(1)=P(1)
      SE(1)=S(1)
      XE(NE)=X(NP)
      RE(NE) =R(NP)
      PE(NE)=P(NP)
      SE(NE)=S(NP)
      NN=NE-1
      DO 1000 I=2,NN
         XE(I)=XE(I-1)+XIN
         VAR(1)=XE(I)
         LGH(1)=NP
         CALL INTERX(1,X,VAR,LGH,R,RE(I),NP,NP,0,0,0,0,0,0,0,0,         &
     &               4HRE  ,1,ROUTID)
         CALL INTERX(1,X,VAR,LGH,P,PE(I),NP,NP,0,0,0,0,0,0,0,0,         &
     &               4HPE  ,1,ROUTID)
         CALL INTERX(1,X,VAR,LGH,S,SE(I),NP,NP,0,0,0,0,0,0,0,0,         &
     &               4HSE  ,1,ROUTID)
 1000 END DO
      DO 1010 I=1,NE
         CALL TBFUNX(XE(I),DUMM,DSEDX(I),NE,XE,SE,CS,IS,MI,NG,0,0,      &
     &               4HDSED,1,ROUTID)
 1010 END DO
      RETURN
 1020 DO 1030 I=1,NE
         XE(I)=X(1)
         RE(I)=R(1)
         PE(I)=P(1)
         SE(I)=S(1)
 1030 DSEDX(I)=0.0
      RETURN
      END
      SUBROUTINE CloseFiles
!
!  SUBROUTINE TO CLOSE FILES OPENED IN PROGRAM DATCOM
!
      CLOSE(5)
      CLOSE(6,STATUS='KEEP')
      CLOSE(8)
      CLOSE(9)
      CLOSE(10)
      CLOSE(11)
      CLOSE(12)
      CLOSE(13,STATUS='KEEP')
      CLOSE(14,STATUS='KEEP')
      RETURN
      END Subroutine CloseFiles
      SUBROUTINE EXPDAT
!
!     LOAD THE EXPERIMENTAL DATA NAMELISTS FOR THE CURRENT MACH
!     NUMBER ON TAPE-10
!
      COMMON /IBODY/ PB, CDB(20), CLB(20), CMB(20), CNB(20), CAB(20),   &
     &               CLAB(20), CMAB(20), dum1(260)
      COMMON /IWING/ PW, CDW(20), CLW(20), CMW(20), CNW(20), CAW(20),   &
     &               CLAW(20), CMAW(20), dum13(260)
      COMMON /IHT/   PH, CDH(20), CLH(20), CMH(20), CNH(20), CAH(20),   &
     &               CLAH(20), CMAH(20), dum3(240)
      COMMON /IVT/   PV, CDV, dum4(379)
      COMMON /IBW/   PBW, CDWB(20), CLWB(20), CMWB(20), CNWB(20),       &
     &               CAWB(20), CLAWB(20), CMAWB(20)
      COMMON /IDWASH/ PDW, QOQINF(20), EPSLON(20), DEODA(20)
!
      COMMON /EXPER/ KLIST, NLIST(100), NNAMES, IMACH, MDATA,           &
     &               KBODY, KWING, KHT, KVT, KWB, KDWASH(3),            &
     &               ALPOW, ALPLW, ALPOH, ALPLH
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /ERROR/  LOG(81), LIST
!
      DIMENSION KOL(20), KLOG(9)
      DIMENSION BO(400), WG(400), HT(380), VT(380), BW(380), DW(60)
      LOGICAL MDATA, KBODY, KWING, KHT, KVT, KWB, KDWASH, KLOG, LIST
      EQUIVALENCE (KLOG(1),MDATA), (BO(1),CDB(1)), (WG(1),CDW(1)),      &
     &         (HT(1),CDH(1)), (VT(1),CDV), (BW(1),CDWB(1)),            &
     &         (DW(1),QOQINF(1))
!
!     INITIALIZE FLAGS AND DATA
!
      DO 1000 J=1,9
         KLOG(J) = .FALSE.
 1000 END DO
      REWIND 8
      REWIND 10
      NNAMES = 0
      ALPOW = UNUSED
      ALPOH = UNUSED
      ALPLW = UNUSED
      ALPLH = UNUSED
      DO 1040  J=1,KLIST
         NCARD = NLIST(J)/1000
         IMACH = NLIST(J)-1000*NCARD
         IF(IMACH .NE. I) GO TO 1020
!
!         LOAD THIS NAMELIST ON TAPE 10
!
         NNAMES = NNAMES+1
         DO 1010 K=1,NCARD
            READ(8,1080) (KOL(L),L=1,20)
            WRITE(10,1080) (KOL(L),L=1,20)
 1010    CONTINUE
 1020    CONTINUE
      IF(IMACH .EQ. I) GO TO 1040
!
!         SKIP PAST THIS NAMELIST
!
         DO 1030 K=1,NCARD
            READ(8,1080) KOL(1)
 1030    CONTINUE
 1040 END DO
!
!     READ EXPERIMENTAL DATA AND SET FLAGS
!
      IF(NNAMES .EQ.0) GO TO 1060
          MDATA = .TRUE.
          CALL EXSUBT
          DO 1050 J=1,5
             K = 1+20*(J-1)
             IF(J .GE. 4) K = K+40
             IF(BO(K) .NE. UNUSED) KBODY = .TRUE.
             IF(WG(K) .NE. UNUSED) KWING = .TRUE.
             IF(HT(K) .NE. UNUSED) KHT   = .TRUE.
             IF(VT(K) .NE. UNUSED) KVT   = .TRUE.
             IF(BW(K) .NE. UNUSED) KWB   = .TRUE.
             IF(J .GT. 3) GO TO 1050
             IF(DW(K) .NE. UNUSED) KDWASH(J) = .TRUE.
 1050     CONTINUE
 1060 CONTINUE
!
!     WRITE OUT EXPERIMENTAL DATA FOR THIS MACH
!
      IF(.NOT. MDATA) GO TO 1070
      IF(.NOT. LIST ) GO TO 1070
          WRITE(6,1090)
          CALL XNAM23(1)
          WRITE(6,1090)
 1070 CONTINUE
 1080 FORMAT(20A4)
 1090 FORMAT(1H1)
      RETURN
      END
      SUBROUTINE EXSUBT
!
!     READ EXPERIMENTAL DATA NAMELISTS FROM TAPE-10
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF
      COMMON /EXPER/ KLIST, NLIST(100), NNAMES, IMACH, MDATA,           &
     &               KBODY, KWING, KHT, KVT, KWB, KDWASH(3),            &
     &               ALPOW, ALPLW, ALPOH, ALPLH
!
      LOGICAL MDATA
      IF(NF .LT. 0) RETURN
      IF(.NOT. MDATA) RETURN
      REWIND 10
      DO 1000 K=1,NNAMES
         CALL XNAM23(0)
 1000 END DO
      RETURN
      END
      SUBROUTINE EXTRST(KOL, FROM, TO, STRING)
!
!***  EXTRACT A STRING IN ARRAY KOL AND PUT IN ARRAY STRING.
!***  EXTRACT FROM-TO.
!
      INTEGER FROM,TO,STRING
!
      DIMENSION KOL(80),STRING(80)
!
      II=0
      DO 1000 I=FROM,TO
          II=II+1
          STRING(II)=KOL(I)
 1000 END DO
!
      RETURN
      END
      SUBROUTINE FG6115(DE,XEPORJ,ZJPORJ,VJPOVI)
!
!***  CALCULATES FIG. 4.6.1-15 DOWNWASH INCREMENT DUE TO A SUBSONIC
!     JET IN A SUBSONIC STREAM
!
      DIMENSION D6115B(10),X6115B(13),Z6115B(13,10)
      DIMENSION D6115C(11),X6115C(11),Z6115C(11,11)
!
!     ----FIGURE 4.6.1-30 DOWNWASH INCREMENT DUE TO A SUBSONIC JET IN A
!     ----SUBSONIC STREAM.
!     ----FIGURE 4.6.1-30 PART A
!
      DIMENSION D6115A(10),X6115A(11),Z6115A(11,10)
      DATA D6115A/.02,.03,.04,.05,.06,.07,.08,.1,.12,.15/
      DATA X6115A/-4.5,-4.,0.,4.,8.,12.,16.,20.,24.,28.,30./
      DATA Z6115A / 2.,6.,10.8,13.4,15.2,15.9,15.9,15.4,14.8,13.7,13.2, &
     & 0.,3.,7.6,9.5,10.9,11.6,11.5,10.9,10.,9.0,8.6 ,               .0,&
     & 2.,6.2,7.8,8.8,9.2,9.0,8.5,8.0,7.2,6.6 ,                         &
     & 0.,2.,4.5,6.5,7.5,8.0,7.8,7.4,6.8,6.0,5.5 ,                   .0,&
     & 2.,4.1,6.0,6.8,7.2,7.1,6.6,5.9,5.1,4.9,                          &
     & 0.,0.,3.3,5.2,6.2,6.5,6.3,5.8,5.2,5.4,4.0,                       &
     & 0.,0.,2.6,4.5,5.7,6.,5.9,5.5,5.25,   3.5,3.2 ,                   &
     & 0.,0.,2.0,3.5,4.7,5.2,5.0,4.2,3.4,2.3,2.3,                       &
     & 0.,0.,1.,3.,4.,4.3,4.0,3.1,2.2,2.25,2.3,                         &
     & 0.,0.,1.,2.3,3.,3.1,2.8,2.1,2.2,2.25,2.3 /
!
!     ----FIGURE 4.6.1-30 PART B
!
      DATA D6115B /.1,.15,.2,.3,.4,.6,.8,1.,1.5,2./
      DATA X6115B /-6.,-4.,-2.,0.,4.,8.,12.,14.,16.,20.,24.,28.,30./
      DATA Z6115B /6.,13.,15.5,17.,19.3,20.9,21.8,22.,22.,21.5,20.7,20.,&
     &19.6 , 0.,5.5,10.0,12.,14.7,16.,16.48,16.5,16.40,16.,15.3,14.2,13.&
     &8, 0.,0.,6.9,7.5,12.,13.2,13.6,13.5,13.4,12.9,12.0,11.0,10.5 ,    &
     & 0.,0.,3.1,6.5,9.1,10.0,10.2,10.1,9.95,9.4,8.3,7.3,7.0 ,          &
     & 0.,0.,1.,4.,7.3,8.0,8.0,7.9,7.7,7.0,6.3,5.6,5.25 ,               &
     & 0.,0.,1.,3.2,5.0,5.8,5.7,5.5,5.25,4.8,4.0,3.8,3.9 ,              &
     & 0.,0.,0.,2.,4.0,4.6,4.5,4.2,4.0,3.5,3.4,3.8,3.9  ,               &
     & 0.,0.,0.,2.,3.5,3.75,3.4,3.2,3.0,2.9,3.4,3.8,3.9  ,              &
     & 0.,0.,0.,1.5,2.6,2.8,2.6,2.5,2.5,2.9,3.4,3.8,3.9  ,              &
     & 0.,0.,0.,1.4,1.8,2.0,2.3,2.4,2.5,2.9,3.4,3.8,3.9  /
!
!     ----FIGURE 4.6.1-30 PART C
!
      DATA D6115C/.25,.5,.75,1.0,1.5,2.0,2.5,3.0,4.0,5.0,6.0/
      DATA X6115C /-8.,-4.,-2.,0.,4.,8.,14.,20.,24.,28.,30./
      DATA Z6115C /14.,20.5,22.7,24.5,27.0,6*28. ,                      &
     & 0.,6.,11.5,14.,16.4,17.9,19.,19.,18.6,18.,17.6 ,                 &
     & 0.,0.,6.,7.6,12.1,13.3,14.0,13.7,13.0,12.2,11.8 ,                &
     & 0.,0.,4.,7.3,10.,11.,11.,10.5,10.,9.4,9. ,                       &
     & 0.,0.,1.,4.5,7.2,8.1,8.2,7.7,7.0,6.5,6.0 ,                       &
     & 0.,0.,1.5,3.4,4.8,6.5,6.3,5.8,5.4,4.8,5.0 ,                      &
     & 0.,0.,1.5,3.5,4.9,5.5,5.2,4.8,4.3,4.5,5.0 ,                      &
     & 0.,0.,0.,2.5,4.2,5.0,4.3,3.9,4.3,4.5,5.0  ,                      &
     & 0.,0.,0.,1.9,3.5,3.6,3.3,3.9,4.3,4.5,5.0  ,                      &
     & 0.,0.,0.,1.0,2.9,3.1,3.0,3.9,4.3,4.5,5.0  ,                      &
     & 0.,0.,0.,1.0,2.5,  2.5,3.0,3.9,4.3,4.5,5.0 /
      IF(VJPOVI.GT.2.0)GO TO 1000
!
!     ----HERE FOR TABLE A.
!
      CALL TLINVS(D6115A,X6115A,Z6115A,10,11,DE,XEPORJ,ZJPORJ)
      GO TO 1050
 1000 IF(VJPOVI.LT.8.0)GO TO 1010
!
!     ----HERE FOR TABLE C
!
      CALL TLINVS(D6115C,X6115C,Z6115C,11,11,DE,XEPORJ,ZJPORJ)
      GO TO 1050
 1010 VTEST=VJPOVI-4.0
      IF(ABS(VTEST).LT.1.E-2)GO TO 1020
      IF(VTEST)1030,1020,1040
!
!     ----HERE FOR TABLE B
!
 1020 CALL TLINVS(D6115B,X6115B,Z6115B,10,13,DE,XEPORJ,ZJPORJ)
      GO TO 1050
!
!     ----USE TABLES A + B
!
 1030 CALL TLINVS(D6115A,X6115A,Z6115A,10,11,DA,XEPORJ,ZJPORJ)
      CALL TLINVS(D6115B,X6115B,Z6115B,10,13,DB,XEPORJ,ZJPORJ)
      DE=DA+(DB-DA)*(VJPOVI-2.)/(4.-2.)
      GO TO 1050
!
!     ----USE TABLES B + C
!
 1040 CALL TLINVS(D6115B,X6115B,Z6115B,10,13,DB,XEPORJ,ZJPORJ)
      CALL TLINVS(D6115C,X6115C,Z6115C,11,11,DC,XEPORJ,ZJPORJ)
      DE=DB+(DC-DB)*(VJPOVI-4.)/(8.-4.)
 1050 RETURN
      END
      SUBROUTINE FIG26 ( RN,MACH, CF )
!
!*********     SUBROUTINE TO COMPUTE FIGURE 4.1.5.1-26
!
      REAL MACH
      DIMENSION A(9),B(9),C(9),D(9),E(9),AMACH(9)
      DATA A/4.12963E-6,3.92725E-6,4.55853E-6,4.49735E-6,4.11442E-6,    &
     &       4.51587E-6,4.61971E-6,4.53836E-6,3.86772E-6/
      DATA B/-1.36204E-4,-1.3037E-4,-1.48715E-4,-1.47407E-4,-1.36505E-4,&
     &       -1.47222E-4,-1.48773E-4,-1.44676E-4,-1.23287E-4/
      DATA C/1.7162E-3,1.65388E-3,1.85005E-3,1.83955E-3,1.72383E-3,     &
     &       1.8252E-3,1.81973E-3,1.74944E-3,1.49335E-3/
      DATA D/-9.88935E-3,-9.59519E-3,-1.0503E-2,-1.04587E-2,-9.91294E-3,&
     &       -1.02911E-2,-1.01084E-2,-9.59421E-3,-8.22227E-3/
      DATA E/2.23641E-2,2.18366E-2,2.33437E-2,2.32398E-2,2.22626E-2,    &
     &       2.2622E-2,2.18584E-2,2.04571E-2,1.76472E-2/
      DATA AMACH/0.0,0.3,0.7,0.9,1.0,1.5,2.0,2.5,3.0/
!
      X=ALOG10(RN)
      DO 1000 M=1,8
         IF(MACH.GE.AMACH(M).AND.MACH.LT.AMACH(M+1)) GO TO 1020
 1000 END DO
      M=9
 1010 ASSIGN 1050 TO NT
      GO TO 1060
 1020 ASSIGN 1030 TO NT
      GO TO 1060
 1030 IF(ABS(MACH-AMACH(M)).LE.0.02)GO TO 1050
      YM=TM
      N= M+1
      ASSIGN 1040 TO NT
      L=N
      GO TO 1070
 1040 YN=TM
      CF= YM+((MACH-AMACH(M))/(AMACH(N)-AMACH(M))) * (YN-YM)
      RETURN
 1050 CF=TM
      RETURN
 1060 L=M
 1070 TM=X*(E(L)+X*(D(L)+X*(C(L)+X*(B(L)+X*A(L)))))
      GO TO NT,(1030,1040,1050)
      END
      SUBROUTINE FIG53A ( RV,Z,R)
!
!*********          SUBROUTINE TO COMPUTE FIGURE 4.1.5.2-53-A
!
      DIMENSION A(5),B(5),C(5),D(5),E(5),ZZ(5)
      DATA A/8.98425E-03,4.50351E-03,6.0128E-03,1.07637E-02,8.48758E-03/
      DATA B/-.138262,-.064239,-.08858,-.167056,-.130342/
      DATA C/0.718213,0.263365,0.410583,0.893775,0.67405/
      DATA D/-1.32167,-9.04994E-02,-0.489542,-1.80535,-1.22853/
      DATA E/0.493821,-0.735445,-0.317567,1.02609,0.471355/
      DATA ZZ/0.0,1.0,2.0,4.0,10.0/
      IF(RV.EQ.0.0) GO TO 1070
      X=ALOG10(RV)
      M=1
 1000 TEMP= ABS(Z-ZZ(M))
      IF(Z.GE.ZZ(M).AND.Z.LT.ZZ(M+1)) GO TO 1030
 1010 M=M+1
      IF(M.GT.4) GO TO 1060
 1020 GO TO 1000
 1030 CONTINUE
      YM=A(M)*X**5+B(M)*X**4+C(M)*X**3+D(M)*X**2+E(M)*X
      IF(TEMP.LE.0.001) GO TO 1050
 1040 N=M+1
      YN=A(N)*X**5+B(N)*X**4+C(N)*X**3+D(N)*X**2+E(N)*X
      R=YM+((Z-ZZ(M))/(ZZ(N)-ZZ(M)))*(YN-YM)
      IF(R.LT.0.)R=0.
      RETURN
 1050 R=YM
      IF(R.LT.0.)R=0.
      RETURN
 1060 R=A(M)*X**5+B(M)*X**4+C(M)*X**3+D(M)*X**2+E(M)*X
      IF(R.LT.0.)R=0.
      RETURN
 1070 R=0.0
      RETURN
      END
      SUBROUTINE FIG60B(BETA, BTANA, CNAA)
! ***
! *** INTERPOLATE DATCOM FIGURE 4.1.3.3-60B FOR FIN CNAA
! ***
! *** REFERENCE   DATCOM SECTION 4.1.3.3
! ***
! *** LIMITATIONS   SUPERSONIC FIN LEADING EDGE
! ***               ATTACHED SHOCK
! ***               STRAIGHT TAPERED FINS
! ***
! *** INPUT   BETA    MACH SIMILARITY PARAMETER, SQRT(MACH**2-1.0)
! ***         BTANA   BETA*TAN(ALPHA), ALPHA = ANGLE OF ATTACK
! ***
! *** OUTPUT  CNAA    CN PER SIN(ALPHA)**2
! ***
! ***
      DIMENSION XA(13), YA(9), Z60B(117), BTA(13)
      DIMENSION Q60B(3), ROUT(2), C(6)
! ***
! *** CONSTANT DATA
! ***
      DATA DUM  / 1.0 /
      DATA Q60B / 4H4.1., 4H3.3-, 4H60B  /
      DATA ROUT / 4HFIG6, 4H0B   /
! ***
! *** FIGURE 4.1.3.3-60B
! ***
      DATA XA / 0.0, 0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8,       &
     &          2.0, 2.2, 2.4 /
      DATA YA / 1.25, 1.50, 1.75, 2.00, 2.50, 3.0, 4.0, 5.0, 20.0 /
      DATA Z60B / 0.000,  .047,  .089,  .127,  .160,  .188,  .211,      &
     &             .231,  .247,  .258,  .266,  .269,  .270,             &
     &            0.000,  .104,  .192,  .259,  .311,  .357,  .395,      &
     &             .426,  .452,  .474,  .492,  .505,  .515,             &
     &            0.000,  .112,  .215,  .308,  .405,  .499,  .572,      &
     &             .624,  .667,  .704,  .735,  .760,  .780,             &
     &            0.000,  .132,  .270,  .400,  .521,  .637,  .732,      &
     &             .820,  .878,  .925,  .962,  .986, 1.000,             &
     &            0.000,  .183,  .353,  .534,  .700,  .873, 1.040,      &
     &            1.190, 1.300, 1.388, 1.461, 1.520, 1.563,             &
     &            0.000,  .223,  .447,  .652,  .865, 1.096, 1.325,      &
     &            1.525, 1.697, 1.842, 1.978, 2.105, 2.222,             &
     &            0.000,  .270,  .576,  .845, 1.106, 1.447, 1.803,      &
     &            2.222, 2.511, 2.707, 2.875, 3.014, 3.125,             &
     &            0.000,  .270,  .575,  .890, 1.170, 1.563, 1.960,      &
     &            2.473, 2.921, 3.333, 3.744, 4.148, 4.545,             &
     &            0.000,  .306,  .629,  .925, 1.232, 1.667, 2.262,      &
     &            3.004, 4.065, 5.814, 9.259, 20.83, 1000. /
! ***
! *** CONSTRUCT CURVE OF CNAA VS BETA*TAN(ALPHA) AT INPUT BETA
! ***           XA   - CNAA CURVE
! ***           YA   - BETA CURVE
! ***           Z60B - BETA*TAN(ALPHA) VS CNAA AND BETA
! ***
      BTA(1) = 0.0
      DO 1000 I=2,13
        CALL TLINEX(YA, XA, Z60B, 9, 13, BETA, XA(I), BTA(I),           &
     &              1, 1, 0, 0, Q60B, 3, ROUT)
 1000 END DO
!
! *** LOOK-UP FOR CNAA
!
      BTAN = BTANA
      IF(BTAN .GT. BTA(13)) BTAN = BTA(13)
      CALL TBFUNX(BTAN, CNAA, DYDX, 13, BTA, XA, C, IN,                 &
     &            MI, NG, 0, 0, Q60B, 3, ROUT)
      RETURN
      END
      SUBROUTINE FIG68 (XM, DELT, THETA, IER)
!
!     THIS SUBROUTINE TAKES THE FREE STREAM MACN NUMBER (XM) AND WEDGE
!     ANGLE (DELT) AND SOLVES THE CUBIC EQUATION FOR SHOCK ANGLE
!     (THETA). THE CUBIC EQUATION FROM NACA REPT. 1135 IS -
!         X**3+P*X**2+Q*X+R=0.0, WHERE X=SIN(THETA)**2.
!
!     DEFINITION OF PARAMETERS -
!         XM    - FREE STREAM MACH NUMBER
!         DELT  - WEDGE ANGLE, IN DEGREES
!         THETA - SHOCK ANGLE, IN DEGREES
!         IER   - ERROR INDICATOR
!               IER=0 NO ERROR
!               IER=1 DELT .LT. 0.0, THETA = MACH ANGLE
!               IER=2 DETACHED SHOCK, THETA = MAX. WEDGE ANGLE FOR
!                                             ATTACHED SHOCK
!               IER=3 XM .LT. 1.0, THETA = 0.0
!
!     METHOD -
!         A CUBIC EQUATION, X**3 + P*X**2 + Q*X + R = 0.0, MAY BE
!         REDUCED TO THE FORM - Y**3 + A*Y + B =0.0, BY SUBSTITUTING
!         FOR X THE VALUE Y-P/3. HERE A = (3*Q - P**2)/3 AND
!         B = (2*P**3 - 9*P*Q + 27*R)/27. FOR ATTACHED SHOCKS AND
!         POSITIVE WEDGE ANGLES THERE ARE THREE REAL AND UNEQUAL
!         ROOTS. IN THIS CASE A TRIGOMETRIC SOLUTION CAN BE USED.
!         FIRST THE ANGLE PHI IS COMPUTED USING THE EXPRESSION -
!         COS(PHI) = -(B/2)/SQRT(-A**3/27), THEN Y WILL HAVE THE
!         FOLLOWING VALUES - Y1=C*COS(PHI/3), Y2=C*COS(PHI/3+120 DEG),
!         AND Y3=C*COS(PHI/3+240 DEG), WHERE C = 2*SQRT(-A/3). THE
!         THREE VALUES OF X ARE - XI = YI-P/3 (I=1,2,3).
!
!         THE INTERPRETATIONS OF THE THREE ROOTS ARE -
!              X1 - CORRESPONDS TO DECREASING ENTROPY, DISREGARD,
!              X2 - STRONG SHOCK, DISREGARD,
!              X3 - WEAK SHOCK, DESIRED ANSWER,
!                 = C*COS(PHI/3 + 240) - P/3.
!                 = SIN(THETA)**2
!
      COMMON /CONSNT/ PI,DEG,UNUSED,DR,kand
      EQUIVALENCE (TMIN,P), (TMAX,S2D,Q,COSP), (DMAX,C2D,R,B,PHI3)
      EQUIVALENCE (XM2,A,S2T)
      IF(XM .LT. 1.0) GO TO 1000
      IER = 0
      DMAX = 0.0
      TMIN = DR*ARCSIN(1./XM)
      IF(XM .EQ. 1.0 .AND. DELT .EQ. 0.0) GO TO 1020
      IF(XM .EQ. 1.0 .AND. DELT .GT. 0.0) GO TO 1030
      IF(DELT .LT. 0.0) GO TO 1010
      IF(DELT .EQ. 0.0) GO TO 1020
      XM2 = XM*XM
      TMAX = (3.*XM2-5.+SQRT(9.*XM2*XM2+12.*XM2+60.))/(7.*XM2)
      DMAX = 1.2*XM2/(XM2*TMAX-1.)-1.
      TMAX = ARCSIN(SQRT(TMAX))
      DMAX = TAN(TMAX)*DMAX
      DMAX = ATAN(1./DMAX)*DR
      TMAX = TMAX*DR
      IF(DELT .GT. DMAX) GO TO 1030
      IF(DELT .EQ. DMAX) GO TO 1040
      S2D = SIN(DELT/DR)
      S2D = S2D*S2D
      C2D = 1.-S2D
      P = -(XM2+2.)/XM2-1.4*S2D
      Q = (2.*XM2+1.)/(XM2*XM2)+(1.44+0.4/XM2)*S2D
      R = -C2D/(XM2*XM2)
      A = Q-P*P/3.
      B = (2.*P*P*P-9.*P*Q+27.*R)/27.
      COSP = -B/(2.*SQRT(-A*A*A/27.))
      PHI3 = ARCCOS(COSP)/3.
      S2T = 2.*SQRT(-A/3.)*COS(PHI3+240./DR)-P/3.
      THETA = ARCSIN(SQRT(S2T))*DR
      RETURN
 1000 IER = 3
      THETA = 0.0
      RETURN
 1010 IER = 1
 1020 THETA = TMIN
      RETURN
 1030 IER = 2
      THETA = DMAX
      RETURN
 1040 THETA = TMAX
      RETURN
      END
      SUBROUTINE FINDCH(KOL, CHAR, KCOL)
!
!***  SKIP TO CHARACTER CHAR IN ARRAY KOL, KCOL POINTS TO THE COLUMN
!***  THAT THE CHARACTER RESIDES.  IF THE CHARACTER IS NOT FOUND,
!***  KCOL IS SET TO 81.
!
      INTEGER CHAR
!
      DIMENSION KOL(80)
!
 1000 IF(KOL(KCOL) .EQ. CHAR)GO TO 1010
      KCOL=KCOL+1
!
      IF(KCOL .LT. 81)GO TO 1000
!
 1010 CONTINUE
!
      RETURN
      END
      SUBROUTINE FINDVN(NUMVN, LENVN, INAME, VNAME, DVNAME, NVN, FOUND)
!
!***  FIND MATCHING VARIABLE NAME
!
!***  INPUTS
!
!  NUMVN - NUMBER OF VARIABLE NAMES TO SEARCH
!  LENVN - ARRAY THAT DEFINES THE LENGTH OF EACH VARIABLE NAME
!  INAME - ARRAY THAT DEFINES THE NAME TO COMPARE
!  VNAME - ARRAY THAT CONTAINS ALL OF THE VARIABLE NAMES
! DVNAME - DIMENSION OF VNAME ARRAY
!
!***  OUTPUTS
!
!    NVN - NUMBER OF VARIABLE FOR WHICH THERE IS A MATCH
!  FOUND - .TRUE. IF VARIABLE NAME MATCH FOUND
!
      INTEGER DVNAME,VNAME,BLANK
!
      LOGICAL FOUND
!
      DIMENSION LENVN(NUMVN),INAME(80),VNAME(DVNAME)
!
      DATA BLANK / 4H     /
!
      FOUND=.FALSE.
!
      INDX=1
!
      DO 1020 NVN=1,NUMVN
!
         IF(NVN .GT. 1)INDX=INDX+MAXC
!
         MAXC=LENVN(NVN)
!
         DO 1000 I=1,MAXC
            IF(INAME(I) .NE. VNAME(I+INDX-1))GO TO 1020
 1000    CONTINUE
!
! ... MAKE SURE REST OF NAME IS BLANK, ELSE NOT RIGHT ONE
!
         J=MAXC+1
         DO 1010 I=J,80
            IF(INAME(I) .NE. BLANK)GO TO 1020
 1010    CONTINUE
!
         FOUND=.TRUE.
         GO TO 1030
!
 1020 END DO
!
      NVN=0
!
 1030 CONTINUE
!
      RETURN
      END
      SUBROUTINE FLAPCM
!
!***  COMPUTES WING CM DUE TO FLAPS
!
      COMMON /OVERLY/ NLOG,NMACH,II,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /FLAPIN/ F(69)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /POWR/   PW(104),FLP(189)
      COMMON /SUPDW/  DW(35),TCD(58)
      COMMON /SUPWH/  FCM(282)
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ AHT(195)
      COMMON /OPTION/ SREF,CBARR
      COMMON /IWING/  PWING, WING(400)
      COMMON /WINGI/  WINGIN(77)
      COMMON /HTI/    HTIN(131)
      REAL MACH
      REAL KK(14)
      DIMENSION CFOC(14),DELTP(14)
      DIMENSION ETAK(14),CK(14)
      DIMENSION ETAG(4), BOC(4),CC(4),GDFULL(14),GDINBD(14),GDOUTB(14)
      DIMENSION VAR(4),LGH(4)
      DIMENSION DELCM(10),SCMD(10)
      DIMENSION SDCL(10),DELTA(10),ALDAG(40),ALPDEL(10),ETA(5),DELTGD(  &
     &14),CL(14),XCP(14),XLE(14),DXCP(140),DCMF(14),XC(14),DELCMF(14),  &
     &SWEPB(14),CHRD(5)
      DIMENSION X5126A(13),Y5126A(13),F5126A(3)
      DIMENSION CLOALD(14)
      DIMENSION X2126B(11),X1126B(4),Y5126B(44),F5126B(3)
      DIMENSION X1215B(5),X2215B(7),Y1215B(35),F1215B(3)
      DIMENSION GDI(14),GDO(14),ET(14),CPRMEI(10),CPRMEO(10)
      DIMENSION ROUTID(2),CPKK(5),X12136(9),Y12136(9),F12136(3)
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      EQUIVALENCE (GDI(1),TCD(1)),(GDO(1),TCD(15)),(GDFULL(1),TCD(29))
      EQUIVALENCE (XCG,SYNA(1)),(CPRMEI(1),F(39)),(CPRMEO(1),F(49))
      EQUIVALENCE (ETA(1),FLP(1)),(ALDAG(1),FLP(150))
      EQUIVALENCE (SDCL(1),F(19)),(DELTA(1),F(1)),(SCMD(1),F(29))
      EQUIVALENCE (DELN4,FLP(60)),(CPKK(1),FLP(28))
      EQUIVALENCE (ETAK(1),FCM(7))
      EQUIVALENCE (CFI,F(12)),(CFO,F(13))
      EQUIVALENCE (SWEEPB,FCM(1)),(BOC(1),FCM(2)),(CAVG,FCM(6)),        &
     &            (GDINBD(1),FCM(35)),(GDOUTB(1),FCM(49)),              &
     &             (ALPDEL(1),FCM(63)),(CK(1),FCM(73)),                 &
     &             (DELTGD(1),FCM(87)),(KK(1),FCM(101)),                &
     &             (XLE(1),FCM(115)),(CFOC(1),FCM(129)),                &
     &             (DELCM(1),WING(211)),(DXCP(1),FCM(143)),             &
     &             (CLOALD(1),FCM(21))
      DATA ROUTID /4HFLAP,4HCM  /
      DATA ETAG   /0.924,.707,.383,0.0/
      DATA ET     /0.0,.1423,.2817,.4153,.5407,.6549,.7557,.8412,.9097, &
     &             .9595,.9898,1.0,.5,.75/
!
!     FIGURE 6.1.5.1-67A
!
      DATA F5126A/4H6.1.,4H5.1-,4H67A /
      DATA X5126A/                                                      &
     & -.02,   0.,     .02,    .04,    .06,    .08,    .10,    .12,     &
     & .14,    .16,    .18,    .20,    .22/
      DATA Y5126A/                                                      &
     & 1.,     1.,     .955,   .845,   .665,   .485,   .33,    .21,     &
     & .12,    .06,    .018,   0.,     0./
!
!     FIGURE 6.1.5.1-67B
!
      DATA F5126B/4H6.1.,4H5.1-,4H67B /
      DATA X2126B/                                                      &
     & 0.,     .1,     .2,     .3,     .4,     .5,     .6,     .7,      &
     & .8,     .9,     1./
      DATA X1126B/0.,20.,20.01,60./
      DATA Y5126B/                                                      &
     & .745,   .698,   .65,    .6,     .55,    .5,     .45,    .4,      &
     & .35,    .3,     .25,                                             &
     & .745,   .698,   .65,    .6,     .55,    .5,     .45,    .4,      &
     & .35,    .3,     .25,                                             &
     & .75,    .704,   .675,   .63,    .6,     .593,   .59,    .592,    &
     & .598,   .6,     .6,                                              &
     & .75,    .704,   .675,   .63,    .6,     .593,   .59,    .592,    &
     & .598,   .6,     .6/
!
!     ----FIGURE 6.1.2.1-35B PLAIN FLAP
!
      DATA X1215B/.1,.2,.25,.3,.5/,X2215B/0.,10.,20.,30.,40.,50.,70./,  &
     & Y1215B/0.,-.05,-.105,-.14,-.163,-.175,-.180 , 0.,-.086,-.16,-.20,&
     &-.219,-.23,-.24 , 0.,-.11,-.195,-.245,-.27,-.28,-.29 , 0.,-.09,   &
     &-.165,-.22,-.24,-.26,-.26 , 0.,-.078,-.145,-.2,-.235,-.26,-.28 /, &
     & F1215B/4H6.1.,4H2.1-,4H35B  /
      DATA X12136/0.,.05,.1,.2,.3,.35,.4,.45,.5/
      DATA Y12136/0.,-.00025,-.00065,-.00165,-.0026,-.0031,-.00345,     &
     & -.0036,-.00375/
      DATA F12136/4H6.1.,4H2.1-,4H36  /
!
!    -----SET GEOMETRY FOR H.L. AND CONTROL DEVICE ON WING OR HORZ. TAIL
!
      IF(HTPL)GO TO 1000
!
!    -----HERE FOR DEVICE ON WING
!
      CLASEC=WINGIN(II+20)
      TANC4=A(68)
      SWSTR=A(3)
      BSTO2=WINGIN(3)
      TANTE=A(80)
      TANLE=A(62)
      XW=SYNA(2)
      CR=A(10)
      TAPEXP=A(27)
      ARSTAR=A(7)
      BO2=WINGIN(4)
      ALPO=A(134)
      CMO=WINGIN(61)
      GO TO 1010
!
!    -----HERE FOR DEVICE ON HORZ. TAIL
!
 1000 TANC4=AHT(68)
      CLASEC=HTIN(II+20)
      SWSTR=AHT(3)
      BSTO2=HTIN(3)
      BO2=HTIN(4)
      TANTE=AHT(80)
      TANLE=AHT(62)
      XW=SYNA(6)
      CR=AHT(10)
      TAPEXP=AHT(27)
      ARSTAR=AHT(7)
      ALPO=AHT(134)
      CMO=HTIN(61)
 1010 CONTINUE
      MACH=FLC(II+2)
      BETA=SQRT(1.-MACH**2)
      NDELTA=F(16)+0.5
      ARG1=TANC4/BETA
      SWEEPB=ATAN(ARG1)*RAD
      CAVG=SWSTR/(2.*BSTO2)
      IFTYPE=F(17)+.5
!
!    ----CALCULATE CHORDS FOR G/DELTA SUBROUTINE CALL FOR ETA STATIONS
!        OF 0.0,.383,.707,.924
!
      ARG1=(TANTE-TANLE)*BSTO2
      DO 1020 K=1,4
         CC(K)=CR+ETAG(K)*ARG1
 1020 BOC(K)=2.*BETA*BSTO2/CC(K)
      DO 1030 J=1,12
         IF(ETA(1).EQ.ET(J))ETA(1)=ETA(1)+.0001
 1030 IF(ETA(5).EQ.ET(J))ETA(5)=ETA(5)-.0001
      CALL GDELTA(GDFULL,GDI   ,GDO   ,ETA(1),ETA(5),BOC,SWEEPB)
      ET  (13)=ETA(1)
      ET  (14)=ETA(5)
!
!    -----CALCULATE AVERAGE (ALPHA)DELTA OVER FLAP SPAN
!
      IF(SDCL(1).EQ.UNUSED)GO TO 1050
      DO 1040 I=1,NDELTA
 1040 ALPDEL(I)=-SDCL(I)/(DELTA(I)*CLASEC)
      GO TO 1080
 1050 CONTINUE
      NN=0
      DO 1070 I=1,NDELTA
         SUM=0.0
         DO 1060 K=1,4
            NN=NN+1
 1060    SUM=SUM+ALDAG(NN)
 1070 ALPDEL(I)=SUM/4.
 1080 CONTINUE
!
!    -----CALCULATE CHORDS CORRESPONDING TO SPAN STATIONS OF G/D CALCU
!     INSERT INBOARD AND OUTBOARD ETA STATIONS IN PROPER SEQUENCE
!
      KOUT=1
      DO 1140 J=1,11
         ETAK(J)=ET(J)
         GDINBD(J)=GDI(J)
         GDOUTB(J)=GDO(J)
         IF(ETA(1).GT.ET(J).AND.ETA(1).LT.ET(J+1))GO TO 1090
         GO TO 1140
 1090    KINBD=J+1
         ETAK(KINBD)=ETA(1)
         GDINBD(KINBD)=GDI(13)
         GDOUTB(KINBD)=GDO(13)
         JJ=J+2
         N=1
 1100    DO 1110 K=JJ,14
            ETAK(K)=ET(K-N)
            GDINBD(K)=GDI(K-N)
 1110    GDOUTB(K)=GDO(K-N)
         IF(KOUT.EQ.2)GO TO 1150
         K=J+1
         ET(K)=ETA(1)
         DO 1130 I=K,11
            IF(ETA(5).GT.ET(I).AND.ETA(5).LT.ET(I+1))GO TO 1120
            GO TO 1130
 1120       KOUTBD=I+2
            ETAK(KOUTBD)=ETA(5)
            KOUT=2
            GDINBD(KOUTBD)=GDI(14)
            GDOUTB(KOUTBD)=GDO(14)
            JJ=I+3
            N=2
            GO TO 1100
 1130    CONTINUE
 1140 END DO
 1150 CONTINUE
      ARG=(CFI-CFO)/(4.*DELN4)
      ARG7=BSTO2*TANLE
      DO 1160 K=1,14
         CFOC(K)=0.0
         CK(K)=CR+ETAK(K)*ARG1
         IF(K.GE.KINBD.AND.K.LE.KOUTBD)                                 &
     &      CFOC(K)=(CFI-ARG*(ETAK(K)-ETA(1)))/CK(K)
         XLE(K)=XW+(BO2-BSTO2)*TANLE+ETAK(K)*ARG7
         DELTGD(K)=GDOUTB(K)-GDINBD(K)
 1160 END DO
      ARG1=BSTO2*TANLE
      ARG2=(1.-TAPEXP)/(1.+TAPEXP)
      KOUNT=1
      INDEX=KINBD
      NN=0
      DO 1400 I=1,NDELTA
         ARGZ=ABS(DELTA(I))
         K=KINBD
         CL(K)=-4.*BSTO2*DELTGD(K)*ALPDEL(I)*DELTA(I)/(CK(K)*RAD)
         K=KOUTBD
         CL(K)=-4.*BSTO2*DELTGD(K)*ALPDEL(I)*DELTA(I)/(CK(K)*RAD)
         DO 1390 K=1,13
            L=K
            CL(K)=-4.*BSTO2*DELTGD(K)*ALPDEL(I)*DELTA(I)/(CK(K)*RAD)
            IF(I.EQ.1)CLOALD(K)=-4.*BSTO2*DELTGD(K)/(CK(K)*RAD)
            IF(CL(K).EQ.0.0)GO TO 1370
!
!    ---- CHECK IF ETA IS OUTSIDE FLAP REGION OF INFLUENCE ----
!
            IF (ETAK(K).LE.(ETA(1)-0.2).OR.ETAK(K).GT.(ETA(5)+0.2))     &
     &        GO TO 1170
!
!     ---- CALCULATE DELTA CMF2 ----
!
            ARG=CFOC(KINBD)
 1170       IF (ETAK(K).LT.ETA(1).OR.ETAK(K).GT.ETA(5)) GO TO 1180
            KOUNT=3
            ARG=CFOC(K)
 1180       IF (ETAK(K).LE.ETA(5)) GO TO 1190
            KOUNT=2
            ARG=CFOC(KOUTBD)
 1190       CONTINUE
!
!    -----IF PLAIN,SPLIT,OR L.E. FLAPS CALL FIG. 6.1.5.1-67B.
!    -----FOR ALL SLOTTED DEVICES,SET XCPBI=0.54
!
            IF(IFTYPE.NE.1.AND.IFTYPE.NE.5)GO TO 1200
!
!       FIGURE 6.1.5.1-67B  (XCP)B
!
            CALL TLINEX(X1126B,X2126B,Y5126B,4,11,ARGZ    ,ARG,XCPBI,   &
     &                  0,0,0,0,F5126B,3,ROUTID)
            GO TO 1210
 1200       XCPBI=0.54
 1210       ARG3=4.0*(XCPBI-0.25)*ARG2/ARSTAR
            ARG4=TANC4-ARG3
            SWEPBI=ATAN(ARG4)*RAD
            ARG4=COS(SWEPBI/RAD)
            DELTPI=ATAN(TAN(ARGZ    /RAD)/ARG4)*RAD
            IF(KOUNT.EQ.3)GO TO 1240
            IF(KOUNT.EQ.2)INDEX=KOUTBD
 1220       IF(KK(K) .NE. UNUSED)GO TO 1230
!
!              FIGURE 6.1.5.1-67A (K)K
!
            VAR(1)=ABS(ETAK(K)-ETAK(INDEX))
            LGH(1)=13
            CALL INTERX(1,X5126A,VAR,LGH,Y5126A,KK(K),13,13,            &
     &                  0,0,0,0,0,0,0,0,F5126A,3,ROUTID)
 1230       CONTINUE
!
!     ---- ETA OUTSIDE FLAP REGION, SET KP=2 ----
!
            SWEPB(K)=SWEPBI
            DELTP(K)=DELTPI
            IF(KOUNT.EQ.2)L=KOUTBD
            COSSB2=COS(SWEPB(K)/RAD)**2
            KP=2
            GO TO 1250
!
!     ---- ETA INSIDE FLAP REGION, SET KP=1 ----
!
 1240       DELTP(K)=DELTPI
            SWEPB(K)=SWEPBI
            COSSB2=COS(SWEPB(K)/RAD)**2
            KP=1
 1250       CONTINUE
            IF (SCMD(1).EQ.UNUSED) GO TO 1280
!
!     ---- COMPUTE SECTION XCP IF DELTA CM IS INPUT ----
!
            DELCMF(K)=SCMD(I)
            IF (KP.EQ.1) GO TO 1260
            XC(K)=0.25+ABS(KK(K)*DELCMF(K)/CL(INDEX)*COSSB2)
            XCP(K)=XLE(K)+XC(K)*CK(K)
            GO TO 1270
 1260       XC(K)=0.25+ABS(DELCMF(K)*COSSB2/CL(K))
            XCP(K)=XLE(K)+XC(K)*CK(K)
!
 1270       GO TO 1370
!
!     ---- SECTION XCP FOR PLAIN FLAPS ----
!
 1280       IF (IFTYPE.GT.1) GO TO 1310
!
!     ---- SECTION XCP FOR PLAIN FLAPS ----
!
!              FIGURE 6.1.2.1-35B PLAIN FLAP
!
            CALL TLINEX(X1215B,X2215B,Y1215B,5,7,CFOC(L),DELTP(K),      &
     &                 DELCMF(K),0,0,0,0,F1215B,3,ROUTID)
            IF (KP.EQ.1) GO TO 1290
            XC(K)=0.25+ABS(KK(K)*DELCMF(K)/CL(INDEX)*COSSB2)
            XCP(K)=XLE(K)+XC(K)*CK(K)
            GO TO 1300
 1290       XC(K)=0.25+ABS(DELCMF(K)*COSSB2/CL(K))
            XCP(K)=XLE(K)+XC(K)*CK(K)
 1300       GO TO 1370
 1310       CONTINUE
!
!     ---- SECTION XCP FOR SLOTTED,SPLIT,AND FOWLER FLAPS ----
!
            XREFOC= .25
            XCPOCP= .44
            IF(IFTYPE .EQ. 5) XCPOCP=0.5-0.25*CFOC(L)
            CPOC=-((CPRMEO(I)-CPRMEI(I))/(ETA(1)-ETA(5))*(ETAK(K)-      &
     &            ETA(5))- CPRMEO(I))/CK(K)
            IF(ETAK(K) .LT. ETA(1) .OR. ETAK(K) .GT. ETA(5)) CPOC=1.0
            IF(IFTYPE .GE. 5) GO TO 1320
            IND=4*(I-1)
            SCL=(FLP(110+IND)+FLP(111+IND)+FLP(112+IND)+FLP(113+IND))/4.
            DELCMF(K)=SCL*(XREFOC-XCPOCP*CPOC)
            GO TO 1330
 1320       CONTINUE
!
!     ---- SECTION XCP FOR LE FLAPS,SLATS AND KRUEGER FLAPS ----
!
            IF(IFTYPE.EQ.6) CPOC=1.0
!
!           FIGURE 6.1.2.1-36  CM DELTA LE
!
            VAR(1)=CFOC(L)/CPOC
            LGH(1)=9
            CALL INTERX(1,X12136,VAR,LGH,Y12136,CMDLEP,9,9,             &
     &                  0,0,0,0,0,0,0,0,F12136,3,ROUTID)
            IND=4*(I-1)
            SCL=(FLP(110+IND)+FLP(111+IND)+FLP(112+IND)+FLP(113+IND))/4.
            DELCMF(K)=CMDLEP*CPOC**2*DELTA(I)+(XREFOC+CPOC-1.)*SCL      &
     &                +.75*CLASEC*ALPO*CPOC*(CPOC-1.)+(CPOC**2-1.)*CMO
 1330       IF (KP.EQ.1) GO TO 1340
            XC(K)=0.25-(KK(K)*DELCMF(K)/CL(INDEX)*COSSB2)
            XCP(K)=XLE(K)+XC(K)*CK(K)
            GO TO 1350
 1340       XC(K)=0.25-(DELCMF(K)*COSSB2/CL(K))
            XCP(K)=XLE(K)+XC(K)*CK(K)
 1350       GO TO 1370
!
!     ---- CALCULATE DELTA CMF1 ----
!
 1360       XCP(K)=XLE(K)+0.25*CK(K)
 1370       NN=NN+1
            IF (CL(K).EQ.0.0) GO TO 1380
            DXCP(NN)=(XCG-XCP(K))/CBARR
 1380       DCMF(K)=CL(K)*DXCP(NN)*CK(K)*SWSTR/(CAVG*SREF)
 1390    CONTINUE
         DCMF(14)=0.0
         NN=NN+1
         DXCP(NN)=DXCP(NN-1)
         CLOALD(14)=0.0
!
!    ----INTEGRATE DCMF OVER FLAP SPAN
!
         CALL TRAPZ(DCMF,14,ETAK,DELCM(I),1)
 1400 END DO
      RETURN
      END
      SUBROUTINE FLTCL(FOT,IFOT,NTRIM,CLUT,CDUT,CMUT,DELT,              &
     &                 DCLT,DCLMT,DCDIT,DCDMT,CDHT,CLT,CDT,             &
     &                 ICASE)
!
      COMMON /OPTION/   SREF,CBARR,ROUGFC,BLREF
      COMMON /CONSNT/   PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/   FLC(156),WT,GAM,NALT,LOOP
      COMMON /OVERLY/   NLOG,NMACH,IM,NALPHA,IG,NF,LF,IALT
      COMMON /CASEID/   JCASE(175),IDIM
!
      DIMENSION FOT(46),IFOT(11),CLUT(20),CDUT(20),CMUT(20)
      DIMENSION DELT(20),DCLT(20),DCLMT(20),DCDIT(20),DCDMT(20)
      DIMENSION CDHT(20),CLT(20),CDT(20)
      DIMENSION CWT(20),MACH(20),PINF(20)
      DIMENSION ALP(1),CL(1),CD(1),CLUE(1),CDUE(1),CMUE(1)
      DIMENSION DELE(1),DCLE(1),CLME(1),CLIE(1),CDME(1),CHDE(1)
      DIMENSION CHAE(1),WDIM(4),ROUTID(2),CC(6)
!
      LOGICAL FLAG
      REAL MACH
      EQUIVALENCE (MACH(1),FLC(3)),(PINF(1),FLC(74))
!
      DATA WDIM / 4H LB., 4H LB., 4H N. , 4H N. /
      DATA ROUTID / 4HFLTC, 4HL   /
!
!***  ICASE = 1 - TRIM WITH FLAPS
!***  ICASE = 2 - ALL MOVEABLE HORIZONTAL TAIL TRIM
!
      IF(ICASE .NE. 1) GO TO 1010
        DO 1000 I=1,NTRIM
          CLT(I) = CLUT(I)+DCLT(I)
          CDT(I) = CDUT(I)+DCDMT(I)+DCDIT(I)
 1000   CONTINUE
 1010 CONTINUE
!
!*** CALCULATE CW AND TEST FOR CWT RANGE
!
      QS = SREF*(0.7*PINF(IALT)*MACH(IM)**2)
      CW = WT/QS
      DO 1020 I=1,NTRIM
        CWT(I) = CLT(I)*COS(GAM/RAD)-CDT(I)*SIN(GAM/RAD)
 1020 END DO
      FLAG = (CW .GT. CWT(NTRIM)) .OR. (CW .LT. CWT(1))
      IF(FLAG) WRITE(6,1060)WT,WDIM(IDIM),CW
!
!***  FIND EQUILIBRIUM ANGLE OF ATTACK AND TRIM DATA
!
      IF(FLAG) GO TO 1050
        IN=0
        CALL TBFUNX(CW,ALP(1),DYDX,NTRIM,CWT,FLC(23),CC,IN,             &
     &              MI,NG,0,0,4HALPE,1,ROUTID)
        IN=0
        CALL TBFUNX(ALP(1),CL(1),DYDX,NTRIM,FLC(23),CLT,CC,IN,          &
     &              MI,NG,0,0,4HCLTE,1,ROUTID)
        IN=0
        CALL TBFUNX(ALP(1),CD(1),DYDX,NTRIM,FLC(23),CDT,CC,IN,          &
     &              MI,NG,0,0,4HCDTE,1,ROUTID)
        IF(ICASE .NE. 1)GO TO 1030
          IN = 0
          CALL TBFUNX(ALP(1),CLUE(1),DYDX,NTRIM,FLC(23),CLUT,CC,IN,     &
     &                MI,NG,0,0,4HCLUE,1,ROUTID)
          IN = 0
          CALL TBFUNX(ALP(1),CDUE(1),DYDX,NTRIM,FLC(23),CDUT,CC,IN,     &
     &                MI,NG,0,0,4HCDUE,1,ROUTID)
          IN = 0
          CALL TBFUNX(ALP(1),CMUE(1),DYDX,NTRIM,FLC(23),CMUT,CC,IN,     &
     &                MI,NG,0,0,4HCMUE,1,ROUTID)
          IN = 0
          CALL TBFUNX(ALP(1),DELE(1),DYDX,NTRIM,FLC(23),DELT,CC,IN,     &
     &                MI,NG,0,0,4HDELE,1,ROUTID)
          IN = 0
          CALL TBFUNX(ALP(1),DCLE(1),DYDX,NTRIM,FLC(23),DCLT,CC,IN,     &
     &                MI,NG,0,0,4HDCLE,1,ROUTID)
          IN = 0
          CALL TBFUNX(ALP(1),CLME(1),DYDX,NTRIM,FLC(23),DCLMT,CC,IN,    &
     &                MI,NG,0,0,4HCLME,1,ROUTID)
          IN = 0
          CALL TBFUNX(ALP(1),CLIE(1),DYDX,NTRIM,FLC(23),DCLIT,CC,IN,    &
     &                MI,NG,0,0,4HCLIE,1,ROUTID)
          IN = 0
          CALL TBFUNX(ALP(1),CDME(1),DYDX,NTRIM,FLC(23),DCDMT,CC,IN,    &
     &                MI,NG,0,0,4HCDME,1,ROUTID)
          IN = 0
          CALL TBFUNX(ALP(1),CHDE(1),DYDX,NTRIM,FLC(23),CHDT,CC,IN,     &
     &                MI,NG,0,0,4HCHDE,1,ROUTID)
          CHAE(1) = 0.0
          WRITE(6,1070)
          CALL SWRITE(11,FOT,46,IFOT,1,ALP,CLUE,CDUE,CMUE,              &
     &                DELE,DCLE,CLME,CDIE,CDME,CHAE,CHDE,               &
     &                X,X,X,NDM,NAF)
 1030   CONTINUE
        IF(ICASE .NE. 2) GO TO 1040
          WRITE(6,1070)
          WRITE(6,1080) ALP(1),CL,CD
 1040   CONTINUE
 1050 CONTINUE
      RETURN
 1060 FORMAT(39H0*** REQUIRED LIFT COEFFICIENT EXCEEDS ,                &
     &       18HRANGE OF TRIM DATA  /                                   &
     &       22H0*** VEHICLE WEIGHT = ,F9.2,A4/                         &
     &       36H0*** LEVEL FLIGHT LIFT COEFFICIENT = ,F8.5)
 1070 FORMAT(1H )
 1080 FORMAT(1H0,52X,F5.1,3X,F6.3,3X,F6.3)
      END
      SUBROUTINE FORINT(IUNIT, NAME, COMBLK, II)
!
!***  FORCE AN INTEGER PRINT ONTO UNIT IUNIT
!
!  IUNIT - OUTPUT UNIT NUMBER
!   NAME - ARRAY WHICH DEFINES THE NAMELIST VARIABLE NAME
! COMBLK - DATA FOR NAMELIST NAME
!     II - NUMBER OF ELEMENTS TO PRINT
!
      INTEGER COMBLK
!
      DIMENSION NAME(8),COMBLK(II)
!
      WRITE(IUNIT,1000)(NAME(I),I=1,8),(COMBLK(I),I=1,II)
!
      RETURN
!
 1000 FORMAT(1H0,8A1,8(I14,1H,)/(9X,8(I14,1H,)))
!
      END
      SUBROUTINE FORLOG(IUNIT, NAME, COMBLK, II)
!
!***  FORCE A LOGICAL PRINT ONTO UNIT IUNIT
!
!  IUNIT - OUTPUT UNIT NUMBER
!   NAME - ARRAY WHICH DEFINES THE NAMELIST VARIABLE NAME
! COMBLK - DATA FOR NAMELIST NAME
!     II - NUMBER OF ELEMENTS TO PRINT
!
      LOGICAL COMBLK
!
      DIMENSION NAME(8),COMBLK(II)
!
      WRITE(IUNIT,1000)(NAME(I),I=1,8),(COMBLK(I),I=1,II)
!
      RETURN
!
 1000 FORMAT(1H0,8A1,8(13X,L1,1H,)/(9X,8(13X,L1,1H,)))
!
      END
      SUBROUTINE FORREA(IUNIT, NAME, COMBLK, II)
!
!***  FORCE A REAL PRINT ONTO UNIT IUNIT
!
!  IUNIT - OUTPUT UNIT NUMBER
!   NAME - ARRAY WHICH DEFINES THE NAMELIST VARIABLE NAME
! COMBLK - DATA FOR NAMELIST NAME
!     II - NUMBER OF ELEMENTS TO PRINT
!
      DIMENSION NAME(8),COMBLK(II)
!
      WRITE(IUNIT,1000)(NAME(I),I=1,8),(COMBLK(I),I=1,II)
!
      RETURN
!
 1000 FORMAT(1H0,8A1,8(G14.7,1H,)/(9X,8(G14.7,1H,)))
!
      END
      SUBROUTINE FWDXAC(ATNSWP,TAPER,FACTOR,MACH,ROUTE,XAC)
!
!***  CALCULATES THE AERODYNAMIC CENTER OF SWEPT FORWARD WINGS
!
!***  INPUTS
!
! ATNSWP - ASPECT RATIO * TAN(SWEEP)
!  TAPER - EXPOSED TAPER RATIO
! FACTOR - TAN(SWEEP)/BETA
!   MACH - MACH NUMBER
!  ROUTE - CALLING SUBROUTINE NAME
!
!***  OUTPUT
!
!   XAC - AERODYNAMIC CENTER, ROOT CHORDS FROM ROOT CHORD L.E.
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
!
      DIMENSION SUBT1(36),SUBT2(36),SUBT3(36),SUBT4(36),SUBT5(36)
      DIMENSION SUBT6(36),SUBT7(36),SUBT8(36),SUBT9(36),SUBT10(36)
      DIMENSION SUBT11(36),SUBT12(36)
      DIMENSION SUPT1(36),SUPT2(36),SUPT3(36),SUPT4(36),SUPT5(36)
      DIMENSION SUPT6(36),SUPT7(36),SUPT8(36),SUPT9(36),SUPT10(36)
      DIMENSION SUPT11(36),SUPT12(36)
      DIMENSION TYSUBL(216),TYSUBR(216),TYSUPL(216),TYSUPR(216)
      DIMENSION TGRAPH(6),TCURVE(6),TX(6)
      DIMENSION ROUTE(2)
      DIMENSION Q41412(3),Q4222A(3),Q4222B(3)
!
      EQUIVALENCE (SUBT1 (1),TYSUBL(  1)),(SUBT2 (1),TYSUBL( 37))
      EQUIVALENCE (SUBT3 (1),TYSUBL( 73)),(SUBT4 (1),TYSUBL(109))
      EQUIVALENCE (SUBT5 (1),TYSUBL(145)),(SUBT6 (1),TYSUBL(181))
      EQUIVALENCE (SUBT7 (1),TYSUBR(  1)),(SUBT8 (1),TYSUBR( 37))
      EQUIVALENCE (SUBT9 (1),TYSUBR( 73)),(SUBT10(1),TYSUBR(109))
      EQUIVALENCE (SUBT11(1),TYSUBR(145)),(SUBT12(1),TYSUBR(181))
      EQUIVALENCE (SUPT1 (1),TYSUPL(  1)),(SUPT2 (1),TYSUPL( 37))
      EQUIVALENCE (SUPT3 (1),TYSUPL( 73)),(SUPT4 (1),TYSUPL(109))
      EQUIVALENCE (SUPT5 (1),TYSUPL(145)),(SUPT6 (1),TYSUPL(181))
      EQUIVALENCE (SUPT7 (1),TYSUPR(  1)),(SUPT8 (1),TYSUPR( 37))
      EQUIVALENCE (SUPT9 (1),TYSUPR( 73)),(SUPT10(1),TYSUPR(109))
      EQUIVALENCE (SUPT11(1),TYSUPR(145)),(SUPT12(1),TYSUPR(181))
!
      REAL MACH
!
      DATA Q41412 /4H4.1.,4H4.1-,4H5   /, Q4222A /4H4.1.,4H4.2-,4H26A /,&
     &     Q4222B /4H4.1.,4H4.2-,4H26B /
!
      DATA TGRAPH / 0., .2, .25, .33, .5, 1. /
      DATA TCURVE / 1., 2., 3., 4., 5., 6. /
      DATA TX / 0., .2, .4, .6, .8, 1. /
!
!*** TAN(SWEEP)/BETA, TAPER=0.
!
      DATA SUBT1 /                                                      &
     &  .08,  .04,  .02,  .01, 0.00, -.01,                              &
     & -.01, -.03, -.05, -.06, -.07, -.08,                              &
     & -.09, -.11, -.12, -.13, -.14, -.15,                              &
     & -.18, -.19, -.20, -.21, -.22, -.22,                              &
     & -.27, -.28, -.29, -.29, -.29, -.30,                              &
     & -.36, -.37, -.37, -.38, -.38, -.38/
!
!*** TAN(SWEEP)/BETA, TAPER=.2
!
      DATA SUBT2 /                                                      &
     &  .05,  .03,  .02,  .01, -.01, -.01,                              &
     & -.06, -.07, -.08, -.09, -.10, -.10,                              &
     & -.18, -.19, -.19, -.20, -.20, -.20,                              &
     & -.30, -.31, -.31, -.31, -.31, -.31,                              &
     & -.42, -.42, -.42, -.42, -.42, -.41,                              &
     & -.54, -.54, -.54, -.53, -.53, -.52/
!
!*** TAN(SWEEP)/BETA, TAPER=.25
!
      DATA SUBT3 /                                                      &
     &  .04,  .03,  .01, 0.00, -.01, -.02,                              &
     & -.08, -.09, -.10, -.11, -.11, -.11,                              &
     & -.21, -.21, -.21, -.21, -.22, -.22,                              &
     & -.34, -.33, -.33, -.33, -.33, -.33,                              &
     & -.46, -.46, -.46, -.45, -.44, -.44,                              &
     & -.59, -.58, -.58, -.57, -.56, -.55/
!
!*** TAN(SWEEP)/BETA, TAPER=.33
!
      DATA SUBT4 /                                                      &
     &  .04,  .03,  .01, 0.00, -.01, -.02,                              &
     & -.10, -.10, -.11, -.11, -.12, -.12,                              &
     & -.24, -.24, -.23, -.23, -.23, -.23,                              &
     & -.38, -.37, -.37, -.36, -.36, -.36,                              &
     & -.52, -.51, -.50, -.49, -.49, -.48,                              &
     & -.66, -.65, -.64, -.63, -.62, -.61/
!
!*** TAN(SWEEP)/BETA, TAPER=.5
!
      DATA SUBT5 /                                                      &
     &  .03,  .02,  .01, 0.00, -.01, -.02,                              &
     & -.14, -.13, -.13, -.13, -.14, -.14,                              &
     & -.31, -.30, -.29, -.28, -.28, -.27,                              &
     & -.47, -.45, -.44, -.43, -.43, -.42,                              &
     & -.64, -.62, -.60, -.59, -.57, -.56,                              &
     & -.82, -.78, -.76, -.75, -.73, -.72/
!
!*** TAN(SWEEP)/BETA, TAPER=1.
!
      DATA SUBT6 /                                                      &
     &  .01,  .02,  .01, 0.00, -.01, -.02,                              &
     & -.24, -.21, -.20, -.20, -.19, -.19,                              &
     & -.50, -.45, -.43, -.41, -.40, -.39,                              &
     & -.75, -.69, -.65, -.63, -.62, -.60,                              &
     &-1.00, -.94, -.90, -.86, -.84, -.82,                              &
     &-1.25,-1.19,-1.13,-1.09,-1.06,-1.04/
!
!*** BETA/TAN(SWEEP), TAPER=0.
!
      DATA SUBT7 /                                                      &
     & -.04, -.03, -.03, -.02, -.02, -.01,                              &
     & -.10, -.09, -.09, -.09, -.08, -.08,                              &
     & -.16, -.16, -.16, -.15, -.15, -.15,                              &
     & -.23, -.23, -.23, -.23, -.22, -.22,                              &
     & -.29, -.30, -.30, -.30, -.30, -.30,                              &
     & -.37, -.37, -.37, -.37, -.38, -.38/
!
!*** BETA/TAN(SWEEP), TAPER=.2
!
      DATA SUBT8 /                                                      &
     & -.05, -.05, -.04, -.03, -.02, -.01,                              &
     & -.12, -.12, -.12, -.11, -.11, -.10,                              &
     & -.21, -.21, -.21, -.21, -.21, -.20,                              &
     & -.30, -.30, -.30, -.31, -.31, -.31,                              &
     & -.40, -.40, -.40, -.41, -.41, -.41,                              &
     & -.49, -.50, -.51, -.51, -.52, -.52/
!
!*** BETA/TAN(SWEEP), TAPER=.25
!
      DATA SUBT9 /                                                      &
     & -.05, -.04, -.04, -.03, -.03, -.02,                              &
     & -.12, -.12, -.12, -.12, -.12, -.11,                              &
     & -.22, -.22, -.22, -.22, -.22, -.22,                              &
     & -.32, -.32, -.32, -.32, -.33, -.33,                              &
     & -.42, -.42, -.43, -.43, -.43, -.44,                              &
     & -.52, -.53, -.53, -.54, -.55, -.55/
!
!*** BETA/TAN(SWEEP), TAPER=.33
!
      DATA SUBT10 /                                                     &
     & -.04, -.04, -.03, -.03, -.02, -.02,                              &
     & -.14, -.14, -.13, -.13, -.12, -.12,                              &
     & -.23, -.23, -.24, -.23, -.23, -.23,                              &
     & -.34, -.35, -.35, -.35, -.35, -.36,                              &
     & -.46, -.46, -.46, -.47, -.48, -.48,                              &
     & -.57, -.57, -.58, -.59, -.60, -.61/
!
!*** BETA/TAN(SWEEP), TAPER=.5
!
      DATA SUBT11 /                                                     &
     & -.05, -.04, -.04, -.03, -.02, -.02,                              &
     & -.15, -.15, -.15, -.14, -.14, -.14,                              &
     & -.26, -.27, -.27, -.27, -.27, -.27,                              &
     & -.39, -.40, -.40, -.41, -.41, -.42,                              &
     & -.52, -.53, -.54, -.55, -.55, -.56,                              &
     & -.66, -.67, -.68, -.70, -.71, -.72/
!
!*** BETA/TAN(SWEEP), TAPER=1.
!
      DATA SUBT12 /                                                     &
     & -.07, -.06, -.05, -.04, -.03, -.02,                              &
     & -.18, -.19, -.19, -.19, -.19, -.19,                              &
     & -.35, -.36, -.37, -.37, -.38, -.39,                              &
     & -.53, -.54, -.56, -.57, -.59, -.60,                              &
     & -.73, -.74, -.76, -.78, -.80, -.82,                              &
     & -.94, -.95, -.97, -.99,-1.02,-1.04/
!
!*** BETA/TAN(SWEEP), TAPER=0.
!
      DATA SUPT1 /                                                      &
     & -.04, -.04, -.04, -.03, -.03, -.02,                              &
     & -.10, -.10, -.09, -.08, -.07, -.05,                              &
     & -.16, -.16, -.15, -.14, -.13, -.11,                              &
     & -.23, -.23, -.22, -.21, -.20, -.18,                              &
     & -.29, -.29, -.28, -.27, -.26, -.24,                              &
     & -.37, -.37, -.36, -.35, -.33, -.31/
!
!*** BETA/TAN(SWEEP), TAPER=.2
!
      DATA SUPT2 /                                                      &
     & -.04, -.04, -.04, -.04, -.03, -.01,                              &
     & -.12, -.12, -.11, -.10, -.09, -.07,                              &
     & -.20, -.20, -.20, -.19, -.18, -.15,                              &
     & -.30, -.30, -.29, -.28, -.26, -.23,                              &
     & -.40, -.40, -.39, -.37, -.34, -.30,                              &
     & -.49, -.49, -.48, -.46, -.45, -.42/
!
!*** BETA/TAN(SWEEP), TAPER=.25
!
      DATA SUPT3 /                                                      &
     & -.04, -.04, -.04, -.03, -.02, -.01,                              &
     & -.12, -.12, -.11, -.10, -.08, -.05,                              &
     & -.22, -.22, -.21, -.20, -.18, -.15,                              &
     & -.31, -.31, -.30, -.29, -.27, -.23,                              &
     & -.42, -.42, -.40, -.38, -.34, -.31,                              &
     & -.51, -.51, -.50, -.47, -.43, -.38/
!
!*** BETA/TAN(SWEEP), TAPER=.33
!
      DATA SUPT4 /                                                      &
     & -.04, -.04, -.04, -.03, -.01,  .02,                              &
     & -.13, -.13, -.12, -.10, -.08, -.02,                              &
     & -.23, -.23, -.22, -.20, -.18, -.14,                              &
     & -.34, -.34, -.33, -.31, -.28, -.24,                              &
     & -.45, -.45, -.43, -.41, -.38, -.35,                              &
     & -.56, -.56, -.54, -.52, -.49, -.45/
!
!*** BETA/TAN(SWEEP), TAPER=.5
!
      DATA SUPT5 /                                                      &
     & -.05, -.05, -.05, -.04, -.02,  .02,                              &
     & -.14, -.14, -.12, -.10, -.07, -.03,                              &
     & -.26, -.26, -.24, -.23, -.21, -.16,                              &
     & -.39, -.39, -.37, -.35, -.32, -.28,                              &
     & -.51, -.51, -.49, -.46, -.43, -.39,                              &
     & -.65, -.65, -.63, -.62, -.60, -.58/
!
!*** BETA/TAN(SWEEP), TAPER=1.
!
      DATA SUPT6 /                                                      &
     & -.08, -.08, -.08, -.04,  .02,  .08,                              &
     & -.17, -.17, -.15, -.12, -.09, -.06,                              &
     & -.34, -.34, -.32, -.29, -.27, -.24,                              &
     & -.51, -.51, -.48, -.46, -.43, -.41,                              &
     & -.71, -.71, -.68, -.56, -.64, -.63,                              &
     & -.92, -.92, -.90, -.87, -.85, -.84/
!
!*** TAN(SWEEP)/BETA, TAPER=0.
!
      DATA SUPT7 /                                                      &
     &  .22,  .20,  .10,  .03, 0.00, -.02,                              &
     &  .13,  .13,  .12,  .04, -.02, -.05,                              &
     &  .04,  .04,  .05, -.01, -.07, -.11,                              &
     & -.04, -.04, -.03, -.07, -.14, -.18,                              &
     & -.13, -.13, -.12, -.11, -.20, -.24,                              &
     & -.22, -.22, -.21, -.17, -.26, -.31/
!
!*** TAN(SWEEP)/BETA, TAPER=.2
!
      DATA SUPT8 /                                                      &
     &  .20,  .19,  .13,  .06,  .02, -.01,                              &
     &  .08,  .09,  .03,  .03, -.03, -.07,                              &
     & -.04, -.04, -.02, -.04, -.10, -.15,                              &
     & -.17, -.16, -.14, -.12, -.19, -.23,                              &
     & -.28, -.28, -.26, -.21, -.25, -.30,                              &
     & -.40, -.39, -.38, -.36, -.37, -.42/
!
!*** TAN(SWEEP)/BETA, TAPER=.25
!
      DATA SUPT9 /                                                      &
     &  .19,  .20,  .15,  .08,  .02, -.01,                              &
     &  .06,  .07,  .08,  .04, -.01, -.05,                              &
     & -.07, -.06, -.03, -.05, -.10, -.15,                              &
     & -.19, -.18, -.16, -.13, -.19, -.23,                              &
     & -.32, -.31, -.29, -.29, -.27, -.31,                              &
     & -.44, -.44, -.43, -.40, -.33, -.38/
!
!*** TAN(SWEEP)/BETA, TAPER=.33
!
      DATA SUPT10 /                                                     &
     &  .18,  .19,  .16,  .11,  .06,  .02,                              &
     & 0.00,  .05,  .06,  .07,  .04, -.02,                              &
     & -.09, -.08, -.06, -.05, -.10, -.14,                              &
     & -.19, -.18, -.16, -.16, -.19, -.24,                              &
     & -.37, -.37, -.34, -.29, -.30, -.35,                              &
     & -.51, -.51, -.49, -.45, -.41, -.45/
!
!*** TAN(SWEEP)/BETA, TAPER=.5
!
      DATA SUPT11 /                                                     &
     &  .18,  .19,  .16,  .11,  .06,  .02,                              &
     &  .02,  .03,  .05,  .04, 0.00, -.03,                              &
     & -.15, -.14, -.11, -.09, -.12, -.16,                              &
     & -.32, -.31, -.28, -.23, -.24, -.28,                              &
     & -.48, -.48, -.45, -.40, -.35, -.39,                              &
     & -.65, -.65, -.62, -.57, -.55, -.58/
!
!*** TAN(SWEEP)/BETA, TAPER=1.
!
      DATA SUPT12 /                                                     &
     &  .19,  .20,  .19,  .16,  .12,  .08,                              &
     & -.05, -.03, -.01, -.01, -.03, -.06,                              &
     & -.30, -.29, -.25, -.20, -.22, -.24,                              &
     & -.55, -.54, -.50, -.42, -.39, -.41,                              &
     & -.80, -.79, -.75, -.67, -.67, -.63,                              &
     &-1.05,-1.04,-1.00, -.92, -.84, -.84/
      AFACT=ABS(FACTOR)
      AATNSP=ABS(ATNSWP)
!
      IF(AFACT .NE. 0.) FACTI=1./AFACT
      IF(AFACT .EQ. 0.) FACTI=1.E10
!
      IF(MACH .LT. 1. .AND. AFACT .LE. 1.)                              &
     &  CALL TLIN3X(TCURVE,TX,TGRAPH,TYSUBL,6,6,6,AATNSP,AFACT,         &
     &              TAPER,XAC,2,0,0,2,0,0,Q4222A,3,ROUTE)
!
      IF(MACH .LT. 1. .AND. AFACT .GT. 1.)                              &
     &  CALL TLIN3X(TCURVE,TX,TGRAPH,TYSUPR,6,6,6,AATNSP,FACTI,         &
     &              TAPER,XAC,2,0,0,2,0,0,Q4222B,3,ROUTE)
!
      IF(MACH .GE. 1. .AND. AFACT .GT. 1.)                              &
     &  CALL TLIN3X(TCURVE,TX,TGRAPH,TYSUPL,6,6,6,AATNSP,FACTI,         &
     &              TAPER,XAC,2,0,0,2,0,0,Q4222B,3,ROUTE)
!
      IF(MACH .GE. 1. .AND. AFACT .LE. 1.)                              &
     &  CALL TLIN3X(TCURVE,TX,TGRAPH,TYSUPR,6,6,6,AATNSP,AFACT,         &
     &              TAPER,XAC,2,0,0,2,0,0,Q4222A,3,ROUTE)
!
      RETURN
      END
      SUBROUTINE GDELTA(GD1,GD2,GD3,EFI,EFO,BOCH,SB)
!
!***  CALCULATES FLAP SPANWISE LOADING COEFFICIENT G/DELTA
!
      LOGICAL ASYFP
      COMMON /FLOLOG/ X(20),ASYFP
      COMMON /HTDATA/ AHT(195)
      COMMON /SUPDW/  DW(35),TCD(58)
      COMMON /HTI/    HTIN(131)
      EQUIVALENCE (GD1H,TCD(43)),(GD2H,TCD(44)),(GD3H,TCD(45)),         &
     &    (GD4H,TCD(46)),(TANTE,AHT(80)),(TANLE,AHT(62)),(BO2H,HTIN(4)),&
     &    (BSTO2,HTIN(3)),(CRH,AHT(10))
      DIMENSION FGX(48),ZRX(60),C1(6),C2(6),C3(6),C4(6)
      EQUIVALENCE (ZRX(13),FGX(1))
      DIMENSION GD1(14),GD2(14),GD3(14),SPU(14),X1(5),GNA(2)
      DIMENSION GD(17),A(16),EQ(16),CN(48),FGC(36),SPT(9),GI(12),       &
     &         SD(5),C(6),BOCH(4)
      DATA ZRX/60*0./,I1/0/,I2/0/,I3/0/,I4/0/
      DATA X1/0.,.195,.556,.831,1.0/,GNA/4HGDEL,4HTA  /
      DATA SPU/0.,.1423,.2817,.4153,.5407,.6549,.7557,.8412,.9097,.9595,&
     &.9898,1.000,.5,.75/
      DATA SD/0.,.383,.707,.924,1.0/,IN/0/,GD/17*0.0/
      DATA SPT/0.,.195,.383,.556,.707,.831,.924,.981,1.0/
      DATA EQ /-.017,.029,-.014,.988 , .032,-.003,.994,.976 ,-.041,1.021&
     &         ,.955,1.040 , 4*1.0 /
      DATA CN / .05775384,-.1585488,.6190800,.5162876,-.1332188,.5903109&
     & ,.6376293,-.09812725,.5287240,.6979618,-.2243549,.05177605,      &
     &  .8184079,-.2989922,.1550801,.03851272,.04523051,-.1196368,      &
     &  .4375114,.6320983,-.1533014,.6545052,.6621265,-.1765276,        &
     &  .5301887,.6743488,-.2033035,.08116567, .8319939,-.2928609,      &
     &  .1422650,.06120639,.03238602,-.07837254,.4212096,.6365698,      &
     & -.1345339,.5254995,.7812855,-.2178882,.5871445,.6832385,         &
     & -.3022919,.1264219,.7802445,-.2512727,.1793873,.08073133 /
      IF(ASYFP)GO TO 1140
 1000 CALL AGENR(BOCH,SB,A)
!
!     ----SOLVE SIMULATANEOUS EQUATIONS.
!
      DO 1010 I=1,16,4
         CALL SIMUL4(A    ,EQ(I),GD(I))
 1010 END DO
 1020 IF(ASYFP)GO TO 1160
!
!     ----COMPUTE INTERMEDIATE POINTS.
!
      LL=1
      DO 1050 I=1,3
         DO 1040 J=1,4
            KJ=16*(I-1)
            GIM=0.
            DO 1030 L=1,4
               M=4*(I-1)+L
               K=4*(J-1)+KJ+L
               GIM=GIM+CN(K)*GD(M)
 1030       CONTINUE
            GI(LL)=GIM
            LL=LL+1
 1040    CONTINUE
 1050 END DO
      I=1
      J=4
      DO 1070 LL=5,17,4
         K=1
         DO 1060 L=I,J
            FGC(L)=GD(LL-K)
            K=K+1
 1060    CONTINUE
         I=I+4
         J=J+4
 1070  CONTINUE
      DO 1080 J=1,16
         GD(J)=FGC(J)
 1080 END DO
!
!     ----COMPUTE INTERMEDIATE POINTS FOR 4TH CURVE.
!
      DO 1090 L=2,8,2
         CALL TBFUNX(SPT(L),FGC(L+27),LL,5,SD,GD(13),C,IN,MI,LL,0,0,    &
     &               4HGDEL,1,4HGDEL)
 1090 END DO
!
!     ----CONSTRUCT TOTAL CURVE.
!
      J=1
      LL=1
      DO 1100 L=1,16
         FGC(LL)=GD(L)
         IF(L.LT.13)FGC(LL+1)=GI(L)
         LL=LL+2
         J=J+1
         IF(J.LT.5)GO TO 1100
         FGC(LL)=0.
         LL=LL+1
         J=1
 1100 END DO
!
!     ----USE LINEAR FOR LAST INTERPOLATED POINT.
!
      DO 1110 I=8,35,9
         FGC(I)=.25*FGC(I-1)
 1110 END DO
!
!     ----GENERATE FINAL CURVES.
!
      SPU(13)=EFI
      SPU(14)=EFO
      II=0
      I1=0
      I2=0
      I3=0
      I4=0
      DO 1120 L=1,12
         CALL TBFUNX(SPU(L),FGX(L)   ,LL,9,SPT,FGC( 1),C1,I1,MI,LL,0,0, &
     &               4HGDL1,1,GNA)
         CALL TBFUNX(SPU(L),FGX(L+12),LL,9,SPT,FGC(10),C2,I2,MI,LL,0,0, &
     &               4HGDL2,1,GNA)
         CALL TBFUNX(SPU(L),FGX(L+24),LL,9,SPT,FGC(19),C3,I3,MI,LL,0,0, &
     &               4HGDL3,1,GNA)
         CALL TBFUNX(SPU(L),FGX(L+36),LL,9,SPT,FGC(28),C4,I4,MI,LL,0,0, &
     &               4HGDL4,1,GNA)
 1120 END DO
      DO 1130 L=1,14
         CALL TBFUNX(SPU(L),GD1(L),LL,9,SPT,FGC(28),C,II,MI,LL,0,0,     &
     &              4HGDL1,1,GNA)
         CALL TLINEX(X1,SPU,ZRX,5,12,EFI,SPU(L),GD2(L),0,0,0,0,4HGXL2,  &
     &               1,GNA)
         CALL TLINEX(X1,SPU,ZRX,5,12,EFO,SPU(L),GD3(L),0,0,0,0,4HGXL3,  &
     &               1,GNA)
 1130 END DO
!
      RETURN
!
 1140 ARG1=(TANTE-TANLE)*BSTO2
      DO 1150 I=1,4
         NMU=5-I
         CC=CRH+SD(NMU)*ARG1
         BOCH(I)=2.*BSTO2/CC
 1150 END DO
      GO TO 1000
 1160 GD1H=GD(16)
      GD2H=GD(15)
      GD3H=GD(14)
      GD4H=GD(13)
      RETURN
      END
      SUBROUTINE GETMAX(X,S,NX,XMAX,SMAX,IMAX)
!
!     ----SUBROUTINE FINDS MAXIMUM S AND X AND I ASSOCIATED WITH IT
!
      DIMENSION ROUTID(2)
      DIMENSION SMX(3),DSDX(3),XMX(3)
      DIMENSION X(1),S(1),CXA(6)
      DATA ROUTID/4HGETM,4HAX  /,SID/4HS   /
      IXA=0
      SM=S(1)
      IM = 0
      DO 1000 I=1,NX
         IF(S(I).LE.SM.AND.I.GT.1)GO TO 1000
         SM=S(I)
         XM=X(I)
         IM=I
         IMAX=IM
 1000 END DO
      XMAX = XM
      SMAX = SM
      RETURN
      END
      SUBROUTINE GLOOK(NXG,XAG,XG,NASG,NOING,IG,TG)
!
!     ----THIS IS A GENERAL TABLE LOOKUP SUBROUTINE.
!
      DIMENSION XG(1)
      LOGICAL NOING,NASG
      DO 1000 I=1,NXG
         II=I
         TEMG=XAG-XG(I)
         DMG=XAG
         IF(XAG .EQ. 0.)DMG=XG(I)
         IF(ABS(DMG) .LE. 0.0001)DMG=1.
         ERG=ABS(TEMG/DMG)
         IF(ERG.LT.1.E-3)GO TO 1010
!
!     ----1ST TEST FOR ASCENDING ORDER. 2ND FOR DESCENDING.
!
         IF(NASG.AND.TEMG.LT.0.)GO TO 1020
         IF(.NOT.NASG.AND.TEMG.GT.0.)GO TO 1020
         TEMPG=TEMG
 1000 END DO
 1010 NOING=.TRUE.
 1020 IG=II
      IF(II .EQ. 1)NOING=.TRUE.
      IF(.NOT. NOING)TG=TEMPG/(TEMPG-TEMG)
      RETURN
      END
      SUBROUTINE GRDEFF(GRDHT,L)
!
!***  COMPUTES GROUND EFFECTS
!
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /SUPWH/  GR(303)
      COMMON /BDATA/  BD(275),CIOM(320)
      COMMON /WINGD/  A(195), B(49)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /CONSNT/ PI, DEG, UNUSED, RAD,kand
      COMMON /SYNTSS/ SYNA(19)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /OVERLY/ NLOG, NMACH, I, NALPHA, IG
      COMMON /WINGI/  WINGIN(77)
      COMMON /HTI/    HTIN(131)
      COMMON /FLAPIN/ F(69)
      COMMON /IWING/  PWING, WING(400)
      COMMON /IBW/    PBW, BWI(380)
      COMMON /IBWV/   PBWV, BWV(380)
      COMMON /IBWH/   PBWH, BWH(380)
      COMMON /IBWHV/  PBWHV, BWHV(380)
      COMMON /IDWASH/ PDWASH, DWASH(60)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
!
      DIMENSION ROUTID(2),Q47118(2),Q47119(2),Q7122A(3),Q47125(2)       &
     &     ,QCLWBG(2),QCLHTG(2)
      DIMENSION CW(6),LGH(4),VAR(4),X4717A(13),Y4717A(13),Y4717B(13)
      DIMENSION CT(6),Q47117(2),DELTA(10)
      REAL K,LOLOM1(20),LH,LHOCBR
      DIMENSION DALPHA(20),ALPHWG(20),DDWASH(20),CLHT(20),ALPHAT(20),   &
     &CLWBG(20),CLG(20),CLHTG(20),DCLWBG(20),DCMWBG(20),CMG(20),DCLHTG  &
     &(20),DCMHTG(20),DCDLWG(20),CLOCOS(20),BW(20),CMWBG(20)
      EQUIVALENCE (DELTA(1),F(1))
      EQUIVALENCE (CLG(1),BWH(21))
      EQUIVALENCE (CMWBG(1),BWI(41)), (CMG(1),BWH(41))
      EQUIVALENCE (GR(1),DX),(GR(2),DXOB2),(GR(3),H75CR),(GR(4),HW),    &
     & (GR(5),HWOB2),(GR(6),HWCR4),(GR(7),HWCOCR),(GR(8),HWMACX),(GR(9),&
     & HWMAC4),(GR(10),HTMACX),(GR(11),HTMAC4),(GR(12),R),(GR(13),SIGMA)&
     & ,(GR(14),HWOCBR),(GR(15),T),(GR(17),DALPHA(1)),                  &
     & (GR(37),ALPHWG(1)),(GR(57),K),(GR(58),X),(GR(59),BWOB),(GR(60),  &
     & BEFF),(GR(61),DDWASH(1)),(GR(81),CLHT(1)),(GR(101),ALPHAT(1)),   &
     & (GR(121),BW(1)),(GR(141),LOLOM1(1)),(GR(161),CLHTG(1)),          &
     & (GR(181),DCLWBG(1)),(GR(201),DXCP),(GR(202),DCMWBG(1)),          &
     & (GR(222),CLOCOS(1)),(GR(242),LH),(GR(243),LHOCBR),               &
     & (GR(244),DCLHTG(1)),(GR(264),DCMHTG(1)),(GR(284),DCDLWG(1))
      DIMENSION X218(11),X118(7),Y18(77)
      DIMENSION X219(12),X119(9),Y19(108)
      DIMENSION X222A(6),X122A(4),Y22A(24)
      DIMENSION X225(11),X125(9),Y25(99)
!
!     *********FIGURE 4.7.1-14**********
!     ******** X218=HWOB2 X118=DX Y18=X **********
!
      DATA ROUTID/4HGRDE,4HFF  /,Q47118/4H4.7.,4H1-14/,Q47119/4H4.7.,   &
     & 4H1-15/,Q7122A/4H4.7.,4H1-18,4HA   /,Q47125/4H4.7.,4H1-21/,      &
     & QCLWBG/4HCLWB,4HG   /,QCLHTG/4HCLHT,4HG   /
      DATA X218/0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA X118/1.0,0.5,0.2,0.0,-0.2,-0.5,-1.0/
      DATA Y18/1.4,1.01,0.79,0.62,0.50,0.40,0.33,0.27,0.22,0.18,0.15,   &
     &1.27,0.90,0.69,0.54,0.42,0.33,0.28,0.22,0.18,0.15,0.12,           &
     &1.11,0.78,0.58,0.45,0.35,0.28,0.22,0.18,0.15,0.12,0.099,          &
     &1.00,0.66,0.50,0.38,0.30,0.23,0.19,0.16,0.12,0.10,0.085,          &
     &0.86,0.55,0.40,0.31,0.24,0.19,0.16,0.13,0.10,0.085,0.080,         &
     &0.72,0.41,0.29,0.21,0.16,0.13,0.10,0.080,0.070,0.060,0.050,       &
     &0.60,0.30,0.19,0.12,0.085,0.065,0.045,0.035,0.025,0.020,0.0200/
!
!     *********FIGURE 4.7.1-15**********
!     ******** X219=HWCOCR X119=CLOCOS(J) Y19=LOLOM1(J) *********
!
      DATA X219/.3,.4,.6,.8,1.,1.2,1.4,1.6,1.8,2.,2.2,2.4/
      DATA X119/0.0,5.0,10.0,15.0,18.0,20.0,22.0,24.0,36.0/
      DATA Y19/.40,.27,.145,.090,.060,.04,.030,.022,.015,.013,.010,.010,&
     &.25,.16,.065,.035,.017,.007,0.0,-.005,-.007,-.010,-.012,-.016,    &
     &.11,.060,0.0,-.020,-.030,-.030,-.030,-.030,-.030,-.030,-.030,-.030&
     &,-.020,-.040,-.065,-.070,-.070,-.065,-.060,-.055,-.050,-.048,-.045&
     &,-.040,-.080,-.10,-.115,-.11,-.098,-.085,-.080,-.070,-.065,-.060, &
     &-.060,-.055,-.125,-.135,-.140,-.125,-.115,-.10,-.090,-.085,-.075, &
     &-.070,-.065,-.063,-.160,-.165,-.165,-.15,-.13,-.12,-.105,-.095,   &
     &-.085,-.080,-.070,-.067,-.20,-.20,-.190,-.170,-.148,-.130,-.115,  &
     &-.10,-.090,-.085,-.077,-.073,-.20,-.20,-.20,-.20,-.20,-.19,-.17,  &
     &-.155,-0.138,-.127,-.118,-.11/
!
!     *********FIGURE 4.7.1-18A*********
!     ******** X22A=1.0/A(118) X12A=A(120) Y22A=BWOB ************
!
      DATA X222A/1.0,1.5,2.0,3.0,4.0,5.0/
      DATA X122A/4.0,6.0,8.0,10.0/
      DATA Y22A/.825,.79,.77,.745,.725,.715,.853,.805,.77,.740,.715,.70,&
     &.88,.82,.77,.73,.703,.69,.895,.825,.77,.725,.695,.68/
!
!     *********FIGURE 4.7.1-21**********
!     ******** X225=HWOCBR X122A=B(J+182) Y25=BW(J) *************
!
      DATA X225/.2,.3,.4,.5,.6,.7,.8,.9,1.0,1.1,1.2/
      DATA X125/0.0,.2,.4,.6,.8,1.0,1.2,1.4,1.6/
      DATA Y25/11*0.0,.92,.59,.41,.31,.23,.19,.15,.11,.09,.08,.07,      &
     &1.92,1.13,.80,.60,.45,.35,.25,.20,.17,.15,.12,                    &
     &2.45,1.65,1.15,.81,.60,.43,.35,.23,.20,.16,.12,                   &
     &2.6,2.15,1.42,1.0,.70,.50,.37,.25,.19,.15,.14,                    &
     &2.6,2.5,1.7,1.15,.78,.52,.37,.22,.14,.09,.04,                     &
     &2.6,2.6,1.85,1.20,.76,.46,.29,.18,.08,0.0,-.02,                   &
     &2.6,2.6,1.95,1.20,.72,.39,.19,.03,-.02,-.09,-.12,                 &
     &2.6,2.6,2.10,1.16,.52,.20,.03,-.07,-.16,-.22,-.26/
      DATA X4717A/0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.,1.1,1.2/
      DATA Y4717A/-.145,-.125,-.1,-.08,-.062,-.05,-.038,-.029,-.02,     &
     & -.014,-.005,2*0./
      DATA Y4717B/.098,.08,.062,.051,.04,.032,.024,.016,.01,.006,3*0./
      DATA Q47117/4H4.7.,4H1-17 /
      DATA STRA/4HSTRA/
!
      IF(IG.GT.1)GO TO 1010
!
!  STORE BASIC AERO, FREE AIR, FOR MULTIPLE HEIGHTS
!
      DO 1000 J=1,20
         CIOM(J    )= BWI(J    )
         CIOM(J+ 20)= BWI(J+ 20)
         CIOM(J+ 40)= BWI(J+ 40)
         CIOM(J+ 60)= BWI(J+100)
         CIOM(J+ 80)= BWI(J+120)
         CIOM(J+100)= BWH(J    )
         CIOM(J+120)= BWH(J+ 20)
         CIOM(J+140)= BWH(J+ 40)
         CIOM(J+160)= BWH(J+100)
         CIOM(J+180)= BWH(J+120)
         CIOM(J+200)= BWV(J    )
         CIOM(J+220)=BWHV(J    )
         CIOM(J+240)=BWHV(J+ 20)
         CIOM(J+260)=BWHV(J+ 40)
         CIOM(J+280)=BWHV(J+100)
         CIOM(J+300)=BWHV(J+120)
 1000 END DO
!
!  REPLACE BASIC AERO, FREE AIR, FOR MULTIPLE HEIGHTS
!
 1010 DO 1020 J=1,20
         BWI(J    )=CIOM(J    )
         BWI(J+ 20)=CIOM(J+ 20)
         BWI(J+ 40)=CIOM(J+ 40)
         BWI(J+100)=CIOM(J+ 60)
         BWI(J+120)=CIOM(J+ 80)
         BWH(J    )=CIOM(J+100)
         BWH(J+ 20)=CIOM(J+120)
         BWH(J+ 40)=CIOM(J+140)
         BWH(J+100)=CIOM(J+160)
         BWH(J+120)=CIOM(J+180)
         BWV(J    )=CIOM(J+200)
        BWHV(J    )=CIOM(J+220)
        BWHV(J+ 20)=CIOM(J+240)
        BWHV(J+ 40)=CIOM(J+260)
        BWHV(J+100)=CIOM(J+280)
        BWHV(J+120)=CIOM(J+300)
 1020 END DO
      GR(16)=GRDHT
!
!      *************CALCULATE GROUND EFFECT GEOMETRIC PARAMETERS********
!
      TANGI=TAN(WINGIN(13)/RAD)
      TANGO=TAN(WINGIN(14)/RAD)
!
!     ****CALCULATE DELTAX****
!
      IF(STRA.EQ.WINGIN(15))GO TO 1040
      IF(WINGIN(2).LE.0.25*WINGIN(4)) GO TO 1030
      DX=.5*WINGIN(6)-A(92)*(WINGIN(2)-0.25*WINGIN(4))-A(68)*           &
     &   (WINGIN(4)-WINGIN(2))
      GO TO 1050
 1030 DX=0.50*WINGIN(6)-0.75*WINGIN(4)*A(8)
      GO TO 1050
 1040 DX=0.50*WINGIN(6)-A(44)*0.75*WINGIN(4)
 1050 DXOB2=DX/WINGIN(4)
!
!     ****CALCULATE AVERAGE ELEVATION OF WING ABOVE GROUND (HW)*****
!
      H75CR=GRDHT+SYNA(3)-0.75*WINGIN(6)*TAN(SYNA(4)/RAD)
      IF(WINGIN(13).EQ.UNUSED.AND.WINGIN(14).EQ.UNUSED) GO TO 1070
      IF(WINGIN(13).NE.UNUSED.AND.WINGIN(14).EQ.UNUSED) GO TO 1060
      IF(WINGIN(13).EQ.UNUSED.AND.WINGIN(14).NE.UNUSED) GO TO 1080
      IF(WINGIN(12).LE.0.25*WINGIN(4)) GO TO 1060
      HW=H75CR+0.50*((WINGIN(4)-WINGIN(12))*TANGI                       &
     &   +(WINGIN(12)-0.25*WINGIN(4))*TANGO)                            &
     &   +DX*TAN(SYNA(4)/RAD)*0.50
      GO TO 1090
 1060 HW=H75CR+0.375*WINGIN(4)*TANGI+DX*TAN(SYNA(4)/RAD)*.50
      GO TO 1090
 1070 HW=H75CR+DX*TAN(SYNA(4)/RAD)*.50
      GO TO 1090
 1080 IF(WINGIN(12).LE.0.25*WINGIN(4)) GO TO 1070
      HW=H75CR+0.50*TANGO*(WINGIN(12)-0.25*WINGIN(4))                   &
     &   +DX*TAN(SYNA(4)/RAD)*.50
 1090 HWOB2=HW/WINGIN(4)
!
!     ****CALCULATE ELEVATION OF WING 1/4CR (HWCR4) *****
!
      HWCR4=H75CR+0.50*WINGIN(6)*TAN(SYNA(4)/RAD)
      HWCOCR=HWCR4/WINGIN(6)
!
!     ****CALCULATE WING AND TAIL ELEVATIONS IF TAIL IS PRESENT****
!
      IF(HTPL) GO TO 1100
      GO TO 1180
 1100 CONTINUE
!
!     ****CALCULATE ELEVATION OF WING MAC (HWMAC4)*****
!
      HWMACX=GRDHT+SYNA(3)-A(161)*TAN(SYNA(4)/RAD)
      IF(WINGIN(13).EQ.UNUSED.AND.WINGIN(14).EQ.UNUSED)GO TO 1120
      IF(WINGIN(13).NE.UNUSED.AND.WINGIN(14).EQ.UNUSED) GO TO 1110
      IF(WINGIN(13).EQ.UNUSED.AND.WINGIN(14).NE.UNUSED) GO TO 1130
      IF(A(136).LE.WINGIN(4)-WINGIN(12)) GO TO 1110
      HWMAC4=HWMACX+(WINGIN(4)-WINGIN(12))*TANGI                        &
     &       +(A(136)+WINGIN(12)-WINGIN(4))*TANGO
      GO TO 1140
 1110 HWMAC4=HWMACX+A(136)*TANGI
      GO TO 1140
 1120 HWMAC4=HWMACX
      GO TO 1140
 1130 IF(A(136).LE.WINGIN(4)-WINGIN(12)) GO TO 1120
      HWMAC4=HWMACX+(A(136)+WINGIN(12)-WINGIN(4))*TANGO
 1140 CONTINUE
!
!     ****CALCULATE ELEVATION OF TAIL MAC (HTMAC4)*****
!
      HTMACX=GRDHT+SYNA(7)-AHT(161)*TAN(SYNA(8)/RAD)
      TANGIT=TAN(HTIN(13)/RAD)
      TANGOT=TAN(HTIN(14)/RAD)
      IF(HTIN(13).EQ.UNUSED.AND.HTIN(14).EQ.UNUSED) GO TO 1160
      IF(HTIN(13).NE.UNUSED.AND.HTIN(14).EQ.UNUSED) GO TO 1150
      IF(HTIN(13).EQ.UNUSED.AND.HTIN(14).NE.UNUSED) GO TO 1170
      IF(AHT(136).LE.HTIN(4)-HTIN(12)) GO TO 1150
      HTMAC4=HTMACX+(HTIN(4)-HTIN(12))*TANGIT+(AHT(136)+HTIN(12)        &
     &       -HTIN(4))*TANGOT
      GO TO 1180
 1150 HTMAC4=HTMACX+AHT(136)*TANGIT
      GO TO 1180
 1160 HTMAC4=HTMACX
      GO TO 1180
 1170 IF(AHT(136).LE.HTIN(4)-HTIN(12)) GO TO 1160
      HTMAC4=HTMACX+(AHT(136)+HTIN(12)-HTIN(4))*TANGOT
 1180 CONTINUE
!
!     **************CALCULATE GROUND EFFECT ON WING LIFT (DELTA ALPHA)**
!
      R=(1.0+HWOB2**2)**.50-HWOB2
      SIGMA=EXP(-2.48*HWOB2**.768)
      HWOCBR=HW/A(122)
      T=(RAD/(8.0*PI))*(HWOCBR/(HWOCBR**2+1.0/64.))
      IF(A(120).LT.3.0) GO TO 1230
      CALL TLINEX(X118,X218,Y18,7,11,DXOB2,HWOB2,X,                     &
     &            0,0,0,0,Q47118,2,ROUTID)
      IF(STRA.EQ.WINGIN(15)) GO TO 1190
      COSL4=(A(91)*WINGIN(2)+A(67)*(WINGIN(4)-WINGIN(2)))/WINGIN(4)
      GO TO 1200
 1190 COSL4=A(43)
 1200 CONTINUE
!
      DDCLF=0.0
      IFTYPE=F(17)+0.5
      IF(IFTYPE.LT.3 .OR. IFTYPE.GT.5)GO TO 1210
!
!     FIG. 4.7.1-17 DEL(DEL-CL) FOR FLAPS
!
      VAR(1)=HWMAC4/WINGIN(6)
      LGH(1)=13
      IF(IFTYPE.EQ.3.OR.IFTYPE.EQ.4)CALL INTERX(1,X4717A,VAR,LGH,       &
     &   Y4717A,DDCLF,13,13,1,0,0,0,1,0,0,0,Q47117,2,ROUTID)
      IF(IFTYPE.EQ.5)               CALL INTERX(1,X4717A,VAR,LGH,       &
     &   Y4717B,DDCLF,13,13,1,0,0,0,1,0,0,0,Q47117,2,ROUTID)
 1210 DO 1220 J=1,NALPHA
         IF(.NOT.HTPL) CLWF=BWI(J+20)+WING(L+200)
         IF(  HTPL   ) CLWF=BWI(J+20)
         CLOCOS(J)=RAD*WING(J+20)/(2.0*PI*COSL4**2)
         CALL TLINEX(X119,X219,Y19,9,12,CLOCOS(J),HWCOCR,LOLOM1(J),     &
     &               0,0,2,2,Q47119,2,ROUTID)
         DALPHA(J)=-(9.12/A(120)+7.16*WINGIN(6)/(2.0*WINGIN(4)))*       &
     &             CLWF*X-(A(120)*WINGIN(6)/(4.0*BWI(101)               &
     &             *WINGIN(4)))* LOLOM1(J)*CLWF*R
         ALPHWG(J)=FLC(J+22)+DALPHA(J)-DDCLF*DELTA(L)**2/(2500.         &
     &             *BWI(J+100))
 1220 END DO
      GO TO 1250
 1230 CONTINUE
!
!     *********GROUND EFFECTS ON LOW ASPECT RATIO WING LIFT******
!
      K=RAD*.0030*HWOCBR*(1.0/(HWOCBR**2+1.0/64.)**2+1.0/(HWOCBR**2     &
     &  +9.0/64.)**2)
      DO 1240 J=1,NALPHA
         CALL TLINEX(X125,X225,Y25,9,11,WING(J+20),HWOCBR,BW(J),        &
     &               0,0,2,2,Q47125,2,ROUTID)
         DALPHA(J)=-18.24*BWI(J+20)*SIGMA/A(120)+R*T*BWI(J+20)**2/      &
     &          (RAD*BWI(101))-R*BW(J)+K*WINGIN(16)
         ALPHWG(J)=FLC(J+22)+DALPHA(J)
 1240 END DO
 1250 CONTINUE
      IF(HTPL) GO TO 1260
      GO TO 1280
 1260 CONTINUE
!
!     *********GROUND EFFECTS ON TAIL ************
!
      CALL TLINEX(X122A,X222A,Y22A,4,6,A(120),1/A(118),BWOB,            &
     &            2,0,2,1,Q7122A,3,ROUTID)
      BEFF=BWOB*2.0*WINGIN(4)
      DO 1270 J=1,NALPHA
         DDWASH(J)=DWASH(J+20)*(BEFF**2+4.*(HTMAC4-HWMAC4)**2)/(BEFF**2+&
     &         4.*(HTMAC4+HWMAC4)**2)
         CLHT(J)=BWH(J+20)-BWI(J+20)
         ALPHAT(J)=FLC(J+22)-DDWASH(J)
 1270 END DO
 1280 CONTINUE
      IW=0
      IT=0
      DO 1300 J=1,NALPHA
         CLWB = BWI(J+20)
         CALL TBFUNX(FLC(J+22),CLWBG(J),DYDX,NALPHA,ALPHWG(1),BWI(21),  &
     &               CW,IW,MI,NG,1,2,QCLWBG,2,ROUTID)
         DCLWBG(J) = CLWBG(J)-CLWB
         IF(VTPL .OR. VFPL .OR. TVTPAN) BWV(J+20)=CLWBG(J)
         IF(HTPL) GO TO 1290
         GO TO 1300
 1290    CALL TBFUNX(FLC(J+22),CLHTG(J),DYDX,NALPHA,ALPHAT(1),CLHT(1),  &
     &               CT,IT,MI,NG,1,2,QCLHTG,2,ROUTID)
         CLG(J)=BWV(J+20)+CLHTG(J)
         IF(VTPL .OR. VFPL .OR. TVTPAN) BWHV(J+20)=CLG(J)
 1300 END DO
      DO 1310 J=1,NALPHA
 1310 BWI(J+20)=CLWBG(J)
!
!     **************GROUND EFFECTS ON PITCHING MOMENT ***********
!
      DO 1350 J=1,NALPHA
         DXCP=BWI(121)/BWI(101)
         DCMWBG(J)=DXCP*DCLWBG(J)
         CMWBG(J)=BWI(J+40)+DCMWBG(J)
         IF(VTPL .OR. VFPL .OR. TVTPAN) BWV(J+40)=CMWBG(J)
         IF(HTPL) GO TO 1320
         GO TO 1330
 1320    CONTINUE
!
!     *********GROUND EFFECT ON TAIL CM *****
!
         LH=SYNA(6)+AHT(161)-SYNA(1)
         LHOCBR=LH/A(122)
         DCLHTG(J)=CLHTG(J)-CLHT(J)
         DCMHTG(J)=-DCLHTG(J)*LHOCBR*DWASH(J)
         CMG(J)=BWH(J+40)+DCMHTG(J)
         IF(VTPL .OR. VFPL .OR. TVTPAN) BWHV(J+40)=CMG(J)
 1330    CONTINUE
!
!     **************GROUND EFFECT ON DRAG ***********************
!
         DCDLWG(J)=-SIGMA*WING(J+20)**2/(PI*A(120))-(WING(J)-SIGMA*     &
     &             WING(J+20)**2/(PI*A(120)))*R*T*WING(J+20)/RAD
         BWI(J)=BWI(J)+DCDLWG(J)
         IF(VTPL .OR. VFPL .OR. TVTPAN) BWV(J)=BWV(J)+DCDLWG(J)
         IF(HTPL) GO TO 1340
         GO TO 1350
 1340    BWH(J)=BWH(J)+DCDLWG(J)
         IF(VTPL .OR. VFPL .OR. TVTPAN) BWHV(J)=BWHV(J)+DCDLWG(J)
 1350 END DO
!
!     CALCULATE CN AND CA
!
      IW = 0
      IT = 0
      DO 1360 J=1,NALPHA
         SA = SIN(FLC(J+22)/RAD)
         CA = COS(FLC(J+22)/RAD)
         BWI(J+60) = BWI(J+20)*CA + BWI(J)*SA
         BWI(J+80) = BWI(J)*CA - BWI(J+20)*SA
         BWV(J+60) = BWV(J+20)*CA + BWV(J)*SA
         BWV(J+80) = BWV(J)*CA - BWV(J+20)*SA
         BWH(J+60) = BWH(J+20)*CA + BWH(J)*SA
         BWH(J+80) = BWH(J)*CA - BWH(J+20)*SA
         BWHV(J+60) = BWHV(J+20)*CA + BWHV(J)*SA
         BWHV(J+80) = BWHV(J)*CA - BWHV(J+20)*SA
!
!     B-W CLA AND CMA
!
         CALL TBFUNX(FLC(J+22),Z,BWI(J+100),NALPHA,FLC(23),BWI(21),     &
     &               CW,IW,MI,NG,0,0,4HCLA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),Z,BWI(J+120),NALPHA,FLC(23),BWI(41),     &
     &               CT,IT,MI,NG,0,0,4HCMA ,1,ROUTID)
 1360 END DO
!
!     B-W-V CLA AND CMA
!
      IW = 0
      IT = 0
      DO 1370 J=1,NALPHA
         CALL TBFUNX(FLC(J+22),Z,BWV(J+100),NALPHA,FLC(23),BWV(21),     &
     &              CW,IW,MI,NG,0,0,4HCLA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),Z,BWV(J+120),NALPHA,FLC(23),BWV(41),     &
     &               CT,IT,MI,NG,0,0,4HCMA ,1,ROUTID)
 1370 END DO
!
!     B-W-H CLA AND CMA
!
      IW = 0
      IT = 0
      DO 1380 J=1,NALPHA
         CALL TBFUNX(FLC(J+22),Z,BWH(J+100),NALPHA,FLC(23),BWH(21),     &
     &               CW,IW,MI,NG,0,0,4HCLA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),Z,BWH(J+120),NALPHA,FLC(23),BWH(41),     &
     &               CT,IT,MI,NG,0,0,4HCMA ,1,ROUTID)
 1380 END DO
!
!     B-W-H-V CLA AND CMA
!
      IW = 0
      IT = 0
      DO 1390 J=1,NALPHA
         CALL TBFUNX(FLC(J+22),Z,BWHV(J+100),NALPHA,FLC(23),BWHV(21),   &
     &               CW,IW,MI,NG,0,0,4HCLA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),Z,BWHV(J+120),NALPHA,FLC(23),BWHV(41),   &
     &               CT,IT,MI,NG,0,0,4HCMA ,1,ROUTID)
 1390 END DO
      RETURN
      END
      SUBROUTINE HBTRAN(I)
!
!*** COMPUTES (XAC/CBARR)B(H) FOR MACH=1.40,TRANSONIC H.T.-BODY CLALPHA
!
      DIMENSION ROUTID(2),Q1211A(3),Q1211B(3),Q31210(3),Q2137A(3),      &
     &          Q2137B(3)
      REAL MACH,NXX,KWB,KBW,IVBW  ,KKBW,KKWB
      LOGICAL       FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,    &
     &              HEAD,PRPOWR,JEQPOW,LOASRT,TVTPAN,                   &
     &              SUPERS,SUBSON,TRANSN,HYPERS
      DIMENSION CDW(20),CDB(20),WTYPE(4),IVBW(20),GAMMA(20)
      DIMENSION T4337A(11),D4337A(24),T4337B(12),D4337B(20)
      DIMENSION T4311A(38),D4311A(285),DUMYA(150),DUMYB(135)
      DIMENSION TFIG10(11),DKWB10(11),DKBW10(11)
      DIMENSION T4311B(24),D4311B(135)
      DIMENSION LGH(4),VAR(4),CD(20),CN(20),CA(20),CL(20),CLB(20),      &
     &          CLW(20),ALPHAB(20)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JEQPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /SYNTSS/ XCG,AA(4),XW
      COMMON /BODYI/  NXX,XCOOR(20), dum2(108)
      COMMON /HTI/    WINGIN(154)
      COMMON /HTDATA/ A(195)
      COMMON /BDATA/  BD(762)
      COMMON /SUPBOD/ SBD(227)
      COMMON /SUPWBB/  SSS(61), SWB(61)
      COMMON /SBETA/  STB(243), TRA(108)
      COMMON /IBODY/  PB, BODY(400)
      COMMON /IHT/    PW, WING(380)
      COMMON /IBH/    PBW, BW(380)
      EQUIVALENCE (D4311A(1),DUMYA(1)),(D4311A(151),DUMYB(1))
      EQUIVALENCE (CA(1),BW(81)),(CR,WINGIN(6)),(CDW(1),WING(1)),       &
     &            (KKWB,SWB(2)),(SPANS,WINGIN(3)),(ARSTAR,A(7)),        &
     &            (CD(1),BW(1)),(DD,SWB(5)),(CLB(1),BODY(21)),          &
     &            (SPAN,WINGIN(4)),(XACBW,SWB(8))
      EQUIVALENCE (CL(1),BW(21)),(KBW,SWB(11)),(TANL,A(62)),            &
     &            (IVBW(1),SWB(12)),(RKBW,SWB(32)),(CRSTAR,A(10)),      &
     &            (TAPEXP,A(27)),(CN(1),BW(61)),(CDB(1),BODY(1)),       &
     &            (CLW(1),WING(21)),(KWB,SWB(35)),                      &
     &            (DN,SBD(4)),(D1,SBD(5)),(KKBW,SWB(37))
      EQUIVALENCE (XACA,SWB(39)),(GAMMA(1),SWB(40)),                    &
     &            (TRINO,SWB(60)),(ALPHAB(1),BD(255))
      EQUIVALENCE (CLAB,BODY(101)),(CLAW,WING(101)),(CLA,BW(101)),      &
     &            (CLABW,TRA(72)),(CLAWB,TRA(71))
      DATA Q1211A/4H4.3.,4H1.2-,4H11A /,Q2137A/4H4.3.,4H2.2-,4H37A /,   &
     &     Q1211B/4H4.3.,4H1.2-,4H11B /,Q2137B/4H4.3.,4H2.2-,4H37B /,   &
     &     Q31210/4H4.3.,4H1.2-,4H10  /,ROUTID/4HWBTR,4HAN  /
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
!                   FIGURE 4.3.1,2-10 KWB
!
      DATA TFIG10/0.0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.0/
      DATA DKWB10/1.0,1.08,1.16,1.26,1.36,1.46,1.56,1.67,1.78,1.89,2.0/
!
!                   FIGURE 4.3.1.2-10 KBW
!
      DATA DKBW10/0.0,.13,.29,.45,.62,.80,1.0,1.22,1.45,1.70,2.0/
!
!                   FIGURE 4.3.1.2-11A  KBW(WITH AFTERBODY)
!
      DATA T4311A/                                                      &
     &.0,.2,.4,.6,.8,1.,1.2,1.4,1.6,1.8,2.,2.4,2.8,3.2,4.,  4*0.,       &
     &0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.,1.2,1.6,2.,3.,4.,8.,10.,999999./
      DATA DUMYA/15*0.,.75,.58,.47,.38,.33,.32,.3,.3,.29,               &
     & .28, .27, .25, .23, .21, .19,                                    &
     & 1.45, 1.2, 1., .87, .78, .75, .7, .68, .64, .6, .58, .55,        &
     &    .5,.48,.4,                                                    &
     & 1.95, 1.7, 1.48, 1.33, 1.2, 1.12, 1.07, 1., .97, .92,            &
     &    .88,.82,.75,.72,.64,                                          &
     & 2.5, 2.2, 1.93, 1.74, 1.58, 1.5, 1.42, 1.38, 1.3, 1.25,          &
     &    1.2,1.1,1.,.93,.8,                                            &
     & 2.95, 2.6, 2.25, 2.05, 1.89, 1.8, 1.7, 1.65, 1.57, 1.5,          &
     &    1.48,1.36,1.27,1.2,1.03,                                      &
     & 3.3,  2.92, 2.6, 2.35, 2.18, 2.04, 1.95, 1.86, 1.8,              &
     &    1.73,1.7,1.59,1.49,1.4,1.21,                                  &
     & 3.7, 3.32, 2.99, 2.7, 2.5, 2.33, 2.23, 2.12, 2.03,               &
     &    1.97,1.9,1.8,1.7,1.6,1.42,                                    &
     & 4.1, 3.64, 3.25, 2.97, 2.77, 2.6, 2.45, 2.32, 2.23,              &
     &    2.15,2.1,1.95,1.85,1.76,1.62,                                 &
     & 4.3, 3.83, 3.49, 3.2, 2.99, 2.8, 2.65, 2.5, 2.42, 2.33,          &
     &    2.29,2.14,2.,1.89,1.74/
      DATA DUMYB/4.6,4.08,3.69,3.35,3.14,2.95,2.8,                      &
     & 2.69, 2.6, 2.49, 2.4, 2.25, 2.16, 2.02, 1.85,                    &
     & 5., 4.37, 3.98, 3.64, 3.39, 3.19, 3.03, 2.89, 2.8,               &
     &    2.7, 2.61, 2.43, 2.33, 2.21, 2.,                              &
     & 5.45, 4.75, 4.29, 3.95, 3.7, 3.5, 3.34, 3.2, 3.1, 3.,            &
     &    2.91,2.75,2.6,2.48,2.28,                                      &
     & 5.9, 5.1, 4.63, 4.25, 4., 3.8, 3.65, 3.5, 3.33, 3.23,            &
     &    3.14,2.95,2.8,2.67,2.4,                                       &
     & 6.2, 5.5, 5., 4.65, 4.35, 4.15, 3.98, 3.8, 3.67,                 &
     &    3.53,3.4,3.24,3.1,2.92,2.68,                                  &
     & 6.6, 5.75, 5.25, 4.9, 4.6, 4.4, 4.22, 4.05, 3.91,                &
     &    3.78,3.68,3.45,3.26,3.1,2.83,                                 &
     & 7.05, 6.15, 5.6, 5.2, 4.95, 4.7, 4.49, 4.3, 4.13,                &
     &    4.,3.85,3.68,3.5,3.34,3.1,                                    &
     & 7.4, 6.35, 5.8, 5.4, 5.12, 4.85, 4.67, 4.49, 4.33,               &
     &    4.2,4.07,3.85,3.65,3.5,3.24,                                  &
     & 8., 6.73, 6.2, 5.8, 5.5, 5.25, 5., 4.82, 4.67,                   &
     &    4.5,4.35,4.12,3.9,3.8,3.59/
!
!                   FIGURE 4.3.1.2-11B  KBW(NO AFTERBODY)
!
      DATA T4311B/0.,.2,.4,.6,.8,1.,1.2,1.4,1.6,1.8,2.,2.4,2.8,3.2,4.,  &
     & 0.,.2,.4,.6,.8,1.,2.,4.,999999./
      DATA D4311B/15*0.,1.2,1.,.75,.58,.45,.37,.3,.28,.24,.2,.18,       &
     &    .15,.13,.11,.1,                                               &
     & 2.4, 1.85, 1.42, 1.1, .92, .77, .66, .6, .51, .48, .41,          &
     &    .31,.26,.22,.22,                                              &
     & 3.5, 2.6, 2., 1.58, 1.28, 1.07, .91, .78, .7, .6, .52,           &
     &    .42,.39,.33,.3,                                               &
     & 4.3, 3.1, 2.35, 1.8, 1.45, 1.2, 1.04, .92, .83, .75,             &
     &    .68,.55,.48,.4,.38,                                           &
     & 5., 3.65, 2.78, 2.22, 1.82, 1.5, 1.3, 1.15, 1., .92,             &
     &    .82,.69,.58,.5,.42,                                           &
     & 5.75, 4.55, 3.66, 2.9, 2.3, 1.92, 1.62, 1.42, 1.25, 1.1,         &
     &    .97,.82,.7,.63,.52,                                           &
     & 6.7, 5.25, 4.18, 3.32, 2.63, 2.2, 1.88, 1.62, 1.45,              &
     &    1.28,1.15,1.,.85,.75,.62,                                     &
     & 7.6, 6.2, 4.91, 3.95, 3.18, 2.6, 2.22, 1.91, 1.7, 1.5,           &
     &    1.35,1.12,.97,.85,.7/
!
!                   FIGURE 4.3.2.2-37A
!
      DATA T4337A/0.0,.4,.8,1.2,1.6,2.,2.4,2.8,                         &
     &           .1,1.0,999999./
      DATA D4337A/                                                      &
     &.5,.72,.900,1.08,1.24,1.39,1.53,1.68,                             &
     &.5,.72,.910,1.09,1.25,1.41,1.57,1.72,                             &
     &.5,.73,.920,1.11,1.27,1.43,1.59,1.74/
!
!                   FIGURE 4.3.2.2-37B
!
      DATA T4337B/0.0,.1,.2,.3,.4,.5,.6,.8,1.0,2.8,                     &
     &            0.2,999999./
      DATA D4337B/                                                      &
     &0.5,.56,.595,.62,.64,.65,.66,.669,.669,.671,                      &
     &0.5,.54,.578,.60,.62,.638,.649,.66,.669,.671/
!
      NX=NXX+.5
      DCYL=(DN+D1)/2.
      MACH=FLC(I+2)
      RLB=XCOOR(NX)
      DD=2.0*(SPAN-SPANS)
      TANLE=TANL
      IF(TANLE.EQ.0.0)TANLE=.00001
      IF(MACH.EQ.1.)BETA=.0000001
      IF(MACH .EQ. 1.) GO TO 1030
      IF(MACH.GT.1.)BETA=SQRT(MACH**2-1.)
      IF(MACH.LT.1.)BETA=SQRT(1.-MACH**2)
!
!   ***SUPERSONIC WING-BODY LIFT CURVE SLOPE,BODY IN PRESENCE OF WING***
!                         NON-TRIANGULAR WINGS
!
      IF(TAPEXP.EQ.0.0)GO TO 1050
      ARG1=BETA*ARSTAR*(1.0+TAPEXP)
      ARG2=1.+TANLE/BETA
      TRINO=ARG1*ARG2
      IF(TRINO.LE.4.)GO TO 1030
 1000 LGH(1)=15
      ARG=(XW+CR)/RLB
      VAR(1)=BETA* DD/CRSTAR
      VAR(2)=BETA/TANLE
      IF(ARG.GT.1.)GO TO 1010
      LGH(2)=19
!
!                   FIGURE 4.3.1.2-11A
!
      CALL INTERX(2,T4311A,VAR,LGH,D4311A,RKBW,19,285,                  &
     &            2,0,0,0,1,0,0,0,Q1211A,3,ROUTID)
      GO TO 1020
 1010 LGH(2)=9
!
!                   FIGURE 4.3.1.2-11B
!
      CALL INTERX(2,T4311B,VAR,LGH,D4311B,RKBW,15,135,                  &
     &            2,0,0,0,1,0,0,0,Q1211B,3,ROUTID)
 1020 KBW=RKBW/(RAD*BETA*(SREF/A(3))*CLAW*(TAPEXP+1.)*(2.*SPAN/DD-1.))
      GO TO 1040
 1030 CONTINUE
      LGH(1)=11
      VAR(1)=DD/(2.*SPAN)
!
!                   FIGURE 4.3.1.2-10 KBW
!
      CALL INTERX(1,TFIG10,VAR,LGH,DKBW10,KBW,11,11,                    &
     &            0,0,0,0,0,0,0,0,Q31210,3,ROUTID)
 1040 CONTINUE
      GO TO 1060
!
!  ***SUPERSONIC WING-BODY LIFT CURVE SLOPE,BODY IN PRESENCE OF WING***
!                         TRIANGULAR WING
 1050 CONTINUE
      ARG=BETA*ARSTAR
      IF(ARG.GT.1.)GO TO 1000
      GO TO 1030
 1060 CONTINUE
!
!  ***SUPERSONIC WING-BODY LIFT CURVE SLOPE
!
      ALBO=BD(81)
      IF(BD(81).EQ.UNUSED)ALBO=0.0
      DO 1070 J=1,NALPHA
 1070 ALPHAB(J)=FLC(J+22)+ALBO
      VAR(1)=(SPAN-SPANS)/SPAN
      LGH(1)=11
!
!                   FIGURE 4.3.1.2-10 KWB
!
      CALL INTERX(1,TFIG10,VAR,LGH,DKWB10,KWB,11,11,                    &
     &            0,0,0,0,0,0,0,0,Q31210,3,ROUTID)
      CLAWB=CLAW*KWB
      CLABW=CLAW*KBW
      CLA=CLABW+CLAWB+CLAB
!
!  ***SUPERSONIC WING-LIFT CARRYOVER ON BODY***
!
      BETA=.98
      VAR(1)=BETA*DD/CRSTAR
      VAR(2)=BETA/TANLE
      ARG=(XW+CR)/RLB
      IF(ARG.GT.1.)GO TO 1080
!
!                   FIGURE 4.3.2.2-37A(XAC)B(W)
!
      LGH(1)=8
      LGH(2)=3
      CALL INTERX(2,T4337A,VAR,LGH,D4337A,XACA,8,24,                    &
     &            0,0,0,0,1,0,0,0,Q2137A,3,ROUTID)
      GO TO 1090
!
!                   FIGURE 4.3.2.2-37B(XAC)B(W)
!
 1080 LGH(1)=10
      LGH(2)=2
      CALL INTERX(2,T4337B,VAR,LGH,D4337B,XACA,10,20,                   &
     &            0,0,0,0,0,0,0,0,Q2137B,3,ROUTID)
 1090 XACBW=XACA*CRSTAR/CBARR
      RETURN
      END
      SUBROUTINE HEADR(DATA,ICONF,SD,JDETCH,GROUND,POWFLG,VTPLAN)
!
!     THIS SUBROUTINE WRITES PAGE HEADINGS AND CALLS SUBROUTINE
!     INTERM TO WRITE THE OUTPUT DATA FOR STATIC OR DYNAMIC
!     STABILITY DATA
!
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /IBWH/    PBWH,   BWH(380)
      COMMON /IPOWER/  PPOWER, POWER(200)
      COMMON /IDWASH/  PDWASH, DWASH(60)
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ SYNA(19)
      COMMON /WINGI/  WINGIN(101)
      COMMON /HTI/    HTIN(154)
      COMMON /FLAPIN/ F(138)
      COMMON /WINGD/  A(195), B(49)
      COMMON /BDATA/  BD(762)
      COMMON /SUPWH/  SLG(303)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA,IG,NF,LF,L
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),IDIM
      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,          &
     &                KBODY, KWING, KHT, KVT, KWB, KDWASH(3),           &
     &                ALPOW, ALPLW, ALPOH, ALPLH
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL MDATA, FLAG
      LOGICAL NDMF,NAF,VTPLAN,POWFLG,NEXPER,PDWASH,GROUND,PRINT
      INTEGER SD

!      DIMENSION DATA(400), OPT(4)
      DIMENSION DATA(*), OPT(4)
! above mod by RLC   2021Jan18
      
      DIMENSION ALSCHD(20)
      DIMENSION ICONT(11), FOR(46)
      EQUIVALENCE(WINGIN(15),WTYPE),(FLC(23),ALSCHD(1)),(SLG(16),GRNDHT)
      EQUIVALENCE (OPT(1),SREF)
      DATA ICONT / 7, 10*10 /
      DATA FOR   /    4H(   ,4H1H0 ,                                    &
     &  4H,0P ,4HF6.3,4H,1X ,4H,1X ,  4H,1X,,4HF8.2,4H,1X ,4H,1X ,      &
     &  4H,1X,,4HF8.2,4H,1X ,4H,2X ,  4H,1P ,4HE10.,4H4   ,4H,3X ,      &
     &  4H,0P ,4HF9.3,4H,1X ,4H,4X ,  4H,1P ,4HE10.,4H4   ,4H,9X ,      &
     &  4H,0P ,4HF9.3,4H,1X ,4H,1X ,  4H,1X,,4HF8.3,4H,1X ,4H    ,      &
     &  4H,1X,,4HF8.3,4H,1X ,4H    ,  4H,1X,,4HF8.3,4H,1X ,4H    ,      &
     &  4H,1X,,4HF8.3,4H,1X ,4H)   /
      DATA DOUB / 4HDOUB /, CRAN / 4HCRAN /, STRA / 4HSTRA /
!
      WRITE(6,1270)
!
      IF(SD .EQ. 1) WRITE(6,1520)
      IF(SD .EQ. 2) WRITE(6,1710)
!
!     WRITE CONFIGURATION HEADING
!
      NALP = NALPHA
      GO TO (1000, 1010, 1020, 1030, 1040, 1050, 1060, 1080, 1090, 1110,&
     & 1130),ICONF
 1000 WRITE(6,1280)
      GO TO 1140
 1010 WRITE(6,1290)
      GO TO 1140
 1020 WRITE(6,1630)
      GO TO 1140
 1030 IF(TVTPAN .AND. VTPL) WRITE(6,1680)
      IF(TVTPAN .AND. .NOT. VTPL) WRITE(6,1670)
      IF(VTPL .AND. .NOT. TVTPAN) WRITE(6,1640)
      GO TO 1140
 1040 IF(.NOT. LOASRT) WRITE(6,1310)
      IF(LOASRT) WRITE(6,1470)
      GO TO 1140
 1050 WRITE(6,1650)
      GO TO 1140
 1060 CONTINUE
      IF(VFPL) GO TO 1070
      IF(TVTPAN .AND. VTPL) WRITE(6,1700)
      IF(TVTPAN .AND. .NOT. VTPL) WRITE(6,1690)
      IF(VTPL .AND. .NOT. TVTPAN) WRITE(6,1660)
      GO TO 1140
 1070 CONTINUE
      IF(TVTPAN .AND. VTPL) WRITE(6,1810)
      IF(TVTPAN .AND. .NOT. VTPL) WRITE(6,1820)
      IF(VTPL .AND. .NOT. TVTPAN) WRITE(6,1830)
      IF(.NOT. VTPL .AND. .NOT. TVTPAN) WRITE(6,1840)
      GO TO 1140
 1080 WRITE(6,1330)
      NALP = JDETCH
      GO TO 1140
 1090 CONTINUE
      IF(VFPL) GO TO 1100
      IF(TVTPAN .AND. VTPL) WRITE(6,1540)
      IF(TVTPAN .AND. .NOT. VTPL) WRITE(6,1530)
      IF(VTPL .AND. .NOT. TVTPAN) WRITE(6,1320)
      GO TO 1140
 1100 CONTINUE
      IF(TVTPAN .AND. VTPL) WRITE(6,1850)
      IF(TVTPAN .AND. .NOT. VTPL) WRITE(6,1860)
      IF(VTPL .AND. .NOT. TVTPAN) WRITE(6,1870)
      IF(.NOT. VTPL .AND. .NOT. TVTPAN) WRITE(6,1880)
      GO TO 1140
 1110 CONTINUE
      NALP = JDETCH
      IF(VFPL) GO TO 1120
      IF(TVTPAN .AND. VTPL) WRITE(6,1560)
      IF(TVTPAN .AND. .NOT. VTPL) WRITE(6,1550)
      IF(VTPL .AND. .NOT. TVTPAN) WRITE(6,1450)
      GO TO 1140
 1120 CONTINUE
      IF(TVTPAN .AND. VTPL) WRITE(6,1890)
      IF(TVTPAN .AND. .NOT. VTPL) WRITE(6,1900)
      IF(VTPL .AND. .NOT. TVTPAN) WRITE(6,1910)
      IF(.NOT. VTPL .AND. .NOT. TVTPAN) WRITE(6,1920)
      GO TO 1140
 1130 CONTINUE
      WRITE(6,1800)
 1140 CONTINUE
      IF(GROUND .AND. GRNDHT .NE. UNUSED)WRITE(6,1500) GRNDHT
      IF(GROUND .AND. GRNDHT .EQ. UNUSED)WRITE(6,1501)
      NFP = F(16) + 0.5
      IF(GROUND .AND. WGPL .AND. (.NOT. HTPL) .AND. (NFP .GT. 1))       &
     &    WRITE(6,1510) F(NF)
      IF(JETPOW .AND. POWFLG) WRITE(6,1490)
      IF(PRPOWR .AND. POWFLG) WRITE(6,1480)
      IF(HEAD) CALL PRCSID
      WRITE(6,1440)
!
!     SET UP FOR DEGREE/RADIAN CONVERSION
!
      CON = 1.0
      IF(DRCONV) CON = RAD
      IF(SD .EQ. 2) GO TO 1210
      DO 1150 J=1,NALPHA
      DO 1150 K=1,5
      KK=(K-1)*20+100
      IF(ABS(DATA(J+KK)).NE.UNUSED .AND. DATA(J+KK).NE.(2.*UNUSED))     &
     & DATA(J+KK)=DATA(J+KK)*CON
 1150 CONTINUE
      WRITE(6,1340)
      IF(IDIM .EQ. 1) WRITE(6,1350)
      IF(IDIM .EQ. 2) WRITE(6,1360)
      IF(IDIM .EQ. 3) WRITE(6,1370)
      IF(IDIM .EQ. 4) WRITE(6,1380)
      SC = SYNA(13)
      XL = 1.0
      XR = 1.0
      XP = 1.0
      XT = 1.0
      IF(IDIM .EQ. 2) XL = 12.0
      IF(IDIM .EQ. 2) XP = 144.0
      IF(IDIM .GE. 3) XP = 0.0208854
      IF(IDIM .GE. 3) XR = 0.3048
      IF(IDIM .GE. 3) XT = 1.8
      IF(IDIM .EQ. 3) XL = 0.3048
      IF(IDIM .EQ. 4) XL = 30.48
      ALT  = FLC(L+96)
      VINF = FLC(M+136)
      PINF = FLC(L+73)
      TINF = FLC(L+116)
      IF(ALT  .NE. -UNUSED) ALT  = ALT *XL
      IF(VINF .NE. -UNUSED) VINF = VINF*XL
      IF(PINF .NE. -UNUSED) PINF = PINF/XP
      IF(TINF .NE. -UNUSED) TINF = TINF/XT
      RN   = FLC(M+42)/XR
      SRF  = OPT(1)*XL*XL/(SC*SC)
      CBAR = OPT(2)*XL/SC
      BLRF = OPT(4)*XL/SC
      XCG  = SYNA(1)
      ZCG  = SYNA(5)
      IF(XCG .EQ. UNUSED) XCG = 0.0
      IF(ZCG .EQ. UNUSED) ZCG = 0.0
      IF(BD(11) .NE. UNUSED) XCG = XCG+BD(11)
      XCG  = XCG*XL/SC
      ZCG  = ZCG*XL/SC
      CALL SWRITE(11,FOR,46,ICONT,1,FLC(M+2),ALT,VINF,PINF,             &
     &            TINF,RN,SRF,CBAR,BLRF,XCG,ZCG,DUM,                    &
     &            DUM,DUM,NDMF,NAF)
      IF(.NOT. DRCONV) WRITE(6,1390)
      IF(   DRCONV   ) WRITE(6,1400)
      WRITE(6,1410)
!
!     ----- INCLUDE POWER EFFECTS IN STATIC COEFFICIENTS
!
      IF(.NOT. POWFLG) GO TO 1170
      DO 1160 J=1,NALPHA
          DATA(J)=DATA(J)+POWER(J)
          DATA(J+20)=DATA(J+20)+POWER(J+20)
          DATA(J+40)=DATA(J+40)+POWER(J+40)
          DATA(J+60)=DATA(J+60)+POWER(J+60)
          DATA(J+80)=DATA(J+80)+POWER(J+80)
 1160 END DO
 1170 CONTINUE
      CALL INTERM(1,NALP,ALSCHD,DATA,NDMF,NAF)
!
!     ----- REMOVE POWER EFFECTS FROM STATIC COEFFICIENTS
!
      DO 1180 J=1,NALPHA
      DO 1180 K=1,5
      KK=(K-1)*20+100
      IF(ABS(DATA(J+KK)).NE.UNUSED .AND. DATA(J+KK).NE.(2.*UNUSED))     &
     & DATA(J+KK)=DATA(J+KK)/CON
 1180 CONTINUE
      IF(.NOT. POWFLG) GO TO 1200
      DO 1190 J=1,NALPHA
          DATA(J)=DATA(J)-POWER(J)
          DATA(J+20)=DATA(J+20)-POWER(J+20)
          DATA(J+40)=DATA(J+40)-POWER(J+40)
          DATA(J+60)=DATA(J+60)-POWER(J+60)
          DATA(J+80)=DATA(J+80)-POWER(J+80)
 1190 END DO
 1200 CONTINUE
      PRINT = (ICONF .EQ. 8) .OR. (ICONF .EQ. 10)
      METHOD=WINGIN(101)+0.5
      IF(.NOT. PRINT)  GO TO 1210
      IF(.NOT. PDWASH) GO TO 1210
      IF(METHOD .EQ. 3) GO TO 1205
      WRITE(6,1620)
      CALL INTERM(2,NALP,ALSCHD,DWASH,NDMF,NAF)
 1205 CONTINUE
      IF(WINGIN(101) .GT. 2.5) WRITE(6,1760)
 1210 CONTINUE
      IF(SD .EQ. 1) GO TO 1240
      WRITE(6,1340)
      IF(IDIM .EQ. 1) WRITE(6,1350)
      IF(IDIM .EQ. 2) WRITE(6,1360)
      IF(IDIM .EQ. 3) WRITE(6,1370)
      IF(IDIM .EQ. 4) WRITE(6,1380)
      CALL SWRITE(11,FOR,46,ICONT,1,FLC(M+2),ALT,VINF,PINF,             &
     &            TINF,RN,SRF,CBAR,BLRF,XCG,ZCG,DUM,                    &
     &            DUM,DUM,NDMF,NAF)
      IF(.NOT. DRCONV) WRITE(6,1740)
      IF(   DRCONV   ) WRITE(6,1750)
      WRITE(6,1720)
      WRITE(6,1730)
      DO 1220 J=1,NALPHA
      DO 1220 K=1,9
      KK=(K-1)*20
      IF(ABS(DATA(J+KK)).NE.UNUSED .AND. DATA(J+KK).NE.(2.*UNUSED))     &
     & DATA(J+KK)=DATA(J+KK)*CON
 1220 CONTINUE
      CALL INTERM(3,NALP,ALSCHD,DATA,NDMF,NAF)
      DO 1230 J=1,NALPHA
      DO 1230 K=1,9
      KK=(K-1)*20
      IF(ABS(DATA(J+KK)).NE.UNUSED .AND. DATA(J+KK).NE.(2.*UNUSED))     &
     & DATA(J+KK)=DATA(J+KK)/CON
 1230 CONTINUE
      IF(.NOT.(BO .AND. WGPL .AND. HTPL)) GO TO 1240
      IF(A(128).EQ.0..AND. SD.EQ. 2) WRITE(6,1770)
      IF(A(128).EQ.1..AND. SD.EQ. 2) WRITE(6,1780)
      IF((BWH(281).EQ.UNUSED.OR.BWH(281).EQ.(2.*UNUSED)).AND.VT(281)    &
     & .NE.UNUSED) WRITE(6,1790)
 1240 CONTINUE
      IF(NDMF) WRITE(6,1570)
      IF(NAF)  WRITE(6,1300)
      IF(SD .EQ. 2) GO TO 1250
      IF(JDETCH.LT.NALPHA .AND. SUPERS) WRITE(6,1260)FLC(JDETCH+22)
      PRINT=(ICONF.EQ.2 .OR. ICONF.EQ.5 .OR. ICONF.EQ.8)
      IF(WTYPE.EQ.CRAN .AND. A(7).LT.A(125) .AND. PRINT) WRITE(6,1420)
      IF(WTYPE.EQ.DOUB .AND. A(7).GE.A(125) .AND. PRINT) WRITE(6,1430)
      IF(GROUND) WRITE(6,1460)
      IF(SUPERS .AND. TVTPAN .AND. VTPLAN) WRITE(6,1590)
      IF(ICONF.EQ.2 .AND. SUPERS .AND. WTYPE.NE.STRA) WRITE(6,1580)     &
     & SLG(80)
      IF(MDATA) WRITE(6,1600)
      FLAG = (ICONF .EQ. 6) .OR. (ICONF .EQ. 8) .OR. (ICONF .EQ. 10)
      IF(HTPL .AND. FLAG .AND. SUPERS .AND. (LF .EQ. 1)) WRITE(6,1610)
 1250 CONTINUE
      RETURN
 1260 FORMAT(30H0ANALYSIS TERMINATED AT ALPHA=,F5.1,16H BECAUSE LEADING,&
     &24H EDGE SHOCK IS DETACHED.)
 1270 FORMAT(1H1,31X,47HAUTOMATED STABILITY AND CONTROL METHODS PER APR,&
     &25HIL 1976 VERSION OF DATCOM)
 1280 FORMAT(51X,31HDATCOM BODY ALONE CONFIGURATION)
 1290 FORMAT(54X,24HWING ALONE CONFIGURATION)
 1300 FORMAT(42H0*** NA PRINTED WHEN METHOD NOT APPLICABLE)
 1310 FORMAT(55X,23HWING-BODY CONFIGURATION)
 1320 FORMAT(48X,37HWING-BODY-VERTICAL TAIL CONFIGURATION)
 1330 FORMAT(47X,39HWING-BODY-HORIZONTAL TAIL CONFIGURATION)
 1340 FORMAT(55H -----------------------  FLIGHT CONDITIONS  ----------,&
     &       14H--------------,11X,25H--------------  REFERENCE,        &
     &       25H DIMENSIONS  ------------/2X,16HMACH    ALTITUDE,       &
     &       3X,48HVELOCITY    PRESSURE    TEMPERATURE     REYNOLDS,    &
     &       13X,47HREF.      REFERENCE LENGTH   MOMENT REF. CENTER/    &
     &       7H NUMBER,55X,6HNUMBER,14X,4HAREA,7X,5HLONG.,5X,4HLAT.,    &
     &       5X,15HHORIZ      VERT)
 1350 FORMAT(13X,2HFT,7X,6HFT/SEC,5X,8HLB/FT**2,7X,5HDEG R,9X,4H1/FT,   &
     &       15X,5HFT**2,1X,4(7X,2HFT,1X))
 1360 FORMAT(13X,2HIN,7X,6HIN/SEC,5X,8HLB/IN**2,7X,5HDEG R,9X,4H1/FT,   &
     &       15X,5HIN**2,1X,4(7X,2HIN,1X))
 1370 FORMAT(13X,2H M,7X,6H M/SEC,5X,8H N/ M**2,7X,5HDEG K,9X,4H1/ M,   &
     &       15X,5H M**2,1X,4(7X,2H M,1X))
 1380 FORMAT(13X,2HCM,7X,6HCM/SEC,5X,8H N/CM**2,7X,5HDEG K,9X,4H1/ M,   &
     &       15X,5HCM**2,1X,4(7X,2HCM,1X))
 1390 FORMAT(1H0,63X,42H-------------------DERIVATIVE (PER DEGREE),     &
     &       19H-------------------)
 1400 FORMAT(1H0,63X,42H-------------------DERIVATIVE (PER RADIAN),     &
     &       19H-------------------)
 1410 FORMAT(2H0 ,5HALPHA,5X,2HCD                                       &
     &,7X,2HCL,7X,2HCM,7X,2HCN,7X,2HCA,7X,3HXCP,8X,3HCLA,10X,3HCMA,10X, &
     & 3HCYB,10X,3HCNB,10X,3HCLB/1H0)
 1420 FORMAT(55H0***NOTE*** CRANKED WING ANALYSIS PERFORMED EVEN THOUGH,&
     &29H WING HAS A LOW ASPECT RATIO.)
 1430 FORMAT(55H0***NOTE*** DOUBLE DELTA WING ANALYSIS DONE EVEN THOUGH,&
     &30H WING HAS A HIGH ASPECT RATIO.)
 1440 FORMAT(1H )
 1450 FORMAT(40X,53HWING-BODY-VERTICAL TAIL-HORIZONTAL TAIL CONFIGURATIO&
     &N)
 1460 FORMAT(121H0***NOTE***GROUND EFFECT ANALYSIS IS PERFORMED ACROSS T&
     &HE COMPLETE ANGLE OF ATTACK RANGE EVEN THOUGH THE METHODS ARE ONLY&
     &/38H APPLICABLE TO THE LINEAR LIFT REGION.)
 1470 FORMAT(1H ,42X,49HLOW ASPECT RATIO WINGS AND WING-BODY COMBINATION&
     &S)
 1480 FORMAT(31X,70HPROPELLER POWER EFFECTS INCLUDED IN THE LONGITUDINAL&
     & STABILITY RESULTS)
 1490 FORMAT(34X,64HJET POWER EFFECTS INCLUDED IN THE LONGITUDINAL STABI&
     &LITY RESULTS)
 1500 FORMAT(21X,78HGROUND EFFECTS INCLUDED IN THE LONGITUDINAL STABILIT&
     &Y RESULTS , GROUND HEIGHT=,F7.2)
 1501 FORMAT(21X,87HGROUND EFFECTS INCLUDED IN THE LONGITUDINAL STABILIT&
     &Y RESULTS , GROUND HEIGHT= FREE AIR)
 1510 FORMAT(25X,70HWING FLAP DEFLECTION INCLUDED IN GROUND EFFECTS DATA&
     &, FLAP DEFLECTION=,F7.2)
 1520 FORMAT(41X, 50HCHARACTERISTICS AT ANGLE OF ATTACK AND IN SIDESLIP)
 1530 FORMAT(45X,43HWING-BODY-TWIN VERTICAL PANEL CONFIGURATION)
 1540 FORMAT(38X,57HWING-BODY-VERTICAL TAIL-TWIN VERTICAL PANEL CONFIGUR&
     &ATION)
 1550 FORMAT(37X,59HWING-BODY-HORIZONTAL TAIL-TWIN VERTICAL PANEL CONFIG&
     &URATION)
 1560 FORMAT(30X,73HWING-BODY-HORIZONTAL TAIL-VERTICAL TAIL-TWIN VERTICA&
     &L PANEL CONFIGURATION)
 1570 FORMAT(45H0*** NDM PRINTED WHEN NO DATCOM METHODS EXIST)
 1580 FORMAT( 9H0**  CD0=,1PE10.3)
 1590 FORMAT(109H0**NOTE*LATERAL STABILITY DERIVATIVES DO NOT INCLUDE TH&
     &E EFFECTS OF TWIN VERTICAL PANELS. (NO DATCOM METHODS))
 1600 FORMAT(48H0*NOTE* OUTPUT REFLECTS EXPERIMENTAL DATA INPUTS)
 1610 FORMAT(130H0**NOTE*  THE HORIZONTAL TAIL LIES OFF THE BODY%  LATER&
     &AL STABILITY DERIVATIVES DO NOT INCLUDE THE EFFECTS OF THE HORIZON&
     &TAL TAIL.)
 1620 FORMAT(1H0,36X, 5HALPHA,5X,6HQ/QINF,4X,6HEPSLON,2X,18HD(EPSLON)/D(&
     &ALPHA)/1H0)
 1630 FORMAT(52X,29HHORIZONTAL TAIL CONFIGURATION)
 1640 FORMAT(53X,27HVERTICAL TAIL CONFIGURATION)
 1650 FORMAT(49X,34HBODY-HORIZONTAL TAIL CONFIGURATION)
 1660 FORMAT(50X,32HBODY-VERTICAL TAIL CONFIGURATION)
 1670 FORMAT(50X,33HTWIN VERTICAL PANEL CONFIGURATION)
 1680 FORMAT(43X,47HVERTICAL TAIL-TWIN VERTICAL PANEL CONFIGURATION)
 1690 FORMAT(47X,38HBODY-TWIN VERTICAL PANEL CONFIGURATION)
 1700 FORMAT(40X,52HBODY-VERTICAL TAIL-TWIN VERTICAL PANEL CONFIGURATION&
     &)
 1710 FORMAT(57X,19HDYNAMIC DERIVATIVES)
 1720 FORMAT(1H0,11X,22H-------PITCHING-------, 4X,23H-----ACCELERATION-&
     &-----, 4X,35H--------------ROLLING--------------, 4X,22H--------YA&
     &WING--------)
 1730 FORMAT(1H0,3X,5HALPHA,7X,3HCLQ,10X,3HCMQ,11X,4HCLAD,9X,4HCMAD,9X, &
     & 3HCLP,10X,3HCYP,10X,3HCNP,10X,3HCNR,10X,3HCLR/1H0)
 1740 FORMAT(51X,33H DYNAMIC DERIVATIVES (PER DEGREE))
 1750 FORMAT(51X,33H DYNAMIC DERIVATIVES (PER RADIAN))
 1760 FORMAT(122H0NOTE - CANARD CONFIGURATION EFFECTIVE EPSOLN AND D(EPS&
     &OLN)/D(ALPHA) ARE AVAILABLE AS PARTIAL OUTPUT AND IN THE FACT ARRA&
     &Y)
 1770 FORMAT(103H*** BECAUSE OF A LIMITATION ON BETA*(ASPECT RATIO) FOR &
     &THE WING METHODS, ANY VALUES APPEARING ABOVE FOR,/,70H     CLQ, CM&
     &Q, CLAD AND CMAD ARE ONLY THE HORIZONTAL TAIL INCREMENTS./)
 1780 FORMAT( 94H*** FOR CONFIGURATIONS WITH A WING TAPER RATIO OTHER TH&
     &AN ZERO, ANY VALUES APPEARING ABOVE FOR,/,58H    CLAD AND CMAD ARE&
     &ONLY THE HORIZONTAL TAIL INCREMENTS./)
 1790 FORMAT(59H0*** CLP CALCULATIONS ARE ONLY THE VERTICAL TAIL INCREME&
     &NTS)
 1800 FORMAT(54X,25HVENTRAL FIN CONFIGURATION)
 1810 FORMAT(36X,44HBODY-VERTICAL TAIL-VENTRAL FIN-TWIN VERTICAL,       &
     &           20H PANEL CONFIGURATION)
 1820 FORMAT(41X,50HBODY-VENTRAL FIN-TWIN VERTICAL PANEL CONFIGURATION)
 1830 FORMAT(44X,44HBODY-VERTICAL TAIL-VENTRAL FIN CONFIGURATION)
 1840 FORMAT(51X,30HBODY-VENTRAL FIN CONFIGURATION)
 1850 FORMAT(32X,49HWING-BODY-VERTICAL TAIL-VENTRAL FIN-TWIN VERTICAL,  &
     &           20H PANEL CONFIGURATION)
 1860 FORMAT(39X,41HWING-BODY-VENTRAL FIN-TWIN VERTICAL PANEL,          &
     &           14H CONFIGURATION)
 1870 FORMAT(42X,49HWING-BODY-VERTICAL TAIL-VENTRAL FIN CONFIGURATION)
 1880 FORMAT(49X,35HWING-BODY-VENTRAL FIN CONFIGURATION)
 1890 FORMAT(24X,48HWING-BODY-HORIZONTAL TAIL-VERTICAL TAIL-VENTRAL ,   &
     &           37HFIN-TWIN VERTICAL PANEL CONFIGURATION)
 1900 FORMAT(31X,42HWING-BODY-HORIZONTAL TAIL-VENTRAL FIN-TWIN,         &
     &           29H VERTICAL PANEL CONFIGURATION)
 1910 FORMAT(34X,48HWING-BODY-HORIZONTAL TAIL-VERTICAL TAIL-VENTRAL ,   &
     &           17HFIN CONFIGURATION)
 1920 FORMAT(41X,38HWING-BODY-HORIZONTAL TAIL-VENTRAL FIN ,             &
     &           13HCONFIGURATION)
      END
      SUBROUTINE HINGE
!
!***  CALCULATES FLAP HINGE MOMENT DATA
!
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ AHT(195)
      COMMON /FLAPIN/ F(69)
      COMMON /SUPDW/  FHG(35)
      COMMON /POWR/   PW(104),FLP(189)
      COMMON /WINGI/  WINGIN(77)
      COMMON /HTI/    HTIN(131)
      COMMON /IWING/  PWING, WING(400)
      REAL KALPHA,KALPHI,KALPHO,KDELTA,KDELTI,KDELTO
      REAL MACH
      DIMENSION ROUTID(2)
      DIMENSION VAR(4),LGH(4),DCHD(10),DSECCL(10),CHD(10),ALPDEL(10)
      DIMENSION X1125A(8),X2125A(8),Y1125A(64),F1125A(3)
      DIMENSION X1125B(16),X2125B( 6),Y1125B(96),F1125B(3)
      DIMENSION X1317A(7),X2317A(6),Y1317A(42),F1317A(3)
      DIMENSION X1317B(16),X2317B(2),Y1317B(32),F1317B(3)
      DIMENSION X1318A(7),Y318A1(7),Y318A2(7),Y318A3(7),F318A1(3),      &
     &          F318A2(3),F318A3(3)
      DIMENSION X1327B(9),X2327B(6),Y1327B(54),F1327B(3)
      DIMENSION X1327A(7),X2327A(5),Y1327A(35),F1327A(3)
      DIMENSION X1328A(3),Y1328A(3),F1328A(3)
      DIMENSION X1328B(2),X2328B(5),Y1328B(10),F1328B(3)
      DIMENSION X1328C(2),X2328C(5),Y1328C(10),F1328C(3)
      DIMENSION X6115A(9),Y6115A(9),F6115A(3)
      DIMENSION X16116(6),X26116(13),Y16116(78),F16116(3)
      DIMENSION X6115B(12),Y6115B(12),F6115B(3)
      DIMENSION X1629B(12),Y1629B(12),F1629B(3)
      DIMENSION X2629A(10),X1629A(3),Y1629A(30),F1629A(3)
      DIMENSION X2128A(11),X1128A(3),Y1128A(33),F1128A(3)
      DIMENSION DELTA(10),SDCL(10),ALDAG(40),DCL(40)
      LOGICAL   FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,        &
     &          HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                       &
     &          SUPERS,SUBSON,TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM
      EQUIVALENCE (SDCL(1),F(19)),(ALDAG(1),FLP(150))
      EQUIVALENCE (DELTA(1),F(1)),(DCL(1),FLP(110)),(TCHL,F(60)),(CFI,  &
     &            F(12)),(CFO,F(13))
      EQUIVALENCE (CHRD1,FLP(6)),(CHRD5,FLP(10)),(TANPHP,F(11))
      EQUIVALENCE (BIF,F(14)),(CFOCA,FLP(61)),(CLACLT,FLP(33)),(TANPHE  &
     &      ,F(61)),(CB,F(59)),(RTYPE,F(62)),(BOF,F(15)),(RDELTA,F(16))
      EQUIVALENCE (CLATHY,FHG(1)),(CHATHY,FHG(2)),(CHACHT,FHG(3)),(CHAP &
     &,FHG(4)),(CHAPP,FHG(5)),(CHAMAC,FHG(6)),(BRATIO,FHG(7)),(CHBCHA,  &
     &FHG(8)),(CHAPPB,FHG(9)),(CHDCHT,FHG(10)),(CHDTHY,FHG(11)),(CHDP,  &
     &FHG(12)),(CHDPP,FHG(13)),(CHDMAC,FHG(14)),(CHBCHD,FHG(15)),       &
     &(DCHAOK,FHG(17)),(CBOCF,FHG(18)),(CFOCAP,FHG(19)),                &
     &(B2,FHG(20)),(KALPHA,FHG(21)),(DELCHA,FHG(22)),(CHA,WING(251)),   &
     &(KDELTA,FHG(24)),(DCHDOK,FHG(25)),(COSHL,FHG(23)),                &
     &(DCHD(1),FHG(26)),(CHD(1),WING(261)),(CHDPPB,FHG(16))
      DATA ROUTID/4HHING,4HE   /
!
!                   FIGURE 6.1.1.1-39A   FIGURE 4.1.1.2-8A
!
      DATA X2128A                                                       &
     &  /0., 0.02,  0.04,  0.06,  0.08,  0.10,  0.12,  0.14,  0.16,     &
     &       0.18,  0.20 /
      DATA X1128A                                                       &
     &     /6.,7.,8./
      DATA Y1128A                                                       &
     & / 0.900,  0.878,  0.858,  0.836,  0.815,  0.794,  0.772,  0.750, &
     &   0.728,  0.708,  0.685,                                         &
     &   0.950,  0.938,  0.924,  0.907,  0.894,  0.878,  0.860,  0.842, &
     &   0.822,  0.802,  0.780,                                         &
     &   0.966,  0.957,  0.947,  0.936,  0.924,  0.910,  0.896,  0.880, &
     &   0.862,  0.842,  0.822 /
      DATA F1128A/4H4.1.,4H1.2-,4H8A  /
!
      DATA X2125A                                                       &
     & / 0.05,  0.10,  0.15,  0.20,  0.25,  0.30,  0.40,  0.50 /
      DATA X1125A                                                       &
     & / 0.00,  0.02,  0.04,  0.06,  0.08,  0.10,  0.12,  0.15 /
      DATA Y1125A                                                       &
     & / 1.770,  2.500,  3.000,  3.460,  3.820,  4.160,  4.690,  5.140, &
     &   1.770,  2.515,  3.030,  3.500,  3.873,  4.220,  4.780,  5.240, &
     &   1.770,  2.530,  3.060,  3.540,  3.926,  4.290,  4.870,  5.350, &
     &   1.770,  2.545,  3.090,  3.580,  3.979,  4.350,  4.950,  5.460, &
     &   1.770,  2.560,  3.120,  3.620,  4.032,  4.400,  5.040,  5.560, &
     &   1.770,  2.575,  3.150,  3.660,  4.085,  4.480,  5.120,  5.690, &
     &   1.770,  2.590,  3.180,  3.700,  4.138,  4.550,  5.210,  5.790, &
     &   1.770,  2.600,  3.220,  3.740,  4.190,  4.620,  5.330,  5.960/
      DATA F1125A/4H6.1.,4H1.1-,4H39A /
!
!                   FIGURE 6.1.1.1-39B
!
      DATA X2125B                                                       &
     &  / 0.05,  0.10,  0.15,  0.20,  0.25,  0.50 /
      DATA X1125B                                                       &
     &  / 0.70,  0.72,  0.74,  0.76,  0.78,  0.80,  0.82,  0.84,  0.86, &
     &    0.88,  0.90,  0.92,  0.94,  0.96,  0.98,  1.00 /
      DATA Y1125B                                                       &
     & /  .356,    .382,    .409,    .431,    .452,    .548,            &
     &    .399,    .426,    .452,    .477,    .498,    .583,            &
     &    .442,    .471,    .499,    .523,    .543,    .619,            &
     &    .485,    .521,    .548,    .569,    .589,    .659,            &
     &    .530,    .569,    .594,    .613,    .630,    .693,            &
     &    .578,    .614,    .639,    .657,    .671,    .729,            &
     &    .619,    .655,    .678,    .692,    .709,    .761,            &
     &    .659,    .696,    .713,    .733,    .746,    .793,            &
     &    .700,    .734,    .750,    .765,    .778,    .819,            &
     &    .742,    .771,    .789,    .800,    .810,    .850,            &
     &    .784,    .809,    .824,    .838,    .843,    .875,            &
     &    .826,    .843,    .860,    .865,    .873,    .900,            &
     &    .865,    .885,    .895,    .900,    .903,    .921,            &
     &    .910,    .921,    .928,    .931,    .933,    .938,            &
     &    .951,    .962,    .964,    .966,    .967,    .968,            &
     &   1.000,   1.000,   1.000,   1.000,   1.000,   1.000/
      DATA F1125B/4H6.1.,4H1.1-,4H39B /
!
!     ----FIGURE 6.1.3.1-11B
!
      DATA X1317A/0.,.04,.06,.08,.10,.12,.15/,                          &
     & X2317A/0.,.05,.1,.175,.25,.4/,                                   &
     & Y1317A/0.,-.245,-.345,-.465,-.565,-.745,                         &
     &        0.,-.225,-.325,-.445,-.54,-.72,                           &
     &        0.,-.205,-.305,-.425,-.52,-.71,                           &
     &        0.,-.185,-.285,-.405,-.505,-.70,                          &
     &        0.,-.170,-.27,-.385,-.485,-.685,                          &
     &        0.,-.150,-.25,-.363,-.465,-.67,                           &
     &        0.,-.125,-.225,-.336,-.435,-.646/
!
!     ----FIGURE 6.1.3.1-11A
!
      DATA X1317B/.7,.72,.74,.76,.78,.8,.82,.84,.86,.88,.9,.92,.94      &
     &,.96,.98,1.0/,X2317B/.1,.4/,F1317B/4H6.1.,4H3.1-,4H11A  /         &
     &,Y1317B/-.11,.13,-.01,.21,.08,.3,.175,.38,.27,.46,.35,.54,.43,.61,&
     &.51,.66,.58,.71,.65,.76,.71,.8,.77,.84,.82,.89,.88,.93,.94,.96,1.,&
     &1./
!
!     ----FIGURE 6.1.3.1-12A
!     ----A1= SHARP NOSE , A2=ELLIPTIC NOSE , A3=ROUND NOSE
!
      DATA X1318A/0.,.15,.185,.3,.35,.4,.5/,                            &
     &     Y318A1/1.,1.,1.,.81,.7,.57,.26/,                             &
     &     Y318A2/1.,.98,.90,.63,.51,.40,.16/,                          &
     &     Y318A3/1.,.93,.84,.54,.42,.28,.03/,                          &
     & F318A1/4H6.1.,4H3.1-,4H12A1 /,F318A2/4H6.1.,4H3.1-,4H12A2 /,     &
     & F318A3/4H6.1.,4H3.1-,4H12A3 /
!
!     ----FIGURE 6.1.3.2-12A
!
      DATA X2327B/.1,.2,.25,.3,.35,.4/,X1327B/.6,.65,.7,.75,.8,.85,.9,  &
     &.95,1.0/,F1327B/4H6.1.,4H3.2-,4H12A  /,                           &
     & Y1327B/.646,.595,.56,.52,.47,.419 , .705,.670,.650,.620,.585,.545&
     & , .755,.735,.72,.704,.685,.660 , .8,.788,.779,.767,.755,.739 ,   &
     &   .845,.836,.830,.821,.814,.80 , .884,.876,.870,.868,.864,.856 , &
     & .925,.919,.915,.913,.91,.909 , .964,.961,.960,.959,.958,.955 ,   &
     & 6*1.0/
!
!     ----FIGURE 6.1.3.2-12B
!
      DATA X1327A/0.,.04,.06,.08,.10,.12,.15/,X2327A/.1,.15,.2,.25,.4/, &
     & F1327A/4H6.1.,4H3.2-,4H12B   /,                                  &
     & Y1327A/-.883,-.901,-.920,-.944,-1.01,-.83,-.855,-.885,-.913,-.995&
     & , -.8,-.83,-.862,-.895,-.984 , -.77,-.805,-.840,-.875,-.972 ,    &
     &   -.735,-.775,-.814,-.85,-.958 , -.696,-.740,-.783,-.824,-.940 , &
     &   -.639,-.683,-.73,-.777,-.920 /
!
!     ----6.1.3.2-13A SHARP NOSE NACA 0009
!
      DATA X1328A/0.,.185,.5/,Y1328A/1.,1.,.5/,F1328A/4H6.1.,4H3.2-,4H13&
     &A /
!
!     ----6.1.3.2-13B ELLIPTIC NOSE NACA 0009 AND NACA 0015
!
      DATA X1328B/.09,.15/,X2328B/0.,.185,.3,.4,.5/,                    &
     &Y1328B/1.,.86,.66,.44,.20,                                        &
     &        1.,.87,.70,.54,.36/,                                      &
     &F1328B/4H6.1.,4H3.2-,4H13B  /
!
!     ----6.1.3.2-13C ROUND NOSE NACA 0009 AND NACA 0015
!
      DATA X1328C/.09,.15/,X2328C/0.,.175,.3,.4,.46/,                   &
     &Y1328C/1.,.74,.31,-.1,-.3,                                        &
     &        1.,.78,.47,.17,0./,                                       &
     &F1328C/4H6.1.,4H3.2-,4H13C  /
!
!     ----FIGURE 6.1.6.1-19 A
!
      DATA X6115A/2.,3.,4.,5.,6.,7.,8.,9.,10./,F6115A/4H6.1.,4H6.1-,4H19&
     &A /,Y6115A/.0182,.014,.0108,.0085,.0068,.0055,.0046,.0039,.0035/
!
!     ----FIGURE 6.1.6.1-19C
!
      DATA X16116/0.,.2,.3,.4,.5,.6/,                                   &
     &     X26116/0.,.05,.1,.15,.2,.25,.3,.35,.4,                       &
     &.45,.5,.55,.6/,F16116/4H6.1.,4H6.1-,4H19C  /,                     &
     &Y16116/0.,.49,.65,.80,.92,1.02,1.09,1.16,1.22,1.28,1.33,1.38,1.42,&
     &       0.,.44,.60,.73,.85,.93,1.01,1.08,1.14,1.19,1.25,1.29,1.34, &
     &       0.,.39,.54,.65,.75,.84,.92,.99,1.05,1.10,1.16,1.21,1.25,   &
     &       0.,.32,.45,.55,.63,.71,.77,.85,.92,.98,1.04,1.09,1.15,     &
     &       0.,.22,.31,.39,.47,.54,.60,.66,.72,.79,.86,.93,1.01,       &
     &       0.,.09,.16,.21,.27,.33,.40,.45,.52,.59,.67,.78,.91/
!
!     ----FIGURE 6.1.6.1-19B
!
      DATA X6115B/0.,.1,.2,.3,.4,.5,.6,.7,.74,0.80,0.90,1.00            &
     & /,F6115B/4H6.1.,4H6.1-,4H19B                                     &
     & /,Y6115B/1.,1.12,1.25,1.43,1.65,1.92,2.22,2.62,2.80,3.06,3.63,   &
     & 4.26/
!
!     ----FIGURE 6.1.6.2-15B
!
      DATA X1629B/0.,.1,.2,.3,.4,.5,.6,.7,.744,.80,.90,1.00             &
     & /,F1629B/4H6.1.,4H6.2-,                                          &
     & 4H15B  /,Y1629B/1.,1.08,1.2,1.34,1.52,1.75,2.05,2.40,2.60,       &
     & 2.91,3.56,4.34/
!
!     ----FIGURE 6.1.6.2-15A
!
      DATA X2629A/2.,2.5,3.,3.5,4.,5.,6.,7.,8.,10./,X1629A/.2,.4,.6/,   &
     & F1629A/4H6.1.,4H6.2-,4H15A  /,                                   &
     & Y1629A/.039,.030,.025,.0214,.0183,.0142,.0113,.009,.0072,.0050 , &
     & .035,.028,.023,.0195,.0168,.0130,.0100,.0082,.0065,.0046 ,       &
     & .0305,.0246,.0205,.0175,.0151,.0118,.0094,.0075,.0061,.0043/
!
      IF(WGPL.AND.HTPL)GO TO 1000
!
!    -----HERE FOR DEVICE ON WING
!
      TOVC=WINGIN(16)
      TOVCO=WINGIN(65)
      BO2=WINGIN(4)
      BSTRO2=WINGIN(3)
      SSPNOP=WINGIN(2)
      SINC4=A(66)
      AW=A(120)
      COSC4=A(67)
      TANTE=A(80)
      TANTEO=A(104)
      SWEPC4=A(64)
      SWEPLE=A(58)
      COSLE=A(61)
      CBAREX=A(16)
      CLASEC=WINGIN(M+20)
      GO TO 1010
!
!    -----HERE FOR DEVICE ON HORZ. TAIL
!
 1000 TOVC=HTIN(16)
      TOVCO=HTIN(65)
      BO2=HTIN(4)
      BSTRO2=HTIN(3)
      SSPNOP=HTIN(2)
      SINC4=AHT(66)
      AW=AHT(120)
      COSC4=AHT(67)
      CLASEC=HTIN(M+20)
      TANTE=AHT(80)
      TANTEO=AHT(104)
      SWEPC4=AHT(64)
      SWEPLE=AHT(58)
      COSLE=AHT(61)
      CBAREX=AHT(16)
 1010 ARG8=BOF-BIF
      ARG9=CFI-CFO
      SWEPHL=ATAN((ARG8*TANTE+ARG9)/ARG8)
      COSHL=COS(SWEPHL)
!
!*******CALCULATE CHORDS NORMAL TO THE WING QUARTER-CHORD LINE
!
      ARG1=SWEPC4/RAD-SWEPHL
      ARG2=(SWEPC4-SWEPLE)/RAD
      ARG3=COSHL/COS(ARG1)
      ARG4=COS(ARG2)/COSLE
      CFOCAP=ARG3*ARG4*CFOCA
      CBOCF=CB*2./(CFI+CFO)
      TANBL=(ARG9*(1.+CBOCF)+ARG8*TANTE)/ARG8
      ARG1=COSC4+TANBL*SINC4
      ARG2=COSC4+TANTE*SINC4
      CBOCF=CBOCF*ARG2/ARG1
      RF=FLC(M+42)
!
!*****COMPUTE SECTION HINGE MOMENT DERIVATIVE DUE TO ANGLE OF ATTACK
!
      NDELTA=RDELTA+0.5
      NTYPE=RTYPE+0.5
      MACH=FLC(M+2)
      BETA=SQRT(1.-MACH**2)
      IF(SDCL(1).EQ.UNUSED)GO TO 1030
      DO 1020 I=1,NDELTA
         DSECCL(I)=SDCL(I)
 1020 ALPDEL(I)=-SDCL(I)/(DELTA(I)*CLASEC)
      GO TO 1060
 1030 NN=0
      DO 1050 I=1,NDELTA
         SUM2=0.0
         SUM=0.0
         DO 1040 K=1,4
            NN=NN+1
            SUM2=SUM2+DCL(NN)
 1040    SUM=SUM+ALDAG(NN)
         ALPDEL(I)=SUM/4.
 1050 DSECCL(I)=SUM2/4.
 1060 CONTINUE
      TC=TOVC
      IF(BIF.GE.(BO2-SSPNOP)) TC=TOVCO
!
!     FOR PLAIN AND SPLIT TE FLAPS
!
      CLATHY=5.0*TC+6.28
!
!              FIGURE 6.1.3.1-11A (CH)ALPHAT
!
      CALL TLINEX(X1317A,X2317A,Y1317A,7,6,TC,CFOCA,CHATHY,             &
     &            0,0,1,1,F1317A,3,ROUTID)
!
!              FIGURE 6.1.3.1-11B CHA/CHAT
!
      CALL TLINEX(X1317B,X2317B,Y1317B,16,2,CLACLT,CFOCA,CHACHT,        &
     &            1,1,0,1,F1317B,3,ROUTID)
      CHAP=CHACHT*CHATHY/RAD
      ARG1=1.-CLACLT
      ARG2=TANPHE-TC
      CHAPP=CHAP+2.*CLATHY*ARG1*ARG2/RAD
      CHAMAC=CHAPP/BETA
!
!*****HERE FOR FLAPS WITH NOSE BALANCE
!
      IF(CB.EQ.UNUSED.OR.CB.EQ.0.0)GO TO 1110
      CFAVG=(CFI+CFO)/2.
      ARG1=(CB/CFAVG)**2
      ARG2=(TCHL/(2.*CFAVG))**2
      ARG3=ARG1-ARG2
      IF(ARG3.LT.0.0)GO TO 1110
      BRATIO=SQRT(ARG3)
      VAR(1)=BRATIO
      LGH(1)=7
      GO TO (1090,1080,1070),NTYPE
 1070 CONTINUE
!
!              FIGURE 6.1.3.1-12A1 (SHARP NOSE)
!
      CALL INTERX(1,X1318A,VAR,LGH,Y318A1,CHBCHA,7,7,                   &
     &            0,0,0,0,1,0,0,0,F318A1,3,ROUTID)
      GO TO 1100
 1080 CONTINUE
!
!              FIGURE 6.1.3.1-12A2 (ELLIPTIC NOSE)
!
      CALL INTERX(1,X1318A,VAR,LGH,Y318A2,CHBCHA,7,7,                   &
     &            0,0,0,0,1,0,0,0,F318A2,3,ROUTID)
      GO TO 1100
 1090 CONTINUE
!
!              FIGURE 6.1.3.1-12A3 (ROUND NOSE)
!
      CALL INTERX(1,X1318A,VAR,LGH,Y318A3,CHBCHA,7,7,                   &
     &            0,0,0,0,1,0,0,0,F318A3,3,ROUTID)
 1100 CONTINUE
      CHAPPB=CHAPP*CHBCHA
      CHAMAC=CHAPPB/BETA
 1110 CONTINUE
!
!*****COMPUTE SECTION HINGE MOMENT DERIVATIVE DUE TO FLAP DEFLECTION
!              FIGURE 6.1.3.2-12B
!
      CALL TLINEX(X1327B,X2327B,Y1327B,9,6,CLACLT,CFOCA,CHDCHT,         &
     &            1,1,0,1,F1327B,3,ROUTID)
!
!              FIGURE 6.1.3.2-12A
!
      CALL TLINEX(X1327A,X2327A,Y1327A,7,5,TC,CFOCA,CHDTHY,             &
     &            0,1,1,1,F1327A,3,ROUTID)
      CHDP=CHDCHT*CHDTHY/RAD
      ARG1=ALOG10(RF*CBAREX)
      CALL TLINEX(X1128A,X2128A,Y1128A,3,11,ARG1,TANPHP,CLOCLT,         &
     &            1,0,0,1,F1128A,3,ROUTID)
!
!              FIGURE 6.1.1.1-39B
!
      CALL TLINEX(X1125B,X2125B,Y1125B,16,6,CLOCLT,CFOCA,CLDCTY,        &
     &            0,0,0,0,F1125B,3,ROUTID)
!
!              FIGURE 6.1.1.1-39A
!
      CALL TLINEX(X1125A,X2125A,Y1125A,8,8,TC,CFOCA,CLDTHY,             &
     &            0,2,1,2,F1125A,3,ROUTID)
      ARG1=2.0*CLDTHY*(1.-CLDCTY)
      ARG2=TANPHE-TC
      CHDPP=CHDP+ARG1*ARG2/RAD
      CHDMAC=CHDPP/BETA
!
!*****HERE FOR NOSE BALANCE
!
      IF(BRATIO.EQ.UNUSED)GO TO 1160
      VAR(1)=BRATIO
      LGH(1)=3
      GO TO (1140,1130,1120),NTYPE
 1120 CONTINUE
!
!              FIGURE 6.1.3.2-13A  (SHARP NOSE)
!
      CALL INTERX(1,X1328A,VAR,LGH,Y1328A,CHBCHD,3,3,                   &
     &            0,0,0,0,1,0,0,0,F1328A,3,ROUTID)
      GO TO 1150
 1130 CONTINUE
!
!              FIGURE 6.1.3.2-13B (ELLIPTIC NOSE)
!
      CALL TLINEX(X1328B,X2328B,Y1328B,2,5,TC,VAR(1),CHBCHD,            &
     &            1,0,1,1,F1328B,3,ROUTID)
      GO TO 1150
 1140 CONTINUE
!
!              FIGURE 6.1.3.2-13C (ROUND NOSE)
!
      CALL TLINEX(X1328C,X2328C,Y1328C,2,5,TC,VAR(1),CHBCHD,            &
     &            1,0,1,1,F1328C,3,ROUTID)
 1150 CONTINUE
      CHDPPB=CHBCHD*CHDPP
      CHDMAC=CHDPPB/BETA
 1160 CONTINUE
!
!*****HINGE-MOMENT DERIVATIVE DUE TO ANGLE OF ATTACH
!              FIGURE 6.1.6.1-19A (DCHA/CONST)
      VAR(1)=AW
      LGH(1)=9
      CALL INTERX(1,X6115A,VAR,LGH,Y6115A,DCHAOK,9,9,                   &
     &            2,0,0,0,0,0,0,0,F6115A,3,ROUTID)
!
!              FIGURE 6.1.6.1-19C
!
      CALL TLINEX(X16116,X26116,Y16116,6,13,CBOCF,CFOCAP,B2,            &
     &            0,0,1,1,F16116,3,ROUTID)
!
!              FIGURE 6.1.6.1-19B (K)ALPHA
!
      ETAI=BIF/BO2
      ETAO=BOF/BO2
      VAR(1)=ETAI
      LGH(1)=12
      CALL INTERX(1,X6115B,VAR,LGH,Y6115B,KALPHI,12,12,                 &
     &            0,0,0,0,2,0,0,0,F6115B,3,ROUTID)
      VAR(1)=ETAO
      CALL INTERX(1,X6115B,VAR,LGH,Y6115B,KALPHO,12,12,                 &
     &            0,0,0,0,2,0,0,0,F6115B,3,ROUTID)
      KALPHA=(KALPHI*(1.-ETAI)-KALPHO*(1.-ETAO))/(ETAO-ETAI)
 1170 ARG1=CLASEC*B2*KALPHA*COSC4
      DELCHA=DCHAOK*ARG1
      ARG1=AW+2.0*COSC4
      CHA=AW*COSC4*CHAMAC/ARG1+DELCHA
!
!*****HINGE-MOMENT DERIVATIVE DUE TO FLAP DEFLECTION
!              FIGURE 6.1.6.2-15B (K)DELTA
      VAR(1)=ETAI
      CALL INTERX(1,X1629B,VAR,LGH,Y1629B,KDELTI,12,12,                 &
     &            0,0,0,0,2,0,0,0,F1629B,3,ROUTID)
      VAR(1)=ETAO
      CALL INTERX(1,X1629B,VAR,LGH,Y1629B,KDELTO,12,12,                 &
     &            0,0,0,0,2,0,0,0,F1629B,3,ROUTID)
      KDELTA=(KDELTI*(1.-ETAI)-KDELTO*(1.-ETAO))/(ETAO-ETAI)
!
!              FIGURE 6.1.6.2-15A (DCHD/CONST)
!
 1180 CALL TLINEX(X1629A,X2629A,Y1629A,3,10,CFOCAP,AW,DCHDOK,           &
     &            1,1,1,0,F1629A,3,ROUTID)
      ARG1=B2*KDELTA*COSC4*COSHL
      ARG2=COSC4*COSHL
      ARG3=2.*COSC4/(AW+2.*COSC4)
      DO 1190 I=1,NDELTA
         DCHD(I)=DCHDOK*DSECCL(I)*ARG1/DELTA(I)
         CHD(I)=ARG2*(CHDMAC+ALPDEL(I)*CHAMAC *ARG3)+DCHD(I)
 1190 END DO
      RETURN
      END
      SUBROUTINE HORTYW
!
!***  EXECUTIVE FOR HORIZONTAL TAIL AND HORIZONTAL TAIL-BODY YAW
!     DERIVATIVES
!
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /IHT/    PHT,HT(380)
      COMMON /IBH/    PBH,BH(380)
      COMMON /IBW/    PBW,BW(380)
      COMMON /IBWH/   PBWH,BWH(380)
      COMMON /IBWV/   PBWV,BWV(380)
      COMMON /IBWHV/  PBWHV,BWHV(380)
      COMMON /IVT/    PVT,VT(380)
      COMMON /WINGI/  WGIN(4)
      COMMON /HTI  /  HTIN(4)
!
      IF(.NOT. (SUBSON .OR. SUPERS)) GO TO 1030
      IF(SUBSON) CALL SUBHYW
      IF(SUPERS) CALL SUPHYW
!
!     METHODS SAME FOR H.T. OR H.T.-BODY
!
      DO 1020 J=1,NALPHA
         BH(J+300)=HT(J+300)
         BH(J+320)=HT(J+320)
         IF(J .GT. 1 .AND. SUPERS) GO TO 1000
         IF((WGIN(4)/HTIN(4)) .GE. 1.5) HT(J+280)=.5*HT(J+280)
         BH(J+280)=HT(J+280)
         BWH(J+280)=BW(J+280)+HT(J+280)
         IF(SUBSON) GO TO 1020
         GO TO 1010
 1000    BH(J+280)= -UNUSED
         HT(J+280)= -UNUSED
         BWH(J+280)= -UNUSED
 1010    BH(J+340)= UNUSED
         HT(J+340)= UNUSED
 1020 END DO
 1030 CONTINUE
      RETURN
      END
      SUBROUTINE HYPBOD(NMN)
!
!*** COMPUTES HYPERSONIC BODY AERO
!
      REAL MACH,K,LX(20),KTHETA(20)
      REAL INTGCN(20),INTGCM(20),INDEP(20),NXX
      REAL INTGCA(20),KAF(20)
      DIMENSION CAF(20)
      DIMENSION CD(20),CL(20),CDALP(20),ALPHA(20)
      DIMENSION VAR(4),LGH(4)
      DIMENSION FIG3(4)
      DIMENSION THETA(20),DEP(20),DEP1(20),CN(20),CM(20)
      DIMENSION DEP2(20)
      DIMENSION T422(18),D422(81)
      DIMENSION T425(18),D425(72)
      DIMENSION T468(8),D468(8)
      DIMENSION X27M(4),X27I(4),C27(6)
      DIMENSION FIG(4),ROUT(2),FIG1(4),FIG2(4)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(73), dumflgtcd(87)
      COMMON /OPTION/ SR,CBAR,ROUGHC,BLREF
      COMMON /BODYI/  NXX,X(20),S(20),P(20),R(20),ZU(20),ZL(20),BNOSE,  &
     &                BTAIL,RLN,RLA,DS, dum2(3)
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /WINGI/  WINGIN(100)
      COMMON /HTI/    HTIN(154)
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ AHT(195)
      COMMON /SUPBOD/ SBD(229)
      COMMON /IBODY/  PB, BODY(400)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JEQPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JEQPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS
      EQUIVALENCE (ALPHA(1),FLC(23))
      EQUIVALENCE (CDP,SBD(227)),(RLBP,SBD(1))
      EQUIVALENCE (CNANF,SBD(125)),(XCPLN,SBD(126)),(THETAN,SBD(127)),  &
     &(CNAN,SBD(128)),(CMAN,SBD(129)),(THETAA,SBD(130)),(CNAAF,SBD(131))&
     &,(CMAAF,SBD(132)),(CMAA,SBD(134)),(CNAA,SBD(133)),(THETAT,SBD(135)&
     &),(CNATF,SBD(136)),(CMATF,SBD(137)),(CNAT,SBD(138)),(CMAT,SBD(139)&
     &)
      EQUIVALENCE (K,SBD(140)),(THETA(1),SBD(141)),(LX(1),SBD(161)),    &
     &            (INTGCN(1),SBD(181)),(INTGCM(1),SBD(201))
      EQUIVALENCE (RLB,SBD(2)),(RLBT,SBD(3)),(DN,SBD(4)),(D1,SBD(5)),   &
     &       (D2,SBD(6)),(FN,SBD(10)),(CNA,SBD(18)),(CL(1),BODY(21)),   &
     &    (CMA,SBD(110)),(SS,SBD(111)),(RLCOFF,SBD(113)),(CDF,SBD(115)),&
     &  (CD0,SBD(124)),(CD(1),BODY(1)),(CN(1),BODY(61)),(CM(1),BODY(41))
      EQUIVALENCE (RNN,SBD(221)),(CFINC,SBD(222)),(CFCOCF,SBD(223)),    &
     &            (CDPN,SBD(224)),(CDPA,SBD(225)),(CDPT,SBD(226)),      &
     &            (CAF(1),BODY(81))
      LOGICAL TAIL,NOSTAL,NOSCYL,NOSCT
      DATA FIG  /4HRADI,4HUS V,4HS X-,4HCOOR/,ROUT/4HHYPB,4HOD  /
      DATA FIG1 /4H4.2.,4H1.1-,4H24  ,4HCNA /
      DATA FIG2 /4H4.2.,4H2.1-,4H27  ,4HXCP /
      DATA FIG3 /4H4.2.,4H3.1-,4H68 (,4HCFC)/
      DATA X27M /0.0,1.0,2.0,3.0/
!
!              FIGURE 4.2.1.1-24
!
      DATA T425/                                                        &
     &1.,1.5,2.,3.,4.,5.,6.,7.,0.0,                                     &
     &0.,.1,.2,.3,.4,.5,.6,.7,.8/
      DATA D425/                                                        &
     &1.6,1.766,1.850,1.930,1.960,1.976,1.987,1.990,                    &
     &1.6,1.764,1.850,1.921,1.950,1.968,1.975,1.979,                    &
     &1.592,1.758,1.840,1.904,1.930,1.942,1.950,1.950,                  &
     &1.581,1.740,1.810,1.864,1.889,1.900,1.901,1.900,                  &
     &1.560,1.704,1.761,1.809,1.822,1.830,1.835,1.838,                  &
     &1.530,1.650,1.693,1.729,1.739,1.743,1.750,1.750,                  &
     &1.488,1.565,1.604,1.629,1.634,1.640,1.640,1.642,                  &
     &1.419,1.463,1.489,1.506,1.510,1.513,1.516,1.515,                  &
     &1.320,1.332,1.342,1.354,1.360,1.365,1.369,1.370/
!
!              FIGURE 4.2.2.1-27
!
      DATA T422/                                                        &
     &1.,2.,3.,4.,5.,6.,7.,8.,9.,                                       &
     &0.0,.1,.2,.3,.4,.5,.6,.7,.8/
      DATA D422/                                                        &
     &.496,.470,.468,.468,.467,.467,.467,.467,.467,                     &
     &.486,.457,.453,.451,.450,.448,.447,.446,.445,                     &
     &.475,.441,.436,.433,.430,.428,.426,.425,.424,                     &
     &.462,.426,.419,.414,.410,.407,.405,.403,.401,                     &
     &.450,.408,.400,.394,.389,.385,.382,.380,.377,                     &
     &.438,.390,.379,.371,.365,.360,.356,.353,.349,                     &
     &.423,.367,.353,.344,.336,.329,.324,.320,.317,                     &
     &.405,.337,.317,.306,.297,.291,.286,.282,.278,                     &
     &.381,.296,.274,.260,.249,.242,.236,.231,.227/
!
!              FIGURE 4.2.3.1-68
!
      DATA T468                                                         &
     &/0.,.5,1.,2.,3.,4.,5.,7./
      DATA D468                                                         &
     &/1.,.975,.927,.775,.616,.500,.409,.275/
!
      NX=NXX+.5
      MACH=FLC(NMN+2)
      RLBP=RLN+RLA
      RLB=X(NX)
      RLBT=RLB-RLBP
      RATIO=ABS(RLBT/RLB)
      IF(RATIO.LT.0.01)GO TO 1000
      TAIL=.TRUE.
      GO TO 1010
 1000 TAIL=.FALSE.
      RLBT=0.0
 1010 VAR(1)=RLN
      LGH(1)=NX
      CALL INTERX(1,X,VAR,LGH,R,DIA,NX,NX,0,0,0,0,0,0,0,0,FIG,4,ROUT)
      DN=2.*DIA
      IF(RLA.EQ.0.0) GO TO 1020
      VAR(1)=RLBP
      CALL INTERX(1,X,VAR,LGH,R,DIA,NX,NX,0,0,0,0,0,0,0,0,FIG,4,ROUT)
      D1=2.*DIA
      GO TO 1030
 1020 D1=DN
 1030 CONTINUE
      IF(.NOT.TAIL) GO TO 1040
      VAR(1)=RLB
      CALL INTERX(1,X,VAR,LGH,R,DIA,NX,NX,0,0,0,0,0,0,0,0,FIG,4,ROUT)
      D2=2.*DIA
      GO TO 1050
 1040 D2=D1
 1050 CONTINUE
 1110 CONTINUE
!
!  ***HYPERSONIC BODY LIFT AND PITCHING MOMENT SLOPES***
!
      FN=RLN/DN
      ARG=.5*(DN-DS)/(DN*FN-.5*DS)
      THETAN=ATAN(ARG)
      BLN=RLN
      BLA=RLA
      BDN=DN
      BD1=D1
      BD2=D2
!
!  ----HERE FOR OGIVE NOSE----
!
      IF(BNOSE.EQ.1.)GO TO 1120
!
!              FIGURE 4.2.1.1-24 (CNA)
!
      VAR(1)=BLN/BDN
      VAR(2)=DS/BDN
      LGH(1)= 8
      LGH(2)= 9
      CALL INTERX(2,T425,VAR,LGH,D425,CNANF,9,72,0,0,0,0,0,0,0,0,FIG1,  &
     &            4,ROUT)
!
!              FIGURE 4.2.2.1-27
!
      LGH(1)= 9
      LGH(2)= 9
      CALL INTERX(2,T422,VAR,LGH,D422,XCPLN,9,81,0,0,0,0,0,0,0,0,FIG2,  &
     &            4,ROUT)
      GO TO 1130
 1120 CONTINUE
!
!  ----HERE FOR CONE NOSE----
!              FIGURE 4.2.1.1-24(CNA)N  EQUATION FOR CNANF
!
      ARG1=2.*COS(THETAN)**2
      ARG2=1.-.5*(DS/BDN)**2*COS(THETAN)**2
      CNANF=ARG1*ARG2
!
!              FIGURE 4.2.2.1-26(XCP/LN) EQUATION FOR XCPLN
!
      ARG1=2./(3.*COS(THETAN)**2)
      ARG=DS*COS(THETAN)/BDN
      SINT=SIN(THETAN)
      ARG2=1.-1.5*(1.-SINT)*ARG
      ARG3=.25*(2.-3.*SINT)*ARG**3
      ARG4=1.-.5*ARG**2
      ARG5=1.-ARG/(1.+SINT)
      XCPLN=ARG1*((ARG2+ARG3)/(ARG4*ARG5))
 1130 ANN=PI*BDN**2/4.
      CNAN=CNANF*ANN/(RAD*SR)
      CMAN=CNAN*(XCG/BLN-XCPLN)*BLN/CBAR
      AAA=PI*BD1**2/4.
      IF(BLA.EQ.0.0)GO TO 1140
!
!  ----HERE FOR CENTER SECTION----
!
      RATIOA=DN/BD1
      THETAA=ATAN(.5*(D1-DN)/RLA)
      IF(RATIOA.GE.1.0)GO TO 1140
!
!              FIGURE 4.2.1.1-26(CNA)A EQUATION FOR CNAAF
!
      CNAAF=2.*COS(THETAA)**2*(1.-RATIOA**2)
!
!              FIGURE 4.2.2.1-25A(CMA)A EQUATION FOR CMAAF
!
      ARG1=3.*TAN(THETAA)
      ARG2=2.*(1.-RATIOA**3)
      ARG3=3.*RATIOA*COS(THETAA)**2*(1.-RATIOA**2)
      CMAAF=-(ARG2-ARG3)/ARG1
      GO TO 1150
 1140 CNAAF=0.0
      CMAAF=0.0
 1150 CNAA=CNAAF*AAA/(RAD*SR)
      ARG1=CNAA*(XCG-BLN)/CBAR
      CMAA=CMAAF*AAA*D1/(CBAR*SR) + ARG1
      ATT=PI*BD1**2/4.
      IF(.NOT.TAIL)GO TO 1160
!
!  ----HERE FOR TAIL SECTION----
!
      RATIOT=BD2/BD1
      THETAT=ATAN(.5*(D2-D1)/RLBT)
!
!***  SKIP THIS CALCUALTION IF BOATTAIL
!
      IF(RATIOT.LE.1.0)GO TO 1160
      SBD(16)=THETAT
      SBD(102)=THETAT
!
!              FIGURE 4.2.1.1-26(CNA)T EQUATION FOR CNATF
!
      CNATF=2.*COS(THETAT)**2*(1.-RATIOT**2)
!
!              FIGURE 4.2.2.1-25A(CMA)T EQUATION FOR CMATF
!
      ARG1=3.*TAN(THETAT)
      ARG2=2.*(1.-RATIOT**3)
      ARG3=3.*RATIOT*COS(THETAT)**2*(1.-RATIOT**2)
      CMATF=-(ARG2-ARG3)/ARG1
      GO TO 1170
 1160 CNATF=0.0
      CMATF=0.0
      SBD(14)=THETAT
 1170 CNAT=CNATF*ATT/(RAD*SR)
      ARG1=CNAT*(XCG-BLN-BLA)/CBAR
      CMAT=CMATF*ATT*BD2/(CBAR*RAD*SR)+ARG1
      CMA=CMAN+CMAA+CMAT
      CNA=CNAN+CNAA+CNAT
!
!  ***HYPERSONIC BODY NORMAL FORCE AND PITCHING MOMENT AT ANG OF ATTACK*
!
      NN=NX-1
      DO 1180 N=1,NN
         CALL TBFUNX(X(N),DUM,ARG,NX,X,R,C27,1,1,1,-1,-1,1HX,1,ROUT)
         THETA(N)=RAD*ATAN(ARG)
 1180 LX(N)=XCG-X(N)
      THETA(NX)=THETA(NN)
      LX(NX)=XCG-X(NX)
      K=1.833*(1.-0.4545/MACH**2)
      FACTOR=K*RLB/SR
      DO 1220 J=1,NALPHA
         ARG=ABS(ALPHA(J)/RAD)
         SA=SIN(ARG)
         CA=COS(ARG)
         TA=TAN(ARG)
         DO 1210 N=1,NX
            ARG=THETA(N)/RAD
            TN=TAN(ARG)
            CNN=COS(ARG)
            SN=SIN(ARG)
!
!**   COMPUTE PHI
!
            IF(ABS(ALPHA(J)/RAD) .GT. ABS(ARG)) GO TO 1185
            IF(ARG .GT. 0.0) PHE=0.0
            IF(ARG .LE. 0.0) PHE=PI
            GO TO 1190
 1185       CONTINUE
            PHE=ACOS(TN/TA)
 1190       CONTINUE
!
!***  INTEGRATE ALONG BODY FOR NORMAL AND AXIAL FORCE
!     METHOD FROM NASA TN D-176
!
            SP=SIN(PHE)
            CP=COS(PHE)
            ARG1=(2./3.)*(CNN*SA)**2*SP*(CP**2+2.)
            ARG2=4.*SN*CNN*CA*SA*(PI/2.-.5*SP*CP-PHE/2.)
            ARG3=2.*(SN*CA)**2*SP
            KTHETA(N)=ARG1+ARG2+ARG3
            ARG6=2.*(CA*SN)**2*TN*(PI-PHE)
            ARG7=4.*CA*SA*SP*SN**2
            ARG8=CNN*SN*SA**2*(PI-PHE-SP*CP)
            KAF(N)=ARG6+ARG7+ARG8
 1200       DEP(N)=KTHETA(N)*R(N)
            INDEP(N)=X(N)/RLB
            DEP1(N)=DEP(N)*LX(N)
            DEP2(N)=KAF(N)*R(N)
 1210    CONTINUE
         CALL TRAPZ(DEP,NX,INDEP,INTGCN(J),1)
         CALL TRAPZ(DEP1,NX,INDEP,INTGCM(J),1)
         CALL TRAPZ(DEP2,NX,INDEP,INTGCA(J),1)
         SIGN=1.0
         IF(ALPHA(J).LT.0.0)SIGN=-1.0
         CN(J)=SIGN*FACTOR*INTGCN(J)
         CM(J)=SIGN*FACTOR*INTGCM(J)/CBAR
         CAF(J)=FACTOR*INTGCA(J)
 1220 END DO
!
!***  COMPUTE LIFT AND DRAG FROM CN AND CA
!
      DO 1230 J=1,NALPHA
         ARG=ALPHA(J)/RAD
         CL(J)=CN(J)*COS(ARG)-CAF(J)*SIN(ARG)
         CD(J)=CAF(J)*COS(ARG)+CN(J)*SIN(ARG)
 1230 END DO
      RETURN
      END
      SUBROUTINE HYPFLP
!
!***  COMPUTES HYPERSONIC FLAP CONTROL AERO
!
      REAL LFIOD0,LFI
      REAL MACH,MALP(20),M2
      REAL MADF
      LOGICAL LAMNR
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /OPTION/ SR,CBAR,RUFF,BLREF
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /FLAPIN/ F(16)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /IBODY/  PBODY, BODY(200), dum1(200)
      COMMON /IWING/  PWING, WING(200),dum13(200)
      COMMON /IHT/    PHT, HT(200), dum3(180)
      COMMON /IVT/    PVT, VT(200), dum4(180)
      COMMON /BDATA/  HYP(80)
      DIMENSION DCA(200),DCN(200),DCMCA(200),DCMCN(200)
      DIMENSION ALPHA(20),PAOPI(20),TAOTI(20),RAORI(20),A1(8),A2(8),    &
     &          A3(8)
      EQUIVALENCE (LAMNR,F(15))
      EQUIVALENCE (XHL,F(2)),(TWOTI,F(3))
      EQUIVALENCE (ALPHA(1),FLC(23))
      EQUIVALENCE (DCN(1),BODY(1)),(DCA(1),WING(1)),(DCMCN(1),HT(1))    &
     &,(DCMCA(1),VT(1)),(PAOPI(1),HYP(1)),(TAOTI(1),HYP(21)),           &
     & (MALP(1),HYP(41)),(RAORI(1),HYP(61))
      EQUIVALENCE (ALT,F(1)),(CF,F(4))
!
      CPIP=0.0
      MACH=FLC(I+2)
      RL=FLC(I+42)
      NDELTA=F(16)+.5
      DO 1200 J=1,NALPHA
         IF(ALPHA(J).LT.0.OR.ALPHA(J).GT.20.0)GO TO 1200
         CALL HYPROP(ALT,MACH,ALPHA(J),PAOPI(J),TAOTI(J),MALP(J),       &
     &               RAORI(J))
         CPIA=(PAOPI(J)-1.)/(.7*MACH**2)
         RLHL=XHL*RAORI(J)*RL
         M2=MALP(J)**2
         DO 1190 N=1,NDELTA
            DELTA=F(N+4)
            SINDF=SIN(DELTA/RAD)
            COSDF=COS(DELTA/RAD)
            IF(.NOT.LAMNR)GO TO 1020
!
!    ----HERE FOR LAMINAR BOUNDARY LAYER
!    ----DETERMINE IF FLOW SEPARATION EXIST
!
            CPINC=2.03*(MALP(J)**2-1.)**(-0.306)/RLHL**0.25
!
!              FIGURE 6.3.1-58 SINGLE SHOCK (EQUATION)
!
            CALL FIG68(MALP(J),DELTA,THETA,IER)
            IF(IER .EQ. 2) THETA=90.0
            P2PASS=(7.*M2*SIN(THETA/RAD)**2-1.)/6.
            IF(DELTA.EQ.0.0)P2PASS=1.0
            IF(MALP(J).GT.6.0)GO TO 1000
!
!              FIGURE 6.3.1-58 ISENTROPIC
!
            ARG=0.2*M2*SINDF/SQRT(M2-1.)
            P2PAIS=(1.+ARG)**7
            P2PA=0.5*(P2PASS+P2PAIS)
            GO TO 1010
 1000       P2PA=P2PASS
 1010       CPA2=(P2PA-1.)/(.7*MALP(J)**2)
            IF(CPA2.GE.CPINC)GO TO 1030
            CPAP=CPIA
            LFI=0.0
            D1=0.0
            D2=0.0
            D3=0.0
            GO TO 1100
 1020       CONTINUE
!
!    ----HERE FOR TURBULENT BOUNDARY LAYER
!    ----DETERMINE IF FLOW SEPARATION EXIST
!              FIGURE 6.3.1-57 (EQUATION)
!
            CPINC=2.2/RLHL**0.1
!
!        FIGURE 6.3.1-58 SINGLE SHOCK (EQUATION)
!
            CALL FIG68(MALP(J),DELTA,THETA,IER)
            P2PASS=(7.*M2*SIN(THETA/RAD)**2-1.)/6.
            IF(IER .EQ. 2) THETA=90.0
            IF(DELTA.EQ.0.0)P2PASS=1.0
            P2PA=P2PASS
            CPA2=(P2PA-1.)/(.7*MALP(J)**2)
            IF(CPA2.GE.CPINC)GO TO 1030
            CPAP=CPIA
            LFI=0.0
            D1=0.0
            D2=0.0
            D3=0.0
            GO TO 1100
 1030       CONTINUE
!
!    ----HERE FOR SEPARATED FLOW
!    ----DETERMINE SEPARATION LOCATION X0
!
            X8=XHL/8.0
            X0=XHL/20.
            ARG=RAORI(J)*RL
            DO 1060 K=1,8
               X0=X0+X8
               RLX0=ARG*X0
               TWOTA=TWOTI/TAOTI(J)
               IF(LAMNR)GO TO 1040
!
!    ----HERE FOR TURBULENT FLOW
!              FIGURE 6.3.1-60 (EQUATION)
!
               CPAP=1.91*(MALP(J)**2-1.)**(-0.309)/RLX0**0.1
!
!**       FIGURE 6.3.1-62 (EQUATION)
!
               ARG4=0.7*CPAP*MALP(J)**2+1.
               D1OD0=1.1E6*(MALP(J)**(-1.67)*(ARG4-1.))**8.55
!
!--       FIGURE 6.3.1-64 (EQUATION)
!
               IF(K.EQ.1)RLSTRL= (0.28+0.5*TWOTA+0.22*(1.+0.2*MALP(J)   &
     &                   **2*0.72**0.3333))
               RLSTR=RLSTRL*ARG
!
!              FIGURE 6.3.1-66 (EQUATION)
!
               D0=0.154/RLSTR**0.142857*X0**0.85714
               GO TO 1050
 1040          CONTINUE
!
!    ----HERE FOR LAMINAR FLOW
!           FIGURE 6.3.1-59 (EQUATION)
!
               ARG4=1.56*(MALP(J)**2-1.)**(-0.262)
               CPAP=ARG4/RLX0**0.25
!
!           FIGURE 6.3.1-61 (EQUATION)
!
               ARG4=0.7*CPAP*MALP(J)**2+1.
               D1OD0=5.69E5*MALP(J)**(-4.1)*(ARG4-1.)**3.5
!
!           FIGURE 6.3.1-63 (EQUATION)
!
               IF(K.EQ.1)RLSTRL=(0.28+0.5*TWOTA+0.22*(1.+0.2*MALP(J)    &
     &                         **2*0.72**0.3333))**(-1.67)
               RLSTR=RLSTRL*ARG
!
!           FIGURE 6.3.1-65 (EQUATION)
!
               D0=5.2*SQRT(X0)/SQRT(RLSTR)
 1050          D1=D1OD0*D0
               A1(K)=X0+D1
               A2(K)=XHL
               A3(K)=X0
 1060       CONTINUE
            CALL SIMUL2(A3,A2,A1,8,X0,X0PD1)
            IF(X0.EQ.(-1000.))X0=0.0
            IF(X0.EQ.0.0)GO TO 1110
            D1=X0PD1-X0
!
!    ----CALCULATE PLATEAU-PRESSURE LEVEL AND INTERACTION LENGTHS
!
            RLX0=ARG*X0
            ARG1=(MALP(J)/MACH)**2*PAOPI(J)
            RLSTR=RLSTRL*ARG
            IF(LAMNR)GO TO 1070
!
!    ----HERE FOR TURBULENT
!              FIGURE 6.3.1-66 (EQUATION)
!
            D0=0.154/RLSTR**0.142857*X0**0.85714
!
!              FIGURE 6.3.1-60 (EQUATION)
!
            CPAP=1.91*(MALP(J)**2-1.)**(-0.309)/RLX0**0.1
            CPIP=CPAP*ARG1+CPIA
!
!              FIGURE 6.3.1-68 (EQUATION)
!
            ARG4=0.7*CPAP*MALP(J)**2+1.
            LFIOD0=1.84E4*((ARG4-1.)/MALP(J)**1.325)**8.4
            IF(MALP(J).GE.3.9)LFIOD0=D1/D0
!
!              FIGURE 6.3.1-62 (EQUATION)
!
            D1OD0=1.1E6*(MALP(J)**(-1.67)*(ARG4-1.))**8.55
            GO TO 1080
 1070       CONTINUE
!
!    ----HERE FOR LAMINAR
!              FIGURE 6.3.1-65 (EQUATION)
!
            D0=5.2*SQRT(X0)/SQRT(RLSTR)
!
!              FIGURE 6.3.1-59 (EQUATION)
!
            ARG4=1.56*(M2-1.)**(-0.262)
            CPAP=ARG4/RLX0**0.25
            CPIP=CPAP*ARG1+CPIA
!
!              FIGURE 6.3.1-67 (EQUATION)
!
            PPPA=0.7*CPAP*M2+1.
            LFIOD0=2.47E5*MALP(J)**(-4.2)*(PPPA-1.)**3.45
!
!              FIGURE 6.3.1-61 (EQUATION)
!
            D1OD0=5.69E5*MALP(J)**(-4.1)*(PPPA-1.)**3.5
 1080       CONTINUE
            LFI=LFIOD0*D0
            D1=D1OD0*D0
            IF(LAMNR)GO TO 1090
!
!    ----SET D3=0 FOR TURBULENT B.L.
!
            D3=0.0
            GO TO 1100
 1090       PPPA=0.7*CPAP*MALP(J)**2+1.
            ARG=6.0*PPPA+1.0
            ARG=SQRT(ARG/(7.*MALP(J)**2))
            THETA=ATAN(ARG/SQRT(1.-ARG**2))
            ARG=M2*SIN(2.*THETA)-2./TAN(THETA)
            ARG1=10.+M2*(7.+5.*COS(2.*THETA))
            TANPHE=5.*ARG/ARG1
            PHE=ATAN(TANPHE)*RAD
 1100       CPI2=CPA2*(MALP(J)/MACH)**2*PAOPI(J)+CPIA
 1110       CONTINUE
            D3=0.0
            IF(CPA2.LT.CPINC)GO TO 1180
            CFOD1=CF/D1
            MADF=MALP(J)*DELTA/RAD
            IF(.NOT.LAMNR)GO TO 1130
!
!              FIGURE 6.3.1-69 (EQUATIONS)
!
            IF(MADF.GE.5.)GO TO 1120
            D2=D1*(0.545-0.0403*MADF)*SQRT(CFOD1)
            IF(CFOD1.GE.1.)D2=D1*(0.545-0.04*MADF)
            IF(CFOD1.LE.0.25)D2=D1*(.273-0.02*MADF)
            GO TO 1150
 1120       D2=.344*D1*SQRT(CFOD1)
            IF(CFOD1.GE.1.)D2=D1*0.344
            IF(CFOD1.LE.0.25)D2=D1*0.172
            GO TO 1150
!
!              FIGURE 6.3.1-70 (EQUATIONS)
!
 1130       IF(MADF.GE.2.4)GO TO 1140
            D2=(1.16-0.33*MADF)*SQRT(CFOD1)*D1
            IF(CFOD1.GE.1.)D2=D1*(1.16-0.33*MADF)
            IF(CFOD1.LE.0.25)D2=D1*(0.58-0.165*MADF)
            GO TO 1150
 1140       D2=D1*0.37*SQRT(CFOD1)
            IF(CFOD1 .GE. 1.0)D2=D1*0.37
            IF(CFOD1 .LE. 0.25)D2=D1*0.37*0.5
 1150       IF(X0 .NE. 0.0)GO TO 1160
!
!    ----HERE FOR SEPARATION AT L.E. OF FLAT PLATE
!
            D1=XHL
            LFI=0.0
            PHE=ATAN(D2*SINDF)/(D1+D2*COSDF)*RAD
            CALL FIG68(MALP(J),PHE,THETA,IER)
            IF(IER .EQ. 2) THETA=90.0
            PPPA=(7.*M2*SIN(THETA/RAD)**2-1.)/6.
            IF(PHE.EQ.0.0)PPPA=1.0
            CPAP=(PPPA-1.)/(0.7*M2)
            CPIP=CPAP*(MALP(J)/MACH)**2*PAOPI(J)+CPIA
 1160       IF(LAMNR)GO TO 1170
!
!    ----SET D3=0 FOR TURB. B.L.
!
            D3=0.0
            GO TO 1180
 1170       ARG1=TAN(DELTA/RAD)-TAN(PHE/RAD)
            D3OD1=(TAN(PHE/RAD)/ARG1)/COS(DELTA/RAD)
            D3=D1*D3OD1
 1180       CONTINUE
!
!    ----NORMAL-FORCE INCREMENT
!
            ARG1=(CPIP-CPIA)*(D1-LFI/2.+CF*COSDF)
            ARG2=(CPI2-CPIP)*COSDF*(CF-0.5*(D2+D3))
            K=(J-1)*10+N
            DCN(K)=(ARG1+ARG2)/SR
!
!    ----AXIAL-FORCE INCREMENT
!
            ARG1=SIN(DELTA/RAD)/SR
            ARG2=CF*(CPIP-CPIA)
            ARG3=(CPI2-CPIP)*(CF-0.5*(D2+D3))
            DCA(K)=ARG1*(ARG2+ARG3)
!
!    ----INCREMENT OF PITCHING MOMENT ABOUT H.L. DUE TO NORMAL FORCE
!
            ARG1=(CPIP-CPIA)*(LFI**2/6.+.5*(-LFI*D1+D1**2-              &
     &           (CF*COSDF)**2))
            ARG2=(CPI2-CPIP)*COSDF**2*(CF**2/2.-( D2**2+D2*D3+D3**2)/6.)
            DCMCN(K)=(ARG1-ARG2)/(SR*CBAR)
!
!    ----INCREMENT OF PITCHING MOMENT ABOUT H.L. DUE TO AXIAL FORCE
!
            ARG1=-SIN(DELTA/RAD)**2/(SR*CBAR)
            ARG2=(CPIP-CPIA)*CF**2/2.0
            ARG3=(CPI2-CPIP)*(CF**2/2.0-(D2**2+D2*D3+D3**2)/6.)
            DCMCA(K)=ARG1*(ARG2+ARG3)
 1190    CONTINUE
 1200 END DO
      RETURN
      END
      SUBROUTINE HYPROP(ALT,MACH,ALPH,PA,TA,MA,RA)
!
!    ----CALCULATES EQUILIBRIUM REAL GAS FLOW PROPERTIES----
!    ----TABLE LOOK-UP PER DATCOM FIGURES 6.3.1-31,-37,-43,-49----
!
      REAL M(2),MA,MACH
      DIMENSION P(2),T(2),S(2),ROUTID(2)
      DIMENSION X13131(  2),X23131( 11),Y63131(  22),Q63131(3)
      DIMENSION X1131B(  3),X2131B( 11),Y3131B(  33),Q3131B(3)
      DIMENSION X1131C(  2),X2131C( 11),Y3131C(  22),Q3131C(3)
      DIMENSION X1131D(  3),X2131D( 11),Y3131D(  33),Q3131D(3)
      DIMENSION X1131E(  2),X2131E( 11),Y3131E(  22),Q3131E(3)
      DIMENSION X1131F(  2),X2131F( 11),Y3131F(  22),Q3131F(3)
      DIMENSION X1137A(  2),X2137A( 11),Y3137A(  22),Q3137A(3)
      DIMENSION X1137B(  3),X2137B( 11),Y3137B(  33),Q3137B(3)
      DIMENSION X1137C(  2),X2137C( 11),Y3137C(  22),Q3137C(3)
      DIMENSION X1137D(  3),X2137D( 11),Y3137D(  33),Q3137D(3)
      DIMENSION X1137E(  2),X2137E( 11),Y3137E(  22),Q3137E(3)
      DIMENSION X1137F(  2),X2137F( 11),Y3137F(  22),Q3137F(3)
      DIMENSION X1143A(  2),X2143A(  3),Y3143A(   6),Q3143A(3)
      DIMENSION X1143B(  3),X2143B( 11),Y3143B(  33),Q3143B(3)
      DIMENSION X1143C(  2),X2143C( 11),Y3143C(  22),Q3143C(3)
      DIMENSION X1143D(  3),X2143D( 11),Y3143D(  33),Q3143D(3)
      DIMENSION X1143E(  2),X2143E( 11),Y3143E(  22),Q3143E(3)
      DIMENSION X1143F(  2),X2143F( 11),Y3143F(  22),Q3143F(3)
      DIMENSION X1149A(  2),X2149A( 11),Y3149A(  22),Q3149A(3)
!
!      ----FIGURE 63149B
!
      DIMENSION X1149B(  3),X2149B( 11),Y3149B(  33),Q3149B(3)
      DIMENSION X1149C(  2),X2149C( 11),Y3149C(  22),Q3149C(3)
      DIMENSION X1149D(  3),X2149D( 11),Y3149D(  33),Q3149D(3)
      DIMENSION X1149E(  2),X2149E( 11),Y3149E(  22),Q3149E(3)
      DIMENSION X1149F(  2),X2149F( 11),Y3149F(  22),Q3149F(3)
      DATA ROUTID/4HHYPR,4HOP  /
!
!      ----FIGURE 6.3.1-31
!
      DATA Q63131/4H6.3.,4H1-31,4H    /
      DATA X13131/  .700E+01,  .500E+01/
      DATA X23131/  .239E-01,  .204E+01,  .415E+01,                     &
     &  .608E+01,  .805E+01,  .102E+02,  .121E+02,  .141E+02,  .162E+02,&
     &  .181E+02,  .201E+02/
      DATA Y63131/  .106E+01,  .147E+01,  .203E+01,                     &
     &  .266E+01,  .347E+01,  .449E+01,  .563E+01,  .699E+01,  .847E+01,&
     &  .101E+02,  .118E+02,  .106E+01,  .133E+01,  .169E+01,           &
     &  .214E+01,  .259E+01,  .314E+01,  .375E+01,  .448E+01,  .528E+01,&
     &  .615E+01,  .704E+01/
!
!      ----FIGURE 63131B
!
      DATA Q3131B/4H6313,4H1B  ,4H    /
      DATA X1131B/  .100E+02,  .700E+01,  .500E+01/
      DATA X2131B/  .273E-01,  .200E+01,  .395E+01,  .604E+01,          &
     &  .800E+01,  .992E+01,  .121E+02,  .140E+02,  .161E+02,  .181E+02,&
     &  .201E+02/
      DATA Y3131B/  .116E+01,  .153E+01,  .255E+01,  .358E+01,          &
     &  .525E+01,  .712E+01,  .935E+01,  .119E+02,  .148E+02,  .178E+02,&
     &  .212E+02,  .116E+01,  .138E+01,  .195E+01,  .268E+01,  .346E+01,&
     &  .449E+01,  .567E+01,  .700E+01,  .856E+01,  .101E+02,  .118E+02,&
     &  .116E+01,  .129E+01,  .163E+01,  .199E+01,  .254E+01,  .315E+01,&
     &  .386E+01,  .457E+01,  .535E+01,  .611E+01,  .693E+01/
!
!      ----FIGURE 63131C
!
      DATA Q3131C/4H6313,4H1C  ,4H    /
      DATA X1131C/  .150E+02,  .100E+02/
      DATA X2131C/ -.309E-01,  .202E+01,  .399E+01,  .597E+01,          &
     &  .796E+01,  .996E+01,  .120E+02,  .139E+02,  .160E+02,  .179E+02,&
     &  .199E+02/
      DATA Y3131C/  .140E+01,  .184E+01,  .356E+01,  .575E+01,          &
     &  .898E+01,  .131E+02,  .178E+02,  .230E+02,  .287E+02,  .346E+02,&
     &  .414E+02,  .139E+01,  .160E+01,  .217E+01,  .340E+01,  .514E+01,&
     &  .689E+01,  .905E+01,  .118E+02,  .144E+02,  .174E+02,  .207E+02/
!
!      ----FIGURE 63131D
!
      DATA Q3131D/4H6313,4H1D  ,4H    /
      DATA X1131D/  .300E+02,  .200E+02,  .150E+02/
      DATA X2131D/  .972E-01,  .211E+01,  .408E+01,                     &
     &  .602E+01,  .805E+01,  .101E+02,  .121E+02,  .142E+02,  .161E+02,&
     &  .180E+02,  .200E+02/
      DATA Y3131D/  .864E+00,  .328E+01,  .783E+01,                     &
     &  .167E+02,  .273E+02,  .415E+02,  .559E+02,  .750E+02,  .942E+02,&
     &  .114E+03,  .136E+03,  .561E+00,  .236E+01,  .464E+01,           &
     &  .878E+01,  .138E+02,  .210E+02,  .286E+02,  .379E+02,  .469E+02,&
     &  .573E+02,  .687E+02,  .594E+00,  .144E+01,  .302E+01,           &
     &  .585E+01,  .960E+01,  .136E+02,  .180E+02,  .234E+02,  .285E+02,&
     &  .349E+02,  .409E+02/
!
!      ----FIGURE 63131E
!
      DATA Q3131E/4H6313,4H1E  ,4H    /
      DATA X1131E/  .300E+02,  .200E+02/
      DATA X2131E/  .668E-02,  .202E+01,  .410E+01,  .604E+01,          &
     &  .804E+01,  .100E+02,  .121E+02,  .140E+02,  .160E+02,           &
     &  .181E+02,  .201E+02/
      DATA Y3131E/  .158E+01,  .397E+01,  .937E+01,  .171E+02,          &
     &  .285E+02,  .430E+02,  .607E+02,  .798E+02,  .991E+02,           &
     &  .120E+03,  .138E+03,  .158E+01,  .235E+01,  .499E+01,  .894E+01,&
     &  .135E+02,  .209E+02,  .299E+02,  .392E+02,  .497E+02,           &
     &  .620E+02,  .748E+02/
!
!      ----FIGURE 63131F
!
      DATA Q3131F/4H6313,4H1F  ,4H    /
      DATA X1131F/  .300E+02,  .200E+02/
      DATA X2131F/0.,2.,4.,6.,8.,10.,12.,14.,16.,18.,20./
      DATA Y3131F/                                                      &
     & 1.0,4.0,9.8,18.0,30.0,44.0,61.2,79.00,98.20,118.0,138.0,         &
     & 1.0,2.0,5.0,9.10,15.0,22.3,30.05,40.0,50.20,61.00,73.0/
!
!      ----FIGURE 63137A
!
      DATA Q3137A/4H6313,4H7A  ,4H    /
      DATA X1137A/  .700E+01,  .500E+01/
      DATA X2137A/ -.116E-01,  .200E+01,  .407E+01,  .604E+01,          &
     &  .797E+01,  .100E+02,  .120E+02,  .140E+02,  .160E+02,  .180E+02,&
     &  .200E+02/
      DATA Y3137A/  .101E+01,  .112E+01,  .124E+01,  .136E+01,          &
     &  .152E+01,  .169E+01,  .189E+01,  .211E+01,  .235E+01,  .261E+01,&
     &  .289E+01,  .101E+01,  .108E+01,  .116E+01,  .125E+01,  .134E+01,&
     &  .144E+01,  .156E+01,  .170E+01,  .184E+01,  .198E+01,  .213E+01/
!
!      ----FIGURE 63137B
!
      DATA X1137B/  .100E+02,  .700E+01,  .500E+01/
      DATA Q3137B/4H6313,4H7B  ,4H    /
      DATA X2137B/            -.280E-01,  .203E+01,  .408E+01,          &
     &  .608E+01,  .800E+01,  .100E+02,  .121E+02,  .141E+02,  .161E+02,&
     &  .181E+02,  .200E+02/
      DATA Y3137B/             .998E+00,  .113E+01,  .131E+01,          &
     &  .154E+01,  .183E+01,  .212E+01,  .248E+01,  .288E+01,  .334E+01,&
     &  .383E+01,  .431E+01,             .998E+00,  .109E+01,  .119E+01,&
     &  .132E+01,  .149E+01,  .168E+01,  .188E+01,  .210E+01,  .235E+01,&
     &  .258E+01,  .282E+01,             .996E+00,  .107E+01,  .113E+01,&
     &  .123E+01,  .132E+01,  .144E+01,  .155E+01,  .169E+01,  .180E+01,&
     &  .194E+01,  .210E+01/
!
!      ----FIGURE 63137C
!
      DATA Q3137C/4H6313,4H7C  ,4H    /
      DATA X1137C/  .150E+02,  .100E+02/
      DATA X2137C/ -.997E-02,  .204E+01,  .403E+01,  .603E+01,          &
     &  .807E+01,  .101E+02,  .121E+02,  .141E+02,  .161E+02,  .181E+02,&
     &  .201E+02/
      DATA Y3137C/  .113E+01,  .123E+01,  .158E+01,  .196E+01,          &
     &  .250E+01,  .306E+01,  .375E+01,  .448E+01,  .532E+01,  .632E+01,&
     &  .729E+01,  .111E+01,  .121E+01,  .144E+01,  .162E+01,  .187E+01,&
     &  .215E+01,  .246E+01,  .278E+01,  .323E+01,  .376E+01,  .424E+01/
!
!      ----FIGURE 63137D
!
      DATA Q3137D/4H6313,4H7D  ,4H    /
      DATA X1137D/  .300E+02,  .200E+02,  .150E+02/
      DATA X2137D/  .000E+00,  .209E+01,  .409E+01,  .614E+01,          &
     &  .809E+01,  .100E+02,  .120E+02,  .140E+02,  .161E+02,  .181E+02,&
     &  .200E+02/
      DATA Y3137D/                                                      &
     & 1.0,1.57,2.49,3.80,5.50,7.32,8.95,10.42,11.8,12.98,14.1,         &
     & 1.0,1.30,1.81,2.50,3.34,4.31,5.41,6.67,7.89,9.06,10.16,          &
     & 1.0,1.20,1.52,2.00,2.47,3.10,3.82,4.61,5.50,6.42,7.35/
!
!      ----FIGURE 63137E
!
      DATA Q3137E/4H6313,4H7E  ,4H    /
      DATA X1137E/  .300E+02,  .200E+02/
      DATA X2137E/  .128E+00,  .204E+01,  .413E+01,  .608E+01,          &
     &  .811E+01,  .101E+02,  .121E+02,  .141E+02,  .161E+02,  .181E+02,&
     &  .200E+02/
      DATA Y3137E/  .104E+01,  .163E+01,  .252E+01,  .379E+01,          &
     &  .571E+01,  .791E+01,  .102E+02,  .122E+02,  .138E+02,  .150E+02,&
     &  .158E+02,  .102E+01,  .137E+01,  .184E+01,  .254E+01,  .341E+01,&
     &  .448E+01,  .572E+01,  .709E+01,  .851E+01,  .100E+02,  .116E+02/
!
!      ----FIGURE 63137F
!
      DATA Q3137F/4H6313,4H7F  ,4H    /
      DATA X1137F/  .300E+02,  .200E+02/
      DATA X2137F/  .366E-01,  .199E+01,  .399E+01,  .606E+01,          &
     &  .801E+01,  .101E+02,  .121E+02,  .142E+02,  .162E+02,  .181E+02,&
     &  .202E+02/
      DATA Y3137F/  .105E+01,  .168E+01,  .250E+01,  .388E+01,          &
     &  .568E+01,  .796E+01,  .102E+02,  .117E+02,  .131E+02,  .140E+02,&
     &  .146E+02,  .109E+01,  .136E+01,  .191E+01,  .258E+01,  .346E+01,&
     &  .459E+01,  .578E+01,  .716E+01,  .860E+01,  .993E+01,  .114E+02/
!
!      ----FIGURE 63143A
!
      DATA Q3143A/4H6314,4H3A  ,4H    /
      DATA X1143A/  .700E+01,  .500E+01/
      DATA X2143A/  .463E-01,  .991E+01,  .200E+02/
      DATA Y3143A/  .704E+01,  .529E+01,  .356E+01,  .508E+01,          &
     &  .404E+01,  .298E+01/
!
!      ----FIGURE 63143B
!
      DATA Q3143B/4H6314,4H3B  ,4H    /
      DATA X1143B/  .100E+02,  .700E+01,  .500E+01/
      DATA X2143B/  .570E-06,  .200E+01,  .404E+01,  .604E+01,          &
     &  .803E+01,  .101E+02,  .121E+02,  .140E+02,  .161E+02,  .182E+02,&
     &  .201E+02/
      DATA Y3143B/  .100E+02,  .928E+01,  .858E+01,  .797E+01,          &
     &  .731E+01,  .664E+01,  .598E+01,  .549E+01,  .506E+01,  .457E+01,&
     &  .417E+01,  .702E+01,  .665E+01,  .627E+01,  .590E+01,  .553E+01,&
     &  .519E+01,  .483E+01,  .449E+01,  .421E+01,  .394E+01,  .369E+01,&
     &  .505E+01,  .483E+01,  .461E+01,  .442E+01,  .415E+01,  .396E+01,&
     &  .377E+01,  .362E+01,  .338E+01,  .319E+01,  .295E+01/
!
!      ----FIGURE 63143C
!
      DATA Q3143C/4H6314,4H3C  ,4H    /
      DATA X1143C/  .150E+02,  .100E+02/
      DATA X2143C/  .501E-01,  .203E+01,  .401E+01,  .608E+01,          &
     &  .802E+01,  .101E+02,  .120E+02,  .141E+02,  .160E+02,  .180E+02,&
     &  .200E+02/
      DATA Y3143C/  .150E+02,  .135E+02,  .121E+02,  .107E+02,          &
     &  .952E+01,  .850E+01,  .767E+01,  .693E+01,  .628E+01,  .580E+01,&
     &  .538E+01,  .100E+02,  .934E+01,  .863E+01,  .796E+01,  .738E+01,&
     &  .670E+01,  .623E+01,  .577E+01,  .532E+01,  .493E+01,  .464E+01/
!
!      ----FIGURE 63143D
!
      DATA Q3143D/4H6314,4H3D  ,4H    /
      DATA X1143D/  .300E+02,  .200E+02,  .150E+02/
      DATA X2143D/  .397E-01,  .211E+01,  .400E+01,  .603E+01,          &
     &  .802E+01,  .991E+01,  .120E+02,             .140E+02,  .159E+02,&
     &  .179E+02,  .200E+02/
      DATA Y3143D/  .300E+02,  .237E+02,  .186E+02,  .153E+02,          &
     &  .131E+02,  .115E+02,  .105E+02,             .962E+01,  .896E+01,&
     &  .830E+01,  .796E+01,  .200E+02,  .170E+02,  .147E+02,  .127E+02,&
     &  .110E+02,  .973E+01,  .866E+01,             .767E+01,  .701E+01,&
     &  .640E+01,  .602E+01,  .149E+02,  .134E+02,  .119E+02,  .105E+02,&
     &  .937E+01,  .843E+01,  .754E+01,             .679E+01,  .618E+01,&
     &  .566E+01,  .523E+01/
!
!      ----FIGURE 63143E
!
      DATA Q3143E/4H6314,4H3E  ,4H    /
      DATA X1143E/  .300E+02,  .200E+02/
      DATA X2143E/  .137E-03,  .193E+01,  .395E+01,  .600E+01,          &
     &  .801E+01,  .100E+02,  .120E+02,  .140E+02,  .159E+02,  .180E+02,&
     &  .200E+02/
      DATA Y3143E/  .320E+02,  .240E+02,  .189E+02,  .151E+02,          &
     &  .126E+02,  .108E+02,  .974E+01,  .883E+01,  .837E+01,  .782E+01,&
     &  .760E+01,  .202E+02,  .174E+02,  .149E+02,  .125E+02,  .107E+02,&
     &  .928E+01,  .841E+01,  .745E+01,  .681E+01,  .621E+01,  .576E+01/
!
!      ----FIGURE 63143F
!
      DATA Q3143F/4H6314,4H3F  ,4H    /
      DATA X1143F/  .300E+02,  .200E+02/
      DATA X2143F/ -.155E-01,  .202E+01,  .412E+01,  .599E+01,          &
     &  .796E+01,  .999E+01,  .120E+02,  .139E+02,  .159E+02,  .179E+02,&
     &  .198E+02/
      DATA Y3143F/  .299E+02,  .237E+02,  .187E+02,  .151E+02,          &
     &  .124E+02,  .108E+02,  .971E+01,  .905E+01,  .842E+01,  .808E+01,&
     &  .784E+01,  .199E+02,  .171E+02,  .145E+02,  .124E+02,  .107E+02,&
     &  .924E+01,  .803E+01,  .727E+01,  .656E+01,  .613E+01,  .579E+01/
!
!      ----FIGURE 63149A
!
      DATA Q3149A/4H6314,4H9A  ,4H    /
      DATA X1149A/  .700E+01,  .500E+01/
      DATA X2149A/  .479E-01,  .204E+01,  .413E+01,  .612E+01,          &
     &  .806E+01,  .102E+02,  .121E+02,  .141E+02,  .161E+02,  .181E+02,&
     &  .201E+02/
      DATA Y3149A/  .102E+01,  .121E+01,  .140E+01,  .156E+01,          &
     &  .169E+01,  .180E+01,  .189E+01,  .191E+01,  .192E+01,  .189E+01,&
     &  .183E+01,  .101E+01,  .115E+01,  .129E+01,  .141E+01,  .152E+01,&
     &  .161E+01,  .169E+01,  .174E+01,  .176E+01,  .177E+01,  .175E+01/
      DATA Q3149B/4H6314,4H9B  ,4H    /
      DATA X1149B/  .100E+02,  .700E+01,  .500E+01/
      DATA X2149B/  .221E-01,  .193E+01,  .393E+01,  .606E+01,          &
     &  .800E+01,  .993E+01,  .121E+02,  .140E+02,  .160E+02,  .181E+02,&
     &  .201E+02/
      DATA Y3149B/  .998E+00,  .129E+01,  .154E+01,  .175E+01,          &
     &  .188E+01,  .196E+01,  .197E+01,  .192E+01,  .184E+01,  .177E+01,&
     &  .171E+01,  .998E+00,  .121E+01,  .139E+01,  .156E+01,  .170E+01,&
     &  .178E+01,  .186E+01,  .191E+01,  .193E+01,  .191E+01,  .182E+01,&
     &  .993E+00,  .114E+01,  .127E+01,  .141E+01,  .151E+01,  .160E+01,&
     &  .166E+01,  .172E+01,  .176E+01,  .177E+01,  .176E+01/
!
!      ----FIGURE 63149C
!
      DATA Q3149C/4H6314,4H9C  ,4H    /
      DATA X1149C/  .150E+02,  .100E+02/
      DATA X2149C/  .835E-01,  .207E+01,  .408E+01,  .611E+01,          &
     &  .812E+01,  .101E+02,  .122E+02,  .141E+02,  .161E+02,  .182E+02,&
     &  .201E+02/
      DATA Y3149C/  .102E+01,  .146E+01,  .177E+01,  .197E+01,          &
     &  .203E+01,  .204E+01,  .196E+01,  .183E+01,  .170E+01,  .159E+01,&
     &  .151E+01,  .102E+01,  .130E+01,  .155E+01,  .177E+01,  .192E+01,&
     &  .200E+01,  .202E+01,  .196E+01,  .189E+01,  .182E+01,  .176E+01/
!
!      ----FIGURE 63149D
!
      DATA Q3149D/4H6314,4H9D  ,4H    /
      DATA X1149D/  .300E+02,  .200E+02,  .150E+02/
      DATA X2149D/  .763E-01,  .201E+01,  .401E+01,  .604E+01,          &
     &  .799E+01,  .101E+02,  .121E+02,  .140E+02,  .160E+02,  .181E+02,&
     &  .199E+02/
      DATA Y3149D/  .101E+01,  .180E+01,  .203E+01,  .195E+01,          &
     &  .168E+01,  .158E+01,  .155E+01,  .156E+01,  .157E+01,  .160E+01,&
     &  .164E+01,  .101E+01,  .158E+01,  .191E+01,  .203E+01,  .199E+01,&
     &  .187E+01,  .169E+01,  .156E+01,  .149E+01,  .146E+01,  .146E+01,&
     &  .101E+01,  .144E+01,  .178E+01,  .196E+01,  .200E+01,  .197E+01,&
     &  .191E+01,  .182E+01,  .171E+01,  .160E+01,  .150E+01/
!
!      ----FIGURE 63149E
!
      DATA Q3149E/4H6314,4H9E  ,4H    /
      DATA X1149E/  .200E+02,  .300E+02/
      DATA X2149E/  .232E-01,  .201E+01,  .395E+01,  .600E+01,          &
     &  .805E+01,  .101E+02,  .120E+02,  .141E+02,  .161E+02,  .180E+02,&
     &  .201E+02/
      DATA Y3149E/  .100E+01,  .177E+01,  .200E+01,  .186E+01,          &
     &  .164E+01,  .142E+01,  .127E+01,  .120E+01,  .125E+01,  .137E+01,&
     &  .141E+01,  .100E+01,  .153E+01,  .193E+01,  .200E+01,  .193E+01,&
     &  .178E+01,  .158E+01,  .144E+01,  .133E+01,  .125E+01,  .118E+01/
!
!      ----FIGURE 63149F
!
      DATA Q3149F/4H6314,4H9F  ,4H    /
      DATA X1149F/  .200E+02,  .300E+02/
      DATA X2149F/  .213E-01,  .200E+01,  .405E+01,  .597E+01,          &
     &  .802E+01,  .998E+01,  .120E+02,  .140E+02,  .160E+02,  .180E+02,&
     &  .200E+02/
      DATA Y3149F/  .100E+01,  .176E+01,  .199E+01,  .186E+01,          &
     &  .165E+01,  .144E+01,  .129E+01,  .127E+01,  .138E+01,  .150E+01,&
     &  .156E+01,  .100E+01,  .154E+01,  .192E+01,  .199E+01,  .189E+01,&
     &  .173E+01,  .158E+01,  .143E+01,  .133E+01,  .125E+01,  .123E+01/
!
      Q=MACH
      R=ALPH
      IF(ALT.LE.50000.)IT=1
      IF(ALT.GT.50000.AND.ALT.LE.100000.)IT=2
      IF(ALT.GT.100000.AND.ALT.LE.150000.)IT=3
      IF(ALT.GT.150000.AND.ALT.LE.200000.)IT=4
      IF(ALT.GT.200000.AND.ALT.LE.250000.)IT=5
      IF(ALT.GT.250000.AND.ALT.LE.300000.)IT=6
      IF(ALT.GT.300000.)IT=7
      DO 1060 K=1,2
         GO TO(1000,1010,1020,1030,1040,1050,1050),IT
 1000    CALL TLINEX(X13131,X23131,Y63131,2,11,Q,R,P(K),                &
     &               0,0,0,0,Q63131,3,ROUTID)
         CALL TLINEX(X1137A,X2137A,Y3137A,2,11,Q,R,T(K),                &
     &               0,0,0,0,Q3137A,3,ROUTID)
         CALL TLINEX(X1143A,X2143A,Y3143A,2,11,Q,R,M(K),                &
     &               0,0,0,0,Q3143A,3,ROUTID)
         CALL TLINEX(X1149A,X2149A,Y3149A,2,11,Q,R,S(K),                &
     &               0,0,0,0,Q3149A,3,ROUTID)
         GO TO 1060
!
!    ----HERE FOR ALT=100000
!
 1010    IF(IT.EQ.2.AND.K.EQ.1)GO TO 1000
         CALL TLINEX(X1131B,X2131B,Y3131B,3,11,Q,R,P(K),                &
     &               0,0,0,0,Q3131B,3,ROUTID)
         CALL TLINEX(X1137B,X2137B,Y3137B,2,11,Q,R,T(K),                &
     &               0,0,0,0,Q3137B,3,ROUTID)
         CALL TLINEX(X1143B,X2143B,Y3143B,3,11,Q,R,M(K),                &
     &               0,0,0,0,Q3143B,3,ROUTID)
         CALL TLINEX(X1149B,X2149B,Y3149B,3,11,Q,R,S(K),                &
     &               0,0,0,0,Q3149B,3,ROUTID)
         GO TO 1060
!
!    ----HERE FOR ALT=150000
!
 1020    IF(IT.EQ.3.AND.K.EQ.1)GO TO 1010
         CALL TLINEX(X1131C,X2131C,Y3131C,2,11,Q,R,P(K),                &
     &               0,0,0,0,Q3131C,3,ROUTID)
         CALL TLINEX(X1137C,X2137C,Y3137C,2,11,Q,R,T(K),                &
     &               0,0,0,0,Q3137C,3,ROUTID)
         CALL TLINEX(X1143C,X2143C,Y3143C,2,11,Q,R,M(K),                &
     &               0,0,0,0,Q3143C,3,ROUTID)
         CALL TLINEX(X1149C,X2149C,Y3149C,2,11,Q,R,S(K),                &
     &               0,0,0,0,Q3149C,3,ROUTID)
         GO TO 1060
!
!    ----HERE FOR ALT=200000
!
 1030    IF(IT.EQ.4.AND.K.EQ.1)GO TO 1020
         CALL TLINEX(X1131D,X2131D,Y3131D,3,11,Q,R,P(K),                &
     &               0,0,0,0,Q3131D,3,ROUTID)
         CALL TLINEX(X1137D,X2137D,Y3137D,3,11,Q,R,T(K),                &
     &               0,0,0,0,Q3137D,3,ROUTID)
         CALL TLINEX(X1143D,X2143D,Y3143D,3,11,Q,R,M(K),                &
     &               0,0,0,0,Q3143D,3,ROUTID)
         CALL TLINEX(X1149D,X2149D,Y3149D,3,11,Q,R,S(K),                &
     &               0,0,0,0,Q3149D,3,ROUTID)
         GO TO 1060
!
!    ----HERE FOR ALT=250000
!
 1040    IF(IT.EQ.5.AND.K.EQ.1)GO TO 1030
         CALL TLINEX(X1131E,X2131E,Y3131E,2,11,Q,R,P(K),                &
     &               0,0,0,0,Q3131E,3,ROUTID)
         CALL TLINEX(X1137E,X2137E,Y3137E,2,11,Q,R,T(K),                &
     &               0,0,0,0,Q3137E,3,ROUTID)
         CALL TLINEX(X1143E,X2143E,Y3143E,2,11,Q,R,M(K),                &
     &               0,0,0,0,Q3143E,3,ROUTID)
         CALL TLINEX(X1149E,X2149E,Y3149E,2,11,Q,R,S(K),                &
     &               0,0,0,0,Q3149E,3,ROUTID)
         GO TO 1060
!
!    ----HERE FOR ALT=300000
!
 1050    IF(IT.EQ.6.AND.K.EQ.1)GO TO 1040
         CALL TLINEX(X1131F,X2131F,Y3131F,2,11,Q,R,P(K),                &
     &               0,0,0,0,Q3131F,3,ROUTID)
         CALL TLINEX(X1137F,X2137F,Y3137F,2,11,Q,R,P(K),                &
     &               0,0,0,0,Q3137F,3,ROUTID)
         CALL TLINEX(X1143F,X2143F,Y3143F,2,11,Q,R,M(K),                &
     &               0,0,0,0,Q3143F,3,ROUTID)
         CALL TLINEX(X1149F,X2149F,Y3149F,2,11,Q,R,S(K),                &
     &               0,0,0,0,Q3149F,3,ROUTID)
 1060 END DO
      X1=(IT-1)*5E4
      X2=IT*5E4
      ARG=(X2-X1)/(ALT-X1)
      PA   =P(1)+(P(2)-P(1))/ARG
      TA   =T(1)+(T(2)-T(1))/ARG
      MA   =M(1)+(M(2)-M(1))/ARG
      RA=S(1)+(S(2)-S(1))/ARG
      RETURN
      END
      SUBROUTINE IDEAL
!
!  CALCULATE THE SECTION IDEAL AERODYNAMIC PARAMETERS
!
      COMMON /IBODY/ PB,NACA(80), dum1(320)
      COMMON /IWING/ PW,X0(60),dum13(340)
      COMMON / IBW / PBW,M, dum5(379)
      COMMON / IBH / PBH, THN(60),CAM(60),A0, dum6(259)
      COMMON / IBV / PBV,ZTNU(32),ZCNU(32),ST1NU(32),ST2NU(32),ST3NU(32)&
     &               ,ST4NU(32),ST5NU(32),X(32),THNU(32),THMU(32)
      COMMON /IBWH/  PBWH,AI,ALO,CLI,ALPMAX,CMCO4
      COMMON /IBWHV/ PBWHV, RHO,TMAX
      COMMON /CONSNT/PI,DEG,UNUSED,RAD, kand
      INTEGER A4HS
      DIMENSION C(6)
      DATA A4HS/4HS   /
      XN=32.
      N=XN
      L=N-1
      DO 1000 J=1,L
         XMU=J
 1000 THMU(J)=XMU*PI/XN
      DO 1010 I=1,N
         XNU=I
         THNU(I)=XNU*PI/XN
 1010 X(I)=.5*(COS(THNU(I))+1.)
      A0=SQRT(2.*RHO)
!
!  OBTAIN THICKNESS AT CALCULATED X(I) FOR WEBER ANALYSIS
!
      IF(NACA(8).EQ.A4HS)GO TO 1020
      CALL ASMINT(M,X0,THN,N,X,ZTNU)
      GO TO 1040
 1020 CONTINUE
!
!  HERE FOR SUPERSONIC AIRFOILS
!
      IN=0
      MI=0
      NG=0
      DO 1030 I=1,N
         CALL TBFUNX(X(I),ZTNU(I),DYDX,60,X0,THN,C,IN,MI,NG,0,0,        &
     &               4HX..Y,1,4HX..Y)
 1030 END DO
 1040 CONTINUE
!
!  DEFINE THE WEBER TERMS FOR THIS AIRFOIL
!
!    ST1NU DEFINES THE SOURCE DISTRIBUTION IN PARALLEL FLOW
!    ST2NU DEFINES THE SLOPE OF THE THICKNESS DISTRIBUTION
!
      DO 1070 I=1,N
         ST1NU(I)=0.0
         ST2NU(I)=0.0
         DO 1070 J=1,L
            IF(I.EQ.J)GO TO 1050
            S1=((-1.)**(J-I)-1.)/XN*2.*SIN(THMU(J))/                    &
     &         (COS(THMU(J))-COS(THNU(I)))**2
            S2=-2.*(-1.)**(J-I)*SIN(THMU(J))/(SIN(THNU(I))*             &
     &          (COS(THMU(J))-COS(THNU(I))))
            GO TO 1060
 1050       S1=XN/SIN(THNU(I))
            S2=COS(THNU(I))/(SIN(THNU(I)))**2
 1060       YS1=S1*ZTNU(J)
            YS2=S2*ZTNU(J)
            ST2NU(I)=ST2NU(I)+YS2
 1070 ST1NU(I)=ST1NU(I)+YS1
      ST1NU(N)=ST1NU(N)+XN*A0
!
!    ST3NU DEFINES THE VORTEX DISTRIBUTION IN NORMAL FLOW
!
      DO 1100 I=1,N
         ST3NU(I)=0.0
         DO 1100 J=1,L
            IF(I.EQ.J) GO TO 1080
            S3=((-1.)**(J-I)-1.)/XN*2.*SIN(THMU(J))/                    &
     &         (COS(THMU(J))-COS(THNU(I)))**2+2./XN*                    &
     &         (1.-(-1.)**(J-I))/(SIN(THMU(J))*                         &
     &         (COS(THMU(J))-COS(THNU(I))))
            GO TO 1090
 1080       S3=XN/SIN(THNU(I))
 1090       YS3=S3*ZTNU(J)
 1100 ST3NU(I)=ST3NU(I)+YS3
      DO 1130 I=1,N
         IF(I.EQ.N)GO TO 1110
         S3=((-1.)**I-1.)/(XN*(1.+COS(THNU(I))))
         GO TO 1120
 1110    S3=0.0
 1120    Y=S3*SQRT(RHO/2.)
         IF(I.NE.N) GO TO 1130
         Y=XN/2.*A0
 1130 ST3NU(I)=ST3NU(I)+Y
!
!  OBTAIN MEAN LINE DISTRIBUTION AT CALCULATED X(I) FOR WEBER ANALYSIS
!
      CALL ASMINT(M,X0,CAM,N,X,ZCNU)
!
!    ST4NU DEFINES THE VORTEX DISTRIBUTION DUE TO CAMBER
!    ST5NU DEFINES THE SLOPE OF THE MEAN LINE
!
      DO 1160 I=1,N
         ST4NU(I)=0.0
         ST5NU(I)=0.0
         DO 1160 J=1,L
            IF(I.EQ.J)GO TO 1140
            S4=2.*((-1.)**(J-I)-1.)/(XN*SIN(THNU(I)))*(1.-COS(THMU(J))* &
     &         COS(THNU(I)))/(COS(THNU(I))-COS(THMU(J)))**2-2.*((-1.)   &
     &         **J-1.)/(XN*SIN(THNU(I))*(1.-COS(THMU(J))))
            S5=-2.*(-1.)**(J-I)/(COS(THMU(J))-COS(THNU(I)))
            GO TO 1150
 1140       S4=XN/SIN(THNU(I))-2.*((-1.)**J-1.)/(XN*SIN(THNU(I))*       &
     &         (1.-COS(THNU(I))))
            S5=-COS(THNU(I))/(SIN(THNU(I)))**2
 1150       YS4=S4*ZCNU(J)
            YS5=S5*ZCNU(J)
            ST4NU(I)=ST4NU(I)+YS4
 1160 ST5NU(I)=ST5NU(I)+YS5
!
!  GET PLANFORM IDEAL PARAMETERS
!
      IF(CLI .NE. UNUSED) GO TO 1190
      JN=N-4
      ZC95=ZCNU(4)
      ZC05=ZCNU(JN)
      DAI05= .3739*ZC05+.04745*ST5NU(N-1)
      DAI95=-.3739*ZC95+.04745*ST5NU(1)
      DA95=-.7834*ZC95+.09518*ST5NU(1)
      T1=.5*(-ZC95*COS(THNU(4))/(SIN(THNU(4))/2.)**2-ZC05*              &
     &  COS(THNU(JN))/(SIN(THNU(JN))/2.)**2)
      T2=.5*ZC95/(1.-COS(THNU(4)))
      NM5=N-5
      SUMAL=0.0
      SUMAI=0.0
      DO 1180 I=5,L
         IF(I .GT. NM5) GO TO 1170
         T3=-ZCNU(I)*COS(THNU(I))/(SIN(THNU(I))/2.)**2
         SUMAI=SUMAI+T3
 1170    T4=ZCNU(I)/(1.-COS(THNU(I)))
 1180 SUMAL=SUMAL+T4
!
!  IDEAL ANGLE OF ATTACK
!
      DAI=.5/XN*(T1+SUMAI)
      AI=RAD*(DAI05+DAI+DAI95)
!
!  ANGLE OF ATTACK FOR ZERO LIFT
!
      DALO=-2./XN*(T2+SUMAL)
      ALO=RAD*(DA95+DALO)
!
!  IDEAL LIFT COEFFICIENT
!
      CLI=2.*PI/RAD*(AI-ALO)
 1190 CONTINUE
!
!  PITCHING MOMENT ABOUT THE QUARTER CHORD
!
      SUMCM=0.0
      DO 1200 I=1,L
         T5=ZCNU(I)*COS(THNU(I))
 1200 SUMCM=SUMCM+T5
      XMUO=SUMCM*(-PI/XN)
      CMCO4=2.*XMUO+PI/2.*ALO/RAD
      RETURN
      END
      SUBROUTINE INFTGM
!
!***  CALCULATE DOWNWASH SYNTHESIZING DIMENSIONS
!
      COMMON /WINGI/  CHRDTP,SSPNOP,SSPNE,SSPN,CHRDBP,CHRDR,SAVSI,SAVSO,&
     &                CHSTAT,ALPHAO,TWISTA,SSPNDD,DHDADI,DHDADO,TYPE,   &
     &                TOVC,DELTAY,XOVC,CLI,ALPHAI,CLALPA(20),           &
     &                CLMAX(20),CMO,LERI,LERO,CAMBER,TOVCO,XOVCO,CMOT,  &
     &                CLMAXL,CLAMO,TCEFF,KSHARP,SLOPE(6)
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ ATH(195)
      COMMON /HTI/    HTIN(154)
      COMMON /CONSNT/ CONST(5)
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT
      LOGICAL         FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT
      LOGICAL LOGCOM(10),VERTUP
      EQUIVALENCE (LOGCOM(1),FLTC)
      EQUIVALENCE (RAD,CONST(4)),(UNUSED,CONST(3))
!
      IF(.NOT.HTPL) GO TO 1010
      COSAIW=COS(ALIW/RAD)
      COSAIH=COS(ALIH/RAD)
      SINAIH=SIN(ALIH/RAD)
      SINAIW=SIN(ALIW/RAD)
      TANAIW=SINAIW/COSAIW
      IF(HINAX .EQ. UNUSED) GO TO 1000
      ZH=ZH+SINAIH*(HINAX-XH)
      XH=HINAX*(1.-COSAIH)+XH*COSAIH
 1000 XBRSTH=ATH(30)-ATH(16)/4.
      DXSTAR=(HTIN(4)-HTIN(3))*ATH(62)
      DXBH=XBRSTH+DXSTAR
      A(193)=XH-XW-CHRDR*COSAIW
      A(194)=A(193)+DXBH*COSAIH
      ZPH=ZH-DXBH*SINAIH-ZW+CHRDR*SINAIW
      DLH=ZPH*TANAIW
      A(24)=(A(194)-DLH)*COSAIW
      A(22)=CHRDR-A(195)
      A(9)=A(29)+(SSPN-SSPNE)*A(38)
      DHH1=ZPH/COSAIW
      DHH2=(A(194)-DLH)*SINAIW
      A(12)=DHH1+DHH2
      A(11)=ATAN(A(12)/A(24))
 1010 CONTINUE
!
!     ----DETERMINE LOCATION OF ZERO SWEEP ANGLE
!
      IF(A(52).LT.0.) GO TO 1020
      A(8)=1.
      RETURN
 1020 IF(A(112).NE.UNUSED) GO TO 1030
!
!     ----HERE IF INBOARD ONLY
!
      A(8)=A(110)/A(13)+CHSTAT
      RETURN
!
!     ----HERE IF INBOARD + OUTBOARD
!
 1030 IC=34
      DO 1050 I=1,3
         CP=I-1
         IF(ABS(A(IC)).GT.1.E-3) GO TO 1040
         A(8)=.25*CP
         RETURN
 1040    IP=IC
         IC=IC+6
         IF(A(IP).GT.0.0.AND.A(IC).LT.0.0) GO TO 1060
 1050 END DO
 1060 A(8)= .25*(CP+(CP+1.)*A(IP)/(A(IP)-A(IC)))
      RETURN
      END
      SUBROUTINE INITZ1
!
!***  INITIALIZE ARRAYS FOR PROGRAM USE
!
!     IDEAL OUTPUT MATRIX
!             BLOCK    PRINT     IOM
!             NAME     FLAG     ARRAY
!
      COMMON /IBODY/   PBODY,  BODY(400)
      COMMON /IWING/   PWING,  WING(400)
      COMMON /IHT/     PHT,    HT(380)
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /IBWH/    PBWH,   BWH(380)
      COMMON /IBWV/    PBWV,   BWV(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
      COMMON /IPOWER/  PPOWER, POWER(200)
      COMMON /IDWASH/  PDWASH, DWASH(60)
!
      LOGICAL PBODY, PWING, PHT, PVT, PVF, PBW, PBH, PBV, PBWH, PBWV,   &
     &        PBWHV, PPOWER, PDWASH
!
!***  COMPUTATIONAL BLOCKS
!
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /WHWB/   FACT(182), WB(39), HB(39)
      COMMON /WBHCAL/ WBT(156)
      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55), DVF(55)
      COMMON /POWR/   PW(315)
      COMMON /SUPWBB/  SWB(61), SHB(61)
      COMMON /SUPDW/  DWA(237)
      COMMON /SUPWH/  GR(303)
      COMMON /SUPBOD/ SBD(229)
!
      COMMON /CONSNT/CONST(5)
      EQUIVALENCE (CONST(3),UNUSED)
!
      DO 1000 I=1,51
 1000 C(I)=UNUSED
      DO 1010 I=1,55
 1010 D(I)=UNUSED
      DO 1020 I=1,39
         HB(I)=UNUSED
 1020 WB(I)=UNUSED
      DO 1030 I=1,182
 1030 FACT(I)=UNUSED
      DO 1040 I=1,156
 1040 WBT(I)=UNUSED
      DO 1050 I=1,315
 1050 PW(I)=UNUSED
      DO 1060 I=1,51
 1060 CHT(I)=UNUSED
      DO 1070 I=1,55
 1070 DHT(I)=UNUSED
      DO 1080 I=1,55
         DVF(I)=UNUSED
 1080 DVT(I)=UNUSED
      DO 1090 I=1,135
         STBH(I)=UNUSED
 1090 STB(I)=UNUSED
      DO 1100 I=1,229
 1100 SBD(I)=UNUSED
      DO 1110 I=1,303
 1110 GR(I)=UNUSED
      DO 1120 I=1,61
         SHB(I)=UNUSED
 1120 SWB(I)=UNUSED
      DO 1130 I=1,237
 1130 DWA(I)=UNUSED
      DO 1140 I=1,108
         TRAH(I)=UNUSED
 1140 TRA(I)=UNUSED
      DO 1150 I=1,400
         BODY(I)=UNUSED
 1150 WING(I)=UNUSED
      DO 1160 I=1,380
         HT(I)=UNUSED
         VT(I)=UNUSED
         VF(I)=UNUSED
         BW(I)=UNUSED
         BH(I)=UNUSED
         BV(I)=UNUSED
         BWH(I)=UNUSED
         BWV(I)=UNUSED
 1160 BWHV(I)=UNUSED
      DO 1170 I=1,200
 1170 POWER(I)=UNUSED
      DO 1180 I=1,60
 1180 DWASH(I)=UNUSED
      RETURN
      END
      SUBROUTINE INITZ2
!
!     REINITIALIZE ARRAYS FOR FLAP ROUTINES
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /POWR/   SPR(59),FLA(45),FLP(189),TRM(22)
      COMMON /SUPDW/  FHG(35),TCD(58)
      COMMON /SUPWH/  FCM(282)
      COMMON /IBODY/  PB, BODY(400)
      COMMON /IWING/  PW, WING(400)
      COMMON /IHT/    PH, HT(380)
      COMMON /IVT/    PV, VT(380)
      COMMON /IVF/    PF, VF(380)
!
      DIMENSION PWW(315),DW(93)
      EQUIVALENCE (PWW(1),SPR(1)), (DW(1),FHG(1))
!
      DO 1000 I=1,315
         PWW(I) = UNUSED
         IF(I .GT. 282) GO TO 1000
         FCM(I) = UNUSED
         IF(I .GT. 93) GO TO 1000
         DW(I) = UNUSED
 1000 END DO
      DO 1010 I=1,200
         BODY(I+200) = UNUSED
         WING(I+200) = UNUSED
         IF(I .GT. 180) GO TO 1010
         HT(I+200) = UNUSED
         VF(I+200) = UNUSED
         VF(I+200) = UNUSED
 1010 END DO
      RETURN
      END
      SUBROUTINE INITZE
!
!***  IDEAL OUTPUT MATRIX
!
!             BLOCK    PRINT     IOM
!             NAME     FLAG     ARRAY
!
      COMMON /IBODY/   PBODY,  BODY(400)
      COMMON /IWING/   PWING,  WING(400)
      COMMON /IHT/     PHT,    HT(380)
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
      COMMON /IBWH/    PBWH,   BWH(380)
      COMMON /IBWV/    PBWV,   BWV(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
      COMMON /IPOWER/  PPOWER, POWER(200)
      COMMON /IDWASH/  PDWASH, DWASH(60)
!
      LOGICAL PBODY, PWING, PHT, PVT, PVF, PBW, PBH, PBV, PBWH, PBWV,   &
     &        PBWHV, PPOWER, PDWASH
!
!***  INPUT DATA BLOCKS
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ XX(4)
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /BODYI/  BODYIN(129)
      COMMON /WINGI/  WINGIN(101)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /HTI/    HTIN(154)
      COMMON /POWER/  PWIN(29), LBIN(21)
      COMMON /FLAPIN/ F(138)
!
!***  COMPUTATIONAL BLOCKS
!
      COMMON /WINGD/  A(195), B(49)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /BDATA/  BD(762)
      COMMON /WHWB/   FACT(182), WB(39), HB(39)
      COMMON /WBHCAL/ WBT(156)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55), DVF(55)
      COMMON /POWR/   PW(315)
      COMMON /SUPWBB/  SWB(61), SHB(61)
      COMMON /SUPDW/  DWA(237)
      COMMON /SUPWH/  GR(303)
      COMMON /SUPBOD/ SBD(229)
      COMMON /LEVEL2/ SECOND(23)
!
      COMMON /CONSNT/CONST(5)
      EQUIVALENCE (CONST(3),UNUSED),(DONE,SECOND(15)),(DOL2,SECOND(16))
      LOGICAL BLF,ROUNDN,VERTUP,DONE,DOL2
      REAL LBIN
      DIMENSION X(19)
      EQUIVALENCE (BLF,LBIN(14)),(ROUNDN,LBIN(17)),(X(1),XCG)
!
!     ----FIX WITH ENTRIES TO INITIALIZE DIFFERENT PARTS
!
      DO 1000 I=1,195
 1000 A(I)=UNUSED
      DO 1010 I=1,49
 1010 B(I) = UNUSED
      DO 1020 I=1,51
 1020 C(I)=UNUSED
      DO 1030 I=1,55
 1030 D(I)=UNUSED
      DO 1040 I=1,762
 1040 BD(I)=UNUSED
      DO 1050 I=1,39
      HB(I)=UNUSED
 1050 WB(I)=UNUSED
      DO 1060 I=1,4
 1060 XX(I)=UNUSED
      DO 1070 I=1,19
      IF(I .NE. 10)X(I)=UNUSED
 1070 END DO
      VERTUP=.TRUE.
      DO 1080 I=1,160
 1080 FLC(I)=UNUSED
      DO 1090 I=1,182
 1090 FACT(I)=UNUSED
      DO 1100 I=1,156
 1100 WBT(I)=UNUSED
      DO 1110 I=1,49
 1110 BHT(I)=UNUSED
      DO 1120 I=1,195
      AVF(I)=UNUSED
 1120 AVT(I)=UNUSED
      DO 1130 I=1,195
 1130 AHT(I)=UNUSED
      DO 1140 I=1,315
 1140 PW(I)=UNUSED
      DO 1170 I=1,51
 1170 CHT(I)=UNUSED
      DO 1180 I=1,55
 1180 DHT(I)=UNUSED
      DO 1190 I=1,55
      DVF(I)=UNUSED
 1190 DVT(I)=UNUSED
      DO 1200 I=1,135
      STBH(I)=UNUSED
 1200 STB(I)=UNUSED
      DO 1210 I=1,229
 1210 SBD(I)=UNUSED
      DO 1215 I=1,23
 1215 SECOND(I)=UNUSED
      DO 1220 I=1,303
 1220 GR(I)=UNUSED
      DO 1230 I=1,61
      SHB(I)=UNUSED
 1230 SWB(I)=UNUSED
      DO 1240 I=1,29
 1240 PWIN(I)=UNUSED
      DO 1250 I=1,237
 1250 DWA(I)=UNUSED
      DO 1260 I=1,129
 1260 BODYIN(I)=UNUSED
      DO 1270 I=1,101
 1270 WINGIN(I)=UNUSED
      WINGIN(7) = 0.
      WINGIN(8) = 0.
      DO 1280 I=1,108
      TRAH(I)=UNUSED
 1280 TRA(I)=UNUSED
      DO 1290 I=1,138
 1290 F(I)=UNUSED
      DO 1300 I=1,154
      HTIN(I) = UNUSED
      VTIN(I) = UNUSED
      VFIN(I) = UNUSED
      IF(I .GT. 21) GO TO 1300
      LBIN(I) = UNUSED
      IF(I .GT. 8) GO TO 1300
      TVTIN(I) = UNUSED
 1300 END DO
      VTIN(7) = 0.
      VTIN(8) = 0.
      VFIN(7) = 0.
      VFIN(8) = 0.
      HTIN(7) = 0.
      HTIN(8) = 0.
      BLF=.FALSE.
      ROUNDN=.FALSE.
      CALL ZERANG(A(106))
      CALL ZERANG(A(112))
      CALL ZERANG(A(138))
      CALL ZERANG(AHT(106))
      CALL ZERANG(AVT(106))
      CALL ZERANG(AVF(106))
      CALL ZERANG(AHT(112))
      CALL ZERANG(AVT(112))
      CALL ZERANG(AVF(112))
      CALL ZERANG(AHT(138))
      CALL ZERANG(AVT(138))
      CALL ZERANG(AVF(138))
      CALL ZERANG(A(153))
      CALL ZERANG(A(147))
      CALL ZERANG(AHT(153))
      CALL ZERANG(AHT(147))
      CALL ZERANG(AVT(153))
      CALL ZERANG(AVT(147))
      CALL ZERANG(AVF(153))
      CALL ZERANG(AVF(147))
      DO 1310 I=1,400
         BODY(I)=UNUSED
 1310 WING(I)=UNUSED
      DO 1320 I=1,380
      HT(I)=UNUSED
      VT(I)=UNUSED
      VF(I)=UNUSED
      BW(I)=UNUSED
      BH(I)=UNUSED
      BV(I)=UNUSED
      BWH(I)=UNUSED
      BWV(I)=UNUSED
 1320 BWHV(I)=UNUSED
      DO 1330 I=1,200
 1330 POWER(I)=UNUSED
      DO 1340 I=1,60
 1340 DWASH(I)=UNUSED
      PBODY=.FALSE.
      PWING=.FALSE.
      PHT=.FALSE.
      PVT=.FALSE.
      PVF=.FALSE.
      PBW=.FALSE.
      PBH=.FALSE.
      PBV=.FALSE.
      PBWH=.FALSE.
      PBWV=.FALSE.
      PBWHV=.FALSE.
      PPOWER=.FALSE.
      PDWASH=.FALSE.
      DONE=.FALSE.
      DOL2=.FALSE.
      RETURN
      END
      SUBROUTINE INIZ
!
!  INITIZE FOR REUSE OF THE COMMON BLOCKS
!
      COMMON /CONSNT/PI,DEG,UNUSED,RAD,kand
      COMMON /IBWH/  PBWH, X(47)
      COMMON /IBWHV/ PBWHV, Y(7)
      COMMON /IBH/   PBH, Z(144), dum6(236)
      DO 1000 I=1,144
         Z(I)=UNUSED
         IF(I.GT.47) GO TO 1000
         X(I)=UNUSED
         IF(I.GT.7) GO TO 1000
         Y(I)=UNUSED
 1000 END DO
      RETURN
      END
      SUBROUTINE INPUT
!
!***  INPUT DATA BLOCKS
!
      COMMON /FLGTCD/ NMACH,NALPHA,MACH(20),ALSCHD(20),RNNUB(20),NGH    &
     &                ,GRDHT(10),PINF(20),STMACH,TSMACH,TR,ALT(20)      &
     &                ,TINF(20),VINF(20),WT,GAMMA,NALT,LOOP
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /BODYI/  NX,X(20),S(20),P(20),R(20),ZU(20),ZL(20),         &
     &                BNOSE,BTAIL,BLN,BLA,DS,ITYPE,METHOD,ELLIP
      COMMON /WINGI/  CHRDTP,SSPNOP,SSPNE,SSPN,CHRDBP,CHRDR,SAVSI,SAVSO,&
     &                CHSTAT,ALPHAO,TWISTA,SSPNDD,DHDADI,DHDADO,        &
     &                TYPE,                                             &
     &                TOVC,DELTAY,XOVC,CLI,ALPHAI,CLALPA(20),           &
     &                CLMAX(20),CMO,LERI,LERO,CAMBER,TOVCO,XOVCO,CMOT,  &
     &                CLMAXL,CLAMO,TCEFF,KSHARP,XAC(20),ARCL,YCM,CLD,   &
     &                SLOPE(6),DWASH
      COMMON /HTI/    HTIN(154)
      COMMON /VTI/    VTIN(154),BVP,BV,BDV,BH,SV,VPHITE,VLP,ZP,         &
     &                VFIN(154)
      COMMON /POWER/  AIETLP,NENGSP,THSTCP,PHALOC,PHVLOC,PRPRAD,ENGFCT, &
     &                BWAPR3,BWAPR6,BWAPR9,NOPBPE,BAPR75,               &
     &                AIETLJ,NENGSJ,THSTCJ,JIALOC,JEVLOC,JEALOC,        &
     &                JINLTA,JEANGL,JEVELO,AMBTMP,JESTMP,JELLOC,        &
     &                JETOTP,AMBSTP,JERAD,YP,CROT,                      &
     &                LBIN(21)
      COMMON /FLAPIN/ F(116),TTYPE,CFITC,CFOTC,BITC,BOTC,CFITT,CFOTT,   &
     &                BITT,BOTT,B1,B2,B3,B4,D1,D2,D3,GCMAX,             &
     &                KS,RL,BGR,DELR
      COMMON /WINGD/  A(195)
      COMMON /IBW/    PBW(131),TYPEIN,NACAW(80),NPTS,XCORD(50),         &
     &                YUPPER(50),YLOWER(50), dum5(18)
      COMMON /IBH/    PBH(131),HTYPE,NACAH(80), dum6(168)
      COMMON /IBV/    PBV(131),VTYPE,NACAV(80)
      COMMON /IVF/    PVF(131),VFTYP,NACAF(80)
!
      REAL NTYPE,NDELTA,NPTS,MEAN,ITYPE,JETFLP
      REAL LERI,LERO
      REAL NT,ME,ISP,LFP
      REAL NENGSP,NOPBPE,NENGSJ,JIALOC,JEVLOC,JEALOC,JINLTA,JEANGL,     &
     &     JEVELO,JESTMP,JELLOC,JETOTP,JERAD,KSHARP
      REAL NMACH,MACH,NALPHA,NGH
      REAL NX,LAFB,METHOD,NALT,LOOP,KS
!
      LOGICAL LAMNRJ
      LOGICAL VERTUP
      LOGICAL CROT,LAMNR
      LOGICAL CAMBER,CAMH,CAMV
!
      DIMENSION MEAN(50),THICK(50)
      DIMENSION TIME(10),FC(10),ALPHA(10),LAMNRJ(10)
      DIMENSION DELTA(10),CPRMEI(10),CPRMEO(10),SCLD(10),SCMD(10)
      DIMENSION DELTAD(10),DELTAL(10),DELTAR(10),DELTAS(10),XSOC(10),   &
     &          HSOC(10),HDELTA(10)
      DIMENSION DELJET(10),EFFJET(10),CAPINB(10),CAPOUT(10),DOBDEF(10)
      EQUIVALENCE (CAMH,HTIN(64)),(CAMV,VTIN(64))
      EQUIVALENCE (DELTA(1),DELTAD(1),F(1)),(PHETE,F(11)),              &
     &            (CHRDFI,F(12)),(CHRDFO,F(13)),(SPANFI,F(14)),         &
     &            (SPANFO,F(15)),(NDELTA,F(16)),(FTYPE,F(17)),          &
     &            (STYPE,F(18)),(SCLD(1),DELTAL(1),F(19)),              &
     &            (SCMD(1),DELTAR(1),F(29)),(CPRMEI(1),DELTAS(1),F(39)),&
     &            (CPRMEO(1),XSOC(1),F(49)),(CB,XSPRME,F(59)),          &
     &            (TC,HSOC(1),F(60)),(PHETEP,F(61)),(NTYPE,F(62))
      EQUIVALENCE (F(1),ALITD),(F(2),XHL),(F(3),TWOTI),(F(4),CF),       &
     & (F(5),HDELTA(1)),(F(15),LAMNR),(F(16),HNDLTA)
      EQUIVALENCE (TIME(1),F(1)),(NT,F(11)),                            &
     & (FC(1),F(12)),(ALPHA(1),F(22)),    (ME,F(32)),(ISP,F(33)),       &
     & (SPAN,F(34)),(PHE,F(35)),(GP,F(36)),(CC,F(37)),(LFP,F(38)),      &
     & (LAMNRJ(1),F(39)),(CMU,F(63)),(DELJET(1),F(64)),                 &
     & (JETFLP,F(74)),(EFFJET(1),F(75)),(CAPINB(1),F(85)),              &
     & (CAPOUT(1),F(95)),(DOBDEF(1),F(105)),(DOBCIN,F(115)),            &
     & (DOBCOT,F(116))
      EQUIVALENCE (CMO,CM0),(CMOT,CM0T),(CLAMO,CLAM0)
      EQUIVALENCE (MEAN(1),YUPPER(1)),(THICK(1),YLOWER(1))
      EQUIVALENCE (ALPHAO,ALPHA0)
!
!***  COMPUTATIONAL BLOCKS
!
      COMMON /CASEID/ IDCSE(74),KOUNT,NAMSV(100),DIM
      COMMON /BDATA/  BD(762)
      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,          &
     &                KBODY, KWING, KHT, KVT, KWB, KDWASH(3),           &
     &                ALPOW, ALPLW, ALPOH, ALPLH
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPN,SUPERS,SUBSON,    &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB,PLOT
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH,LIST,LEXTRP
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPN,SUPERS,SUBSON,           &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB,PLOT
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH,LIST,LEXTRP
      LOGICAL TEST,FRSTT
      LOGICAL  EXPSWT,SSAVE,NONE
      LOGICAL  LOGCOM(10), LEQV(81)
      INTEGER  DIM, IDCSE, KASE(6)
      EQUIVALENCE (BD(81),ALPCA)
      EQUIVALENCE (LEQV(1),IERR)
      EQUIVALENCE (LOGCOM(1),FLTC)
!
      DIMENSION XTYPE(4),NUM(10),IDIM(3),IDIMT(8),NMLIST(8)
      DIMENSION NCHR(23),NLOC(23),NK(24)
      DIMENSION KOL(80),ISAVE(4),NEXT(9),KEY(138),ITRIM(4),IDAMP(4)
      DIMENSION IBUILD(5),INACA(4),NACAT(4),IDERD(9),IDERR(9)
      DIMENSION NAMORD(300),IPART(4)
      DIMENSION IDMP(8),IDMC(4),IPLOT(4)
      DIMENSION KEYDP(224),  NDP(75)
      DIMENSION KEYARY(136), NDPARY(48)
      DIMENSION KEYINP(47),  NDPINP(13)
      DIMENSION KEYIOM(41),  NDPIOM(14)
      EQUIVALENCE (KEYDP( 1 ),KEYARY(1)), (NDP(1 ),NDPARY(1))
      EQUIVALENCE (KEYDP(137),KEYINP(1)), (NDP(49),NDPINP(1))
      EQUIVALENCE (KEYDP(184),KEYIOM(1)), (NDP(62),NDPIOM(1))
      DATA XTYPE  /4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA NCHR   /2*6,4,9*6,5,2*6,4,7*6/
      DATA NK     /24*0/
      DATA NLOC   /4,10,16,20,26,32,38,44,50,56,62,68,74,79,85,91,97,   &
     &             103,109,115,121,127,133 /
      DATA NNAM   /23/
      DATA IBUILD /4HB   , 4HU   , 4HI   , 4HL   , 4HD    /
      DATA INACA  /4HN   , 4HA   , 4HC   , 4HA    /
      DATA NACAT  /4HW   , 4HH   , 4HV   , 4HF   /
      DATA IDERD  /4HD   ,4HE   ,4HR   ,4HI   ,4HV   ,4H    ,           &
     &             4HD   ,4HE   ,4HG   /
      DATA IDERR  /4HD   ,4HE   ,4HR   ,4HI   ,4HV   ,4H    ,           &
     &             4HR   ,4HA   ,4HD   /
      DATA IPART  /4HP   ,4HA   ,4HR   ,4HT   /
      DATA IDIM   /4HD   ,4HI   ,4HM    /
      DATA IDIMT  /4HF   ,4HT   ,4HI   ,4HN   ,4HM   ,4H    ,           &
     &             4HC   ,4HM   /
      DATA NMLIST /4HN   ,4HA   ,4HM   ,4HE   ,4HL   ,                  &
     &             4HI   ,4HS   ,4HT   /
      DATA KASE   /4HC   ,4HA   ,4HS   ,4HE   ,4HI   ,4HD   /
      DATA ISAVE  /4HS   ,4HA   ,4HV   ,4HE    /
      DATA NEXT   /4HN   ,4HE   ,4HX   ,4HT   ,4H    ,4HC   ,4HA   ,    &
     &             4HS   ,4HE   /
      DATA IDMP   /4HD   ,4HU   ,4HM   ,4HP   ,4H    ,4HA   ,4HL   ,    &
     &             4HL   /
      DATA IDMC   /4HC   ,4HA   ,4HS   ,4HE   /
      DATA IPLOT  /4HP   ,4HL   ,4HO   ,4HT   /
      DATA IBLNK  /4H    /,KOMMA /4H,   /
      DATA ITRIM  /4HT   ,4HR   ,4HI   ,4HM   /
      DATA IDAMP  /4HD   ,4HA   ,4HM   ,4HP   /
      DATA NUM    /4H0   ,4H1   ,4H2   ,4H3   ,4H4   ,4H5   ,4H6   ,    &
     &             4H7   ,4H8   ,4H9   /
      DATA KEYARY  /                                                    &
     &       4HB   ,4HA   ,4HB   ,4HD   ,4HA   ,4HV   ,4HF   ,4HF   ,   &
     &       4HA   ,4HC   ,4HT   ,4HW   ,4HB   ,4HT   ,4HB   ,4HH   ,   &
     &       4HT   ,4HA   ,4HV   ,4HT   ,4HA   ,4HH   ,4HT   ,4HC   ,   &
     &       4HD   ,4HW   ,4HB   ,4HC   ,4HH   ,4HT   ,4HD   ,4HH   ,   &
     &       4HT   ,4HD   ,4HY   ,4HN   ,4HH   ,4HD   ,4HV   ,4HT   ,   &
     &       4HG   ,4HR   ,4HL   ,4HB   ,4HP   ,4HW   ,4HS   ,4HT   ,   &
     &       4HB   ,4HS   ,4HB   ,4HD   ,4HS   ,4HL   ,4HG   ,4HS   ,   &
     &       4HW   ,4HB   ,4HS   ,4HT   ,4HP   ,4HD   ,4HW   ,4HA   ,   &
     &       4HS   ,4HT   ,4HG   ,4HS   ,4HL   ,4HA   ,4HT   ,4HR   ,   &
     &       4HA   ,4HX   ,4HP   ,4HD   ,4HD   ,4HV   ,4HF   ,4HF   ,   &
     &       4HL   ,4HP   ,4HF   ,4HH   ,4HG   ,4HF   ,4HC   ,4HM   ,   &
     &       4HT   ,4HC   ,4HD   ,4HF   ,4HL   ,4HA   ,4HT   ,4HR   ,   &
     &       4HM   ,4HS   ,4HP   ,4HR   ,4HT   ,4HR   ,4HN   ,4HT   ,   &
     &       4HR   ,4HM   ,4H2   ,4HH   ,4HY   ,4HP   ,4HD   ,4HY   ,   &
     &       4HN   ,4HJ   ,4HE   ,4HT   ,4HH   ,4HB   ,4HS   ,4HH   ,   &
     &       4HB   ,4HT   ,4HR   ,4HA   ,4HH   ,4HS   ,4HT   ,4HB   ,   &
     &       4HH   ,4HS   ,4HE   ,4HC   ,4HS   ,4HL   ,4HA   ,4HH   /
      DATA NDPARY / 1,1,2,3,4,4*3,2*1,2,2*3,4,3,3*2,19*3,4,3*3,2,3,     &
     &              4,4,3,4 /
!
      DATA KEYINP  /                                                    &
     &       4HI   ,4HN   ,4HP   ,4HT   ,4HF   ,4HL   ,4HC   ,4HO   ,   &
     &       4HP   ,4HT   ,4HN   ,4HS   ,4HY   ,4HN   ,4HA   ,4HB   ,   &
     &       4HD   ,4HI   ,4HN   ,4HW   ,4HG   ,4HI   ,4HN   ,4HV   ,   &
     &       4HT   ,4HI   ,4HN   ,4HT   ,4HV   ,4HT   ,4HV   ,4HF   ,   &
     &       4HI   ,4HN   ,4HH   ,4HT   ,4HI   ,4HN   ,4HP   ,4HW   ,   &
     &       4HI   ,4HN   ,4HL   ,4HB   ,4HI   ,4HN   ,4HF   /
      DATA NDPINP / 4,3,5*4,3,4*4,1 /
!
      DATA KEYIOM  /                                                    &
     &       4HI   ,4HO   ,4HM   ,4HB   ,4HO   ,4HD   ,4HY   ,4HW   ,   &
     &       4HI   ,4HN   ,4HG   ,4HH   ,4HT   ,4HV   ,4HT   ,4HV   ,   &
     &       4HF   ,4HB   ,4HW   ,4HB   ,4HH   ,4HB   ,4HV   ,4HB   ,   &
     &       4HW   ,4HH   ,4HB   ,4HW   ,4HV   ,4HB   ,4HW   ,4HH   ,   &
     &       4HV   ,4HP   ,4HO   ,4HW   ,4HR   ,4HD   ,4HW   ,4HS   ,   &
     &       4HH   /
      DATA NDPIOM / 3,4,4,6*2,3,3,4,4,4 /
      DATA KEY     /                                                    &
     &       4HE   ,4HN   ,4HD   ,4HF   ,4HL   ,4HT   ,4HC   ,4HO   ,   &
     &       4HN   ,4HO   ,4HP   ,4HT   ,4HI   ,4HN   ,4HS   ,4HB   ,   &
     &       4HO   ,4HD   ,4HY   ,4HW   ,4HG   ,4HP   ,4HL   ,4HN   ,   &
     &       4HF   ,4HW   ,4HG   ,4HS   ,4HC   ,4HH   ,4HR   ,4HS   ,   &
     &       4HY   ,4HN   ,4HT   ,4HH   ,4HS   ,4HH   ,4HT   ,4HP   ,   &
     &       4HL   ,4HN   ,4HF   ,4HH   ,4HT   ,4HS   ,4HC   ,4HH   ,   &
     &       4HR   ,4HV   ,4HT   ,4HP   ,4HL   ,4HN   ,4HF   ,4HV   ,   &
     &       4HT   ,4HS   ,4HC   ,4HH   ,4HR   ,4HP   ,4HR   ,4HO   ,   &
     &       4HP   ,4HW   ,4HR   ,4HJ   ,4HE   ,4HT   ,4HP   ,4HW   ,   &
     &       4HR   ,4HL   ,4HA   ,4HR   ,4HW   ,4HB   ,4HG   ,4HR   ,   &
     &       4HN   ,4HD   ,4HE   ,4HF   ,4HT   ,4HV   ,4HT   ,4HP   ,   &
     &       4HA   ,4HN   ,4HE   ,4HX   ,4HP   ,4HR   ,4H    ,4H    ,   &
     &       4HS   ,4HY   ,4HM   ,4HF   ,4HL   ,4HP   ,4HA   ,4HS   ,   &
     &       4HY   ,4HF   ,4HL   ,4HP   ,4HH   ,4HY   ,4HP   ,4HE   ,   &
     &       4HF   ,4HF   ,4HT   ,4HR   ,4HN   ,4HJ   ,4HE   ,4HT   ,   &
     &       4HV   ,4HF   ,4HP   ,4HL   ,4HN   ,4HF   ,4HV   ,4HF   ,   &
     &       4HS   ,4HC   ,4HH   ,4HR   ,4HC   ,4HO   ,4HN   ,4HT   ,   &
     &       4HA   ,4HB   /
!
!    1----WAS EOF HIT ON LAST ENTRY
!
      IF(IEND) GO TO 1190
!
!     ----INITIALIZE ALL DUMP TESTS FALSE
!
      DO 1000 I=4,81
      IF(I .EQ. 20) GO TO 1000
      LEQV(I)=.FALSE.
 1000 END DO
      EXPSWT=.FALSE.
      DAMP=.FALSE.
      TRIM=.FALSE.
      LIST=.FALSE.
      LEXTRP=.FALSE.
      FRSTT = .TRUE.
      ISDIM=DIM
      SSAVE=SAVE
      WRITE(6,2150)
      IF(SAVE)GO TO 1010
      REWIND 9
      KOUNT=0
      GO TO 1030
!
!     ----HERE TO UNPACK SAVE CASE NAMSV ARRAY INTO NAMORD ARRAY
!
 1010 KK=KOUNT/3
      KK3=3*KK
      IF(KK3.NE.KOUNT)KK=KK+KOUNT-KK3
      I=1
      DO 1020 K=1,KK
      NAMORD(I+2)=NAMSV(K)/1000000
      NAMORD(I+1)=(NAMSV(K)-1000000*NAMORD(I+2))/1000
      NAMORD(I)=NAMSV(K)-1000*(NAMSV(K)/1000)
 1020 I=I+3
 1030 SAVE=.FALSE.
!
!     ----SET ALPHACA = 0. TO AVOID UNDERFLOWS IF NOT READ IN
!
      ALPCA=0.
      CAMBER = .FALSE.
      CAMH   = .FALSE.
      CAMV   = .FALSE.
      GONOGO=.TRUE.
!
!***  THE FOLLOWING  -TWO-  CARDS ARE FOR FORTRAN-IV
!
!1040 READ(11,2130) (KOL(I),I=1,80)
!     IF(EOF(11))1180,1050
!
!***  THE FOLLOWING CARD IS FOR FORTRAN-V
!
 1040 READ(11,2130,END=1180) (KOL(I),I=1,80)
 1050 CONTINUE
      WRITE(6,2140)(KOL(I),I=1,80)
!
!     ----TEST FOR NEXT CASE CARD
!
      IF(KOL(1).NE.IBLNK) GO TO 1700
!
!     ----TEST FOR + IN COLUMN 2
!
      IF(KOL(2).NE.KAND) GO TO 1170
!
!     ----TEST FOR +END
!
      IF(TEST(KOL(3),KEY(1),3)) GO TO 1170
!
!     ----FIND NAMELIST NAME
!
      I = 16
      IV= NLOC(16)
      DO 1060 J=1,4
         IF(KOL(J+2) .NE. KEY(J+IV-1)) GO TO 1070
 1060 END DO
      GO TO 1100
 1070 CONTINUE
      DO 1080 I=1,NNAM
         IV=NLOC(I)
         IF(TEST(KOL(3),KEY(IV),NCHR(I)))GO TO 1100
 1080 END DO
!
!     ----HERE IF NAME WAS NOT FOUND
!
 1090 WRITE(6,2210)(KOL(I),I=1,80)
      GONOGO=.FALSE.
      GO TO 1040
 1100 IF(I.NE.16)GO TO 1150
!
!     ----HERE FOR EXPERIMENTIAL NAMELIST
!
      EXPSWT = .TRUE.
      KLIST = KLIST+1
      DO 1130 J=7,8
         DO 1110 K=1,10
            IF(KOL(J) .EQ. NUM(K)) GO TO 1120
 1110    CONTINUE
         GO TO 1090
 1120    CONTINUE
         IF(J .EQ. 7) NLIST(KLIST) = 10*(K-1)
         IF(J .EQ. 8) NLIST(KLIST) = NLIST(KLIST)+(K-1)
 1130 END DO
      KOL(7) = IBLNK
      KOL(8) = IBLNK
 1140 WRITE(8,2130) (KOL(I),I=1,80)
      GO TO 1040
 1150 NK(I)=NK(I)+1
      EXPSWT=.FALSE.
      KOUNT=KOUNT+1
!
!     ----TEST FOR NUMBER OF ALLOWED NAMELISTS EXCEEDED
!
      IF(KOUNT.LT.300) GO TO 1160
      WRITE(6,2170)
      GONOGO=.FALSE.
      RETURN
 1160 NAMORD(KOUNT)=I
!
!     ----WRITE NAMELIST DATA ONTO DISK
!
 1170 IF(EXPSWT)GO TO 1140
      WRITE(9,2130)(KOL(I),I=1,80)
      GO TO 1040
!
!     ----HAVE REACHED END OF DATA
!
 1180 IEND=.TRUE.
!
!     ----TEST FOR END OF JOB-TERMINATE IF NO DATA READ BEFORE EOF.
!
      IF(KOUNT.NE.0) GO TO 1200
 1190 WRITE(6,2180)
      CALL CloseFiles   ! changed 15 May 2004
      STOP
 1200 CONTINUE
!
!     ----TEST FOR PRESENCE OF ERROR
!
      IF(GONOGO) GO TO 1210
!
!     ----ERROR IF HERE
!
      WRITE(6,2220)
      GO TO 1660
 1210 REWIND 9
!
!***  CALL  INPUTB TO READ NAMELIST VAIRABLES USING NAMELIST EMULATOR
!
      CALL INPUTB(I,KOL,NAMORD)
 1660 IF(.NOT.SAVE)RETURN
!
!     ----HERE FOR SAVE CASE.PACK NAMORD ARRAY INTO NAMSV ARRAY.
!
      KK=KOUNT
      DO 1670 I=1,2
         IF(3*(KK/3).EQ.KK)GO TO 1680
         KK=KK+1
         NAMORD(KK)=0
 1670 END DO
 1680 K=1
      DO 1690 I=1,KK,3
         NAMSV(K)=NAMORD(I)+1000*NAMORD(I+1)+1000000*NAMORD(I+2)
 1690 K=K+1
      RETURN
 1700 CONTINUE
      CALL INPUTC(JRETRN,I,KOL,NAMORD,ISDIM,SSAVE)
      GO TO (1040,1150,1200,1040), JRETRN
!
 2130 FORMAT(80A1)
 2140 FORMAT(1X,80A1)
 2150 FORMAT(1H1,10X,57HTHE FOLLOWING IS A LIST OF ALL INPUT CARDS FOR T&
     &HIS CASE./1H0)
 2160 FORMAT(1H1,10X,53HTHE FOLLOWING IS A LIST OF FINAL INPUTS FOR THIS&
     & CASE/1H0)
 2170 FORMAT(66H -ERROR--NUMBER OF NAMELISTS IN A SERIES OF SAVE CASES E&
     &XCEEDS 300)
 2180 FORMAT(13H1 END OF JOB.)
 2190 FORMAT(42H ERROR TYPE CANNOT BE GREATER THAN 4.TYPE=,E12.5,       &
     &9HSET TO 1.)
 2200 FORMAT(41H0 *** WARNING *** THIS IS A SAVE CASE AND,              &
     &       38H THE DIMENSION SYSTEM HAS BEEN CHANGED/)
 2210 FORMAT(20H ERROR IN CARD BELOW/1H ,80A1)
 2220 FORMAT(27H ERROR(S),THIS CASE NOT RUN/1H1)
 2230 FORMAT(21H ERROR-THE CARD BELOW/1H ,80A1/53H CONTAINS ILLEGAL VARI&
     &ABLE NAME TO BE DUMPED.NAME IS ,30A1)
      END
      SUBROUTINE INPUTB(I,KOL,NAMORD)
!
!***  SUBROUTINE TO READ NAMELIST USING THE NAMELIST EMULATOR
!
      COMMON /FLGTCD/ NMACH,NALPHA,MACH(20),ALSCHD(20),RNNUB(20),NGH    &
     &                ,GRDHT(10),PINF(20),STMACH,TSMACH,TR,ALT(20)      &
     &                ,TINF(20),VINF(20),WT,GAMMA,NALT,LOOP
      COMMON /BODYI/  NX,X(20),S(20),P(20),R(20),ZU(20),ZL(20),         &
     &                BNOSE,BTAIL,BLN,BLA,DS,ITYPE,METHOD,ELLIP
      COMMON /WINGI/  CHRDTP,SSPNOP,SSPNE,SSPN,CHRDBP,CHRDR,SAVSI,SAVSO,&
     &                CHSTAT,ALPHAO,TWISTA,SSPNDD,DHDADI,DHDADO,        &
     &                TYPE,                                             &
     &                TOVC,DELTAY,XOVC,CLI,ALPHAI,CLALPA(20),           &
     &                CLMAX(20),CMO,LERI,LERO,CAMBER,TOVCO,XOVCO,CMOT,  &
     &                CLMAXL,CLAMO,TCEFF,KSHARP,XAC(20),ARCL,YCM,CLD,   &
     &                SLOPE(6),DWASH
      COMMON /HTI/    HTIN(154)
      COMMON /VTI/    VTIN(154),BVP,BV,BDV,BH,SV,VPHITE,VLP,ZP,         &
     &                VFIN(154)
      COMMON /FLAPIN/ F(116),TTYPE,CFITC,CFOTC,BITC,BOTC,CFITT,CFOTT,   &
     &                BITT,BOTT,B1,B2,B3,B4,D1,D2,D3,GCMAX,             &
     &                KS,RL,BGR,DELR
      COMMON /IBW/    PBW(131),TYPEIN,NACAW(80),NPTS,XCORD(50),         &
     &                YUPPER(50),YLOWER(50), dum5(98)
      COMMON /IBH/    PBH(131),HTYPE,NACAH(80), dum6(168)
      COMMON /IBV/    PBV(131),VTYPE,NACAV(80), dum7(168)
      COMMON /IVF/    PVF(131),VFTYP,NACAF(80), dum17(168)
!
      REAL NT,ME,ISP,LFP
      REAL NTYPE,NDELTA,NPTS,MEAN,ITYPE,JETFLP
      REAL LERI,LERO
      REAL NENGSP,NOPBPE,NENGSJ,JIALOC,JEVLOC,JEALOC,JINLTA,JEANGL,     &
     &     JEVELO,JESTMP,JELLOC,JETOTP,JERAD,KSHARP
      REAL NMACH,MACH,NALPHA,NGH
      REAL NX,LAFB,METHOD,NALT,LOOP,KS
!
      LOGICAL LAMNRJ
      LOGICAL VERTUP
      LOGICAL CROT,LAMNR
      LOGICAL CAMBER,CAMH,CAMV
!
      DIMENSION TIME(10),FC(10),LAMNRJ(10)
      DIMENSION MEAN(50),THICK(50)
      DIMENSION ALPHAJ(10),ALPHA(20)
      DIMENSION DELTA(10),CPRMEI(10),CPRMEO(10),SCLD(10),SCMD(10)
      DIMENSION DELTAD(10),DELTAL(10),DELTAR(10),DELTAS(10),XSOC(10),   &
     &          HSOC(10),HDELTA(10)
      DIMENSION DELJET(10),EFFJET(10),CAPINB(10),CAPOUT(10),DOBDEF(10)
      EQUIVALENCE (ALSCHD(1),ALPHA(1))
      EQUIVALENCE (CAMH,HTIN(64)),(CAMV,VTIN(64))
      EQUIVALENCE (DELTA(1),DELTAD(1),F(1)),(PHETE,F(11)),              &
     &            (CHRDFI,F(12)),(CHRDFO,F(13)),(SPANFI,F(14)),         &
     &            (SPANFO,F(15)),(NDELTA,F(16)),(FTYPE,F(17)),          &
     &            (STYPE,F(18)),(SCLD(1),DELTAL(1),F(19)),              &
     &            (SCMD(1),DELTAR(1),F(29)),(CPRMEI(1),DELTAS(1),F(39)),&
     &            (CPRMEO(1),XSOC(1),F(49)),(CB,XSPRME,F(59)),          &
     &            (TC,HSOC(1),F(60)),(PHETEP,F(61)),(NTYPE,F(62))
      EQUIVALENCE (F(1),ALITD),(F(2),XHL),(F(3),TWOTI),(F(4),CF),       &
     &            (F(5),HDELTA(1)),(F(15),LAMNR),(F(16),HNDLTA)
      EQUIVALENCE (CMU,F(63)),(DELJET(1),F(64)),                        &
     &            (JETFLP,F(74)),(EFFJET(1),F(75)),(CAPINB(1),F(85)),   &
     &            (CAPOUT(1),F(95)),(DOBDEF(1),F(105)),(DOBCIN,F(115)), &
     &            (DOBCOT,F(116))
!
!***  COMPUTATIONAL BLOCKS
!
      COMMON /CASEID/ IDCSE(74), KOUNT, NAMSV(100), DIM
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPN,SUPERS,SUBSON,    &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB,PLOT
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH,LIST
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPN,SUPERS,SUBSON,           &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB,PLOT
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH,LIST
      LOGICAL TEST
      LOGICAL  EXPSWT,SSAVE,NONE
      LOGICAL  LOGCOM(10)
      INTEGER  DIM
      EQUIVALENCE (LOGCOM(1),FLTC)
!
      DIMENSION XTYPE(4)
      DIMENSION KOL(80),NACAT(4)
      DIMENSION NAMORD(300)
      EQUIVALENCE (TIME(1),F(1)),(NT,F(11)),(FC(1),F(12)),(ALPHAJ(1),   &
     &             F(21)),(ME,F(31)),(ISP,F(32)),(SPAN,F(33)),          &
     &             (PHE,F(34)),(GP,F(35)),(CC,F(36)),(LFP,F(37)),       &
     &             (LAMNRJ(1),F(38))
      DATA XTYPE  /4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA NACAT  /4HW   , 4HH   , 4HV   , 4HF   /
      DO 1300 I=1,KOUNT
         ITR=NAMORD(I)
         IF(ITR.GT.15)ITR=ITR-1
!
!     ----TRANSFER TO CORRECT NAMELIST
!
         GO TO (1000,1010,1020,1030,1060,1070,1080,1090,1100,1110,1120, &
     &          1130,1140,1150,1160,1170,1200,1230,1240,1250,1260,1270, &
     &          1280),ITR
!
!***  READ NAMELIST FLTCON
!
 1000    CALL XNAM1(0)
         IF(TR .LE. UNUSED) TR = 0.0
         IF(TR .GT. UNUSED) TR = 1.0
         IF(STMACH .LT. 0.6) STMACH = 0.6
         IF(STMACH .GT. 0.99) STMACH = 0.99
         IF(TSMACH .LE. UNUSED) TSMACH = 1.40
         IF(TSMACH .LE. 1.01) TSMACH = 1.01
         IF(TSMACH .GT. 1.4) TSMACH = 1.4
         FLTC=.TRUE.
         GO TO 1300
!
!***  READ NAMELIST OPTIONS
!
 1010    CALL XNAM2(0)
         OPTI=.TRUE.
         GO TO 1300
!
!***  READ NAMELIST BODY
!
 1020    CALL XNAM3(0)
         BO=.TRUE.
         GO TO 1300
!
!***  READ NAMELIST WGPLNF
!
 1030    CALL XNAM4(0)
         WGPL=.TRUE.
!
!     ----CHECK FOR TYPE SET IF IN PREVIOUS NAMELIST
!
         DO 1040 L=1,4
            IF(TYPE.EQ.XTYPE(L))GO TO 1300
 1040    CONTINUE
         NXTYPE=TYPE + .5
         IF(TYPE.LT.5.0)GO TO 1050
!
!     ----PRINT ERROR
!
         WRITE(6,1460) TYPE
         NXTYPE=1
 1050    CONTINUE
         GO TO 1300
!
!***  READ NAMELIST WGSCHR
!
 1060    CALL XNAM5(0)
         WGSC=.TRUE.
         GO TO 1300
!
!***  READ NAMLIST SYNTHS
!
 1070    CALL XNAM6(0)
         SYNT=.TRUE.
         GO TO 1300
!
!***  READ NAMELIST HTPLNF
!
 1080    CALL XNAM7(0)
         HTPL=.TRUE.
         GO TO 1300
!
!***  READ NAMELIST HTSCHR
!
 1090    CALL XNAM8(0)
         HTSC=.TRUE.
         GO TO 1300
!
!***  READ NAMELIST VTPLNF
!
 1100    CALL XNAM9(0)
         VTPL=.TRUE.
         GO TO 1300
!
!***  READ NAMELIST VTSCHR
!
 1110    CALL XNAM10(0)
         VTSC=.TRUE.
         GO TO 1300
!
!***  READ NAMELIST PROPWR
!
 1120    CALL XNAM11(0)
         PRPOWR=.TRUE.
         JETPOW=.FALSE.
         GO TO 1300
!
!***  READ NAMELIST JETPWR
!
 1130    CALL XNAM12(0)
         JETPOW=.TRUE.
         PRPOWR=.FALSE.
         GO TO 1300
!
!***  READ NAMELIST LARWB
!
 1140    CALL XNAM13(0)
         LOASRT=.TRUE.
         GO TO 1300
!
!***  READ NAMELIST GRNDEF
!
 1150    CALL XNAM14(0)
         GO TO 1300
!
!***  READ NAMELIST TVTPAN
!
 1160    CALL XNAM15(0)
         TVTPN=.TRUE.
         GO TO 1300
!
!     TEST FOR ASYFLP READ PREVIOUSLY.IF SO NEGATE IT AND READ SYMFLP
!
 1170    IF(.NOT.ASYFP)GO TO 1190
         ASYFP=.FALSE.
         DO 1180 K=1,69
 1180    F(K)=UNUSED
!
!***  READ NAMELIST SYMFLP
!
 1190    SYMFP=.TRUE.
         CALL XNAM16(0)
         GO TO 1300
!
!     TEST FOR SYMFLP READ BEFORE.IF SO NEGATE IT AND READ ASYFLP
!
 1200    IF(.NOT.SYMFP)GO TO 1220
         SYMFP=.FALSE.
         DO 1210 K=1,69
 1210    F(K)=UNUSED
 1220    ASYFP=.TRUE.
!
!***  READ NAMELIST ASYFLP
!
         CALL XNAM17(0)
         GO TO 1300
!
!***  READ NAMELIST HYPEFF
!
 1230    CALL XNAM18(0)
         HYPEF=.TRUE.
         GO TO 1300
!
!***  READ NAMELIST TRNJET
!
 1240    CALL XNAM19(0)
         TRAJET=.TRUE.
         GO TO 1300
!
!***  READ NAMELIST VFPLNF
!
 1250    CALL XNAM20(0)
         VFPL = .TRUE.
         GO TO 1300
!
!***  READ NAMELIST VFSCHR
!
 1260    CALL XNAM21(0)
         VFSC = .TRUE.
         GO TO 1300
!
!***  READ NAMELIST CONTAB
!
 1270    CALL XNAM22(0)
         CTAB = .TRUE.
         GO TO 1300
 1280    READ(9,1400) (KOL(IJ),IJ=1,80)
         DO 1290 IJ=1,80
            IF(KOL(6) .EQ. NACAT(1)) NACAW(IJ)=KOL(IJ)
            IF(KOL(6) .EQ. NACAT(2)) NACAH(IJ)=KOL(IJ)
            IF(KOL(6) .EQ. NACAT(3)) NACAV(IJ)=KOL(IJ)
            IF(KOL(6) .EQ. NACAT(4)) NACAF(IJ)=KOL(IJ)
 1290    CONTINUE
         IF(KOL(6) .EQ. NACAT(1)) WGSC=.TRUE.
         IF(KOL(6) .EQ. NACAT(2)) HTSC=.TRUE.
         IF(KOL(6) .EQ. NACAT(3)) VTSC=.TRUE.
         IF(KOL(6) .EQ. NACAT(4)) VFSC=.TRUE.
 1300 END DO
      IF(.NOT.BO)GO TO 1370
!
!  CHECK BODY INPUTS TO MEET SPECIFICATIONS NOTED ABOVE
!  IN READING BODY NAMELIST DATA
!
      NNX=NX+0.5
      IF(ELLIP.EQ.0.)ELLIP=UNUSED
      IF(ELLIP.EQ.UNUSED) ELLIP=1.0
      IF(R(1).NE.UNUSED .AND. S(1).EQ.UNUSED .AND. P(1).EQ.UNUSED)      &
     &   GO TO 1310
      IF(S(1).NE.UNUSED .AND. R(1).EQ.UNUSED .AND. P(1).EQ.UNUSED)      &
     &   GO TO 1330
      IF(R(1).NE.UNUSED .AND. S(1).NE.UNUSED .AND. P(1).NE.UNUSED)      &
     &   GO TO 1350
!
!  HERE FOR RADIUS OR AREA INPUT WITH ANOTHER VARIABLE.
!  ONLY R OR S OR R,S,P CAN BE USED.  SET THE GONOGO FLAG,
!  WRITE A MESSAGE AND CONTINUE.
!
      GONOGO=.FALSE.
      WRITE(6,1510)
      GO TO 1370
!
!     HALF WIDTH, R, SPECIFIED
!
 1310 DO 1320 K=1,NNX
      S(K)=PI*R(K)**2*ELLIP
      P(K)=2*PI*R(K)*SQRT((ELLIP**2+1.)/2.)
      R(K)=R(K)*SQRT(ELLIP)
 1320 END DO
      GO TO 1370
!
!     CROSS SECTIONAL AREA, S, SPECIFIED
!
 1330 DO 1340 K=1,NNX
      R(K)=SQRT(S(K)/PI)
      P(K)=2.*PI*SQRT((S(K)/ELLIP)*(ELLIP**2+1.)/2./PI)
 1340 END DO
      GO TO 1370
!
!     R, S, AND P ALL SPECIFIED
!
 1350 DO 1360 K=1,NNX
      R(K)=R(K)*SQRT(ELLIP)
 1360 END DO
 1370 CONTINUE
!
!     ----WRITE FINAL OUTPUTS USED.
!
      IF(.NOT. LIST) GO TO 1380
        WRITE(6,1430)
        IF(FLTC)CALL XNAM1(1)
        IF(OPTI)CALL XNAM2(1)
        IF(SYNT)CALL XNAM6(1)
        IF(BO)CALL XNAM3(1)
        IF(WGPL)CALL XNAM4(1)
        IF(WGSC)CALL XNAM5(1)
        IF(HTPL)CALL XNAM7(1)
        IF(HTSC)CALL XNAM8(1)
        IF(VTPL)CALL XNAM9(1)
        IF(VTSC)CALL XNAM10(1)
        IF(VFPL)CALL XNAM20(1)
        IF(VFSC)CALL XNAM21(1)
        IF(TVTPN)CALL XNAM15(1)
        IF(PRPOWR)CALL XNAM11(1)
        IF(JETPOW)CALL XNAM12(1)
        IF(NGH.NE.UNUSED)CALL XNAM14(1)
        IF(LOASRT)CALL XNAM13(1)
        IF(SYMFP)CALL XNAM16(1)
        IF(ASYFP)CALL XNAM17(1)
        IF(HYPEF)CALL XNAM18(1)
        IF(TRAJET)CALL XNAM19(1)
 1380 CONTINUE
      IF(WGPL.AND.TYPE.EQ.UNUSED)NXTYPE=1
      IF(WGPL) TYPE     = XTYPE(NXTYPE)
      IF(HTPL) NXTYPE   = HTIN(15)+0.5
      IF(HTPL.AND.TYPE.EQ.0)NXTYPE=1
      IF(HTPL) HTIN(15) = XTYPE(NXTYPE)
      IF(VTPL) NXTYPE   = VTIN(15)+0.5
      IF(VTPL.AND.TYPE.EQ.0)NXTYPE=1
      IF(VTPL) VTIN(15) = XTYPE(NXTYPE)
      IF(VFPL) NXTYPE   = VFIN(15)+0.5
      IF(VFPL.AND.TYPE.EQ.0)NXTYPE=1
      IF(VFPL) VFIN(15) = XTYPE(NXTYPE)
!
!     ----SET SWITCHES FOR SPEED REGIMES
!
      NMCH=NMACH+.5
      DO 1390 I=1,NMCH
         IF(MACH(I).LE.STMACH)SUBSON=.TRUE.
         IF(MACH(I).GE.TSMACH)SUPERS=.TRUE.
         IF(MACH(I).GT.STMACH.AND.MACH(I).LT.TSMACH)TRANSN=.TRUE.
 1390 END DO
      RETURN
!
 1400 FORMAT(80A1)
 1410 FORMAT(1X,80A1)
 1420 FORMAT(1H1,10X,57HTHE FOLLOWING IS A LIST OF ALL INPUT CARDS FOR T&
     &HIS CASE./1H0)
 1430 FORMAT(1H1,10X,53HTHE FOLLOWING IS A LIST OF FINAL INPUTS FOR THIS&
     & CASE/1H0)
 1440 FORMAT(66H -ERROR--NUMBER OF NAMELISTS IN A SERIES OF SAVE CASES E&
     &XCEEDS 300)
 1450 FORMAT(13H1 END OF JOB.)
 1460 FORMAT(42H ERROR TYPE CANNOT BE GREATER THAN 4.TYPE=,E12.5,       &
     & 9HSET TO 1.)
 1470 FORMAT(41H0 *** WARNING *** THIS IS A SAVE CASE AND,              &
     &       38H THE DIMENSION SYSTEM HAS BEEN CHANGED/)
 1480 FORMAT(20H ERROR IN CARD BELOW/1H ,80A1)
 1490 FORMAT(27H ERROR(S),THIS CASE NOT RUN/1H1)
 1500 FORMAT(21H ERROR-THE CARD BELOW/1H ,80A1/53H CONTAINS ILLEGAL VARI&
     &ABLE NAME TO BE DUMPED.NAME IS ,30A1)
 1510 FORMAT(47H1***** THE BODY IS NOT ADEQUATELY DEFINED *****,/,      &
     & 75H IN NAMELIST BODY, ONLY THE FOLLOWING COMBINATIONS OF VARIABLE&
     &S CAN BE USED,/,48H FOR A CIRCULAR BODY, SPECIFY X AND R OR X AND &
     &S,/,75H FOR AN ELLIPTICAL BODY, SPECIFY X AND R OR X AND S, AND TH&
     &E VARIABLE ELLIP,/,59H FOR OTHER BODY SHAPES X, R, S, AND P MUST A&
     &LL BE SPECIFIED,/)
      END
      SUBROUTINE INPUTC(JRETRN,I,KOL,NAMORD,ISDIM,SSAVE)
!
!***  SUBROUTINE READS CONTROL CARDS AND SETS FLAGS
!
!    INPUT DATA BLOCKS
!
      COMMON /FLGTCD/ NMACH,NALPHA,MACH(20),ALSCHD(20),RNNUB(20),NGH    &
     &                ,GRDHT(10),PINF(20),STMACH,TSMACH,TR,ALT(20)      &
     &                ,TINF(20),VINF(20),WT,GAMMA,NALT,LOOP
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV,YF,        &
     &                PHIV, PHIF
      COMMON /BODYI/  NX,X(20),S(20),P(20),R(20),ZU(20),ZL(20),         &
     &                BNOSE,BTAIL,BLN,BLA,DS,ITYPE,METHOD,ELLIP
      COMMON /WINGI/  CHRDTP,SSPNOP,SSPNE,SSPN,CHRDBP,CHRDR,SAVSI,SAVSO,&
     &                CHSTAT,ALPHAO,TWISTA,SSPNDD,DHDADI,DHDADO,        &
     &                TYPE,                                             &
     &                TOVC,DELTAY,XOVC,CLI,ALPHAI,CLALPA(20),           &
     &                CLMAX(20),CMO,LERI,LERO,CAMBER,TOVCO,XOVCO,CMOT,  &
     &                CLMAXL,CLAMO,TCEFF,KSHARP,XAC(20),ARCL,YCM,CLD,   &
     &                SLOPE(6),DWASH
      COMMON /HTI/    HTIN(154)
      COMMON /VTI/    VTIN(154),BVP,BV,BDV,BH,SV,VPHITE,VLP,ZP,         &
     &                VFIN(154)
      COMMON /POWER/  AIETLP,NENGSP,THSTCP,PHALOC,PHVLOC,PRPRAD,ENGFCT, &
     &                BWAPR3,BWAPR6,BWAPR9,NOPBPE,BAPR75,               &
     &                AIETLJ,NENGSJ,THSTCJ,JIALOC,JEVLOC,JEALOC,        &
     &                JINLTA,JEANGL,JEVELO,AMBTMP,JESTMP,JELLOC,        &
     &                JETOTP,AMBSTP,JERAD,YP,CROT,                      &
     &                LBIN(21)
      COMMON /FLAPIN/ F(116),TTYPE,CFITC,CFOTC,BITC,BOTC,CFITT,CFOTT,   &
     &                BITT,BOTT,B1,B2,B3,B4,D1,D2,D3,GCMAX,             &
     &                KS,RL,BGR,DELR
      COMMON /WINGD/  A(195)
      COMMON /IBW/    PBW(131),TYPEIN,NACAW(80),NPTS,XCORD(50),         &
     &                YUPPER(50),YLOWER(50),dum5(98)
      COMMON /IBH/    PBH(131),HTYPE,NACAH(80), dum6(168)
      COMMON /IBV/    PBV(131),VTYPE,NACAV(80), dum7(168)
      COMMON /IVF/    PVF(131),VFTYP,NACAF(80), dum17(168)
!
      REAL NTYPE,NDELTA,NPTS,MEAN,ITYPE,JETFLP
      REAL LERI,LERO
      REAL NT,ME,ISP,LFP
      REAL NENGSP,NOPBPE,NENGSJ,JIALOC,JEVLOC,JEALOC,JINLTA,JEANGL,     &
     &     JEVELO,JESTMP,JELLOC,JETOTP,JERAD,KSHARP
      REAL NMACH,MACH,NALPHA,NGH
      REAL NX,LAFB,METHOD,NALT,LOOP,KS
!
      LOGICAL LAMNRJ
      LOGICAL VERTUP
      LOGICAL CROT,LAMNR
      LOGICAL CAMBER,CAMH,CAMV
!
      DIMENSION MEAN(50),THICK(50)
      DIMENSION TIME(10),FC(10),ALPHA(10),LAMNRJ(10)
      DIMENSION DELTA(10),CPRMEI(10),CPRMEO(10),SCLD(10),SCMD(10)
      DIMENSION DELTAD(10),DELTAL(10),DELTAR(10),DELTAS(10),XSOC(10),   &
     &          HSOC(10),HDELTA(10)
      DIMENSION DELJET(10),EFFJET(10),CAPINB(10),CAPOUT(10),DOBDEF(10)
      EQUIVALENCE (CAMH,HTIN(64)),(CAMV,VTIN(64))
      EQUIVALENCE (DELTA(1),DELTAD(1),F(1)),(PHETE,F(11)),              &
     &            (CHRDFI,F(12)),(CHRDFO,F(13)),(SPANFI,F(14)),         &
     &            (SPANFO,F(15)),(NDELTA,F(16)),(FTYPE,F(17)),          &
     &            (STYPE,F(18)),(SCLD(1),DELTAL(1),F(19)),              &
     &            (SCMD(1),DELTAR(1),F(29)),(CPRMEI(1),DELTAS(1),F(39)),&
     &            (CPRMEO(1),XSOC(1),F(49)),(CB,XSPRME,F(59)),          &
     &            (TC,HSOC(1),F(60)),(PHETEP,F(61)),(NTYPE,F(62))
      EQUIVALENCE (F(1),ALITD),(F(2),XHL),(F(3),TWOTI),(F(4),CF),       &
     & (F(5),HDELTA(1)),(F(15),LAMNR),(F(16),HNDLTA)
      EQUIVALENCE (TIME(1),F(1)),(NT,F(11)),                            &
     & (FC(1),F(12)),(ALPHA(1),F(22)),    (ME,F(32)),(ISP,F(33)),       &
     & (SPAN,F(34)),(PHE,F(35)),(GP,F(36)),(CC,F(37)),(LFP,F(38)),      &
     & (LAMNRJ(1),F(39)),(CMU,F(63)),(DELJET(1),F(64)),                 &
     & (JETFLP,F(74)),(EFFJET(1),F(75)),(CAPINB(1),F(85)),              &
     & (CAPOUT(1),F(95)),(DOBDEF(1),F(105)),(DOBCIN,F(115)),            &
     & (DOBCOT,F(116))
      EQUIVALENCE (CMO,CM0),(CMOT,CM0T),(CLAMO,CLAM0)
      EQUIVALENCE (MEAN(1),YUPPER(1)),(THICK(1),YLOWER(1))
      EQUIVALENCE (ALPHAO,ALPHA0)
!
!***  COMPUTATIONAL BLOCKS
!
      COMMON /CASEID/ IDCSE(74), KOUNT, NAMSV(100), DIM
      COMMON /BDATA/  BD(762)
      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,          &
     &                KBODY, KWING, KHT, KVT, KWB, KDWASH(3),           &
     &                ALPOW, ALPLW, ALPOH, ALPLH
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPN,SUPERS,SUBSON,    &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB,PLOT
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH,LIST,LEXTRP
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPN,SUPERS,SUBSON,           &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB,PLOT
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH,LIST,LEXTRP
      LOGICAL TEST
      LOGICAL  EXPSWT,SSAVE,NONE
      LOGICAL  LOGCOM(10), LEQV(81)
      INTEGER  DIM, IDCSE, KASE(6)
      INTEGER EXTRAP
      EQUIVALENCE (BD(81),ALPCA)
      EQUIVALENCE (LEQV(1),IERR)
      EQUIVALENCE (LOGCOM(1),FLTC)
!
      DIMENSION EXTRAP(12)
      DIMENSION XTYPE(4),NUM(10),IDIM(3),IDIMT(8),NMLIST(8)
      DIMENSION NCHR(23),NLOC(23),NK(24)
      DIMENSION KOL(80),ISAVE(4),NEXT(9),KEY(138),ITRIM(4),IDAMP(4)
      DIMENSION IBUILD(5),INACA(4),NACAT(4),IDERD(9),IDERR(9)
      DIMENSION NAMORD(300),IPART(4)
      DIMENSION IDMP(8),IDMC(4),IPLOT(4)
      DIMENSION KEYDP(224),  NDP(75)
      DIMENSION KEYARY(136), NDPARY(48)
      DIMENSION KEYINP(47),  NDPINP(13)
      DIMENSION KEYIOM(41),  NDPIOM(14)
      EQUIVALENCE (KEYDP( 1 ),KEYARY(1)), (NDP(1 ),NDPARY(1))
      EQUIVALENCE (KEYDP(137),KEYINP(1)), (NDP(49),NDPINP(1))
      EQUIVALENCE (KEYDP(184),KEYIOM(1)), (NDP(62),NDPIOM(1))
      DATA XTYPE  /4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA NCHR   /2*6,4,9*6,5,2*6,4,7*6/
      DATA NK     /24*0/
      DATA NLOC   /4,10,16,20,26,32,38,44,50,56,62,68,74,79,85,91,97,   &
     &             103,109,115,121,127,133 /
      DATA NNAM   /23/
!
      DATA EXTRAP /4HP   ,4HR   ,4HI   ,4HN   ,4HT   ,4H    ,           &
     &             4HE   ,4HX   ,4HT   ,4HR   ,4HA   ,4HP   /
      DATA IBUILD /4HB   ,4HU   ,4HI   ,4HL   ,4HD   /
      DATA INACA  /4HN   ,4HA   ,4HC   ,4HA   /
      DATA NACAT  /4HW   ,4HH   ,4HV   ,4HF   /
      DATA IDERD  /4HD   ,4HE   ,4HR   ,4HI   ,4HV   ,4H    ,           &
     &             4HD   ,4HE   ,4HG   /
      DATA IDERR  /4HD   ,4HE   ,4HR   ,4HI   ,4HV   ,4H    ,           &
     &             4HR   ,4HA   ,4HD   /
      DATA IPART  /4HP   ,4HA   ,4HR   ,4HT   /
      DATA IDIM   /4HD   ,4HI   ,4HM    /
      DATA IDIMT  /4HF   ,4HT   ,4HI   ,4HN   ,4HM   ,4H    ,           &
     &             4HC   ,4HM   /
      DATA NMLIST /4HN   ,4HA   ,4HM   ,4HE   ,4HL   ,                  &
     &             4HI   ,4HS   ,4HT   /
      DATA KASE   /4HC   ,4HA   ,4HS   ,4HE   ,4HI   ,4HD   /
      DATA ISAVE  /4HS   ,4HA   ,4HV   ,4HE    /
      DATA NEXT   /4HN   ,4HE   ,4HX   ,4HT   ,4H    ,4HC   ,4HA   ,    &
     &             4HS   ,4HE   /
      DATA IDMP   /4HD   ,4HU   ,4HM   ,4HP   ,4H    ,4HA   ,4HL   ,    &
     &             4HL   /
      DATA IDMC   /4HC   ,4HA   ,4HS   ,4HE   /
      DATA IPLOT  /4HP   ,4HL   ,4HO   ,4HT   /
      DATA IBLNK  /4H    /,KOMMA /4H,   /
      DATA ITRIM  /4HT   ,4HR   ,4HI   ,4HM   /
      DATA IDAMP  /4HD   ,4HA   ,4HM   ,4HP   /
      DATA NUM    /4H0   ,4H1   ,4H2   ,4H3   ,4H4   ,4H5   ,4H6   ,    &
     &             4H7   ,4H8   ,4H9   /
      DATA KEYARY  /                                                    &
     &       4HB   ,4HA   ,4HB   ,4HD   ,4HA   ,4HV   ,4HF   ,4HF   ,   &
     &       4HA   ,4HC   ,4HT   ,4HW   ,4HB   ,4HT   ,4HB   ,4HH   ,   &
     &       4HT   ,4HA   ,4HV   ,4HT   ,4HA   ,4HH   ,4HT   ,4HC   ,   &
     &       4HD   ,4HW   ,4HB   ,4HC   ,4HH   ,4HT   ,4HD   ,4HH   ,   &
     &       4HT   ,4HD   ,4HY   ,4HN   ,4HH   ,4HD   ,4HV   ,4HT   ,   &
     &       4HG   ,4HR   ,4HL   ,4HB   ,4HP   ,4HW   ,4HS   ,4HT   ,   &
     &       4HB   ,4HS   ,4HB   ,4HD   ,4HS   ,4HL   ,4HG   ,4HS   ,   &
     &       4HW   ,4HB   ,4HS   ,4HT   ,4HP   ,4HD   ,4HW   ,4HA   ,   &
     &       4HS   ,4HT   ,4HG   ,4HS   ,4HL   ,4HA   ,4HT   ,4HR   ,   &
     &       4HA   ,4HX   ,4HP   ,4HD   ,4HD   ,4HV   ,4HF   ,4HF   ,   &
     &       4HL   ,4HP   ,4HF   ,4HH   ,4HG   ,4HF   ,4HC   ,4HM   ,   &
     &       4HT   ,4HC   ,4HD   ,4HF   ,4HL   ,4HA   ,4HT   ,4HR   ,   &
     &       4HM   ,4HS   ,4HP   ,4HR   ,4HT   ,4HR   ,4HN   ,4HT   ,   &
     &       4HR   ,4HM   ,4H2   ,4HH   ,4HY   ,4HP   ,4HD   ,4HY   ,   &
     &       4HN   ,4HJ   ,4HE   ,4HT   ,4HH   ,4HB   ,4HS   ,4HH   ,   &
     &       4HB   ,4HT   ,4HR   ,4HA   ,4HH   ,4HS   ,4HT   ,4HB   ,   &
     &       4HH   ,4HS   ,4HE   ,4HC   ,4HS   ,4HL   ,4HA   ,4HH   /
      DATA NDPARY / 1,1,2,3,4,4*3,2*1,2,2*3,4,3,3*2,19*3,4,3*3,2,3,     &
     &              4,4,3,4 /
!
      DATA KEYINP  /                                                    &
     &       4HI   ,4HN   ,4HP   ,4HT   ,4HF   ,4HL   ,4HC   ,4HO   ,   &
     &       4HP   ,4HT   ,4HN   ,4HS   ,4HY   ,4HN   ,4HA   ,4HB   ,   &
     &       4HD   ,4HI   ,4HN   ,4HW   ,4HG   ,4HI   ,4HN   ,4HV   ,   &
     &       4HT   ,4HI   ,4HN   ,4HT   ,4HV   ,4HT   ,4HV   ,4HF   ,   &
     &       4HI   ,4HN   ,4HH   ,4HT   ,4HI   ,4HN   ,4HP   ,4HW   ,   &
     &       4HI   ,4HN   ,4HL   ,4HB   ,4HI   ,4HN   ,4HF   /
      DATA NDPINP / 4,3,5*4,3,4*4,1 /
!
      DATA KEYIOM  /                                                    &
     &       4HI   ,4HO   ,4HM   ,4HB   ,4HO   ,4HD   ,4HY   ,4HW   ,   &
     &       4HI   ,4HN   ,4HG   ,4HH   ,4HT   ,4HV   ,4HT   ,4HV   ,   &
     &       4HF   ,4HB   ,4HW   ,4HB   ,4HH   ,4HB   ,4HV   ,4HB   ,   &
     &       4HW   ,4HH   ,4HB   ,4HW   ,4HV   ,4HB   ,4HW   ,4HH   ,   &
     &       4HV   ,4HP   ,4HO   ,4HW   ,4HR   ,4HD   ,4HW   ,4HS   ,   &
     &       4HH   /
      DATA NDPIOM / 3,4,4,6*2,3,3,4,4,4 /
      DATA KEY     /                                                    &
     &       4HE   ,4HN   ,4HD   ,4HF   ,4HL   ,4HT   ,4HC   ,4HO   ,   &
     &       4HN   ,4HO   ,4HP   ,4HT   ,4HI   ,4HN   ,4HS   ,4HB   ,   &
     &       4HO   ,4HD   ,4HY   ,4HW   ,4HG   ,4HP   ,4HL   ,4HN   ,   &
     &       4HF   ,4HW   ,4HG   ,4HS   ,4HC   ,4HH   ,4HR   ,4HS   ,   &
     &       4HY   ,4HN   ,4HT   ,4HH   ,4HS   ,4HH   ,4HT   ,4HP   ,   &
     &       4HL   ,4HN   ,4HF   ,4HH   ,4HT   ,4HS   ,4HC   ,4HH   ,   &
     &       4HR   ,4HV   ,4HT   ,4HP   ,4HL   ,4HN   ,4HF   ,4HV   ,   &
     &       4HT   ,4HS   ,4HC   ,4HH   ,4HR   ,4HP   ,4HR   ,4HO   ,   &
     &       4HP   ,4HW   ,4HR   ,4HJ   ,4HE   ,4HT   ,4HP   ,4HW   ,   &
     &       4HR   ,4HL   ,4HA   ,4HR   ,4HW   ,4HB   ,4HG   ,4HR   ,   &
     &       4HN   ,4HD   ,4HE   ,4HF   ,4HT   ,4HV   ,4HT   ,4HP   ,   &
     &       4HA   ,4HN   ,4HE   ,4HX   ,4HP   ,4HR   ,4H    ,4H    ,   &
     &       4HS   ,4HY   ,4HM   ,4HF   ,4HL   ,4HP   ,4HA   ,4HS   ,   &
     &       4HY   ,4HF   ,4HL   ,4HP   ,4HH   ,4HY   ,4HP   ,4HE   ,   &
     &       4HF   ,4HF   ,4HT   ,4HR   ,4HN   ,4HJ   ,4HE   ,4HT   ,   &
     &       4HV   ,4HF   ,4HP   ,4HL   ,4HN   ,4HF   ,4HV   ,4HF   ,   &
     &       4HS   ,4HC   ,4HH   ,4HR   ,4HC   ,4HO   ,4HN   ,4HT   ,   &
     &       4HA   ,4HB   /
!
!     ----TEST FOR NEXT CASE OR DUMP REQUEST CARD.
!
      DO 1000 I=1,9
         IF(KOL(I).NE.NEXT(I)) GO TO 1010
 1000 END DO
      GO TO 1450
!
 1010 DO 1020 I=1,8
         IF(KOL(I).NE.IDMP(I)) GO TO 1040
 1020 END DO
!
!     ----TEST TO BE SURE THE REST OF THE CARD IS BLANK
!
      DO 1030 I=9,80
         IF(KOL(I).NE.IBLNK) GO TO 1070
 1030 END DO
      DMPALL=.TRUE.
      GO TO 1430
!
!     ----TEST FOR KEY WORD DUMP
!
 1040 IF(I.LT.6) GO TO 1160
!
!     ----TEST FOR DUMP CASE CARD
!
      J=1
      DO 1050 L=6,9
         IF(KOL(L).NE.IDMC(J)) GO TO 1070
 1050 J=J+1
!
!     ----TEST FOR REST OF CARD BLANK
!
      DO 1060 I=10,80
         IF(KOL(I).NE.IBLNK) GO TO 1070
 1060 END DO
      DMPCSE=.TRUE.
      GO TO 1430
 1070 I=5
 1080 I=I+1
      IF(I.GT.80) GO TO 1430
      IF(KOL(I).EQ.IBLNK.OR.KOL(I).EQ.KOMMA)GO TO 1080
      NS=I
      NCHAR=1
 1090 I=I+1
      IF(I.GT.80)GO TO 1100
      IF(KOL(I).EQ.IBLNK.OR.KOL(I).EQ.KOMMA) GO TO 1100
      NCHAR=NCHAR+1
      GO TO 1090
 1100 IF(NCHAR.LT.7) GO TO 1120
!
!     ----HERE FOR ERROR
!
 1110 M=I-1
      WRITE(6,1490)(KOL(J),J=1,80),(KOL(J),J=NS,M)
      GO TO 1150
 1120 ISAV=KOL(NS+NCHAR)
      KOL(NS+NCHAR)=IBLNK
      LOCDP = 1
      DO 1130 J=1,75
         IF(TEST(KOL(NS),KEYDP(LOCDP),NDP(J)))GO TO 1140
         LOCDP = LOCDP+NDP(J)
 1130 END DO
      KOL(NS+NCHAR)=ISAV
      GO TO 1110
 1140 IF(J.GT.15)J=J+2
      LEQV(J+4)=.TRUE.
      KOL(NS+NCHAR)=ISAV
 1150 IF(I.GT.80)GO TO 1430
      GO TO 1080
!
!     ----TEST FOR SAVE CARD
!
 1160 DO 1170 I=1,4
         IF(KOL(I).NE.ISAVE(I))GO TO 1180
 1170 END DO
      SAVE=.TRUE.
      GO TO 1430
!
!     ----TEST FOR CASE IDENTIFICATION CARDS
!
 1180 DO 1190 I=1,6
         IF(KOL(I).NE.KASE(I))GO TO 1210
 1190 END DO
!
!     ----STORE IDENTIFICATION
!
      DO 1200 I=7,80
 1200 IDCSE(I-6)=KOL(I)
      HEAD=.TRUE.
      GO TO 1430
 1210 DO 1220 I=1,4
         IF(KOL(I).NE.ITRIM(I))GO TO 1230
 1220 END DO
      TRIMC=.TRUE.
      GO TO 1430
 1230 DO 1240 I=1,4
         IF(KOL(I).NE.IDAMP(I))GO TO 1250
 1240 END DO
      DAMP=.TRUE.
      GO TO 1430
 1250 DO 1260 I=1,4
         IF(KOL(I) .NE. IPART(I)) GO TO 1270
 1260 END DO
      PART=.TRUE.
      GO TO 1430
!
!***  TEST FOR - PRINT EXTRAP CARD
!
 1270 DO 1280 I=1,12
         IF(KOL(I) .NE. EXTRAP(I)) GO TO 1290
 1280 END DO
      LEXTRP=.TRUE.
      GO TO 1430
 1290 DO 1300 I=1,5
         IF(KOL(I) .NE. IBUILD(I)) GO TO 1310
 1300 END DO
      BUILD=.TRUE.
      GO TO 1430
 1310 DO 1320 I=1,4
         IF(KOL(I) .NE. INACA(I)) GO TO 1330
 1320 END DO
      I=24
      GO TO 1440
 1330 DO 1340 I=1,9
         IF(KOL(I) .NE. IDERD(I)) GO TO 1350
 1340 END DO
      DRCONV = .FALSE.
      GO TO 1430
 1350 DO 1360 I=1,9
         IF(KOL(I) .NE. IDERR(I)) GO TO 1370
 1360 END DO
      DRCONV = .TRUE.
      GO TO 1430
 1370 CONTINUE
      DO 1380 I=1,3
         IF(KOL(I) .NE. IDIM(I)) GO TO 1390
 1380 END DO
      DIM = 0
      IF((KOL(5) .EQ. IDIMT(1)) .AND. (KOL(6) .EQ. IDIMT(2))) DIM = 1
      IF((KOL(5) .EQ. IDIMT(3)) .AND. (KOL(6) .EQ. IDIMT(4))) DIM = 2
      IF((KOL(5) .EQ. IDIMT(5)) .AND. (KOL(6) .EQ. IDIMT(6))) DIM = 3
      IF((KOL(5) .EQ. IDIMT(7)) .AND. (KOL(6) .EQ. IDIMT(8))) DIM = 4
      IF(SSAVE .AND. (ISDIM .NE. DIM)) WRITE(6,1470)
      IF(DIM .NE. 0) GO TO 1430
      GO TO 1410
 1390 CONTINUE
      DO 1400 I=1,8
         IF(KOL(I) .NE. NMLIST(I)) GO TO 1410
 1400 END DO
      LIST = .TRUE.
      GO TO 1430
 1410 CONTINUE
      DO 1420 I=1,4
         IF(KOL(I) .NE. IPLOT(I)) GO TO 1460
 1420 END DO
      PLOT = .TRUE.
 1430 JRETRN=1
      RETURN
 1440 JRETRN=2
      RETURN
 1450 JRETRN=3
      RETURN
 1460 CONTINUE
      GONOGO = .FALSE.
      WRITE(6,1480)(KOL(I),I=1,80)
      JRETRN=4
      RETURN
!
 1470 FORMAT(41H0 *** WARNING *** THIS IS A SAVE CASE AND,              &
     &       38H THE DIMENSION SYSTEM HAS BEEN CHANGED/)
 1480 FORMAT(20H ERROR IN CARD BELOW/1H ,80A1)
 1490 FORMAT(21H ERROR-THE CARD BELOW/1H ,80A1/53H CONTAINS ILLEGAL VARI&
     &ABLE NAME TO BE DUMPED.NAME IS ,30A1)
      END
      SUBROUTINE INTEP3(ARG1,ARG2,LAMDA,A1,A2,YA,N1A,N2A,QA,B1,B2,YB,   &
     &            N1B,N2B,QB,C1,C2,YC,N1C,N2C,QC,D1,D2,YD,N1D,N2D,QD,   &
     &            E1,E2,YE,N1E ,N2E,QE,ANS)
!
!***  TABLE LOOKUP ROUTINE FOR A SPECIFIC TABLE
!
      DIMENSION A1(2),A2(2),YA(2),QA(3),B1(2),B2(2),YB(2),QB(3),C1(2),  &
     &          C2(2),YC(2),QC(3),D1(2),D2(2),YD(2),QD(3),              &
     &          E1(2),E2(2),YE(2),QE(3) ,AA(2)
      REAL LAMDA
      DIMENSION ROUTID(2)
      DATA ROUTID/4HINTE,4HP3  /
      IF(LAMDA.EQ.0.)IT=1
      IF(LAMDA.GT.0.0.AND.LAMDA.LE.0.25)IT=2
      IF(LAMDA.GT.0.25.AND.LAMDA.LE.0.50)IT=3
      IF(LAMDA.GT.0.50.AND.LAMDA.LE.0.75)IT=4
      IF(LAMDA.GT.0.75.AND.LAMDA.LE.1.00)IT=5
      IF((IT.EQ.4.OR.IT.EQ.5).AND.N2D.EQ.1)IT=6
      DO 1050 K=1,2
         GO TO(1000,1010,1020,1030,1040,1040),IT
!
!    ----HERE FOR 0.0 LAMDA
!
 1000    CONTINUE
         IF(K.EQ.1)X1=0.0
         CALL TLIP2X(A1,A2,YA,N1A,N2A,ARG1,ARG2,AA(K),                  &
     &               0,0,0,0,QA,3,ROUTID)
         X2=X1+1.
         GO TO 1050
!
!    ----HERE FOR 0.25 LAMDA
!
 1010    IF(IT.EQ.2.AND.K.EQ.1)GO TO 1000
         IF(K.EQ.1)X1=0.25
         CALL TLIP2X(B1,B2,YB,N1B,N2B,ARG1,ARG2,AA(K),                  &
     &               0,0,0,0,QB,3,ROUTID)
         X2=0.25
         GO TO 1050
!
!    ----HERE FOR 0.50 LAMDA
!
 1020    IF(IT.EQ.3.AND.K.EQ.1)GO TO 1010
         IF(K.EQ.1)X1=0.50
         CALL TLIP2X(C1,C2,YC,N1C,N2C,ARG1,ARG2,AA(K),                  &
     &               0,0,0,0,QC,3,ROUTID)
         X2=0.50
         GO TO 1050
!
!    ----HERE FOR 0.75 LAMDA
!
 1030    IF(IT.EQ.4.AND.K.EQ.1)GO TO 1020
         IF(K.EQ.1)X1=0.75
         CALL TLIP2X(D1,D2,YD,N1D,N2D,ARG1,ARG2,AA(K),                  &
     &               0,0,0,0,QD,3,ROUTID)
         X2=0.75
         GO TO 1050
!
!    ----HERE FOR 1.0 LAMDA
!
 1040    IF(IT.EQ.5.AND.K.EQ.1)GO TO 1030
         IF(IT.EQ.6.AND.K.EQ.1)GO TO 1020
         CALL TLIP2X(E1,E2,YE,N1E,N2E,ARG1,ARG2,AA(K),                  &
     &               0,0,0,0,QE,3,ROUTID)
         X2=1.00
 1050 END DO
      ARG=(LAMDA-X1)/(X2-X1)
      ANS= AA(1)+(AA(2)-AA(1))*ARG
      RETURN
      END
      SUBROUTINE INTER3(ARG1,ARG2,RL   ,A1,A2,YA,N1A,N2A,QA,B1,B2,YB,   &
     &            N1B,N2B,QB,C1,C2,YC,N1C,N2C,QC,D1,D2,YD,N1D,N2D,QD,   &
     &            E1,E2,YE,N1E,N2E,QE,ANS)
!
!***  TABLE LOOKUP ROUTINE FOR SPECIFIC TABLE
!
      DIMENSION A1(2),A2(2),YA(2),QA(3),B1(2),B2(2),YB(2),QB(3),C1(2),  &
     &          C2(2),YC(2),QC(3),D1(2),D2(2),YD(2),QD(3),E1(2),E2(2),  &
     &          YE(2),QE(3),AA(2)
      DIMENSION ROUTID(2)
      DATA ROUTID/4HINTE,4HR3  /
      IF(RL.LE.1E5)IT=1
      IF(RL.GT.1E5.AND.RL.LE.1E6)IT=2
      IF(RL.GT.1E6.AND.RL.LE.1E7)IT=3
      IF(RL.GT.1E7.AND.RL.LE.1E8)IT=4
      IF(RL.GT.1E8.AND.RL.LE.1E9)IT=5
      IF(RL.GT.1E9)IT=6
      DO 1050 K=1,2
         GO TO(1000,1010,1020,1030,1040,1040),IT
!
!    ----HERE FOR RL=1E5
!
 1000   CONTINUE
         IF(K.EQ.1)X1=1E5
         CALL TLINEX(A1,A2,YA,N1A,N2A,ARG1,ARG2,AA(K),                  &
     &               0,0,0,0,QA,3,ROUTID)
         X2=X1+1.
         GO TO 1050
!
!    ----HERE FOR RL=1E6
!
 1010    IF(IT.EQ.2.AND.K.EQ.1)GO TO 1000
         IF(K.EQ.1)X1=1E6
         CALL TLINEX(B1,B2,YB,N1B,N2B,ARG1,ARG2,AA(K),                  &
     &               0,0,0,0,QB,3,ROUTID)
         X2=1E6
         GO TO 1050
!
!    ----HERE FOR RL=1E7
!
 1020    IF(IT.EQ.3.AND.K.EQ.1)GO TO 1010
         IF(K.EQ.1)X1=1E7
         CALL TLINEX(C1,C2,YC,N1C,N2C,ARG1,ARG2,AA(K),                  &
     &               0,0,0,0,QC,3,ROUTID)
          X2=1E7
         GO TO 1050
!
!    ----HERE FOR RL=1E8
!
 1030    IF(IT.EQ.4.AND.K.EQ.1)GO TO 1020
         IF(K.EQ.1)X1=1E8
         CALL TLINEX(D1,D2,YD,N1D,N2D,ARG1,ARG2,AA(K),                  &
     &               0,0,0,0,QD,3,ROUTID)
         X2=1E8
         GO TO 1050
!
!    ----HERE FOR RL=1E9
!
 1040    IF(IT.EQ.5.AND.K.EQ.1)GO TO 1030
         IF(K.EQ.1)X1=1E9
         CALL TLINEX(E1,E2,YE,N1E,N2E,ARG1,ARG2,AA(K),                  &
     &               0,0,0,0,QE,3,ROUTID)
         X2=1E9
         IF(IT.EQ.6)ANS=AA(1)
         IF(IT.EQ.6)RETURN
 1050 END DO
      ARG=(RL-X1)/(X2-X1)
      ANS= AA(1)+(AA(2)-AA(1))*ARG
      RETURN
      END
      SUBROUTINE INTERM(IFLAG,NALPHA,ALPHA,ARRAY,NDMF,NAF)
!
!***  INTERMDIATE LOGIC FOR OUTPUT
!
      REAL NDM
      LOGICAL NDMF,NAF
      DIMENSION ALPHA(1),ARRAY(1),XCP(20)
      DIMENSION ICONT(12),ICONT2(4),ICONT3(10),FOR(50),FOR2(18)         &
     &         ,FOR3(42)
      COMMON /CONSNT/ CONST(5)
      EQUIVALENCE(CONST(3),UNUSED)
      DATA ICONT/7,8,8,9,3*8,5*10/,ICONT2/3*9,10/,ICONT3/9,9*10/
      DATA NW/50/,NW2/18/,NW3/42/
      DATA FOR /                                                        &
     & 4H(0P ,4H1X  ,4H,1X,,4HF5. ,4H1,1X,4H,1X ,4H,1X,,4HF6. ,4H3,1X,  &
     & 4H,1X ,4H,1X,,4HF6. ,4H3,1X,4H,1X ,4H,1X,,4HF7. ,4H4,1X,4H    ,  &
     & 4H,1X,,4HF6. ,4H3,1X,4H,1X ,4H,1X,,4HF6. ,4H3,1X,4H,1X ,4H,1X,,  &
     & 4HF6. ,4H3,1X,4H,2X ,4H,1P ,4HE10.,4H3   ,4H,3X ,4H,1P ,4HE10.,  &
     & 4H3   ,4H,3X ,4H,1P ,4HE10.,4H3   ,4H,3X ,4H,1P ,4HE10.,4H3   ,  &
     & 4H,3X ,4H,1P ,4HE10.,4H3   ,4H)   /
      DATA FOR2 /                                                       &
     & 4H(   ,4H34X ,4H,2X,,4HF5. ,4H1,2X,4H,2X ,4H,2X,,4HF5. ,4H3,2X,  &
     & 4H,1X ,4H,1X,,4HF7. ,4H3,1X,4H,4X ,4H,2X,,4HF6. ,4H3,2X,4H)   /
      DATA FOR3/                                                        &
     & 4H(0P ,4H1X  ,4H,1X,,4HF7. ,4H2,1X,4H,2X ,4H,1P ,4HE10.,4H3   ,  &
     & 4H,3X ,4H,1P ,4HE10.,4H3   ,4H,4X ,4H,1P ,4HE10.,4H3   ,4H,3X ,  &
     & 4H,1P ,4HE10.,4H3   ,4H,3X ,4H,1P ,4HE10.,4H3   ,4H,3X ,4H,1P ,  &
     & 4HE10.,4H3   ,4H,3X ,4H,1P ,4HE10.,4H3   ,4H,3X ,4H,1P ,4HE10.,  &
     & 4H3   ,4H,3X ,4H,1P ,4HE10.,4H3   ,4H)   /
!
      GO TO (1000,1080,1090),IFLAG
 1000 KXCP=1
      DO 1070 I=1,NALPHA
          IF(KXCP.EQ.2) GO TO 1040
          IF(ARRAY(I+40).EQ.UNUSED.OR.ARRAY(I+60).EQ.UNUSED) GO TO 1030
          IF(ARRAY(I+40).NE.2*UNUSED) GO TO 1010
              XCP(I)=2*UNUSED
              GO TO 1070
 1010     IF(ARRAY(I+40).EQ.-UNUSED.OR.ARRAY(I+60).EQ.-UNUSED)GO TO 1020
              XCP(I)=1.0E20
              IF(ARRAY(I+60).NE.0) XCP(I)=ARRAY(I+40)/ARRAY(I+60)
              GO TO 1070
 1020     CONTINUE
              XCP(I)=-UNUSED
              GO TO 1070
 1030     KXCP=2
 1040     IF(ARRAY(I+120).EQ.UNUSED.OR.ARRAY(I+100).EQ.UNUSED) GO TO 106&
     &0
          IF(ARRAY(I+120).EQ.-UNUSED.OR.ARRAY(I+100).EQ.-UNUSED)        &
     &       GO TO 1050
              XCP(I)=1.0E20
              IF(ARRAY(I+100).NE.0) XCP(I)=ARRAY(I+120)/ARRAY(I+100)
              GO TO 1070
 1050     CONTINUE
              XCP(I)=-UNUSED
              GO TO 1070
 1060     CONTINUE
              XCP(I)=UNUSED
 1070 END DO
      NDMF=.FALSE.
      NAF=.FALSE.
          CALL SWRITE(12,FOR,NW,ICONT,NALPHA,ALPHA,ARRAY(1),ARRAY(21)   &
     &       ,ARRAY(41),ARRAY(61),ARRAY(81),XCP,ARRAY(101),ARRAY(121)   &
     &       ,ARRAY(141),ARRAY(161),ARRAY(181),S,T,NDMF,NAF)
      RETURN
 1080 CONTINUE
          CALL SWRITE(4,FOR2,NW2,ICONT2,NALPHA,ALPHA,ARRAY(1),ARRAY(21) &
     &               ,ARRAY(41),E,F,G,H,O,P,Q,R,S,T,NDMF,NAF)
      RETURN
 1090 CONTINUE
      NDMF=.FALSE.
      NAF=.FALSE.
          CALL SWRITE(10,FOR3,NW3,ICONT3,NALPHA,ALPHA,ARRAY(1),ARRAY(21)&
     &              ,ARRAY(41),ARRAY(61),ARRAY(81),ARRAY(101),ARRAY(121)&
     &              ,ARRAY(141),ARRAY(161),Q,R,S,T,NDMF,NAF)
      RETURN
      END
      SUBROUTINE INTERX (NIND,TABLE,VAR,LENGTH,DEP,ANS,LIND,LDEP,       &
     &           LX1L,LX2L,LX3L,LX4L,LX1U,LX2U,LX3U,LX4U,MESS,NMSS,ROUT)
!
!
!  THE PURPOSE OF THIS SUBROUTINE IS TO PERFORM A LINEAR INTERPOLATION
!  FOR UP TO FOUR INDEPENDENT VARIABLES.  A TABLE LOOK-UP IS PERFORMED
!  PRIOR TO THE INTERPOLATION IN ORDER TO FIND THE TABLE VALUES BOUNDING
!  EACH OF THE INDEPENDENT VARIABLES.
!
!  THE CALLING FORMAT FOR THIS SUBROUTINE IS
!         CALL INTERP(NIND,TABLE,VAR,LENGTH,DEP,ANS,LIND,LDEP)
!
!     WHERE,
!            NIND  = NUMBER OF INDEPENDENT VARIABLES
!            TABLE = TABLE NAMES OF THE INDEPENDENT VARIABLES (1-N,1-4)
!            VAR   = INDEPENDENT VARIABLE VALUES (1-4)
!            LENGTH= LENGTH OF INDEPENDENT VARIABLE TABLES (1-4)
!            DEP   = DEPENDENT VARIABLE TABLE NAME
!            ANS   = INTERPOLATION RESULT
!           LIND  = LENGTH OF THE LARGEST INDEPENDENT VARIABLE TABLE
!                   FOR A GIVEN INDEPENDENT VARIABLE TABLE NAME
!           LDEP  = LENGTH OF THE DEPENDENT VARIABLE TABLE
!
!  THE FUNCTION VALUES OF THE DEPENDENT VARIABLE ARE IN THE FOLLOWING
!  MANNER
!       ASSUME X,Y, AND Z ARE THE INDEPENDENT VARIABLES WITH THE
!       CORRESPONDING TABLE LENGTHS OF X=4, Y=3, AND Z=2.  THE
!       DEPENDENT VARIABLE TABLE THEN MUST BE
!           DEP(1) = F(X1,Y1,Z1)       DEP(13)= F(X1,Y1,Z2)
!           DEP(2) = F(X2,Y1,Z1)       DEP(14)= F(X2,Y1,Z2)
!           DEP(3) = F(X3,Y1,Z1)       DEP(15)= F(X3,Y1,Z2)
!           DEP(4) = F(X4,Y1,Z1)       DEP(16)= F(X4,Y1,Z2)
!           DEP(5) = F(X1,Y2,Z1)       DEP(17)= F(X1,Y2,Z2)
!           DEP(6) = F(X2,Y2,Z1)       DEP(18)= F(X2,Y2,Z2)
!           DEP(7) = F(X3,Y2,Z1)       DEP(19)= F(X3,Y2,Z2)
!           DEP(8) = F(X4,Y2,Z1)       DEP(20)= F(X4,Y2,Z2)
!           DEP(9) = F(X1,Y3,Z1)       DEP(21)= F(X1,Y3,Z2)
!           DEP(10)= F(X2,Y3,Z1)       DEP(22)= F(X2,Y3,Z2)
!           DEP(11)= F(X3,Y3,Z1)       DEP(23)= F(X3,Y3,Z2)
!           DEP(12)= F(X4,Y3,Z1)       DEP(24)= F(X4,Y3,Z2)
      DIMENSION MSSCL(21),RMSCL(21)
      DIMENSION LENGTH(NIND),TABLE(LIND,4),DEP(LDEP),VAR(NIND),ROUT(2),    &
     &          MESS(20)
! dimension of VAR and TABLE changed from 4 to NIND    RLC 2020Dec14
      EQUIVALENCE(MSSCL(1),RMSCL(1))
      DATA MSSCL  /4HINTE,4HRX  ,19*0/
      DATA SRPMSS /4H1TIN/,HOL1/4H1EXP/
!
!     ----SUPPRESS TLINNX S MESSAGES.
!
      RO=SRPMSS
      GO TO (1000,1010,1020,1030),NIND
!
 1000 CALL TLIN1X(TABLE,DEP,LENGTH,VAR,ANS,LX1L,LX1U,MESS,NMSS,RO)
      GO TO 1040
 1010 CALL TLINEX(TABLE(1,2),TABLE(1,1),DEP,LENGTH(2),LENGTH(1),VAR(2), &
     &            VAR(1),ANS,LX2L,LX1L,LX2U,LX1U,MESS,NMSS,RO)
      GO TO 1040
 1020 CALL TLIN3X(TABLE(1,2),TABLE(1,1),TABLE(1,3),DEP,LENGTH(2),       &
     &            LENGTH(1),LENGTH(3),VAR(2),VAR(1),VAR(3),ANS,LX2L,    &
     &            LX1L,LX3L,LX2U,LX1U,LX3U,MESS,NMSS,RO)
      GO TO 1040
!
!****TLIN4X CALL DELETED TO SAVE CORE****
!
 1030 CONTINUE
!1400 CALL TLIN4X(TABLE(1,2),TABLE(1,1),TABLE(1,3),TABLE(1,4),DEP,LENGTH
!    1(2),LENGTH(1),LENGTH(3),LENGTH(4),VAR(2),VAR(1),VAR(3),VAR(4),ANS,
!    2LX2L,LX1L,LX3L,LX4L,LX2U,LX1U,LX3U,LX4U,MESS,NMSS,RO)
!**** END OF DELETION****
!
!     ----PRINT MESSAGE IF REQUIRED
!
 1040 IF(RO.NE.HOL1)RETURN
      MSSCL(3)=NMSS
      RMSCL(4)=ANS
      MSSCL(5)=NIND
      L=6
      MSSCL(8)=LX1L
      MSSCL(9)=LX1U
      MSSCL(12)=LX2L
      MSSCL(13)=LX2U
      MSSCL(16)=LX3L
      MSSCL(17)=LX3U
      MSSCL(20)=LX4L
      MSSCL(21)=LX4U
      DO 1050 I=1,NIND
         RMSCL(L)=VAR(I)
         MSSCL(L+1)=LENGTH(I)
         L=L+4
 1050 END DO
      CALL MESSGE(ROUT,MESS,TABLE(1,1),TABLE(1,2),TABLE(1,3),TABLE(1,4),&
     &            MSSCL)
      RETURN
      END
      SUBROUTINE INTKBW(MACH,OLE,CR,D,DX,KBW,XAC)
!
!  SUBROUTINE TO INTEGRATE THE PRESSURE DISTRIBUTION OVER A
!  BODY, BEHIND THE SHOCK, AND OBTAIN THE FIN/BODY INTERFERENCE
!  FACTORS.  METHOD FROM NACA TR 1307.
!
! *** INPUTS ***
!
!   MACH -- FREE-STREAM MACH NUMBER
!    OLE -- FIN LEADING EDGE SWEEP, DEGREES
!     CR -- FIN EXPOSED ROOT CHORD
!      D -- BODY DIAMETER AT FIN
!     DX -- LENGTH OF AFTER BODY BEHIND FIN
!
! *** OUTPUTS ***
!
!    KBW -- INTERFERENCE FACTOR K-B(W)*CONST.
!           CONST IS A CONSTANT TO RELATE TO PANEL LIFT, TAPER RATIO,
!           ASPECT RATIO AND SPAN/DIAMETER RATIO
!    XAC -- AERODYNAMIC CENTER (XAC*CONST)
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      REAL MACH,M,N,LL,KBW
      DIMENSION DATA(50),SAVE(50)
      DIMENSION DATM(50),SAVM(50)
!
      NN=50
      IF(MACH .LE. 1.)GO TO 1050
      XX   = NN-1
!
      M=ABS(1./TAN(OLE/RAD))
      DN   = D/XX
      BETA = SQRT(MACH**2-1.)
      IF(DX .LT. (D*BETA-CR)) DN=(CR+DX)/(XX*BETA)
      IF(BETA*M .LE. 1.0) GO TO 1020
!
      DO 1010 I=1,NN
        N  = DN*FLOAT(I-1)
        LL = BETA*N
        UL = CR+LL
        IF(UL .GT. (CR+DX)) UL = CR+DX
        DE = (UL-LL)/XX
        DO 1000 J = 1,NN
          E = LL+DE*FLOAT(J-1)
          IF(N .EQ. 0.0)   VAL = 1./(BETA*M)
          IF(N .NE. 0.0)   VAL = (E/BETA+BETA*M*N)/(N+M*E)
          IF(VAL .GT. 1.0) VAL = 1.0
          DATA(J) = ACOS(VAL)
          DATM(J) = E*DATA(J)
 1000   CONTINUE
        CALL QUADIN(DATA,NN,DE,SAVE(I))
        CALL QUADIN(DATM,NN,DE,SAVM(I))
 1010 END DO
      CALL QUADIN(SAVE,NN,DN,KBW)
      CALL QUADIN(SAVM,NN,DN,XAC)
      XAC = XAC/(KBW*CR)
      KBW = 8.*BETA*M/(PI*(D*CR/2.)*SQRT(BETA**2*M**2-1.))*KBW
      GO TO 1050
!
 1020 CONTINUE
      DO 1040 I=1,NN
        N  = DN*FLOAT(I-1)
        LL = BETA*N
        UL = CR+LL
        IF(UL .GT. (CR+DX)) UL = CR+DX
        DE = (UL-LL)/XX
        DO 1030 J = 1,NN
          E = LL+DE*FLOAT(J-1)
          IF(N .EQ. 0.0)   VAL = 1./(BETA*M)
          IF(N .NE. 0.0)   VAL = (E/BETA-N)/(N+M*E)
          IF(VAL .LT. 0.0) VAL = 0.0
          DATA(J) = SQRT(VAL)
          DATM(J) = E*DATA(J)
 1030   CONTINUE
        CALL QUADIN(DATA,NN,DE,SAVE(I))
        CALL QUADIN(DATM,NN,DE,SAVM(I))
 1040 END DO
      CALL QUADIN(SAVE,NN,DN,KBW)
      CALL QUADIN(SAVM,NN,DN,XAC)
      XAC = XAC/(KBW*CR)
      KBW = 16.*(BETA*M)**1.5/(PI*(D*CR/2.)*(BETA*M+1.))*KBW
 1050 CONTINUE
      RETURN
      END
      SUBROUTINE JETFP
!
!  CALCULATE JET FLAP AERODYNAMIC INCREMENTS
!
      COMMON /IWING/  PWING,WING(400)
      COMMON /POWER/  P(12),PWIN(26)
      COMMON /OPTION/ SREF,CBARR
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /FLAPIN/ F(84)
      COMMON /WINGD/  A(195)
      COMMON /WINGI/  WINGIN(100)
!
      LOGICAL VERTUP
      DIMENSION DELFLP(10),CPRMEI(10),CPRMEO(10),DELJET(10),            &
     &          X149(18),Y149(63),Q149(3),X418(24),Y418(48),Q418(3),    &
     &          X409(22),Y409(110),Q409(3),X415(22),Y415(33),Q415(3),   &
     &          X412(7),Y412(7),Q412(3),ROUT(2),CC(6),DECCL(10),        &
     &          EFFJET(10),DCLMAX(10),CLAUB(10),CLAB(10),VAR(3),LEN(3), &
     &    DELCM(10),X237(22),Y237(88),Q237(3),X568(22),Y568(121),Q568(3)
!
      EQUIVALENCE     (SW,A(4)),(TANLE,A(38)),(DCLMAX(1),WING(221)),    &
     & (CHRDFI,F(12)),(CHRDFO,F(13)),(SPANFI,F(14)),(TANTE,A(56)),      &
     & (SPANFO,F(15)),(CMU,F(63)),(AIETLJ,PWIN(1)),(JEALOC,PWIN(6)),    &
     & (JEANGL,PWIN(8)),(JELLOC,PWIN(12)),(JERAD,PWIN(15)),             &
     & (DELFLP(1),F(1)),(CPRMEI(1),F(39)),(CPRMEO(1),F(49)),            &
     & (DELJET(1),F(64)),(CLAUB(1),WING(101)),(SSPN,WINGIN(4)),         &
     & (CHRDR,WINGIN(6)),(DECCL(1),WING(201)),(EFFJET(1),F(75)),        &
     & (TAPR,A(118)),(JEVLOC,PWIN(5)),(AR,A(120)),(TWISTA,WINGIN(11)),  &
     & (TOC,WINGIN(16)),(DELCM(1),WING(211)),(CLAB(1),WING(241)),       &
     & (SSPNE,WINGIN(3)),(CHRDTP,WINGIN(1))
!
      INTEGER FTYPE
      REAL    JEALOC, JEANGL, JELLOC, JERAD, JEVLOC
!
!***** DATA FOR FIG. 6.1.1.1-49
!
      DATA X149 /0.,.5,1.,2.,3.,4.,6.,8.,10.,0.,.05,.1,.2,.3,.5,1.,2*0./
      DATA Y149 /0.,2.8,4.,6.,7.9,9.7,12.8,15.6,18.4,1.9,3.5,4.8,6.8,   &
     & 8.5,10.2,13.2,16.1,19.,2.3,3.9,5.2,7.2,8.9,10.6,13.6,16.5,19.4,  &
     & 3.5,5.,6.,8.,9.6,11.3,14.2,17.3,20.,4.2,5.5,6.5,8.5,10.2,11.9,   &
     & 14.6,17.8,20.5,5.1,6.2,7.5,9.1,10.3,12.6,15.6,18.6,21.1,6.3,     &
     & 7.5,8.5,10.5,12.1,13.6,16.5,19.2,22.1/
      DATA Q149 / 4H6.1., 4H1.1-, 4H49  /
!
!***** DATA FOR FIG. 6.1.4.1-18
!
      DATA X418 /0.,.5,1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,.1,.2,.3,.4,8*0./
      DATA Y418 /0.,1.7,2.8,4.8,6.5,8.1,9.75,11.1,12.6,14.05,15.5,16.9, &
     & 0.,1.5,2.6,4.5,6.2,7.85,9.3,10.9,12.25,13.8,15.1,16.5,           &
     & 0.,1.45,2.45,4.3,6.05,7.75,9.1,10.75,12.05,13.55,14.98,16.4,     &
     & 0.,1.45,2.45,4.25,5.95,7.55,9.,10.55,11.95,13.25,14.8,16.05/
      DATA Q418 / 4H6.1., 4H4.1-, 4H18  /
!
!***** DATA FOR FIG. 6.1.4.2-9
!
      DATA X409 /0.,1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,1.,2.,3.,4.,5.,6.,7.,&
     & 8.,9.,10.,0./
      DATA Y409 /1.,1.52,2.02,2.49,2.9,3.35,3.75,4.15,4.55,4.95,5.35,   &
     & 1.,1.35,1.65,1.95,2.21,2.5,2.75,3.03,3.28,3.56,3.8,1.,1.3,1.56,  &
     & 1.8,2.03,2.24,2.46,2.7,2.9,3.13,3.35,1.,1.3,1.53,1.75,1.95,2.16, &
     & 2.35,2.55,2.75,2.95,3.15,1.,1.3,1.53,1.73,1.93,2.12,2.3,2.5,     &
     & 2.67,2.84,3.07,1.,1.3,1.53,1.73,1.92,2.1,2.28,2.46,2.65,2.82,    &
     & 3.03,1.,1.3,1.53,1.73,1.92,2.1,2.28,2.45,2.63,2.8,2.98,1.,1.3,   &
     & 1.53,1.73,1.92,2.1,2.28,2.45,2.63,2.8,2.98,1.,1.3,1.53,1.73,     &
     & 1.92,2.1,2.28,2.45,2.63,2.8,2.98,1.,1.3,1.53,1.73,1.92,2.1,      &
     & 2.28,2.45,2.63,2.8,2.98/
      DATA Q409 / 4H6.1., 4H4.2-, 4H9   /
!
!***** DATA FOR FIG. 6.1.4.1-15
!
      DATA X415 /0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.,0.,.5,1.,8*0./
      DATA Y415 /0.,.17,.3,.43,.57,.67,.78,.86,.93,.98,1.,0.,.14,.28,   &
     &.4,.52,.52,.73,.82,.91,.97,1.,0.,.13,.26,.38,.39,.5,.7,.8,.89,.96,&
     & 1./
      DATA Q415 / 4H6.1., 4H4.1-, 4H15  /
!
!***** DATA FOR FIG. 6.1.4.3-12
!
      DATA X412 /0.,.4,.8,1.2,1.6,2.,2.4/
      DATA Y412 /0.,1.6,2.65,3.65,4.55,5.4,6.2/
      DATA Q412 / 4H6.1., 4H4.3-, 4H12  /
!
!***** DATA FOR FIG. 6.1.2.1-37
!
      DATA X237 /0.,1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,0.,.05,.1,.2,        &
     & .3,.5,.7,1.,3*0./
      DATA Y237 /.5,.575,.61,.63,.655,.67,.685,.695,.705,.71,.715,      &
     & .49,.55,.58,.605,.62,.645,.66,.67,.675,.68,.69,.48,.525,         &
     & .56,.585,.6,.61,.62,.635,.64,.65,.655,.445,.485,.51,.54,         &
     & .555,.565,.575,.585,.59,.595,.599,.42,.45,.475,.49,.5,           &
     & .505,.51,.515,.52,.525,.53,.38,.385,.39,.399,.402,.405,.41,      &
     & .415,.42,.422,.426,.325,.32,9*.315,.25,.23,.215,.21,.202,        &
     & .198,.195,.19,.185,.178,.175/
      DATA Q237 / 4H6.1., 4H2.1-, 4H37  /
!
!***** DATA FOR FIG. 6.1.5.1-68
!
      DATA X568 /0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.,0.,.05,.1,.15,        &
     & .2,.25,.3,.35,.4,.45,.5/
      DATA Y568 /1.,1.098,1.18,1.255,1.32,1.38,1.43,1.48,1.52,1.575,    &
     & 1.605,1.,1.095,1.175,1.245,1.31,1.375,1.415,1.46,1.5,1.55,       &
     & 1.58,1.,1.09,1.17,1.235,1.3,1.365,1.4,1.445,1.48,1.52,1.57,      &
     & 1.,1.085,1.16,1.225,1.29,1.345,1.385,1.43,1.46,1.5,1.54,         &
     & 1.,1.08,1.15,1.215,1.28,1.325,1.375,1.4,1.445,1.48,1.505,        &
     & 1.,1.075,1.14,1.205,1.26,1.305,1.355,1.385,1.42,1.455,1.48,      &
     & 1.,1.07,1.13,1.195,1.24,1.29,1.33,1.36,1.39,1.425,1.46,          &
     & 1.,1.065,1.12,1.18,1.22,1.265,1.3,1.345,1.37,1.39,1.42,          &
     & 1.,1.06,1.11,1.16,1.2,1.24,1.28,1.3,1.33,1.36,1.38,              &
     & 1.,1.055,1.1,1.145,1.18,1.21,1.245,1.27,1.29,1.315,1.34,         &
     & 1.,1.05,1.09,1.12,1.16,1.185,1.205,1.23,1.25,1.275,1.29/
      DATA Q568 / 4H6.1., 4H5.1-, 4H68  /
!
      DATA ROUT / 4HJETF, 4HP   /
!
!---- CALCULATE THE AVERAGE FLAP CHORD FOR THE WING
!
      IF(CMU .EQ. UNUSED .OR. F(74) .EQ. UNUSED) GO TO 1100
      CF=(CHRDFI+CHRDFO)/2.
      IF(JEANGL .EQ. UNUSED) JEANGL=12.0
      TANJET=TAN(JEANGL*DEG)
!
!---- CALCULATE AVERAGE BASIC WING CHORD IN BLOWN REGION
!
      C=CHRDR+(SPANFI+SPANFO)*(CHRDTP-CHRDR)/(2.0*SSPN)
      IN=0
      JETFLP=F(74)+.5
      NDELTA=F(16)+.5
      FTYPE=F(17)+.5
      DO 1090 N=1,NDELTA
!
!  CALCULATE SECTION GEOMETRIC CONSTANTS
!
!---- GET AVERAGE C-PRIME FOR WING
!
         CPRIME=(CPRMEI(N)+CPRMEO(N))/2.
         IF(FTYPE .EQ. 5 .OR. FTYPE .EQ. 1 .OR. FTYPE .EQ. 6) CPRIME=C
!
!---- CALCULATE AVERAGE WING EXTENDED CHORD IN BLOWN REGION
!---- AIRFOIL THICKNESS RATIO BASED ON EXTENDED CHORD (C-PRIME)
!---- GENERAL AIRFOIL USED FOR CONSTANT KT (KT=0.80)
!
         TCPRM=TOC*C/CPRIME*0.80
!
!---- CALCULATE TOTAL WING AREA INCLUDING FLAP
!
         ST=SW+2.0*(CPRIME-C)*(SPANFO-SPANFI)
         IF(FTYPE .EQ. 5 .OR. FTYPE .EQ. 1 .OR. FTYPE .EQ. 6) ST=SW
!
!---- CALCULATE TOTAL WING-FLAP COMBINATION ASPECT RATIO
!
         AT=AR*SW/ST
!
!---- CALCULATE FLAP T.E. FOR BLOWING BOUNDARIES
!
         YI=SPANFI
         YO=SPANFO
         IF(JETFLP .NE. 3) GO TO 1000
         COSDF=COS(DELFLP(N)*DEG)-1.
         BK=(CPRMEI(N)-CPRMEO(N))/(SPANFI-SPANFO)
         FK=(CHRDFI-CHRDFO)/(SPANFI-SPANFO)
         YI=(JELLOC-JERAD-TANJET*(XW-JEALOC+CPRMEO(N)-BK*SPANFO         &
     &      -FK*COSDF*SPANFO+CHRDFO))/(1.+TANJET*(TANLE-BK-FK*COSDF))
         YO=2.*JELLOC-YI
         IF(YI .LT. SPANFI) YI=SPANFI
         IF(YO .GT. SPANFO) YO=SPANFO
!
!---- CALCULATE BASIC WING BLOWN AREA
!
 1000    SJ=(YO-YI)*CHRDR*(2.-(YI+YO)*(1.-TAPR)/SSPN)
!
!  CALCULATE SECTION LIFT USING CMU-PRIME
!
         IF(JETFLP .EQ. 2 .OR. JETFLP .EQ. 3) GO TO 1010
!
!---- HERE FOR PURE JET FLAP OR COMBINATION
!---- FIG. 6.1.1.1-49, CLDJ
!
         VAR(1)=CMU*C/CPRIME
         VAR(2)=0.0
         LEN(1)=9
         LEN(2)=7
         CALL INTERX(2,X149,VAR,LEN,Y149,CLDJ,9,63,1,1,0,0,1,1,0,0,     &
     &               Q149,3,ROUT)
         DELCL=((1.+TCPRM)*DELJET(N)*(CLDJ-CMU*C/CPRIME)+               &
     &         CMU*C/CPRIME*DELJET(N))*CPRIME/(C*RAD)
         IF(JETFLP .EQ. 4) DELCL1=DELCL
         IF(JETFLP .EQ. 1) GO TO 1020
 1010    CONTINUE
!
!---- HERE FOR IBF, EBF OR COMBINATION
!---- FIG. 6.1.1.1-49, CLDF
!
         VAR(1)=CMU*C/CPRIME
         VAR(2)=CF/CPRIME
         LEN(1)=9
         LEN(2)=7
         CALL INTERX(2,X149,VAR,LEN,Y149,CLDF,9,63,1,1,0,0,1,1,0,0,     &
     &               Q149,3,ROUT)
         DELCL=((1.+TCPRM)*DELFLP(N)*(CLDF-CMU*C/CPRIME)+               &
     &         CMU*C/CPRIME*DELFLP(N))*CPRIME/(C*RAD)
         IF(JETFLP .EQ. 4)DELCL=DELCL+DELCL1
 1020    CONTINUE
!
!  CALCULATE THREE DIMENSIONAL JET MOMENTUM COEFFICIENT
!
         CJ=2./SREF*C*CMU*(SPANFO-SPANFI)
         CJPRM=CJ*SREF/SJ
!
!  CALCULATE THE SECTION LIFT USING CJ-PRIME
!
         IF(JETFLP .EQ. 2 .OR. JETFLP .EQ. 3) GO TO 1030
         VAR(1)=CJPRM
         VAR(2)=0.0
         LEN(1)=9
         LEN(2)=7
         CALL INTERX(2,X149,VAR,LEN,Y149,CLDJT,9,63,1,1,0,0,1,1,0,0,    &
     &               Q149,3,ROUT)
         DELCLT=((1.+TCPRM)*DELJET(N)*(CLDJT-CJPRM)+CJPRM*DELJET(N))*   &
     &          CPRIME/(C*RAD)
         IF(JETFLP .EQ. 4)DELCL2=DELCLT
         IF(JETFLP .EQ. 1) GO TO 1040
 1030    VAR(1)=CJPRM
         VAR(2)=CF/CPRIME
         LEN(1)=9
         LEN(2)=7
         CALL INTERX(2,X149,VAR,LEN,Y149,CLDFT,9,63,1,1,0,0,1,1,0,0,    &
     &               Q149,3,ROUT)
         DELCLT=((1.+TCPRM)*DELFLP(N)*(CLDFT-CJPRM)+CJPRM*DELFLP(N))    &
     &          *CPRIME/(C*RAD)
         IF(JETFLP .EQ. 4) DELCLT=DELCLT+DELCL2
 1040 CONTINUE
!
!---- EQN. 6.1.4.1-B, IBF
!---- IF CONFIGURATION IS PURE JET FLAP, USE IBF EQN TO APPROXIMATE
!
         IF(JETFLP .NE. 2 .AND. JETFLP .NE. 1) GO TO 1050
         DECCL(N)=DELCLT*SJ/SREF*(AT+2.*CJPRM/PI)/                      &
     &            (AT+2.+.604*SQRT(CJPRM)+.876*CJPRM)
 1050    CONTINUE
         IF(JETFLP .NE. 3) GO TO 1060
!
!---- HERE FOR EBF
!---- GET TWO DIMENSIONAL LIFT CURVE SLOPE FROM 6.1.1.1
!---- FIG. 6.1.1.1-49
!
         VAR(1)=CJPRM
         VAR(2)=1.
         LEN(1)=9
         LEN(2)=7
         CALL INTERX(2,X149,VAR,LEN,Y149,CLAPRM,9,63,1,1,0,0,1,1,0,0,   &
     &              Q149,3,ROUT)
!
!---- FIG. 6.1.4.1-18
!
         VAR(1)=CJPRM
         VAR(2)=CF/CPRIME
         LEN(1)=12
         LEN(2)=4
         CALL INTERX(2,X418,VAR,LEN,Y418,PIDO4,12,48,1,1,0,0,1,1,0,0,   &
     &               Q418,3,ROUT)
!
!---- EQN. 6.1.4.1-C
!
         DECCL(N)=PIDO4*EFFJET(N)*SJ/(SREF*RAD)*(PI*AT+2.*CJPRM)/       &
     &            (PI*AT+CLAPRM+2.01*CJPRM)
 1060    CONTINUE
!
!  CAN ADD DECCL TO FLAP RETRACTED POWER-OFF DATA FOR TOTAL LIFT
!
         IF(JETFLP .EQ. 4) GO TO 1090
!
!  CALCULATE LIFT-CURVE-SLOPE FROM 6.1.4.2 (PURE JET, IBF OR EBF ONLY)
!
         TERM2=CJ*(COS((EFFJET(N)+DELJET(N))*DEG)-1.)/RAD
!
!---- K(AT,CJPRIME), FIG. 6.1.4.2-9
!
         VAR(1)=CJPRM
         VAR(2)=AT
         LEN(1)=11
         LEN(2)=10
         CALL INTERX(2,X409,VAR,LEN,Y409,ATCJK,11,110,1,1,0,0,1,1,0,0,  &
     &               Q409,3,ROUT)
!
!---- KB, FIG. 6.1.4.1-15 AND SKETCH (A) OF 6.1.4.1
!
         ETAI=SPANFI/SSPN
         ETAO=SPANFO/SSPN
         VAR(1)=ETAI
         VAR(2)=1.
         LEN(1)=11
         LEN(2)=3
         CALL INTERX(2,X415,VAR,LEN,Y415,BK1,11,33,1,1,0,0,1,1,0,0,     &
     &               Q415,3,ROUT)
         VAR(1)=ETAO
         CALL INTERX(2,X415,VAR,LEN,Y415,BK2,11,33,1,1,0,0,1,1,0,0,     &
     &               Q415,3,ROUT)
         BK=BK2-BK1
!
!---- FIRST TERM OF EQN. 6.1.4.2-B
!
         TERM1K=(ATCJK-1.)*BK+1.
!
!  MULTIPLY UNBLOWN FLAP DEFLECTED WING LIFT-CURVE-SLOPE BY
!  TERM1K AND ADD THIS RESULT TO TERM2.  THIS IS THE TOTAL
!  BLOWN WING LIFT-CURVE-SLOPE.
!
         CLAB(N)=TERM1K*CLAUB(N)+TERM2
         IF(JETFLP .NE. 3) GO TO 1070
!
!---- WING MAXIMUM LIFT, SECTION 6.1.4.3 (EBF ONLY)
!---- OMIT CLMAX CALCULATION IF FLAP NOT DOUBLE SLOTTED
!
         ETAT=0.0
         IF(FTYPE .NE. 4) GO TO 1070
!
!---- FIG. 6.1.4.3-11, STATIC TURNING EFFICIENCY
!
         ETAT=1.-2.*EFFJET(N)/300.
         CONS=ETAT*CJ*SIN(EFFJET(N)*DEG)
!
!---- FIG. 6.1.4.3-12
!
         CALL TBFUNX(CONS,DCLMAX(N),DYDX,7,X412,Y412,CC,IN,MI,NG,       &
     &               1,1,Q412,3,ROUT)
!
!  WING PITCHING MOMENT INCREMENT, SECTION 6.1.5.1
!
!  PURE JET, IBF OR EBF ONLY, NO LEADING EDGE DEVICES
!
 1070    IF(FTYPE .GT. 5) GO TO 1090
         IF(JETFLP .NE. 3) GO TO 1080
!
!---- HERE FOR EBF
!---- CHECK TO MAKE SURE THAT JET BLOWS OVER FLAP
!---- CALCULATE EXHAUST HEIGHT AT WING TRAILING EDGE
!
         EH=(JERAD+TANJET*(CPRIME-CF+XW+JELLOC*TANLE))*COS(AIETLJ*DEG)
         IF(EH .LT. (JEVLOC-ZW)) WRITE(6,1110)
         IF(EH .LT. (JEVLOC-ZW)) GO TO 1100
!
!---- DIVIDE THE WING INTO SECTIONS FOR PITCHING MOMENT ANALYSIS
!---- A TOTAL OF 5 SECTIONS IS TO BE CALCULATED
!
 1080    CONTINUE
         ETA1=SPANFI/SSPN
         ETA2=YI/SSPN
         ETA3=YO/SSPN
         ETA4=SPANFO/SSPN
         ETA5=1.0
         AT=AR*C/CPRIME
         CMUPRM=CJ*SREF/SJ*C/CPRIME
         AK1=0.
         AK2=AT/(2.+AT)*CPRIME/C
         AK3=(AT+2.*CMUPRM/PI)/(AT+2.+.604*SQRT(CMUPRM)+.876*CMUPRM)*   &
     &       CPRIME/C
         AK4=AK2
         AK5=0.
!
!---- FIG. 6.1.4.1-15
!
         VAR(1)=ETA1
         VAR(2)=TAPR
         LEN(1)=11
         LEN(2)=3
         CALL INTERX(2,X415,VAR,LEN,Y415,BK10,11,33,1,1,0,0,1,1,0,0,    &
     &               Q415,3,ROUT)
         VAR(1)=ETA2
         CALL INTERX(2,X415,VAR,LEN,Y415,BK22,11,33,1,1,0,0,1,1,0,0,    &
     &               Q415,3,ROUT)
         BK21=BK22-BK10
         VAR(1)=ETA3
         CALL INTERX(2,X415,VAR,LEN,Y415,BK33,11,33,1,1,0,0,1,1,0,0,    &
     &               Q415,3,ROUT)
         BK32=BK33-BK22
         VAR(1)=ETA4
         CALL INTERX(2,X415,VAR,LEN,Y415,BK44,11,33,1,1,0,0,1,1,0,0,    &
     &               Q415,3,ROUT)
         BK43=BK44-BK33
         BK54=1.-BK44
!
!---- STRAIGHT TAPERED WINGS ONLY
!
         IF(TAPR .NE. 1.) XMOC=(1.+TAPR)*AR*TANLE/(4.*(1.-TAPR))
         IF(TAPR .EQ. 1.) XMOC=(XW-XCG)/CHRDR
!
!---- FIG. 6.1.2.1-37, TWO DIMENSIONAL CENTER OF LIFT LOCATION
!
         VAR(1)=CMUPRM
         VAR(2)=CF/CPRIME
         LEN(1)=11
         LEN(2)=8
         CALL INTERX(2,X237,VAR,LEN,Y237,XF2F,11,88,1,1,0,0,1,1,0,0,    &
     &               Q237,3,ROUT)
!
!---- FIG. 6.1.5.1-68 3-D TO 2-D XCP FRACTION
!
         VAR(1)=1./AT
         VAR(2)=CF/CPRIME
         LEN(1)=11
         LEN(2)=11
         CALL INTERX(2,X568,VAR,LEN,Y568,X3D2F,11,121,1,1,0,0,1,1,0,0,  &
     &               Q568,3,ROUT)
!
!---- FIG. 6.1.2.1-37, JET CENTER OF LIFT, 2-D
!
         VAR(1)=CMUPRM
         VAR(2)=0.
         LEN(1)=11
         LEN(2)=8
         CALL INTERX(2,X237,VAR,LEN,Y237,XF2J,11,88,1,1,0,0,1,1,0,0,    &
     &               Q237,3,ROUT)
!
!---- FIG. 6.1.5.1-68, JET CENTER OF LIFT, 3-D TO 2-D FRACTION
!
         VAR(1)=1./AT
         VAR(2)=0.
         LEN(1)=11
         LEN(2)=11
         CALL INTERX(2,X568,VAR,LEN,Y568,X3D2J,11,121,1,1,0,0,1,1,0,0,  &
     &               Q568,3,ROUT)
!
!---- SET ALPHA-L TO WING TWIST (WING TWIST ASSUMED TO BE UNIFORM)
!
         AL=TWISTA
         XFICDD=XF2F*X3D2F
         XJICDD=XF2J*X3D2J
!
!---- CALCULATE SECTION PITCHING MOMENT COEFFICIENT
!---- CALCULATE BY SECTION ALONG THE SPAN
!
         VAR(1)=CMUPRM
         VAR(2)=1.0
         LEN(1)=11
         LEN(2)=8
         CALL INTERX(2,X237,VAR,LEN,Y237,XACDD,11,88,1,1,0,0,1,1,0,0,   &
     &               Q237,3,ROUT)
!
!---- FIG. 6.1.1.1.-49, INCREMENTAL CL-ALPHA
!
         VAR(1)=0.
         VAR(2)=1.
         LEN(1)=9
         LEN(2)=7
         CALL INTERX(2,X149,VAR,LEN,Y149,CLA1,9,63,1,1,0,0,1,1,0,0,     &
     &               Q149,3,ROUT)
         CLA2=CLA1
         VAR(1)=CMUPRM
         CALL INTERX(2,X149,VAR,LEN,Y149,CLA3,9,63,1,1,0,0,1,1,0,0,     &
     &               Q149,3,ROUT)
         CLA4=CLA2
         CLA5=CLA4
         DELC41=AL*AK1*CLA1/RAD
         DELC42=AL*AK2*CLA2/RAD
         DELC43=AL*AK3*CLA3/RAD
         DELC44=AL*AK4*CLA4/RAD
         DELC45=AL*AK5*CLA5/RAD
         X21=XMOC
         X22=XMOC
         X23=XMOC-XACDD*CPRIME/C
         X24=XMOC
         X25=XMOC
         DELCM4=-CJ*ETAT*SW/SJ*(XMOC)*AL/RAD
         DCMDA1=DELC41*X21
         DCMDA2=DELC42*X22
         DCMDA3=DELC43*X23+DELCM4
         DCMDA4=DELC44*X24
         DCMDA5=DELC45*X25
         X5=XMOC-XFICDD*CPRIME/C
         VAR(1)=CMUPRM
         VAR(2)=CF/CPRIME
         CALL INTERX(2,X149,VAR,LEN,Y149,CLDFI,9,63,1,1,0,0,1,1,0,0,    &
     &               Q149,3,ROUT)
         DELC5=DELFLP(N)*AK3*CLDFI/RAD
         DCMDF=DELC5*X5
         VAR(1)=CMUPRM
         VAR(2)=0.
         CALL INTERX(2,X149,VAR,LEN,Y149,CLDJI,9,63,1,1,0,0,1,1,0,0,    &
     &               Q149,3,ROUT)
         IF(EFFJET(N) .GT. DELFLP(N)) DJ=EFFJET(N)-DELFLP(N)
         IF(EFFJET(N) .LE. DELFLP(N)) DJ=0.0
         IF(JETFLP.LT.5.AND.JETFLP.NE.3.) DJ=DELJET(N)
         DELC6=DJ*AK3*CLDJI/RAD
         X6=XMOC-XJICDD*CPRIME/C
         DCMDJ=DELC6*X6
!
!---- WING PITCHING MOMENT COEFFICIENT
!
         CMM=DCMDJ*BK32+DCMDF*(BK44-BK10)+DCMDA1*BK10+DCMDA2*BK21+      &
     &       DCMDA3*BK32+DCMDA4*BK43+DCMDA5*BK54
!
!---- NOW GET C(LAMBDA), EQN. 6.1.5.1-T
!
         CL1=BK10*DELC41
         CL2=BK21*DELC42
         CL3=BK32*(DELC43+DELC5+DELC6)
         CL4=BK43*DELC44
         CL5=BK54*DELC45
!
!---- NOW TOTAL WING INCREMENT, EQN. 6.1.5.1-U
!
         DXOCB=(XW+XMOC*CHRDR-XCG)/CBARR
         DELCM(N)=CMM+ETAT*CJ*(ZCG-ZW)/C +DXOCB*                        &
     &            (-CL1-CL2-CL4-CL5-CL3+CJ*ETAT*SW/SJ*AL*SJ/(RAD*SW))
 1090 END DO
 1100 CONTINUE
      RETURN
 1110 FORMAT(55H0*** FLAP IS NOT EXTERNALLY BLOWN, ANALYSIS TERMINATED.)
      END
      SUBROUTINE JETPWE
!
!     ----SUBROUTINE COMPUTES JET POWER EFFECTS
!
      COMMON /POWER/  XX(12),AIETLJ,NENGSJ,THSTCJ,JIALOC,JEVLOC,JEALOC, &
     &                JINLTA,JEANGL,JEVELO,AMBTMP,JESTMP,JELLOC,JETOTP, &
     &                AMBSTP,JERAD
      COMMON /POWR/   ATP,DCLT(20),XBARIN,XINOCR,DEUDA,EPSLON,ATJ,      &
     &                DCLNJ(20),XEP,ZJP,XJP,XHP,AIN,VIN,TINOTJ,VJPOVI,  &
     &                ZJPORJ,DE,ZJPOBH,YTOB2H,DEBODE,ZJPXHP,SRTPCO,     &
     &                ZJDEXH,COMP1,PTEOPI,RJPORJ,RJP,DXPORJ,DXP,XEPC,   &
     &                XHPC,ZTP,ZJPRJP,DCLHE(20),ZBART,DCMT(20),XL,      &
     &                DCMNJ(20),DLH,DCME(20)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /OPTION/ SR,CBARR
      COMMON /WINGD/  A(195),B(49)
      COMMON /HTDATA/ AHT(195)
      COMMON /WHAERO/ C(51),D(55)
      COMMON /WINGI/  WINGIN(77)
      COMMON /HTI/    HTIN(131)
      COMMON /IWING/  PWING, WING(400)
      COMMON /IHT/    PHT, HT(380)
      COMMON /IDWASH/ PDWASH,DWASH(60)
      COMMON /IPOWER/ PPOWER, DCDPOW(20),DCLPOW(20),DCMPOW(20)
      LOGICAL VERTUP
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT
      LOGICAL LOGCOM(11)
      REAL MACH(20)
      REAL NENGSJ,JIALOC,JEVLOC,JEALOC,JINLTA,JEANGL,JEVELO,JESTMP,     &
     &     JELLOC,JETOTP,JERAD
      EQUIVALENCE (CDL(1),D(36)),(CLW(1),WING(21))
      EQUIVALENCE (ALSCHD(1),FLC(23)),(MACH(1),FLC(3))
      EQUIVALENCE (A(120),AR),(ALPHA0,A(134))
      EQUIVALENCE (LOGCOM(1),FLTC)
      EQUIVALENCE (BO2H,HTIN(4)),(CLALPH,HT(101)),(QHOQI(1),DWASH(1)),  &
     &            (XBARRH,AHT(161))
      DIMENSION CLW(20),CDL(20)
      DIMENSION ALSCHD(20)
      DIMENSION ROUTID(2),Q44161(2),Q46128(2),Q46129(2),Q46131(2),      &
     &          Q6132A(3),Q6132B(3),Q46114(2)
      DIMENSION QHOQI(20)
      DIMENSION X16114(6),X26114(8),Y46114(48)
      DIMENSION X16117(13),X26117(4),Y46117(52)
      DIMENSION X6118A(8),Y6118A(8) , C6118A(6)
      DIMENSION X6118B(8),Y6118B(8),C6118B(6)
      DIMENSION X6119A(9),Y6119A(9),C6119A(6)
!
!     ----TABLES FOR UPWASH GRADIENT AT PLANE OF SYMMETRY FOR UNSWEPT
!     ----WINGS. FIGURE 4.4.1-73
!
      DIMENSION X14161(4),X24161(10),Y44161(10,4)
      DATA Q44161/4H4.4.,4H1-73/,Q46128/4H4.6.,4H1-28/,ROUTID/4HJETP,   &
     & 4HWE  /, Q46129/4H4.6.,4H1-29/,Q46131/4H4.6.,4H1-31/,            &
     & Q6132A/4H4.6.,4H1-32,4HA   /,  Q46114/4H4.6.,4H1-28/,            &
     & Q6132B/4H4.6.,4H1-32,4HB   /
      DATA X14161/4.,6.,9.,12./
      DATA X24161/.25,.4,.5,.6,.7,.8,1.0,1.2,1.6,2.0/
      DATA Y44161/1.08,.545,.40,.31,.24,.20,.13,.10,.06,.04 , 1.18,.680,&
     &.52,.40,.32,.27,.19,.15,.10,.08 , 1.30,.81,.62,.49,.40,.34,.25,.20&
     &,.13,.12 , 1.4,.88,.70,.56,.445,.39,.30,.24,.165,.14 /
!
!    -----FIGURE 4.6.1-28
!     -----EFFECTIVE MEAN DOWNWASH ACTING ON HORIZONTAL TAIL
!
      DATA X16114/0.0,0.3,0.5,0.7,0.9,1.1/
      DATA X26114/0.0,0.2,0.4,0.6,0.8,1.0,1.2,1.4/
      DATA Y46114/0.0,0.54,0.765,0.860,0.915,0.950,0.969,0.988,         &
     &0.0,0.51,0.721,0.825,0.890,0.923,0.950,0.970,                     &
     &0.0,0.450,0.675,0.790,0.860,0.900,0.922,0.945,                    &
     &0.0,0.395,0.595,0.725,0.810,0.861,0.892,0.914,                    &
     &0.0,0.300,0.522,0.660,0.748,0.810,0.859,0.890,                    &
     &0.0,0.200,0.415,0.570,0.682,0.758,0.810,0.850/
!
!    -----FIGURE 4.6.1-29
!    -----VARIATION OF EQUIVALENT VELOCITY RATIO,WITH ACTUAL VELOCITY RA
!
      DATA X16117/0.46,0.42,0.38,0.34,0.32,0.30,0.28,0.26,0.24,0.22,    &
     &.20,0.16,0.12/
      DATA X26117/1.0,6.0,14.0,24.0/
      DATA Y46117/1.0,4.25,9.66,16.6, 1.0,4.10,9.21,15.7, 1.0,3.90,8.80,&
     &14.9, 1.0,3.85,8.35,14.10, 1.,3.6,8.1,13.7, 1.,3.55,7.89,13.3,    &
     &1.0,3.40,7.60,12.90,   1.0,3.30,7.40,12.40,   1.0,3.20,7.10,12.0, &
     &1.0,3.10,6.80,11.40,   1.0,3.00,6.50,11.00,   1.0,2.72,5.90,9.85, &
     &1.0,2.42,5.15,8.55/
!
!    -----FIGURE 4.6.1-31
!    -----DOWNWASH INCREMENT DUE TO A SUBSONIC JET IN A SUBSONIC STREAM
!
      DATA I6118A/0/
      DATA X6118A/0.0,0.4,0.8,1.2,1.6,2.0,2.4,2.6/
      DATA Y6118A/0.0,0.34,0.63,0.88,1.1,1.31,1.51,1.61/
!
!    -----FIGURE 4.6.1-32A
!    -----EQUIVALENT JET ORIFICE RADIUS FOR SUPERSONIC JET IN A SUBSONIC
!    -----STREAM
!
      DATA I6118B/0/
      DATA X6118B/3.0,4.0,6.0,8.0,10.0,12.0,14.0,16.0/
      DATA Y6118B/1.08,1.30,1.70,2.02,2.23,2.41,2.55,2.70/
!
!    -----FIGURE 4.6.132B
!    -----DOWNSTREAM DISPLACEMENT OF EQUIVALENT JET ORIFICE LOCATION
!    -----FOR A SUPERSONIC JET IN A SUBSONIC STREAM
!
      DATA I6119A/0/
      DATA X6119A/1.0,1.2,1.4,1.6,1.8,2.0,2.2,2.4,2.6/
      DATA Y6119A/0.0,1.0,1.6,2.07,2.40,2.65,2.86,3.04,3.16/
!
      TMPINK(T)=273.+.556*(T-492.)
      TPCNE=NENGSJ*THSTCJ
      COSAIW=COS(DEG*ALIW)
      IF(NENGSJ.EQ.1.)GO TO 1010
      IF(WINGIN(2).EQ.UNUSED) GO TO 1010
      IF(JELLOC .LE.WINGIN(4)-WINGIN(2)) GO TO 1000
      CRJ=WINGIN(5)-(WINGIN(5)-WINGIN(1))*((JELLOC -(WINGIN(4)          &
     &   -WINGIN(2)))/WINGIN(2))
      XBARJ=(XW+A(38)*(WINGIN(4)-WINGIN(2))+A(86)*(JELLOC -(WINGIN(4)   &
     &      -WINGIN(2)))-JIALOC)*COS(DEG*ALIW)/CRJ
      GO TO 1020
 1000 WINGIN(1)=SAVE
      WINGIN(1)=WINGIN(5)
 1010 CRJ=WINGIN(6)-(WINGIN(6)-WINGIN(1))*JELLOC /WINGIN(4)
      XBARJ=(XW+A(38)*JELLOC +CRJ/4.0-JIALOC)*COS(DEG*ALIW)/CRJ
 1020 CONTINUE
      SAVE=WINGIN(1)
!
!     ----FIG 4.4.1-73
!
      CALL TLINEX(X14161,X24161,Y44161,4,10,AR,XBARJ,DEUDA,             &
     &            2,2,2,2,Q44161,2,ROUTID)
      AINNE2=2.0*JINLTA*NENGSJ/SR
      SINAIT=SIN(DEG*AIETLJ)
      COSAIT=COS(DEG*AIETLJ)
!
!     ----GEOMETRIC COMPUTATIONS IF TAIL PRESENT.
!
      IF(.NOT.HTPL)GO TO 1090
      COSAIH=COS(DEG*ALIH)
      XEP=(XH+XBARRH*COSAIH-JEALOC)
      TANTHJ=TAN(DEG*JEANGL)
      ZT=JEVLOC+JERAD*SINAIT/TANTHJ
      ZJP=XEP*SINAIT+(ZH-ZT)*COSAIT
      XEP=XEP/COSAIT
      XJP=4.6*JERAD
      XHP=XJP+XEP
      AIN=49.0*SQRT(AMBTMP)
      VIN=MACH(M)*AIN
      VJOVIN=JEVELO/VIN
      XEPORJ=XEP/JERAD
      ZJPOBH=ZJP/(2.0*BO2H)
      YTOB2H=JELLOC/BO2H
!
!     ----FIGURE 4.6.1-28 EFF. MEAN DOWNWASH ACTING ON HORT. TAIL
!
      CALL TLINEX(X16114,X26114,Y46114,6,8,YTOB2H,ZJPOBH,DEBODE,        &
     &            0,0,2,2,Q46114,2,ROUTID)
      KASE=3
      IF(JEVELO.GE.AIN)GO TO 1030
      KASE=1
      IF(XEPORJ.GT.16.0)KASE=2
 1030 GO TO (1040,1060,1070),KASE
!
!     ----COMPUTE PART OF CASE 1 WHICH IS NOT A FUNCTION OF ALPHA
!     ----SUBSONIC FREE STREAM , SUBSONIC JET . HORIZONTAL TAIL .LT. 8
!     ----EXIT DIAMETERS DOWNSTREAM OF JET EXIT PLANE.
!
 1040 TINOTJ=TMPINK(AMBTMP)/TMPINK(JESTMP)
!
!     ----FIGURE 4.6.1-29 VAR. OF EQUIV. VEL. RATIO TO ACTUAL VEL. RATIO
!
      CALL TLINEX(X16117,X26117,Y46117,13,4,TINOTJ,VJOVIN,VJPOVI,       &
     &            2,0,2,1,Q46129,2,ROUTID)
      IF(KASE.EQ.3) GO TO 1050
      ZJPORJ=ZJP/JERAD
!
!     ----FIGURE 4.6.1-31 A-C
!     ----FIGURE 4.6.1-31 DOWNWASH INCREMENT DUE TO A SUBSONIC JET IN A
!     ----SUBSONIC STREAM.
!
 1050 CALL FG6115(DE,XEPORJ,ZJPORJ,VJPOVI)
      GO TO 1080
!
!     ----COMPUTE PART OF CASE II WHICH IS NOT A FUNCTION OF ALPHA
!     ----SUBSONIC FREE STREAM SUBSONIC JET,HORIZONTAL TAIL LOCATED
!     ---MORE THAH 8 EXIT DIAMETERS DOWNSTREAM OF JET EXIT PLANE.
!
 1060 ZJPXHP=ZJP/XHP
      SRTPCO=SR*THSTCJ/(XHP**2)
!
!     ----FIGURE 4.6.1-31 DOWNWASH INCREM. SUBSON JET IN SUB. STREAM
!
      CALL TBFUNX(SRTPCO,ZJDEXH,Q,8,X6118A,Y6118A,C6118A,I6118A,MI,NG,  &
     &            0,1,Q46131,2,ROUTID)
      DE=ZJDEXH/ZJPXHP
      GO TO 1080
!
!     ----CASE III SUBSONIC FREE STREAM,SUPERSONIC JET,HORTZ TAIL IS
!         DOWNSTREAM OF THE FULLY EXPANDED FLOW.
!
 1070 PTEOPI=JETOTP/AMBSTP
!
!     ----FIGURE 4.6.1-32A
!
      CALL TBFUNX(PTEOPI,RJPORJ,Q,8,X6118B,Y6118B,C6118B,I6118B,MI,NG,  &
     &            2,2,Q6132A,3,ROUTID)
      RJP=JERAD*RJPORJ
!
!     ----FIGURE 4.6.1-32B
!
      CALL TBFUNX(RJPORJ,DXPORJ,Q,9,X6119A,Y6119A,C6119A,I6119A,MI,NG,  &
     &            0,2,Q6132B,3,ROUTID)
      DXP=DXPORJ*JERAD
      XEPC=XEP+DXP
      XHPC=XEPC+RJP/TANTHJ
      ZTP=JEVLOC-DXP*SINAIT
      ZJP=XHPC*SINAIT+COSAIT*(ZH-ZTP)
      ZJPOBH=ZJP/(2.0*BO2H)
      CALL TLINEX(X16114,X26114,Y46114,6,8,YTOB2H,ZJPOBH,DEBODE,        &
     &            0,0,2,2,Q46128,2,ROUTID)
      ZJPORJ=ZJP/RJP
      XEPORJ=XEPC/RJP
      GO TO 1040
 1080 COMP1=CLALPH*DE*DEBODE
!
!     ----COMPUTE JET POWER EFFECTS ON PITCHING MOMENT DUE TO OFFSET OF
!     ----THRUST AXIS
!
 1090 ZBART=COSAIT*(JEVLOC-ZCG)+SINAIT*(JEALOC-XCG)
      DCMT(1)=-THSTCJ*ZBART*NENGSJ/CBARR
 1100 CONTINUE
      DO 1110 J=1,NALPHA
!
!     ----COMPUTE LIFT COMPONENT DUE TO THRUST VECTOR (DCL)T
!
         ATP=ALSCHD(J)+AIETLJ
         SINATP=SIN(DEG*ATP)
         DCLT(J)=TPCNE*SINATP
!
!     ----COMPUTE LIFT DUE TO INCLINATION OF THRUST LINE
!
         EPSLON=DEUDA*(ALIW+ALSCHD(J)-ALPHA0)
         ATJ=ALSCHD(J)+AIETLJ+EPSLON
         SINATJ=SIN(DEG*ATJ)
         DCLNJ(J)=AINNE2*SINATJ
!
!     ----COMPUTE LIFT DUE TO HORIZONTAL TAIL IF IT IS PRESENT
!
         DCLHE(J)=0.0
         IF(HTPL)DCLHE(J)=COMP1*QHOQI(J)
!
!     ----COMPUTE TOTAL LIFT DUE TO POWER
!
         DCLPOW(J)=DCLNJ(J)+DCLT(J)+DCLHE(J)
!
!     ----COMPUTE JET POWER EFFECTS ON PITCHING MOMENT DUE TO NORMAL
!     ----FORCE ON THE ENGINE INLET.
!
         XL=JIALOC-XCG
         DCMNJ(J)=-DCLNJ(J)*XL/CBARR
!
!     ----COMPUTE JET POWER EFFECTS ON PITCHING MOMENT DUE TO THE CHANGE
!     ----IN ANGLE OF ATTACK OF THE HORIZONTAL TAIL.
!
         DLH=XH+XBARRH*COSAIH-XCG
         DCME(J)=-DCLHE(J)*DLH/CBARR
!
!     ----TOTAL JET POWER EFFECTS ON PITCHING MOMENT
!
         DCMPOW(J)=DCMT(1)+DCMNJ(J)+DCME(J)
!
!     ------A SINGLE ENGINE JET CHANGES THE BASE PRESSURE AND THUS
!     ALTERS CDO HOWEVER NO METHODS ARE DEFINED FOR THIS CHANGE IN DRAG
!     -------JET EFFECTS DO NOT CAUSE A CHANGE IN INDUCED DRAG
!     BECAUSE THEY DO NOT MODIFY THE AERODYNAMIC LIFT OF THE WING
!
         DCDPOW(J) = 0.0
 1110 END DO
      RETURN
      END
      SUBROUTINE LATFLP
      REAL KYAW,KYAZ
      REAL MACH  ,KPRML(5),KPRMR(5)
      REAL KFACTR(10),KSSD,KC
      LOGICAL TIPCAL
      DIMENSION CLDLT(10),CLDRT(10),CLROLT(10),CNTEMP(2,200)
      DIMENSION ROUTID(2)
      DIMENSION X1132B(4),X2132B(11),Y1132B(44),F1132B(3)
      DIMENSION CLROLL(10),ANS(5),BCLOK(5),DBCLOK(5),CLDPM(5)
      DIMENSION CHRD(5),VAR(4),LGH(4),ETA(5),DELTAS(10),CLSSDF(10)
      COMMON /OVERLY/NLOG,NMACH,I,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /IHT/    PHT,HT(380)
      COMMON /HTI/    HTIN(131)
      COMMON /IBODY/  PBODY,BODY(400)
      COMMON /HTDATA/ AHT(195),BHT(49)
      COMMON /WINGI/  WINGIN(77)
      COMMON /POWR/   PW(59),FLA(45)
      COMMON /FLAPIN/ F(69)
      COMMON /WINGD/  A(195),B(49)
      COMMON /WBHCAL/ WBT(155)
      COMMON /IDWASH/ PDWASH,DWASH(60)
      COMMON /IWING/  PWING,WING(400)
      COMMON /SUPDW/  DW(35),TCD(58)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL         FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      DIMENSION X11126(7),X21126(14),Y11126(98),F11126(3)
      DIMENSION X1125A(8),X2125A(8),Y1125A(64),F1125A(3)
      DIMENSION X1125B(16),X2125B( 6),Y1125B(96),F1125B(3)
      DIMENSION X2128A(11),X1128A(3),Y1128A(33),F1128A(3)
      DIMENSION X21123(11),X11123(4),X31123(3),X41123(3),Y21123(396),   &
     &          F21123(3),Y1(44),Y2(44),Y3(44),Y4(44),Y5(44),Y6(44),    &
     &          Y7(44),Y8(44),Y9(44),YG(396)
      DIMENSION X22219(7),X12219(4),X32219(4),Y62219(112),F62219(3)
      DIMENSION X2110A(6),X1110A(5),Y2110A(30),F2110A(3)
      DIMENSION X2110B(6),X1110B(4),Y2110B(24),F2110B(3)
      DIMENSION X2110C(2),X1110C(2),Y2110C(4),F2110C(3)
      DIMENSION X2110D(2),X1110D(4),Y2110D(8),F2110D(3)
      DIMENSION X211A0(5),X111A0(4),Y111A0(20),F111A0(3)
      DIMENSION X211A1(3),X111A1(3),Y111A1(9),F111A1(3)
      DIMENSION X211A2(3),X111A2(2),Y111A2(6),F111A2(3)
      DIMENSION X111A3(3),Y111A3(3),F111A3(3)
      DIMENSION X1111B(3),X2111B(2),Y2111B(6),F2111B(3)
      DIMENSION X1111C(4),X2111C(2),Y2111C(8),F2111C(3)
      DIMENSION X1111D(3),X2111D(2),Y2111D(6),F2111D(3)
      DIMENSION X2111E(2),Y2111E(2),F2111E(3)
      DIMENSION X22112(12),Y22112(12),F22112(3)
      DIMENSION X1126A(14),Y1126A(14),F1126A(3)
      DIMENSION DDOC(10)
      DIMENSION X6226B(10),Y6226B(10),F6226B(3)
      EQUIVALENCE (DDOC(1),F(1))
      EQUIVALENCE (Y1(1),YG(1)),(Y2(1),YG(45)),(Y3(1),YG(89)),(Y4(1),   &
     &      YG(133)),(Y5(1),YG(177)),(Y6(1),YG(221)),(Y7(1),YG(265)),   &
     &      (Y8(1),YG(309)),(Y9(1),YG(353)),(YG(1),Y21123(1))
      DIMENSION X62122(6),Y62122(6),F62122(3)
      DIMENSION RIVBH(20),GAMVR(20),DEDALP(20)
      DIMENSION CLROL(200),CLDH(20),CF(5)
      DIMENSION CFOC(5),DELTAL(10),DELTAR(10),DCLL(5),CLDOCT(5),        &
     &          CLDTHY(5),DCLR(5),DLCL(4),DRCL(4),ALDL(4),              &
     &          ALDR(4),CLDL(10),CLDR(10),CLW(20),CLDELT(10),CN(200),   &
     &          XSOC(10),CNODS(10),DSOC(10),CNSPOL(10),HSOC(10)
      DIMENSION WTYPE(4)
      EQUIVALENCE (SWEEPB,FLA(1)),(BCLOKI,FLA(2)),(BCLOKO,FLA(3)),      &
     &            (BCLDOK,FLA(4)),(CLDPRM,FLA(5)),(CLDL(1),FLA(6)),     &
     &            (CLDR(1),FLA(16)),(CLROLL(1),HT(211)),                &
     &            (SBACKI,FLA(36)),(THETAI,FLA(37)),(DELETO,FLA(38)),   &
     &            (DELETI,FLA(39)),(ETAIEF,FLA(40)),(ETAOEF,FLA(41))
      EQUIVALENCE (BCLDI,FLA(42)),(BCLDO,FLA(43)),(KFACTR(1),FLA(26)),  &
     &            (CNSPOL(1),HT(221)),(KYAW,FLA(45))
      EQUIVALENCE (BO2H,HTIN(4)),(BO2HST,HTIN(3)),(AWHST,AHT(7)),       &
     &            (SHST,AHT(3)),(RIVBH(1),WBT(68)),(GAMVR(1),WBT(46)),  &
     &            (DEDALP(1),DWASH(41))
      EQUIVALENCE (DELTAL(1),F(19)),(DELTAR(1),F(29)),(XSPRME,F(59))
      EQUIVALENCE (BOF,F(15)) ,(TANLE,A(62)),(STYPE,F(18))
      EQUIVALENCE (CN(1),BODY(201)),(WING(201),CLROL(1))
      EQUIVALENCE (TANC4,A(68)),(AW,A(120)),(TAPRW,A(118)),(SWEPTE,A(76)&
     &             ),(COSTE,A(79)),(CLW(1),WING(21))
      EQUIVALENCE (CR,WINGIN(6)),(COSC4,A(67)),(CBAREX,A(16)),          &
     &            (BO2,WINGIN(4)),(SWEPLE,A(58)),(TANTE,A(80)),         &
     &            (TOVC,WINGIN(16))
      EQUIVALENCE (BIF,F(14)),(TANPHE,F(11)),(CFI,F(12)),(CFO,F(13)),   &
     &            (XSOC(1),F(49)),(DSOC(1),F(39)),(HSOC(1),F(60)),      &
     &            (GD1,TCD(43)),(GD2,TCD(44)),(GD3,TCD(45)),            &
     &            (GD4,TCD(46))
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA ROUTID/4HLATF,4HLP  /
!
!                   FIGURE 4.1.1.2-8A
!
      DATA X2128A                                                       &
     &  /0., 0.02,  0.04,  0.06,  0.08,  0.10,  0.12,  0.14,  0.16,     &
     &       0.18,  0.20 /
      DATA X1128A                                                       &
     &        /1.,     10.,    100./
      DATA Y1128A                                                       &
     & / 0.900,  0.878,  0.858,  0.836,  0.815,  0.794,  0.772,  0.750, &
     &   0.728,  0.708,  0.685,                                         &
     &   0.950,  0.938,  0.924,  0.907,  0.894,  0.878,  0.860,  0.842, &
     &   0.822,  0.802,  0.780,                                         &
     &   0.966,  0.957,  0.947,  0.936,  0.924,  0.910,  0.896,  0.880, &
     &   0.862,  0.842,  0.822 /
      DATA F1128A/4H4.1.,4H1.2-,4H8A  /
!
!                   FIGURE 6.1.1.1-39A
!
      DATA X2125A                                                       &
     & / 0.05,  0.10,  0.15,  0.20,  0.25,  0.30,  0.40,  0.50 /
      DATA X1125A                                                       &
     & / 0.00,  0.02,  0.04,  0.06,  0.08,  0.10,  0.12,  0.15 /
      DATA Y1125A                                                       &
     & / 1.770,  2.500,  3.000,  3.460,  3.820,  4.160,  4.690,  5.140, &
     &   1.770,  2.515,  3.030,  3.500,  3.873,  4.220,  4.780,  5.240, &
     &   1.770,  2.530,  3.060,  3.540,  3.926,  4.290,  4.870,  5.350, &
     &   1.770,  2.545,  3.090,  3.580,  3.979,  4.350,  4.950,  5.460, &
     &   1.770,  2.560,  3.120,  3.620,  4.032,  4.400,  5.040,  5.560, &
     &   1.770,  2.575,  3.150,  3.660,  4.085,  4.480,  5.120,  5.690, &
     &   1.770,  2.590,  3.180,  3.700,  4.138,  4.550,  5.210,  5.790, &
     &   1.770,  2.600,  3.220,  3.740,  4.190,  4.620,  5.330,  5.960/
      DATA F1125A/4H6.1.,4H1.1-,4H39A /
!
!                   FIGURE 6.1.1.1-39B
!
      DATA X2125B                                                       &
     &  / 0.05,  0.10,  0.15,  0.20,  0.25,  0.50 /
      DATA X1125B                                                       &
     &  / 0.70,  0.72,  0.74,  0.76,  0.78,  0.80,  0.82,  0.84,  0.86, &
     &    0.88,  0.90,  0.92,  0.94,  0.96,  0.98,  1.00 /
      DATA Y1125B                                                       &
     & /  .356,    .382,    .409,    .431,    .452,    .548,            &
     &    .399,    .426,    .452,    .477,    .498,    .583,            &
     &    .442,    .471,    .499,    .523,    .543,    .619,            &
     &    .485,    .521,    .548,    .569,    .589,    .659,            &
     &    .530,    .569,    .594,    .613,    .630,    .693,            &
     &    .578,    .614,    .639,    .657,    .671,    .729,            &
     &    .619,    .655,    .678,    .692,    .709,    .761,            &
     &    .659,    .696,    .713,    .733,    .746,    .793,            &
     &    .700,    .734,    .750,    .765,    .778,    .819,            &
     &    .742,    .771,    .789,    .800,    .810,    .850,            &
     &    .784,    .809,    .824,    .838,    .843,    .875,            &
     &    .826,    .843,    .860,    .865,    .873,    .900,            &
     &    .865,    .885,    .895,    .900,    .903,    .921,            &
     &    .910,    .921,    .928,    .931,    .933,    .938,            &
     &    .951,    .962,    .964,    .966,    .967,    .968,            &
     &   1.000,   1.000,   1.000,   1.000,   1.000,   1.000/
      DATA F1125B/4H6.1.,4H1.1-,4H39B /
!
!                   FIGURE 6.1.1.1-40
!  CTAB4(1,I)  = FLAP DEFLECTION ANGLE  (DEG)
!  CTAB4(2,I)  = FLAP TO A1RFOIL CHORD RATIO
!  KPRIME(I)   = EMPIRICAL CORRECTION FACTOR
!
      DATA X21126                                                       &
     & / 0., 10., 12., 14., 16., 18., 20., 23., 27., 30., 35., 40.,     &
     &  50., 60. /
      DATA X11126                                                       &
     & / 0.10, 0.15, 0.20, 0.25, 0.30, 0.40, 0.50 /
      DATA Y11126                                                       &
     & /  1.000,  1.000,  0.994,  0.989,  0.970,  0.938,  0.900, 0.829, &
     &    0.755,  0.722,  0.672,  0.641,  0.596,  0.562,                &
     &    1.000,  1.000,  0.994,  0.989,  0.970,  0.937,  0.890, 0.809, &
     &    0.737,  0.698,  0.650,  0.618,  0.569,  0.531,                &
     &    1.000,  1.000,  0.994,  0.989,  0.968,  0.936,  0.870, 0.783, &
     &    0.710,  0.673,  0.630,  0.595,  0.542,  0.500,                &
     &    1.000,  1.000,  0.994,  0.989,  0.965,  0.935,  0.850, 0.740, &
     &    0.677,  0.644,  0.600,  0.569,  0.518,  0.480,                &
     &    1.000,  1.000,  0.994,  0.989,  0.963,  0.905,  0.800, 0.700, &
     &    0.643,  0.610,  0.570,  0.541,  0.496,  0.461,                &
     &    1.000,  1.000,  0.993,  0.969,  0.924,  0.860,  0.750, 0.656, &
     &    0.606,  0.579,  0.540,  0.513,  0.471,  0.440,                &
     &    1.000,  1.000,  0.981,  0.943,  0.880,  0.790,  0.695, 0.625, &
     &    0.571,  0.542,  0.512,  0.490,  0.450,  0.423/
      DATA F11126/4H6.1.,4H1.1-,4H40  /
!
!                  FIGURE 6.2.1.1-23A-C
!
      DATA F21123/4H6.2.,4H1.1-,4H23  /
      DATA X21123                                                       &
     & / 0., .1, .2, .3,  .4, .5, .6, .7, .8, .9, 1. /
      DATA X11123                                                       &
     & / -40., 0., 40., 60. /
      DATA X31123                                                       &
     & / 2., 4., 8. /
      DATA X41123                                                       &
     & / 0., 0.5, 1. /
      DATA Y1                                                           &
     & / 0.000,   0.005,  0.014,  0.030,  0.055,  0.087,  0.126,        &
     &   0.163,   0.197,  0.222,  0.245,                                &
     &   0.000,   0.005,  0.017,  0.036,  0.063,  0.100,  0.144,        &
     &   0.185,  0.224,  0.262,  0.282,                                 &
     &   0.000,  0.005,  0.017,  0.036,  0.064,  0.103,  0.149,         &
     &   0.192,  0.230,  0.264,  0.282,                                 &
     &   0.000,  0.005,  0.017,  0.036,  0.062,  0.098,  0.136,         &
     &   0.178,  0.215,  0.243,  0.259 /
      DATA Y2                                                           &
     & / 0.000,  0.007,  0.027,  0.054,  0.097,  0.145,  0.197,         &
     &   0.243,  0.292,  0.333,  0.363,                                 &
     &   0.000,  0.008,  0.029,  0.064,  0.113,  0.173,  0.235,         &
     &   0.300,  0.363,  0.414,  0.445,                                 &
     &   0.000,  0.008,  0.029,  0.064,  0.119,  0.180,  0.245,         &
     &   0.313,  0.374,  0.417,  0.443,                                 &
     &   0.000,  0.008,  0.029,  0.063,  0.108,  0.163,  0.220,         &
     &   0.273,  0.319,  0.350,  0.363 /
      DATA Y3                                                           &
     & / 0.000,  0.006,  0.032,  0.080,  0.145,  0.212,  0.275,         &
     &   0.336,  0.394,  0.446,  0.485,                                 &
     &   0.000,  0.012,  0.043,  0.093,  0.165,  0.255,  0.354,         &
     &   0.445,  0.525,  0.587,  0.627,                                 &
     &   0.000,  0.013,  0.045,  0.106,  0.189,  0.280,  0.375,         &
     &   0.465,  0.542,  0.592,  0.612,                                 &
     &   0.000,  0.013,  0.045,  0.106,  0.187,  0.258,  0.327,         &
     &   0.390,  0.443,  0.475,  0.485 /
      DATA Y4                                                           &
     & / 0.000,  0.006,  0.017,  0.038,  0.066,  0.100,  0.142,         &
     &   0.185,  0.232,  0.273,  0.293,                                 &
     &   0.000,  0.007,  0.023,  0.048,  0.079,  0.114,  0.154,         &
     &   0.200,  0.249,  0.284,  0.311,                                 &
     &   0.000,  0.007,  0.023,  0.048,  0.079,  0.114,  0.154,         &
     &   0.198,  0.240,  0.276,  0.304,                                 &
     &   0.000,  0.007,  0.023,  0.043,  0.072,  0.106,  0.148,         &
     &   0.190,  0.232,  0.264,  0.286 /
      DATA Y5                                                           &
     & / 0.000,  0.006,  0.025,  0.060,  0.100,  0.151,  0.214,         &
     &   0.294,  0.370,  0.430,  0.479,                                 &
     &   0.000,  0.009,  0.033,  0.075,  0.125,  0.185,  0.259,         &
     &   0.348,  0.427,  0.491,  0.538,                                 &
     &   0.000,  0.009,  0.033,  0.075,  0.125,  0.185,  0.259,         &
     &   0.340,  0.413,  0.472,  0.515,                                 &
     &   0.000,  0.008,  0.026,  0.065,  0.113,  0.170,  0.231,         &
     &   0.294,  0.350,  0.398,  0.432 /
      DATA Y6                                                           &
     & / 0.000,  0.007,  0.034,  0.072,  0.125,  0.187,  0.270,         &
     &   0.371,  0.480,  0.580,  0.662,                                 &
     &   0.000,  0.014,  0.052,  0.108,  0.180,  0.275,  0.390,         &
     &   0.510,  0.620,  0.718,  0.800,                                 &
     &   0.000,  0.014,  0.052,  0.113,  0.190,  0.280, 0.385,          &
     &   0.485,  0.578,  0.658,  0.729,                                 &
     &   0.000,  0.014,  0.052,  0.103,  0.163,  0.234,  0.308,         &
     &   0.379,  0.445,  0.504,  0.554 /
      DATA Y7                                                           &
     & / 0.000,  0.003,  0.015,  0.037,  0.065,  0.103,  0.147,         &
     &   0.190,  0.237,  0.280,  0.306,                                 &
     &   0.000,  0.004,  0.020,  0.045,  0.079,  0.118,  0.159,         &
     &   0.205,  0.252,  0.291,  0.315,                                 &
     &   0.000,  0.004,  0.020,  0.045,  0.079,  0.114,  0.156,         &
     &   0.200,  0.246,  0.286,  0.310,                                 &
     &   0.000,  0.004,  0.020,  0.045,  0.073,  0.108,  0.147,         &
     &   0.187,  0.230,  0.268,  0.291 /
      DATA Y8                                                           &
     & / 0.000,  0.008,  0.033,  0.063,  0.108,  0.162,  0.225,         &
     &   0.303,  0.389,  0.453,  0.500,                                 &
     &   0.000,  0.008,  0.033,  0.072,  0.122,  0.187,  0.260,         &
     &   0.348,  0.437,  0.504,  0.558,                                 &
     &   0.000,  0.008,  0.033,  0.072,  0.122,  0.187,  0.258,         &
     &   0.335,  0.413,  0.474,  0.522,                                 &
     &   0.000,  0.008,  0.033,  0.070,  0.110,  0.165,  0.229,         &
     &   0.290,  0.347,  0.400,  0.445 /
      DATA Y9                                                           &
     & / 0.000,  0.010,  0.035,  0.070,  0.118,  0.192,  0.291,         &
     &   0.405,  0.520,  0.626,  0.721,                                 &
     &   0.000,  0.014,  0.049,  0.104,  0.179,  0.275,  0.393,         &
     &   0.520,  0.653,  0.768,  0.850,                                 &
     &   0.000,  0.014,  0.050,  0.109,  0.186,  0.284,  0.393,         &
     &   0.505,  0.602,  0.690,  0.763,                                 &
     &   0.000,  0.014,  0.040,  0.094,  0.155,  0.230,  0.306,         &
     &   0.380,  0.458,  0.519,  0.578 /
!
!     ----FIGURE 6.2.2.1-9
!
      DATA X22219/.0,.2,.4,.6,.7,.8,.9/,X12219/3.,4.,6.,8./,            &
     & X32219/.25,.5,.75,1.0/,F62219/4H6.2.,4H2.1-,4H9   /,             &
     & Y62219/-.285,-.278,-.275,-.282,-.289,-.30,-.315 , -.234,-.223,   &
     & -.217,-.220,-.223,-.226,-.230 , -.160,-.152,-.146,-.146,-.150,   &
     & -.162,-.175 , -.120,-.116,-.110,-.106,-.112,-.125,-.140 ,        &
     & -.338,-.336,-.338,-.340,-.347,-.355,-.364, -.250,-.250,-.252,    &
     & -.258,-.264,-.270,-.280 , -.170,-.170,-.172,-.182,-.190,-.202,   &
     & -.219 , -.130,-.131,-.132,-.136,-.145,-.158,-.175 ,-.327,-.327,  &
     & -.330 , -.340,-.362,-.390,-.430 , -.261,-.261,-.265,-.280,-.294, &
     & -.307,-.323 , -.179,-.179,-.186,-.20,-.212,-.225,-.240 , -.138,  &
     & -.138,-.140,-.159,-.172,-.184,-.195 , 7*-.361 , -.262,-.267,-.279&
     &,-.295,-.305,-.315,-.325 , -.182,-.190,-.20,-.219,-.232,-.248,    &
     &-.270 , -.145,-.150,-.160,-.175,-.187,-.202,-.223 /
!
!     ----FIGURE 6.2.2.1-10 A-E
!
      DATA X2110A/.0,.3,.5,.7,.9,1.0/,X1110A/.4,.6,.8,.9,1.0/,          &
     & F2110A/4H6.2.,4H2.1-,4H10A /,                                    &
     & Y2110A/.0,.2,.24,.32,.44,.49 , .0,.5,.8,1.20,1.53,1.70 , .0,.91, &
     & 1.45,2.0,2.42,2.68 , .0,1.38,2.10,2.75,3.30,3.55 , 0.,1.68,2.60, &
     & 3.50,4.20,4.40 /
      DATA X2110B/0.,1.,2.,3.,4.,5./,X1110B/2.,3.,6.,10./,              &
     & F2110B/4H6.2.,4H2.1-,4H10B /,                                    &
     & Y2110B/.0,.5,1.0,1.35,1.65,1.85 , .0,.7,1.35,1.85,2.23,2.48 ,    &
     & .0,.98,1.75,2.45,3.05,3.44 , .0,1.0,1.95,2.95,3.90,4.88 /
      DATA X2110C/0.,5./,X1110C/.4,1.0/,F2110C/4H6.2.,4H2.1-,4H10C /,   &
     & Y2110C/0.,5.05 , 0.,8.4 /
      DATA X2110D/0.,5./,X1110D/.5,.6,.7,.8/,F2110D/4H6.2.,4H2.1-,4H10D &
     & /,Y2110D/.0,.310 , .0,.268 , .0,.20 , .0,.146 /
!
!     -----FIGURE 6.2.2.1-11 A-E
!     ----FIGURE 6.2.2.1-11 A IS BROKEN INTO 4 SEPARATE PARTS
!
      DATA X211A0/.0,.1,.2,.3,.4/,X111A0 /.4,.6,.8,1.0/,F111A0/4H6.2.,  &
     & 4H2.1-,4H11A0/,Y111A0/.0,.55,1.0,1.35,1.50 , 0.,.79,1.45,2.0,2.5 &
     & , 0.,1.0,2.0,2.8,3.55 , 0.,1.6,3.0,4.25,5.3 /
      DATA X211A1/.4,.5,.6/,X111A1/.6,.8,1.0/,F111A1/4H6.2.,4H2.1-,     &
     & 4H11A1/,Y111A1/2.5,2.75,2.80 ,3.55,4.2,4.4 , 5.3,6.,6.55/
      DATA X211A2/.6,.7,.8/,X111A2/.8,1.0/,F111A2/4H6.2.,4H2.1-,4H11A2/,&
     & Y111A2/4.4,4.5,4.3 , 6.55,6.86,7.0 /
      DATA X111A3/.8,.9,1.0/,Y111A3/7.0,6.8,6.28/,F111A3/4H6.2.,4H2.1-, &
     & 4H11A3/
      DATA X1111B/2.,4.,6./,X2111B/0.,7./,Y2111B/0.,2.85 ,0.,3.50 , 0., &
     & 3.75/,F2111B/4H6.2.,4H2.1-,4H11B /
      DATA X1111C/0.,.4,.6,1.0/,X2111C/0.,5./,F2111C/4H6.2.,4H2.1-,4H11B&
     & /,Y2111C/0.,7.45 , 0.,8.6 , 0.,10.0 , 0.,16.5 /
      DATA X1111D/20.,45.,60./,X2111D/0.,8./,Y2111D/0.,.153 ,0.,.172 ,0.&
     &,.193 /,F2111D/4H6.2.,4H2.1-,4H11D /
      DATA X2111E/0.,.10/,Y2111E/0.,.150/,F2111E/4H6.2.,4H2.1-,4H11E /
!
!     ----FIGURE 6.2.2.1-12 SPOILER-SLOT-DEFLECTOR
!
      DATA X22112/.175,.3,.4,.5,.6,.7,.8,.9,1.0,1.1,1.15,1.25/,         &
     & Y22112/2.3,2.33,2.34,2.32,2.29,2.22,2.09,1.81,1.53,1.38,1.37,1.49&
     &/,F22112/4H6.2.,4H2.1-,4H12  /
!
!     ----FIGURE 6.2.1.1-26A
!
      DATA X1126A/0.,2.5,5.,7.5,10.,12.5,15.,17.5,20.,25.,30.,35.,40.,  &
     & 45./,F1126A/4H6.2.,4H1.1-,4H26A /,                               &
     & Y1126A/0.,9.,13.,16.,18.5,20.6,22.4,23.7,25.0,27.3,29.0,30.4,31.2&
     &,31.6/
!
!     ----FIGURE 6.1.1.1-51B SPOILER LIFT EFFECTIVENESS-LOW SPEEDS.
!
      DATA X1132B/.5,.6,.7,.8/,X2132B/.06,.07,.08,.09,.10,.11,.12,.14,  &
     &.16,.18,.19/,F1132B/4H6.1.,4H1.1-,4H51B /,Y1132B/                 &
     & .012,.046,.068,.086,.102,.116,.126,.143,.158,.167,.170 ,         &
     & .046,.064,.080,.095,.108,.121,.130,.149,.164,.175,.180 ,         &
     & .054,.072,.088,.102,.116,.128,.137,.154,.170,.181,.186 ,         &
     & .080,.093,.105,.117,.126,.136,.144,.160,.175,.189,.196 /
      DATA F62122/4H6.2.,4H1.2-,4H22  /
!
!              FIGURE 6.2.1.1-26B
!
      DATA X6226B/0.68,.770,1.0,1.17,1.50,2.0,2.5,3.0,3.5,4.0/
      DATA Y6226B/0.70,1.0,1.36,1.50,1.65,1.73,1.72,1.64,1.50,1.33/
      DATA F6226B/4H6.2.,4H1.1-,4H26B /
      DATA X62122/.165,.2,.25,.3,.35,.40/
      DATA Y62122/.830,.818,.779,.738,.680,.615/
!
      TIPCAL=.FALSE.
      NDELTA=F(16)+0.5
      RF=FLC(I+42)
      MACH=FLC(I+2)
      IF(TRANSN)MACH=.6
      BETA=SQRT(1.-MACH**2)
      CLASEC=WINGIN(I+20)
      IF(TRANSN)CLASEC=WINGIN(69)/.8
      SCALE=(2*WINGIN(4)*A(4))/(BLREF*SREF)
      IF(STYPE.EQ.5.)GO TO 1270
      ARG1=TANC4/BETA
      SWEEPB=ATAN(ARG1)*RAD
      KC=CLASEC*BETA/(2.*PI) *RAD
      DELN4=0.25*(BOF-BIF)/BO2
      ETA(1)=BIF/BO2
      ETA(5)=BOF/BO2
      IF(STYPE.NE.4.)GO TO 1160
      ARG1=(CFI-CFO)/(4.*DELN4)
      ARG2=(TANTE-TANLE)*BO2
 1000 DO 1010 K=1,5
         N=K-1
         IF(N.NE.0)ETA(K)=ETA(N)+DELN4
         CF(K)=CFI-ARG1*(ETA(K)-ETA(1))
         CHRD(K)=CR+ETA(K)*ARG2
         CFOC(K)=CF(K)/CHRD(K)
 1010 END DO
!
!              FIGURE 6.2.1.1-23A-C
!
      ARG1=BETA*AW/KC
!
!------CALCULATE THE ROLLING MOMENT EFFECTIVENESS PARAMETER
!
      ARG2=ETA(1)
      DO 1020 J=1,5
         CALL TLIN4X(X11123,X21123,X31123,X41123,Y21123,4,11,3,3,SWEEPB,&
     &           ARG2,ARG1,TAPRW,ANS(J),0,0,0,0,0,0,0,0,F21123,3,ROUTID)
         BCLOK(J)=ANS(J)
         ARG2=ARG2+DELN4
 1020 END DO
      DO 1030 J=1,4
         DBCLOK(J)=BCLOK(J+1)-BCLOK(J)
         CLDPM(J)=DBCLOK(J)*KC/BETA
 1030 END DO
      BCLOKI=ANS(1)
      BCLOKO=ANS(5)
      BCLDOK=BCLOKI
      BCLOKO=BCLOKI-BCLOKI
      CLDPRM=BCLDOK*KC/BETA
      NN=0
      ARG1=ALOG10(RF*CBAREX)
!
!              FIGURE 4.1.1-2-8A
!
      CALL TLINEX(X1128A,X2128A,Y1128A,3,11,ARG1,TANPHE,CLOCLT,         &
     &            0,0,0,0,F1128A,3,ROUTID)
      DO 1060 J=1,NDELTA
         ARG=ABS(DELTAL(J))
         ARG1=ABS(DELTAR(J))
         DO 1040 K=1,5
!
!              FIGURE 6.1.1.1-39A
!
            CALL TLINEX(X1125A,X2125A,Y1125A,8,8,TOVC,CFOC(K),CLDTHY(K),&
     &                  0,0,0,0,F1125A,3,ROUTID)
!
!              FIGURE 6.1.1.1-39B
!
            CALL TLINEX(X1125B,X2125B,Y1125B,16,6,CLOCLT,CFOC(K),       &
     &                 CLDOCT(K),0,0,0,0,F1125B,3,ROUTID)
!
!              FIGURE 6.1.1.1-40
!
            CALL TLINEX(X11126,X21126,Y11126,7,14,CFOC(K),ARG,KPRML(K), &
     &                  0,0,0,0,F11126,3,ROUTID)
            ARG2=CLDOCT(K)*CLDTHY(K)
            DCLL(K)=ARG2               *KPRML(K)
!
!              FIGURE 6.1.1.1-40
!
            CALL TLINEX(X11126,X21126,Y11126,7,14,CFOC(K),ARG1,KPRMR(K),&
     &                  0,0,0,0,F11126,3,ROUTID)
            DCLR(K)=ARG2*KPRMR(K)
            IF(K.EQ.1)GO TO 1040
            N=K-1
            DLCL(N)=(DCLL(K)+DCLL(N))/2.0
            DRCL(N)=(DCLR(K)+DCLR(N))/2.0
            ALDL(N)=ABS(DLCL(N)/CLASEC)/RAD
            ALDR(N)=ABS(DRCL(N)/CLASEC)/RAD
 1040    CONTINUE
         IF(.NOT.TIPCAL) GO TO 1050
         CLDLT(J)=(CLDPM(1)*ALDL(1)+CLDPM(2)*ALDL(2)+CLDPM(3)*ALDL(3)+  &
     &             CLDPM(4)*ALDL(4))
         CLDRT(J)=(CLDPM(1)*ALDR(1)+CLDPM(2)*ALDR(2)+CLDPM(3)*ALDR(3)+  &
     &            CLDPM(4)*ALDR(4))
         CLROLT(J)=(CLDLT(J)*DELTAL(J)/RAD-CLDRT(J)*DELTAR(J)/RAD)/2.   &
     &             *SCALE
         GO TO 1060
 1050    CLDL(J)=(CLDPM(1)*ALDL(1)+CLDPM(2)*ALDL(2)+CLDPM(3)*ALDL(3)+   &
     &            CLDPM(4)*ALDL(4))
         CLDR(J)=(CLDPM(1)*ALDR(1)+CLDPM(2)*ALDR(2)+CLDPM(3)*ALDR(3)+   &
     &           CLDPM(4)*ALDR(4))
         CLROLL(J)=(CLDL(J)*DELTAL(J)/RAD-CLDR(J)*DELTAR(J)/RAD)/2.     &
     &             *SCALE
 1060 END DO
      IF(ETA(5).GE..98) GO TO 1100
      TIPCAL=.TRUE.
      CFIX=CFI
      CFOX=CFO
      BOFX=BOF
      BIFX=BIF
      BCLKI=BCLOKI
      BCLKO=BCLOKO
      BCLDK=BCLDOK
      CLDP=CLDPRM
      L=1
      DELN4=0.25*(BO2-BIF)/BO2
      ETA(1)=BIF/BO2
      ETA(5)=1.0
      CFT=CFI-(CFI-CFO)*(BO2-BIF)/(BOF-BIF)
      ARG1=(CFI-CFT)/(4.*DELN4)
      ARG2=(TANTE-TANLE)*BO2
      GO TO 1090
 1070 CFI=CFO
      DELN4=0.25*(BO2-BOF)/BO2
      ETA(1)=BOF/BO2
      ARG1=(CFI-CFT)/(4.*DELN4)
      ARG2=(TANTE-TANLE)*BO2
      DO 1080 J=1,NDELTA
 1080 CLROLL(J)=CLROLT(J)
 1090 CONTINUE
      GO TO 1000
 1100 CONTINUE
!
!------YAWING MOMENT COEFFICIENT DUE TO ASYMMETRIC FLAP DEFLECTION OF
!      PLAIN TRAILING-EDGE FLAPS
!              FIGURE 6.2.2.1-9  KYAW
!
      CALL TLIN3X(X12219,X22219,X32219,Y62219,4,7,4,AW,ETA(1),TAPRW,KYAW&
     &            ,0,0,0,0,0,0,F62219,3,ROUTID)
      IF(.NOT.TIPCAL) GO TO 1140
      NN=0
      DO 1110 N=1,NALPHA
         DO 1110 J=1,NDELTA
            NN=NN+1
            CNTEMP(L,NN)=KYAW*CLW(N)*CLROLT(J)
            IF(ABS(CLW(N)) .EQ. UNUSED) CNTEMP(L,NN)=KYAW*FLC(N+22)*    &
     &                                    WING(101)*CLROLT(J)
 1110 CONTINUE
      L=L+1
      IF(L.EQ.2) GO TO 1070
      NN=0
      DO 1120 N=1,NALPHA
         DO 1120 J=1,NDELTA
            NN=NN+1
            CN(NN)=CNTEMP(1,NN)-CNTEMP(2,NN)
 1120 CONTINUE
      CFI=CFIX
      CFO=CFOX
      BOF=BOFX
      BIF=BIFX
      BCLOKI=BCLKI
      BCLOKO=BCLKO
      BCLDOK=BCLDK
      CLDPRM=CLDP
      DO 1130 J=1,NDELTA
 1130 CLROLL(J)=CLROLL(J)-CLROLT(J)
      GO TO 1290
 1140 NN=0
      DO 1150 N=1,NALPHA
         DO 1150 J=1,NDELTA
            NN=NN+1
            CN(NN)= KYAW*CLW(N)*CLROLL(J)
            IF(ABS(CLW(N)) .EQ. UNUSED) CN(NN)=KYAW*FLC(N+22)*          &
     &                                    WING(101)*CLROLL(J)
 1150 CONTINUE
      GO TO 1290
 1160 CONTINUE
!
!------ROLLING MOMENT COEFFICIENT FOR PLUG OR FLAP TYPE SPOILERS
!------CALCULATE ETA(EFFECTIVE)
!
      ARG1=0.75-(1.-XSPRME)
      ARG2=(1.-TAPRW)/(1.+TAPRW)
      TANSI=TANC4-4.0*ARG1/AW*ARG2
      SBACKI=ATAN(TANSI)*RAD
!
!              FIGURE 6.2.1.1-26A
!
      VAR(1)=SBACKI
      LGH(1)=14
      CALL INTERX(1,X1126A,VAR,LGH,Y1126A,THETAI,14,14,                 &
     &            0,0,0,0,0,0,0,0,F1126A,3,ROUTID)
      ARG1=4.*(1.-XSPRME)/(AW*(1.+TAPRW))
      ARG2=1.-(1.-TAPRW)*ETA(1)
      ARG3=COSTE*SIN(THETAI/RAD)/COS((SWEPTE+THETAI)/RAD)
      DELETI=ARG1*ARG2*ARG3
      ARG2=1.-(1.-TAPRW)*ETA(5)
      DELETO=ARG1*ARG2*ARG3
      ETAIEF=ETA(1)+DELETI
      ETAOEF=ETA(5)+DELETO
!
!------CALCULATE CLD(PRIME) AND THE ROLLING MOMENT COEFICIENT
!
      ARG4=BETA*AW/KC
!
!              FIGURE 6.2.1.1-23A-C (INBOARD)
!
      CALL TLIN4X(X11123,X21123,X31123,X41123,Y21123,4,11,3,3,SBACKI,   &
     &       ETAIEF,ARG4,TAPRW,BCLDI,0,0,0,0,0,0,0,0,F21123,3,ROUTID)
!
!              FIGURE 6.2.1.1-23A-C (OUTBOARD)
!
      CALL TLIN4X(X11123,X21123,X31123,X41123,Y21123,4,11,3,3,SBACKI,   &
     &       ETAOEF,ARG4,TAPRW,BCLDO,0,0,0,0,0,0,0,0,F21123,3,ROUTID)
      CLDPRM=KC*(BCLDO-BCLDI)/BETA
      ARG1=CLDPRM/2.0
      DO 1170 J=1,NDELTA
!
!              FIGURE 6.1.1.1-51B
!
         CALL TLINEX(X1132B,X2132B,Y1132B,4,11,XSOC(J),HSOC(J),         &
     &               DELTAS(J),0,0,0,0,F1132B,3,ROUTID)
 1170    CLROLL(J)=ARG1*DELTAS(J) *SCALE
!
!------HERE FOR SPOILER-SLOT-DEFLECTOR
!
      IF(STYPE.NE.3.)GO TO 1190
      LGH(1)=10
      DO 1180 J=1,NDELTA
!
!              FIGURE 6.2.1.1-26B (K)
!
         VAR(1)=DSOC(J)/DDOC(J)
         CALL INTERX(1,X6226B,VAR,LGH,Y6226B,KFACTR(J),10,10,           &
     &               0,0,0,0,0,0,0,0,F6226B,3,ROUTID)
 1180 CLROLL(J)=KFACTR(J)*CLROLL(J)
!
!------YAWING MOMENT COEFFICIENT FOR PLUG OR FLAP TYPE SPOILERS
!
 1190 IF(ABS(SWEPLE-SWEPTE).GT.4.0)GO TO 1210
!
!------HERE FOR STRAIGHT TAPERED WINGS WITHOUT SWEEPBACK
!              FIGURE 6.2.2.1-10A-C
!
      CALL TLINEX(X1110A,X2110A,Y2110A,5,6,ETA(5),ARG1,DUMYA,           &
     &            0,0,0,0,F2110A,3,ROUTID)
      ARG1=4.*DELN4
      CALL TLINEX(X1110B ,X2110B,Y2110B,4,6,AW,DUMYA,DUMYB,             &
     &            0,0,0,0,F2110B,3,ROUTID)
      CALL TLINEX(X1110C,X2110C,Y2110C,2,2,TAPRW,DUMYB,DUMYC,           &
     &            0,0,0,0,F2110C,3,ROUTID)
      DO 1200 J=1,NDELTA
!
!              FIGURE 6.2.2.1-10D
!
         CALL TLINEX(X1110D,X2110D,Y2110D,4,2,XSOC(J),DUMYC,CNODS(J),   &
     &               0,0,0,1,F2110D,3,ROUTID)
 1200 CNSPOL(J)= CNODS(J)*DSOC(J) *SCALE
      GO TO 1250
 1210 CONTINUE
!
!------HERE FOR STRAIGHT TAPERED WINGS WITH SWEEPBACK
!
      BS=4.*DELN4
!
!              FIGURE 6.2.2.1-11A
!
      IF(BS.LE.0.4)                                                     &
     &   CALL TLINEX(X111A0,X211A0,Y111A0,4,5,BS,ETA(5),DUMYA,          &
     &               0,0,0,0,F111A0,3,ROUTID)
      IF(BS.GT.0.4.AND.(BS.LE.0.6))                                     &
     &   CALL TLINEX(X111A1,X211A1,Y111A1,3,3,                          &
     &               BS,ETA(5),DUMYA,0,0,0,0,F111A1,3,ROUTID)
      IF(BS.GT.0.6.AND.(BS.LE.0.8))                                     &
     &   CALL TLINEX(X111A2,X211A2,Y111A2,2,3,                          &
     &               BS,ETA(5),DUMYA,0,0,0,0,F111A2,3,ROUTID)
      VAR(1)=BS
      LGH(1)=3
      IF(BS.GT.0.8)                                                     &
     &   CALL INTERX(1,X111A3,VAR,LGH,Y111A3,DUMYA,3,3,                 &
     &               0,0,0,0,0,0,0,0,F111A3,3,ROUTID)
!
!              FIGURE 6.2.2.1-11B
!
      CALL TLINEX(X1111B,X2111B,Y2111B,3,2,AW,DUMYA,DUMYB,              &
     &            0,0,0,0,F2111B,3,ROUTID)
!
!              FIGURE 6.2.2.1-11C
!
      CALL TLINEX(X1111C,X2111C,Y2111C,4,2,TAPRW,DUMYB,DUMYC,           &
     &            0,0,0,0,F2111C,3,ROUTID)
!
!              FIGURE 6.2.2.1-11D
!
      CALL TLINEX(X1111D,X2111D,Y2111D,3,2,SWEPLE,DUMYC,DUMYD,          &
     &            0,0,0,0,F2111D,3,ROUTID)
!
!------HERE FOR FLAP TYPE SPOILER
!
      IF(STYPE.EQ.1.)GO TO 1220
      CNODSB=DUMYD
      GO TO 1230
!
!              FIGURE 6.2.2.1-11E
!
 1220 VAR(1)=DUMYD
      LGH(1)=2
      CALL INTERX(1,X2111E,VAR,LGH,Y2111E,CNODSB,2,2,                   &
     &            0,0,0,0,1,0,0,0,F2111E,3,ROUTID)
 1230 DO 1240 J=1,NDELTA
 1240 CNSPOL(J)=CNODSB*DSOC(J)  *SCALE
 1250 IF(STYPE.NE.3.0)GO TO 1290
!
!------YAWING MOMENT DUE TO SPOILER-SLOT-DEFLECTOR
!              FIGURE 6.2.2.1-12 (K)
!
      VAR(1)=MACH*COSC4
      LGH(1)=12
      CALL INTERX(1,X22112,VAR,LGH,Y22112,KSSD,12,12,                   &
     &            0,0,0,0,0,0,0,0,F22112,3,ROUTID)
      DO 1260 J=1,NDELTA
 1260 CNSPOL(J)=CNSPOL(J)*KSSD
      GO TO 1290
 1270 CONTINUE
!
!    -----ROLLING-MOMENT DUE TO DIFFERENTIALLY DEFLECTED HORZ. STABILIZ
!
      ARG1=0.352*GD1+0.503*GD2+0.344*GD3+0.041*GD4
      ARG2=0.383*GD1+0.707*GD2+0.924*GD3+0.500*GD4
      ETACP=ARG1/ARG2
      DHO2=BO2H-BO2HST
      VAR(1)=DHO2/BO2H
      LGH(1)=6
      CALL INTERX(1,X62122,VAR,LGH,Y62122,EQHOQ,6,6,                    &
     &            2,0,0,0,2,0,0,0,F62122,3,ROUTID)
      YH=ETACP*BO2HST+DHO2
      CLAHM=HT(101)
      CLAHS=CLAHM*SREF/AHT(3)
      A2=DHO2/BO2HST
      ARG1=EQHOQ*YH*SHST*CLAHS/(BLREF*SREF)
      A1=PI*AW/RAD
      DO 1280 J=1,NALPHA
         B1=1.-A1*DEDALP(J)
         B2=RIVBH(J)*GAMVR(J)*A2
         CLDH(J)=0.5*(B1+B2)*ARG1
         DO 1280 K=1,NDELTA
            NN=10*(J-1)+K
 1280 CLROL(NN)= CLDH(J)*DELTAL(K)-CLDH(J)*DELTAR(K)
 1290 CONTINUE
      DO 1300 J=1,NDELTA
 1300 HT(J+200) = DELTAL(J) - DELTAR(J)
      RETURN
      END
      SUBROUTINE LIFTCF(A,B,AIN,AOUT)
!
!***  COMPUTES LIFTING SURFACE CL
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /CONSNT/ CONST(5)
!
      DIMENSION ROUTID(2),Q3355B(3),Q3355A(3),Q13358(3),Q13356(3),      &
     &          Q13357(3)

!      DIMENSION A(195),B(49),AOUT(380),AIN(100)
      DIMENSION A(*),B(*),AOUT(*),AIN(*)
! changed by RLC 2021Jan18

      DIMENSION AJ(12),TRAT(7),DCNAA(7,12),DC(84)
      DIMENSION A58(11) , CLJ58(11),C58(6)
      DIMENSION AR(71),AI(11) , C90(11),C90I(11) , D(11),TIR(11)        &
     &          , CAR(6) , CAI(6) , CTIR(6)
      DIMENSION X13356(6)  , X23356(12) , Y13356(12,6)
      DIMENSION X33356(5) , Y33356(8,4,5)
      DIMENSION X13357(11), Y13357(11) , C11357(6)
      DIMENSION WTYPE(4)
!
      EQUIVALENCE (RAD,CONST(4)),(DEG,CONST(2))
      EQUIVALENCE (DC(1),DCNAA(1,1))
      EQUIVALENCE (AR(1),AI(1),TIR(1))
!
      LOGICAL LTABSW
      LOGICAL LOARAT
!
      DATA ROUTID/4HLIFT,4HCF  /,Q3355B/4H4.1.,4H3.3-,4H55B /,          &
     &                           Q3355A/4H4.1.,4H3.3-,4H55A /,          &
     & Q13358/4H4.1.,4H3.3-,4H58  /,Q13356/4H4.1.,4H3.3-,4H56  /,       &
     & Q13357/4H4.1.,4H3.3-,4H57  /
!
!     ----4.1.3.3-55(A)
!
      DATA AJ/-4.,-2.,-1.,0.,.15,.25,.5,1.,1.5,2.,2.5,3.0/
      DATA TRAT/.2,.4,.46,.5,.55,.6,1./
      DATA DC/ -.9,-.676,-.607,-.564,-.506,-.452,0. , -.4,-.3,-.27,-.25,&
     &-.225,-.2,0. , -.1,-.075,-.065,-.0625,-.0562,-.05,0. , 2*.25,.225,&
     &.2083,.1874,.1666,0.,2*.6,.54,.5,.45,.4,0.,2*.75,.675,.625,       &
     &.562,.5,0. , 2*1.1,.99,.917,.825,.734,0. , 2*1.6,1.44,1.334,1.2,  &
     &1.068,0. , 3*2.,1.852,1.666,1.48,0. , 4*2.35,2.115,1.88,0.  ,     &
     & 5*2.65,2.36,0. , 6*2.85,0. /
!
!     ----4.1.3.3-58
!
      DATA I58 /0/
      DATA A58 / 0.,2.,4.,6.,8.,10.,12.,14.,16.,18.,20./
      DATA CLJ58 /.0,.11,.238,.375,.521,.68,.85,1.025,1.205,1.39,1.575/
      DATA TIR/0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
      DATA D/0.,-.35,-.7,-1.,-1.27,-1.46,-1.55,-1.4,-1.,-.21,0./
      DATA IC90/0/
      DATA ICTIR/0/
      DATA II90/0/
      DATA C90I/2.,1.4,1.26,1.21,7*1.2/
      DATA C90/2.,1.32,9*1.2/
!
!     ----FIG,4.1.3.3-56 SOLID
!     ----X13356 = ANGLE OF ATTACK
!
      DATA X13356 /0.,4.,8.,12.,16.,20./
!
!     ----X23356 = BETA * TAN(LEADING EDGE SWEEP ANGLE)
!
      DATA X23356/0.,1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11./
!
!     ----Y13356(NX2,NX1)
!
      DATA Y13356 / 12*0.,                                              &
     &             .165,.157,.120,.095,.082,.074,.066,.061,.058,3*.055  &
     & , .297,.276,.227,.190,.167,.151,.142,.135,.130,.127,2*.125 ,     &
     &.425 ,.409,.350,.300,.268,.250,.235,.225,.217,.212,.209,.208,     &
     & .568,.545,.480,.420,.377,.348,.327,.311,.301,.296,2*.293   ,     &
     & .701,.675,.602,.533,.482,.443,.422,.404,.392,.385,.381,.380 /
!
!     ----FIG 4.1.3.3-56 DASHED  X33356 IS ASPECT RATIO
!
      DATA X33356 /1.,1.5,2.,2.5,3./
      DATA Y33356 / 40*0.,                                              &
     &             6*.07,.066,.061 , 3*.087,.085,.081,.074,.066,.061 ,  &
     & .117,.113,.105,.095,.082,.074,.066,.061 ,  .145,.142,.120,.095,  &
     &.082,.074,.066,.061 , .165,.157,.120,.095,.082,.074,.066,.061 ,   &
     & 5*.145,.142,.138,.135,2*.180,.178,.172,.163,.151,.142,.135 , .215&
     &,.214,.206,.190,.167,.155,.142,.135 , .285,.273,.227,.190,.167,   &
     &.151,.142,.135 , .297,.276,.227,.190,.167,.151,.142,.135 , .425,  &
     &.409,.350,.300,.268,.250,.235,.225 , .425,.409,.350,.300,.268,.250&
     &,.235,.225 , .425,.409,.350,.300,.268,.250,.235,.225 , .425,.409, &
     &.350,.300,.268,.250,.235,.225 , .425,.409,.350,.300,.268,.250,.235&
     &,.225 /
!
!     ----4.1.3.3-57
!
      DATA I13357 /0/
      DATA X13357 /0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
      DATA Y13357 /5*7.,6.90,6.75,6.50,6.20,5.80,5.30/
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV /
!
!     ----INITIALIZATION ENTRY
!
      TYPE=AIN(15)
      LOARAT=.FALSE.
      IF(A(7).LT.A(125))LOARAT=.TRUE.
!
!     ----TEST TYPE OF WING
!
      IF(TYPE.NE.WTYPE(1)) GO TO 1090
!
!     ----HERE STRAIGHT TAPERED WING
!
      AJAYC= .3*(A(123)+1.)*A(7)*A(37)*((A(123)+1.)*(A(159)+1.)-        &
     &        (A(160)/7.)**3)
      AJAY = AJAYC / B(2)
      NEWM = 1
      A(147)=B(43)-B(49)
      CALL ANGLES(1,A(147))
      CNA=AOUT(101)*RAD
      B(45)=(B(44)/(A(149)*A(150))-CNA*A(150))/                         &
     &      ABS(A(149))
      DO 1070 J=1,NALPHA
         IF(B(J+22).LT.B(43)) GO TO 1050
!
!    ----HERE IF ALPHA GT ACLMAX
!
         IF(A(7).LT.A(125)) GO TO 1010
!
!     ----HIGH ASPECT RATIO
!
         IF(NEWM.EQ.0) GO TO 1020
         NEWM = 0
         BU4 = 4./B(2)
         CALL CLMXBS(BU4,CLSMAX,A,B,AIN)
         GO TO 1020
 1010    CLSMAX = B(44)
 1020    TEMP = B(49)/(90.-B(43))
         A(153) = B(J+22)*(1.+TEMP)-90.*TEMP
         CALL ANGLES(1,A(153))
         RAT=ABS(A(151)/A(157))
         CALL TBFUNX(RAT,DJ,DDDR,11,TIR,D,CTIR,ICTIR,MI,NG,             &
     &               0,0,4HDJ  ,1,ROUTID)
         IF(A(7).GT.1.) GO TO 1030
         CALL TBFUNX(A(7),CNAA90,DCDA,11,AR,C90,CAR,IC90,MI,NG,         &
     &               0,0,Q3355B,3,ROUTID)
         GO TO 1040
 1030    AINV=1./A(7)
         CALL TBFUNX(AINV,CNAA90,DCDA,11,AI,C90I,CAI,II90,MI,NG,        &
     &               0,0,Q3355B,3,ROUTID)
         CNAA90=CNAA90*A(3)/SREF
 1040    CNAAJ=B(45)+(CNAA90-B(45))*(1.-RAT)+RAD*DJ *                   &
     &         AOUT(101)/2.3*(B(2)*B(44)/CLSMAX)**2
         GO TO 1060
 1050    A(153) = B(J+22) - B(49)
         CALL ANGLES(1,A(153))
         RAT=ABS(A(157)/A(151))
!
!     ----4.1.3.3-55(A)
!
         CALL TLINEX(AJ,TRAT,DCNAA,12,7,AJAY,RAT,DCAAJ,                 &
     &               2,1,-1,0,Q3355A,3,ROUTID)
         CNAAJ=B(45)+DCAAJ*A(3)/SREF
 1060    AOUT(J+60)=(RAD*AOUT(101)*A(156)+CNAAJ*ABS(A(155)))*A(155)
         AOUT(J+20)=AOUT(J+60)*COS(DEG*B(J+22))
 1070 END DO
      RETURN
!
!     ----TEST TYPES AND ASPECT RATIO
!
 1090 IF(TYPE.NE.WTYPE(4)) GO TO 1110
!
!     ----HERE FOR CURVED HIGH ASPECT RATIO WINGS-CONSTANT FOR MACH NOS
!
      SQBO2=SQRT(AIN(3)/A(29))
      DO 1100 J=1,NALPHA
         CALL TBFUNX(B(J+22),CLJOSQ,DYDX,11,A58,CLJ58,C58,I58,MI,NG,    &
     &               0,1,Q13358,3,ROUTID)
         AOUT(J+20)=SQBO2*CLJOSQ*A(3)/SREF
         AOUT(J+60) = AOUT(J+20) / COS(DEG*B(J+22))
 1100 END DO
      RETURN
 1110 IF(TYPE.NE.WTYPE(2)) GO TO 1180
!
!     ----HERE IF DOUBLE DELTA,LOW ASPECT RATIO
!
      CON = A(23)/(AIN(3)*A(5)) * RAD
      BTANLE=B(2)*A(62)
      LTABSW=.TRUE.
      IF(A(7).GE.3.0.OR.B(1).LT.0.7.OR.BTANLE.GT.7.0)LTABSW=.FALSE.
      DO 1160 J=1,NALPHA
!
!     ----ALLOW FOR NEGATIVE ALPHA
!
         ALPHA=0.
         IF(B(J+22).LT.0.0)ALPHA=B(J+22)
         B(J+22)=ABS(B(J+22))
         IF(B(J+22).GE.12.0) GO TO 1120
         IF(LTABSW) GO TO 1130
!
!     ----HERE FOR 4.1.3.3-56 SOLID CURVE
!
 1120    CONTINUE
         CALL TLINEX(X13356,X23356,Y13356,6,12,B(J+22),BTANLE,C3356,    &
     &               2,2,2,1,Q13356,3,ROUTID)
         GO TO 1140
!
!     ----HERE FOR 4.1.3.3-56 DASHED CURVE
!
 1130    CALL TLIN3X(X33356,X23356,X13356,Y33356,5,8,4,A(7),BTANLE,     &
     &               B(J+22),C3356,2,2,2,2,1,2,Q13356,3,ROUTID)
 1140    AOUT(J+20)=C3356*AOUT(101)*CON
         IF(ALPHA.GE.0.0)GO TO 1150
         B(J+22)=ALPHA
         AOUT(J+20)=-AOUT(J+20)
 1150    AOUT(J+60) = AOUT(J+20) / COS(DEG*B(J+22))
 1160 END DO
 1170 CONTINUE
      RETURN
 1180 IF(TYPE.NE.WTYPE(3)) GO TO 1290
!
!     ----HERE IF CRANKED HIGH ASPECT RATIO
!     ----DETERMINE ALPHA BREAK
!
      TINVS = 1./A(62)
      CALL TBFUNX(TINVS,ABREAK,DYDX,11,X13357,Y13357,C11357,I13357,     &
     &               MI,NG,0,2,Q13357,3,ROUTID)
!
!     ----CALCULATE (CL)ALPHA=ALPHA BREAK
!
      CON = A(23)/(AIN(3)*A(5)) * RAD
      BTANLE=B(2)*A(62)
      LTABSW=.TRUE.
      IF(A(7).GE.3.0.OR.B(1).LT.0.7.OR.BTANLE.GT.7.0)LTABSW=.FALSE.
      CLBRAK = AOUT(101)* ABREAK
!
!     ----COMPUTE CLA=ALPHA BREAK NONLINEAR
!
      IF(ABREAK.GE.12.0) GO TO 1190
      IF(LTABSW) GO TO 1200
 1190 CONTINUE
      CALL TLINEX(X13356,X23356,Y13356,5,12,ABREAK,BTANLE,CLABNL,       &
     &            2,2,2,1,Q13356,3,ROUTID)
      GO TO 1210
 1200 CALL TLIN3X(X33356,X23356,X13356,Y33356,5,8,4,A(7),BTANLE,ABREAK, &
     &            CLABNL,2,2,2,2,1,2,Q13356,3,ROUTID)
 1210 CLABNL=CLABNL*AOUT(101)*CON
      DO 1270 J=1,NALPHA
         IF(B(J+22).GT.ABREAK) GO TO 1220
         AOUT(J+20)= AOUT(101) * B(J+22)
         AOUT(J+60) = AOUT(J+20) / COS(DEG*B(J+22))
         GO TO 1260
!
!     ----COMPUTE CL NONLINEAR
!
 1220    IF(B(J+22).GE.12.0) GO TO 1230
         IF(LTABSW) GO TO 1240
!
!     ----4.1.3.3-56 SOLID CURVE
!
 1230    CONTINUE
         CALL TLINEX(X13356,X23356,Y13356,6,12,B(J+22),BTANLE,C3356,    &
     &               2,2,2,1,Q13356,3,ROUTID)
         GO TO 1250
!
!     ----HERE FOR 4.1.3.3-56 DASHED CURVE
!
 1240    CALL TLIN3X(X33356,X23356,X13356,Y33356,5,8,4,A(7),BTANLE,     &
     &               B(J+22),C3356,2,2,2,2,1,2,Q13356,3,ROUTID)
 1250    AOUT(J+20)=C3356*AOUT(101)*CON
         AOUT(J+20) = CLBRAK + AOUT(J+20) - CLABNL
         AOUT(J+60) = AOUT(J+20) / COS(DEG*B(J+22))
         GO TO 1270
 1260    CONTINUE
 1270 END DO
 1280 CONTINUE
      RETURN
!
!     ----METHOD DOES NOT APPLY
!
 1290 WRITE(6,1300) TYPE,LOARAT
 1300 FORMAT(28H METHOD NOT APPLICABLE-TYPE= ,A4,8H LOW AR= ,L1)
      RETURN
      END
      SUBROUTINE LIFTFP
!
!***  COMPUTES INCREMENTAL WING LIFT DUE TO FLAPS
!
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /FLAPIN/ F(116)
      COMMON /POWR/   PW(104),FLP(189)
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
      COMMON /WINGI/  WINGIN(77)
      COMMON /SUPWH/  FCM(287)
      COMMON /HTI/    HTIN(131)
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ AHT(195)
      COMMON /IWING/  PWING, WING(400)
      COMMON /IHT/    PHT, HT(380)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108)
      REAL KFPRM,MACH
      REAL KSWEEP
      LOGICAL TRANSL
      LOGICAL EXPDCL
      DIMENSION ROUTID(2),DSCLMX(10),ALDAG(40)
      DIMENSION CPI(10),CPO(10),DALPDE(5)
      DIMENSION SDCL(10),ADCAD(10)
      DIMENSION RK2(10),DELCL2(10),DCLMAX(10)
      DIMENSION VAR(4),LGH(4),RKB(5),CF(5),ETA(5),CHRD(5),DKB(4),       &
     &          CFOC(5),DELTA(10),DELCL(5),CP(5),ALDAVG(4),ADCADS(5),   &
     &          DCL(10),DCLK(5)
      DIMENSION SWF(4),DELCLA(40),CPOCF(4),CLAD(10),CFACTR(4),CFACT(10)
      DIMENSION CLDTHY(5),CLDOCT(5),ALPHAD(5)
      DIMENSION ITRANS(5)
      DIMENSION X2128A(11),X1128A(3),Y1128A(33),F1128A(3)
      DIMENSION X1125A(8),X2125A(8),Y1125A(64),F1125A(3)
      DIMENSION X1125B(16),X2125B( 6),Y1125B(96),F1125B(3)
      DIMENSION X11126(7),X21126(14),Y11126(98),F11126(3)
      DIMENSION X11419(3),X21419(12),Y61419(36),F61419(3)
      DIMENSION X11127(5),X21127(13),Y11127(65),F11127(3)
      DIMENSION X11150(7),Y11150(7),F11150(3)
      DIMENSION X11418(10),X21418(10),Y61418(100),F61418(3)
      DIMENSION X137AD(17),Y137AD(17),F137AD(3)
      DIMENSION X137B2(2),Y137B2(2),F137B2(3)
      DIMENSION X137B1(13),Y137B1(13),F137B1(3)
      DIMENSION X137AB(12),Y137AB(12),F137AB(3)
      DIMENSION X137AC(12),Y137AC(12),F137AC(3)
      DIMENSION X1138A(12),Y138A1(12),Y138A2(12),Y138A3(12),Y138A4(12), &
     &          F138A1(3),F138A2(3),F138A3(3),F138A4(3)
      DIMENSION X1138B(9),Y138B1(9),Y138B2(9),F138B1(3),F138B2(3)
      DIMENSION X1418A(12),Y1418A(12),F1418A(3)
      DIMENSION CF2(5),X61142(11),Y61142(11),F61142(3),                 &
     &          X6143A(14),Y6143A(21),F6143A(3),CF2OC(5),DF2(10),       &
     &          CAPI(10),CAPO(10),X6143B(14),Y6143B(21),F6143B(3)
      DIMENSION X11147(20),Y11147(40),F11147(3)
      LOGICAL   FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,        &
     &          HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                       &
     &          SUPERS,SUBSON,TRANSN,HYPERS,                            &
     &          SYMFP,ASYFP,TRIMC,TRIM
      EQUIVALENCE (CFOC(1),FLP(62)),(CF2I,F(115)),(CF2O,F(116)),        &
     &            (CAPI(1),F(85)),(CAPO(1),F(95)),(DF2(1),F(105))
      EQUIVALENCE (FTYPE,F(17)),(BOF,F(15)),(BIF,F(14)),(CFI,F(12))     &
     &,(CFO,F(13)),(RDELTA,F(16)),(SDCL(1),F(19)),(CPI(1),F(39))        &
     &,(CPO,F(49)),(TANPHE,F(11)),(DELTA(1),F(1))
      EQUIVALENCE (FLP(1),ETA(1)),(CHRD(1),FLP(6)),(CF(1),FLP(11))      &
     &,(DKB(1),FLP(20)),(SWF(1),FLP(24)),(CP(1),FLP(28))                &
     &,(CLOCLT,FLP(33)),(CLDOCT(1),FLP(34)),(CLDTHY(1),FLP(39)),        &
     &(ALDAVG(1),FLP(16)),(DALPDE(1),FLP(54)),(DELCLA(1),FLP(110))      &
     &,(CFACT(1),FLP(71)),(ADCADS(1),FLP(67)),(DCL(1),WING(201))        &
     &,(DCLMAB,FLP(102)),(RK2(1),FLP(91)),(DELCL2(1),FLP(44))           &
     &,(CLAD(1),WING(241))
      EQUIVALENCE (DELN4,FLP(60)),(DELCL(1),FCM(283))
      EQUIVALENCE (ALDAG(1),FLP(150)),(CFOCA,FLP(61))                   &
     &           ,(RK1,FLP(101)),(RK3,FLP(103)),(DSCLMX(1),FLP(81)),    &
     & (KSWEEP,FLP(104)),(DCLMAX(1),WING(221)),(ALPHAD(1),FLP(105))
      DATA ROUTID/4HLIFT,4HFP  /
!
!                   FIGURE 4.1.1.2-8A
!
      DATA X2128A                                                       &
     &  /0., 0.02,  0.04,  0.06,  0.08,  0.10,  0.12,  0.14,  0.16,     &
     &       0.18,  0.20 /
      DATA X1128A                                                       &
     &        /6.,     7.,    8./
      DATA Y1128A                                                       &
     & / 0.900,  0.878,  0.858,  0.836,  0.815,  0.794,  0.772,  0.750, &
     &   0.728,  0.708,  0.685,                                         &
     &   0.950,  0.938,  0.924,  0.907,  0.894,  0.878,  0.860,  0.842, &
     &   0.822,  0.802,  0.780,                                         &
     &   0.966,  0.957,  0.947,  0.936,  0.924,  0.910,  0.896,  0.880, &
     &   0.862,  0.842,  0.822 /
      DATA F1128A/4H4.1.,4H1.2-,4H8A  /
!
!                   FIGURE 6.1.1.1-39A
!
      DATA X2125A                                                       &
     & / 0.05,  0.10,  0.15,  0.20,  0.25,  0.30,  0.40,  0.50 /
      DATA X1125A                                                       &
     & / 0.00,  0.02,  0.04,  0.06,  0.08,  0.10,  0.12,  0.15 /
      DATA Y1125A                                                       &
     & / 1.770,  2.500,  3.000,  3.460,  3.820,  4.160,  4.690,  5.140, &
     &   1.770,  2.515,  3.030,  3.500,  3.873,  4.220,  4.780,  5.240, &
     &   1.770,  2.530,  3.060,  3.540,  3.926,  4.290,  4.870,  5.350, &
     &   1.770,  2.545,  3.090,  3.580,  3.979,  4.350,  4.950,  5.460, &
     &   1.770,  2.560,  3.120,  3.620,  4.032,  4.400,  5.040,  5.560, &
     &   1.770,  2.575,  3.150,  3.660,  4.085,  4.480,  5.120,  5.690, &
     &   1.770,  2.590,  3.180,  3.700,  4.138,  4.550,  5.210,  5.790, &
     &   1.770,  2.600,  3.220,  3.740,  4.190,  4.620,  5.330,  5.960/
      DATA F1125A/4H6.1.,4H1.1-,4H39A /
!
!                   FIGURE 6.1.1.1-39B
!
      DATA X2125B                                                       &
     &  / 0.05,  0.10,  0.15,  0.20,  0.25,  0.50 /
      DATA X1125B                                                       &
     &  / 0.70,  0.72,  0.74,  0.76,  0.78,  0.80,  0.82,  0.84,  0.86, &
     &    0.88,  0.90,  0.92,  0.94,  0.96,  0.98,  1.00 /
      DATA Y1125B                                                       &
     & /  .356,    .382,    .409,    .431,    .452,    .548,            &
     &    .399,    .426,    .452,    .477,    .498,    .583,            &
     &    .442,    .471,    .499,    .523,    .543,    .619,            &
     &    .485,    .521,    .548,    .569,    .589,    .659,            &
     &    .530,    .569,    .594,    .613,    .630,    .693,            &
     &    .578,    .614,    .639,    .657,    .671,    .729,            &
     &    .619,    .655,    .678,    .692,    .709,    .761,            &
     &    .659,    .696,    .713,    .733,    .746,    .793,            &
     &    .700,    .734,    .750,    .765,    .778,    .819,            &
     &    .742,    .771,    .789,    .800,    .810,    .850,            &
     &    .784,    .809,    .824,    .838,    .843,    .875,            &
     &    .826,    .843,    .860,    .865,    .873,    .900,            &
     &    .865,    .885,    .895,    .900,    .903,    .921,            &
     &    .910,    .921,    .928,    .931,    .933,    .938,            &
     &    .951,    .962,    .964,    .966,    .967,    .968,            &
     &   1.000,   1.000,   1.000,   1.000,   1.000,   1.000/
      DATA F1125B/4H6.1.,4H1.1-,4H39B /
!
!                   FIGURE 6.1.1.1-40
!  CTAB4(1,I)  = FLAP DEFLECTION ANGLE  (DEG)
!  CTAB4(2,I)  = FLAP TO A1RFOIL CHORD RATIO
!  KPRIME(I)   = EMPIRICAL CORRECTION FACTOR
!
      DATA X21126                                                       &
     & / 0., 10., 12., 14., 16., 18., 20., 23., 27., 30., 35., 40.,     &
     &  50., 60. /
      DATA X11126                                                       &
     & / 0.10, 0.15, 0.20, 0.25, 0.30, 0.40, 0.50 /
      DATA Y11126                                                       &
     & /  1.000,  1.000,  0.994,  0.989,  0.970,  0.938,  0.900, 0.829, &
     &    0.755,  0.722,  0.672,  0.641,  0.596,  0.562,                &
     &    1.000,  1.000,  0.994,  0.989,  0.970,  0.937,  0.890, 0.809, &
     &    0.737,  0.698,  0.650,  0.618,  0.569,  0.531,                &
     &    1.000,  1.000,  0.994,  0.989,  0.968,  0.936,  0.870, 0.783, &
     &    0.710,  0.673,  0.630,  0.595,  0.542,  0.500,                &
     &    1.000,  1.000,  0.994,  0.989,  0.965,  0.935,  0.850, 0.740, &
     &    0.677,  0.644,  0.600,  0.569,  0.518,  0.480,                &
     &    1.000,  1.000,  0.994,  0.989,  0.963,  0.905,  0.800, 0.700, &
     &    0.643,  0.610,  0.570,  0.541,  0.496,  0.461,                &
     &    1.000,  1.000,  0.993,  0.969,  0.924,  0.860,  0.750, 0.656, &
     &    0.606,  0.579,  0.540,  0.513,  0.471,  0.440,                &
     &    1.000,  1.000,  0.981,  0.943,  0.880,  0.790,  0.695, 0.625, &
     &    0.571,  0.542,  0.512,  0.490,  0.450,  0.423/
      DATA F11126/4H6.1.,4H1.1-,4H40  /
!
!     FIGURE 6.1.4.1-15
!     TIKB(1,I) ETA
!     TIKB(2,I) LAMBDA
!     TDKB(I) K(B)
!
      DATA X21419/                                                      &
     & 0.0,    0.1,    0.2,    0.3,    0.4,    0.5,    0.6,    0.7,     &
     & 0.8,    0.85,   0.9,    1.0/
      DATA X11419/                                                      &
     & 0.0,    0.5,    1.0/
      DATA Y61419/                                                      &
     & 0.0,    0.160,  0.305,  0.440,  0.560,  0.670,  0.772,  0.860,   &
     & .930,   .96,    .981,   1.0,                                     &
     & 0.0,    0.140,  0.270,  0.400,  0.515,  0.630,  0.735,  0.830,   &
     & 0.912,  0.947,  0.972,  1.0,                                     &
     & 0.,     .125,   .255,   .37,    .49,    .6,     .705,   .8,      &
     & 0.885,  0.921,  0.955,  1.0/
      DATA F61419/4H6.1.,4H4.1-,4H15  /
!
!     ----FIGURE 6.1.1.1-41
!
      DATA Y11127/-.373,-.373,-.368,-.345,-.32,-.296,-.268,-.23,-.19,   &
     &-.165,-.151,-.142,-.140 , -.45,-.446,-.43,-.412,-.39,-.364,-.328, &
     &-.29,-.24,-.207,-.188,-.172,-.167 , -.512,-.51,-.491,-.48,-.458,  &
     &-.43,-.398,-.356,-.30,-.247,-.229,-.20,-.190,-.55,-.55,-.53 ,-.52,&
     &-.5,-.472,-.44,-.396,-.34,-.28,-.25,-.224,-.21, -.60,-.60,-.585,  &
     &-.57,-.55,-.521,-.495,-.455,-.4,-.33,-.29,-.25,-.23 /
      DATA X21127/0.,10.,20.,25.,30.,35.,40.,45.,50.,55.,60.,70.,80./
      DATA X11127/.15,.20,.25,.30,.40/,F11127/4H6.1.,4H1.1-,4H41  /
!
!     FIGURE 6.1.4.1-14
!     TIADER(1,I) A(W)
!     TIADER(2,I) (ALFA(DELTA)) CL
!     TDADER(I) (ALFA(DELTA)) CL RATIO
!
      DATA X21418/                                                      &
     & 0.0,    0.25,   0.50,   1.0,    2.0,    3.0,    4.0,    5.0,     &
     & 6.0,    8.0/
      DATA X11418/                                                      &
     & -1.0,   -.9,    -.8,    -.7,    -.6,    -.5,    -.4,    -.3,     &
     & -.2,    -.1/
      DATA Y61418/10*1.,                                                &
     & 1.11,   1.075,  1.06,   1.049,  1.03,   1.019,  1.011,  1.01,    &
     & 1.009,  1.007,                                                   &
     & 1.2,    1.15,   1.125,  1.095,  1.06,   1.04,   1.03,   1.02,    &
     & 1.019,  1.015,                                                   &
     & 1.365,  1.245,  1.20,   1.145,  1.095,  1.065,  1.05,   1.04,    &
     & 1.032,  1.025,                                                   &
     & 1.5,    1.35,   1.285,  1.205,  1.132,  1.095,  1.072,  1.06,    &
     & 1.05,   1.039,                                                   &
     & 1.7,    1.5,    1.4,    1.29,   1.185,  1.135,  1.10,   1.085,   &
     & 1.071,  1.055,                                                   &
     & 2.0,    1.63,   1.53,   1.39,   1.25,   1.185,  1.145,  1.118,   &
     & 1.1,    1.079,                                                   &
     & 2.4,    1.90,   1.70,   1.52,   1.35,   1.26,   1.20,   1.165,   &
     & 1.142,  1.11,                                                    &
     & 2.73,   2.43,   2.10,   1.73,   1.49,   1.375,  1.30,   1.24,    &
     & 1.2,    1.16,                                                    &
     & 3.08,   2.85,   2.55,   2.18,   1.79,   1.58,   1.46,   1.385,   &
     & 1.325,  1.245/
      DATA F61418/4H6.1.,4H4.1-,4H14  /
!
!     ----FIGURE 6.1.1.3-12AD SPLIT AND PLAIN
!
      DATA X137AD/0.,2.,4.,5.,6.,8.,9.,10.,11.,12.,14.,15.,16.,17.,18., &
     & 19.,20./,F137AD/4H6.1.,4H1.3-,4H12AD/,                           &
     &Y137AD/2*1.,.979,.95,.92,.82,.80,.82,.85,.91,1.09,1.19,1.31,1.43, &
     & 1.51,1.57,1.60/
!
!     ----FIGURE 6.1.1.3-12B2 2-SLOT AND FOWLER
!
      DATA X137B2/0.,30./,Y137B2/0.,1.2/,F137B2/4H6.1.,4H1.3-,4H12B2/
!
!     ----FIGURE 6.1.1.3-12B1 SPLIT,PLAIN AND 1-SLOT
!
      DATA X137B1/0.,2.,4.,6.,8.,10.,12.,14.,16.,20.,24.,28.,30./,      &
     &Y137B1/0.,.2,.34,.47,.57,.65,.72,.78,.83,.92,.99,1.04,1.06/   ,   &
     &F137B1/4H6.1.,4H1.3-,4H12B1/
!
!     ----FIGURE 6.1.1.3-12AB AVERAGE 2-SLOT,FOWLER
!
      DATA X137AB/0.,2.,5.,7.,9.,11.,13.,15.,16.,17.,18.,19./,          &
     &Y137AB/1.0,1.0,1.04,1.09,1.17,1.29,1.45,1.64,1.73,1.77,1.80,1.82/,&
     &F137AB/4H6.1.,4H1.3-,4H12AB/
!
!     ----FIGURE 6.1.1.3-12AC NACA 2-SLOT,NACA 1-SLOT
!
      DATA X137AC/0.,5.,6.,8.,10.,12.,14.,16.,17.,18.,19.,20./,         &
     &Y137AC/1.,1.,1.02,1.08,1.17,1.30,1.47,1.67,1.71,1.73,1.715,1.68/, &
     &F137AC/4H16.1,4H.1.3,4H-12A/
!
!     ----FIGURE 6.1.1.3-13A
!     ----A1=FOWLER , A2=1-SLOT , A3=2-SLOT , A4=SPLIT AND PLAIN
!
      DATA X1138A /0.,5.,10.,15.,20.,25.,30.,35.,40.,45.,50.,60./,      &
     & Y138A1/.4,.5,.61,.71,.79,.87,.94,.98,4*1.0/,                     &
     & Y138A2/.18,.33,.47,.59,.70,.79,.87,.93,.97,3*1.0/,               &
     & Y138A3/.18,.32,.44,.56,.66,.76,.84,.90,.95,.99,2*1.0/,           &
     & Y138A4/0.,.17,.33,.46,.57,.67,.76,.83,.87,.92,.95,1.0/,          &
     & F138A1/4H6.1.,4H1.3-,4H13A1 /,                                   &
     & F138A2/4H6.1.,4H1.3-,4H13A2 /,                                   &
     & F138A3/4H6.1.,4H1.3-,4H13A3 /,                                   &
     & F138A4/4H6.1.,4H1.3-,4H13A4 /
!
!     ----FIGURE 6.1.1.3-13B
!     ----B1=1-SLOT , 4-BAR , FOWLER , CIRCULAR ARC
!     ----B2= 2-SLOT, 4-BAR MOTION
!
      DATA X1138B/0.,.2,.3,.4,.45,.55,.6,.8,1.0/,F138B1/4H6.1.,4H1.3-,  &
     & 4H13B1 /,F138B2/4H6.1.,4H1.3-,4H13B2 /,                          &
     & Y138B1/0.,.26,.39,.50,.57,.66,.70,.87,1.0/,                      &
     & Y138B2/0.,.11,.23,.40,.52,.66,.70,.87,1.0/
!
!     ----FIGURE 6.1.4.1-14A
!
      DATA X1418A/0.,.05,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.0/,               &
     & Y1418A/0.,-.26,-.40,-.55,-.66,-.75,-.82,-.88,-.93,-.97,-.99,-1./,&
     & F1418A /4H6.1.,4H4.1-,4H13A  /
      DATA X61142/0.,.05,.1,.15,.2,.25,.3,.35,.4,.45,.5/
      DATA Y61142/0.,.03,.042,.052,.06,.068,.072,.078,.082,.086,.09/
      DATA X6143A/15.,20.,30.,40.,50.,60.,70.,.1,.25,.4,4*0./
      DATA Y6143A/2*.66,.645,.505,.5,.4,.35,2*.73,.7,.645,.55,.43,      &
     & .38,2*.78,.745,.68,.585,.475,.4/
      DATA X6143B/0.,15.,20.,30.,40.,60.,90.,0.,10.,20.,4*0./
      DATA Y6143B/9*1.,.945,.89,.885,.875,.865,2*1.,.9,.79,.75,         &
     & .725,.72/
      DATA F61142/4H6.1.,4H1.1-,4H42  /
      DATA F6143A/4H6.1.,4H1.1-,4H43A /
      DATA F6143B/4H6.1.,4H1.1-,4H43B /
      DATA X11147/5.,10.,15.,20.,30.,40.,50.,60.,70.,75.,               &
     & .1,.2,.3,.4,6*0./
      DATA Y11147/-.36,-.295,-.24,-.22,-.195,-.18,-.17,-.155,-.14,      &
     & -.13,-.435,-.37,-.32,-.29,-.26,-.245,-.23,-.215,-.195,-.185,     &
     & -.57,-.48,-.415,-.375,-.33,-.305,-.28,-.27,-.255,-.25,-.6,       &
     & -.545,-.48,-.44,-.378,-.35,-.325,-.3,-.275,-.26/
      DATA F11147/4H6.1.,4H1.1-,4H47  /
      DATA X11150/0.,.05,.1,.2,.3,.4,.5/
      DATA Y11150/0.,-.0005,-.0016,-.0044,-.0082,-.0108,-.02/
      DATA F11150/4H6.1.,4H1.1-,4H50  /
      DATA ITRANS/2,3,4,7,8/
!
      IF(HTPL)GO TO 1000
!
!    -----HERE FOR H.L. OR  CONTROL DEVICE ON WING
!
      CBAREX=A(16)
      BO2=WINGIN(3)
      TANTE=A(80)
      TANLE=A(62)
      CR=WINGIN(6)
      TAPRI=A(25)
      BSTRO2=WINGIN(2)
      TANTEO=A(104)
      TANLEO=A(86)
      CB=WINGIN(5)
      TAPRO=A(28)
      SR=SREF
      AW=A(120)
      BTHEO=WINGIN(4)
      TOVC=WINGIN(16)
      TOVCO=WINGIN(66)
      COSC4=A(67)
      CLASEC=WINGIN(M+20)
      CLAW=WING(101)
      IF(TRANSN)CLAW=TRA(70)
      IF(TRANSN)CLASEC=WINGIN(69)/.8
      GO TO 1010
 1000 CBAREX=AHT(16)
      BO2=HTIN(3)
      TANTE=AHT(80)
      TANLE=AHT(62)
      CR=HTIN(6)
      TAPRI=AHT(25)
      BSTRO2=HTIN(2)
      TANTEO=AHT(104)
      TANLEO=AHT(86)
      CB=HTIN(5)
      TAPRO=AHT(28)
      SR=SREF
      AW=AHT(120)
      BTHEO=HTIN(4)
      TOVC=HTIN(16)
      TOVCO=HTIN(66)
      COSC4=AHT(67)
      CLASEC=HTIN(M+20)
      CLAW=HT(101)
      IF(TRANSN)CLAW=TRAH(70)
      IF(TRANSN)CLASEC=HTIN(69)/.8
 1010 CONTINUE
!
!*****CHECK FOR TRANSALATING DEVICE,IF SO CALCULATE SWF
!
      TRANSL=.FALSE.
      IFTYPE=FTYPE+0.5
      NDELTA=RDELTA+0.5
      RF=FLC(M+42)
      MACH=FLC(M+2)
      IF(TRANSN)MACH=.6
!
!-----IF DELTA EQUALS ZERO,SET TO 0.01 DEG
!
      DO 1020 J=1,NDELTA
 1020 IF(DELTA(J).EQ.0.0)DELTA(J)=0.01
      DO 1030 K=1,5
 1030 IF(IFTYPE.EQ.ITRANS(K))TRANSL=.TRUE.
!
!*****GEOMETRIC PARAMETERS PER FLAP SEGMENT
!
      DELN4=0.25*(BOF-BIF)/BTHEO
      ETA(1)=BIF/BTHEO
      VAR(1)=ETA(1)
      CF(1)=CFI
      ARG1=(CFI-CFO)/(4.*DELN4)
      ARG2=(TANTE-TANLE)*BTHEO
      ARG3=(BOF-BIF)*CR /4.0
      ARG4=CR
      ARG5=TAPRI
      TC=TOVC
      IF(BIF.LT.(BTHEO-BSTRO2))GO TO 1040
      ARG2=(TANTEO-TANLEO)*BO2
      ARG3=(BOF-BIF)*CB /4.0
      ARG4=CB
      ARG5=TAPRO
      TC=TOVCO
 1040 CONTINUE
!
!              FIGURE 6.1.4.1-15 (KB)
!
      CALL TLINEX(X11419,X21419,Y61419,3,12,ARG5,ETA(1),RKB(1),         &
     &            0,0,0,0,F61419,3,ROUTID)
      CHRD(1)=ARG4+ETA(1)*ARG2
!
!              FIGURE 6.1.4.1-14 (ALPHA)DELTA
!
      CFOC(1)=CF(1)/CHRD(1)
      VAR(1)=CFOC(1)
      LGH(1)=12
      CALL INTERX(1,X1418A,VAR,LGH,Y1418A,ALPHAD(1),12,12,              &
     &            0,0,0,0,0,0,0,0,F1418A,3,ROUTID)
      DO 1050 K=2,5
         N=K-1
         ETA(K)=ETA(N)+DELN4
         CF(K)=CFI-ARG1*(ETA(K)-ETA(1))
!
!              FIGURE 6.1.4.1-15 (KB)
!
         CALL TLINEX(X11419,X21419,Y61419,3,12,ARG5,ETA(K),RKB(K),      &
     &               0,0,0,0,F61419,3,ROUTID)
         DKB(N)=RKB(K)-RKB(N)
         CHRD(K)=ARG4+ETA(K)*ARG2
!
!              FIGURE 6.1.4.1-14 (ALPHA)DELTA
!
         CFOC(K)=CF(K)/CHRD(K)
         VAR(1)=CFOC(K)
         LGH(1)=12
         CALL INTERX(1,X1418A,VAR,LGH,Y1418A,ALPHAD(K),12,12,           &
     &               0,0,0,0,0,0,0,0,F1418A,3,ROUTID)
         ALDAVG(N)=0.50*(ALPHAD(K)+ALPHAD(N))
         SWF(N)=ARG3*(2.-(1.-ARG5)*(ETA(N)+ETA(K)))
 1050 END DO
!
!*****CALCULATE SECTION LIFT INCREMENT FOR EACH SPANWISE SEGMENT
!
      EXPDCL=.FALSE.
      NN=0
!
!              FIGURE 4.1.1.2-8A
!
      ARG1=ALOG10(RF*CBAREX)
      IF(IFTYPE.EQ.1)CALL TLINEX(X1128A,X2128A,Y1128A,3,11,ARG1,TANPHE, &
     &                           CLOCLT,1,0,0,1,F1128A,3,ROUTID)
      DO 1200 I=1,NDELTA
         ARG8=DELTA(I)*CLASEC
         IF(SDCL(I).NE.UNUSED)EXPDCL=.TRUE.
         IF(EXPDCL.AND.(.NOT.TRANSL))GO TO 1190
         CP(1)=CPI(I)
         DO 1170 K=1,5
            IF(K.EQ.1)GO TO 1060
            IF(.NOT.TRANSL)GO TO 1060
            ARG1=       (CPI(I)-CPO(I))/(4.*DELN4)
            CP(K)=CPI(I)-ARG1*(ETA(K)-ETA(1))
 1060       CONTINUE
            IF(EXPDCL)GO TO 1150
            ARGZ=ABS(DELTA(I))
            GO TO (1070,1090,1090,1150,1100,1110,1120,1130),IFTYPE
 1070       CONTINUE
!
!*****PLAIN TRAILING-EDGE FLAPS
!
            IF(I.GT.1)GO TO 1080
!
!              FIGURE 6.1.1.1-39B
!
            CALL TLINEX(X1125B,X2125B,Y1125B,16,6,CLOCLT,CFOC(K),       &
     &                  CLDOCT(K),0,0,0,0,F1125B,3,ROUTID)
!
!              FIGURE 6.1.1.1-39A
!
            CALL TLINEX(X1125A,X2125A,Y1125A,8,8,TC,CFOC(K),CLDTHY(K),  &
     &                  0,0,0,0,F1125A,3,ROUTID)
!
!              FIGURE 6.1.1.1-40
!
 1080       CALL TLINEX(X11126,X21126,Y11126,7,14,CFOC(K),ARGZ,KFPRM,   &
     &                  0,0,0,0,F11126,3,ROUTID)
            DELCL(K)=DELTA(I)*CLDOCT(K)*CLDTHY(K)*KFPRM/RAD
            GO TO 1140
 1090 CONTINUE
!
!*****SINGLE-SLOTTED AND FOWLER TRAILING-EDGE FLAPS
!              FIGURE 6.1.1.1.-41
!
            CALL TLINEX(X11127,X21127,Y11127,5,13,CFOC(K),ARGZ,         &
     &                  ALPHAD(K),0,0,0,0,F11127,3,ROUTID)
            DELCL(K)=-CLASEC*ALPHAD(K)*DELTA(I)
            GO TO 1140
 1100       CONTINUE
!
!*****SPLIT TRAILING-EDGE FLAPS
!
            VAR(1)=DELTA(I)
            VAR(2)=CFOC(K)
            LGH(1)=10
            LGH(2)=4
            CALL INTERX(2,X11147,VAR,LGH,Y11147,ALFAD,10,40,            &
     &                  1,1,0,0,1,1,0,0,F11147,3,ROUTID)
            DELCL(K)=-CLASEC*ALFAD*DELTA(I)
            GO TO 1140
 1110       CONTINUE
!
!*****LEADING-EDGE FLAPS
!
            VAR(1)=CFOC(K)
            LGH(1)=7
            CALL INTERX(1,X11150,VAR,LGH,Y11150,CLDK,7,7,               &
     &                  0,0,0,0,1,0,0,0,F11150,3,ROUTID)
            DELCL(K)=CLDK*DELTA(I)
            GO TO 1140
 1120       CONTINUE
!
!*****LEADING-EDGE SLATS
!
            VAR(1)=CFOC(K)
            LGH(1)=7
            CALL INTERX(1,X11150,VAR,LGH,Y11150,CLDK,7,7,               &
     &                  0,0,0,0,1,0,0,0,F11150,3,ROUTID)
            DELCL(K)=CLDK*DELTA(I)*CP(K)/CHRD(K)
            GO TO 1140
 1130       CONTINUE
!
!*****KRUEGER L.E. FLAPS
!
            VAR(1)=CFOC(K)
            LGH(1)=7
            CALL INTERX(1,X11150,VAR,LGH,Y11150,CLDK,7,7,               &
     &                  0,0,0,0,1,0,0,0,F11150,3,ROUTID)
            DELCL(K)=CLDK*DELTA(I)*CP(K)/CHRD(K)
 1140       CONTINUE
!
!*****COMPUTE AVERAGE SECTION DELTA CL OVER SPANWISE SEGMENT
!
            N=K-1
            IF(N.EQ.0) GO TO 1170
            NN=NN+1
            DELCLA(NN)=(DELCL(K)+DELCL(N))/2.
            ALDAG(NN)=-DELCLA(NN)/ARG8
!
!*****COMPUTE AVERAGE CP/CK OVER SPANWISE SEGMENT
!
            IF(IFTYPE .EQ. 4) GO TO 1160
            IF(.NOT.TRANSL)GO TO 1160
 1150       CONTINUE
            CPOCF(N)=(CP(K)/CHRD(K)+CP(N)/CHRD(N))/2.
            CFACTR(N)=(CPOCF(N)-1.)*SWF(N)/SR
            IF(EXPDCL)GO TO 1170
            IF(IFTYPE .NE. 4) GO TO 1160
!
!*****HERE FOR SECTION DELTA-CL FOR DOUBLE SLOTTED FLAPS
!
            AARG1=(CF2I-CF2O)/(4.*DELN4)
            AARG2=(CAPI(I)-CAPO(I))/(4.*DELN4)
            CAPR=CAPI(I)-AARG2*(ETA(K)-ETA(1))
            CF2(K)=CF2I-AARG1*(ETA(K)-ETA(1))
            CF2OC(K)=CF2(K)/CHRD(K)
            PHI1=DELTA(I)+ATAN(TANPHE)*RAD
            PHI2=PHI1+DF2(I)
            VAR(1)=PHI1
            IF(CFOC(K) .LE. .10) VAR(2)=.10
            IF(CFOC(K) .GE. .40) VAR(2)=.40
            IF(CFOC(K) .GT. .10 .AND. CFOC(K) .LT. .40) VAR(2)=CFOC(K)
            LGH(1)=7
            LGH(2)=3
            CALL INTERX(2,X6143A,VAR,LGH,Y6143A,ATEA1,7,21,             &
     &                  1,1,0,0,1,1,0,0,F6143A,3,ROUTID)
            LGH(1)=11
            VAR(1)=CFOC(K)
            CALL INTERX(1,X61142,VAR,LGH,Y61142,CLDF1,11,11,            &
     &                  1,0,0,0,1,0,0,0,F61142,3,ROUTID)
            VAR(1)=PHI2
            LGH(1)=7
            IF(CF2OC(K) .LE. .10) VAR(2)=.10
            IF(CF2OC(K) .GE. .40) VAR(2)=.40
            IF(CF2OC(K) .GT. .10 .AND. CF2OC(K) .LT. .4)VAR(2)=CF2OC(K)
            CALL INTERX(2,X6143A,VAR,LGH,Y6143A,ATEA2,7,21,             &
     &                  1,1,0,0,1,1,0,0,F6143A,3,ROUTID)
            LGH(1)=11
            VAR(1)=CFOC(K)
            CALL INTERX(1,X61142,VAR,LGH,Y61142,CLDF2,11,11,            &
     &                  1,0,0,0,1,0,0,0,F61142,3,ROUTID)
            IF((CFOC(K)/CF2OC(K)) .LE. 0.60) DELCL(N)=ATEA1*CLDF1*DELTA &
     &      (I)*(1.+CFOC(K))+ATEA2*CLDF2*(DELTA(I)+DF2(I))*CP(K)/CHRD(K)
            IF((CFOC(K)/CF2OC(K)) .LE. 0.60) GO TO 1140
            VAR(1)=DF2(I)
            VAR(2)=DELTA(I)
            LGH(1)=7
            LGH(2)=3
            CALL INTERX(2,X6143B,VAR,LGH,Y6143B,ATEAT,7,21,             &
     &                  1,1,0,0,1,1,0,0,F6143B,3,ROUTID)
            DELCL(N)=ATEA1*CLDF1*DELTA(I)*CAPR/CHRD(K)+ATEA2*ATEAT      &
     &               *CLDF2*DF2(I)*(1.+(CP(K)-CAPR)/CHRD(K))
            GO TO 1140
 1160       CONTINUE
!
!*****SPANWISE SEGMENT DELTA CL
!              FIGURE 6.1.4.1-8
!
            CALL TLINEX(X11418,X21418,Y61418,10,10,ALDAVG(N),AW,        &
     &                  ADCADS(N),0,0,0,1,F61418,3,ROUTID)
            DCLK(N)=DELCLA(NN)*ADCADS(N)*DKB(N)*CLAW/CLASEC
 1170    CONTINUE
         IF(EXPDCL)GO TO 1180
         DCL(I)=DCLK(1)+DCLK(2)+DCLK(3)+DCLK(4)
         IF(.NOT.TRANSL)GO TO 1200
 1180    CONTINUE
         CFACT(I)=(CFACTR(1)+CFACTR(2)+CFACTR(3)+CFACTR(4))/4.0
         CLAD(I)=CFACT(I)*CLAW+CLAW
         IF(.NOT.EXPDCL)GO TO 1200
 1190    CONTINUE
!
!*****HERE IF SECTION DELTA CL WAS INPUT
!
      VAR(1)=SDCL(I)/(CLASEC*DELTA(I))
      VAR(2)=AW
!
!              FIGURE 6.1.4.1-8
!
         CALL TLINEX(X11418,X21418,Y61418,10,10,VAR(1),VAR(2),ADCAD(I), &
     &               0,0,0,1,F61418,3,ROUTID)
         DCL(I)=SDCL(I)*ADCAD(I)*(RKB(5)-RKB(1))*CLAW/CLASEC
 1200 END DO
      IF(IFTYPE.GE.6) GO TO 1380
      DO 1370 I=1,NDELTA
         IF(I.GT.1)GO TO 1270
!
!*****CALCULATE SECTION DELTA (CL)MAX
!
         TROFS=CHRD(5)/CHRD(1)
         CBARFS=2./3.*CHRD(1)*(1.+TROFS*(1.+TROFS))/(1.+TROFS)
         ETAFS=(1.+2.*TROFS)/(3.*(1.+TROFS))
         CFOCA=(CFI-ETAFS*(CFI-CFO))/CBARFS
         VAR(1)=TC*100.
         GO TO(1220,1210,1230,1230,1220,1380,1380,1380),IFTYPE
 1210 CONTINUE
!
!              FIGURE 6.1.1.3-12AC (SINGLE SLOT) (DCL)BASE
!
         LGH(1)=12
         CALL INTERX(1,X137AC,VAR,LGH,Y137AC,DCLMAB   ,12,12,           &
     &               0,0,0,0,0,0,0,0,F137AC,3,ROUTID)
         GO TO 1240
 1220    CONTINUE
!
!              FIGURE 6.1.1.3-12AD (SPLIT AND PLAIN) (DCL)BASE
!
         LGH(1)=17
         CALL INTERX(1,X137AD,VAR,LGH,Y137AD,DCLMAB   ,17,17,           &
     &               0,0,0,0,0,0,0,0,F137AD,3,ROUTID)
         GO TO 1240
 1230    CONTINUE
!
!              FIGURE 6.1.1.3-12AB (2-SLOT AND FOWLER)  (DCL)BASE
!
         LGH(1)=12
         CALL INTERX(1,X137AB,VAR,LGH,Y137AB,DCLMAB   ,12,12,           &
     &               0,0,0,0,0,0,0,0,F137AB,3,ROUTID)
 1240    CONTINUE
         VAR(1)=CFOCA *100.
         GO TO(1250,1250,1260,1260,1250,1380,1380,1380),IFTYPE
 1250    CONTINUE
!
!              FIGURE 6.1.1.3-12B1 (SPLIT,PLAIN,AND 1-SLOT) K1
!
         LGH(1)=13
         CALL INTERX(1,X137B1,VAR,LGH,Y137B1,RK1,13,13,                 &
     &               0,0,0,0,1,0,0,0,F137B1,3,ROUTID)
         GO TO 1270
 1260    CONTINUE
!
!              FIGURE 6.1.1.3-12B2 (2-SLOT AND FOWLER) K1
!
         LGH(1)=2
         CALL INTERX(1,X137B2,VAR,LGH,Y137B2,RK1,2,2,                   &
     &               0,0,0,0,1,0,0,0,F137B2,3,ROUTID)
 1270    CONTINUE
!
!*****SET REFERENCE FLAP DEFLECTIONS FROM FIG.6.1.1.3-13A
!
      DREFF=40.
      DREF1S=45.
      DREF2S=50.
      DREFSP=60.
      VAR(1)=ABS(DELTA(I))
      LGH(1)=12
      GO TO(1280,1290,1300,1310,1280,1380,1320,1380),IFTYPE
 1280 CONTINUE
!
!              FIGURE 6.1.1.3-13A (SPLIT AND PLAIN) K2
!
      CALL INTERX(1,X1138A,VAR,LGH,Y138A4,RK2(I),12,12,                 &
     &            0,0,0,0,0,0,0,0,F138A4,3,ROUTID)
      GO TO 1330
 1290 CONTINUE
!
!              FIGURE 6.1.1.3-13A (1-SLOT) K2
!
         CALL INTERX(1,X1138A,VAR,LGH,Y138A2,RK2(I),12,12,              &
     &               0,0,0,0,0,0,0,0,F138A2,3,ROUTID)
      GO TO 1330
 1300 CONTINUE
!
!              FIGURE 6.1.1.3-13A (FOWLER) K2
!
         CALL INTERX(1,X1138A,VAR,LGH,Y138A1,RK2(I),12,12,              &
     &               0,0,0,0,0,0,0,0,F138A1,3,ROUTID)
         GO TO 1330
 1310    CONTINUE
!
!              FIGURE 6.1.1.3-13A (2-SLOT) K2
!
         CALL INTERX(1,X1138A,VAR,LGH,Y138A3,RK2(I),12,12,              &
     &               0,0,0,0,0,0,0,0,F138A3,3,ROUTID)
         GO TO 1330
 1320    CONTINUE
!
!*****DELTA CLMAX FOR L.E. SLATS
!
         DCLMAX(I)=1.28*CFOC(K)/.18*COSC4**2*((BOF-BIF)/BTHEO)**2
         GO TO 1370
 1330    CONTINUE
         IF(IFTYPE.EQ.1.OR.IFTYPE.EQ.5) GO TO 1350
         IF(IFTYPE.EQ.4) GO TO 1340
!
!*****HERE FOR 1-SLOT OR FOWLER
!
         VAR(1)=ABS(DELTA(I))/DREFF
         IF(IFTYPE.EQ.2)VAR(1)=ABS(DELTA(I))/DREF1S
!
!              FIGURE 6.1.1.3-13B1 (1-SLOT AND FOWLER ) K3
!
         LGH(1)=9
         CALL INTERX(1,X1138B,VAR,LGH,Y138B1,RK3,9,9,                   &
     &               0,0,0,0,0,0,0,0,F138B1,3,ROUTID)
         GO TO 1360
 1340    CONTINUE
!
!*****HERE FOR 2-SLOT
!
         VAR(1)=ABS(DELTA(I))/DREF2S
!
!              FIGURE 6.1.1.3-13B2 (2-SLOT) K3
!
         LGH(1)=9
         CALL INTERX(1,X1138B,VAR,LGH,Y138B2,RK3,9,9,                   &
     &               0,0,0,0,0,0,0,0,F138B2,3,ROUTID)
         GO TO 1360
 1350    RK3=1.
 1360    CONTINUE
         DSCLMX(I)=RK1*RK2(I)*RK3*DCLMAB
!
!*****INCREMENT IN MAXIMUM LIFT COEFFICIENT DUE TO TE FLAP DEFLECTION
!
         SWFT=SWF(1)+SWF(2)+SWF(3)+SWF(4)
         KSWEEP=(1.-0.08*COSC4**2)*COSC4**0.75
         DCLMAX(I)=DSCLMX(I)*SWFT*KSWEEP/SR
 1370 END DO
 1380 CONTINUE
      RETURN
      END
      SUBROUTINE LOARWB
!
!********** LOW ASPECT RATIO WING, WING-BODY AERODYNAMICS **************
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ SREFF,CBARR,ROUGFC,BLREF
      COMMON /SYNTSS/ SYNA(19)
      COMMON /SUPDW/  LB(237)
      COMMON /IBW/    PBW,BW(380)
      COMMON /POWER/  PWIN(29),LBIN(21)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      REAL KYBNO,KNBNO,KLBCNO,KYCN20,KYB,KNB,KCKCC2,KLB,KCCA20,KYBA,    &
     &     KNBA,KLBA,LBIN,L,LOK
      DIMENSION ROUTID(2),Q1212B(3),Q1213B(3),Q1214B(3),Q1212A(3),      &
     & Q1213A(3),Q1214A(3),Q48217(3),Q27INT(3),Q82210(3),Q2211A(3),     &
     & Q2211B(3),Q8327A(3),Q8326B(3),Q55116(3),Q55316(3),Q5218A(3),     &
     & Q5218B(3),Q55129(3),Q52213(3),Q5522B(3),Q5522A(3),Q55128(3)
      LOGICAL BLF,ROUNDN
      DIMENSION CCN(6),CCA(6),CCM(6)
      DIMENSION X5516(12),Y5516(12),X1558(14),X2558(11),Y558(154),      &
     & X1559(7),X2559(10),Y559(70),X5528(18),Y5528(18),X1558B(6),       &
     & X2558B(12),Y558B(72),X5522A(19),Y5522A(19),X5522B(8),Y5522B(8),  &
     & X55213(12),Y55213(12),X5536(19),Y5536(19)
      DIMENSION W1(6),W2(6),W3(6),W8(6),W7(6),W6(6)
      DIMENSION KYB(20),KNB(20),KLB(20),KYBA(20),KNBA(20),KLBA(20)
      DIMENSION ALPHAP(20),ALPAPR(20),CNP(20),CXP(20),CMP(20),CN(20),   &
     &          CA(20),CM(20),CL(20),CD(20),XCPOLR(20)
      EQUIVALENCE (LB(1),ALPHA0),(LB(2),ALPHAP(1)),                     &
     & (LB(28),CNAC0),(LB(29),CNC20),(LB(30),ACNA0),(LB(31),ACNA20),    &
     & (LB(32),Z),(LB(33),CN20),(LB(34),CNA0),(LB(35),ALPAPR(1)),       &
     & (LB(55),CNP(1)),(LB(75),SHAPEP),(LB(76),CPBOPS),                 &
     & (LB(83),CPB0),(LB(84),RN),(LB(85),LOK),(LB(86),CF),(LB(87),CX0P),&
     & (LB(88),SFOSR),(LB(89),GEOPAR),(LB(90),DCXCXC),(LB(91),ACX),     &
     & (LB(92),SHAPEB),(LB(93),CP20O0),(LB(94),ACPB0),(LB(95),CXP(1)),  &
     & (LB(115),CM0),(LB(117),BLUNTP),(LB(118),XOCRD),                  &
     & (LB(119),XOCRB),(LB(120),XOCRT),(LB(116),XCPOC),                 &
     & (LB(22),DX),(LB(121),CMP(1))
      DIMENSION C12B(6),RLEOB(7),RCNA0(7)
      DIMENSION C13A(6),SCNA20(8)
      DIMENSION C13B(6),RCNA20(7)
      DIMENSION C14A(6),ZS(8)
      DIMENSION C14B(6),ZR(7)
      DIMENSION C7(6),SBOLHB(7),CPBOP(7)
      DIMENSION X210(6),X110(11),Y10(66)
      DIMENSION C11A(6) ,B2OHS(7),CP2OCP(7)
      DIMENSION C11B(6),AP2OCP(7)
      DIMENSION C6B(6),THETA(5),XCPOCR(5)
      DIMENSION X27A(8),X17A(7),Y7A(56)
      DIMENSION C12A(6),DELTAE(8),SCNA0(8)
      DIMENSION C1(6),C2(6),C3(6)
      DIMENSION X27M(4),X27I(4),C27(6)
      EQUIVALENCE(LB(80),KYBNO),(LB(79),XCPXC),(LB(22),KCCA20),         &
     & (LB(78),KNBNO),(LB(77),DKLCNO),(LB(27),DKLCNB),(LB(26),KLBCNO)   &
     & ,(LB(25),KYCN20),(LB(141),KYB(1)),(LB(161),KNB(1)),              &
     & (LB(24),KCKCC2),(LB(23),DKCKCC),(LB(181),KLB(1))
      EQUIVALENCE(LBIN(5),AR),(LBIN(4),SFRONT),(LBIN(2),SREF),          &
     & (LBIN(3),DELTEP),(LBIN(6),R3LEOB),(LBIN(7),DELTAL),              &
     & (LBIN(12),HB),(LBIN(13),BB),(LBIN(11),SBASE),(LBIN(10),PERBAS),  &
     & (LBIN(9),SWET),(LBIN(8),L),(LBIN(16),THETAD),(LBIN(15),XCG),     &
     & (LBIN(1),ZB),(LBIN(17),ROUNDN),(LBIN(14),BLF),(LBIN(18),SBS),    &
     & (LBIN(19),SBSLB),(LBIN(20),XCENSB),(LBIN(21),XCENW)
      EQUIVALENCE(BW(61),CN(1)),(BW(81),CA(1)),(BW(41),CM(1)),          &
     & (BW(21),CL(1)),(BW(1),CD(1)),(BW(201),XCPOLR(1)),                &
     & (BW(141),KYBA(1)),(BW(161),KNBA(1)),(BW(181),KLBA(1))
      DATA ROUTID/4HLOAR,4HWB  /
      DATA Q1212B/4H4.8.,4H1.2-,4H12B /,Q1213B/4H4.8.,4H1.2-,4H13B /,   &
     &     Q1212A/4H4.8.,4H1.2-,4H12A /,Q1213A/4H4.8.,4H1.2-,4H13A /,   &
     &     Q1214B/4H4.8.,4H1.2-,4H14B /,Q1214A/4H4.8.,4H1.2-,4H14A /,   &
     &     Q48217/4H4.8.,4H2.1-,4H7   /,Q27INT/4H27 I,4HNTER,4HCEPT/,   &
     &     Q82210/4H4.8.,4H2.2-,4H10  /,Q2211A/4H4.8.,4H2.2-,4H11A /,   &
     &     Q8327A/4H4.8.,4H3.2-,4H7A  /,Q2211B/4H4.8.,4H2.2-,4H11B /,   &
     &     Q8326B/4H4.8.,4H3.2-,4H6B  /,Q55116/4H5.5.,4H1.1-,4H6   /,   &
     &     Q5218A/4H5.5.,4H2.1-,4H8A  /,Q55316/4H5.5.,4H3.1-,4H6   /,   &
     &     Q5218B/4H5.5.,4H2.1-,4H8B  /,Q55129/4H5.5.,4H1.2-,4H9   /,   &
     &     Q5522B/4H5.5.,4H2.2-,4H12B /,Q5522A/4H5.5.,4H2.2-,4H12A /,   &
     &     Q52213/4H5.5.,4H2.2-,4H13  /,Q55128/4H5.5.,4H1.2-,4H8   /
!
!**************FIGURE 4.8.1.2-12A **************************************
!     ALPHA CORRELATION,SHARP LEADING EDGE,CN=0
!
      DATA X27M/0.0,1.0,2.0,3.0/
      DATA X27I/1.57780,1.67221,1.98509,2.28874/
      DATA I27/0/
      DATA IN12A/0/
      DATA DELTAE/0.0,10.0,20.0,40.0,60.0,80.0,100.0,120.0/
      DATA SCNA0/1.18,1.16,1.11,1.0,.91,.82,.73,.65/
!
!     FIGURE 4.8.1.2-12B *************************************
!     CN ALPHA CORRELATION,ROUND LEADING EDGE,CN=0 ***********
!
      DATA IN12B/0/
      DATA RLEOB/0.0,.02,.04,.06,.08,.10,.12/
      DATA RCNA0/1.18,1.01,.89,.82,.80,.78,.77/
!
!     FIGURE 4.8.1.2-13A *************************************
!     CN ALPHA CORRELATION FACTOR,SHARP LEADING EDGE,ALPHA=20*
!
      DATA IN13A/0/
      DATA SCNA20/1.18,1.17,1.15,1.09,1.03,.98,.93,.89/
!
!     FIGURE 4.8.1.2-13B *************************************
!     CN ALPHA CORRELATION,ROUND LEADING EDGE,ALPHA=20 *******
!
      DATA IN13B/0/
      DATA RCNA20/1.18,.97,.82,.76,.73,.70,.68/
!
!     FIGURE 4.8.1.2-14A *************************************
!     Z VS. DELTAE,SHARP LEADING EDGE ************************
!
      DATA IN14A/0/
      DATA ZS/1.0,1.0,1.0,1.0,1.0,.98,.96,.92/
!
!     FIGURE 4.8.1.2-14B ************************************
!     Z VS. RLE/B ,ROUND LEADING EDGE **********************
!
      DATA IN14B/0/
      DATA ZR/1.0,.96,.83,.60,.37,.20,.20/
!
!     FIGURE 4.8.2.1-7 **********************************
!     ZERO NORMAL FORCE BASE-PRESSURE COEF. VS. SHAPE PARAMETER ***
!
      DATA IN7/0/
      DATA SBOLHB/0.0,.02,.04,.06,.08,.10,.12/
      DATA CPBOP/0.0,-.08,-.14,-.19,-.225,-.245,-.255/
!
!****************** FIGURE 4.8.2.2-10 **********************************
!********* BASE-PRESSURE COEF. CORRELATION FACTOR AT ALPHA=20 **********
!     X210=SF/SREF,X110=2.0*RLE*A/(B*X210),Y10=DCX/DCXC
!
      DATA X210/0.0,.10,.20,.30,.40,.50/
      DATA X110/0.0,.10,.20,.30,.40,.50,.60,.70,.80,.90,1.0/
      DATA Y10/0.0,.20,.31,.38,.43,.48,0.0,.23,.37,.46,.52,.58,0.0,.27, &
     &.42,.52,.60,.66,0.0,.31,.49,.605,.69,.73,0.0,.34,.56,.68,.77,.82, &
     &0.0,.39,.605,.75,.84,.91,0.0,.415,.67,.82,.92,1.0,0.0,.45,.71,.89,&
     &1.0,1.08,0.0,.49,.775,.95,1.07,1.14,0.0,.51,.81,1.00,1.115,1.19,  &
     &0.0,.55,.87,1.06,1.16,1.195/
!
!********* FIGURE 4.8.2.2-11A ******************************************
!     AXIAL FORCE COEFFICIENT CORRELATION FACTOR AT ALPHA=20 ******
!     TOTAL BASE AFT OF LIFTING SURFACE
!
      DATA IN11B/0/
      DATA IN11A/0/
      DATA B2OHS/2.0,4.0,8.0,12.0,16.0,20.0,24.0/
      DATA CP2OCP/1.3,1.5,1.80,2.0,2.1,2.15,2.20/
!
!**************      FIGURE 4.8.2.2-11B ********************************
!     AXIAL FORCE COEFFICIENT CORRELATION FACTOR AT ALPHA=20
!     PORTIONS OF BASE AFT OF NONLIFTING SURFACES
!
      DATA AP2OCP/1.15,1.15,1.25,1.40,1.47,1.51,1.54/
!
!**************FIGURE 4.8.3.2-6B ***************************************
!     C.P. FOR THIN,POINTED NOSE,SYMMETRICAL DELTA CONFIG
!
      DATA IN6B/0/
      DATA THETA/0.0,10.0,20.0,30.0,40.0/
      DATA XCPOCR/.65,.615,.585,.565,.550/
!
!******************* FIGURE 4.8.3.2-7A *********************************
!     EFFECTS OF NOSE BLUNTING ON C.P. FOR DELTA + MOD. DELTAS ****
!     X27A=1-4*TAN(THETA)/A,X17A=THETA,Y7A=DELTA(XCP/CR)
!
      DATA X27A/0.0,.01,.02,.04,.08,.12,.16,.21/
      DATA X17A/0.0,5.0,10.0,15.0,20.0,25.0,30.0/
      DATA Y7A/0.0,-.056,-.072,-.090,-.110,-.122,-.130,-.136,0.0,-.050, &
     &-.066,-.082,-.102,-.114,-.123,-.129,0.0,-.045,-.060,-.076,-.096,  &
     &-.107,-.115,-.122,0.0,-.042,-.056,-.072,-.089,-.100,-.109,-.117,  &
     &0.0,-.039,-.052,-.067,-.084,-.095,-.103,-.110,0.0,-.036,-.048,    &
     &-.062,-.0795,-.090,-.098,-.105,0.0,-.032,-.044,-.058,-.074,-.085, &
     &-.092,-.098/
      DATA N1,N2,N3,N8,N6,N7/6*0/
!
!*************** FIGURE 5.5.1.1-6 **************************************
!     (KYB) NO CORRELATION
!
      DATA X5516/0.0,.05,.10,.20,.25,.30,.35,.40,.45,.50,.55,.60/
      DATA Y5516/0.0,-.005,-.009,-.021,-.037,-.064,-.107,-.172,-.250,   &
     &-.340,-0.440,-.550/
!
!************** FIGURE 5.5.1.2-8 ***************************************
!     (DKYB/CN**2)20 VS. SBS/S ,ROUND LEADING EDGES
!
      DATA X1558/0.00,.02,.03,.04,.05,.06,.07,.08,.09,.10,.105,.110,    &
     &.115,.120/
      DATA X2558/0.00,.05,.10,.15,.20,.25,.30,.35,.40,.45,.50/
      DATA Y558/.0,.0,-.03,-.09,-.15,-.24,-.35,-.47,-.61,-.78,-.95,     &
     &.0,.0,-.02,-.05,-.09,-.14,-.20,-.26,-.35,-.44,-.54,               &
     &.0,.0,-.001,-.02,-.04,-.08,-.10,-.15,-.20,-.25,-.30,              &
     &.0,.0,.0,.0,.0,.0,.0,.0,.0,.0,.0,                                 &
     &.0,.0,.0,.0,.03,.05,.08,.10,.13,.19,.22,                          &
     &.0,.0,.0,.04,.07,.11,.18,.24,.31,.40,.50,                         &
     &.0,.0,.02,.07,.13,.20,.29,.39,.50,.63,.80,                        &
     &.0,.0,.03,.10,.19,.29,.40,.54,.70,.96,1.10,                       &
     &.0,.0,.04,.12,.22,.35,.50,.69,.90,1.11,1.39,                      &
     &.0,.0,.05,.15,.25,.40,.58,.79,1.02,1.30,1.60,                     &
     &.0,.0,.04,.12,.22,.35,.50,.69,.90,1.11,1.39,                      &
     &.0,.0,.03,.10,.19,.29,.40,.54,.70,.90, 1.10,                      &
     &.0,.0,.0,.05,.10,.15,.21,.29,.38,.49,.60,                         &
     &.0,.0,.0,.0,.0,.02,.03,.04,.06,.08,.10/
!
!************** FIGURE 5.5.1.2-9 ***************************************
!     CORRELATION OF (DKYB/CN**2)20 VS. SBS/S,SHARP LEADING EDGE
!
      DATA X1559/0.00,10.0,20.0,30.0,40.0,50.0,60.0/
      DATA X2559/0.00,.10,.15,.20,.25,.30,.35,.40,.45,.50/
      DATA Y559/0.0,-.04,-.09,-.155,-.24,-.342,-.472,-.620,-.77,-.95,   &
     &          0.0,-.02,-.065,-.11,-.17,-.244,-.338,-.440,-.55,-.67,   &
     &          0.0,-.01,-.040,-.07,-.11,-.151,-.200,-.260,-.329,-.40,  &
     &          0.0, 0.0,-.020,-.023,-.035,-.050,-.060,-.080,-.10,-.12, &
     &          0.0,0.0,.01,.022,.04,.06,.08,.11,.14,.18,               &
     &          0.0,.010,.039,.07,.11,.159,.22,.29,.37,.46,             &
     &          0.0,.028,.065,.123,.198,.279,.37,.48,.61,.75/
!
!************** FIGURE 5.5.2.1-8A **************************************
!     THETA VS. (KLBNO-CN)D
!
      DATA X5528/3.5,4.0,4.8,6.0,8.0,9.5,12.0,13.5,16.0,18.0,22.0,25.0, &
     &28.0,31.0,34.0,39.0,42.0,45.0/
      DATA Y5528/-2.7,-2.4,-2.0,-1.6,-1.2,-1.00,-.80,-.70,-.58,-.52,    &
     &-.40,-.36,-.30,-.27,-.24,-.20,-.18,-.16/
!
!************** FIGURE 5.5.2.1-8B **************************************
!     1-4TAN(THETA)/A VS. D(KLB/CN)B
!
      DATA X1558B/5.,10.,15.,20.,25.,30./
      DATA X2558B/0.0,.01,.02,.04,.06,.08,.1,.12,.14,.16,.18,.20/
      DATA Y558B/0.0,.24,.30,.403,.477,.537,.585,.628,.667,.704,.74,.77,&
     &0.0,.092,.13,.176,.21,.236,.257,.275,.294,.314,.33,.347,          &
     &0.0,.054,.074,.105,.125,.139,.152,.168,.179,.188,.199,.204,       &
     &0.0,.035,.050,.07,.08,.09,.101,.110,.120,.130,.138,.144,          &
     &0.0,.024,.033,.05,.059,.066,.071,.08,.086,.09,.100,.102,          &
     &0.0,.019,.025,.036,.042,.048,.052,.06,.063,.067,.072,.076/
!
!************** FIGURE 5.5.2.2-12A *************************************
!    KLB VS. R3LE/B
!
      DATA X5522A/.0,.005,.01,.015,.020,.03,.035,.045,.050,.060,.070,   &
     &.08,.09,.10,.11,.12,.13,.14,.145/
      DATA Y5522A/1.0,.84,.76,.70,.66,.61,.61,.66,.70,.81,.94,1.10,1.24,&
     &1.34,1.42,1.50,1.54,1.60,1.61/
!
!************** FIGURE 5.5.2.2-12B *************************************
!     DELTAE VS KLB
!
      DATA X5522B/0.0,10.0,20.0,30.0,40.0,50.0,60.0,70.0/
      DATA Y5522B/1.0,.94,.83,.69,.50,.32,.19,.10/
!
!**************** FIGURE 5.5.2.2-13 ************************************
!     SBS/S VS. D(KLB)
!
      DATA X55213/.0,.10,.20,.30,.40,.50,.60,.65,.70,.80,.90,1.00/
      DATA Y55213/.0,.03,.09,.12,.16,.20,.26,.30,.38,.53,.80,.125/
!
!***************** FIGURE 5.5.3.1-6 ************************************
!     (SBS).2CR/SBS VS. XCP/CEN
!
      DATA X5536/.0,.01,.02,.03,.04,.05,.06,.07,.08,.09,.10,.11,.12,.13,&
     &.14,.15,.16,.165,.170/
      DATA Y5536/1.04,1.04,1.04,1.04,1.04,1.04,1.04,1.04,1.04,1.04,1.04,&
     &1.00,.93,.81,.655,.51,.32,.18,.0/
!
!************** CALCULATE ZERO NORMAL FORCE ANGLE OF ATTACK (ALPHA0) ***
!
      SYNA(1)=XCG
      ALPHA0=ATAN(ZB/L)*RAD
      DO 1000 J=1,NALPHA
         ALPHAP(J)=FLC(J+22)-ALPHA0
 1000 END DO
!
!************** CALCULATE CN VS.ALPHA **********************************
!
      CNAC0=(PI*AR/2.0+2.0*SFRONT/SREF)*(4.0/(4.0+AR))
      CNC20=2.195*((AR+0.61)/(AR+4.0))
      IF(DELTEP.NE.UNUSED) GO TO 1010
      CALL TBFUNX(R3LEOB,ACNA0,DYDX,7,RLEOB,RCNA0,C12B,IN12B,MI,NG,     &
     &            0,2,Q1212B,3,ROUTID)
      CALL TBFUNX(R3LEOB,ACNA20,DYDX,7,RLEOB,RCNA20,C13B,IN13B,MI,NG,   &
     &            0,2,Q1213B,3,ROUTID)
      CALL TBFUNX(R3LEOB,Z,DYDX,7,RLEOB,ZR,C14B,IN14B,MI,NG,            &
     &            0,2,Q1214B,3,ROUTID)
      CN20=CNC20*((1.0+COS(DELTAL/RAD))/2.0)*ACNA20
      CNA0=CNAC0*ACNA0
      GO TO 1020
 1010 CONTINUE
      CALL TBFUNX(DELTEP,ACNA0,DYDX,8,DELTAE,SCNA0,C12A,IN12A,MI,NG,    &
     &            0,2,Q1212A,3,ROUTID)
      CALL TBFUNX(DELTEP,ACNA20,DYDX,8,DELTAE,SCNA20,C13A,IN13A,MI,NG,  &
     &            0,2,Q1213A,3,ROUTID)
      CALL TBFUNX(DELTEP,Z,DYDX,8,DELTAE,ZS,C14A,IN14A,MI,NG,           &
     &            0,2,Q1214A,3,ROUTID)
      CN20=CNC20*ACNA20
      CNA0=CNAC0*ACNA0
 1020 CONTINUE
      DO 1030 J=1,NALPHA
         ALPAPR(J)=ALPHAP(J)/RAD
         CNP(J)=CNA0*ALPAPR(J)+8.21*(CN20-0.349*CNA0)*(Z+2.81*(1.0-Z)*  &
     &          ALPAPR(J))*(ALPAPR(J))**2
 1030 END DO
!
!************** CALCULATE ZERO NORMAL FORCE AXIAL FORCE ****************
!          CALCULATE CA AT CN=0.0 DUE TO BASE PRESSURE
!
      SHAPEP=2.0*SBASE/(PI*L *(HB+BB))
      CALL TBFUNX(SHAPEP,CPBOPS,DYDX,7,SBOLHB,CPBOP,C7,IN7,MI,NG,       &
     &            0,2,Q48217,3,ROUTID)
      CPB0=CPBOPS*PERBAS*SBASE/(2.0*SQRT(PI*SBASE)*SREF)
!
!********* CALCULATE CA AT CN=0.0 DUE TO SKIN FRICTION *****************
!
      RN=FLC(I+42)*L
      LOK=12.0*L/ROUGFC
      CALL TBFUNX(FLC(I+2),CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,         &
     &            0,0,Q27INT,3,ROUTID)
      RL=LOK**1.0482*10.0**CEPT
      IF(RL.LT.RN) RN=RL
      CALL FIG26(RN,FLC(I+2),CF)
      CX0P=-CF*SWET/SREF+CPB0
!
!*************** CALCULATE AXIAL FORCE VARIATION WITH ANGLE OF ATTACK **
!
      SFOSR=SFRONT/SREF
      GEOPAR=2.0*R3LEOB*AR/SFOSR
      CALL TLINEX(X110,X210,Y10,11,6,GEOPAR,SFOSR,DCXCXC,               &
     &            0,0,2,2,Q82210,3,ROUTID)
      ACX=+DCXCXC*0.349*((AR+2)/(AR+4))
      SHAPEB=BB**2/(HB*SBASE**.50)
      IF(BLF) GO TO 1040
      CALL TBFUNX(SHAPEB,CP20O0,DYDX,7,B2OHS,CP2OCP,C11A,IN11A,MI,NG,   &
     &            2,2,Q2211A,3,ROUTID)
      GO TO 1050
 1040 CALL TBFUNX(SHAPEB,CP20O0,DYDX,7,B2OHS,AP2OCP,C11B,IN11B,MI,NG,   &
     &            2,2,Q2211B,3,ROUTID)
 1050 CONTINUE
      ACPB0=CPB0*(CP20O0-1.0)
      DO 1060 J=1,NALPHA
         CXP(J)=CX0P+ACX*CNP(J)*SQRT(ABS(ALPHAP(J))/20.0)+              &
     &          ACPB0*(ALPHAP(J)/20.0)**2
         CXP(J)=-CXP(J)
 1060 END DO
!
!************** CALCULATE CM VS. ALPHA *********************************
!
      CM0=0.0003333*ALPHA0
      IF(ROUNDN) GO TO 1070
      GO TO 1080
 1070 BLUNTP=1.0-(4.0*TAN(THETAD/RAD))/AR
      CALL TLINEX(X17A,X27A,Y7A,7,8,THETAD,BLUNTP,XOCRB,                &
     &            0,0,1,2,Q8327A,3,ROUTID)
 1080 CALL TBFUNX(THETAD,XOCRD,DYDX,5,THETA,XCPOCR,C6B,IN6B,MI,NG,      &
     &            0,2,Q8326B,3,ROUTID)
      XOCRT=0.1020*SFOSR
      XCPOC=XOCRD+XOCRB+XOCRT
      XMOCR=XCG/L
      DX=XMOCR-XCPOC
      DO 1090 J=1,NALPHA
         CMP(J)=CM0+DX*CNP(J)
 1090 END DO
      DO 1120 J=1,NALPHA
         IF(ALPHA0.NE.0.0) GO TO 1100
         CN(J)=CNP(J)
         CA(J)=CXP(J)
         CM(J)=CMP(J)
         GO TO 1110
 1100    CONTINUE
         INCN=0
         INCA=0
         INCM=0
         CALL TBFUNX(FLC(J+22),CN(J),DYDX,NALPHA,ALPHAP(1),CNP(1),CCN,  &
     &               INCN,MI,NG,0,0,4H CN ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),CA(J),DYDX,NALPHA,ALPHAP(1),CXP(1),CCA,  &
     &               INCA,MI,NG,0,0,4H CA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),CM(J),DYDX,NALPHA,ALPHAP(1),CMP(1),CCM,  &
     &               INCM,MI,NG,0,0,4H CM ,1,ROUTID)
 1110    CONTINUE
         SINA=SIN(FLC(J+22)/RAD)
         COSA=COS(FLC(J+22)/RAD)
         CL(J)=CN(J)*COSA-CA(J)*SINA
         CD(J)=CA(J)*COSA+CN(J)*SINA
         IF(CN(J).EQ.0.0) CN(J)=1.0E-20
         XCPOLR(J)=CM(J)/CN(J)
 1120 END DO
!
!*************WING, WING-BODY LATERAL STABILITY CALCULATIONS************
!        WING-BODY SIDEFORCE DERIVATIVE NEAR ZERO NORMAL FORCE**
!
      ARG1=SBS/SREF
!
!********************** FIGURE 5.5.1.1-6 *******************************
!
      CALL TBFUNX(ARG1,KYBNO,DYDX,12,X5516,Y5516,W1,N1,MI,NG,           &
     & 0,2,Q55116,3,ROUTID)
!
!        WING-BODY YAWING MOMENT DERIVATIVE NEAR ZERO NORMAL FORCE**
!
      ARG1=SBSLB/SBS
!
!        FIGURE 5.5.3.1-6
!
      CALL TBFUNX(ARG1,XCPXC,DYDX,19,X5536,Y5536,W2,N2,MI,NG,           &
     &            0,0,Q55316,3,ROUTID)
      XCPP=XCPXC*XCENSB
      AKN1=-.006*(XCG-XCENW)/(RAD*BB)
      AKN2=(XCG-XCPP)/(RAD*BB)
!
!*****WING, WING-BODY ROLLING MOMENT DERIVATIVE NEAR ZERO NORMAL FORCE**
!        FIGURE 5.5.2.1-8A
!
      CALL TBFUNX(THETAD,DKLCNO,DYDX,18,X5528,Y5528,W3,N3,WI,NT,        &
     &            2,2,Q5218A,3,ROUTID)
      IF(ROUNDN)GO TO 1130
      DKLCNB=0.0
      GO TO 1140
 1130 ARG1=1.-(4.*TAN(THETAD/RAD)/AR)
!
!        FIGURE 5.5.2.1-8B
!
      CALL TLINEX(X1558B,X2558B,Y558B,  6, 12,THETAD,ARG1,DKLCNB,       &
     &            2,0,2,2,Q5218B,3,ROUTID)
 1140 KLBCNO=1./RAD*(DKLCNO+DKLCNB)
!
!**************PARAMETERS REQUIRED TO CALCULATE (KYB)J *****************
!
      ARG6=SBS/SREF
      IF(R3LEOB.NE.UNUSED)GO TO 1150
      ARG1=DELTEP
      CALL TLINEX(X1559,X2559,Y559,  7, 10,ARG1,ARG6,KYCN20,            &
     &            0,0,1,1,Q55129,3,ROUTID)
      GO TO 1160
 1150 ARG1=R3LEOB
      CALL TLINEX(X1558,X2558,Y558, 14, 11,ARG1,ARG6,KYCN20,            &
     &            0,0,0,2,Q55128,3,ROUTID)
 1160 CONTINUE
!
!**************PARAMETERS REQUIRED TO CALCULATE (KLB)J *****************
!        FIGURE 5.5.2.2-13
!
      CALL TBFUNX(ARG6,DKCKCC,DYDX,12,X55213,Y55213,W8,N8,MI,NG,        &
     &            0,0,Q52213,3,ROUTID)
      IF(R3LEOB.NE.UNUSED)GO TO 1170
!
!********************** FIGURE 5.5.2.2-12B *****************************
!
      CALL TBFUNX(DELTEP,KCKCC2,DYDX, 8,X5522B,Y5522B,W6,N6,MI,NG,      &
     &            0,2,Q5522B,3,ROUTID)
      GO TO 1180
 1170 CONTINUE
!
!        FIGURE 5.5.2.2-12A
!
      CALL TBFUNX(R3LEOB,KCKCC2,DYDX,19,X5522A,Y5522A,W7,N7,MI,NG,      &
     &            0,2,Q5522A,3,ROUTID)
 1180 CONTINUE
      KCCA20=1./(1.+.152/TAN(THETAD/RAD))*DKLCNO
      BPART=KCKCC2+DKCKCC
!
!*****WING, WING-BODY DERIVATIVES VARIATION WITH ANGLE OF ATTACK********
!
      DO 1190 J=1,NALPHA
!
!************** SIDEFORCE DERIVATIVE ***********************************
!
         KYB(J)=(1./RAD)*(KYBNO+KYCN20*CNP(J)**2)
!
!************ YAWING MOMENT DERIVATIVE *********************************
!
         KNB(J)=(KYB(J)+.006)*AKN2+AKN1
!
!************ ROLLING MOMENT DERIVATIVE ********************************
!
         CPART=CNP(J)/RAD
         APART=DKLCNO*(1.-(ALPHAP(J)/20.)**2)
         KLB(J)=CPART*(APART+(BPART*KCCA20+DKLCNB)*(ALPHAP(J)/20.)**2)
 1190 END DO
      INKY=0
      INKN=0
      INKL=0
      DO 1210 J=1,NALPHA
         IF(ALPHA0.NE.0.0) GO TO 1200
         KYBA(J)=KYB(J)
         KNBA(J)=KNB(J)
         KLBA(J)=KLB(J)
         GO TO 1210
 1200    CALL TBFUNX(FLC(J+22),KYBA(J),DYDX,NALPHA,ALPHAP(1),KYB(1),C1, &
     &               INKY,MI,NG,0,0,4HKYB ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),KNBA(J),DYDX,NALPHA,ALPHAP(1),KNB(1),C2, &
     &               INKN,MI,NG,0,0,4HKNB ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),KLBA(J),DYDX,NALPHA,ALPHAP(1),KLB(1),C3, &
     &               INKL,MI,NG,0,0,4HKLB ,1,ROUTID)
 1210 END DO
      RETURN
      END
      SUBROUTINE LVALUE(KOL,L,NDML,NF,BLANK,COMMA,NUMBER)
!
! TEST FOR LEGAL LOGICAL CONSTANTS AND MULTIPLICTION FACTOR FOR INPUT
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      DIMENSION KOL(80), NUMBER(15), TRUE(6), FALSE(7)
      INTEGER BLANK, COMMA, TRUE, FALSE
      LOGICAL STAR, NMTEST
      DATA TRUE  / 4H.   ,4HT   ,4HR   ,4HU   ,4HE   ,4H.   /
      DATA FALSE / 4H.   ,4HF   ,4HA   ,4HL   ,4HS   ,4HE   ,4H.   /
!
 1010 CONTINUE
      MULT = 0
      STAR = .FALSE.
      IF(L .GE. 81) GO TO 1090
      IF(KOL(L) .NE. BLANK) GO TO 1020
        L = L+1
        GO TO 1010
 1020 CONTINUE
!
!***  TEST FOR MULTIPLICATION FACTOR
!
      DO 1030 J=1,14
        IF(J .GE. 11 .AND. J .LE. 13) GO TO 1030
        IF(KOL(L) .EQ. NUMBER(J)) GO TO 1040
        IF(L .GE. 80) GO TO 1050
 1030 END DO
      GO TO 1050
 1040 CONTINUE
      IF(STAR)      NF = NF+1
      IF(J .EQ. 14) STAR = .TRUE.
      IF(J .LE. 10) MULT = 10*MULT+J-1
      L = L+1
      GO TO 1020
 1050 CONTINUE
      IF(.NOT. STAR .AND. MULT .GT. 0) NF = NF+1
      IF(STAR .AND. MULT .EQ. 0)       NF = NF+1
      IF(MULT .EQ. 0) MULT = 1
!
!***  TEST FOR LOGICAL CONSTANTS
!
      NCHR = 6
      IF(NMTEST(KOL(L),TRUE,NCHR))  GO TO 1060
      NCHR = 7
      IF(NMTEST(KOL(L),FALSE,NCHR)) GO TO 1060
      GO TO 1090
 1060 CONTINUE
      L = L+NCHR
 1070 CONTINUE
      IF(L .GE. 80) GO TO 1080
      IF(KOL(L) .NE. BLANK) GO TO 1080
        NF = NF+1
        L = L+1
        GO TO 1070
 1080 CONTINUE
      IF(KOL(L) .NE. COMMA .AND. KOL(L) .NE. KAND) NF = NF+1
      IF(KOL(L) .EQ. COMMA) L = L+1
      NDML = NDML+MULT
      GO TO 1010
!
!***  END OF CARD OR NON-LOGICAL VARIABLE FOUND
!
 1090 CONTINUE
      IF(NDML .EQ. 0) NF = NF+1
      RETURN
      END
      SUBROUTINE M01O01
!
!***  EXEC FOR OVERLAY 1, INITIALIZE PROGRAM AND PROCESS INPUTS
!
!!!      external blockd
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
      COMMON /EXPER/  KLIST,NLIST(100),NN(2),FLAG(9),ALP(4)
!
      LOGICAL  LEQV(65),LOGCOM(34),FLAG
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
      EQUIVALENCE (LOGCOM(1),FLTC)
      EQUIVALENCE (LEQV(1),IERR)
!
      NOVLY=1
!
!***  TEST FOR VALID INPUT ON THE FIRST ENTRY - CONERR
!
      IF(.NOT. FIRST) GO TO 1010
          FIRST = .FALSE.
          DRCONV = .FALSE.
          CALL CONERR
 1010 CONTINUE
!
!***  INITIALIZE INPUTS AND DATA ARRAYS
!
      CALL INITZE
      HEAD = .FALSE.
      IERR = .FALSE.
      DO 1020 L=1,NLOG
          IF(L .EQ. 29) GO TO 1020
          LOGCOM(L) = .FALSE.
 1020 END DO
      IF(SAVE) GO TO 1040
          REWIND 8
          KLIST = 0
          DO 1030 L=1,100
          IF(L .LE. 9) FLAG(L) = .FALSE.
          IF(L .LE. 4) ALP(L)  = UNUSED
 1030     NLIST(L) = 0
 1040 CONTINUE
!
!***  READ AND WRITE INPUTS
!
      CALL INPUT
      IF(.NOT. GONOGO) GO TO 1010
!
!***  TEST INPUTS
!
      CALL CHECK
      IF(IERR) GO TO 1010
      RETURN
      END

      SUBROUTINE M02O02
!
!***  EXEC FOR OVERLAY 2, CALCULATE GEOMETRIES AND SYNTHESIS DATA
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /WINGI/  WINGIN(101)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /HTI/    HTIN(154)
      COMMON /WINGD/  A(195), B(49)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      DIMENSION INDX(12)
      DATA INDX/1,2,3,4,5,6,7,119,120,163,167,168/
!
      NOVLY=2
!
!     ----STORE QUANTITIES IN PROPER LOCATION ECT. TO START COMPUTATIONS
!
      CALL SETUP1
      IF(LOASRT)GO TO 1020
!
!      ----COMPUTE PLANFORM GEOMETRIES IF PRESENT
!
      IF(WGPL) CALL WTGEOM(A,WINGIN)
      IF(HTPL) CALL WTGEOM(AHT,HTIN)
      IF(VTPL) CALL WTGEOM(AVT,VTIN)
      DO 1000 I=1,12
        II=INDX(I)
        IF(AVT(II).NE.UNUSED)AVT(II)=AVT(II)/2.
 1000 END DO
      IF(VFPL) CALL WTGEOM(AVF,VFIN)
      DO 1010 I=1,12
        II=INDX(I)
        IF(AVF(II).NE.UNUSED)AVF(II)=AVF(II)/2.
 1010 END DO
!
      AVT(130) = AVT(130)+ ZV
      AVT(133) = AVT(133)+ ZV
      AVT(136) = AVT(136)+ ZV
      AVF(130) = AVF(130)+ZVF
      AVF(133) = AVF(133)+ZVF
      AVF(136) = AVF(136)+ZVF
!
!     ----IF SREF AND CBARR WERE INPUTS USE INSTEAD OF COMPUTED VALUES.
!
      IF(SREF.EQ.UNUSED)SREF=A(4)
      IF(CBARR.EQ.UNUSED)CBARR=A(122)
      IF(BLREF.EQ.UNUSED)BLREF=2.*WINGIN(4)
!
!     ----SET ROUGHNESS FACTOR IF NOT READ IN
!
 1020 IF(ROUGFC.EQ.UNUSED)ROUGFC=1.6E-04
      IF(LOASRT)GO TO 1030
!
!     ----COMPUTE SYNTHESIZING DIMENSIONS IF WING + BODY PRESENT
!
      IF(WGPL)CALL SYNDIM
!
!      ----CLASSIFY PANEL ASPECT RATIO IF PRESENT
!
      A(128)   = WINGIN(92)
      AHT(128) = HTIN(92)
      AVT(128) = VTIN(92)
      AVF(128) = VFIN(92)
      IF(WGPL) CALL ARCLSS(A)
      IF(HTPL) CALL ARCLSS(AHT)
      IF(VTPL) CALL ARCLSS(AVT)
      IF(VFPL) CALL ARCLSS(AVF)
!
!     ----IF ANY COMBINATIONS COMPUTE INTERFERENCE FACTOR GEOMETRY
!
      IF((WGPL.AND.BO).OR.(HTPL.AND.BO)) CALL INFTGM
 1030 CONTINUE
      RETURN
      END
      SUBROUTINE M03O03
!
!***  EXEC FOR OVERLAY 3, SUBSONIC WING DRAG
!
      COMMON /OVERLY/ IJKDUM(8),NOVLY
      COMMON /WINGD/  A(195),B(49)
      COMMON /WHAERO/ C(51),D(55),CHT(51),DHT(55),DVT(55)
      COMMON /WINGI/  WINGIN(77)
      COMMON /IWING/  PWING,WING(400)
      NOVLY=3
      CALL CDRAG(A,B,D,WINGIN,WING)
      RETURN
      END
      SUBROUTINE M04O04
!
!***  EXEC FOR OVERLAY 4, SUBSONIC ASYMETRIC BODY AERODYNAMICS
!
      COMMON /IBODY/  PBODY, BODY(400)
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA,IJKDUM(4),NOVLY
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /WINGD/  A(195)
      COMMON /WINGI/  WINGIN(100)
      COMMON /SUPBOD/ SBD(229)
      COMMON /BODYI/  XNX,X(20),S(20),P(20),R(20),                      &
     &                ZU(20),ZL(20),BNOSE,BTAIL,RLN,RLA,DS,dum2(3)
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,XVF,&
     &                SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /HTI/    HTIN(154)
      COMMON /HTDATA/ AHT(195)
      COMMON /BDATA/  BD(275),BOD(120)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
      COMMON /EXPER/  KKK(104),KBODY
!
      LOGICAL KBODY,FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
      DIMENSION XS(20),SS(20),PS(20),RS(20),XI(3)
      DIMENSION ZUS(20), ZLS(20)
      DIMENSION C(6), D(6), ROUTID(2)
      DATA ROUTID / 4HM04O, 4H04   /
!
      NOVLY=4
      CALL BODOPT
      CALL EXSUBT
!
      IN = 0
      IF(KBODY) CALL TBFUNX(0.0,BD(62),DYDX,NALPHA,BODY(21),BODY(41),   &
     &                      C,IN,MI,NG,1,1,4HCM0 ,1,ROUTID)
!
!     CALCULATE CLA, CMA, CYB, CNB, CLB, CN, AND CA
!
      BFACT = CBARR/BLREF
      IN = 0
      IM = 0
      DO 1020 J=1,NALPHA
         IF(J .EQ. 1 .AND. .NOT. KBODY) GO TO 1010
         CALL TBFUNX(FLC(J+22),XX,BODY(J+100),NALPHA,FLC(23),BODY(21),  &
     &               C,IN,MI,NG,0,0,4HCLAB,1,ROUTID)
         CALL TBFUNX(FLC(J+22),XX,BODY(J+120),NALPHA,FLC(23),BODY(41),  &
     &               D,IM,MI,NG,0,0,4HCMAB,1,ROUTID)
 1010    CONTINUE
         BODY(J+140) = -BODY(J+100)
         BODY(J+160) = -BFACT*BODY(J+120)
         BODY(J+180) = 0.0
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         BODY(J+60) = BODY(J+20)*CA + BODY(J)*SA
         BODY(J+80) = BODY(J)*CA - BODY(J+20)*SA
 1020 END DO
      RETURN
      END
      SUBROUTINE M05O05
!
!***  EXEC FOR OVERLAY 5, SUBSONIC HORIZONTAL TAIL DRAG
!
      COMMON /OVERLY/ IJKDUM(8),NOVLY
      COMMON /HTDATA/ AHT(195),BHT(49)
      COMMON /WHAERO/ C(51),D(55),CHT(51),DHT(55),DVT(55)
      COMMON /HTI/    HTIN(131)
      COMMON /IHT/    PHT,HT(380)
      NOVLY=5
      CALL CDRAG(AHT,BHT,DHT,HTIN,HT)
      RETURN
      END
      SUBROUTINE M06O06
!
!***  EXEC FOR OVERLAY 6, SUBSONIC AXISYMMETRIC BODY AERO
!
      COMMON /IBODY/ PBODY, BODY(400)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA,IJKDUM(4),NOVLY
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /WINGD/  A(195)
      COMMON /WINGI/  WINGIN(100)
      COMMON /BODYI/  XNX,X(20),S(20),P(20),R(20),ZL(20),ZU(20),        &
     &                BNOSE,BTAIL,RLN,RLA,DS,ITYPE,METHOD,dum2(1)
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ALIH,XV,VERTUP,HINAX,       &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /HTI/    HTIN(154)
      COMMON /HTDATA/ AHT(195)
      COMMON /BDATA/  BD(275),BOD(120)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /EXPER/  KKK(104),KBODY
!
      REAL METHOD
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB,KBODY
      DIMENSION C(6), D(6), ROUTID(2)
      DIMENSION XS(20),SS(20),PS(20),RS(20),XI(3)
      DIMENSION ZUS(20), ZLS(20)
      DATA ROUTID / 4HM06O, 4H06   /
!
      NOVLY=6
      CALL BODYRT
      IF(SUBSON .AND. (METHOD .GT. 1.5)) CALL BODYJM
      CALL EXSUBT
!
      IN = 0
      IF(KBODY .AND. .NOT. TRANSN) CALL TBFUNX(0.0,BD(62),XX,NALPHA,    &
     &   BODY(21),BODY(41),C,IN,MI,NG,1,1,4HCM0 ,1,ROUTID)
!
!     CALCULATE CLA, CMA, CYB, CNB, CLB, CN, AND CA
!
      BFACT = CBARR/BLREF
      IN = 0
      IM = 0
      DO 1020 J=1,NALPHA
         IF(J .EQ. 1 .AND. .NOT. KBODY) GO TO 1010
         CALL TBFUNX(FLC(J+22),XX,BODY(J+100),NALPHA,FLC(23),BODY(21),  &
     &               C,IN,MI,NG,0,0,4HCLAB,1,ROUTID)
         CALL TBFUNX(FLC(J+22),XX,BODY(J+120),NALPHA,FLC(23),BODY(41),  &
     &               D,IM,MI,NG,0,0,4HCMAB,1,ROUTID)
 1010    CONTINUE
         BODY(J+140) = -BODY(J+100)
         BODY(J+160) = -BFACT*BODY(J+120)
         BODY(J+180) = 0.0
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         BODY(J+60) = BODY(J+20)*CA + BODY(J)*SA
         BODY(J+80) = BODY(J)*CA - BODY(J+20)*SA
 1020 END DO
      RETURN
      END
      SUBROUTINE M07O07
!
!***  EXEC FOR OVERLAY 7, SUBSONIC WING, WING BODY AERO
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
!
      NOVLY=7
!
      CALL WBAERO
      CALL WBCD
      RETURN
      END
      SUBROUTINE M08O10
!
!***  EXEC FOR OVERLAY 8, SUBSONIC VERTICAL TAIL DRAG
!
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55), DVF(55)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K,NOVLY
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
!
      NOVLY=8
      IF(VTPL) CALL VTDRAG(I)
      IF(VFPL) CALL VFDRAG(I)
!
!     SETUP VT IOM
!
      VT(1) = DVT(20)
      VT(21) = 0.0
      VT(41) = 0.0
      VT(61) = 0.0
      VT(101) = 0.0
      VT(121) = 0.0
      DO 1010 J=2,NALPHA
         VT(J) = -UNUSED
         VT(J+20) = -UNUSED
         VT(J+40) = -UNUSED
         VT(J+60) = -UNUSED
         VT(J+80) = -UNUSED
         VT(J+100) = -UNUSED
         VT(J+120) = -UNUSED
 1010 END DO
!
!     SETUP VF IOM
!
      VF(1) = DVF(20)
      VF(21) = 0.0
      VF(41) = 0.0
      VF(61) = 0.0
      VF(101) = 0.0
      VF(121) = 0.0
      DO 1020 J=2,NALPHA
         VF(J) = -UNUSED
         VF(J+20) = -UNUSED
         VF(J+40) = -UNUSED
         VF(J+60) = -UNUSED
         VF(J+80) = -UNUSED
         VF(J+100) = -UNUSED
         VF(J+120) = -UNUSED
 1020 END DO
      RETURN
      END
      SUBROUTINE M09O11
!
!***  EXEC FOR OVERLAY 9, SUBSONIC WING FLOW FIELDS
!
      COMMON /CONSNT/ CONST(5)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /EXPER/ KLIST, NLIST(100), NNAMES, IMACH, MDATA,           &
     &               KBODY, KWING, KHT, KVT, KWB, KDWASH(3),            &
     &               ALPOW, ALPLW, ALPOH, ALPLH
      COMMON /WINGD/  A(195), B(49)
      COMMON /IWING/  PWINF, WING(400)
      COMMON /IDWASH/ PDWASH, DWASHI(60)
      EQUIVALENCE (KDWASH(2),KEPSLN)
      LOGICAL KEPSLN, KDWASH
      NOVLY=9
      CALL DWASH
      IF(KEPSLN) CALL EXSUBT
      CALL DYPRLS(B(46),A(24),A(16),WING(21),A(7),A(11),B(23),          &
     &            DWASHI(1),NALPHA,KEPSLN)
      IF(KDWASH(1)) CALL EXSUBT
      RETURN
      END
      SUBROUTINE M10O12
!
!***  EXEC FOR OVERLAY 10, SUBSONIC WING-BODY-TAIL AERO
!
      COMMON /IVT/    PVT,    VT(380)
      COMMON /IVF/    PVF,    VF(380)
      COMMON /IBW/    PBW,    BW(380)
      COMMON /IBWH/   PBWH,   BWH(380)
      COMMON /IBWV/   PBWV,   BWV(380)
      COMMON /IBWHV/  PBWHV,  BWHV(380)
      COMMON /IDWASH/ PDWASH, DWASH(60)
      COMMON /FLGTCD/ FLC(160)
      COMMON /WINGI/  WINGIN(101)
      COMMON /HTI/    HTIN(154)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K,NOVLY
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB,FOUND
!
      DIMENSION CR(6), DR(6), ROUTID(2)
      DATA ROUTID / 4HM10O, 4H12   /
!
      NOVLY=10
      CALL EXSUBT
      IF(.NOT. HTPL) GO TO 1000
      CALL WGEOTL
      CALL WBTAIL
!
!     CALCULATE  B-W-H  CN, CA, CLA, AND CMA
!
 1000 IN = 0
      IM = 0
      NLA=NALPHA
      FOUND=.FALSE.
      DO 1010 J=1,NALPHA
         IF(BW(J+40) .NE. 2.*UNUSED .OR. FOUND)GO TO 1010
         NLA=J-1
         FOUND=.TRUE.
 1010 END DO
      DO 1040 J=1,NALPHA
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         IF(.NOT. HTPL) GO TO 1020
         BWH(J+60) = BWH(J+20)*CA + BWH(J)*SA
         BWH(J+80) = BWH(J)*CA - BWH(J+20)*SA
         IF(J .EQ. 1) GO TO 1020
         CALL TBFUNX(FLC(J+22),X,BWH(J+100),NALPHA,FLC(23),BWH(21),     &
     &               CR,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),X,BWH(J+120),NLA,FLC(23),BWH(41),        &
     &               DR,IM,MI,NG,0,0,4HCMA ,1,ROUTID)
         IF(J .GT. NLA) BWH(J+120)=2.*UNUSED
 1020    CONTINUE
!
!     CALCULATE  B-W-V  DATA
!
         BWV(J) = BW(J) + VT(1) + VF(1)
         BWV(J+20) = BW(J+20)
         BWV(J+40) = BW(J+40)
         BWV(J+60) = BWV(J+20)*CA + BWV(J)*SA
         BWV(J+80) = BWV(J)*CA - BWV(J+20)*SA
         BWV(J+100) = BW(J+100)
         BWV(J+120) = BW(J+120)
         IF(.NOT. HTPL) GO TO 1030
!
!     CALCULATE  B-W-H-V  DATA
!
         BWHV(J+20) = BWH(J+20)
         BWHV(J+40) = BWH(J+40)
         BWHV(J+60) = BWHV(J+20)*CA + BWHV(J)*SA
         BWHV(J+80) = BWHV(J)*CA - BWHV(J+20)*SA
         BWHV(J+100) = BWH(J+100)
         BWHV(J+120) = BWH(J+120)
 1030    IF(BW(J) .NE. -UNUSED) GO TO 1040
         BWV(J   ) = -UNUSED
         BWV(J+60) = -UNUSED
         BWV(J+80) = -UNUSED
         BWH(J   ) = -UNUSED
         BWH(J+60) = -UNUSED
         BWH(J+80) = -UNUSED
         BWHV(J   ) = -UNUSED
         BWHV(J+60) = -UNUSED
         BWHV(J+80) = -UNUSED
 1040 END DO
      RETURN
      END
      SUBROUTINE M11O13
!
!***  EXEC FOR OVERLAY 11, GROUND EFFECTS
!
      COMMON /IBW/     PBW, BW(380)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,IJKDUM(2),NOVLY
      COMMON /CONSNT/ PI,DEG,UNUSED,rad,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /SUPWH/  GR(303)
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPFLC,DPFACT,&
     &           DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,DPCHT,DPDHT,DPSYN,&
     &           SAVE,DMPCSE,DPDVT,DPGR,DPLB,DPPW,DPSTB,DPSBD,DPSLG,    &
     &           DPSWB,DPSTP,DPDWA,DPSTG,DPSLA,DPTRA,DPEXPD
      LOGICAL    IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPFLC,DPFACT,     &
     &           DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,DPCHT,DPDHT,DPSYN,&
     &           SAVE,DMPCSE,DPDVT,DPGR,DPLB,DPPW,DPSTB,DPSBD,DPSLG,    &
     &           DPSWB,DPSTP,DPDWA,DPSTG,DPSLA,DPTRA,DPEXPD
      NOVLY=11
      DO 1000 J=1,303
 1000 GR(J)=UNUSED
      CALL GRDEFF(FLC(IG+63),NF)
      IF(DPGR.OR.DMPCSE)CALL DMPARY(GR,303,2HGR,2)
      RETURN
      END
      SUBROUTINE M12O14
!
!***  EXEC FOR OVERLAY 12, PRINT OUTPUTS
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
      COMMON /LEVEL2/ SECOND(23)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB,PLOT
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB,PLOT
!
      EQUIVALENCE (DOL2,SECOND(16))
      LOGICAL DOL2
      NOVLY=12
      CALL OUTPUT
      IF(PART .OR. DOL2) CALL AUXOUT
      IF(PLOT) CALL WPLOT
      RETURN
      END
      SUBROUTINE M13O15
!
!***  EXEC FOR OVERLAY 13, PROPELLER POWER EFFECTS
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /IPOWER/ PP, POWER(200)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      DIMENSION CR(6), DR(6), ROUTID(2)
      DATA ROUTID / 4HM10O, 4H12   /
      NOVLY=13
      CALL PRPWEF(I)
!
!     CALCULATE CN, CA, CLA, AND CMA INCREMENTS
!
      IN = 0
      IM = 0
      DO 1000 J=1,NALPHA
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         POWER(J+60) = POWER(J+20)*CA + POWER(J)*SA
         POWER(J+80) = POWER(J)*CA - POWER(J+20)*SA
         CALL TBFUNX(FLC(J+22),X,POWER(J+100),NALPHA,FLC(23),POWER(21), &
     &               CR,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),X,POWER(J+120),NALPHA,FLC(23),POWER(41), &
     &               DR,IM,MI,NG,0,0,4HCMA ,1,ROUTID)
 1000 END DO
      RETURN
      END
      SUBROUTINE M14O16
!
!***  EXEC FOR OVERLAY 14, LOW ASPECT RATIO AERO
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /CONSNT/ CONST(5)
      COMMON /IBW/    PBW,BW(380)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      DIMENSION CR(6), DR(6), ROUTID(2)
      EQUIVALENCE     (CONST(4),RAD)
      DATA ROUTID / 4HM14O, 4H16   /
      NOVLY=14
      CALL LOARWB
!
!     CALCULATE CN, CA, CLA, AND CMA INCREMENTS
!
      IN = 0
      IM = 0
      DO 1000 J=1,NALPHA
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         BW(J+60) = BW(J+20)*CA + BW(J)*SA
         BW(J+80) = BW(J)*CA - BW(J+20)*SA
         CALL TBFUNX(FLC(J+22),X,BW(J+100),NALPHA,FLC(23),BW(21),       &
     &               CR,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),X,BW(J+120),NALPHA,FLC(23),BW(41),       &
     &               DR,IM,MI,NG,0,0,4HCMA ,1,ROUTID)
 1000 END DO
      RETURN
      END
      SUBROUTINE M15O17
!
!***  EXEC FOR OVERLAY 15, SUBSONIC WING LIFT
!
      COMMON /OVERLY/ IJKDUM(8),NOVLY
      COMMON /WINGD/  A(195),B(49)
      COMMON /IWING/  PWING,WING(400)
      COMMON /WINGI/  WINGIN(77)
      NOVLY=15
      CALL CALCA0(A,B,WINGIN)
      CALL WTLIFT(A,B,WINGIN,WING)
      CALL LIFTCF(A,B,WINGIN,WING)
      RETURN
      END
      SUBROUTINE M16O20
!
!***  EXEC FOR OVERLAY 16, SUBSONIC HORIZONTAL TAIL LIFT
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /WINGI/  WINGIN(77)
      COMMON /IDWASH/ PDWASH,DWASH(60)
      COMMON /HTDATA/ AHT(195),BHT(49)
      COMMON /IHT/    PHT,HT(380)
      COMMON /HTI/    HTIN(131)
      COMMON /WINGD/  A(195),B(49)
      NOVLY=16
      CALL CALCA0(AHT,BHT,HTIN)
      CALL WTLIFT(AHT,BHT,HTIN,HT)
      CALL LIFTCF(AHT,BHT,HTIN,HT)
      RETURN
      END
      SUBROUTINE M17O21
!
!***  EXEC FOR OVERLAY 17, SUBSONIC LATERAL STABILITY
!
      COMMON /IBODY/   PBODY,  BODY(400)
      COMMON /IWING/   PWING,  WING(400)
      COMMON /IHT/     PHT,    HT(380)
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
      COMMON /IBWH/    PBWH,   BWH(380)
      COMMON /IBWV/    PBWV,   BWV(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
!
      COMMON /WINGI/  WINGIN(101)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /HTI/    HTIN(154)
      COMMON /WINGD/  A(195), B(49)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K,NOVLY
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL  FLAG, TEST
!
      NOVLY=17
      FLAG = .FALSE.
      TEST = WGPL .OR. VTPL .OR. TVTPAN
      IF(TEST) CALL SUBLAT(STB,WING,WINGIN,BW,A,B,AHT,                  &
     &                     AVT,VT,VTIN,VTPL,TVTPAN,HTPL,WGPL,0)
      TEST = HTPL .OR. VFPL
      IF(TEST) CALL SUBLAT(STBH,HT,HTIN,BH,AHT,BHT,AHT,                 &
     &                     AVF,VF,VFIN,VFPL,FLAG,FLAG,HTPL,1)
!
!     SET IOM VALUES FOR CYB, CNB, AND CLB
!
      DO 1050 J=1,NALPHA
!
!     VT DATA
!
         IF(J .EQ. 1) GO TO 1000
         VT(J+140) = -UNUSED
         VT(J+160) = -UNUSED
         VF(J+140) = -UNUSED
         VF(J+160) = -UNUSED
!
!     B-W  DATA
!
         BW(J+140) = -UNUSED
         BW(J+160) = -UNUSED
!
!     B-H  DATA
!
         BH(J+140) = -UNUSED
         BH(J+160) = -UNUSED
 1000    CONTINUE
!
!     B-V  DATA
!
         BV(J+140) = -UNUSED
         BV(J+160) = -UNUSED
         IF(J .GT. 1) GO TO 1010
         BV(J+140) = BODY(J+140) + VT(J+140) + VF(J+140)
         BV(J+160) = BODY(J+160) + VT(J+160) + VF(J+160)
 1010    CONTINUE
         BV(J+180) = BODY(J+180) + VT(J+180) + VF(J+180)
!
!     B-W-H  DATA
!
         BWH(J+140) = -UNUSED
         BWH(J+160) = -UNUSED
         IF(J .GT. 1) GO TO 1020
         BWH(J+140) = BW(J+140) + HT(J+140)
         BWH(J+160) = BW(J+160) + HT(J+160)
 1020    BWH(J+180) = BW(J+180) + HT(J+180)
!
!     B-W-V  DATA
!
         BWV(J+140) = -UNUSED
         BWV(J+160) = -UNUSED
         IF(J .GT. 1) GO TO 1030
         BWV(J+140) = BW(J+140) + VT(J+140) + VF(J+140)
         BWV(J+160) = BW(J+160) + VT(J+160) + VF(J+160)
 1030    CONTINUE
         BWV(J+180) = BW(J+180) + VT(J+180) + VF(J+180)
!
!     B-W-H-V  DATA
!
         BWHV(J+140) = -UNUSED
         BWHV(J+160) = -UNUSED
         IF(J .GT. 1) GO TO 1040
         BWHV(J+140) = BWH(J+140) + VT(J+140) + VF(J+140)
         BWHV(J+160) = BWH(J+160) + VT(J+160) + VF(J+160)
 1040    CONTINUE
         BWHV(J+180) = BWH(J+180) + VT(J+180) + VF(J+180)
 1050 END DO
      IF(.NOT. TRANSN) GO TO 1070
      VT(141) = UNUSED
      VT(161) = UNUSED
      VF(141) = UNUSED
      VF(161) = UNUSED
      BV(141) = UNUSED
      BV(161) = UNUSED
      BWH(141) = UNUSED
      BWH(161) = UNUSED
      BWHV(141) = UNUSED
      BWHV(161) = UNUSED
      WING(141) = UNUSED
      WING(161) = UNUSED
      HT(141) = UNUSED
      HT(161) = UNUSED
      DO 1060 J=1,NALPHA
         BV(J+180) = UNUSED
         BWH(J+180) = UNUSED
         BWV(J+180) = UNUSED
         BWHV(J+180) = UNUSED
 1060 END DO
 1070 CONTINUE
      RETURN
      END
      SUBROUTINE M18O22
!
!***  EXEC FOR OVERLAY 18, SUPERSONIC WING DRAG
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZVT, ZVF, YV, YF,      &
     &                PHIV, PHIF
      COMMON /WINGI/  WINGIN(101)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /HTI/    HTIN(154)
      COMMON /WINGD/  A(195), B(49)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      DIMENSION INDX(12)
      DATA INDX/1,2,3,4,5,6,7,119,120,163,167,168/
!
      NOVLY=18
      CALL SETUP1
!
!     ----SET SURFACE GEOMETRY IF PRESENR
!
      IF(WGPL) CALL WTGEOM(A,WINGIN)
      IF(HTPL) CALL WTGEOM(AHT,HTIN)
      IF(VTPL) CALL WTGEOM(AVT,VTIN)
      DO 1000 I=1,12
         II=INDX(I)
         IF(AVT(II).NE.UNUSED)AVT(II)=AVT(II)/2.
 1000 END DO
      IF(VFPL) CALL WTGEOM(AVF,VFIN)
      DO 1010 I=1,12
         II=INDX(I)
         IF(AVF(II).NE.UNUSED)AVF(II)=AVF(II)/2.
 1010 END DO
      AVT(130) = AVT(130)+ZVT
      AVT(133) = AVT(133)+ZVT
      AVT(136) = AVT(136)+ZVT
      AVF(130) = AVF(130)+ZVF
      AVF(133) = AVF(133)+ZVF
      AVF(136) = AVF(136)+ZVF
!
!     ----SET /OPTION/ PARAMETERS IF NOT INPUT
!
      IF(SREF.EQ.UNUSED) SREF=A(4)
      IF(CBARR.EQ.UNUSED) CBARR=A(122)
      IF(ROUGFC.LT.1.0E-10)ROUGFC=1.6E-4
!
      IF(TRANSN)RETURN
      IF(WGPL) CALL SUPDRG
      RETURN
      END
      SUBROUTINE M19O23
!
!***  EXEC FOR OVERLAY 19, SUPERSONIC BODY AERO
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /IBODY/  PBODY,BODY(400)
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /FLGTCD/ FLC(93),STMACH,TSMACH,TR, dumflgtcd(64)
      COMMON /WINGD/  A(195)
      COMMON /WINGI/  WINGIN(100)
      COMMON /SUPBOD/ SBD(229)
      COMMON /BODYI/  XNX,X(20),S(20),P(20),R(20),                      &
     &                ZU(20),ZL(20),BNOSE,BTAIL,RLN,RLA,DS,dum2(3)
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIHXV,VERTUP,HINAX,     &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /HTI/    HTIN(154)
      COMMON /HTDATA/ AHT(195)
      COMMON /BDATA/  BD(275),BOD(120)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
!
      LOGICAL       FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
      DIMENSION CR(6), DR(6), ROUTID(2)
      DIMENSION XS(20),SS(20),PS(20),RS(20),XI(3)
      DATA ROUTID / 4HM19O, 4H23   /
!
      NOVLY=19
      IF(SREF   .EQ. UNUSED) SREF   = A(4)
      IF(CBARR  .EQ. UNUSED) CBARR  = A(122)
      IF(ROUGFC .EQ. UNUSED) ROUGFC = 1.6E-4
      IF(BLREF  .EQ. UNUSED) BLREF  = 2.0*WINGIN(4)
      CALL SYPBOD(I)
      CALL EXSUBT
!
!
      IF(FLC(I+2) .LT. TSMACH) RETURN
!
!      CALCULATE CLA, CMA,CYB, CNB, AND CLB
!
      BFACT = CBARR/BLREF
      IN = 0
      IM = 0
      DO 1000 J=1,NALPHA
         CALL TBFUNX(FLC(J+22),XX,BODY(J+100),NALPHA,FLC(23),BODY(21),  &
     &               CR,IN,MI,NG,0,0,4HCLAB,1,ROUTID)
         CALL TBFUNX(FLC(J+22),XX,BODY(J+120),NALPHA,FLC(23),BODY(41),  &
     &               DR,IM,MI,NG,0,0,4HCMAB,1,ROUTID)
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         BODY(J+60) = BODY(J+20)*CA + BODY(J)*SA
         BODY(J+80) = BODY(J)*CA - BODY(J+20)*SA
         BODY(J+140) = -BODY(J+100)
         BODY(J+160) = -BFACT*BODY(J+120)
         BODY(J+180) = 0.0
 1000 END DO
      RETURN
      END
      SUBROUTINE M20O24
!
!***  EXEC FOR OVERLAY 20, SUPERSONIC WING-BODY AERO
!
      COMMON /IBODY/   PBODY,  BODY(400)
      COMMON /IWING/   PWING,  WING(400)
      COMMON /IHT/     PHT,    HT(380)
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
      COMMON /IBWV/    PBWV,   BWV(380)
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /WBHCAL/ STP(156)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,L,NOVLY
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
!
      DIMENSION CR(6), DR(6), ROUTID(2)
      DATA ROUTID / 4HM20O, 4H24   /
!
      NOVLY=20
      IF(WGPL .AND. BO)CALL SUPWB
      IF(HTPL .AND. BO) CALL SUPHB
      DO 1000 J=1,NALPHA
 1000 BWV(J) = BW(J)
      IF(VTPL) CALL VRTCDO(I)
      IF(VFPL) CALL VFCDO(I)
      CALL SUPCM0
!
!     VT DATA
!
      IF(VT(1) .EQ. UNUSED) VT(1) = STP(1)
      VT(21) = 0.0
      VT(41) = 0.0
      VT(61) = 0.0
      VT(81) = VT(1)
      VT(101) = 0.0
      VT(121) = 0.0
      IF(VF(1) .EQ. UNUSED) VF(1) = STP(156)
      VF(21) = 0.0
      VF(41) = 0.0
      VF(61) = 0.0
      VF(81) = VF(1)
      VF(101) = 0.0
      VF(121) = 0.0
      DO 1010 J=1,NALPHA
         IF(J .EQ. 1) GO TO 1010
         VT(J) = -UNUSED
         VT(J+20) = -UNUSED
         VT(J+40) = -UNUSED
         VT(J+60) = -UNUSED
         VT(J+80) = -UNUSED
         VT(J+100) = -UNUSED
         VT(J+120) = -UNUSED
         VF(J) = -UNUSED
         VF(J+20) = -UNUSED
         VF(J+40) = -UNUSED
         VF(J+60) = -UNUSED
         VF(J+80) = -UNUSED
         VF(J+100) = -UNUSED
         VF(J+120) = -UNUSED
 1010 END DO
      IF( .NOT. BO) GO TO 1060
      IF(.NOT. WGPL) GO TO 1040
!
!     B-W  DATA
!
      IN = 0
      DO 1020 J=1,NALPHA
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         BW(J+60) = BW(J+20)*CA + BW(J)*SA
         BW(J+80) = BW(J)*CA - BW(J+20)*SA
         IF(J .EQ. 1) GO TO 1020
        CALL TBFUNX(FLC(J+22),X,BW(J+100),NALPHA,FLC(23),BW(21),        &
     &               CR,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         BW(J+120) = -UNUSED
 1020 END DO
!
!     B-W-V  DATA
!
      IN = 0
      DO 1030 J=1,NALPHA
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         BWV(J+20) = BW(J+20)
         BWV(J+40) = BW(J+40)
         BWV(J+60) = BWV(J+20)*CA + BWV(J)*SA
         BWV(J+80) = BWV(J)*CA - BWV(J+20)*SA
         BWV(J+100)= BW(J+100)
         BWV(J+120)= BW(J+120)
 1030 END DO
 1040 IF(.NOT. HTPL) GO TO 1060
!
!     B-H  DATA
!
      IN = 0
      DO 1050 J=1,NALPHA
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         BH(J+60) = BH(J+20)*CA + BH(J)*SA
         BH(J+80) = BH(J)*CA - BH(J+20)*SA
         IF(J .EQ. 1) GO TO 1050
         CALL TBFUNX(FLC(J+22),X,BH(J+100),NALPHA,FLC(23),BH(21),       &
     &               CR,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         BH(J+120) = -UNUSED
 1050 END DO
 1060 IF(.NOT. (BO .AND. VTPL)) GO TO 1080
!
!     B-V DATA
!
      DO 1070 J=1,NALPHA
         DO 1070 K=1,7
            KK=(K-1)*20
            IF(K .EQ. 1) BV(J+KK)=BODY(J+KK)+VT(1) + VF(1)
            IF(K .NE. 1) BV(J+KK)=BODY(J+KK)
 1070 CONTINUE
 1080 CONTINUE
      RETURN
      END
      SUBROUTINE M21O25
!
!***  EXEC FOR OVERLAY 21, SUPERSONIC WING FLOW FIELDS
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,          &
     &                KBODY, KWING, KHT, KVT, KWB, KDWASH(3),           &
     &                ALPOW, ALPLW, ALPOH, ALPLH
      EQUIVALENCE (KDWASH(2),KEPSLN)
      LOGICAL KEPSLN
      KEY = 0
      IF(KEPSLN) KEY = 1
      NOVLY=21
      IF(KEPSLN) CALL EXSUBT
      CALL SDWASH(I,KEY)
      CALL EXSUBT
      RETURN
      END
      SUBROUTINE M22O26
!
!***  EXEC FOR OVERLAY 22, SUPERSONIC HORIZONTAL-TAIL AERO
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /IHT/    PHT, HT(380)
      COMMON /CONSNT/ CONST(5)
      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,          &
     &                KBODY, KWING, KHT, KVT, KWB, KDWASH(3),           &
     &                ALPOW, ALPLW, ALPOH, ALPLH
      EQUIVALENCE (CONST(3),UNUSED)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      DIMENSION CR(6), ROUTID(2)
      EQUIVALENCE (KDWASH(2), KEPSLN)
      LOGICAL KEPSLN
      DATA ROUTID / 4HM22O, 4H26   /
      KEY = 0
      IF(KEPSLN) KEY = 1
      NOVLY=22
      CALL SUPLTG(KEY)
!
!     CALCULATE CLA AND CMA
!
      IN = 0
      DO 1000 J=2,NALPHA
         CALL TBFUNX(FLC(J+22),X,HT(J+100),NALPHA,FLC(23),HT(21),       &
     &               CR,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         HT(J+120) = -UNUSED
 1000 END DO
      RETURN
      END
      SUBROUTINE M23O27
!
!***  EXEC FOR OVERLAY 23, SUPERSONIC LATERAL STABILITY
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /IWING/  PW, WING(400)
      COMMON /IHT/    PHT, HT(380)
      COMMON /IVT/    PVT, VT(380)
      COMMON /IVF/    PVF, VF(380)
      COMMON /IBODY/  PBODY, BODY(400)
      COMMON /IBH/    PBH, BH(380)
      COMMON /IBV/    PBV, BV(380)
      COMMON /IBW/    PBW, BW(380)
      COMMON /IBWH/   PBWH, BWH(380)
      COMMON /IBWV/   PBWV, BWV(380)
      COMMON /IBWHV/  PBWHV, BWHV(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
!
      NOVLY=23
      NALPHA=FLC(2)+0.5
      IF(WGPL) CALL SUPLAT
      IF(HTPL) CALL SUPLAH
      IF(VTPL) CALL SUPLAV
      IF(VFPL) CALL SUPLAF
!
!  CALCULATE V.T. INCREMENTS FOR LATERAL DERIVATIVES
!
      DO 1000 J=2,NALPHA
         WING(J+140) = -UNUSED
         WING(J+160) = -UNUSED
         HT(J+140) = -UNUSED
         HT(J+160) = -UNUSED
         VT(J+140) = -UNUSED
         VT(J+160) = -UNUSED
         VF(J+140) = -UNUSED
         VF(J+160) = -UNUSED
 1000 END DO
!
!  SET IOM FOR CYB, CNB AND CLB
!
      DO 1010 J=2,NALPHA
         BW(J+140) =  -UNUSED
         BW(J+160) = -UNUSED
         BWH(J+140) = -UNUSED
         BWH(J+160) = -UNUSED
         BWV(J+140) = -UNUSED
         BWV(J+160) = -UNUSED
         BWHV(J+140) = -UNUSED
         BWHV(J+160) = -UNUSED
 1010 END DO
      BV(141) = BODY(141) + VT(141) + VF(141)
      BV(161) = BODY(161) + VT(161) + VF(161)
      BV(181) = BODY(181) + VT(181) + VF(181)
      DO 1020 J=2,NALPHA
         BV(J+140) = -UNUSED
         BV(J+160) = -UNUSED
         BV(J+180) = BODY(J+180) + VT(J+180) + VF(J+180)
         BH(J+140) = -UNUSED
         BH(J+160) = -UNUSED
 1020 END DO
      RETURN
      END
      SUBROUTINE M24O30
!
!***  EXEC FOR OVERLAY 24, TRANSONIC WING AERO AND BODY STABILITY DATA
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /CONSNT/ CONST(5)
      COMMON /IBODY/  PB, BODY(380), dum1(20)
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
      LOGICAL       FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
      EQUIVALENCE (CONST(3),UNUSED)
!
      NOVLY=24
!
      IF(WGPL) CALL TRANWB
      IF(HTPL) CALL TRANHB
      CALL EXSUBT
!
!     SET BODY IOM
!
      BODY(141) = -BODY(101)
      BODY(161) = -BODY(121)*CBARR/BLREF
      DO 1010 J=1,NALPHA
         BODY(J+60) = UNUSED
         BODY(J+80) = UNUSED
         IF(J .EQ. 1) GO TO 1000
         BODY(J+20)  = -UNUSED
         BODY(J+40)  = -UNUSED
         BODY(J+60)  = -UNUSED
         BODY(J+80)  = -UNUSED
         BODY(J+100) = -UNUSED
         BODY(J+120) = -UNUSED
         BODY(J+140) = -UNUSED
         BODY(J+160) = -UNUSED
 1000    BODY(J+180) = 0.0
 1010 END DO
      CALL TRANCD
      RETURN
      END
      SUBROUTINE M25O31
!
!***  EXEC FOR OVERLAY 25, TRANSONIC WING, WING-BODY CMA
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
      LOGICAL         FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
      NOVLY=25
      IF(WGPL) CALL TRANCM
      IF(HTPL) CALL TRHTCM
      IF(BO)   CALL TRACM0
      RETURN
      END
      SUBROUTINE M26O32
!
!***  EXEC FOR OVERLAY 26, HYPERSONIC BODY AERO
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /IBODY/  PB, BODY(400)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      DIMENSION C1(6),C2(6),ROUTID(2)
      DATA ROUTID/ 4HM26O, 4H32  /
      NOVLY=26
      CALL HYPBOD(I)
      BFACT = CBARR/BLREF
      IN = 0
      IM = 0
      DO 1000 J=1,NALPHA
         CALL TBFUNX(FLC(J+22),X,BODY(J+100),NALPHA,FLC(23),BODY(21),   &
     &               C1,IN,MI,NG,0,0,4HCLAB,1,ROUTID)
         CALL TBFUNX(FLC(J+22),X,BODY(J+120),NALPHA,FLC(23),BODY(41),   &
     &               C2,IM,MI,NG,0,0,4HCMAB,1,ROUTID)
         BODY(J+140) = -BODY(J+100)
         BODY(J+160) = -BFACT*BODY(J+120)
         BODY(J+180) = 0.0
 1000 END DO
      RETURN
      END
      SUBROUTINE M27O33
!
!***  EXEC FOR OVERLAY 27, SUPERSONIC WING STABILITY
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /CONSNT/ CONST(5)
      COMMON /IWING/  PWING,WING(400)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /WINGI/  WGIN(100)
      EQUIVALENCE (CONST(3),UNUSED)
      LOGICAL FLAG
      DIMENSION CR(6),ROUTID(2)
      DATA ROUTID/ 4HM27O, 4H33  /
      DATA A4HSTR/4HSTRA/
      NOVLY=27
      CALL SUPLNG
!
!   GET WING CLA AND CMA FOR ANGLES-OF-ATTACK OTHER THAN THE FIRST
!
      FLAG = (WGIN(15) .EQ. A4HSTR)
      IN=0
      INN=0
      DO 1000 J=2,NALPHA
         CALL TBFUNX(FLC(J+22),X,WING(J+100),NALPHA,FLC(23),WING(21),   &
     &                CR,IN,MI,NG,0,0,4HCLAW,1,ROUTID)
         IF(J .EQ. 1) GO TO 1000
         WING(J+120) = -UNUSED
         IF(FLAG) GO TO 1000
         WING(J)    = -UNUSED
         WING(J+20) = -UNUSED
         WING(J+40) = -UNUSED
         WING(J+60) = -UNUSED
         WING(J+80) = -UNUSED
         WING(J+100)= -UNUSED
         WING(J+180)= -UNUSED
 1000 END DO
      IF(.NOT. FLAG)WING(81)=WING(1)
      RETURN
      END
      SUBROUTINE M28O34
!
!***  EXEC FOR OVERLAY 28, SUPERSONIC WING-BODY-TAIL AERO
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /IBWH/   PBWH, BWH(380)
      COMMON /IBWHV/  PBWHV, BWHV(380)
      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,          &
     &                KBODY, KWING, KHT, KVT, KWB, KDWASH(3),           &
     &                ALPOW, ALPLW, ALPOH, ALPLH
      DIMENSION KEY(3)
      LOGICAL KDWASH
      EQUIVALENCE (KEY(1),KQOQIN), (KEY(2),KEPSLN), (KEY(3),KDEODA)
      NOVLY=28
      CALL EXSUBT
      DO 1000 J=1,3
         KEY(J) = 0
         IF(KDWASH(J)) KEY(J) = 1
 1000 END DO
      CALL SUPWBT(KDEODA,KQOQIN,KEPSLN)
      DO 1010 J=1,NALPHA
         BWHV(J+ 20) = BWH(J+ 20)
         BWHV(J+100) = BWH(J+100)
         BWHV(J+120) = BWH(J+120)
 1010 END DO
      RETURN
      END
      SUBROUTINE M29O35
!
!***  EXEC FOR OVERLAY 29, LATERAL STABILITY GEOMETRY DATA
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
      LOGICAL VERTUP
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /WINGD/  A(195),B(49)
      COMMON /SBETA/  STB(135),TRA(108),TRAH(108),STBH(135)
      COMMON /BDATA/  BD(762)
      COMMON /HTDATA/ AHT(195),BHT(48)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /WINGI/  WINGIN(77)
      COMMON /HTI/    HTIN(154)
      COMMON /BODYI/  BODYIN(129)
      DIMENSION ROUTID(2),BODYDP(20)
      DIMENSION WTYPE(4),C1(6),C2(6)
      EQUIVALENCE (SYNA(10),VERTUP)
      DATA ROUTID/4HM29O,4H35  /
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA I1,I2/2*0/
      NOVLY=29
!
!---------       LATERAL STABILITY GEOMETRY CALCULATIONS         -------
!
      STB(2)= (WINGIN(4)-WINGIN(12))/WINGIN(4)
      STB(3)=1.0
      IF(WGPL.AND.(.NOT.BO)) GO TO 1050
      IF(.NOT.WGPL)GO TO 1060
      SINSYN=SIN(SYNA(4)/RAD)
      STB(1)=-SYNA(3)+(.25*A(10)+BD(66))*SINSYN-(WINGIN(4)-WINGIN(3))   &
     &       *TAN(WINGIN(13)/RAD)
      STB(4)=-SYNA(3)+WINGIN(6)/4.0*SINSYN
      STB(72)=(WINGIN(4)-WINGIN(3))*2.0
      STB(63)=SYNA(2)+BD(66)+WINGIN(2)*A(86)+A(23)*A(62)+WINGIN(1)/2.
      NV=BODYIN(1)+.5
      IF(BODYIN(82).EQ.UNUSED) GO TO 1010
      CALL TRAPZ(BODYIN(82),NV,BODYIN(2),VARU,1)
      CALL TRAPZ(BODYIN(102),NV,BODYIN(2),VARL,1)
      STB(62)=VARU-VARL
      QL=BD(1)*.25
      TFL=BD(1)*.75
      DO 1000 I=1,NV
 1000 BODYDP(I)=BODYIN(I+81)-BODYIN(I+101)
      CALL TBFUNX(QL,STB(61),DYDX,NV,BODYIN(2),BODYDP(1),C1,I1,MI,NG,   &
     &            0,0,4HQL  ,1,ROUTID)
      CALL TBFUNX(TFL,STB(60),DYDX,NV,BODYIN(2),BODYDP(1),C2,I2,MI,NG,  &
     &            0,0,4HTFL ,1,ROUTID)
      CALL GETMAX(BODYIN(2),BODYDP(1),NV,XMAX,STB(59),IMAX)
      GO TO 1020
 1010 CONTINUE
      CALL TRAPZ(BODYIN(62),NV,BODYIN(2),VAR,1)
      STB(62)=2.0*VAR
      QL=BD(1)*.25
      TFL=BD(1)*.75
      CALL TBFUNX(QL,VAR,DYDX,NV,BODYIN(2),BODYIN(62),C1,I1,MI,NG,      &
     &            0,0,4HQL  ,1,ROUTID)
      STB(61)=2.*VAR
      CALL TBFUNX(TFL,VAR,DYDX,NV,BODYIN(2),BODYIN(62),C2,I2,MI,NG,     &
     &            0,0,4HTFL ,1,ROUTID)
      STB(60)=2.*VAR
      CALL GETMAX(BODYIN(2),BODYIN(62),NV,XMAX,RMAX,IMAX)
      STB(59)=2.*RMAX
 1020 CONTINUE
      CALL GETMAX(BODYIN(2),BODYIN(62),NV,XMAX,RMAX,IMAX)
      STB(123)=2.*RMAX
      IF(.NOT.VTPL)GO TO 1050
      STB(11)=(SYNA(9)-SYNA(1))+AVT(195)+AVT(122)/4.0
      STB(12)=-SYNA(5)+AVT(136)
      IF(.NOT.VERTUP)STB(12)=-SYNA(5)-AVT(136)
      IF(.NOT.HTPL.OR.SYNA(7).LT.0.0) GO TO 1050
      XPART=SYNA(6)+AHT(161)-SYNA(9)
      IF(VTIN(15).NE.WTYPE(1)) GO TO 1030
      STB(9)=XPART-SYNA(7)*AVT(62)
      STB(10)=VTIN(6)-(VTIN(6)-VTIN(1))*SYNA(7)/VTIN(4)
      GO TO 1050
 1030 IF(SYNA(7).GT.(VTIN(4)-VTIN(2))) GO TO 1040
      STB(9)=XPART-SYNA(7)*AVT(62)
      STB(10)=VTIN(6)-(VTIN(6)-VTIN(5))*SYNA(7)/(VTIN(4)-VTIN(2))
      GO TO 1050
 1040 STB(9)=XPART-(VTIN(4)-VTIN(2))*AVT(62)-(SYNA(7)+VTIN(2)           &
     &       -VTIN(4))*AVT(86)
      STB(10)=VTIN(1)+(VTIN(5)-VTIN(1))*(VTIN(4)-SYNA(7))/VTIN(2)
 1050 CONTINUE
!
!     CALCULATION OF EFFECTIVE DIHEDRAL ANGLE
!
      IF(WINGIN(13).EQ.UNUSED)WINGIN(13)=0.0
      IF(WINGIN(12).EQ.UNUSED)WINGIN(12)=0.0
      IF(WINGIN(14).EQ.UNUSED)WINGIN(14)=WINGIN(13)
      STB(122)=(WINGIN(13)*(WINGIN(3)-WINGIN(12))+WINGIN(14)*WINGIN(12))&
     &         /WINGIN(3)
!
      IF(WGPL.AND.(.NOT.BO).AND.(.NOT.HTPL))RETURN
 1060 IF(.NOT.HTPL) RETURN
      STBH(2)= (HTIN(4)-HTIN(12))/HTIN(4)
      STBH(3)=1.0
      IF(HTPL.AND.(.NOT.BO)) GO TO 1120
      SINSYN=SIN(SYNA(8)/RAD)
      STBH(1)=-SYNA(7)+(.25*A(10)+BD(66))*SINSYN-(HTIN(4)-HTIN(3))      &
     &        *TAN(HTIN(13)/RAD)
      STBH(4)=-SYNA(7)+HTIN(6)/4.0*SINSYN
      STBH(72)=(HTIN(4)-HTIN(3))*2.0
      STBH(63)=SYNA(6)+BD(66)+HTIN(2)*AHT(86)+AHT(23)*AHT(62)+HTIN(1)/2.
      NV=BODYIN(1)+.5
      IF(BODYIN(82).EQ.UNUSED) GO TO 1080
      CALL TRAPZ(BODYIN(82),NV,BODYIN(2),VARU,1)
      CALL TRAPZ(BODYIN(102),NV,BODYIN(2),VARL,1)
      STBH(62)=VARU-VARL
      QL=BD(1)*.25
      TFL=BD(1)*.75
      DO 1070 I=1,NV
 1070 BODYDP(I)=BODYIN(I+81)-BODYIN(I+101)
      CALL TBFUNX(QL,STBH(61),DYDX,NV,BODYIN(2),BODYDP(1),C1,I1,MI,NG,  &
     &            0,0,4HQL  ,1,ROUTID)
      CALL TBFUNX(TFL,STBH(60),DYDX,NV,BODYIN(2),BODYDP(1),C2,I2,MI,NG, &
     &            0,0,4HTFL ,1,ROUTID)
      CALL GETMAX(BODYIN(2),BODYDP(1),NV,XMAX,STBH(59),IMAX)
      GO TO 1090
 1080 CONTINUE
      CALL TRAPZ(BODYIN(62),NV,BODYIN(2),VAR,1)
      STBH(62)=2.0*VAR
      QL=BD(1)*.25
      TFL=BD(1)*.75
      CALL TBFUNX(QL,VAR,DYDX,NV,BODYIN(2),BODYIN(62),C1,I1,MI,NG,      &
     &            0,0,4HQL  ,1,ROUTID)
      STBH(61)=2.*VAR
      CALL TBFUNX(TFL,VAR,DYDX,NV,BODYIN(2),BODYIN(62),C2,I2,MI,NG,     &
     &            0,0,4HTFL ,1,ROUTID)
      STBH(60)=2.*VAR
      CALL GETMAX(BODYIN(2),BODYIN(62),NV,XMAX,RMAX,IMAX)
      STBH(59)=2.*RMAX
 1090 CONTINUE
      CALL GETMAX(BODYIN(2),BODYIN(62),NV,XMAX,RMAX,IMAX)
      STBH(123)=2.*RMAX
      IF(.NOT.VFPL)GO TO 1120
      STBH(11)=(SYNA(12)-SYNA(1))+AVF(195)+AVF(122)/4.0
      STBH(12)=-SYNA(5)+AVF(136)
      IF(VERTUP)STBH(12)=-SYNA(5)-AVF(136)
      IF(.NOT.HTPL.OR.SYNA(7).LT.0.0) GO TO 1120
      XPART=SYNA(6)+AHT(161)-SYNA(12)
      IF(VFIN(15).NE.WTYPE(1)) GO TO 1100
      STBH(9)=XPART-SYNA(7)*AVF(62)
      STBH(10)=VFIN(6)-(VFIN(6)-VFIN(1))*SYNA(7)/VFIN(4)
      GO TO 1120
 1100 IF(SYNA(7).GT.(VFIN(4)-VFIN(2))) GO TO 1110
      STBH(9)=XPART-SYNA(7)*AVF(62)
      STBH(10)=VFIN(6)-(VFIN(6)-VFIN(5))*SYNA(7)/(VFIN(4)-VFIN(2))
      GO TO 1120
 1110 STBH(9)=XPART-(VFIN(4)-VFIN(2))*AVF(62)-(SYNA(7)+VFIN(2)          &
     &        -VFIN(4))*AVF(86)
      STBH(10)=VFIN(1)+(VFIN(5)-VFIN(1))*(VFIN(4)-SYNA(7))/VFIN(2)
 1120 CONTINUE
!
!     CALCULATION OF EFFECTIVE DIHEDRAL ANGLE
!
      IF(HTIN(13).EQ.UNUSED)HTIN(13)=0.0
      IF(HTIN(12).EQ.UNUSED)HTIN(12)=0.0
      IF(HTIN(14).EQ.UNUSED)HTIN(14)=HTIN(13)
      STBH(122)=(HTIN(13)*(HTIN(3)-HTIN(12))+HTIN(14)*HTIN(12))         &
     &          /HTIN(3)
      STBH(123) = STB(123)
      RETURN
      END
      SUBROUTINE M30O36
!
!***  EXEC FOR OVERLAY 30, JET POWER EFFECTS
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /POWR/   PW(315)
      COMMON /IPOWER/ PP, POWER(200)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /CONSNT/ CONST(5)
      EQUIVALENCE(CONST(4),RAD)
      DIMENSION CR(6),CRR(6),ROUTID(2)
      DATA ROUTID/ 4HM30O, 4H36  /
      NOVLY=30
      CALL JETPWE
!
!  SET IOM FOR CLA AND CMA AND BODY AXES CN AND CA
!
      IN = 0
      IM = 0
      DO 1000 J=1,NALPHA
         SA = SIN(FLC(J+22)/RAD)
         CA = COS(FLC(J+22)/RAD)
         POWER(J+60) = POWER(J+20)*CA + POWER(J)*SA
         POWER(J+80) = POWER(J)*CA - POWER(J+20)*SA
         CALL TBFUNX(FLC(J+22),X,POWER(J+100),NALPHA,FLC(23),POWER(21), &
     &               CR,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),X,POWER(J+120),NALPHA,FLC(23),POWER(41), &
     &               CRR,IM,MI,NG,0,0,4HCMA ,1,ROUTID)
 1000 END DO
      RETURN
      END
      SUBROUTINE M31O37
!
!***  EXEC FOR OVERLAY 31, SUBSONIC WING CM, BODY CA,CN
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /IWING/  PWING, WING(400)
      COMMON /WINGI/  WINGIN(100)
      COMMON /WINGD/  A(195),B(49)
      COMMON /WHAERO/ C(51)
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /EXPER/  KK(105),KWING
      DIMENSION C1(6),C3(6),ROUTID(2)
      LOGICAL FLAG,KWING
      DATA ROUTID/ 4HM31O, 4H37  /
      DATA STRA/ 4HSTRA /
      NOVLY=31
      CALL CMALPH(A,B,C,WINGIN,WING)
      CALL CACALC(B,WING)
!
!     SET IOM CN, CA, CLA, AND CMA
!
      CALL EXSUBT
      IN = 0
      IM = 0
      CLA=WING(101)
      CMA=WING(121)
      DO 1000 J=1,NALPHA
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         WING(J+60) = WING(J+20)*CA + WING(J)*SA
         WING(J+80) = WING(J)*CA - WING(J+20)*SA
         CALL TBFUNX(FLC(J+22),X,WING(J+100),NALPHA,FLC(23),WING(21),   &
     &               C1,IN,MI,NG,0,0,4HCLAW,1,ROUTID)
         CALL TBFUNX(FLC(J+22),X,WING(J+120),NALPHA,FLC(23),WING(41),   &
     &               C3,IM,MI,NG,0,0,4HCMAW,1,ROUTID)
 1000 END DO
      IN=0
      IM=0
      IF(KWING)CALL TBFUNX(0.,X,CLA,NALPHA,FLC(23),                     &
     &              WING(21),C1,IN,MI,NG,0,0,4HCLAW,1,ROUTID)
      IF(KWING)CALL TBFUNX(0.,X,CMA,NALPHA,FLC(23),                     &
     &              WING(41),C3,IM,MI,NG,0,0,4HCMAW,1,ROUTID)
!
!***  IF THE WING LIFT DEVIATES FROM THE LINEAR VALUE BY
!***  15 PERCENT OR MORE SET CM AND CMA TO NA (2*UNUSED)
!
      IF(A(7) .LE. (6./A(124)) .AND. WINGIN(15) .EQ. STRA) GO TO 1020
      IF(KWING) GO TO 1020
      FLAG=.FALSE.
      DO 1010 J=2,NALPHA
         DEL = 100.*ABS((WING(J+100)/CLA-1.0))
      IF(DEL.GT.90.0) FLAG=.TRUE.
         IF(FLAG) WING(J+40)  = 2.0*UNUSED
         IF(FLAG) WING(J+120) = 2.0*UNUSED
 1010 END DO
 1020 CONTINUE
      WING(101)=CLA
      WING(121)=CMA
      RETURN
      END
      SUBROUTINE M32O40
!
!***  EXEC FOR OVERLAY 32, SUPERSONIC VERTICAL TAIL LIFT
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      NOVLY=32
      IF(VTPL) CALL VTLIFT
      IF(VFPL) CALL VFLIFT
      RETURN
      END
      SUBROUTINE M33O41
!
!**  EXEX FOR OVERLAY 33, SUBSONIC HORIZONTAL TAIL CM
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /HTDATA/ AHT(195),BHT(49)
      COMMON /WHAERO/ C(51),D(55),CHT(51)
      COMMON /IHT/    PHT, HT(380)
      COMMON /HTI/    HTIN(154)
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /EXPER/  KK(106),KHT
      DIMENSION C1(6), C3(6), ROUTID(2)
      LOGICAL FLAG,KHT
      DATA ROUTID / 4HM33O, 4H41   /
      DATA STRA/ 4HSTRA /
      NOVLY=33
      CALL CMALPH(AHT,BHT,CHT,HTIN,HT)
      CALL CACALC(BHT,HT)
      CALL EXSUBT
      IN = 0
      CLA=HT(101)
      CMA=HT(121)
      IM = 0
      DO 1010 J=1,NALPHA
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         HT(J+60) = HT(J+20)*CA + HT(J)*SA
         HT(J+80) = HT(J)*CA - HT(J+20)*SA
         CALL TBFUNX(FLC(J+22),X,HT(J+100),NALPHA,FLC(23),HT(21),       &
     &               C1,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),X,HT(J+120),NALPHA,FLC(23),HT(41),       &
     &               C3,IM,MI,NG,0,0,4HCMA ,1,ROUTID)
 1010 END DO
      IN=0
      IM=0
      IF(KHT)CALL TBFUNX(0.,X,CLA,NALPHA,FLC(23),HT(21),C1,IN,MI,NG,    &
     & 0,0,4HCLAH,1,ROUTID)
      IF(KHT)CALL TBFUNX(0.,X,CMA,NALPHA,FLC(23),HT(41),C1,IM,MI,NG,    &
     & 0,0,4HCMAH,1,ROUTID)
!
!***  IF THE H.T. LIFT DEVIATES FROM THE LINEAR VALUE BY
!***  7.5 PERCENT OR MORE SET CM AND CMA TO NA (2*UNUSED)
!
      IF(AHT(7) .LE. (6./AHT(124)) .AND. HTIN(15) .EQ. STRA) GO TO 1030
      IF(KHT) GO TO 1030
      FLAG=.FALSE.
      DO 1020 J=2,NALPHA
         DEL = 100.*ABS(HT(J+100)/HT(101)-1.0)
         IF(DEL .GT. 7.5) FLAG=.TRUE.
         IF(FLAG) HT(J+40)  = 2.0*UNUSED
         IF(FLAG) HT(J+120)=2.0*UNUSED
 1020 END DO
      HT(101)=CLA
      HT(121)=CMA
 1030 CONTINUE
      RETURN
      END
      SUBROUTINE M34O42
!
!***  EXEC FOR OVERLAY 34, DEFINE EXPERIMENTAL DATA INPUT
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
      COMMON /EXPER/ KLIST, NLIST(100), NNAMES, IMACH, MDATA,           &
     &               KBODY, KWING, KHT, KVT, KWB, KDWASH(3),            &
     &               ALPOW, ALPLW, ALPOH, ALPLH
!
      NOVLY=34
      IF(KLIST .GE. 1) CALL XPERNM
      RETURN
      END
      SUBROUTINE M35O43
!
!***  EXEC FOR OVERLAY 35, TRANSONIC AERO
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,IJKDUM(2),NOVLY
!
      NOVLY=35
!
      IF(NF .LT. 0) CALL SETUP2
      IF(NF .GT. 0) CALL WBTRA
      IF(NF .GT. 0) CALL SECLEV
      RETURN
      END
      SUBROUTINE M36O44
!
!***  EXEC FOR OVERLAY 36, FLAP LIFT AND HINGE MOMENTS
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      COMMON /FLAPIN/ F(69)
      COMMON /IWING/  PWING, WING(400)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      NOVLY=36
      CALL LIFTFP
      IF(TRANSN)RETURN
      IF(F(17).EQ.1.0.OR.F(17).EQ.5.0)CALL HINGE
      DO 1010 J=2,10
 1010 WING(J+250) = -UNUSED
      IF(CTAB) CALL CTABS
      RETURN
      END
      SUBROUTINE M37O45
!
!***  EXEC FOR OVERLAY 37, FLAP PITCHING MOMENTS
!
      DIMENSION BOC(4)
      LOGICAL ASYFP
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IJKDUM(4),NOVLY
      COMMON /HTDATA/ AHT(195)
      COMMON /FLOLOG/ X(20),ASYFP
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /FLAPIN/ F(69)
      NOVLY=37
      IF(ASYFP.AND.(F(18).EQ.5.))GO TO 1000
      CALL FLAPCM
      RETURN
 1000 RACH=FLC(I+2)
      BETA=SQRT(1.-RACH**2)
      ARG=AHT(68)/BETA
      SB=ATAN(ARG)*RAD
      CALL GDELTA(GDF,GDI,GDO,ETI,ETO,BOC,SB)
      RETURN
      END
      SUBROUTINE M38O46
!
!***  EXEC FOR OVERLAY 38, SUBSONIC FLAP DRAG AND TRIM AERO
!
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,           &
     &        TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /FLAPIN/ F(69)
      COMMON /CONSNT/ CONST(5)
      COMMON /IWING/  PWING, WING(400)
      COMMON /IVT/    PVT, VT(380)
      COMMON /WINGI/  WINGIN(101)
      COMMON /HTI/    HTIN(131)
      EQUIVALENCE (CONST(3),UNUSED)
      NOVLY=38
      IF(TRIM.AND.HTPL.AND.(.NOT.SYMFP ))GO TO 1010
      IF(F(17).LE.6.)CALL DRAGFP
      IF(TRIM)CALL TRIMRT
      VT(301) = WING(251)
      DO 1000 J=2,NALPHA
 1000 VT(J+300) = -UNUSED
      RETURN
!
!     ---- IF CANARD, RETURN
!
 1010 IF(WINGIN(101).GT.2.0) RETURN
      CALL TRIMR2
      VT(301) = WING(251)
      DO 1020 J=2,NALPHA
 1020 VT(J+300) = -UNUSED
      RETURN
      END
      SUBROUTINE M39O47
!
!***  EXEC FOR OVERLAY 39, PRINT HIGH LIFT AND CONTROL DATA
!
      COMMON /FLAPIN/ F(138)
      COMMON /IBODY/  PBODY,  BODY(400)
      COMMON /IWING/  PWING,  WING(400)
      COMMON /IHT/    PHT,    HT(380)
      COMMON /IVT/    PVT,    VT(380)
      COMMON /OVERLY/ IJKDUM(8),NOVLY
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB,PLOT
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB,PLOT
!
      NOVLY=39
      CALL DUMP2
      CALL OUTPT2
      IF(.NOT. PLOT) GO TO 1000
        WRITE(13,1010) F
        WRITE(13,1010)(BODY(J),J=201,400)
        WRITE(13,1010)(WING(J),J=201,400)
        WRITE(13,1010) (HT(J), J=201,380)
        WRITE(13,1010) (VT(J), J=201,380)
 1000 CONTINUE
 1010 FORMAT(1P,10E12.4)
      RETURN
      END
      SUBROUTINE M40O50
!
!***  EXEC FOR OVERLAY 40, TRANSONIC LATERAL CONTROL/FLAP AERO
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLOLOG/ LOG(19),SYMFLP,ASYFLP
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /IWING/  PW, WING(400)
      LOGICAL SYMFLP,ASYFLP
      NOVLY=40
      CALL TRNYRL
      IF(ASYFLP) GO TO 1010
      DO 1000 J=1,10
         WING(J+220) = UNUSED
         IF(J .EQ. 1) GO TO 1000
         WING(J+250) = -UNUSED
 1000 END DO
 1010 CONTINUE
      RETURN
      END
      SUBROUTINE M41O51
!
!***  EXEC FOR OVERLAY 41, SUPERSONIC HIGH LIFT AND CONTROL AERO
!
      COMMON /OVERLY/ IJKDUM(8),NOVLY
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLAPIN/ F(69)
      COMMON /IWING/  PW, WING(400)
      NOVLY=41
      IF(F(17).NE.5.0.AND.F(17).NE.6.0)CALL SSHING
      DO 1000 J=2,10
         WING(J+250) = -UNUSED
 1000 END DO
      RETURN
      END
      SUBROUTINE M42O52
!
!***  EXEC FOR OVERLAY 42, HYPERSONIC FLAP AERO
!
      COMMON /IBODY/  PB, BODY(200), dum1(200)
      COMMON /IWING/  PW, WING(200)
      COMMON /IHT/    PHT, HT(200), dum3(180)
      COMMON /IVT/    PVT, VT(200), dum4(180)
      COMMON /FLAPIN/ F(16)
      COMMON /BDATA/  HYP(80)
      COMMON /CONSNT/ CONST(5)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /ERROR/  LL
      LOGICAL LL(46),DMPCSE,DPHYP
      EQUIVALENCE (LL(21),DMPCSE),(LL(46),DPHYP)
      NOVLY=42
      CALL HYPFLP
      IF(DMPCSE .OR. DPHYP) CALL DMPARY(   F, 16,4H   F,4)
      IF(DMPCSE .OR. DPHYP) CALL DMPARY(BODY,200,4HBODY,4)
      IF(DMPCSE .OR. DPHYP) CALL DMPARY(  HT,200,4H  HT,4)
      IF(DMPCSE .OR. DPHYP) CALL DMPARY( HYP, 80,4H HYP,4)
      IF(DMPCSE .OR. DPHYP) CALL DMPARY(  VT,200,4H  VT,4)
      IF(DMPCSE .OR. DPHYP) CALL DMPARY(WING,200,4HWING,4)
      CALL OUTPT4
      RETURN
      END
      SUBROUTINE M43O53
!
!***  EXEC FOR OVERLAY 43, DYNAMIC DERIVATIVES
!
      COMMON /CONSNT/ CONST(5)
      COMMON /IWING/  PWING, WING(400)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /WINGD/  A(195),B(49)
      COMMON /WINGI/  WINGIN(101)
      COMMON /POWR/   DYN(213)
      COMMON /IHT/    PHT,HT(380)
      COMMON /HTDATA/ AHT(195),BHT(49)
      COMMON /HTI/    HTIN(154)
      COMMON /BDATA/  BD(300),DYNH(213)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,           &
     &        TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM
      EQUIVALENCE (CONST(3),UNUSED)
      NOVLY=43
      IF(HYPERS) GO TO 1020
      CALL CMALPO(A,B,WINGIN,DYN)
      IF(SUBSON .OR. TRANSN)CALL SUBPAW
      IF(SUBSON) GO TO 1000
      IF(TRANSN)CALL SUPPAW
      IF(SUPERS) CALL SUPPAW
      IF(TRANSN .OR. SUPERS) CALL SUPCMQ
 1000 CONTINUE
!
!     ONLY FIRST LOCATION COMPUTED, SET REST TO BLANK
!
      DO 1010 J=2,NALPHA
         WING(J+200) = -UNUSED
         WING(J+220) = -UNUSED
         WING(J+240) = -UNUSED
         WING(J+260) = -UNUSED
 1010 END DO
 1020 CONTINUE
      IF(HYPERS) GO TO 1050
      IF(.NOT. HTPL) GO TO 1050
      CALL CMALPO(AHT,BHT,HTIN,DYNH)
      IF(SUBSON .OR. TRANSN)CALL SUBPAH
      IF(SUBSON) GO TO 1030
      IF(TRANSN)CALL SUPPAH
      IF(SUPERS) CALL SUPPAH
      IF(TRANSN .OR. SUPERS) CALL SUPHMQ
 1030 CONTINUE
!
!     ONLY FIRST LOCATION COMPUTED, SET REST TO BLANK
!
      DO 1040 J=2,NALPHA
         HT(J+200) = -UNUSED
         HT(J+220) = -UNUSED
         HT(J+240) = -UNUSED
         HT(J+260) = -UNUSED
 1040 END DO
 1050 CONTINUE
      RETURN
      END
      SUBROUTINE M44O54
!
!***  EXEC FOR OVERLAY 44, SUPERSONIC WING ALPHA DOT DERIVS
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /IWING/  PWING,WING(400)
      COMMON /IHT/    PHT,HT(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      NOVLY=44
      IF(WGPL)CALL SUPCLD
      IF(HTPL)CALL SUPHLD
!
!  FIRST LOCATION COMPUTED, SET IOM WITH BLANKS
!
      DO 1000 J=2,NALPHA
        WING(J+240) = -UNUSED
        HT(J+240) = -UNUSED
 1000 END DO
      RETURN
      END
      SUBROUTINE M45O55
!
!***  EXEC FOR OVERLAY 45, WING AND WING-BODY YAW AND ROLL DERIVS
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
      NOVLY=45
      IF(WGPL)CALL WINGYW
      IF(HTPL)CALL HORTYW
      RETURN
      END
      SUBROUTINE M46O56
!
!***  EXEC FOR OVERLAY 46, WING-BODY-TAIL DYNAMIC DERIVS
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /POWR/   DYN(213)
      COMMON /BDATA/  BD(300),DYNH(213)
      COMMON /IBODY/  PBODY,BODY(400)
      COMMON /IWING/  PWING,WING(400)
      COMMON /IBW/    PBW,BW(380)
      COMMON /IBH/    PBH,BH(380)
      COMMON /IBV/    PBV,BV(380)
      COMMON /IHT/    PHT,HT(380)
      COMMON /IVT/    PVT,VT(380)
      COMMON /IVF/    PVF,VF(380)
      COMMON /IBWV/   PBWV,BWV(380)
      COMMON /IBWH/   PBWH,BWH(380)
      COMMON /IBWHV/  PBWHV,BWHV(380)
      COMMON /IPOWER/ PPOWER,POWER(200)
      COMMON /IDWASH/ PDWASH,DWSH(60)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
      NOVLY=46
      IF(.NOT.BO)GO TO 1020
      CALL DYNBOD
      IF(HYPERS.AND.FLC(I+2).GT.1.4)GO TO 1020
      IF(WGPL)CALL DNPAWB
      IF(WGPL.AND.HTPL)GO TO 1000
      GO TO 1010
 1000 CALL DNPWBT
 1010 IF((VTPL .OR. VFPL).AND.SUBSON)CALL SUBWBT
 1020 CONTINUE
      IF(.NOT. HYPERS) CALL CLRDER
!
!   SET IOM WITH BLANKS SINCE ONLY FIRST POINT CALCULATED
!
      DO 1040 J=2,NALPHA
         BODY(J+200) = -UNUSED
         BODY(J+220) = -UNUSED
         BODY(J+240) = -UNUSED
         BODY(J+260) = -UNUSED
         BODY(J+280) = -UNUSED
         BODY(J+300) = -UNUSED
         BODY(J+320) = -UNUSED
         BODY(J+340) = -UNUSED
         HT(J+200) = -UNUSED
         HT(J+220) = -UNUSED
         IF(SUBSON) HT(J+300)=-UNUSED
         IF(SUBSON) HT(J+320)=-UNUSED
         IF(SUBSON) HT(J+340)=-UNUSED
         IF(TRANSN) HT(J+240) = -UNUSED
         IF(TRANSN) HT(J+260) = -UNUSED
         VT(J+200) = -UNUSED
         VT(J+220) = -UNUSED
         VT(J+240) = -UNUSED
         VT(J+260) = -UNUSED
         VF(J+200) = -UNUSED
         VF(J+220) = -UNUSED
         VF(J+240) = -UNUSED
         VF(J+260) = -UNUSED
         BW(J+200) = -UNUSED
         BW(J+220) = -UNUSED
         BW(J+240) = -UNUSED
         BW(J+260) = -UNUSED
         BWH(J+200) = -UNUSED
         BWH(J+220) = -UNUSED
         IF(TRANSN) BWH(J+240) = -UNUSED
         IF(TRANSN) BWH(J+260) = -UNUSED
         IF(HYPERS) GO TO 1030
         BH(J+200) = -UNUSED
         BH(J+220) = -UNUSED
         BH(J+240) = -UNUSED
         BH(J+260) = -UNUSED
         BV(J+200) = -UNUSED
         BV(J+220) = -UNUSED
         BV(J+240) = -UNUSED
         BV(J+260) = -UNUSED
         BH(J+300) = -UNUSED
         BH(J+320) = -UNUSED
         BH(J+340) = -UNUSED
         BV(J+280) = -UNUSED
         BV(J+300) = -UNUSED
         BV(J+320) = -UNUSED
         BV(J+340) = -UNUSED
 1030    BWHV(J+200) = -UNUSED
        BWHV(J+220) = -UNUSED
         IF(TRANSN) BWHV(J+240) = -UNUSED
         IF(TRANSN) BWHV(J+260) = -UNUSED
 1040 END DO
      DO 1050 J=1,NALPHA
         BWH(J+300) = BW(J+300)
         BWH(J+320) = BW(J+320)
         BWH(J+340) = BW(J+340)
         IF((VTPL.OR.VFPL).AND.SUBSON)BWV(J+280) = BW(J+280)+VT(J+280)  &
     &                                             +VF(J+280)
         IF((VTPL.OR.VFPL).AND.SUBSON)BWHV(J+280) = BWH(J+280)+VT(J+280)&
     &                                              +VF(J+280)
         BWV(J+200) = BW(J+200)
         BWV(J+220) = BW(J+220)
         BWV(J+240) = BW(J+240)
         BWV(J+260) = BW(J+260)
 1050 END DO
      IF(DMPCSE .OR. DPDYN) CALL DMPARY(DYN,213,3HDYN,3)
      IF(DMPCSE .OR. DPDYNH) CALL DMPARY(DYNH,213,4HDYNH,4)
      IF(DPIBDY.OR.DPIWG.OR.DPIHT.OR.DPIVT.OR.DPIBW.OR.DPIBH.OR.        &
     &    DPIBV.OR.DPIBWH.OR.DPIBWV.OR.DPITOT.OR.DPIPWR.OR.DPIDWH)      &
     &    WRITE(6,1060)
      IF(DPIBDY) CALL DMPARY(BODY,400,4HBODY,4)
      IF(DPIWG)  CALL DMPARY(WING,400,4HWING,4)
      IF(DPIHT)  CALL DMPARY(HT,380,2HHT,2)
      IF(DPIVT)  CALL DMPARY(VT,380,2HVT,2)
      IF(DPIVF)  CALL DMPARY(VF,380,2HVF,2)
      IF(DPIBW)  CALL DMPARY(BW,380,2HBW,2)
      IF(DPIBH)  CALL DMPARY(BH,380,2HBH,2)
      IF(DPIBV)  CALL DMPARY(BV,380,2HBV,2)
      IF(DPIBWH) CALL DMPARY(BWH,380,3HBWH,3)
      IF(DPIBWV) CALL DMPARY(BWV,380,3HBWV,3)
      IF(DPITOT) CALL DMPARY(BWHV,380,4HBWHV,4)
      IF(DPIPWR) CALL DMPARY(POWER,200,4HPOWR,4)
      IF(DPIDWH) CALL DMPARY(DWSH,60,4HDWSH,4)
 1060 FORMAT(55H0**** THE FOLLOWING ARE IDEAL OUTPUT MATRIX ARRAYS ****)
      RETURN
      END
      SUBROUTINE M47O57
!
!***  EXEC FOR OVERLAY 47, TRANSVERSE-JET AERO
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
      NOVLY=47
      CALL TRANJT
      CALL OUTTRJ
      RETURN
      END
      SUBROUTINE M48O60
!
!***  EXEC FOR OVERLAY 48, LOAD EXPERIMENTAL DATA FOR THIS MACH
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
      NOVLY=48
      CALL EXPDAT
      RETURN
      END
      SUBROUTINE M49O61
!
!***  EXEC FOR OVERLAY 49, DUMP REQUESTED ARRAY
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
      NOVLY=49
      CALL DUMPRT
      RETURN
      END
      SUBROUTINE M50O62
!
!  AIRFOIL SECTION AERODYNAMICS AND GEOMETRIC PROPERTIES
!
      COMMON /OVERLY/IJKDUM(8),NOVLY
      COMMON /IBODY/ PB, NACA(80), BF(232), CBAR , dum1(87)
      COMMON /IWING/ PW, X(60), dum13(340)
      COMMON / IHT / PH, XU(60),XL(60),YU(60),YL(60), dum3(140)
      COMMON / IVT / PV, YUN(60),YLN(60), dum4(260)
      COMMON / IVF / PVF, BVF(380)
      COMMON / IBW / PBW, BW(380)
      COMMON / IBH / PBH, BBH(380)
      COMMON / IBV / PBV, BBV(380)
      COMMON /IBWH/  PBWH, AI,ALO,CLI,ASEP,CMCO4,CLA0,CLA(20),CLMAX0,   &
     &               CLMAX(20),BH(232)
      COMMON /IBWHV/ PBWHV,RHO,TMAX,DELTAY,XOVC,TOVC,COVC,CXVC,CAMBER,  &
     &               BV(232)
      COMMON /WINGI/ WINGIN(100)
      COMMON /HTI/   HTIN(154)
      COMMON /VTI/   VTIN(154),TVTIN(8),VFIN(154)
      COMMON /FLGTCD/FLC(93), dumflgtcd(67)
      COMMON /CONSNT/PI,DEG,UNUSED,RAD,kand
      LOGICAL NACAIN,CAMBER
      INTEGER A4HN,A4HA,A4HC
      DIMENSION THN(60),CAM(60)
      EQUIVALENCE (THN(1),BBH(1)),(CAM(1),BBH(61))
      DATA A4HN,A4HA,A4HC/4HN   ,4HA   ,4HC   /
      NOVLY=50
      DO 1000 I=1,232
         BH(I)=BBH(I+130)
         BV(I)=BBV(I+130)
         BF(I)=BVF(I+130)
 1000 END DO
      IN=0
 1010 IN=IN+1
      CALL INIZ
      NACAIN=.FALSE.
      CAMBER=.FALSE.
      IF(IN .GT. 4) GO TO 1150
      GO TO (1020,1030,1040,1050), IN
 1020 CONTINUE
!
!---- HERE FOR WING
!
      IF(WINGIN(15) .EQ. UNUSED) GO TO 1010
      CALL SECI(BW(131),CAMBER,ATYPE,WINGIN,L)
      RHO = WINGIN(62)
      GO TO 1060
 1030 CONTINUE
!
!---- HERE FOR HORIZONTAL TAIL
!
      IF(HTIN(15) .EQ. UNUSED) GO TO 1010
      CALL SECI(BH(1),CAMBER,ATYPE,HTIN,L)
      RHO = HTIN(62)
      GO TO 1060
 1040 CONTINUE
!
!---- HERE FOR VERTICAL TAIL
!
      IF(VTIN(15) .EQ. UNUSED) GO TO 1010
      CALL SECI(BV(1),CAMBER,ATYPE,VTIN,L)
      GO TO 1060
 1050 CONTINUE
!
!---- HERE FOR VENTRAL FIN
!
      IF(VFIN(15) .EQ. UNUSED) GO TO 1010
      CALL SECI(BF(1),CAMBER,ATYPE,VFIN,L)
      RHO = VTIN(62)
 1060 CONTINUE
      IF(IN .EQ. 1 .AND. ATYPE .LT. 0.) WRITE(6,1160)
      IF(IN .EQ. 2 .AND. ATYPE .LT. 0.) WRITE(6,1170)
      IF(IN .EQ. 3 .AND. ATYPE .LT. 0.) WRITE(6,1180)
      IF(IN .EQ. 4 .AND. ATYPE .LT. 0.) WRITE(6,1190)
      IF(NACA(1).EQ.A4HN .AND. NACA(2).EQ.A4HA .AND.                    &
     &   NACA(3).EQ.A4HC .AND. NACA(4).EQ.A4HA)NACAIN=.TRUE.
      IF(NACAIN .AND. ABS(ATYPE) .LE. UNUSED) GO TO 1090
      IF(ABS(ATYPE).LE.UNUSED) GO TO 1010
      IVAL=ABS(ATYPE)-0.5
      CALL XYCORD(IVAL,IN)
 1070 CONTINUE
      DO 1080 M=2,L
         IF(THN(M) .GT. THN(M-1)) TOVC=THN(M)
         IF(THN(M) .GT. THN(M-1)) XOVC=X(M)
         IF(CAM(M) .GT. CAM(M-1)) COVC=CAM(M)
         IF(CAM(M) .GT. CAM(M-1)) CXVC=X(M)
 1080 END DO
      IF(COVC .GT. UNUSED) CAMBER=.TRUE.
      IF(TMAX .EQ. UNUSED) TMAX=2.*TOVC
      IF(RHO.EQ.UNUSED) RHO = (X(2)**2+THN(2)**2)/(2.0*X(2))
      CALL DELY
      CALL THEORY
      CALL MAXCL
      GO TO 1100
 1090 CALL AIRFOL
      GO TO 1070
 1100 CONTINUE
      GO TO (1110,1120,1130,1140), IN
 1110 CONTINUE
!
!---- SET CALCULATED WING PARAMETERS
!
      CALL SECO(WINGIN(1),CAMBER,ATYPE)
      CALL CSLOPE
      GO TO 1010
 1120 CONTINUE
!
!---- SET CALCULATED HORIZONTAL TAIL PARAMETERS
!
      CALL SECO(HTIN(1),CAMBER,ATYPE)
      GO TO 1010
 1130 CONTINUE
!
!---- SET CALCULATED VERTICAL TAIL PARAMETERS
!
      CALL SECO(VTIN(1),CAMBER,ATYPE)
      GO TO 1010
 1140 CONTINUE
!
!---- SET CALCULATED VENTRAL FIN PARAMETERS
!
      CALL SECO(VFIN(1),CAMBER,ATYPE)
      GO TO 1010
 1150 CONTINUE
 1160 FORMAT(68H0*** WARNING *** WING NOT STRAIGHT TAPERED. UNIFORM SECT&
     &ION ASSUMED.)
 1170 FORMAT(68H0*** WARNING *** H.T. NOT STRAIGHT TAPERED. UNIFORM SECT&
     &ION ASSUMED.)
 1180 FORMAT(68H0*** WARNING *** V.T. NOT STRAIGHT TAPERED. UNIFORM SECT&
     &ION ASSUMED.)
 1190 FORMAT(68H0*** WARNING *** VFIN NOT STRAIGHT TAPERED. UNIFORM SECT&
     &ION ASSUMED.)
      RETURN
      END
      SUBROUTINE M51O63
!
!***  EXEC FOR OVERLAY 51, INITIALIZE ARRAYS
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,INITZE,IJKDUM(3),NOVLY
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /POWR/   PW(315)
      NOVLY=51
      IF(INITZE .EQ. 1) CALL INITZ1
      IF(INITZE .EQ. 2) CALL INITZ2
      IF(INITZE .NE. 3) GO TO 1010
      DO 1000 J=1,315
         PW(J) = UNUSED
 1000 END DO
 1010 CONTINUE
      RETURN
      END
      SUBROUTINE M52O64
!
!***  EXEC FOR OVERLAY 52, SUBSONIC LATERAL CONTROL/FLAP AERO
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
      NOVLY=52
      CALL LATFLP
      RETURN
      END
      SUBROUTINE M53O65
!
!***  EXEC FOR OVERLAY 53, SUPERSONIC TRAILING EDGE FLAP ROLL AND
!     YAW AERO
!
      COMMON /OVERLY/ IJKDUM(8),NOVLY
      COMMON /IHT/    PHT,HT(380)
      COMMON/FLAPIN/F(69)
      NOVLY=53
      IF(F(18).NE.3.0)CALL SPRYAW
!
!     CALCULATE DELTAL-DELTAR
!
      DO 1000 J=1,10
         HT(J+200) = F(J+18)-F(J+28)
 1000 END DO
      RETURN
      END
      SUBROUTINE M54O66
!
!***  EXEC FOR OVERLAY 54, SUPERSONIC WING CM ALPHA DOT
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /CONSNT/ PI,DEG,UNUSED,rad,kand
      COMMON /IWING/  PWING, WING(400)
      COMMON /IHT/    PHT, HT(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      NOVLY=54
      IF(WGPL) CALL SUPCMD
      IF(HTPL) CALL SUPHMD
!
!     FOR CMAD ONLY ONE POINT CALCULATED
!     BLANK OUT REMAINING POINTS
!
      DO 1000 J=2,NALPHA
         HT(J+260) = -UNUSED
 1000 WING(J+260) = -UNUSED
      RETURN
      END
      SUBROUTINE M55O67
!
!***  EXEC FOR OVERLAY 55, CALCULATE INCREMENTAL AFFECTS DUE TO JET FLAP
!
      COMMON /OVERLY/  IJKDUM(8),NOVLY
      NOVLY=55
      CALL JETFP
      RETURN
      END
      SUBROUTINE M56O70
!
!***  EXEC FOR OVERLAY 56, MACH SHADOWING DATA
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,IJKDUM(3),NOVLY
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /HTI/    HTIN(154)
      COMMON /VTI/    VTIN(154),TVTIN(8),VFIN(154)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON/CONSNT/CONST(5)
      EQUIVALENCE (CONST(3),UNUSED),(VERTUP,SYNA(10))
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL ABORT,VERTUP,FINUP,FLAG
      DATA A/4H****/
      NOVLY=56
      IG=0
      FINUP=.NOT. VERTUP
      SYNA6=SYNA(6)
      SYNA7=SYNA(7)
      FLAG=VTPL.AND.(VTIN(I+94).EQ.UNUSED).OR.(VTIN(I+114).EQ.UNUSED)   &
     &     .OR.(VTIN(I+134).EQ.UNUSED)
      IF(FLAG)CALL VTAREA(VTIN,AVT,VERTUP,SYNA(9),SYNA(14))
      FLAG=VFPL.AND.(VFIN(I+94).EQ.UNUSED).OR.(VFIN(I+114).EQ.UNUSED)   &
     &     .OR.(VFIN(I+134).EQ.UNUSED)
      IF(FLAG)CALL VTAREA(VFIN,AVF,FINUP,SYNA(12),SYNA(15))
      IF(.NOT.HTPL) GO TO 1070
      IF(HTIN(94+I).NE.UNUSED.AND.HTIN(114+I).NE.UNUSED.AND.            &
     &   HTIN(134+I).NE.UNUSED) GO TO 1070
      CALL BDAREA(ABORT)
      IF(.NOT.ABORT) GO TO 1070
      DO 1020 JK=1,5
 1020 WRITE(6,1030) (A,K=1,32)
 1030 FORMAT(3X,32A4)
      WRITE(6,1040)
 1040 FORMAT(//////)
      WRITE(6,1050)
 1050 FORMAT(8X,42HLATERAL STABILITY DERIVATIVES ARE DELETED ,          &
     &      43HBECAUSE ALL OR PART OF THE HORIZONTAL TAIL ,             &
     &      34HEXPOSED ROOT CHORD LIES OFF OF THE,//,8X,                &
     &      44HFUSELAGE. FOR THIS CASE THE NAMELIST HTPLNF ,            &
     &      45HPARAMETERS SHB, SEXT, AND RLPH MUST BE INPUT ,           &
     &      12HBY THE USER.)
      WRITE(6,1040)
      DO 1060 JK=1,5
 1060 WRITE(6,1030) (A,K=1,32)
      IG=1
 1070 CONTINUE
      SYNA(6)=SYNA6
      SYNA(7)=SYNA7
      RETURN
      END
      SUBROUTINE M57O71
!
!  PROGRAM TO READ EXTRAPOLATION MESSAGES FROM UNIT 12
!  AND PRINT IN A READABLE FORMAT
!
      INTEGER ROUT,ROUTL
      LOGICAL PAIR,PAIRX
!
!   ROUTINE USES THE IOM AND WORKING DATA ARRAYS TO
!   CONSERVE CORE.  ROUTINE EXECUTES AFTER COMPLETION OF ALL
!   CASE COMPUTATIONS.
!
      COMMON /IBODY/   PB, AFIG01(121), AFIG02(121), dum1(158)
      COMMON /IWING/   PW, AFIG03(121), AFIG04(121), dum13(158)
      COMMON /IHT/    PHT, AFIG05(121), AFIG06(121), dum3(138)
      COMMON /IVT/    PVT, AFIG07(121), AFIG08(121), dum4(138)
      COMMON /IVF/    PVF, AFIG09(121), AFIG10(121), dum17(138)
      COMMON /IBW/    PBW, AFIG11(121), AFIG12(121), dum5(138)
      COMMON /IBH/    PBH, AFIG13(121), AFIG14(121), dum6(138)
      COMMON /IBV/    PBV, JFIG01(121), JFIG02(121), dum7(138)
      COMMON /IBWH/  PBWH, JFIG03(121), JFIG04(121), dum8(138)
      COMMON /IBWV/  PBWV, JFIG05(121), JFIG06(121), dum9(138)
      COMMON /IBWHV/PBWHV, JFIG07(121), JFIG08(121), dum12(138)
      COMMON /WINGD/       JFIG09(121)
      COMMON /SBETA/       JFIG10(121), JFIG11(121), JFIG12(121)
      COMMON /BDATA/       JFIG13(121), JFIG14(121), JFIG15(121),       &
     &                     JFIG16(121), JFIG17(121)
      COMMON /WHWB/        JFIG18(121)
      COMMON /WBHCAL/      JFIG19(121)
      COMMON /HTDATA/      JFIG20(121)
      COMMON /VTDATA/ LFIGN(121),LFIGO(121),IOVLY,IOVL,NSTQ,NSTP,FINALR,&
     &                NFIG,IFIGN
      COMMON /WHAERO/ LFIGS(121), IFIGST(20), IEXCD(4), MSSCL(2),       &
     &                ROUT(2), XLL(4), XUL(4), IEXTRL(4,2),             &
     &                IEXTRU(4,2), XVAL(4), LDUM(121), PAIRX
      COMMON /ERROR/ DERROR(82),LEXTRP
      LOGICAL DERROR,LEXTRP
      DIMENSION IFIG(20,121)
!
!*** IF PRINT EXTRAP CARD NOT INPUT REURN AND DO NOT DUMP EXTRAPOLATION
!       MESSAGES
      IF(.NOT. LEXTRP)RETURN
!
!  INITIALIZE ALL ARRAYS AND VARIABLES TO BE USED
!
      CALL CLEARA(IFIG,ROUTL,MSSCLL)
!
!  WRITE OVERLAY NUMBER OF 999 TO UNIT 12 TO SIGNIFY END OF DATA
!  THIS OVERLAY NUMBER HAS BEEN PRE-SET IN SUBROUTINE CLEARA
!
      WRITE(12,1090)IOVLY,IOVLY,IOVLY
!
!   REWIND UNIT 12 AND START READING EXTRAPOLATION MESSAGES
!
      REWIND 12
      IPRT=60
 1000 CALL READXM(IFIG)
      IF(IOVLY.NE.IOVL .OR. NFIG.GE.120 .OR. IOVL.EQ.999) GO TO 1020
 1010 CONTINUE
!
!  TRANSLATE FIGURE NUMBER INTO 9 DIGIT INTEGER WORD
!
      CALL DECFIG(IFIG(1,NFIG),20,IFIGN)
!
!  STORE FIGURE DATA FOR LATER USE
!
      CALL STORXM
      GO TO 1000
!
!  SORT FIGURE NUMBERS FOR THIS OVERLAY IN ASCENDING ORDER
!
 1020 CONTINUE
      IOVM=IOVL
      NFIG=NFIG-1
      IF(NFIG.LE.0 .AND. IOVLY.EQ.999)GO TO 1060
      CALL SORTER(LFIGN,NFIG,1,0,1,LFIGS,LFIGO,LDUM,IFLAG)
!
!  PULL FIGURES IN ASCENDING ORDER
!
      PAIRX=.TRUE.
      DO 1040 I=1,NFIG
         IF(IPRT.GE.54)WRITE(6,1070)
         IF(IPRT.GE.54)WRITE(6,1080)
         IF(IPRT.GE.54)PAIR=.TRUE.
         IF(IPRT.GE.54)IPRT=6
!
!  FIND WHERE THIS FIGURE IS STORED IN THE ARRAYS
!
         JJ=LFIGO(I)
         JK=AFIG01(JJ)+0.5
         CALL WRITXM(IFIG,IPRT,JK,JJ,IOVM,ROUTL,JJ,MSSCLL)
         IF(IPRT.GE.54)WRITE(6,1100)
         IF(IPRT.GE.54)PAIR=.FALSE.
!
!  SET TEST ARRAYS TO PRESENT FIGURE NUMBER AND ROUTINES
!
         DO 1030 K=1,20
            IFIGST(K)=IFIG(K,JJ)
 1030    CONTINUE
         MSSCLL=JFIG01(JJ)
         ROUTL=JFIG03(JJ)
 1040 END DO
      IF(IOVLY.EQ.999 .OR. IOVLY.LE.0)GO TO 1060
      NFIG=NFIG+1
      DO 1050 L=1,20
         IFIG(L,1)=IFIG(L,NFIG)
 1050 END DO
      NFIG=1
!
!  CONTINUE PROCESSING WITH LAST FIGURE READ FROM UNIT 12
!
      GO TO 1010
 1060 CONTINUE
!
!  COMPLETED THE DUMP OF EXTRAPOLATION MESSAGES FOR THIS CASE
!  REWIND UNIT 12 TO BEGIN NEXT CASE
!
      REWIND 12
      IF(PAIR)WRITE(6,1100)
 1070 FORMAT(1H1,50X,29HEXTRAPOLATION MESSAGE SUMMARY/)
 1080 FORMAT(1X,7HOVERLAY,2X,13HFIGURE NUMBER,                          &
     & 26X,35HTYPE OF EXTRAPOLATION (LOWER UPPER)/                      &
     & 11X,11HSUBROUTINES,32X,27HFIGURE LIMITS (LOWER UPPER)/           &
     & 25X,12HFINAL RESULT,20X,21HINDEPENDENT VARIABLES)
 1090 FORMAT(3I3)
 1100 FORMAT(107H0*NOTE*   MESSAGES HAVE BEEN SORTED WITHIN EACH OVERLAY&
     & BY FIGURE NUMBER AND DO NOT NECESSARILY CORRESPOND               &
     & /10X,34HTO THE PROGRAM EXECUTION SEQUENCE.                       &
     & /9X,53H ** DENOTES THE INDEPENDENT VARIABLE EXCEEDED IN CALL)
      RETURN
      END
      SUBROUTINE MACH2(DNU,XM,IER)
!
!     THIS SUBROUTINE TAKES THE PRANDTL-MEYER ANGLE (DNU) AND SOLVES THE
!     TRANSCENDENTIAL EQUATION FOR THE FLOW MACH NUMBER USING NEWTONS
!     METHOD
!
!     DESCRIPTION OF PARAMETERS -
!       DNU - ARGUMENT VALUE OF PRANDTL-MEYER ANGLE IN DEGREES
!       XM  - RESULTING MACH NUMBER
!       IER - RESULTING ERROR PARAMETER
!           IER=0   NO ERROR
!           IER=1   DNU .LT. 0.0, NO MACH NUMBER SOLUTION, XM=1.0
!           IER=2   DNU .GT. 130 DEG.,  NO NUMERICAL SOLUTION, XM=1000.
!           IER=3   ITERATION DID NOT CONVERGE,DIFFERENCE BETWEEN
!                        CALCULATED AND REQUESTED DNU .GT. 2.0E-6 DEG.
!
!     METHOD -
!         THE EQUATION FOR THE PRANDTL-MEYER EXPANSION ANGLE, FROM
!         NACA REPT. 1135, IS - DNU = SQR6*ATAN(B/SQR6)-ATAN(B), WHERE
!         B = SQRT(XM**2 - 1), AND SQR6 = SQRT(6) = 2.44948974. FOR
!         PROGRAM OPERATIONS DNU IS CONVERTED FROM DEGREES TO RADIANS
!         AND NAMED RNU. IN NEWTONS METHOD, THE EQUATION FOR F(B)
!         IS DEFINED AND BY ITERATION SOLVED FOR B SUCH THAT F(B)=0.0.
!         THE ITERATION FORM IS - B(I+1) = B(I) -F/(DF/DB), WHERE
!              F = F(B) -THE INCREMENT BETWEEN THE PRANDTL-MEYER
!                         ANGLE FOR B(I) AND RNU
!                = SQR6*ATAN(B/SQR6) - ATAN(B) -RNU
!
!              DF/DB - THE FIRST DERIVATIVE OF F(B) WITH RESPECT
!                      TO B
!                    = (5*B**2)/((1+B**2)*(6+B**2))
!
      COMMON /CONSNT/ PI,DEG,UNUSED,DR,kand
      DATA EPS,SQR6 / 2.0E-6, 2.44948974 /
      IER=0
      IF(DNU .LT. 0.0) GO TO 1020
      IF(DNU .EQ. 0.0) GO TO 1030
      IF(DNU.GT.130.) GO TO 1040
      RNU=DNU/DR
      B=1.0
      DO 1000 I=1,30
         F=SQR6*ATAN(B/SQR6)-ATAN(B)-RNU
         IF(ABS(F).LE.EPS) GO TO 1010
         DB=F*(1.+B*B)*(6.+B*B)/(5.*B*B)
         B=B-DB
 1000 END DO
      IER=3
 1010 XM=SQRT(B*B+1.0)
      RETURN
 1020 IER=1
 1030 XM=1.0
      RETURN
 1040 IER=2
      XM=1000.
      RETURN
      END
      SUBROUTINE MAIN00
!
!***  TOP LEVEL EXECUTIVE
!
!             IDEAL OUTPUT MATRIX
!
!             BLOCK    PRINT     IOM
!             NAME     FLAG     ARRAY
!
      COMMON /IBODY/   PBODY,  BODY(400)
      COMMON /IWING/   PWING,  WING(400)
      COMMON /IHT/     PHT,    HT(380)
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
      COMMON /IBWH/    PBWH,   BWH(380)
      COMMON /IBWV/    PBWV,   BWV(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
      COMMON /IPOWER/  PPOWER, POWER(200)
      COMMON /IDWASH/  PDWASH, DWASH(60)
!
      LOGICAL PBODY, PWING, PHT, PVT, PVF, PBW, PBH, PBV, PBWH, PBWV,   &
     &        PBWHV, PPOWER, PDWASH
!
!***  INPUT DATA BLOCKS
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /BODYI/  BODYIN(129)
      COMMON /WINGI/  WINGIN(101)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /HTI/    HTIN(154)
      COMMON /POWER/  PWIN(29), LBIN(21)
      COMMON /FLAPIN/ F(138)
!
      DIMENSION ZL(20)
      EQUIVALENCE (ZL(1),BODYIN(102))
      EQUIVALENCE (STMACH,FLC(94)), (TSMACH,FLC(95))
      LOGICAL VERTUP
!
!***  COMPUTATIONAL BLOCKS
!
      COMMON /WINGD/  A(195), B(49)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /BDATA/  BD(762)
      COMMON /WHWB/   FACT(182), WB(39), HB(39)
      COMMON /WBHCAL/ WBT(156)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55), DVF(55)
      COMMON /POWR/   PW(315)
      COMMON /SUPWBB/  SWB(61), SHB(61)
      COMMON /SUPDW/  DWA(237)
      COMMON /SUPWH/  GR(303)
      COMMON /SUPBOD/ SBD(229)
      COMMON /LEVEL2/ SECOND(23)
!
      DIMENSION SLG(141), STG(141), FCM(287), LB(200), DYN(213)
      DIMENSION SPR(59),FLA(45), FLP(189), STP(156), JET(26), SLA(31)
      DIMENSION FHG(35), TCD(58), TRM(22), TRM2(22), TRN(7), DYNH(213)
      DIMENSION SLAH(31)
!
      EQUIVALENCE (GR(1), FCM(1), SLG(1)), (GR(142), STG(1))
      EQUIVALENCE (DWA(1), LB(1), JET(1), FHG(1)), (WBT(1), STP(1))
      EQUIVALENCE (PW(1), DYN(1), SPR(1)), (PW(60), FLA(1))
      EQUIVALENCE (PW(105), FLP(1)), (PW(294), TRM(1), TRM2(1), TRN(1))
      EQUIVALENCE (STB(1), SLA(1)), (DWA(36), TCD(1)), (DYNH(1),BD(301))
      EQUIVALENCE (STB(32), SLAH(1))
!
!***   CONTROL DATA BLOCKS
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),IDIM
      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,          &
     &                KBODY, KWING, KHT, KVT, KWB, KDWASH(3),           &
     &                ALPOW, ALPLW, ALPOH, ALPLH
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
      LOGICAL FLAG
!
!***  HYPERSONIC CONTROLS
!
      FLAG = HYPEF .AND. HYPERS .AND. (FLC(I+2) .GE. 5.0)
      IF(.NOT. (FLAG .OR. TRAJET)) GO TO 1010
!
!***  INITALIZE IOM AND COMPUTATIONAL ARRAYS
!
        IG = 1
        IF(I .NE. 1) CALL M51O63
        IF(FLAG)   CALL M42O52
        IF(TRAJET) CALL M47O57
        GO TO 1050
 1010 CONTINUE
!
!***  SET MACH DATA AND FLAGS, SET EXPERIMENTAL DATA NAMELISTS
!
      SUBSON = .FALSE.
      TRANSN = .FALSE.
      SUPERS = .FALSE.
      TRIM   = .FALSE.
      IF(FLC(I+2) .GE. TSMACH) SUPERS = .TRUE.
      IF(FLC(I+2) .LE. STMACH) SUBSON = .TRUE.
      FLAG = SUPERS .OR. SUBSON
      IF(.NOT. FLAG)           TRANSN = .TRUE.
      B(1) = FLC(I+2)
      B(2) = SQRT(ABS(1.-FLC(I+2)**2))
      BHT(1) = B(1)
      BHT(2) = B(2)
      A(129)   = FLC(I+42)
      AHT(129) = FLC(I+42)
      AVT(129) = FLC(I+42)
      AVF(129) = FLC(I+42)
      NF = 1
      IG = 1
      IF(KLIST .GT. 0) CALL M51O63
      IF(KLIST .GT. 0) CALL M48O60
!
!***  CALCULATE SUBSONIC DATA
!
      IF(.NOT. SUBSON) GO TO 1030
        IF(.NOT. LOASRT) GO TO 1020
          CALL M14O16
          CALL M49O61
          CALL M12O14
 1020   CONTINUE
        IF(LOASRT) GO TO 1030
          CALL MAIN01
 1030 CONTINUE
!
!***  CALCULATE TRANSONIC AND SUPERSONIC DATA
!
      IF(LOASRT) GO TO 1040
      IF(TRANSN) CALL MAIN03
      IF(SUPERS) CALL MAIN04
!
!***  HIGH LIFT AND CONTROL DATA
!
      TRIM = TRIMC
      FLAG = SYMFP .OR. ASYFP .OR. (TRIM .AND. HTPL .AND. SUBSON)
      IF(.NOT. FLAG) GO TO 1040
        IG = 2
        CALL M51O63
        IF(SUBSON) CALL MAIN05
        IF(TRANSN) CALL MAIN06
        IF(SUPERS) CALL MAIN07
        CALL M39O47
 1040 CONTINUE
!
!***  GROUND EFFECTS DATA
!
      FLAG= SUBSON .AND. (FLC(63) .NE. UNUSED) .AND. (.NOT. LOASRT)
      IF(FLAG) CALL MAIN02
 1050 CONTINUE
      RETURN
      END
      SUBROUTINE MAIN01
!
!***  DIGITAL DATCOM SUBSONIC AERO EXECUTIVE
!
!***  IDEAL OUTPUT MATRIX
!
!             BLOCK    PRINT     IOM
!             NAME     FLAG     ARRAY
!
      COMMON /IBODY/   PBODY,  BODY(400)
      COMMON /IWING/   PWING,  WING(400)
      COMMON /IHT/     PHT,    HT(380)
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
      COMMON /IBWH/    PBWH,   BWH(380)
      COMMON /IBWV/    PBWV,   BWV(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
      COMMON /IPOWER/  PPOWER, POWER(200)
      COMMON /IDWASH/  PDWASH, DWASH(60)
!
      LOGICAL PBODY, PWING, PHT, PVT, PVF, PBW, PBH, PBV, PBWH, PBWV,   &
     &        PBWHV, PPOWER, PDWASH
!
!***  INPUT DATA BLOCKS
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /BODYI/  BODYIN(129)
      COMMON /WINGI/  WINGIN(101)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /HTI/    HTIN(154)
      COMMON /POWER/  PWIN(29), LBIN(21)
      COMMON /FLAPIN/ F(116)
!
      DIMENSION ZL(20)
      EQUIVALENCE (ZL(1),BODYIN(102))
      LOGICAL VERTUP
!
!***  COMPUTATIONAL BLOCKS
!
      COMMON /WINGD/  A(195), B(49)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /BDATA/  BD(762)
      COMMON /WHWB/   FACT(182), WB(39), HB(39)
      COMMON /WBHCAL/ WBT(156)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55)
      COMMON /POWR/   PW(315)
      COMMON /SUPWBB/  SWB(61), SHB(61)
      COMMON /SUPDW/  DWA(237)
      COMMON /SUPWH/  GR(303)
      COMMON /SUPBOD/ SBD(229)
!
!
!***   CONTROL DATA BLOCKS
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100)
      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,          &
     &                KBODY, KWING, KHT, KVT, KWB, KDWASH(3),           &
     &                ALPOW, ALPLW, ALPOH, ALPLH
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
      LOGICAL FLAG, KDWASH
      DATA STRA/4HSTRA/
!
!***  INITALIZE IOM AND COMPUTATIONAL ARRAYS
!
      IG = 1
      CALL M51O63
      CALL EXSUBT
!
!***  SET REYNOLDS NO., CLALPA, AND CLMAX IN A-ARRAYS
!
      A(131)   = WINGIN(I+20)
      AHT(131) = HTIN(I+20)
      AVT(131) = VTIN(I+20)
      AVF(131) = VFIN(I+20)
      A(132)   = WINGIN(I+40)
      AHT(132) = HTIN(I+40)
      AVT(132) = VTIN(I+40)
      AVF(132) = VFIN(I+40)
!
!***  SINGLE COMPONENT AERO - BODY, WING, HT, AND VT
!
      IF(.NOT. BO) GO TO 1010
        FLAG = (ZL(1) .EQ. UNUSED) .OR. (BODYIN(128) .GT. 1.50)
        IF(.NOT. FLAG) CALL M04O04
        IF(   FLAG   ) CALL M06O06
 1010 CONTINUE
      IF(.NOT. WGPL) GO TO 1020
        CALL M15O17
        CALL M03O03
        CALL M31O37
        BD(69) = C(6)*A(10)
        BD(70) = BD(68)-BD(69)*BD(78)-BD(82)
        BD(71) = BD(67)-BD(69)*BD(79)
        BD(72) = (BD(71)+BD(70)*BD(80))*BD(79)
        BD(73) = (BD(70)/BD(79))-(BD(71)+BD(70)*BD(80))*BD(78)
 1020 CONTINUE
      IF(.NOT. HTPL) GO TO 1030
        CALL M16O20
        CALL M05O05
        CALL M33O41
 1030 CONTINUE
      IF(VTPL .OR. VFPL) CALL M08O10
      CALL EXSUBT
!
!***  CALCULATE B-W, B-H, AND B-V DATA
!
      FLAG = BO .AND. (WGPL .OR. HTPL .OR. VTPL .OR. VFPL)
      BD(83) = A(161) + XW
      IF(FLAG) CALL M07O07
      IF(FLAG) CALL EXSUBT
!
!***  CALCULATE B-W-H, B-W-V, AND B-W-H-V
!
      FLAG = BO .AND. WGPL .AND. (HTPL .OR. VTPL .OR. VFPL)
      IF(.NOT. FLAG) GO TO 1060
        FLAG = (KDWASH(1) .AND. KDWASH(2) .AND. KDWASH(3)) .OR.         &
     &         (WINGIN(15) .EQ. STRA)
        IF(.NOT. FLAG) GO TO 1040
          IF(WINGIN(15) .EQ. STRA .AND. HTPL)                           &
     &      CALL M09O11
          CALL M10O12
 1040   CONTINUE
        IF( FLAG) GO TO 1050
          BUILD = .TRUE.
          PART  = .TRUE.
 1050   CONTINUE
 1060 CONTINUE
!
!***  LATERAL STABILITY DERIVATIVES AND POWER EFFECTS
!
      CALL M29O35
      CALL M17O21
      IF(NF .LT. 0) GO TO 1080
      IF(PRPOWR) CALL M13O15
      IF(JETPOW) CALL M30O36
      CALL M49O61
!
!***  DYNAMIC STABILITY
!
      IF(.NOT. DAMP) GO TO 1070
        IG = 3
        CALL M51O63
        IF(WGPL) CALL M43O53
        IF(WGPL .OR. HTPL) CALL M45O55
        CALL M46O56
 1070 CONTINUE
!
!***  PRINT DATA, RETURN TO MAIN00
!
      CALL M12O14
 1080 CONTINUE
      RETURN
      END
      SUBROUTINE MAIN02
!
!***  SUBSONIC GROUND EFFECTS DATA EXECUTIVE
!
      COMMON /FLGTCD/ FLC(93), STMACH, TSMACH, TR, dumflgtcd(64)
      COMMON /FLAPIN/ F(116)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF
!
!***  FLAP AND GROUND HEIGHT LOOPS
!
      NGR = FLC(63)+0.5
      NFP = F(16)+0.5
      IF(NFP .EQ. 0)NFP=1
!
!     THIS WAS DONE IN CASE NFP=0, WITH FTN 77 (V) LOOP DOES NOT EXECUTE
!
      DO 1020 NF=1,NFP
        DO 1010 IG=1,NGR
          CALL M11O13
          CALL M12O14
 1010   CONTINUE
 1020 END DO
      RETURN
      END
      SUBROUTINE MAIN03
!
!***  TRANSONIC AERO EXECUTIVE
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /WINGI/  WINGIN(101)
      COMMON /HTI/    HTIN(154)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /LEVEL2/ SECOND(23)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
!
      LOGICAL DONE, DOL2, FLAG
      EQUIVALENCE (SECOND(15),DONE), (SECOND(16),DOL2)
!
      DATA STRA / 4HSTRA /
!
      DOL2 = ((WINGIN(15) .EQ. STRA) .OR. (.NOT. WGPL)) .AND.           &
     &       ((HTIN(15)   .EQ. STRA) .OR. (.NOT. HTPL))
      IF(DONE .OR. .NOT. DOL2) GO TO 1020
        NF = -1
        CALL M24O30
 1010   CONTINUE
        CALL M35O43
        IF(NF .GE. -5)                 CALL MAIN01
        IF(NF .EQ. -6 .OR. NF .EQ. -7) CALL MAIN04
        IF(NF .GE. -7)                 GO TO 1010
 1020 CONTINUE
      NF = 1
      IG = 1
      CALL M51O63
      CALL EXSUBT
      CALL M18O22
      IF(.NOT. BO) GO TO 1030
        CALL M06O06
        CALL M19O23
 1030 CONTINUE
      CALL M24O30
      FLAG = BO .AND. (WGPL .OR. HTPL)
      IF(DOL2) CALL M25O31
      CALL EXSUBT
      IF(FLAG) CALL M29O35
      IF(FLAG) CALL M17O21
      CALL M35O43
      CALL M49O61
!
!***  DYNAMIC STABILITY
!
      IF(.NOT. DAMP) GO TO 1040
        IG = 3
        CALL M51O63
        IF(WGPL) CALL M43O53
        CALL M46O56
 1040 CONTINUE
!
!***  PRINT DATA, RETURN TO MAIN00
!
      CALL M12O14
      DOL2 = .FALSE.
      RETURN
      END
      SUBROUTINE MAIN04
!
!***  DIGITAL DATCOM SUPERSONIC AERO EXECUTIVE
!
!***  IDEAL OUTPUT MATRIX
!
!             BLOCK    PRINT     IOM
!             NAME     FLAG     ARRAY
!
      COMMON /IBODY/   PBODY,  BODY(400)
      COMMON /IWING/   PWING,  WING(400)
      COMMON /IHT/     PHT,    HT(380)
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
      COMMON /IBWH/    PBWH,   BWH(380)
      COMMON /IBWV/    PBWV,   BWV(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
      COMMON /IPOWER/  PPOWER, POWER(200)
      COMMON /IDWASH/  PDWASH, DWASH(60)
!
      LOGICAL PBODY, PWING, PHT, PVT, PVF, PBW, PBH, PBV, PBWH, PBWV,   &
     &        PBWHV, PPOWER, PDWASH
!
!***  INPUT DATA BLOCKS
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /BODYI/  BODYIN(129)
      COMMON /WINGI/  WINGIN(101)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /HTI/    HTIN(154)
      COMMON /POWER/  PWIN(29), LBIN(21)
      COMMON /FLAPIN/ F(116)
!
      DIMENSION ZL(20)
      EQUIVALENCE (ZL(1),BODYIN(102))
      LOGICAL VERTUP
!
!***  COMPUTATIONAL BLOCKS
!
      COMMON /WINGD/  A(195), B(49)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /BDATA/  BD(762)
      COMMON /WHWB/   FACT(182), WB(39), HB(39)
      COMMON /WBHCAL/ WBT(156)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55), DVF(55)
      COMMON /POWR/   PW(315)
      COMMON /SUPWBB/  SWB(61), SHB(61)
      COMMON /SUPDW/  DWA(237)
      COMMON /SUPWH/  GR(303)
      COMMON /SUPBOD/ SBD(229)
!
      EQUIVALENCE (DWA(237),JDETCH)
!
!***   CONTROL DATA BLOCKS
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100)
      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,          &
     &                KBODY, KWING, KHT, KVT, KWB, KDWASH(3),           &
     &                ALPOW, ALPLW, ALPOH, ALPLH
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
      LOGICAL FLAG, KDWASH
      DATA STRA/4HSTRA/
!
!***  INITALIZE IOM AND COMPUTATIONAL ARRAYS
!
      IG = 1
      CALL M51O63
      CALL EXSUBT
!
!***  BYPASS SUPERSONIC AERO IF GROUND OR POWER EFFECTS PRESENT
!
      FLAG = (FLC(63) .NE. UNUSED) .OR. PRPOWR .OR. JETPOW
      IF(FLAG) GO TO 1080
!
!***  SINGLE COMPONENT AERO - BODY, WING, AND HT
!
      IF(.NOT. BO) GO TO 1010
        METHOD = BODYIN(128)+0.5
        FLAG = HYPERS .AND. (METHOD .EQ. 1)
        IF(.NOT. FLAG) CALL M19O23
        IF(FLAG)       CALL M26O32
 1010 CONTINUE
      FLAG = WGPL .OR. HTPL .OR. VTPL .OR. VFPL
      IF(FLAG) CALL M18O22
      IF(WGPL) CALL M27O33
      IF(HTPL) CALL M22O26
      CALL EXSUBT
!
!***  CALCULATE VT, B-W, B-H, B-V, AND B-W-V DATA
!
      FLAG = (VTPL .OR. VFPL) .OR. (BO .AND. (WGPL .OR. HTPL))
      IF(FLAG) CALL M20O24
      IF(FLAG) CALL EXSUBT
!
!***  CALCULATE B-W-H AND B-W-H-V
!
      FLAG = BO .AND. WGPL .AND. HTPL
      IF(.NOT. FLAG) GO TO 1040
        FLAG = (KDWASH(1) .OR. KDWASH(2) .OR. KDWASH(3)) .OR.           &
     &         (WINGIN(15) .EQ. STRA)
        IF(.NOT. FLAG) GO TO 1020
          CALL M21O25
          CALL M28O34
 1020   CONTINUE
        IF(FLAG) GO TO 1030
          BUILD = .TRUE.
          PART  = .TRUE.
          JDETCH = 0
 1030   CONTINUE
 1040 CONTINUE
!
!***  LATERAL STABILITY DERIVATIVES
!
      CALL M56O70
      LF = 0
      IF(IG .EQ. 1) GO TO 1050
        FLAG = WGPL .OR. HTPL .OR. VTPL .OR. VFPL
        IF(VTPL .OR. VFPL) CALL M32O40
        IF(FLAG)           CALL M23O27
 1050 CONTINUE
      IF(NF .LT. 0) GO TO 1080
      CALL M49O61
!
!***  DYNAMIC STABILITY
!
      IF(.NOT. DAMP) GO TO 1070
        IG = 3
        CALL M51O63
        IF(HYPERS .OR. .NOT. WGPL) GO TO 1060
          CALL M43O53
          CALL M44O54
          CALL M54O66
          CALL M45O55
 1060   CONTINUE
        CALL M46O56
 1070 CONTINUE
!
!***  PRINT DATA, RETURN TO MAIN00
!
      CALL M12O14
 1080 CONTINUE
      RETURN
      END
      SUBROUTINE MAIN05
!
!***  SUBSONIC HIGH LIFT AND CONTROL DEVICES EXECUTIVE
!
      COMMON /FLAPIN/ F(116)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART
      LOGICAL FLAG
!
!***  SYMMETRICAL FLAPS
!
      IF(.NOT. SYMFP) GO TO 1010
        JETFLP=F(74)+0.5
        IF(JETFLP .GE. 1) CALL M55O67
        IF(JETFLP .GE. 1) GO TO 1010
        F(16) = F(16)+1.0
        NDELTA = F(16)+0.5
        F(NDELTA) = 0.0
        CALL M36O44
        CALL M37O45
        CALL M38O46
        F(16) = F(16)-1.0
 1010 CONTINUE
!
!***  ASYMETRICAL FLAPS
!
      IF(.NOT. ASYFP) GO TO 1020
        IF(F(18) .EQ. 5.0) CALL M37O45
        CALL M52O64
 1020 CONTINUE
!
!***  ALL MOVEABLE HORIZONTAL TAIL TRIM
!
      FLAG = .NOT.(SYMFP .OR. ASYFP) .AND. (TRIM .AND. HTPL)
      IF(FLAG) CALL M38O46
      RETURN
      END
      SUBROUTINE MAIN06
!
!***  TRANSONIC HIGH LIFT AND CONTROL DEVICES EXECUTIVE
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /FLAPIN/ F(116)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART
      LOGICAL FLAG
!
!***  FLAP DATA
!
      IF(SYMFP) CALL M36O44
      IF(.NOT. ASYFP) GO TO 1000
        CALL M52O64
        FLAG = (F(18) .EQ. 5.0) .AND. (FLC(I+2) .LT. 1.0)
        IF(FLAG) CALL M37O45
 1000 CONTINUE
      CALL M40O50
      RETURN
      END
      SUBROUTINE MAIN07
!
!***  SUPERSONIC HIGH LIFT AND CONTROL DEVICES EXECUTIVE
!
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART
!
      IF(SYMFP) CALL M41O51
      IF(ASYFP) CALL M53O65
      RETURN
      END
      SUBROUTINE MAJERR
!
!     ----TESTS FOR MISSING ESSENTIAL NAMELISTS
!
      COMMON /FLAPIN/ F(138)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,       &
     &                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,      &
     &                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,   &
     &                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,   &
     &                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD, &
     &                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET, &
     &                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,     &
     &                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,    &
     &                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,            &
     &                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV, &
     &                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,              &
     &         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,             &
     &         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,          &
     &         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,          &
     &         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,        &
     &         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,        &
     &         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,            &
     &         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,           &
     &         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,                   &
     &         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,        &
     &         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH
      LOGICAL LOGCOM(10)
      EQUIVALENCE (LOGCOM(1),FLTC)
!
!     ----TEST FOR FLIGHT CONDITIONS IF ABSENT CANNOT RUN.
!
      IF(FLTC) GO TO 1010
      WRITE(6,1000)
 1000 FORMAT(57H0ERROR-FLIGHT CONDITIONS NOT PRESENT-MISSING NAME*FLTCON&
     &* )
      IERR=.TRUE.
!
!     ----TEST FOR SYNTHESIS QUANTITIES.IF ABSENT NO RUN.
!
 1010 IF(SYNT) GO TO 1030
      WRITE(6,1020)
 1020 FORMAT(50H0ERROR-SYNTHESIS DATA MISSING-MISSING NAME*SYNTHS* )
      IERR=.TRUE.
!
!     ----TEST FOR WING
!
 1030 IF(WGPL.AND.WGSC) GO TO 1070
!
!     ----TEST FOR PLANFORM OR SECTION CHARACTERISTICS PRESENT.
!
      IF(WGPL.OR.WGSC) GO TO 1040
      GO TO 1070
!
!     ----HERE FOR PART OF WING DATA MISSING.
!
 1040 IF(WGPL) WRITE(6,1050)
 1050 FORMAT(84H0ERROR-WING PLANFORM PRESENT BUT SECTION CHARACTERISTICS&
     & ABSENT-MISSING NAME*WGSCHR* )
      IF(WGSC) WRITE(6,1060)
 1060 FORMAT(84H0ERROR-WING SECTION CHARACTERISTICS PRESENT BUT PLANFORM&
     & ABSENT-MISSING NAME*WGPLNF* )
      IERR=.TRUE.
!
!     ----TEST FOR HORIZONTAL TAIL.
!
 1070 IF(HTSC.AND.HTPL)GO TO 1110
      IF(HTSC.OR.HTPL)GO TO 1080
      GO TO 1110
!
!     ----TEST FOR
!
 1080 IF(HTSC) WRITE(6,1090)
 1090 FORMAT(61H0MISSING PLANFORM FOR HORIZONTAL TAIL-MISSING NAME IS*HT&
     &PLNF* )
      IF(HTPL) WRITE(6,1100)
 1100 FORMAT(68H0MISSING SECTION CHARACTERISTICS FOR HORIZONTAL TAIL-NAM&
     &E IS*HTSCHR* )
      IERR=.TRUE.
!
!     ----HAVE HORIZONTAL TAIL-TEST FOR WING AND BODY
!
 1110 IF(.NOT.VTSC)GO TO 1130
      IF(VTPL) GO TO 1130
      WRITE(6,1120)
 1120 FORMAT(80H0ERROR-MUST HAVE VERTICAL TAIL PLANFORM WHEN V.T.PRESENT&
     &-MISSING NAME IS*VTPLNF* )
      IERR=.TRUE.
 1130 IF(IERR) WRITE(6,1140)
 1140 FORMAT(42H0THIS CASE ABORTED FOR THE ABOVE REASON(S) /            &
     &  34H ALL NAMES REFER TO NAMELIST NAMES )
!
      IF(.NOT. CTAB) GO TO 1160
      ITYPE = F(17)+0.5
      IF(SYMFP .AND. (ITYPE .EQ. 1)) GO TO 1160
        CTAB = .FALSE.
        WRITE(6,1150)
 1150   FORMAT(45H0 ERROR - MUST HAVE PLAIN TRAILING EDGE FLAP ,        &
     &         27HWHEN CONTROL TABS ARE INPUT,/                         &
     &         9X,40H CONTROL TAB DATA WILL NOT BE CALCULATED/)
 1160 CONTINUE
      RETURN
      END
      SUBROUTINE MASRAT(R2OBO2,R1OBA,ZHOR1,AMRK)
!
!     ----ROUTINE USES DATCOM METHOD 3 TO COMPUTE APPARENT MASS RATIO K
!
      DIMENSION ROUTID(2),Q1125B(3),Q1125C(3),Q1125E(3),Q1125F(3),      &
     &          Q1125H(3),Q1125I(3),Q1125J(3),Q1125K(3),Q1125M(3)
      LOGICAL EXACTP
      DIMENSION AN(5),C25B(6),C225U(6),R225U(5),CK(6),AK(3),ZK(3)
      DIMENSION R1125B(6),F1125B(6)
      DIMENSION R1125H(8),F1125H(8),C25H(6),R1125I(8),F1125I(8),C25I(6),&
     &          R1125J(7),F1125J(7),C25J(6),R1125K(6),F1125K(6),C25K(6)
      DIMENSION F1125M(2),R1125M(2),C25M(6)
      DIMENSION F1125C(9),R1125C(9),C25C(6),                            &
     &          F1125E(9),R1125E(9),C25E(6),F1125F(9),R1125F(9),C25F(6)
      DATA ROUTID/4HMASR,4HAT  /,                                       &
     & Q1125B /4H5.3.,4H1.1-,4H25B /,                                   &
     & Q1125C /4H5.3.,4H1.1-,4H25C /,                                   &
     & Q1125E /4H5.3.,4H1.1-,4H25E /,                                   &
     & Q1125F /4H5.3.,4H1.1-,4H25F /,                                   &
     & Q1125H /4H5.3.,4H1.1-,4H25H /,                                   &
     & Q1125I /4H5.3.,4H1.1-,4H25I /,                                   &
     & Q1125J /4H5.3.,4H1.1-,4H25J /,                                   &
     & Q1125K /4H5.3.,4H1.1-,4H25K /,                                   &
     & Q1125M /4H5.3.,4H1.1-,4H25M /
      DATA R225U /0.,0.2,0.4,0.6,0.8/
!
!     ----FIGURE 5.3.1.1-25B
!
      DATA F1125B / 1.,1.44,1.97,2.58,3.25,4.0/
      DATA R1125B / 0.,.2,.4,.6,.8,1.0/
      DATA I25B/0/
!
!     ----FIGURE 5.3.1.1-25C (PARTIAL - R1/B = 1. ONLY)
!
      DATA F1125C /.39,.96,1.3,1.9,2.28,2.56,2.77,3.0,3.9/ ,I25C /0/
      DATA R1125C/0.,.1,.2,.4,.525,.61,.675,.74,1.0/
!
!     ----FIGURE 5.3.1.1-25E (PARTIAL - R1/B = 1. ONLY)
!
      DATA R1125E /0.,.23,.33,.41,.53,.68,.7,.745,1.0/,I25E/0/
      DATA F1125E /.51,1.23,1.6,1.83,2.25,2.75,2.85,3.0,4.0/
!
!     ----FIGURE 5.3.1.1-25F (PARTIAL - R1/B = 1. ONLY)
!
      DATA R1125F /0.,.22,.32,.4,.52,.66,.7,.735,1.0/,I25F/0/
      DATA F1125F /.505,1.19,1.5,1.79,2.2,2.68,2.84,3.0,4.0/
!
!     ----FIGURE 5.3.1.1-25M (FOR R1/B=1.0 ONLY)
!
      DATA R1125M/0.,1./,F1125M/.5,5.75/,I25M/0/
!
!     -----FIGURE 5.9.1.1-25H (ONLY INCLUDES R1/B=1.)
!
      DATA R1125H/0.,.1,.15,.2,.25,.3,.5,1.0/,I25H/0/
      DATA F1125H /.5,.84,.93,.99,1.01,1.02,1.06,1.06/
!
!     -----FIGURE 5.9.1.1-25I (ONLY INCLUDES R1/B=1.)
!
      DATA R1125I /0.,.1,.2,.3,.4,.5,.6,1./,I25I/0/
      DATA F1125I /.5,.8,1.,1.1,1.18,1.2,1.22,1.23/
!
!     -----FIGURE 5.9.1.1-25J (ONLY INCLUDES R1/B=1.)
!
      DATA R1125J / 0.,.2,.3,.4,.5,.7,1.0/,I25J/0/
      DATA F1125J /.5,1.02,1.2,1.33,1.4,1.45,1.45/
!
!     -----FIGURE 5.9.1.1-25K (ONLY INCLUDES R1/B=1.)
!
      DATA R1125K /0.,.3,.4,.5,.7,1.0/,I25K/0/
      DATA F1125K /.5,1.26,1.43,1.55,1.66,1.7/
      DATA ZK/-1.,0.,1./
!
!     ----FUNCTION COMPUTES STRAIGHT LINE.
!
      PLINE(X1,X2,Y1,Y2,XV)=Y1+(XV-X1)*(Y2-Y1)/(X2-X1)
      EXACTP=.TRUE.
!
!     ----TEST FOR HORIZONTAL SURFACE POSITION ON CENTER LINE.
!
      IF(ZHOR1.EQ.0.0)GO TO 1000
!
!     ----TEST FOR HORIZONTAL SURFACE TANGENT ON SAME SIDE AS PANEL
!
      IF(ZHOR1.EQ.1.0)GO TO 1010
!
!     ----TEST FOR HORIZONTAL SURFACE TANGENT ON OPPOSITE SIDE OF PANEL.
!
      IF(ZHOR1.EQ.-1.0)GO TO 1020
      EXACTP=.FALSE.
!
!     ----HERE FOR MID POSITION OF HORIZONTAL SURFACE
!
 1000 CALL TBFUNX(R1OBA,AN(1),DMM, 6,R1125B,F1125B,C25B,I25B,M0,NG,     &
     &            0,0,Q1125B,3,ROUTID)
      CALL TBFUNX(R1OBA,AN(2),DMM, 9,R1125C,F1125C,C25C,I25C,M1,NG,     &
     &            0,0,Q1125C,3,ROUTID)
!
!     ----FIGURE 5.3.1.1-25D FOR R1/B=1. ONLY.USE 2 ST. LINES.
!
      IF(R1OBA.LE.0.74)AN(3)=PLINE(0.,.74,.52,3.0,R1OBA)
      IF(R1OBA.GT.0.74)AN(3)=PLINE(.74,1.0,3.0,4.,R1OBA)
      IF(R1OBA.LT.0.)AN(3)=.52
      IF(R1OBA.GT. 1.)AN(3)=4.
      CALL TBFUNX(R1OBA,AN(4),DMM, 9,R1125E,F1125E,C25E,I25E,M3,NG,     &
     &            0,0,Q1125E,3,ROUTID)
      CALL TBFUNX(R1OBA,AN(5),DMM, 9,R1125F,F1125F,C25F,I25F,M4,NG,     &
     &            0,0,Q1125F,3,ROUTID)
      I225U=0
      CALL TBFUNX(R2OBO2,AMRK,DMM, 5,R225U,AN,C225U,I225U,M5,NG,        &
     &            0,0,4HMID ,1,ROUTID)
      IF(EXACTP)RETURN
      AK(2)=AMRK
!
!     ----HERE FOR TAIL SAME SIDE AS ADDED PANEL
!     ----DO TABLE 5.3.1.1-25G USING EQUATION
!
 1010 AN(1)=1.0
      CALL TBFUNX(R1OBA,AN(2),DMM, 8,R1125H,F1125H,C25H,I25H,M6,NG,     &
     &            0,0,Q1125H,3,ROUTID)
      CALL TBFUNX(R1OBA,AN(3),DMM, 8,R1125I,F1125I,C25I,I25I,M7,NG,     &
     &            0,0,Q1125I,3,ROUTID)
      CALL TBFUNX(R1OBA,AN(4),DMM, 7,R1125J,F1125J,C25J,I25J,M8,NG,     &
     &            0,0,Q1125J,3,ROUTID)
      CALL TBFUNX(R1OBA,AN(5),DMM, 6,R1125K,F1125K,C25K,I25K,M9,NG,     &
     &            0,0,Q1125K,3,ROUTID)
      I225U=0
      CALL TBFUNX(R2OBO2,AMRK,DMM, 5,R225U,AN,C225U,I225U,MA,NG,        &
     &            0,0,4HSAME,1,ROUTID)
!
!     ----TEST FOR TANGENT TO BODY
!
      IF(EXACTP)RETURN
!
!     ----HERE IF NOT TANGENT TO BODY
!
      AK(3)=AMRK
!
!     ----HERE FOR TAIL LOW (OPPOSITE SIDE AS ADDED PANEL.)
!     ----FIGURE 5.3.1.1-25L . USE 2 ST. LINES
!
 1020 IF(R1OBA.LE.0.45)AN(1)=PLINE(0.,.45,1.03,3.,R1OBA)
      IF(R1OBA.GT.0.45)AN(1)=PLINE(.45,1.0,3.,6.,R1OBA)
      IF(R1OBA.LT.0.0)AN(1)=1.03
      IF(R1OBA.GT.1.0)AN(1)=6.0
      CALL TBFUNX(R1OBA,AN(2),DMM,2,R1125M,F1125M,C25M,I25M,MC,NG,      &
     &            0,0,Q1125M,3,ROUTID)
!
!     ----FIGURE 5.3.1.1-25N
!
      IF(R1OBA.LE.0.56)AN(3)=PLINE(0.,.56,.5,3.0,R1OBA)
      IF(R1OBA.GT.0.56)AN(3)=PLINE(.56,1.0,3.,5.2,R1OBA)
      IF(R1OBA.LT.0.0)AN(3)=.5
      IF(R1OBA.GT.1.0)AN(3)=5.2
!
!     ----FIGURE 5.3.1.1-25O FOR R1/B=1.0 ONLY
!
      IF(R1OBA.LE.0.63)AN(4)=PLINE(0.,.63,.5,3.,R1OBA)
      IF(R1OBA.GT.0.63)AN(4)=PLINE(.63,1.0,3.,4.7,R1OBA)
      IF(R1OBA.LT.0.)AN(4)=.5
      IF(R1OBA.GT.1.0)AN(4)=4.7
!
!     ----FIGURE 5.3.1.1-25P
!
      IF(R1OBA.LE.0.67)AN(5)=PLINE(0.,.67,.5,3.,R1OBA)
      IF(R1OBA.GT.0.67)AN(5)=PLINE(.67,1.,3.,4.5,R1OBA)
      IF(R1OBA.LT.0.)AN(5)=.5
      IF(R1OBA.GT.1.)AN(5)=4.5
      I225U=0
      CALL TBFUNX(R2OBO2,AMRK,DMM, 5,R225U,AN,C225U,I225U,MI,NG,        &
     &            0,0,4HOPST,1,ROUTID)
!
!     ----TEST FOR TANGENT TO BODY
!
      IF(EXACTP)RETURN
!
!     ----HERE IF NOT TANGENT TO BODY
!
      AK(1)=AMRK
      IK=0
!
!     ----INTERPOLATE USING 3 POINTS.
!
      CALL TBFUNX(ZHOR1,AMRK,DMM,3,ZK,AK,CK,IK,MI,NG,                   &
     &            0,0,4H3 PT,1,ROUTID)
      RETURN
      END
      SUBROUTINE MAXCL
!
!  CALCULATE CLMAX AT FLIGHT CONDITIONS
!
      COMMON /IBODY/ PB, NACA(80), BF(232), CBAR, dum(87)
      COMMON /IBWH/   PBWH,AI,ALO,CLI,ASEP,CMCO4,CLA0,CLA(20),CLMAX0,   &
     &                CLMAX(20)
      COMMON /IBWHV/  PBWHV, RHO,TMAX,DELTAY,XOVC,TOVC,COVC,CXVC,CAMBER
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
!
      DIMENSION PARM58(26),EVAL58(52),PARM59(30),EVAL59(160),           &
     &          PARM60(20),EVAL60(30),PARM61(16),EVAL61(32),            &
     &          PARM62(8),EVAL62(8),VAR(4),LEN(4),ROUT(2),C(6)
      LOGICAL CAMBER
!
      DATA PARM58 /0.,1.,1.1,1.25,1.50,2.00,2.25,2.50,3.00,3.50,4.00,   &
     &    4.50,5.00,.3,.35,.4,.45,9*0./
      DATA EVAL58 /2*.8,.81,.85,.98,1.2,1.31,1.43,1.58,1.59,1.55,1.47,  &
     &    1.42,2*.8,.81,.85,.98,1.2,1.31,1.43,1.51,1.52,1.48,1.41,1.41, &
     &    2*.8,.81,.85,.98,1.2,1.31,1.39,1.44,1.45,1.43,1.35,1.35,      &
     &    2*.8,.81,.85,.98,1.2,1.29,1.33,1.35,1.35,1.35,1.35,1.35/
      DATA PARM59 /0.,1.,1.5,2.,2.5,3.,3.5,4.,4.5,5.,0.,.02,.04,.06,    &
     &    6*0.,.15,.30,.40,.50,6*0./
      DATA EVAL59 /10*0.,                                               &
     & 0.,.12,.23,.32,.23,.12,.07,.07,.06,.03,                          &
     & 0.,.27,.36,.40,.30,.16,3*.1,.06,                                 &
     & 0.,.27,.36,.40,.30,.16,3*.1,.06,                                 &
     & 10*0.,                                                           &
     & 2*0.,.17,.22,.25,.15,.08,.06,.08,.02,                            &
     & 0.,.15,.27,.40,.33,.18,.08,.06,.07,.01,                          &
     & 0.,.53,.64,.56,.38,.22,.10,2*.06,0.,                             &
     & 10*0.,                                                           &
     & 2*0.,.05,.19,.23,.14,.07,2*.06,.02,                              &
     & 0.,.16,.27,.37,.34,.19,.10,.07,.09,.05,                          &
     & 0.,.39,.50,.50,.40,.25,.13,.10,.13,.09,                          &
     & 10*0.,                                                           &
     & 2*0.,.04,.10,.15,.14,.09,.07,.10,.08,                            &
     & 0.,.10,.19,.27,.30,.22,.15,.13,.18,.12,                          &
     & 0.,.26,.36,.43,.45,.30,.21,.20,.23,.20 /
      DATA PARM60 /0.,.25,1.,1.75,2.,2.75,3.,3.5,4.,4.5,.35,.4,.45,7*0./
      DATA EVAL60 /0.,.16,.19,.20,.18,.08,.05,-.01,-.03,-.04,           &
     &             0.,.16,.19,.20,.18,.08,.05,.03,.04,.02,              &
     &             0.,.16,.19,.20,.18,.08,.08,.10,.12,.08 /
      DATA PARM61 /0.,1.,1.5,2.,2.5,3.,3.5,4.,3.E06,6.E06,9.E06,2.5E07, &
     &    4*0./
      DATA EVAL61 /0.,-.09,2*-.13,-.09,-.11,-.20,-.24,                  &
     &             2*0.,-.08,-.07,2*-.03,-.07,-.10,                     &
     &             8*0.,0.,.12,.14,.07,.01,.11,.18,.20 /
      DATA PARM62 /0.,1.,1.5,2.,2.5,3.,3.5,4./
      DATA EVAL62 /2*0.,-.19,-.37,-.46,3*-.5/
      DATA ROUT /4HMAXC, 4HL   /
!
!  CLMAX BASE
!
      IF(ABS(XOVC-.3) .LE. 1.E-5) XOVC = .3
      VAR(1)=DELTAY
      VAR(2)=XOVC
      LEN(1)=13
      LEN(2)=4
      CALL INTERX(2,PARM58,VAR,LEN,EVAL58,CLBASE,13,52,0,0,0,0,0,0,0,0, &
     &            4HBASE,1,ROUT)
!
!  DELTA CLMAX
!
      DEL1=0.0
      DEL2=0.0
      IF(.NOT.CAMBER) GO TO 1000
      VAR(2)=COVC
      VAR(3)=CXVC
      LEN(1)=10
      LEN(2)=4
      LEN(3)=4
      CALL INTERX(3,PARM59,VAR,LEN,EVAL59,DEL1,10,200,0,0,0,0,0,0,0,0,  &
     &            4HDEL1,1,ROUT)
      IF(XOVC .EQ. 0.30) GO TO 1000
      VAR(2)=XOVC
      LEN(1)=10
      LEN(2)=3
      CALL INTERX(2,PARM60,VAR,LEN,EVAL60,DEL2,10,30,0,0,0,0,0,0,0,0,   &
     &            4HDEL2,1,ROUT)
 1000 NMACH=FLC(1)+0.5
      IN=0
      DO 1010 I=1,NMACH
         RN=FLC(I+42)*CBAR
         VAR(2)=RN
         IF(RN .LT. 1.0) VAR(2)=9.0E6
         LEN(1)=8
         LEN(2)=4
         CALL INTERX(2,PARM61,VAR,LEN,EVAL61,DEL3,8,32,0,0,0,0,0,0,0,0, &
     &               4HDEL3,1,ROUT)
         CALL TBFUNX(DELTAY,DEL4,DYDX,8,PARM62,EVAL62,C,IN,MI,NG,0,0,   &
     &               4HDEL4,1,ROUT)
         CLMAX0=CLBASE+DEL1+DEL2+DEL3
         CLMAX(I)=CLMAX0
 1010 END DO
      RETURN
      END
      SUBROUTINE MESSGE(ROUT,MESS,X1,X2,X3,X4,MSSCL)
!
!     ----THIS SUBROUTINE WRITES TO UNIT 12 WHEN EXTRAPOLATION IS
!         REQUIRED IN THE TABLE LOOKUP SUBROUTINES.
!
      COMMON /OVERLY/ NN(5),NF,NM(2),IOVLY
      
!      DIMENSION ROUT(2),MESS(1),X1(1),X2(1),X3(1),X4(1),MSSCL(21),      &
!     &          RL(21),ML(13)
      DIMENSION ROUT(2),MESS(*),X1(1),X2(1),X3(1),X4(1),MSSCL(21),      &
     &          RL(21),ML(13)

      EQUIVALENCE (RL(1),ML(1))
      IF(NF .LT. 0) RETURN
      NSTQ=MSSCL(3)
      ML(1)=MSSCL(4)
      NSTP=MSSCL(5)
      ML(2)=MSSCL(6)
      II=MSSCL(7)
      RL(6)=X1(1)
      RL(10)=X1(II)
      IF(NSTP.EQ.1)GO TO 1000
      ML(3)=MSSCL(10)
      II=MSSCL(11)
      RL(7)=X2(1)
      RL(11)=X2(II)
      IF(NSTP.EQ.2)GO TO 1000
      ML(4)=MSSCL(14)
      II=MSSCL(15)
      RL(8)=X3(1)
      RL(12)=X3(II)
      IF(NSTP.EQ.3)GO TO 1000
      ML(5)=MSSCL(18)
      II=MSSCL(19)
      RL(9)=X4(1)
      RL(13)=X4(II)
 1000 WRITE(12,1020) IOVLY,NSTQ,NSTP
      WRITE(12,1030)MSSCL(1),MSSCL(2),ROUT(1),ROUT(2),(MESS(L),L=1,NSTQ)
      DO 1010 L=1,NSTP
         WRITE(12,1040)RL(L+1),RL(L+5),RL(L+9),MSSCL(4*L+4),            &
     &        MSSCL(4*L+5)
 1010 END DO
      WRITE(12,1050) RL(1)
 1020 FORMAT(3I3)
 1030 FORMAT(24A4)
 1040 FORMAT(3E12.5,2I2)
 1050 FORMAT(E12.5)
      RETURN
      END
      SUBROUTINE NAMER(KAND,IUNIT,NLNAME,LENNLN,VNAME,DVNAME,LENVN,     &
     &                 NUMVN,VDIME,COMBLK,MAXCOM,LOC,IEOF)
!
!***  SIMULATE NAMELIST INPUT.  THE FILE ON IUNIT IS READ UNTIL THE
!***  NAMELIST DEFINED IN NLNAME IS FOUND.  IF FOUND, IT IS READ AND
!***  THE CONSTANTS ASSOCIATED WITH EACH VARIABLE ARE SET INTO THE
!***  ARRAY COMBLK.  IUNIT IS NOT REWOUND BEFORE OR AFTER EXECUTION.
!***  ALL ERROR MESSAGES ARE PRINTED TO UNIT IO (SET TO 6).
!
!   KAND - NAMELIST DELIMITER ($ ON CDC AND VAX, & ON IBM AND OTHER)
!          (BUT CAN BE SPECIFIED TO BE ANY UNIQUE CHARACTER)
!  IUNIT - TAPE UNIT FOR READING
! NLNAME - NAMELIST NAME TO FIND AND READ
! LENNLN - NUMBER OF CHARACTERS IN NAMELIST NAME (DIMENSION OF NLNAME)
!  VNAME - VARIABLE NAMES FOR THIS NAMELIST (AN ARRAY)
! DVNAME - DIMENSION OF VNAME ARRAY
!  LENVN - ARRAY WHICH DEFINES THE NUMBER OF CHARACTERS IN EACH
!          VARIABLE NAME
!  NUMVN - NUMBER OF VARIABLE NAMES DEFINED
!  VDIME - NUMBER OF CONSTANTS PERMITTED FOR EACH VARIABLE
!          (DIMENSION OF EACH VARIABLE; USE NEGATIVE FOR LOGICAL
!           VARIABLES)
! COMBLK - STARTING LOCATION FOR STORING INPUTS
!          (USUALLY THE FIRST LOCATION OF A COMMON BLOCK)
! MAXCOM - MAXIMUM DIMENSION OF STORAGE ARRAY
!          (USUALLY THE LENGTH OF THE COMMON BLOCK)
!    LOC - POINTER TO STORAGE ARRAY FOR THE STARTING LOCATION
!          OF EACH INPUT VARIABLE (IF ZERO THE CONSTANT IS NOT STORED)
!   IEOF - .TRUE. IF AN END-OF-FILE WAS DETECTED DURING READ
!
!***  NOTES -
!
!***  ALL INPUT STRING ARRAYS MUST BE DECLARED INTEGER
!
!***  ALL VARIABLES ARE ASSUMMED TO BE REAL; IF VDIME IS NEGATIVE
!***  THE VARIABLE IS ASSUMMED TO BE LOGICAL.  ALTHOUGH THE CODE IS
!***  DESIGNED TO HANDLE INTEGERS AS WELL, THIS OPTION IS NOT
!***  CURRENTLY USED.  IT CAN BE ACTIVATED BY PASSING ANOTHER ARRAY,
!***  VTYPE, TO DEFINE THE TYPE OF VARIABLE, WITH THE CODE
!***  0=LOGICAL, 1=INTEGER, OR 2=REAL; THEN REPLACE THE NAME VTYPE
!***  WITH THE NAME VTYPE(NVN) IN THE REMAINING CODE.
!
!***  THIS ROUTINE CAN BE USED AS A NAMELIST ERROR CHECKER BY SETTING
!***  THE ARRAY LOC TO ALL ZEROS.  THE VARIABELS AND CONSTANTS WILL
!***  BE READ, BUT THE CONSTANTS NOT STORED.
!
      INTEGER EQUAL,COMMA,BLANK,VNAME,DVNAME,VTYPE,VDIME,PARL,PARR
      INTEGER CARET
!
      LOGICAL IEOF,LANS,SEARCH,FOUND,IEND
!
      DIMENSION NLNAME(LENNLN),VNAME(DVNAME),LENVN(NUMVN),              &
     &          VDIME(NUMVN),COMBLK(MAXCOM),LOC(NUMVN)
      DIMENSION INUMS(13),KOL(80),INAME(80),IDIM(80),INLN(80),          &
     &          ICONST(80),KERR(80)
!
      DATA BLANK / 4H     /
      DATA EQUAL / 4H=    /
      DATA COMMA / 4H,    /
      DATA PARL  / 4H(    /
      DATA PARR  / 4H)    /
      DATA CARET / 4H^    /
      DATA INUMS / 4H0   ,4H1   ,4H2   ,4H3   ,4H4   ,4H5   ,4H6   ,    &
     &             4H7   ,4H8   ,4H9   ,4H+   ,4H-   ,4H.   /
      DATA IO    / 6 /
!
!******************************************************************
!***  STAGE 1 - READ CARD AND CHECK FOR KAND AS FIRST CHARACTER ***
!******************************************************************
!
 1000 IEND=.FALSE.
      DO 1010 I=1,80
         INLN(I)=BLANK
         KERR(I)=BLANK
 1010 END DO
!
!***  READ CARD FROM IUNIT
!
 1020 CALL READCD(IUNIT, KOL, IEOF)
      IF(IEOF)GO TO 1290
!
!***  SKIP LEADING BLANKS
!
      ICOL=1
      CALL SKIPBL(KOL, ICOL)
      IF(ICOL .GT. 80)GO TO 1020
!
!***  LOOK FOR KAND FIRST, ELSE READ NEXT CARD
!
      IF(KOL(ICOL) .NE. KAND)GO TO 1020
!
!********************************************************
!***  STAGE 2 - CHECK IF NAMELIST READ IS ONE DESIRED ***
!********************************************************
!
! ... EXTRACT NAMELIST NAME TO BLANK
!
      ICOL=ICOL+1
      LCOL=ICOL
      IECOL=ICOL
      CALL FINDCH(KOL, BLANK, LCOL)
      IF(LCOL .EQ. ICOL)GO TO 1040
!
      CALL EXTRST(KOL, ICOL, LCOL-1, INLN)
!
! ... CHECK FOR NAME MATCH
!
      DO 1030 I=1,LENNLN
         IF(INLN(I) .NE. NLNAME(I))GO TO 1050
 1030 END DO
      ICOL=LCOL
      GO TO 1060
!
!***  KAND FOUND BUT NO NAMELIST NAME FOUND
!
 1040 CONTINUE
!
      WRITE(IO,1310)(KOL(I),I=1,80)
      KERR(IECOL)=CARET
      WRITE(IO,1410)(KERR(I),I=1,80)
      GO TO 1300
!
!***  NAMELIST NAME DESIRED NOT FOUND, READ UNTIL KAND SEEN AGAIN
!***  (SKIP UNTIL END OF THIS NAMELIST INPUT)
!
 1050 CALL FINDCH(KOL, KAND, ICOL)
      IF(ICOL .LE. 80)GO TO 1000
!
! ... READ CARD FROM IUNIT
!
      CALL READCD(IUNIT, KOL, IEOF)
      IF(IEOF)GO TO 1290
      ICOL=1
      GO TO 1050
!
!****************************************
!***  STAGE 3 - EXTRACT VARIABLE NAME ***
!****************************************
!
 1060 SEARCH=.TRUE.
      IOFF=0
!
      DO 1070 I=1,80
         INAME(I)=BLANK
         IDIM(I)=BLANK
         KERR(I)=BLANK
 1070 END DO
!
! ... SKIP BLANKS
!
      CALL SKIPBL(KOL, ICOL)
!
      IF(ICOL .LT. 81)GO TO 1080
!
! ... READ CARD FROM IUNIT
!
      CALL READCD(IUNIT, KOL, IEOF)
      IF(IEOF)GO TO 1290
      ICOL=1
!
      CALL SKIPBL(KOL, ICOL)
!
 1080 IF(KOL(ICOL) .EQ. KAND .OR. IEND)GO TO 1290
!
! ... EXTRACT TO =
!
      LCOL=ICOL
      IECOL=ICOL
      CALL FINDCH(KOL, EQUAL, LCOL)
!
      IF(LCOL .LT. 81)GO TO 1090
!
         WRITE(IO,1320)(KOL(I),I=1,80)
         KERR(IECOL)=CARET
         WRITE(IO,1410)(KERR(I),I=1,80)
         GO TO 1300
!
 1090 KNAME=ICOL
      IECOL=KNAME
      CALL EXTRST(KOL, ICOL, LCOL-1, INAME)
!
! ... LOOK FOR ( IN VARIABLE STRING
!
      KK=1
      CALL FINDCH(INAME, PARL, KK)
      IF(KK .GT. 80)GO TO 1130
!
! ... HAVE SUBSCRIPT DEFINED, NOW LOOK FOR )
!
      LL=KK
      CALL FINDCH(INAME, PARR, LL)
!
      IF(LL .LT. 81)GO TO 1100
!
         WRITE(IO,1330)(KOL(I),I=1,80)
         KERR(IECOL)=CARET
         WRITE(IO,1410)(KERR(I),I=1,80)
         GO TO 1300
!
! ... EXTRACT SUBSCRIPT (OFFSET)
!
 1100 CALL EXTRST(INAME, KK+1, LL-1, IDIM)
      KSUB=KNAME+KK
      IECOL=KSUB
!
! ... BLANK ( TO ) IN VARIABLE NAME
!
      DO 1110 I=KK,LL
         INAME(I)=BLANK
 1110 END DO
!
! ... CONVERT OFFSET
!
      CALL TOINT(IDIM, IOFF, IERR)
!
! ... CHECK IF SUBSCRIPT VALID
!
      IF(.NOT.(IERR .NE. 0 .OR. IOFF .LT. 1))GO TO 1120
!
      WRITE(IO,1370)(KOL(I),I=1,80)
      KERR(IECOL)=CARET
      WRITE(IO,1410)(KERR(I),I=1,80)
      GO TO 1300
!
 1120 IOFF=IOFF-1
!
 1130 CONTINUE
!
      ICOL=LCOL+1
!
 1140 IF(KOL(ICOL) .EQ. KAND)IEND=.TRUE.
!
      DO 1150 I=1,80
         ICONST(I)=BLANK
 1150 END DO
!
!***********************************
!***  STAGE 4 - EXTRACT CONSTANT ***
!***********************************
!
! ... EXTRACT TO COMMA OR KAND
!
      LCOL=ICOL
      KCONS=ICOL
      IECOL=KCONS
      CALL FINDCH(KOL, COMMA, LCOL)
!
      IF(LCOL .LT. 81)GO TO 1160
!
! ... COMMA NOT THERE, SEARCH FOR KAND
!
         LCOL=ICOL
         CALL FINDCH(KOL, KAND, LCOL)
!
         IF(LCOL .LT. 81)IEND=.TRUE.
         IF(LCOL .LT. 81)GO TO 1160
!
! ...    NEITHER COMMA NOR KAND, ASSUME COMMA
!
!           CALL FINDCH(KOL, BLANK, IECOL)
!           WRITE(IO,1340)KAND,(KOL(I),I=1,80)
!           KERR(IECOL)=CARET
!           WRITE(IO,1410)(KERR(I),I=1,80)
!
 1160 CALL EXTRST(KOL, ICOL, LCOL-1, ICONST)
!
! ... EXTRACT REPEAT COUNT SPECIFIED IN CONSTANT
!
      IECOL=KCONS
      CALL REPTCT(ICONST, IREPT, IERR)
!
      IF(IERR .EQ. 0 .AND. IREPT .GT. 0)GO TO 1170
!
      WRITE(IO,1390)(KOL(I),I=1,80)
      KERR(IECOL)=CARET
      WRITE(IO,1410)(KERR(I),I=1,80)
      GO TO 1300
!
 1170 ICOL=LCOL+1
!
!*************************************
!***  STAGE 5 - FIND VARIABLE NAME ***
!*************************************
!
! ... SEARCH FOR VARIABLE NAME IN VNAME ARRAY
!
      IECOL=KNAME
      IF(SEARCH)CALL FINDVN(NUMVN, LENVN, INAME, VNAME, DVNAME, NVN,    &
     & FOUND)
!
      IF(.NOT.(SEARCH .AND. .NOT. FOUND))GO TO 1180
!
      WRITE(IO,1350)(KOL(I),I=1,80)
      KERR(IECOL)=CARET
      WRITE(IO,1410)(KERR(I),I=1,80)
      GO TO 1300
!
! ... CHECK VARIABLE DIMENSION LIMIT
!
 1180 IECOL=KCONS
!
      IF(.NOT.((IOFF+1) .GT. IABS(VDIME(NVN))))GO TO 1190
!
      WRITE(IO,1370)(KOL(I),I=1,80)
      KERR(IECOL)=CARET
      WRITE(IO,1410)(KERR(I),I=1,80)
      GO TO 1300
!
 1190 LANS=.FALSE.
      IANS=0
      ANS=0.
!
!**************************************
!***  STAGE 6 - SUBSTITUTE CONSTANT ***
!**************************************
!
! ... CONVERT CONSTANT DEPENDING ON TYPE
!
      IECOL=KCONS
!
! ... A NEGATIVE DIMENSION MEANS LOGICAL
! ... ELSE VARIABLE TYPE IS REAL
!
      IF(VDIME(NVN) .LT. 0)VTYPE=0
      IF(VDIME(NVN) .GT. 0)VTYPE=2
!
      IF(VTYPE .EQ. 0)CALL TOLOG(ICONST, LANS, IERR)
      IF(VTYPE .EQ. 1)CALL TOINT(ICONST, IANS, IERR)
      IF(VTYPE .EQ. 2)CALL TODEC(ICONST,  ANS, IERR)
!
      IF(IERR .EQ. 0)GO TO 1220
!
      IF(VTYPE .EQ. 1)GO TO 1200
!
         WRITE(IO,1390)(KOL(I),I=1,80)
         KERR(IECOL)=CARET
         WRITE(IO,1410)(KERR(I),I=1,80)
         GO TO 1300
!
 1200 IF(IERR .EQ. 1 .AND. VTYPE .NE. 1)GO TO 1210
!
         WRITE(IO,1390)(KOL(I),I=1,80)
         KERR(IECOL)=CARET
         WRITE(IO,1410)(KERR(I),I=1,80)
         GO TO 1300
!
 1210 IF(IERR .EQ. 2 .AND. VTYPE .NE. 1)GO TO 1220
!
!        WRITE(IO,1400)(KOL(I),I=1,80)
!        KERR(IECOL)=CARET
!        WRITE(IO,1410)(KERR(I),I=1,80)
!
! ... SUBSTITUTE CONSTANT
!
 1220 DO 1250 I=1,IREPT
!
! ...    CHECK VARIABLE DIMENSION LIMIT
!
         IF((I+IOFF) .LE. IABS(VDIME(NVN)))GO TO 1230
!
            IECOL=KCONS
            WRITE(IO,1380)(KOL(J),J=1,80)
            KERR(IECOL)=CARET
            WRITE(IO,1410)(KERR(J),J=1,80)
            GO TO 1300
!
 1230    IF(LOC(NVN) .LT. 1)GO TO 1250
         II=LOC(NVN)+I+IOFF-1
!
! ...    CHECK DATA BLOCK SIZE LIMIT
!
         IF(II .LE. MAXCOM)GO TO 1240
!
            WRITE(IO,1360)(KOL(J),J=1,80)
            KERR(IECOL)=CARET
            WRITE(IO,1410)(KERR(J),J=1,80)
            GO TO 1300
!
! ...    SUBSTITUTE CONSTANT DEPENDING ON TYPE
!
 1240    IF(VTYPE .EQ. 0)CALL SUBLOG(COMBLK(II), LANS)
         IF(VTYPE .EQ. 1)CALL SUBINT(COMBLK(II), IANS)
         IF(VTYPE .EQ. 2)CALL SUBREA(COMBLK(II),  ANS)
!
 1250 END DO
!
! ... UPDATE OFFSET IN CASE NEXT INPUT IS A CONSTANT INSTEAD OF A
! ... VARIABLE NAME
!
      IOFF=IOFF+IREPT
!
! ... CHECK IF NEXT INPUT IS A NUMERIC OR LOGICAL
!
      CALL SKIPBL(KOL, ICOL)
!
! ... IF KAND PREVIOUSLY DETECTED, EXIT
!
      IF(IEND)GO TO 1290
!
      IF(ICOL .LT. 81)GO TO 1260
!
! ... READ NEXT CARD
!
      CALL READCD(IUNIT, KOL, IEOF)
      IF(IEOF)GO TO 1290
      ICOL=1
!
      CALL SKIPBL(KOL, ICOL)
!
! ... CHECK IF NEXT NON-BLANK CHARACTER SPECIFIES A NUMERIC OR
! ... LOGICAL INPUT
!
 1260 DO 1270 I=1,13
         IF(KOL(ICOL) .EQ. INUMS(I))GO TO 1280
 1270 END DO
!
! ... NO, SEARCH FOR NEXT VARIABLE NAME INPUT
!
      IERR=0
      GO TO 1060
!
! ... YES, SEARCH FOR NEXT INPUT CONSTANT
!
 1280 SEARCH=.FALSE.
      IERR=0
      GO TO 1140
!
 1290 CONTINUE
!
      RETURN
!
 1300 WRITE(IO,1420)
      STOP
!
 1310 FORMAT(26H0*** NAMELIST INPUT ERROR.,                             &
     & 51H  ILLEGAL/INCORRECT SPECIFICATION OF NAMELIST NAME.,          &
     & /,1X,80A1)
 1320 FORMAT(26H0*** NAMELIST INPUT ERROR.,                             &
     & 36H  NO EQUALS FOLLOWING VARIABLE NAME.,/,1X,80A1)
 1330 FORMAT(26H0*** NAMELIST INPUT ERROR.,                             &
     & 51H  NO CLOSING RIGHT PARENTHESIS IN ARRAY DEFINITION.,          &
     & /,1X,80A1)
!1340 FORMAT(26H0*** NAMELIST INPUT ERROR.,
!    1 26H  NO TERMINATING COMMA OR ,A1,16H AFTER CONSTANT.,
!    2 27H  A COMMA HAS BEEN ASSUMED.,/,1X,80A1)
 1350 FORMAT(26H0*** NAMELIST INPUT ERROR.,                             &
     & 32H  VARIABLE NAME NOT IN NAMELIST.,/,1X,80A1)
 1360 FORMAT(26H0*** NAMELIST INPUT ERROR.,                             &
     & 57H  ARRAY SUBSCRIPT OR NUMBER OF CONSTANTS EXCEEDS VARIABLE,    &
     & 32H DIMENSION OR COMMON BLOCK SIZE.,/,1X,80A1)
 1370 FORMAT(26H0*** NAMELIST INPUT ERROR.,                             &
     & 34H  ILLEGAL/INVALID ARRAY SUBSCRIPT.,/,1X,80A1)
 1380 FORMAT(26H0*** NAMELIST INPUT ERROR.,                             &
     & 48H  REPEAT COUNT EXCEEDS VARIABLE ARRAY DIMENSION.,/,1X,80A1)
 1390 FORMAT(26H0*** NAMELIST INPUT ERROR.,                             &
     & 49H  CONSTANT DOES NOT MATCH TYPE OF INPUT REQUIRED.,/,1X,80A1)
!1400 FORMAT(26H0*** NAMELIST INPUT ERROR.,
!    1 47H  REAL NUMBER SPECIFIED FOR INTEGER, CONVERTED.,/,1X,80A1)
 1410 FORMAT(1X,80A1)
 1420 FORMAT(49H0*** EXECUTION TERMINATING DUE TO NAMELIST ERROR.)
!
      END

      SUBROUTINE NAMEW(KAND,IUNIT,NLNAME,LENNLN,VNAME,DVNAME,LENVN,     &
     &                 NUMVN,VDIME,COMBLK,MAXCOM,LOC)
!
!***  SIMULATE NAMELIST OUTPUT.
!
!   KAND - NAMELIST DELIMITER ($ ON CDC AND VAX, & ON IBM AND OTHER)
!          (BUT CAN BE SPECIFIED TO BE ANY UNIQUE CHARACTER)
!  IUNIT - TAPE UNIT FOR WRITING NAMELIST DATA
! NLNAME - NAMELIST NAME TO WRITE
! LENNLN - NUMBER OF CHARACTERS IN NAMELIST NAME (DIMENSION OF NLNAME)
!  VNAME - VARIABLE NAMES FOR THIS NAMELIST (AN ARRAY)
! DVNAME - DIMENSION OF VNAME ARRAY
!  LENVN - ARRAY WHICH DEFINES THE NUMBER OF CHARACTERS IN EACH
!          VARIABLE NAME
!  NUMVN - NUMBER OF VARIABLE NAMES DEFINED
!  VDIME - NUMBER OF CONSTANTS PERMITTED FOR EACH VARIABLE
!          (DIMENSION OF EACH VARIABLE; USE NEGATIVE FOR LOGICAL
!           VARIABLES)
! COMBLK - STARTING LOCATION FOR RESULTS
!          (USUALLY THE FIRST LOCATION OF A COMMON BLOCK)
! MAXCOM - MAXIMUM DIMENSION OF STORAGE ARRAY
!          (USUALLY THE LENGTH OF THE COMMON BLOCK)
!    LOC - POINTER TO STORAGE ARRAY FOR THE STARTING LOCATION
!          OF EACH INPUT VARIABLE (IF ZERO THE CONSTANT IS NOT PRINTED)
!
!***  NOTES -
!
!***  ALL INPUT STRING ARRAYS MUST BE DECLARED INTEGER
!
!***  ALL VARIABLES ARE ASSUMMED TO BE REAL; IF VDIME IS NEGATIVE
!***  THE VARIABLE IS ASSUMMED TO BE LOGICAL.  ALTHOUGH THE CODE IS
!***  DESIGNED TO HANDLE INTEGERS AS WELL, THIS OPTION IS NOT
!***  CURRENTLY USED.  IT CAN BE ACTIVATED BY PASSING ANOTHER ARRAY,
!***  VTYPE, TO DEFINE THE TYPE OF VARIABLE, WITH THE CODE
!***  0=LOGICAL, 1=INTEGER, OR 2=REAL; THEN REPLACE THE NAME VTYPE
!***  WITH THE NAME VTYPE(NVN) IN THE REMAINING CODE.
!
!***  IF ANY ELEMENT OF ARRAY LOC IS ZERO, THAT VARIABLE WILL NOT
!***  BE INCLUDED IN THE LISTING.
!
      INTEGER VNAME,DVNAME,VTYPE,VDIME,BLANK,EQUAL
!
      DIMENSION NLNAME(LENNLN),VNAME(DVNAME),LENVN(NUMVN),              &
     &          VDIME(NUMVN),COMBLK(MAXCOM),LOC(NUMVN)
      DIMENSION KOL(8)
!
      DATA BLANK / 4H     /
      DATA EQUAL / 4H=    /
!
      WRITE(IUNIT,1030)KAND,(NLNAME(I),I=1,LENNLN)
!
      INDX=1
!
      DO 1020 NVN=1,NUMVN
!
         IF(NVN .GT. 1)INDX=INDX+MAXC
!
         MAXC=LENVN(NVN)
!
         DO 1000 J=1,8
            KOL(J)=BLANK
 1000    CONTINUE
!
         DO 1010 I=1,MAXC
            KOL(I)=VNAME(I+INDX-1)
 1010    CONTINUE
!
         KOL(8)=EQUAL
!
         KK=LOC(NVN)
         IF(KK .LT. 1)GO TO 1020
         JJ=IABS(VDIME(NVN))
!
! ... A NEGATIVE DIMENSION MEANS LOGICAL
! ... ELSE VARIABLE TYPE IS REAL
!
         IF(VDIME(NVN) .LT. 0)VTYPE=0
         IF(VDIME(NVN) .GT. 0)VTYPE=2
!
         IF(VTYPE .EQ. 0)CALL FORLOG(IUNIT, KOL, COMBLK(KK), JJ)
         IF(VTYPE .EQ. 1)CALL FORINT(IUNIT, KOL, COMBLK(KK), JJ)
         IF(VTYPE .EQ. 2)CALL FORREA(IUNIT, KOL, COMBLK(KK), JJ)
!
 1020 END DO
!
      WRITE(IUNIT,1040)KAND
!
      RETURN
!
 1030 FORMAT(1H1,8A1)
 1040 FORMAT(1H0,A1,3HEND)
!
      END

      SUBROUTINE NMLIST(KOL,L,NAME,K,IER)
!
!***  PASS NAMELIST NAMES TO TESTOR FOR CHECKING
!
      DIMENSION KOL(80)
      COMMON /IBODY/   PBODY, LEN2(18),LDM2(18),FLTCON(81), dum1(283)
      COMMON /BODYI/          LEN3(4) ,LDM3(4) ,OPTINS(20), dum2(101)
      COMMON /IHT/     PHT,   LEN4(15),LDM4(15),BODY(44), dum3(306)
      COMMON /IVT/     PVT,   LEN5(21),LDM5(21),PLNF(103), dum4(235)
      COMMON /IBW/     PBW,   LEN6(36),LDM6(36),SCHR(170), dum5(138)
      COMMON /IBH/     PBH,   LEN7(19),LDM7(19),SYNTHS(60), dum6(282)
      COMMON /IBV/     PBV,   LENC(14),LDMC(14),PRPOWR(78)
      COMMON /IBWH/    PBWH,  LEND(15),LDMD(15),JETPWR(89)
      COMMON /IBWV/    PBWV,  LENE(21),LDME(21),LARWB(89)
      COMMON /IPOWER/  PPOWR, LENF(2) ,LDMF(2) ,GRNDEF(8)
      COMMON /IDWASH/  PDWAS, LENG(8) ,LDMG(8) ,TVTPAN(23)
      COMMON /IBWHV/   PBWHV, LENH(32),LDMH(32),EXPR(131)
      COMMON /IWING/   PWING, LENI(27),LDMI(27),SYMFLP(139),dum13(207)
      COMMON /VTI/            LENJ(14),LDMJ(14),ASYFLP(78)
      COMMON /WINGI/          LENK(7) ,LDMK(7) ,HYPEFF(32)
      COMMON /HTI/            LENL(12),LDML(12),TRNJET(38)
      COMMON /IVF/     PVF,   LENM(22),LDMM(22),CONTAB(76)
!
      INTEGER FLTCON, OPTINS, BODY, PLNF, SCHR, PRPOWR, SYNTHS,         &
     &        JETPWR, LARWB, GRNDEF, TVTPAN, EXPR, SYMFLP,              &
     &        ASYFLP, HYPEFF, TRNJET
!
!***  PASS CORRECT NAMELIST VARIABLES TO TESTOR FOR NAME
!***  AND SYNTAX VERIFICATION
!
      IF(IER .EQ. 1) NAME = 1
      GO TO (1010, 1010, 1020, 1030, 1040, 1050, 1060,                  &
     &       1040, 1050, 1040, 1050, 1070, 1080, 1090,                  &
     &       1100, 1110, 1120, 1130, 1140, 1150, 1160,                  &
     &       1165, 1050, 1040) , NAME
!
 1010 CALL TESTOR(KOL,L,NAME,K,IER,LEN2,LDM2,18,FLTCON)
      GO TO 1170
!
 1020 CALL TESTOR(KOL,L,NAME,K,IER,LEN3,LDM3, 4,OPTINS)
      GO TO 1170
!
 1030 CALL TESTOR(KOL,L,NAME,K,IER,LEN4,LDM4,15,BODY)
      GO TO 1170
!
 1040 CALL TESTOR(KOL,L,NAME,K,IER,LEN5,LDM5,21,PLNF)
      GO TO 1170
!
 1050 CALL TESTOR(KOL,L,NAME,K,IER,LEN6,LDM6,36,SCHR)
      GO TO 1170
!
 1060 CALL TESTOR(KOL,L,NAME,K,IER,LEN7,LDM7,19,SYNTHS)
      GO TO 1170
!
 1070 CALL TESTOR(KOL,L,NAME,K,IER,LENC,LDMC,14,PRPOWR)
      GO TO 1170
!
 1080 CALL TESTOR(KOL,L,NAME,K,IER,LEND,LDMD,15,JETPWR)
      GO TO 1170
!
 1090 CALL TESTOR(KOL,L,NAME,K,IER,LENE,LDME,21,LARWB)
      GO TO 1170
!
 1100 CALL TESTOR(KOL,L,NAME,K,IER,LENF,LDMF, 2,GRNDEF)
      GO TO 1170
!
 1110 CALL TESTOR(KOL,L,NAME,K,IER,LENG,LDMG, 8,TVTPAN)
      GO TO 1170
!
 1120 CALL TESTOR(KOL,L,NAME,K,IER,LENH,LDMH,32,EXPR)
      GO TO 1170
!
 1130 CALL TESTOR(KOL,L,NAME,K,IER,LENI,LDMI,27,SYMFLP)
      GO TO 1170
!
 1140 CALL TESTOR(KOL,L,NAME,K,IER,LENJ,LDMJ,14,ASYFLP)
      GO TO 1170
!
 1150 CALL TESTOR(KOL,L,NAME,K,IER,LENK,LDMK, 7,HYPEFF)
      GO TO 1170
!
 1160 CALL TESTOR(KOL,L,NAME,K,IER,LENL,LDML,12,TRNJET)
      GO TO 1170
!
 1165 CALL TESTOR(KOL,L,NAME,K,IER,LENM,LDMM,22,CONTAB)
!
 1170 CONTINUE
      RETURN
      END

      LOGICAL FUNCTION NMTEST(KOL,KEY,NCHAR)
!
!***  CHECK NAMELIST NAMES
!
      INTEGER KOL(1) , KEY(1)
!
!     ----TEST FOR NAME IN KEY = NAME IN KOL, NCHAR = NO. OF CHARACTERS
!
      DO 1000 I=1,NCHAR
         IF(KOL(I).NE.KEY(I)) GO TO 1010
 1000 END DO
!
!     ----HERE IF NAME CHECKS
!
      NMTEST=.TRUE.
      RETURN
!
!     ----HERE IF NAME DOES NOT CHECK
!
 1010 NMTEST=.FALSE.
      RETURN
      END
      SUBROUTINE OUTPT2
!
!     THIS SUBROUTINE WRITES THE HIGH LIFT AND CONTROL DATA
!
      COMMON /FLAPIN/ F(138)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ OPT(4)
      COMMON /CONSNT/ PI, DEG, UNUSED, RAD,kand
      COMMON /POWR/   PW(315)
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA,IG,NF,LF,K
      COMMON /WINGI/  WINGIN(101)
      COMMON /HTI/    HTIN(131)
      COMMON /BDATA/  BD(762)
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),IDIM
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      DIMENSION TRM(22), TRM2(22), ALPHA(20)
      EQUIVALENCE (TRM(1),TRM2(1),PW(294)), (ALPHA(1),FLC(23))
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL NDMF,NAF,FLAG
!
      COMMON /IBODY/  PBODY, BODY(400)
      COMMON /IWING/  PWING, WING(400)
      COMMON /IHT/    PHT,   HT(380)
      COMMON /IVT/    PVT,   VT(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
      COMMON /IBWH/    PBWH,   BWH(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
!
!     SYMMETRICAL FLAP DATA DEFINITION
!
      DIMENSION DCDI(200), DCL(10), DCM(10), DCLMAX(10), DCDMIN(10),    &
     &          DCLAD(10), CHA(10), CHD(10)
      DIMENSION DELTA(10)
      EQUIVALENCE (DCDI(1),BODY(201)), (DCL(1),WING(201)),              &
     &          (DCM(1),WING(211)), (DCLMAX(1),WING(221)),              &
     &          (DCDMIN(1),WING(231)), (DCLAD(1),WING(241)),            &
     &          (CHA(1),WING(251)), (CHD(1),WING(261))
      EQUIVALENCE (DELTA(1),F(1)), (FTYPE,F(17))
!
!     CONTROL TAB DATA DEFINITION
!
      DIMENSION CHCTF(20,9),CHCTL(20,9),DCHCG(20,9),CFC(20,9),          &
     &          FC(20,9),DTT(20,9)
      EQUIVALENCE (CFC(1,1),FC(1,1),BW(201)),(CHCTF(1,1),BH(201)),      &
     &            (CHCTL(1,1),BV(201)),(DCHCG(1,1),BWH(201)),           &
     &            (DTT(1,1),BWHV(201))
!
!     ASYMMETRICAL FLAP DATA DEFINITION
!
      DIMENSION CNAD(200), CLAD(200), DDELTA(10), CLD(10), CND(10)
      DIMENSION DELTAD(10), DELTAL(10), DELTAR(10), DELTAS(10),         &
     &          XSOC(10), HSOC(10)
      EQUIVALENCE (CNAD(1),BODY(201)), (CLAD(1),WING(201)),             &
     &          (DELTAD(1),F(1)), (STYPE,F(18)), (DELTAL(1),F(19)),     &
     &          (DELTAR(1),F(29)), (DELTAS(1),F(39)),                   &
     &          (XSOC(1),F(49)), (HSOC(1),F(60)), (DDELTA(1),HT(201)),  &
     &          (CLD(1),HT(211)), (CND(1),HT(221))
!
!     TRIM DATA DEFINITION
!
      DIMENSION CLUT(20), CDUT(20), CMUT(20), DELT(20), DCLT(20),       &
     &          DCLMT(20), DCDIT(20), DCDMT(20), CHAT(20), CHDT(20)
      DIMENSION HMUNT(20), ALINT(20), CDTRM(20), CLTRM(20), CMTRM(20),  &
     &          HMTRM(20), CDWBT(20), CLWBT(20)
      EQUIVALENCE (CLUT(1),HT(201)), (CDUT(1),HT(221)),                 &
     &          (CMUT(1),HT(241)), (DELT(1),VT(201)), (DCLT(1),VT(221)),&
     &          (DCLMT(1),VT(241)), (DCDIT(1),VT(261)),                 &
     &          (DCDMT(1),VT(281)), (CHAT(1),VT(301)),                  &
     &          (CHDT(1),VT(321))
      EQUIVALENCE (HMUNT(1),HT(201)), (ALINT(1),HT(221)),               &
     &          (CDTRM(1),HT(241)), (CLTRM(1),HT(261)),                 &
     &          (CMTRM(1),HT(281)), (HMTRM(1),HT(301)),                 &
     &          (CDWBT(1),VT(201)), (CLWBT(1),VT(221))
      DIMENSION FOR(34), IFOR(8)
      DIMENSION FOT(46), IFOT(11)
      DIMENSION IFOH(11), FOH(46)
!
      DATA FOR /                                                        &
     &  4H(0P ,   4H5X  ,   4H,1X ,   4H,F5.,   4H1,1X,   4H,2X ,       &
     &  4H,1X ,   4H,F6.,   4H3   ,   4H,4X ,                           &
     &  4H    ,   4H,F7.,   4H4   ,   4H,3X ,                           &
     &  4H,1X ,   4H,F6.,   4H3   ,   4H,6X ,                           &
     &  4H    ,   4H,F7.,   4H5   ,   4H,15X,                           &
     &  4H,1P ,   4H E10,   4H.3  ,   4H,2X ,                           &
     &  4H,1P ,   4H E10,   4H.3  ,   4H,2X ,                           &
     &  4H,1P ,   4H E10,   4H.3  ,   4H)   /
      DATA IFOR / 5*7, 3*10 /
!
      DATA FOT /                                                        &
     &  4H(0P ,   4H4X  ,   4H,1X ,   4H,F5.,   4H1,1X,   4H,1X ,       &
     &  4H,1X ,   4H,F6.,   4H3   ,   4H,3X ,                           &
     &  4H,1X ,   4H,F6.,   4H3   ,   4H,3X ,                           &
     &  4H    ,   4H,F7.,   4H4   ,   4H,2X ,                           &
     &  4H,1X ,   4H,F5.,   4H1,1X,   4H,1X ,                           &
     &  4H,1X ,   4H,F6.,   4H3   ,   4H,4X ,                           &
     &  4H,1X ,   4H,F6.,   4H3   ,   4H,5X ,                           &
     &  4H,1P ,   4H E9.,   4H2   ,   4H,2X ,                           &
     &  4H,0P ,   4H F8.,   4H5,1X,   4H,2X ,                           &
     &  4H,1P ,   4H E10,   4H.3  ,   4H,3X ,                           &
     &  4H,1P ,   4H E10,   4H.3  ,   4H)   /
      DATA IFOT / 7*7, 2*9, 2*10 /
      DATA IFOH / 8, 10*10 /
      DATA FOH   /    4H(   ,4H1H0 ,                                    &
     &  4H,0P ,4HF6.3,4H,1X ,4H,1X ,  4H,1X,,4HF8.2,4H,1X ,4H,1X ,      &
     &  4H,1X,,4HF8.2,4H,1X ,4H,2X ,  4H,1P ,4HE10.,4H4   ,4H,3X ,      &
     &  4H,0P ,4HF9.3,4H,1X ,4H,4X ,  4H,1P ,4HE10.,4H4   ,4H,9X ,      &
     &  4H,0P ,4HF9.3,4H,1X ,4H,1X ,  4H,1X,,4HF8.3,4H,1X ,4H    ,      &
     &  4H,1X,,4HF8.3,4H,1X ,4H    ,  4H,1X,,4HF8.3,4H,1X ,4H    ,      &
     &  4H,1X,,4HF8.3,4H,1X ,4H)   /
!
!
      DATA WINGP / 4HWING /, TAILP / 4HTAIL /
!!!      DATA STRA / 4HSTRA /   ! not used
!
      NDELTA = F(16)+0.5
      SC = SYNA(13)
      XL = 1.0
      XR = 1.0
      XP = 1.0
      XT = 1.0
      IF(IDIM .EQ. 2) XL = 12.0
      IF(IDIM .EQ. 2) XP = 144.0
      IF(IDIM .GE. 3) XP = 0.0208854
      IF(IDIM .GE. 3) XR = 0.3048
      IF(IDIM .GE. 3) XT = 1.8
      IF(IDIM .EQ. 3) XL = 0.3048
      IF(IDIM .EQ. 4) XL = 30.48
      ALT  = FLC(K+96)
      VINF = FLC(M+136)
      PINF = FLC(K+73)
      TINF = FLC(K+116)
      IF(ALT  .NE. -UNUSED) ALT  = ALT *XL
      IF(VINF .NE. -UNUSED) VINF = VINF*XL
      IF(PINF .NE. -UNUSED) PINF = PINF*XP
      IF(TINF .NE. -UNUSED) TINF = TINF*XT
      RN   = FLC(M+42)*XR
      SREF = OPT(1)*XL*XL/(SC*SC)
      CBAR = OPT(2)*XL/SC
      BLRF = OPT(4)*XL/SC
      XCG  = SYNA(1)
      ZCG  = SYNA(5)
      IF(XCG .EQ. UNUSED) XCG = 0.0
      IF(ZCG .EQ. UNUSED) ZCG = 0.0
      IF(BD(11) .NE. UNUSED) XCG = XCG+BD(11)
      XCG  = XCG*XL/SC
      ZCG  = ZCG*XL/SC
!
!      SYMMETRICAL FLAP DATA
!
      FLAG = (FLC(157) .NE. UNUSED) .AND. (FLC(K+72) .NE. UNUSED)
      NDMF = .FALSE.
      NAF  = .FALSE.
      IF (.NOT. SYMFP) GO TO 1020
          WRITE(6,1340)
          VWGTL = WINGP
          IF(WGPL .AND. HTPL) VWGTL = TAILP
          IF(FTYPE .EQ. 1.0)  WRITE(6,1350) VWGTL
          IF(FTYPE .EQ. 2.0)  WRITE(6,1360) VWGTL
          IF(FTYPE .EQ. 3.0)  WRITE(6,1370) VWGTL
          IF(FTYPE .EQ. 4.0)  WRITE(6,1380) VWGTL
          IF(FTYPE .EQ. 5.0)  WRITE(6,1390) VWGTL
          IF(FTYPE .EQ. 6.0)  WRITE(6,1400) VWGTL
          IF(FTYPE .EQ. 7.0)  WRITE(6,1410) VWGTL
          IF(HEAD) CALL PRCSID
          WRITE(6,1420)
          IF(IDIM .EQ. 1) WRITE(6,1430)
          IF(IDIM .EQ. 2) WRITE(6,1440)
          IF(IDIM .EQ. 3) WRITE(6,1450)
          IF(IDIM .EQ. 4) WRITE(6,1460)
          CALL SWRITE(11,FOH,46,IFOH,1,FLC(M+2),ALT,VINF,PINF,          &
     &                TINF,RN,SREF,CBAR,BLRF,XCG,ZCG,DUM,               &
     &                DUM,DUM,NDMF,NAF)
!
          WRITE(6,1470)
          CALL SWRITE(8,FOR,34,IFOR,NDELTA,DELTA,DCL,DCM,DCLMAX,        &
     &               DCDMIN,DCLAD,CHA,CHD,X,X,X,X,X,X,NDMF,NAF)
          IF(.NOT. SUBSON .OR. FTYPE .GE. 7) GO TO 1010
          WRITE(6,1480)
          WRITE(6,1490) (DELTA(I),I=1,NDELTA)
          WRITE(6,1500)
          IS = NALPHA*NDELTA
          DO 1000 I=1,NALPHA
             WRITE(6,1510) ALPHA(I), (DCDI(J),J=I,IS,NALPHA)
 1000     CONTINUE
 1010     IF(.NOT. SUPERS) GO TO 1020
          WRITE(6,1310)
          WRITE(6,1320)
          WRITE(6,1330)
 1020 CONTINUE
!
!      CONTROL TAB OUTPUT
!
      IF(.NOT. CTAB) GO TO 1030
        ITYPE=F(116)+0.5
        WRITE(6,1340)
        IF(ITYPE .EQ. 1)WRITE(6,1770)
        IF(ITYPE .EQ. 2)WRITE(6,1780)
        IF(ITYPE .EQ. 3)WRITE(6,1790)
        IF(HEAD)CALL PRCSID
        WRITE(6,1420)
        IF(IDIM .EQ. 1) WRITE(6,1430)
        IF(IDIM .EQ. 2) WRITE(6,1440)
        IF(IDIM .EQ. 3) WRITE(6,1450)
        IF(IDIM .EQ. 4) WRITE(6,1460)
        CALL SWRITE(11,FOH,46,IFOH,1,FLC(M+2),ALT,VINF,PINF,            &
     &              TINF,RN,SREF,CBAR,BLRF,XCG,ZCG,DUM,                 &
     &              DUM,DUM,NDMF,NAF)
        IF(FLC(M+73) .NE. UNUSED) WRITE(6,1800)
        IF(FLC(M+73) .EQ. UNUSED) WRITE(6,1810)
        WRITE(6,1490) (DELTA(I),I=1,NDELTA)
        WRITE(6,1500)
        WRITE(6,1510) ((FC(I,J),J=1,NDELTA), I=1,NALPHA)
        WRITE(6,1820)
!
        WRITE(6,1830)
        WRITE(6,1490) (DELTA(I), I=1,NDELTA)
        WRITE(6,1500)
        WRITE(6,1510) ((CHCTF(I,J), J=1,NDELTA), I=1,NALPHA)
!
        WRITE(6,1340)
        IF(ITYPE .EQ. 1)WRITE(6,1770)
        IF(ITYPE .EQ. 2)WRITE(6,1780)
        IF(ITYPE .EQ. 3)WRITE(6,1790)
        IF(HEAD)CALL PRCSID
        WRITE(6,1420)
        IF(IDIM .EQ. 1) WRITE(6,1430)
        IF(IDIM .EQ. 2) WRITE(6,1440)
        IF(IDIM .EQ. 3) WRITE(6,1450)
        IF(IDIM .EQ. 4) WRITE(6,1460)
        CALL SWRITE(11,FOH,46,IFOH,1,FLC(M+2),ALT,VINF,PINF,            &
     &              TINF,RN,SREF,CBAR,BLRF,XCG,ZCG,DUM,                 &
     &              DUM,DUM,NDMF,NAF)
        WRITE(6,1840)
        WRITE(6,1490) (DELTA(I), I=1,NDELTA)
        WRITE(6,1500)
        WRITE(6,1510) ((CHCTL(I,J), J=1,NDELTA), I=1,NALPHA)
        WRITE(6,1820)
!
        WRITE(6,1850)
        WRITE(6,1490) (DELTA(I), I=1,NDELTA)
        WRITE(6,1500)
        WRITE(6,1510) ((DCHCG(I,J), J=1,NDELTA), I=1,NALPHA)
!
        IF(ITYPE .EQ. 1) GO TO 1030
        WRITE(6,1340)
        IF(ITYPE .EQ. 1)WRITE(6,1770)
        IF(ITYPE .EQ. 2)WRITE(6,1780)
        IF(ITYPE .EQ. 3)WRITE(6,1790)
        IF(HEAD)CALL PRCSID
        WRITE(6,1420)
        IF(IDIM .EQ. 1) WRITE(6,1430)
        IF(IDIM .EQ. 2) WRITE(6,1440)
        IF(IDIM .EQ. 3) WRITE(6,1450)
        IF(IDIM .EQ. 4) WRITE(6,1460)
        CALL SWRITE(11,FOH,46,IFOH,1,FLC(M+2),ALT,VINF,PINF,            &
     &              TINF,RN,SREF,CBAR,BLRF,XCG,ZCG,DUM,                 &
     &              DUM,DUM,NDMF,NAF)
        WRITE(6,1860)
        WRITE(6,1490) (DELTA(I), I=1,NDELTA)
        WRITE(6,1500)
        WRITE(6,1510) ((DTT(I,J), J=1,NDELTA), I=1,NALPHA)
 1030 CONTINUE
!
!     ASYMMETRICAL FLAP OUTPUT
!
      IF(.NOT. ASYFP) GO TO 1120
          WRITE(6,1340)
          IF(STYPE .EQ. 1.0) WRITE(6,1570)
          IF(STYPE .EQ. 2.0) WRITE(6,1580)
          IF(STYPE .EQ. 3.0) WRITE(6,1590)
          IF(STYPE .EQ. 4.0) WRITE(6,1600)
          IF(STYPE .EQ. 5.0) WRITE(6,1520)
          IF(HEAD) CALL PRCSID
          WRITE(6,1420)
          IF(IDIM .EQ. 1) WRITE(6,1430)
          IF(IDIM .EQ. 2) WRITE(6,1440)
          IF(IDIM .EQ. 3) WRITE(6,1450)
          IF(IDIM .EQ. 4) WRITE(6,1460)
          CALL SWRITE(11,FOH,46,IFOH,1,FLC(M+2),ALT,VINF,PINF,          &
     &                TINF,RN,SREF,CBAR,BLRF,XCG,ZCG,DUM,               &
     &                DUM,DUM,NDMF,NAF)
!
          IF(STYPE .GT. 2) GO TO 1050
               IF(SUPERS) GO TO 1040
               WRITE(6,1700)
               IF(SUBSON) WRITE(6,1710) (XSOC(I), HSOC(I),              &
     &                        DELTAS(I), CLD(I), CND(I), I=1,NDELTA)
               IF(TRANSN) WRITE(6,1290) (XSOC(I), HSOC(I),              &
     &                        DELTAS(I), CLD(I), I=1,NDELTA)
               GO TO 1050
 1040          WRITE(6,1260)
               WRITE(6,1270) (DELTAS(I), CLD(I), CND(I), I=1,NDELTA)
 1050     CONTINUE
          IF(STYPE .NE. 3.0) GO TO 1060
               IF(SUPERS) WRITE(6,1280)
               IF(SUPERS) GO TO 1060
               WRITE(6,1680)
               IF(SUBSON) WRITE(6,1690) (XSOC(I), HSOC(I), DELTAD(I),   &
     &                        DELTAS(I), CLD(I), CND(I), I=1,NDELTA)
               IF(TRANSN) WRITE(6,1300) (XSOC(I), HSOC(I), DELTAD(I),   &
     &                        DELTAS(I), CLD(I), I=1,NDELTA)
 1060     CONTINUE
          IF(STYPE .NE. 4.0) GO TO 1090
               WRITE(6,1610)
               WRITE(6,1540) (DDELTA(I), I=1,NDELTA)
               WRITE(6,1550)
               IF(CLD(1) .EQ. UNUSED) GO TO 1080
               IS = 1
               ISS = NDELTA
               IDEL = NDELTA
               IF(SUPERS) IDEL = 10
               DO 1070 I=1,NALPHA
                  WRITE(6,1560) ALPHA(I), (CNAD(J), J=IS,ISS)
                  IS = IS+IDEL
                  ISS = ISS+IDEL
 1070          CONTINUE
               WRITE(6,1620) (DELTAL(I), DELTAR(I), CLD(I),             &
     &                   I=1,NDELTA)
               IF(.NOT. SUPERS) GO TO 1090
               WRITE(6,1310)
               WRITE(6,1320)
               GO TO 1090
 1080          WRITE(6,1280)
 1090     CONTINUE
          IF(STYPE .NE. 5.0) GO TO 1120
               IF(TRANSN) GO TO 1110
               WRITE(6,1530)
               WRITE(6,1540) (DDELTA(I), I=1,NDELTA)
               WRITE(6,1550)
               IS = 1
               ISS = NDELTA
               DO 1100 I=1,NALPHA
                  WRITE(6,1560) ALPHA(I), (CLAD(J), J=IS,ISS)
                  IS = IS+10
                  ISS = ISS+10
 1100          CONTINUE
               GO TO 1120
 1110          WRITE(6,1620) (DELTAL(I), DELTAR(I), CLD(I),             &
     &                   I=1,NDELTA)
 1120 CONTINUE
      IF(NDMF) WRITE(6,1740)
      IF(NAF)  WRITE(6,1750)
      NDMF = .FALSE.
      NAF  = .FALSE.
!
!     TRIM DATA OUTPUT
!
      IF(ASYFP .OR. .NOT. TRIM .OR. .NOT. SUBSON) GO TO 1160
          NTRIM = TRM(21) + 0.5
          IF(.NOT. SYMFP) GO TO 1130
               WRITE(6,1340)
               IF(BO .AND. WGPL .AND. HTPL)         WRITE(6,1650)
               IF(BO .AND. WGPL .AND. .NOT. HTPL)   WRITE(6,1640)
               IF(WGPL .AND. .NOT. (BO .OR. HTPL))  WRITE(6,1630)
               WRITE(6,1420)
               IF(IDIM .EQ. 1) WRITE(6,1430)
               IF(IDIM .EQ. 2) WRITE(6,1440)
               IF(IDIM .EQ. 3) WRITE(6,1450)
               IF(IDIM .EQ. 4) WRITE(6,1460)
               CALL SWRITE(11,FOH,46,IFOH,1,FLC(M+2),ALT,VINF,PINF,     &
     &                     TINF,RN,SREF,CBAR,BLRF,XCG,ZCG,DUM,          &
     &                     DUM,DUM,NDMF,NAF)
!
               WRITE(6,1670)
               WRITE(6,1660)
               CALL SWRITE(11,FOT,46,IFOT,NTRIM,ALPHA,CLUT,CDUT,CMUT,   &
     &                     DELT,DCLT,DCLMT,DCDIT,DCDMT,CHAT,CHDT,       &
     &                     X,X,X,NDMF,NAF)
               IF(FLAG) CALL FLTCL(FOT,IFOT,NTRIM,CLUT,CDUT,CMUT,DELT,  &
     &                             DCLT,DCLMT,DCDIT,DCDMT,CHDT,CLWBT,   &
     &                             CDWBT,1)
               IF((TRM(22) .EQ. 1.0) .OR. (NTRIM .EQ. 0)) WRITE(6,1720)
               ITRM = TRM(22) + 0.5
               IF(ITRM .EQ. 2) WRITE(6,1730)
 1130     CONTINUE
          IF(SYMFP .OR. .NOT. HTPL) GO TO 1160
      IF(WINGIN(101).GT.2.0) GO TO 1160
               WRITE(6,1340)
               IF(VTPL)       WRITE(6,1180)
               IF(.NOT. VTPL) WRITE(6,1170)
               WRITE(6,1420)
               IF(IDIM .EQ. 1) WRITE(6,1430)
               IF(IDIM .EQ. 2) WRITE(6,1440)
               IF(IDIM .EQ. 3) WRITE(6,1450)
               IF(IDIM .EQ. 4) WRITE(6,1460)
               CALL SWRITE(11,FOH,46,IFOH,1,FLC(M+2),ALT,VINF,PINF,     &
     &                     TINF,RN,SREF,CBAR,BLRF,XCG,ZCG,DUM,          &
     &                     DUM,DUM,NDMF,NAF)
!
               WRITE(6,1190)
               WRITE(6,1200)
               NTM = 0
               DO 1140 I=1,NTRIM
                  IF(ALINT(I) .NE. -1000.)WRITE(6,1240) ALPHA(I)        &
     &                ,HT(I), HT(I+20), HT(I+40), HMUNT(I), ALINT(I)    &
     &                ,CDTRM(I), CLTRM(I), CMTRM(I), HMTRM(I)
                  IF(ALINT(I) .NE. -1000.) NTM = NTM+1
                  IF(ALINT(I) .EQ. -1000.)WRITE(6,1240) ALPHA(I)        &
     &                ,HT(I), HT(I+20), HT(I+40)
 1140          CONTINUE
               WRITE(6,1210)
               WRITE(6,1220)
               DO 1150 I=1,NTRIM
                  IF(ALINT(I) .NE. -1000.) WRITE(6,1230) ALPHA(I),      &
     &                 CDWBT(I), CLWBT(I)
                  IF(ALINT(I) .EQ. -1000.) WRITE(6,1230) ALPHA(I)
 1150          CONTINUE
               IF(FLAG) CALL FLTCL(FOT,IFOT,NTM,CLUT,CDUT,CMUT,DELT,    &
     &                             DCLT,DCLMT,DCDIT,DCDMT,CHDT,CLWBT,   &
     &                             CDWBT,2)
               IF(TRM2(22).EQ.1.) WRITE(6,1250)
               IF(TRM2(22).EQ.2.) WRITE(6,1730)
               IF(TRM2(22).EQ.3.) WRITE(6,1735)
 1160 CONTINUE
      IF(NDMF) WRITE(6,1740)
      IF(NAF)  WRITE(6,1750)
 1170 FORMAT(33X,62HWING-BODY-ALL MOVABLE HORIZONTAL STABILIZER TRIM CON&
     &FIGURATION)
 1180 FORMAT(26X,76HWING-BODY-VERTICAL TAIL-ALL MOVABLE HORIZONTAL STABI&
     &LIZER TRIM CONFIGURATION)
 1190 FORMAT(1H0,46H-----------------UNTRIMMED--------------------,     &
     &34HHORIZONTAL STABILIZER COEFFICIENTS,45H----------------AT TRIM I&
     &NCIDENCE------------/)
 1200 FORMAT(7H0 ALPHA,5X,2HCD,7X,2HCL,7X,2HCM,7X,2HHM,41X,5HALIHT,4X,  &
     &2HCD,7X,2HCL,7X,2HCM,7X,2HHM/)
 1210 FORMAT(/1H0,41X,45HWING-BODY-TAIL COEFFICIENTS AT TRIM INCIDENCE/)
 1220 FORMAT(1H0,52X,5HALPHA,5X,2HCD,7X,2HCL/1H0)
 1230 FORMAT(53X,F5.1,3X,F6.3,3X,F6.3)
 1240 FORMAT(2X,0PF5.1,3X,F6.3,3X,F6.3,3X,F7.4,2X,1PE10.3,35X,0PF5.1,   &
     &       2X,F6.3,3X,F6.3,3X,F7.4,2X,1PE10.3)
 1250 FORMAT( 81H0*NOTE** ANGLES OF ATTACK WHERE NO OUTPUT EXISTS INDICA&
     &TES LACK OF CONTROL MOMENT)
 1260 FORMAT(1H0,46X,4HDS/C,9X,8H(CL)ROLL,12X,2HCN/1H0)
 1270 FORMAT(45X,0PF7.4,6X,1PE11.4,7X,E10.3)
 1280 FORMAT( 82H0*NOTE* NO OUTPUT AVAILABLE FOR THIS COMBINATION OF MAC&
     &H NUMBER AND CONFIGURATION.)
 1290 FORMAT(1X,33X,0PF7.4,5X,F7.4,5X,F7.4,5X,1PE11.4,8X,3HNDM)
 1300 FORMAT(1X,27X,0PF7.4,5X,F7.4,5X,F7.4,5X,F7.4,5X,1PE11.4,8X,3HNDM)
 1310 FORMAT(131H0*NOTE* METHODS VALID FOR CONFIGURATIONS WITH LEADING(H&
     &INGE LINE) AND TRAILING EDGES OF THE CONTROL SURFACE SWEPT AHEAD O&
     &F THE MACH/8X,34HLINES FROM THE DEFLECTED CONTROLS.)
 1320 FORMAT(103H0*NOTE* OTHER RESTRICTIONS USED IN THE DERIVATION OF TH&
     &E METHODS ARE PRESENTED IN VOL. II AND/OR DATCOM)
 1330 FORMAT(126H0*NOTE* CH(A) AND CH(D) DERIVATIVES ARE FOR STRAIGHT SI&
     &DED SYMMETRICAL BICONVEX AIRFOILS BASED ON TWICE THE AREA-MOMENT O&
     &F THE/8X,29HCONTROL ABOUT ITS HINGE LINE.)
 1340 FORMAT(1H1,28X,48HAUTOMATED STABILITY AND CONTROL METHODS PER APRI&
     &,24HL 1976 VERSION OF DATCOM,/,41X,                               &
     &48HCHARACTERISTICS OF HIGH LIFT AND CONTROL DEVICES)
 1350 FORMAT(44X,A4,39H PLAIN TRAILING-EDGE FLAP CONFIGURATION)
 1360 FORMAT(46X,A4,34H SINGLE-SLOTTED FLAP CONFIGURATION)
 1370 FORMAT(50X,A4,26H FOWLER FLAP CONFIGURATION)
 1380 FORMAT(46X,A4,34H DOUBLE-SLOTTED FLAP CONFIGURATION)
 1390 FORMAT(51X,A4,25H SPLIT FLAP CONFIGURATION)
 1400 FORMAT(47X,A4,32H LEADING-EDGE FLAP CONFIGURATION)
 1410 FORMAT(47X,A4,32H LEADING-EDGE SLAT CONFIGURATION)
 1420 FORMAT(55H -----------------------  FLIGHT CONDITIONS  ----------,&
     &       14H--------------,11X,25H--------------  REFERENCE,        &
     &       25H DIMENSIONS  ------------/2X,16HMACH    ALTITUDE,       &
     &       3X,48HVELOCITY    PRESSURE    TEMPERATURE     REYNOLDS,    &
     &       13X,47HREF.      REFERENCE LENGTH   MOMENT REF. CENTER/    &
     &       7H NUMBER,55X,6HNUMBER,14X,4HAREA,7X,5HLONG.,5X,4HLAT.,    &
     &       5X,15HHORIZ      VERT)
 1430 FORMAT(13X,2HFT,7X,6HFT/SEC,5X,8HLB/FT**2,7X,5HDEG R,9X,4H1/FT,   &
     &       15X,5HFT**2,1X,4(7X,2HFT,1X))
 1440 FORMAT(13X,2HIN,7X,6HIN/SEC,5X,8HLB/IN**2,7X,5HDEG R,9X,4H1/FT,   &
     &       15X,5HIN**2,1X,4(7X,2HIN,1X))
 1450 FORMAT(13X,2H M,7X,6H M/SEC,5X,8H N/ M**2,7X,5HDEG K,9X,4H1/ M,   &
     &       15X,5H M**2,1X,4(7X,2H M,1X))
 1460 FORMAT(13X,2HCM,7X,6HCM/SEC,5X,8H N/CM**2,7X,5HDEG K,9X,4H1/ M,   &
     &       15X,5HCM**2,1X,4(7X,2HCM,1X))
 1470 FORMAT(1H0,12X,46H---------INCREMENTS DUE TO DEFLECTION---------  &
     &,14X,30H---DERIVATIVES (PER DEGREE)---/1H0,5X,5HDELTA,            &
     &5X,5HD(CL),5X,5HD(CM),4X,9HD(CL MAX),4X,9HD(CD MIN),16X,6H(CLA)D, &
     & 5X,5H(CH)A,7X,5H(CH)D//)
 1480 FORMAT(1H0,2X,106H*** NOTE * HINGE MOMENT DERIVATIVES ARE BASED ON&
     & TWICE THE AREA-MOMENT OF THE CONTROL ABOUT ITS HINGE LINE//1H0,12&
     &X,83H--------- INDUCED DRAG COEFFICIENT INCREMENT , D(CDI) , DUE T&
     &O DEFLECTION ---------)
 1490 FORMAT(1H0,7X,8HDELTA =  ,F5.1,5X,F5.1,5X,F5.1,5X,F5.1,5X,F5.1,5X,&
     &F5.1,5X,F5.1,5X,F5.1,5X,F5.1,5X,F5.1)
 1500 FORMAT(3X,5HALPHA/1H0)
 1510 FORMAT(3X,0PF5.1,7X,1PE9.2,1X,E9.2,1X,E9.2,1X,E9.2,1X,E9.2,1X,    &
     &       E9.2,1X,E9.2,1X,E9.2,1X,E9.2,1X,E9.2)
 1520 FORMAT(30X, 60HDIFFERENTIALLY DEFLECTED HORIZONTAL STABILIZER CONF&
     &IGURATION)
 1530 FORMAT(1H0,33X, 64H----------ROLLING-MOMENT COEFFICIENT DUE TO DEF&
     &LECTION----------)
 1540 FORMAT( 17H0(DELTAL-DELTAR)=,F5.1,7X,F5.1,7X,F5.1,7X,F5.1,7X,F5.1,&
     &7X,F5.1,7X,F5.1,7X,F5.1,7X,F5.1,7X,F5.1)
 1550 FORMAT( 6H0ALPHA/1H0)
 1560 FORMAT(1X,0PF5.1,8X,1PE10.3,2X,E10.3,2X,E10.3,2X,E10.3,2X,        &
     &       E10.3,2X,E10.3,2X,E10.3,2X,E10.3,2X,E10.3,2X,E10.3)
 1570 FORMAT(47X, 36HWING WITH FLAP SPOILER CONFIGURATION)
 1580 FORMAT(47X, 36HWING WITH PLUG SPOILER CONFIGURATION)
 1590 FORMAT(42X, 46HWING WITH SPOILER-SLOT-DEFLECTOR CONFIGURATION)
 1600 FORMAT(44X, 43HWING PLAIN TRAILING-EDGE FLAP CONFIGURATION)
 1610 FORMAT(1H0,27X, 74H----------YAWING MOMENT COEFFICIENT,CN,DUE TO C&
     &ONTROL DEFLECTION----------)
 1620 FORMAT(1H0/                                                       &
     &       1H0,44X,6HDELTAL,10X,6HDELTAR,10X,8H(CL)ROLL/1H0/(45X,     &
     &       0PF5.1,11X,F5.1,11X,1PE11.4))
 1630 FORMAT(47X,37HWING TRIM WITH CONTROL DEVICE ON WING)
 1640 FORMAT(44X,42HWING-BODY TRIM WITH CONTROL DEVICE ON WING)
 1650 FORMAT(42X,47HWING-BODY-TAIL TRIM WITH CONTROL DEVICE ON TAIL)
 1660 FORMAT(1H0,4X,5HALPHA,5X,2HCL,9X,2HCD,7X,2HCM,5X,6HDELTAT,3X,5HD(C&
     &L),4X,9HD(CL MAX),5X,6HD(CDI),4X,9HD(CD MIN),3X,5HCH(A),8X,5HCH(D)&
     &/1H0)
 1670 FORMAT(1H0,9X,29H----------UNTRIMMED----------,12X,64H------------&
     &-----------AT TRIM DEFLECTION-----------------------)
 1680 FORMAT(1H0 ,29X,4HXS/C,8X,4HHS/C,8X,4HDD/C,8X,4HDS/C,8X,8H(CL)ROLL&
     &,10X,2HCN/1H0)
 1690 FORMAT(1X,27X,0PF7.4,5X,F7.4,5X,F7.4,5X,F7.4,5X,1PE11.4,5X,E10.3)
 1700 FORMAT(1H0,35X,4HXS/C,8X,4HHS/C,8X,4HDS/C,8X,8H(CL)ROLL,10X,2HCN/1&
     &H0)
 1710 FORMAT(1X,33X,0PF7.4,5X,F7.4,5X,F7.4,5X,1PE11.4,5X,E10.3)
 1720 FORMAT(73H0*NOTE** TRIM RESULTS HAVE BEEN TERMINATED DUE TO LACK O&
     &F CONTROL MOMENT.)
 1730 FORMAT(99H0*NOTE** TRIM RESULTS HAVE BEEN TERMINATED BECAUSE THE N&
     &EXT ANGLE OF ATTACK EXCEEDS ALPHA (CL) MAX.)
 1735 FORMAT(78H0*NOTE** TRIM RESULTS TERMINATED BECAUSE WING-BODY MOMEN&
     &T DATA WAS UNAVAILABLE)
 1740 FORMAT(44H0***NDM PRINTED WHEN NO DATCOM METHODS EXIST)
 1750 FORMAT(41H0***NA PRINTED WHEN METHOD NOT APPLICABLE)
 1770 FORMAT(45X,39HCONTROL TAB ON PLAIN TRAILING EDGE FLAP  )
 1780 FORMAT(50X,30HTRIM TAB ON TRAILING EDGE FLAP  )
 1790 FORMAT(42X,48HCONTROL AND TRIM TAB ON PLAIN TRAILING EDGE FLAP)
 1800 FORMAT(1H0,31X,44HSTICK FORCE, F(C), LB (TRIM TAB DEFL. = 0.0)  )
 1810 FORMAT(1H0,27X,53HSTICK FORCE COEFFICIENT, CF(C) (TRIM TAB DEFL. =&
     & 0.0))
 1820 FORMAT(1H0)
 1830 FORMAT(1H0,22X,63HFLAP HINGE MOMENT COEFFICIENT - TAB FREE (TRIM T&
     &AB DEFL. = 0.0))
 1840 FORMAT(1H0,21X,65HFLAP HINGE MOMENT COEFFICIENT - TAB LOCKED (TRIM&
     & TAB DEFL. = 0.0))
 1850 FORMAT(1H0,18X,69HFLAP HINGE MOMENT COEFFICIENT - DUE TO GEARING (&
     &TRIM TAB DEFL. = 0.0))
 1860 FORMAT(1H0,30X,46HTRIM TAB DEFLECTION FOR ZERO STICK FORCE, DEG.)
      RETURN
      END

      SUBROUTINE OUTPT4
! revised 23Dec97 by RLC
!
!***  PRINTS HYPERSONIC CONTROL EFFECTIVENESS OUTPUTS
!
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA,IG
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /FLAPIN/ F(16)
      COMMON /IBODY/  PB, BODY(200), dum1(200)
      COMMON /IWING/  PW, WING(200), dum13(200)
      COMMON /IHT/    PHT, HT(200), dum3(180)
      COMMON /IVT/    PVT, VT(200), dum4(180)
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      REAL,DIMENSION(200):: temp
                                          ! max allowed by input
      REAL,DIMENSION(20):: alpha,delta
      REAL,DIMENSION(800):: hyp
!!!      EQUIVALENCE (F(5),DELTA(1)),(ALPHA(1),FLC(23))
!!!      DATA BLANK/4H    /

      CHARACTER(LEN=*),PARAMETER:: string1060 =                         &
     &  "                      AUTOMATED STABILITY AND CONTROL METHODS"
      CHARACTER(LEN=*),PARAMETER:: string1061 =                         &
     &  " APRIL 1976 VERSION OF DATCOM"
      CHARACTER(LEN=*),PARAMETER:: string1070 =                         &
     &  "AERODYNAMIC CONTROL EFFECTIVENESS AT HYPERSONIC SPEEDS"
      CHARACTER(LEN=*),PARAMETER:: FMT1080 =                            &
     &   '(20X,"MACH NUMBER=",F5.2,57X,"REYNOLDS NO./FT=",E9.2/)'
      CHARACTER(LEN=*),PARAMETER:: FMT1081 =                            &
     &  '(20X,"REF. AREA (FT2)=",F8.3,"   LONG. REF. LENGTH(FT)=",F7.3)'
      CHARACTER(LEN=*),PARAMETER:: string1090 =                         &
     &  "--INCREMENT IN NORMAL FORCE PER SPANWISE FOOT OF CONTROL------"
      CHARACTER(LEN=*),PARAMETER:: string1100 =                         &
     &  "--INCREMENT IN AXIAL FORCE PER SPANWISE FOOT OF CONTROL-------"
      CHARACTER(LEN=*),PARAMETER:: string1110 =                         &
     &  "-INCREMENT IN PITCHING MOMENT DUE TO NORMAL FORCE "//          &
     &  "INCREMENT PER SPANWISE FOOT OF CONTROL---"
      CHARACTER(LEN=*),PARAMETER:: string1120 =                         &
     &  "--INCREMENT IN PITCHING MOMENT DUE TO AXIAL FORCE "//          &
     &  "INCREMENT PER SPANWISE FOOT OF CONTROL---"
      CHARACTER(LEN=*),PARAMETER:: string1130 =                         &
     &  "----- CENTER-OF-PRESSURE LOCATION OF NORMAL FORCE----------"
      CHARACTER(LEN=*),PARAMETER:: string1140 =                         &
     &  "----------CENTER-OF-PRESSURE LOCATION OF AXIAL FORCE---------"
!-----------------------------------------------------------------------

                              ! could be NINT
      ndelta=INT(F(16)+0.5)
      delta(1:ndelta)=f(5:ndelta+4)
      alpha(1:nalpha)=flc(23:nalpha+22)
      hyp(  1:200)=body(:)
      hyp(201:400)=wing(:)
      hyp(401:600)=ht(:)
      hyp(601:800)=vt(:)
!!!      DO 1000 I=1,200
!!!         HYP(I    ) = BODY(I)
!!!         HYP(I+200) = WING(I)
!!!         HYP(I+400) = HT(I)
!!!         HYP(I+600) = VT(I)
!!! 1000 CONTINUE

      WRITE(6,*) string1060
      WRITE(6,*) string1061
      WRITE(6,*) string1070
      CALL PRCSID
      WRITE(6,FMT1080) FLC(M+2),FLC(M+42)
      WRITE(6,FMT1081) SREF,CBARR
      WRITE(6,*) string1090

      CALL ALDLPR(ALPHA,DELTA,HYP(1:200),NALPHA,NDELTA)
      WRITE(6,*) string1100
      CALL ALDLPR(ALPHA,DELTA,HYP(201:400),NALPHA,NDELTA)
      WRITE(6,*) string1060
      WRITE(6,*) string1061
      WRITE(6,*) string1070
      CALL PRCSID
      WRITE(6,FMT1080) FLC(M+2),FLC(M+42)
      WRITE(6,FMT1081) SREF,CBARR
      WRITE(6,*) string1110
      CALL ALDLPR(ALPHA,DELTA,HYP(401:600),NALPHA,NDELTA)
      WRITE(6,*) string1120
      CALL ALDLPR(ALPHA,DELTA,HYP(601:800),NALPHA,NDELTA)
      DO I=1,NALPHA
         DO J=1,NDELTA
            II=(I-1)*10+J
            IF (HYP(II) == 0.0) THEN
              temp(ii)=HUGE(1.0)
            ELSE
              temp(ii)=HYP(II+400)/HYP(II)
            END IF
        END DO
      END DO

      WRITE(6,*) string1060
      WRITE(6,*) string1061
      WRITE(6,*) string1070
      CALL PRCSID
      WRITE(6,FMT1080) FLC(M+2),FLC(M+42)
      WRITE(6,FMT1081) SREF,CBARR
      WRITE(6,*) string1130
      CALL ALDLPR(ALPHA,DELTA,TEMP,NALPHA,NDELTA)

      DO I=1,NALPHA
         DO J=1,NDELTA
            II=(I-1)*10+J
            IF (HYP(II+200) == 0.0) THEN
              temp(ii)=HUGE(1.0)
            ELSE
              TEMP(II)=-HYP(II+600)/HYP(II+200)
            END IF
        END DO
      END DO

      WRITE(6,*) string1140
      CALL ALDLPR(ALPHA,DELTA,TEMP,NALPHA,NDELTA)

      RETURN

      CONTAINS

      SUBROUTINE ALDLPR(alpha,delta,var,nalpha,ndelta)
! ----------------------------------------------------------------------
! rewritten by RLC  23Dec97
      IMPLICIT NONE
      REAL,INTENT(IN),DIMENSION(:):: alpha,delta,var
      INTEGER,INTENT(IN):: nalpha,ndelta

      CHARACTER(LEN=*),PARAMETER:: FMT1000 = '("    DELTA=",10F9.1)'
      INTEGER:: i
!-----------------------------------------------------------------------
      WRITE(6,FMT1000) delta(1:ndelta)
      WRITE(6,*) "   alpha"
      DO i=1,nalpha
        WRITE(6,'(11ES9.2)') alpha(i),var(10*i-9:10*i)
      END DO
      RETURN
      END Subroutine ALDLPR

      END Subroutine OUTPT4

      SUBROUTINE OUTPUT
!
!     OUTPUT CONTROLS THE PRINTING OF STATIC AND DYNAMIC
!     STABILITY DATA STORED IN THE IDEAL OUTPUT MATRIX
!
!         SUBROUTINES REFERENCED-
!              1- HEADR - WRITES PAGE HEADINGS, PASSES STABILITY
!                         DATA TO INTERM, AND WRITES REQUIRED
!                         NOTES FOLLOWING DATA.
!              2- PRCSID- WRITES THE USER SUPPLIED IDENTIFICATION
!                         CENTERED ON THE PAGE.
!              3- INTERM- COMPUTES AERODYNAMIC CENTER OF PRESSURE
!                         FOR STATIC STABILITY DATA, SETS PRINT
!                         FORMAT, AND CALLS SWRITE.
!              4- SWRITE- PRINTS DATA WITH BLANKS, NDM, OR NA
!                         REPLACING NUMERIC DATA WHERE APPLICABLE.
!
      COMMON /IBODY/  PBODY,  BODY(400)
      COMMON /IWING/  PWING,  WING(400)
      COMMON /IHT/    PHT,    HT(380)
      COMMON /IVT/    PVT,    VT(380)
      COMMON /IVF/    PVF,    VF(380)
      COMMON /IBW/    PBW,    BW(380)
      COMMON /IBH/    PBH,    BH(380)
      COMMON /IBV/    PBV,    BV(380)
      COMMON /IBWH/   PBWH,   BWH(380)
      COMMON /IBWV/   PBWV,   BWV(380)
      COMMON /IBWHV/  PBWHV,  BWHV(380)
      COMMON /IPOWER/ PPOWER
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /CONSNT/ CONST(5)
      COMMON /SUPDW/  DWA(237)
      COMMON /FLGTCD/ FLC(160)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),IDIM
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL PBODY,PWING,PHT,PVT,PVF,PBW,PBH,PBV,PBWH,PBWV,PBWHV
      LOGICAL PWOP,PWP,GROUND,PPOWER,FLAG
      EQUIVALENCE (DWA(237),JDETCH),(CONST(3),UNUSED)
      EQUIVALENCE (WT,FLC(157))
      DIMENSION WTI(4)
      DATA WTI / 4H LB., 4H LB., 4H N. , 4H N.  /
!
      IF(PBODY)LAST=1
      IF(PWING)LAST=2
      IF(PHT)LAST=3
      IF(PVT)LAST=4
      IF(PVF)LAST=4
      IF(PBW)LAST=5
      IF(PBH)LAST=6
      IF(PBV)LAST=7
      IF(PBWH)LAST=8
      IF(PBWV)LAST=9
      IF(PBWHV)LAST=10
      GROUND=.FALSE.
      NALPHA=FLC(2) + 0.5
      IF(FLC(63) .NE. UNUSED) GROUND = .TRUE.
      IF(.NOT. SUPERS)   JDETCH = NALPHA
      IF(JDETCH .EQ. -1) JDETCH = NALPHA
      IF(JDETCH .EQ. 0)  JDETCH = 1
!
!     ----- PRINT BODY DATA
!
      FLAG = PBODY .OR. (BUILD .AND. BO)
      IF(.NOT. FLAG)GO TO 1000
        PWOP=(LAST.EQ.1).AND.PPOWER.AND..NOT.BUILD
        PWOP=.NOT.PWOP
        PWP=PPOWER.AND.(LAST.EQ.1)
        IF(PWOP)CALL HEADR(BODY,1,1,21,GROUND,.FALSE.,.FALSE.)
        IF(PWP) CALL HEADR(BODY,1,1,21,GROUND,.TRUE.,.FALSE.)
        IF(DAMP)CALL HEADR(BODY(201),1,2,21,.FALSE.,.FALSE.,.FALSE.)
 1000 CONTINUE
!
!     ----- PRINT WING DATA
!
      FLAG = PWING .OR. (BUILD .AND. WGPL)
      IF(.NOT. FLAG)GO TO 1010
        PWOP=(LAST.EQ.2).AND.PPOWER.AND..NOT.BUILD
        PWOP=.NOT.PWOP
        PWP=PPOWER.AND.(LAST.EQ.2)
        IF(PWOP)CALL HEADR(WING,2,1,21,GROUND,.FALSE.,.FALSE.)
        IF(PWP) CALL HEADR(WING,2,1,21,GROUND,.TRUE.,.FALSE.)
        IF(DAMP)CALL HEADR(WING(201),2,2,21,.FALSE.,.FALSE.,.FALSE.)
 1010 CONTINUE
!
!     ----- PRINT HORIZONTAL TAIL DATA
!
      FLAG = PHT .OR. (BUILD .AND. HTPL)
      IF(.NOT. FLAG)GO TO 1020
        PWOP=(LAST.EQ.3).AND.PPOWER.AND..NOT.BUILD
        PWOP=.NOT.PWOP
        PWP=PPOWER.AND.(LAST.EQ.3)
        IF(PWOP)CALL HEADR(HT,3,1,21,GROUND,.FALSE.,.FALSE.)
        IF(PWP) CALL HEADR(HT,3,1,21,GROUND,.TRUE.,.FALSE.)
        IF(DAMP)CALL HEADR(HT(201),3,2,21,.FALSE.,.FALSE.,.FALSE.)
 1020 CONTINUE
!
!     ----- PRINT VERTICAL TAIL DATA
!
      FLAG = PVT .OR. (BUILD .AND. VTPL)
      IF(.NOT. FLAG)GO TO 1030
        PWOP=(LAST.EQ.4).AND.PPOWER.AND..NOT.BUILD
        PWOP=.NOT.PWOP
        PWP=PPOWER.AND.(LAST.EQ.4)
        IF(PWOP)CALL HEADR(VT,4,1,21,GROUND,.FALSE.,.TRUE.)
        IF(PWP) CALL HEADR(VT,4,1,21,GROUND,.TRUE.,.FALSE.)
        IF(DAMP)CALL HEADR(VT(201),4,2,21,.FALSE.,.FALSE.,.TRUE.)
 1030 CONTINUE
!
!     ----- PRINT VENTRAL FIN DATA
!
      FLAG = PVF .OR. (BUILD .AND. VFPL)
      IF(.NOT. FLAG)GO TO 1040
        PWOP=(LAST.EQ.4).AND.PPOWER.AND..NOT.BUILD
        PWOP=.NOT.PWOP
        PWP=PPOWER.AND.(LAST.EQ.4)
        IF(PWOP)CALL HEADR(VF,11,1,21,GROUND,.FALSE.,.TRUE.)
        IF(PWP) CALL HEADR(VF,11,1,21,GROUND,.TRUE.,.FALSE.)
        IF(DAMP)CALL HEADR(VF(201),11,2,21,.FALSE.,.FALSE.,.TRUE.)
 1040 CONTINUE
!
!     ----- PRINT BODY-WING DATA
!
      FLAG = PBW .OR. (BUILD .AND. BO .AND. WGPL)
      IF(.NOT. FLAG)GO TO 1050
        PWOP=(LAST.EQ.5).AND.PPOWER.AND..NOT.BUILD
        PWOP=.NOT.PWOP
        PWP=PPOWER.AND.(LAST.EQ.5)
        IF(PWOP)CALL HEADR(BW,5,1,21,GROUND,.FALSE.,.FALSE.)
        IF(PWP) CALL HEADR(BW,5,1,21,GROUND,.TRUE.,.FALSE.)
        IF(DAMP)CALL HEADR(BW(201),5,2,21,.FALSE.,.FALSE.,.FALSE.)
 1050 CONTINUE
!
!     ----- PRINT BODY-HORIZONTAL TAIL DATA
!
      FLAG = PBH .OR. (BUILD .AND. BO .AND. HTPL)
      IF(.NOT. FLAG)GO TO 1060
        PWOP=(LAST.EQ.6).AND.PPOWER.AND..NOT.BUILD
        PWOP=.NOT.PWOP
        PWP=PPOWER.AND.(LAST.EQ.6)
        IF(PWOP)CALL HEADR(BH,6,1,21,GROUND,.FALSE.,.FALSE.)
        IF(PWP) CALL HEADR(BH,6,1,21,GROUND,.TRUE.,.FALSE.)
        IF(DAMP)CALL HEADR(BH(201),6,2,21,.FALSE.,.FALSE.,.FALSE.)
 1060 CONTINUE
!
!     ----- PRINT BODY-VERTICAL TAIL DATA
!
      FLAG = PBV .OR. (BUILD .AND. BO .AND. VTPL)
      IF(.NOT. FLAG)GO TO 1070
        PWOP=(LAST.EQ.7).AND.PPOWER.AND..NOT.BUILD
        PWOP=.NOT.PWOP
        PWP=PPOWER.AND.(LAST.EQ.7)
        IF(PWOP)CALL HEADR(BV,7,1,21,GROUND,.FALSE.,.TRUE.)
        IF(PWP) CALL HEADR(BV,7,1,21,GROUND,.TRUE.,.TRUE.)
        IF(DAMP)CALL HEADR(BV(201),7,2,21,.FALSE.,.FALSE.,.TRUE.)
 1070 CONTINUE
!
!     ----- PRINT B-W-H DATA
!
      FLAG = PBWH .OR. (BUILD .AND. BO .AND. WGPL .AND. HTPL)
      IF(.NOT. FLAG)GO TO 1080
        PWOP=(LAST.EQ.8).AND.PPOWER.AND..NOT.BUILD
        PWOP=.NOT.PWOP
        PWP=PPOWER.AND.(LAST.EQ.8)
        IF(PWOP)CALL HEADR(BWH,8,1,JDETCH,GROUND,.FALSE.,.FALSE.)
        IF(PWP) CALL HEADR(BWH,8,1,JDETCH,GROUND,.TRUE.,.FALSE.)
        IF(DAMP)CALL HEADR(BWH(201),8,2,JDETCH,.FALSE.,.FALSE.,.FALSE.)
 1080 CONTINUE
!
!     ----- PRINT B-W-V DATA
!
      FLAG = PBWV .OR. (BUILD .AND. BO .AND. WGPL .AND. VTPL)
      IF(.NOT. FLAG)GO TO 1090
        PWOP=(LAST.EQ.9).AND.PPOWER.AND..NOT.BUILD
        PWOP=.NOT.PWOP
        PWP=PPOWER.AND.(LAST.EQ.9)
        IF(PWOP)CALL HEADR(BWV,9,1,21,GROUND,.FALSE.,.TRUE.)
        IF(PWP) CALL HEADR(BWV,9,1,21,GROUND,.TRUE.,.TRUE.)
        IF(DAMP)CALL HEADR(BWV(201),9,2,JDETCH,.FALSE.,.FALSE.,.TRUE.)
 1090 CONTINUE
!
!     ----- PRINT B-W-H-V DATA
!
      IF(.NOT.PBWHV)GO TO 1100
        PWOP=(LAST.EQ.10).AND.PPOWER.AND..NOT.BUILD
        PWOP=.NOT.PWOP
        PWP=PPOWER.AND.(LAST.EQ.10)
        IF(PWOP)CALL HEADR(BWHV,10,1,JDETCH,GROUND,.FALSE.,.TRUE.)
        IF(PWP) CALL HEADR(BWHV,10,1,JDETCH,GROUND,.TRUE.,.TRUE.)
        IF(DAMP)CALL HEADR(BWHV(201),10,2,JDETCH,.FALSE.,.FALSE.,.TRUE.)
 1100 CONTINUE
      IF((WT .EQ. UNUSED) .OR. (FLC(K+73) .EQ. UNUSED)) GO TO 1120
        IF(IDIM.GT.2) WT=WT/0.2248089
        Q  = 0.7*FLC(K+73)*FLC(I+2)**2
        CL = WT/(Q*SREF)
        WRITE(6,1110) WT, WTI(IDIM), CL
 1110   FORMAT(22H0*** VEHICLE WEIGHT = ,F9.2,A4/                       &
     &         36H0*** LEVEL FLIGHT LIFT COEFFICIENT =,F8.5)
 1120 CONTINUE
      RETURN
      END
      SUBROUTINE OUTTRJ
!
!***  PRINTS TRANSVERSE JET CONTROL EFFECTIVENESS OUTPUT
!
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /IBODY/  PBODY,JET(200), dum1(200)
      COMMON /SUPDW/  JETA(26)
      COMMON /FLAPIN/ F(48)
      COMMON /ERROR/  F1(7),DPFLC,F2(12),DMPCSE,F3(14),DPF,F4(11),DPJET
      REAL JET,JETA
      LOGICAL F1,DPFLC,F2,DMPCSE,F3,DPF,F4,DPJET
      LOGICAL LM(10)
      EQUIVALENCE (LM(1),F(39))
      DIMENSION TRBLAM(10)
      DATA HLAM/4HLAM /
      DATA HTRB/4HTURB/
 1000 FORMAT(1H1,26X,75HAUTOMATED STABILITY AND CONTROL METHODS PER APRI&
     &L 1976 VERSION OF DATCOM    )
 1010 FORMAT(53X,23HSPECIAL CONTROL METHODS/47X,36HTRANSVERSE-JET CONTRO&
     &L EFFECTIVENESS)
 1020 FORMAT(2H0 ,10HTIME (SEC),20X,F5.1,5X,F5.1,5X,F5.1,5X,F5.1,5X,F5.1&
     &,5X,F5.1,5X,F5.1,5X,F5.1,5X,F5.1,5X,F5.1)
 1030 FORMAT(2H0 ,18HCONTROL FORCE (LB),10X,10E10.3)
 1040 FORMAT(2H0 ,14HLOCAL MACH NO.,14X,3X,F4.1,6X,F4.1,6X,F4.1,6X,F4.1,&
     &6X,F4.1,6X,F4.1,6X,F4.1,6X,F4.1,6X,F4.1,6X,F4.1)
 1050 FORMAT(2H0 ,12HREYNOLDS NO.,16X,10E10.3)
 1060 FORMAT(2H0 ,23HLOCAL PRESSURE (LB/IN2),5X,10E10.3)
 1070 FORMAT(2H0 ,25HDYNAMIC PRESSURE (LB/IN2),3X,10E10.3)
 1080 FORMAT(2H0 ,14HBOUNDARY LAYER,14X,3X,A4,6X,A4,6X,A4,6X,A4,6X,A4,6X&
     &,A4,6X,A4,6X,A4,6X,A4,6X,A4)
 1090 FORMAT(2H0 ,20HCONTROL-FORCE COEFF.,8X,10E10.3)
 1100 FORMAT(2H0 ,22HCORRECTED FORCE COEFF.,6X,10E10.3)
 1110 FORMAT(2H0 ,26HSONIC AMPLIFICATION FACTOR,5X,F5.2,5X,F5.2,5X,F5.2,&
     &5X,F5.2,5X,F5.2,5X,F5.2,5X,F5.2,5X,F5.2,5X,F5.2,5X,F5.2)
 1120 FORMAT(  22H0 AMPLIFICATION FACTOR,11X,F5.1,5X,F5.1,5X,F5.1,5X,F5.&
     &1,5X,F5.1,5X,F5.1,5X,F5.1,5X,F5.1,5X,F5.1,5X,F5.1)
 1130 FORMAT(20H0 VACUUM THRUST (LB),10X,10E10.3)
 1140 FORMAT(21H0 MIN. PRESSURE RATIO,9X,10E10.3)
 1150 FORMAT(28H0 MIN. JET PRESSURE (LB/IN2),2X,10E10.3)
 1160 FORMAT(23H0 JET PRESSURE (LB/IN2),7X,10E10.3)
 1170 FORMAT(25H0 MASS-FLOW RATE (LB/SEC),8X,F5.2,5X,F5.2,5X,F5.2,5X,F5.&
     &2,5X,F5.2,5X,F5.2,5X,F5.2,5X,F5.2,5X,F5.2,5X,F5.2)
 1180 FORMAT(24H0 PROPELLANT WEIGHT (LB),7X,F7.2,3X,F7.2,3X,F7.2,3X,F7.2&
     &,3X,F7.2,3X,F7.2,3X,F7.2,3X,F7.2,3X,F7.2,3X,F7.2)
 1185 FORMAT(1H1)
!
!     ----DUMP LOGIC FOR TRANSVERSE JET.
!
      IF(.NOT.DMPCSE)GO TO 1190
      DPF=.TRUE.
      DPJET=.TRUE.
      DPFLC=.TRUE.
 1190 IF(DPF)  CALL DMPARY(F,48,4H   F,4)
      IF(DPFLC)CALL DMPARY(FLC,93,4H FLC,4)
      IF(DPJET)CALL DMPARY(JET,200,4H IOM,4)
      IF(DPJET)CALL DMPARY(JETA,26,4H JET,4)
      NC=F(11)+.5
      WRITE(6,1000)
      WRITE(6,1010)
      CALL PRCSID
      WRITE(6,1020)(F(L),L=1,NC)
      WRITE(6,1030)(F(L+11),L=1,NC)
      WRITE(6,1040)(JET(L),L=1,NC)
      WRITE(6,1050)(JET(L+10),L=1,NC)
      WRITE(6,1060)(JET(L+20),L=1,NC)
      WRITE(6,1070)(JET(L+30),L=1,NC)
      DO 1210 L=1,NC
         IF(LM(L))GO TO 1200
         TRBLAM(L)=HTRB
         GO TO 1210
!
!     ----LAM.
!
 1200    TRBLAM(L)=HLAM
 1210 END DO
      WRITE(6,1080)(TRBLAM(L),L=1,NC)
      WRITE(6,1090)(JET(L+40),L=1,NC)
      WRITE(6,1100)(JET(L+50),L=1,NC)
      WRITE(6,1110)(JET(L+60),L=1,NC)
      WRITE(6,1120)(JET(L+70),L=1,NC)
      WRITE(6,1130)(JET(L+80),L=1,NC)
      WRITE(6,1140)(JET(L+90),L=1,NC)
      WRITE(6,1150)(JET(L+100),L=1,NC)
      WRITE(6,1160)(JET(L+110),L=1,NC)
      WRITE(6,1170)(JET(L+120),L=1,NC)
      WRITE(6,1180)(JET(L+130),L=1,NC)
      WRITE(6,1185)
      RETURN
      END
      SUBROUTINE PRCSID
!
!     -----CENTER AND PRINT CASE IDENTIFICATION.
!
      DIMENSION IPR(132)
      LOGICAL LDM,HEAD,LDM2
      COMMON /FLOLOG/ LDM(10),HEAD,LDM2(14)
      COMMON /CASEID/ IDCSE(74)
      DATA IBLNK /4H    /
!
!     ----RETURN IF NO CASE ID CARD.
!
      IF(.NOT.HEAD)RETURN
      KB=0
      DO 1000 I=1,74
         IPR(I)=IBLNK
         IF(IDCSE(I).EQ.IBLNK)GO TO 1000
         KB=KB+1
         IF(KB.EQ.1)IFB=I
         ILB=I
 1000 END DO
      IF(KB.EQ.0) GO TO 1020
!
!     ----CENTER ON PAGE
!
      ICNT=(ILB-IFB+1)/2
      IF=65-ICNT
      K=0
      DO 1010 I=IFB,ILB
         IPR(IF+K)=IDCSE(I)
 1010 K=K+1
      NP=IF+K-1
 1015 WRITE(6,1030)(IPR(I),I=1,NP)
 1020 RETURN
 1030 FORMAT(1X,132A1)
      END
      SUBROUTINE PRNSEC(ICONF)
!
!     WRITE CONFIGURATION SECOND LEVEL PARTIAL OUTPUTS
!
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108)
      COMMON /LEVEL2/ SECOND(23)
      DIMENSION SMACH(4)
      IF(ICONF .EQ. 3) GO TO 1000
      IF(ICONF .EQ. 6) GO TO 1000
!
!     WRITE WING PARTIAL OUTPUTS
!
      WRITE(6,1010)
      WRITE(6,1020)SECOND(17),SECOND(18),TRA(5),TRA(6)
      AMACH=TRA(6) + 0.07
      BMACH=TRA(6) + 0.14
      WRITE(6,1030)AMACH,TRA(13),BMACH,TRA(15),SECOND(1),SECOND(2)
      WRITE(6,1040)
      WRITE(6,1050)(TRA(I+15),TRA(I+20),I=1,5)
      IF(ICONF .EQ. 2) GO TO 1140
!
!     WRITE WING-BODY PARTIAL OUTPUTS
!
      WRITE(6,1060)
      WRITE(6,1070)SECOND(21),SECOND(5),SECOND(6),SECOND(9)
 1000 IF(ICONF .NE. 3 .AND. ICONF .NE. 6 .AND. ICONF .NE. 8 .AND.       &
     &   ICONF .NE. 10) GO TO 1140
!
!     WRITE HORIZONTAL TAIL PARTIAL OUTPUTS
!
      WRITE(6,1080)
      WRITE(6,1020)SECOND(19),SECOND(20),TRAH(5),TRAH(6)
      AMACH=TRAH(6) + 0.07
      BMACH=TRAH(6) + 0.14
      WRITE(6,1030)AMACH,TRAH(13),BMACH,TRAH(15),SECOND(3),SECOND(4)
      WRITE(6,1040)
      WRITE(6,1050)(TRAH(I+15),TRAH(I+20),I=1,5)
      IF(ICONF .EQ. 3) GO TO 1140
!
!     WRITE HORIZONTAL TAIL-BODY PARTIAL OUTPUTS
!
      WRITE(6,1090)
      WRITE(6,1070)SECOND(22),SECOND(7),SECOND(8),SECOND(10)
      IF(ICONF .NE. 8 .AND. ICONF .NE. 10) GO TO 1140
!
!     WRITE B-W-H OR B-W-H-V PARTIAL OUTPUTS
!
      WRITE(6,1100)
      WRITE(6,1110)SECOND(23)
      WRITE(6,1120)
      SMACH(1)=0.6
      SMACH(2)=0.7
      SMACH(3)=1.1
      SMACH(4)=1.4
      WRITE(6,1130)(SMACH(I),SECOND(I+10),I=1,4)
 1010 FORMAT(//53X,26H *** WING DATA FAIRING ***)
 1020 FORMAT(39X,11HCDL/CL**2 =,E11.4,5X,8HCLB/CL =,E11.4/12X,          &
     & 38HFORCE BREAK MACH NUMBER (ZERO SWEEP) =,E11.4,5X,              &
     & 38HFORCE BREAK MACH NUMBER (WITH SWEEP) =,E11.4)
 1030 FORMAT(22X,9HMACH(A) =,F6.3,5X,8HCLA(A) =,E11.4,                  &
     &        5X,9HMACH(B) =,F6.3,5X,8HCLA(B) =,E11.4/                  &
     & 48X,15H(CLB/CL)M=0.6 =,E11.4,5X,15H(CLB/CL)M=1.4 =,E11.4/)
 1040 FORMAT(50X,36HLIFT-CURVE-SLOPE INTERPOLATION TABLE/               &
     & 54X,4HMACH,15X,8HCL-ALPHA)
 1050 FORMAT(52X,F6.3,14X,E11.4)
 1060 FORMAT(//50X,31H *** WING-BODY DATA FAIRING ***)
 1070 FORMAT(12X,8HCLB/CL =,E11.4,5X,13H(CLB/CL)MFB =,E11.4,5X,         &
     & 15H(CLB/CL)M=1.4 =,E11.4,5X,12H(CNA)M=1.4 =,E11.4)
 1080 FORMAT(////50X,37H *** HORIZONTAL TAIL DATA FAIRING ***)
 1090 FORMAT(//45X,42H *** HORIZONTAL TAIL-BODY DATA FAIRING ***)
 1100 FORMAT(////42X,47H *** BODY-WING-HORIZONTAL TAIL DATA FAIRING ***)
 1110 FORMAT(48X,29HDRAG DIVERGENCE MACH NUMBER =,F6.3)
 1120 FORMAT(54X,4HMACH,17X,3HCDO)
 1130 FORMAT(52X,F6.3,14X,E11.4)
 1140 CONTINUE
      RETURN
      END
      SUBROUTINE PRPWEF(M)

!     ----SUBROUTINE COMPUTES PROPELLER POWER EFFECTS
! modified 21 Dec 2004 to correct an error. See comments.
! Thanks to Remzi Barlas for the debugging effort.

      COMMON /IWING/  PWING,  WING(400)
      COMMON /IHT/    PHT,    HT(380)
      COMMON /IPOWER/ PPOWER, POWER(200)
      COMMON /IDWASH/ PDWASH, DWASH(60)

      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /WINGI/  CHRDTP,SSPNOP,SSPNE,SSPN,CHRDBP,CHRDR,SAVSI,SAVSO,&
     &                CHSTAT,SWAFP,TWISTA,SSPNDD,DHDADI,DHDADO,         &
     &                TYPE,                                             &
     &                TOVC,DELTAY,XOVC,CLI,ALPHAI,CLALPW(20),           &
     &                CLMAX(20),CMO,LERI,LERO,CAMBER,TOVCO,XOVCO,CMOT,  &
     &                CLMAXL,CLAMO,TCEFF,KSHARP,SLOPE(6)
      COMMON /HTI/    HTIN(131)
      COMMON /POWER/ AIETLP,NENGSP,THSTCP,PHALOC,PHVLOC,PRPRAD,ENGFCT,  &
     &               BWAPR3,BWAPR6,BWAPR9,NOPBPE,BAPR75,                &
     &               XX(15),YP,CROT

      COMMON /WBHCAL/ WBT(155)
      COMMON /WINGD/  A(195), B(49)
      COMMON /BDATA/  BD(762)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /VTDATA/ AVT(195)
      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55)
      COMMON /POWR/   DCLT(20),XBARP,DEUDA,                             &
     & DCLNP(20),DCLQ(20),DCLAW(20),DCLHQ(20),DCMNP(20),                &
     & DCMQ,DCML(20),DCMHQ(20),DCMHE(20),SINAPX,PRPRD2,                 &
     & CTI,BSTIO2,SSTRI,BST0I2,CTIH,SST0I,SRATIO,                       &
     & CNAP80,CNAP,C1,C2,DEPDAP,SRTPCO,F,COMBO1,COMBO,COSAIH,SIOSRH,SIH,&
     & DCD0S,CD0POW,RPNOB,AAK,EBROEP,DCMT,ASTARI,TRPSTI,                &
     & XBRSRR,ALPHAT,ALPHAP,EP,SINAP,ZS,BIO2,COSAT,SINAT,SI,TRI,CBARLI, &
     & SWEEPA,TRPSI,SCAPI,TRS0I,CBSR0I,COSSWA,ATOVCA,CM0IN,             &
     & CM02,CM0OVA,CM0TE0,CM0I,BS1,BS2,BS3,AK1,DELALP,DXHMAC,           &
     & ZHEFF,ZHORP,DQHOQI,ZHT,ZHTORP,XCP,DLH,CNP,CLP,EBAR,CLWW,CDLRAT,  &
     & CDLPOW,EPOWR,YTEMP,STEP1,DCLHE(20),ARGCS(7)
!
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC   &
     &                ,HEAD,PRPOWR,JETPOW,LOASRT
      COMMON /CONSNT/ PI, DEG, UNUSED, RAD,kand
!
      REAL NENGSP,NOPBPE
      REAL LH
      REAL KN
      LOGICAL SWITCH
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC           &
     &        ,HEAD,PRPOWR,JETPOW,LOASRT
      LOGICAL CROT
!
      DIMENSION ALSCHD(20),CDL(20),CLW(20)
      DIMENSION CLH(20),QHOQI(20),EPSLON(20)
      DIMENSION CLMXW(20)
      DIMENSION CDPOW(20), DCLPON(20), DCM(20)
      EQUIVALENCE (CDPOW(1),POWER(1)),(DCLPON(1),POWER(21)),            &
     &            (DCM(1),POWER(41)),(CLHT(1),WBT(110))
      EQUIVALENCE (ACLMAX,B(43)),(CLW(1),WING(21)),(CLALPA,WING(101))   &
     &                ,(CD0,B(46))
      EQUIVALENCE (A(120),AR),(A(161),XBARRW),(ALPHA0,A(134)),          &
     & (SSTARI,A(1)),(CB,CHRDBP),(BST0O2,SSPNOP),(BO2,SSPN),            &
     & (CR,CHRDR),(CRSTR,A(10)),(SRW,SREF),(CLMXW(1),CLMAX(1)),         &
     & (LH,A(193)),(CBARCI,A(121)),(CM0,CMO),                           &
     & (CT,CHRDTP),(BSTO2,SSPNE)
      EQUIVALENCE (BO2H,HTIN(4)),(CRH,HTIN(6)),(CTH,HTIN(1)),           &
     & (EPSLON(1),DWASH(21)),(SRH,AHT(3)),(QHOQI(1),DWASH(1)),          &
     & (XBARRH,AHT(161))
      EQUIVALENCE (COSAIW,BD(79))
      EQUIVALENCE (ALSCHD(1),FLC(23))
      EQUIVALENCE (KN,ENGFCT)
      EQUIVALENCE (SSTRRV,AVT(3)),(SSB,BD(93)),                         &
     &            (CFBPO,BD(92)),(CDL(1),D(36))
      DIMENSION CA(6),QCLTB(1),CLHT(20)
      DIMENSION ROUTID(2),Q44161(2),Q6125A(3),Q46126(2),Q6125B(3),      &
     & Q46316(2),Q6413A(3),Q6413B(3),Q41412(3),Q46112(2),Q6314A(3),     &
     & Q46315(2)
      DIMENSION X6111A(11),F6111A(11),C6111A(6)
      DIMENSION X1S11B(4),X2S11B(7),YSR11B( 7,4)
      DIMENSION X6111B( 6),Y6111B( 6),C6111B(6)
      DIMENSION X16112(3),X26112(9),Y46112(9,3)
      DIMENSION C46112(6)
      DIMENSION XB6112(9),DM2(9)
      DIMENSION DC1(5),DC2(2),DC3(2,5)
      DIMENSION D4(2),D3(11),AK6112(2,11)
      DIMENSION X14161(4),X24161(10),Y44161(10,4)
      DIMENSION X46113(19),C26113(19),C16113(18),C61132(6),C61131(6)
      DIMENSION X14637(6),X24637(6),Y4637(36)
      DIMENSION XT4637(13),Z24637(2),YF4637(2,13)
      DIMENSION X4648A(11),Y4648A(11),C4648A(6)
      DIMENSION X1648B(5),X2648B(14),Y4648B(70)
      DIMENSION X21412(16) , X11412(5) , X31412(3) , Y41412(240)
      DIMENSION Y415A(80), Y415B(80), Y415C(80)
      DIMENSION X1638A(8),X2638A(8),Y4638A(64)
      DIMENSION X1638B(4),X2638B(2),Y4638B(8)
      DIMENSION X1639A(8),X2639A(8),Y4639A(64)
      DIMENSION X4639B(2),Y4639B(2),C4639B(6)
      DIMENSION X1639C(5),X2639C(2),Y4639C(10)
!
      EQUIVALENCE (Y41412(1),Y415A(1)), (Y41412(81),Y415B(1))
      EQUIVALENCE (Y41412(161),Y415C(1))
!
      DATA ROUTID/4HPRPW,4HEF  /,Q44161/4H4.4.,4H1-73/,                 &
     & Q6125A/4H4.6.,4H1-25,4HA   /,Q46126/4H4.6.,4H1-26/,              &
     & Q6125B/4H4.6.,4H1-25,4HB   /,Q46316/4H4.6.,4H3-16/,              &
     & Q6413A/4H4.6.,4H4-13,4HA   /,Q41412/4H4.1.,4H4.1-,4H5   /,       &
     & Q6413B/4H4.6.,4H4-13,4HB   /,Q46112/4H4.6.,4H1-27/,              &
     & Q6314A/4H4.6.,4H3-14,4H    /,Q46315/4H4.6.,4H3-15/
      DATA PISQRD /9.8696044/
!
!     ----PROPELLER INFLOW FACTOR
!     ----FIGURE 4.6.1-25B
!
      DATA I6111A/0/
      DATA X6111A/0.,1.,2.,3.,4.,6.,8.,10.,14.,19.,22./
      DATA F6111A/1.0,1.55,1.94,2.20,2.40,2.75,3.05,3.30,3.75,4.25,4.54/
!
!     ----PROPELLER NORMAL FORCE PARAMETER
!     ----FIGURE 4.6.1-25A SINGLE ROTATION
!
      DATA X1S11B/2.,3.,4.,6./
      DATA X2S11B/15.,20.,25.,30.,35.,40.,60./
      DATA YSR11B/.08,.10,.115,.126,.140,.150,.192 , .11,.139,.160,.182,&
     &.20,.216,.275 , .136,.172,.20,.226,.25,.272,.35 , .196,.237,.275, &
     &.315,.35,.382,.5 /
!
!     ----PROPELLER NORMAL FORCE PARAMETER
!     ----FIGURE 4.6.1-25A COUNTER ROTATION
!
      DATA I6111B/0/
      DATA X6111B/15.,20.,30.,40.,50.,60./
      DATA Y6111B/.25,.295,.366,.421,.468,.51/
!
!     ----4.6.1-27 (A) DM1=F(ASPECT RATIO,AI)
!
      DATA X26112 /2.,3.,4.,5.,6.,7.,8.,9.,10./,X16112/1.,1.5,2./
      DATA Y46112 /3.8,2.3,1.5,0.9,0.65,0.35,0.20,0.10,0.0 , 9.0,6.6,5.4&
     &,4.5,3.9,3.6,3.4,3.1,3.0 , 13.0,10.3,9.0,8.05,7.45,6.90,6.55,6.25,&
     &6.0/
!
!     ----4.6.1-27 (B) DM2=F(SW*T*C/(SR**2P))
!
      DATA I46112/0/
      DATA XB6112 /0.,.5,1.,1.5,2.,2.5,3.,3.5,4./
      DATA DM2 /0.,1.3,1.95,2.4,2.75,3.1,3.35,3.56,3.75/
!
!     ----4.6.1-27 (C)
!
      DATA DC2 /0.,14./,DC1 /1.,2.,3.,4.,5./
      DATA DC3 /.3,1. , .6,2. , .9,3. , 1.2,4. , 1.5,5. /
!
!     ----4.6.1-27 (D)
!
      DATA D4/0.,5./,            D3/100.,4.,3.,2.,1.5,1.,.8,.6,.4,.2,0./
      DATA AK6112/0.,1. , .21,1.21 , .32,1.32 , .46,1.46 ,.54,1.54 ,    &
     & .61,1.61 , .68,1.68 , .72,1.72 , .8,1.8 , .89,1.89 , 1.,2. /
!
!     ----TABLES FOR UPWASH GRADIENT AT PLANE OF SYMMETRY FOR UNSWEPT
!     ----WINGS. FIGURE 4.4.1-73
!
      DATA X14161/4.,6.,9.,12./
      DATA X24161/.25,.4,.5,.6,.7,.8,1.0,1.2,1.6,2.0/
      DATA Y44161/1.08,.545,.40,.31,.24,.20,.13,.10,.06,.04 , 1.18,.680,&
     &.52,.40,.32,.27,.19,.15,.10,.08 , 1.30,.81,.62,.49,.40,.34,.25,.20&
     &,.13,.12 , 1.4,.88,.70,.56,.445,.39,.30,.24,.165,.14 /
!
!     ---- FACTORS FOR DETERMINING DOWNWASH DUE TO PROPELLERS.
!     ----FIGURE 4.6.1-26
!
      DATA I26113/0/,I16113/0/
      DATA X46113 /0.,.5,1.,1.5,2.,2.5,3.,3.5,4.,5.,6.,7.,8.,9.,10.,11.,&
     &             12.,19.,20./
      DATA C16113/0.,.25,.36,.44,.49,.54,.575,.61,.64,.675,.708,.73,.75,&
     &          .76,.78,.79,.798,.84/
      DATA C26113/.25,.24,.225,.205,.19,.175,.165,.16,.15,.14,.13,.12,  &
     &            .11,.10,.099,.098,.097,.078,.075/
!
!     ----EFFECT OF PROPELLER POWER ON THE DYNAMIC PRESSURE RATIO AT HT
!     ----FIGURE 4.6.3-16
!
      DATA X14637/0.,.2,.4,.6,.8,1.0/,X24637/0.,.2,.4,.8,1.2,1.8/
      DATA Y4637/6*0.,0.,.95,1.25,2.0,2.75,3.8,0.,1.99,2.8,4.1,5.5,7.7, &
     &0.,2.80,4.25,6.3,8.3,11.3,0.,3.7,5.75,8.5,11.05,15.0,0.,4.61,6.8, &
     &10.25,13.75,18.8/
!
!     ----2ND PART OF FIGURE 4.6.3-16
!
      DATA Z24637/0.,20./,XT4637/0.,.2,.4,.5,.6,.7,.8,.9,1.,1.1,1.2,1.3,&
     &1.4 /
      DATA YF4637 /-.1,1.9 , -.1,1.8 , -.1,1.72 , -.1,1.63 , -.1,1.46 , &
     & -.1,1.31 , -.1,1.175 , -.1,1.025 , -.1,.85 , -.1,.63 , -.1,.43 , &
     & -.1,.22 , -.1,.03 /
!
!     ----PROPELLER DRAG FACTOR  FIGURE 4.6.4-13A
!
      DATA I4648A/0/
      DATA X4648A /0.,5.,10.,15.,20.,25.,30.,35.,40.,45.,48.5/
      DATA Y4648A /4.,2.84,2.20,1.75,1.45,1.25,1.08,0.98,0.87,0.82,0.76/
!
!     ----AVERAGE PROPELLER DOWNWASH FIGURE 4.6.4-13B
!
      DATA X1648B/.1,.2,.3,.4,.5/
      DATA X2648B/0.,2.5,5.,7.5,10.,12.5,15.,20.,25.,30.,35.,40.,45.,50.&
     &/
      DATA Y4648B /0.,.22,.32,.39,.44,.49,.53,.59,.64,.68,.71,.73,.75,  &
     &.76 , .3,.45,.542,.60,.655,.70,.73,.776,.81,.835,.85,.87,.88,.89 ,&
     & .55,.66,.73,.78,.81,.83,.85,.88,.90,.915,.93,.94,.942,.95 ,  .81,&
     &.84,.87,.89,.905,.92,.93,.95,.96,.966,.971,.975,.98,.98, 1.0,.99, &
     &.978,.97,.967,.968,.972,.982,.989,.995,4*1.0 /
!
!---------    FIGURE 4.1.4.1-5
!     ----Y41412(16,5,3) , X31412=TAPER RATIO  X11416= ASPECT RATIO
!     ----X21412=QUARTER CHORD SWEEP ANGLE
!
      DATA X31412 /0.,.5,1./
      DATA X11412 /10.,8.,6.,3.5,1.5/
      DATA X21412 /0., 2.5 , 5. , 7.5 , 10. , 12.5 , 15. , 20. , 25. ,  &
     &             30. , 35. , 40. , 45. , 50. , 55. , 60. /
      DATA Y415A /                                                      &
     & -.0000, -.0005, -.0011, -.0016, -.0022, -.0028, -.0033, -.0045,  &
     & -.0057, -.0069, -.0081, -.0094, -.0107, -.0120, -.0133, -.0147,  &
     & -.0000, -.0004, -.0008, -.0012, -.0016, -.0020, -.0025, -.0033,  &
     & -.0041, -.0050, -.0059, -.0068, -.0078, -.0088, -.0099, -.0111,  &
     & -.0000, -.0002, -.0005, -.0008, -.0010, -.0013, -.0015, -.0021,  &
     & -.0027, -.0033, -.0039, -.0045, -.0052, -.0059, -.0066, -.0074,  &
     & -.0000, -.0001, -.0002, -.0003, -.0004, -.0005, -.0007, -.0009,  &
     & -.0011, -.0014, -.0017, -.0020, -.0024, -.0027, -.0032, -.0036,  &
     & -.0000, -.0000, -.0000, -.0001, -.0001, -.0001, -.0001, -.0002,  &
     & -.0003, -.0003, -.0004, -.0005, -.0006, -.0007, -.0008, -.0009 /
      DATA Y415B /                                                      &
     & -.0000, -.0009, -.0018, -.0027, -.0037, -.0046, -.0056, -.0076,  &
     & -.0097, -.0118, -.0140, -.0162, -.0185, -.0208, -.0232, -.0257,  &
     & -.0000, -.0006, -.0013, -.0019, -.0026, -.0033, -.0040, -.0054,  &
     & -.0069, -.0084, -.0099, -.0116, -.0134, -.0153, -.0172, -.0193,  &
     & -.0000, -.0004, -.0008, -.0012, -.0016, -.0021, -.0025, -.0034,  &
     & -.0043, -.0053, -.0063, -.0074, -.0086, -.0099, -.0113, -.0128,  &
     & -.0000, -.0002, -.0003, -.0005, -.0007, -.0008, -.0010, -.0014,  &
     & -.0018, -.0022, -.0026, -.0031, -.0037, -.0043, -.0050, -.0058,  &
     & -.0000, -.0000, -.0001, -.0001, -.0001, -.0002, -.0002, -.0003,  &
     & -.0004, -.0005, -.0006, -.0007, -.0008, -.0010, -.0011, -.0013 /
      DATA Y415C /                                                      &
     & -.0000, -.0010, -.0019, -.0029, -.0039, -.0049, -.0059, -.0080,  &
     & -.0101, -.0122, -.0143, -.0166, -.0190, -.0214, -.0240, -.0266,  &
     & -.0000, -.0007, -.0013, -.0020, -.0027, -.0034, -.0041, -.0056,  &
     & -.0071, -.0086, -.0101, -.0118, -.0136, -.0155, -.0176, -.0197,  &
     & -.0000, -.0004, -.0008, -.0012, -.0017, -.0021, -.0026, -.0035,  &
     & -.0044, -.0054, -.0065, -.0076, -.0089, -.0102, -.0117, -.0132,  &
     & -.0000, -.0002, -.0003, -.0005, -.0007, -.0008, -.0010, -.0014,  &
     & -.0018, -.0022, -.0026, -.0031, -.0037, -.0043, -.0050, -.0057,  &
     & -.0000, -.0000, -.0001, -.0002, -.0002, -.0003, -.0003, -.0004,  &
     & -.0005, -.0006, -.0007, -.0008, -.0009, -.0010, -.0012, -.0013 /
!
!    -----FIGURE 4.6.3-14
!    -----INCREMENT IN DOWNWASH DUE TO PROPELLER POWER FOR SINGLE-ENGINE
!    -----AIRPLANES
!
      DATA X1638A/14.0,12.0,10.0,8.0,6.0,4.0,2.0,0.0/
      DATA X2638A/0.0,0.2,0.4,0.6,0.8,1.0,1.2,1.4/
      DATA Y4638A/0.0,1.5,2.17,2.68,3.2,3.64,4.06,4.47  , 0.0,1.27,1.93,&
     &2.40,2.80,3.12,3.40,3.68,  0.0,1.03,1.55,1.96,2.28,2.55,2.79,3.00,&
     &0.00,0.80,1.20,1.50,1.70,1.90,2.06,2.20,   0.0,0.56,0.9,1.11,1.30,&
     &1.45,1.58,1.68,   0.0,0.40,0.65,0.80,0.94,1.08,1.11,1.18,  0.0,   &
     &0.30,0.45,0.52,0.61,0.65,0.70,0.72,  0.0,0.15,0.21,0.26,0.31,0.32,&
     &0.32,0.31/
      DATA X1638B/0.0,0.6,1.0,1.2/
      DATA X2638B/0.0,4.8/
      DATA Y4638B/0.0,9.85,   0.0,8.7,  0.0,7.5,   0.0,5.9/
!
!    -----FIGURE 4.6.3-15
!    -----INCREMENT IN DOWNWASH DUE TO PROPELLOR POWER FOR MULTI-ENGINE
!    -----AIRPLANES
!
      DATA X1639A/10.0,8.0,6.0,5.0,4.0,3.0,2.0,1.0/
      DATA X2639A/0.0,0.2,0.4,0.6,0.8,1.0,1.2,1.4/
      DATA Y4639A/0.0,1.50,2.25,2.77,3.10,3.37,3.60,3.80,  0.0,1.40,    &
     &2.10,2.57,2.87,3.12,3.31,3.48,   0.0,1.17,1.80,2.20,2.47,2.68,    &
     &2.87,3.01,  0.0,1.08,1.60,1.95,2.20,2.40,2.54,2.66,  0.0,0.90,    &
     &1.32,1.60,1.82,2.00,2.13,2.25,  0.0,0.7,1.05,1.28,1.48,1.60,      &
     &1.70,1.78,  0.0,0.50,0.78,0.92,1.05,1.13,1.20,1.25, 0.0,0.28,     &
     &0.43,0.52,0.60,0.61,0.62,0.62/
      DATA I4639B/0/
      DATA X4639B/0.0,4.0/
      DATA Y4639B/0.0,4.0/
      DATA X1639C/0.0,0.4,0.7,1.0,1.2/
      DATA X2639C/0.0,4.0/
      DATA Y4639C/0.0,10.0, 0.0,9.6, 0.0,8.75, 0.0,7.45, 0.0,5.90/
      DATA IY / 0 /, QCLTB / 4HCLTB /
!
!     ----STATEMENT FUNCTION TO COMPUTE CBARR*S
!
      FUNCB(TRI)=2.*(1.+TRI*(1.+TRI))/(3.*(1.+TRI))
      CALL ZERANG(ARGCS)
      SAVE=CT
      CFWPO=D(10)+D(11)
      CFHPO=DHT(10)+DHT(11)
      CFVPO=DVT(10)+DVT(11)
      SWITCH=.FALSE.
      IF(NENGSP.EQ.1.)GO TO 1010
      IF(BST0O2.EQ.UNUSED) GO TO 1010
      IF(YP.LE.BO2-BST0O2) GO TO 1000
      CRP=CB-(CB-CT)*((YP-(BO2-BST0O2))/BST0O2)
      XBARP=(XW+A(62)*(BO2-BST0O2)+A(86)*(YP-(BO2-BST0O2))-PHALOC       &
     &)*COS(DEG*ALIW)
      GO TO 1020
 1000 CONTINUE
      CT=CB
 1010 CRP=CR-(CR-CT)*YP/(BO2-BST0O2)
      XBARP=(XW+A(62)*YP+CRP/4.0-PHALOC)*COS(DEG*ALIW)
      CT=SAVE
 1020 CONTINUE
!
!     ----FIG 4.4.1-73
!
!*** In call to TlineX, original XBARP changed to XBARP/CRP by RLC 18Jun2004
      DEUDA = -1.0
      IF((XBARP/CRP) .LT. 0.25) GO TO 1025
      CALL TLINEX(X14161,X24161,Y44161,4,10,AR,XBARP/CRP,DEUDA,             &
     &            2,2,2,2,Q44161,2,ROUTID)
 1025 CONTINUE
      COSAIW=COS(DEG*ALIW)
      PRPRD2=PRPRAD**2
      SRTPCO=SRW*THSTCP/(8.0*PRPRD2)
!
!     ----COMPUTE ENGINE FACTOR KN UNLESS IT WAS INPUT
!
      IF(KN.EQ.UNUSED) KN=NOPBPE*(262.0*BWAPR3+262.*BWAPR6+135.*BWAPR9) &
     &                    /PRPRAD
!
!     ----COMPUTE (CNA)P
!     ----PROPELLER NORMAL FORCE PARAMETER FIGURE 4.6.1-25A
!     ----TEST FOR SINGLE OR COUNTER ROTATION
!
      IF(CROT.AND.NOPBPE.GE.6)GO TO 1030
      CALL TLINEX(X1S11B,X2S11B,YSR11B,4,7,NOPBPE,BAPR75,CNAP80,        &
     &            0,2,2,2,Q6125A,3,ROUTID)
      GO TO 1040
 1030 CALL TBFUNX(BAPR75,CNAP80,DYDX,6,X6111B,Y6111B,C6111B,I6111B,MI,NG&
     &           ,2,2,Q6125A,3,ROUTID)
 1040 CNAP=CNAP80*(1.+.8*(KN/80.7-1.))
!
!     ----FIGURE 4.6.1-26
!
      CALL TBFUNX(SRTPCO,C1,DYDX,18,X46113,C16113,C61131,I16113,MI,NG,  &
     &            0,1,Q46126,2,ROUTID)
      CALL TBFUNX(SRTPCO,C2,DYDX,19,X46113,C26113,C61132,I26113,MI,NG,  &
     &            0,1,Q46126,2,ROUTID)
      DEPDAP=C1+C2*CNAP
!
!     ----COMPUTE PROPELLER INFLOW FACTOR FIGURE 4.6.1-25B
!
      CALL TBFUNX(SRTPCO,F,DYDX,11,X6111A,F6111A,C6111A,I6111A,MI,NG,   &
     &            0,2,Q6125B,3,ROUTID)
      COMBO1=PI*NENGSP*F*CNAP*PRPRD2/(RAD*SRW)
      COMBO=NENGSP*THSTCP
      ALPHAP=AIETLP+DEUDA*(ALIW-ALPHA0)
      ALPHAP=ALPHAP-DEPDAP*ALPHAP
      SINAP=SIN(DEG*ALPHAP)
      TANAP=TAN(DEG*ALPHAP)
      ZS=PHVLOC+XBARP*TANAP
      IF(.NOT.HTPL)GO TO 1080
!
!     ----COMPUTE HORIZONTAL TAIL QUANTITIES
!
      COSAIH=COS(DEG*ALIH)
      TN=XH+XBARRH*COSAIH-(XW+XBARRW*COSAIH)
      ZHEFF=ZS-ZH+TN*TAN(DEG*ALPHAP)
      IF(PRPRD2.LT.(ZHEFF**2))GO TO 1060
      IF(NENGSP.EQ.2.0) GO TO 1050
      SIOSRH=1.0
      SIH=SRH
      IF(PRPRAD.GE.BO2H)GO TO 1070
      CTIH=CRH-PRPRAD*(CRH-CTH)/BO2H
! following line changed by RLC 21 Dec 2004 to defend against sqrt(<0)
      BIO2H=SQRT(MAX(0.0, PRPRD2-(ZHEFF**2)))
      SIH=BIO2H*(CRH+CTIH)
      SIOSRH=SIH/SRH
      GO TO 1070
 1050 IF(YP-PRPRAD.GE.BO2H) GO TO 1060
      SIH=(BO2H-YP+PRPRAD)/BO2H*SRH
      SIOSRH=SIH/SRH
      GO TO 1070
 1060 SIH=0.0
      SIOSRH=0.0
!
!     ----FIRST PART OF FIGURE 4.6.3-16. THIS PART NOT FUNCTION OF ALPHA
!
 1070 CALL TLINEX(X14637,X24637,Y4637,6,6,SIOSRH,SRTPCO,YTEMP,          &
     &            0,0,0,1,Q46316,2,ROUTID)
 1080 CONTINUE
!
!     CALCULATE GEOMETRIC PARAMETERS FOR CD0 + CM0 CALCULATIONS
!
! following line changed by RLC 21 Dec 2004 to defend against sqrt(<0)
      BIO2=SQRT(MAX(0.0, PRPRD2-(ZS-(ZW-XBARRW*SINAP))**2))
      IF(NENGSP.EQ.2.0) GO TO 1100
      IF(BIO2.GT.(BO2-BST0O2))GO TO 1090
      CTI=CR-BIO2*((CR-CB)/(BO2-BST0O2))
      BSTIO2=BIO2-BO2+BSTO2
      SSTRI=(CRSTR+CTI)*BSTIO2
      SI=(CR+CTI)*BIO2
      TRI=CTI/CR
      CBARLI=CR*FUNCB(TRI)
      SWEEPA=A(69)
      TRPSI=CTI/CRSTR
      ASTARI=4.0*(BSTIO2**2)/SSTRI
      GO TO 1110
 1090 BST0I2=BST0O2-(BO2-BIO2)
      CTI=CB-BST0I2*(CB-CT)/BST0O2
      SST0I=(CB+CTI)*BST0I2
      SSTRI=SSTARI+SST0I
      SCAPI=(CR+CB)*(BO2-BST0O2)
      SI=SCAPI+SST0I
      TRS0I=CTI/CB
      CBSR0I=CB*FUNCB(TRS0I)
      CBARLI=(SCAPI*CBARCI+SST0I*CBSR0I)/SI
!
!     ----COMPUTE ARCOSINE IN DEGREES.THIS AVOIDS USE OF ACOS OR ARCOS
!
      ARGCS(4)=(SSTRI*A(67)+SST0I*A(91))/SSTRI
      CALL ANGLES(4,ARGCS)
      SWEEPA=ARGCS(2)
      TRPSI=A(26)*TRS0I
      BSTIO2=A(23)+BST0I2
      ASTARI=4.0*(BSTIO2**2)/SSTRI
      GO TO 1110
 1100 SSTRI=BIO2*CRP*4.0
      ASTARI=4.0*BIO2**2/(.50*SSTRI)
      TRPSI=1.0
      SWEEPA=A(106)
      IF(YP.GT.BO2-BST0O2) SWEEPA=A(112)
      CBARLI=CRP
      SI=SSTRI
      GO TO 1120
 1110 CONTINUE
!
!     ----COMPUTE (DELTA CDO)S
!
      DCD0S=((SRTPCO*8.0)/(PI*SRW))*(CFWPO*SSTRI+CFHPO*SIH+.50*CFVPO*   &
     &      SSTRRV +CFBPO*SSB)
      GO TO 1130
 1120 DCD0S=((SRTPCO*8.0)/(PI*SRW))*(SSTRI*CFWPO)
      IF(YP.GT.(BO2-BST0O2))DCD0S=((SRTPCO*8.0)/(PI*SRW))*              &
     &   (SSTRI*D(12))
 1130 CD0POW=CD0+DCD0S
      RPNOB=.5*NENGSP*PRPRAD/BO2
!
!    ----COMPUTE PROPELLER DRAG FACTOR. FIGURE 4.6.4-13A
!
      CALL TBFUNX(SRTPCO,AAK,DYDX,11,X4648A,Y4648A,C4648A,I4648A,MI,NG, &
     &            0,2,Q6413A,3,ROUTID)
!
!     ----COMPUTE AVERAGE PROPELLER DOWNWASH . FIGURE 4.6.4-13B
!
      CALL TLINEX(X1648B,X2648B,Y4648B,5,14,RPNOB,SRTPCO,EBROEP,        &
     &             2,0,2,2,Q6413B,3,ROUTID)
!
!     ----COMPUTE PITCHING MOMENT QUANTITIES
!
      DCMT=THSTCP*(ZCG-PHVLOC)*NENGSP/CBARR
      COSSWA=COS(DEG*SWEEPA)
      CM0IN=CM0
      CM02=CMOT
      CM0OVA=CM0
      SWITCH=.FALSE.
      IF(ABS(CM0IN).LT.1.E-10.OR.ABS(CM02).LT.1.E-10) SWITCH=.TRUE.
      IF(SWITCH)GO TO 1140
      CM0OVA=0.5*(CM0IN+CM02)
 1140 CM0TE0=ASTARI*COSSWA**2*CM0OVA/(ASTARI+2.0*COSSWA)
!
!     ----TEST FOR TWIST
!
      IF(TWISTA.LT.1.E-10) GO TO 1150
!
!     ----GET CM0 THETA FROM FIG 4.1.4.1-5
!
      CALL TLIN3X(X11412,X21412,X31412,Y41412,5,16,3,ASTARI,SWEEPA,     &
     &            TRPSI,DCM0OT,2,0,0,2,2,0,Q41412,3,ROUTID)
      CM0I=CM0TE0+DCM0OT*TWISTA
      GO TO 1160
 1150 CM0I=CM0TE0
 1160 DCMQ=(SRTPCO*SI/SRW*CBARLI/CBARR*CM0I)*8.0/PI
      XBRSRR=A(16)/4.+(A(1)*A(32)*A(62)+A(2)*(A(23)*A(62)+(A(33)-A(23))*&
     & A(86))) /A(3)
      NALPHA=FLC(2)+.5
!
!     ----START ALPHA LOOP (big)
!
      DO 1270 J=1,NALPHA
         ALPHAT=ALSCHD(J)+AIETLP
         COSAT=COS(DEG*ALPHAT)
         SINAT=SIN(DEG*ALPHAT)
         ALPHAP=ALPHAT+DEUDA*(ALIW+ALSCHD(J)-ALPHA0)
         CNP=CNAP*ALPHAP/RAD*PI*PRPRAD**2/SRW
         EBAR=EBROEP*DEPDAP*ALPHAP
!
!     ----COMPUTE (DELTA CL)NP
!
         DCLNP(J)=COMBO1*ALPHAP*COSAT
         EP=DEPDAP*ALPHAP
         ALPHAP=ALPHAP-EP
         SINAP=SIN(DEG*ALPHAP)
         TANAP=TAN(DEG*ALPHAP)
         ZS=PHVLOC+XBARP*TANAP
         IF(ZS-ZW.GT.PRPRAD) ZS=PRPRAD
! following line changed by RLC 21 Dec 2004 to defend against sqrt(<0)
         BIO2=SQRT(MAX(0.0, PRPRD2-(ZS-ZW)**2))
         IF(DEUDA .EQ. -1.0) ZS = PHVLOC
         IF(NENGSP.EQ.2.0) GO TO 1180
         IF(BIO2.GT.(BO2-BST0O2))GO TO 1170
         IF(BIO2.LE.BO2-BSTO2) GO TO 1200
         CTI=CR-BIO2*((CR-CB)/(BO2-BST0O2))
         BSTIO2=BIO2-BO2+BSTO2
         SSTRI=(CRSTR+CTI)*BSTIO2
         ASTARI=4.0*(BSTIO2**2)/SSTRI
         GO TO 1190
 1170    BST0I2=BST0O2-(BO2-BIO2)
         CTI=CB-BST0I2*(CB-CT)/BST0O2
         SST0I=(CB+CTI)*BST0I2
         SSTRI=SSTARI+SST0I
         BSTIO2=A(23) +BST0I2
         ASTARI=4.0*(BSTIO2**2)/SSTRI
         GO TO 1190
 1180    SSTRI=4.0*BIO2*CRP
         ASTARI=4.0*BIO2**2/(.50*SSTRI)
 1190    CONTINUE
!
!     ----COMPUTE (DELTA CL)Q
!     ----CORRELATION PARAMETER FOR ADDITIONAL WING LIFT DUE TO PROP POW
!     ----COMPUTE CORRELATION PARAMETER FOR ADDITIONAL WING LIFT DUE TO
!         PROPELLER POWER. FIGURE 4.6.1-27
!
         CALL TLINEX(X16112,X26112,Y46112,3,9,ASTARI,AR,BS1,            &
     &               0,0,2,0,Q46112,2,ROUTID)
         CALL TBFUNX(SRTPCO,BS2,DYDX,9,XB6112,DM2,C46112,I46112,MI,NG,  &
     &               0,2,Q46112,2,ROUTID)
         CALL TLINEX(DC1,DC2,DC3,5,2,BS2,BS1 ,BS3,                      &
     &               0,0,0,0,Q46112,2,ROUTID)
         CALL TLINEX(D3,D4,AK6112,11,2,SRTPCO,BS3,AK1,                  &
     &               0,0,0,0,Q46112,2,ROUTID)
         IF(DEUDA .EQ. -1.0) GO TO 1200
         DCLQ(J)=8.0*AK1*SRTPCO*SSTRI/(PI*SRW)*CLW(J)
         DELALP=-EP/(1.0+DEUDA)
         DCLAW(J)=CLALPA*DELALP*SSTRI*AK1/SRW*(1.0+8.0*SRTPCO/PI)
         GO TO 1210
 1200    DCLQ(J)=0.0
         DCLAW(J)=0.0
 1210    CONTINUE

!     ----COMPUTE (DELTA CL)T
         DCLT(J)=COMBO*SINAT

!     ----COMPUTE (DELTA CLHQ)
         DCLHQ(J)=0.
         DCLHE(J)=0.0
         DCMHE(J)=0.

!     ----TEST FOR PRESENCE OF HORIZONTAL TAIL
         IF(.NOT.HTPL) GO TO 1240
!
         DXHMAC=XH+XBARRH*COSAIH-PHALOC
         ZHT=ZH-PHVLOC+(XH+XBARRH*COSAIH-PHALOC)*TAN(DEG*AIETLP)
         ZHTORP=ZHT/PRPRAD
         IF(NENGSP.GT.1.0)GO TO 1220

!     ----SINGLE ENGINE.USE FIGURE 4.6.3-14
!     ----INCREMENT IN DOWNWASH DUE TO PROPELLER POWER FOR SINGLE ENGINE
         CALL TLINEX(X1638A,X2638A,Y4638A,8,8,EPSLON(J),SRTPCO,STEP1,   &
     &               0,0,2,2,Q6314A,3,ROUTID)
         CALL TLINEX(X1638B,X2638B,Y4638B,4,2,ZHTORP,STEP1,DEPOWR,      &
     &               0,1,2,1,Q6314A,3,ROUTID)
         GO TO 1230

!     ----MUTIPLE ENGINE.USE FIGURE 4.6.3-15
!     ----INCREMENT IN DOWNWASH DUE TO PROP. POWER FOR MULTIPE ENGINES.
 1220 CONTINUE
         CALL TLINEX(X1639A,X2639A,Y4639A,8,8,EPSLON(J),SRTPCO,STEP1,   &
     &               2,2,2,2,Q46315,2,ROUTID)
         CALL TBFUNX(STEP1,FLPSUP,DYDX,2,X4639B,Y4639B,C4639B,I4639B,   &
     &               MI,NG,0,1,Q46315,2,ROUTID)
         CALL TLINEX(X1639C,X2639C,Y4639C,5,2,ZHTORP,FLPSUP,DEPOWR,     &
     &               0,0,2,1,Q46315,2,ROUTID)
 1230    CONTINUE
         CALL TBFUNX(ALSCHD(J),CLH(J),CLALPH,NALPHA,ALSCHD,CLHT,CA,IY,  &
     &               MI,NG,1,1,QCLTB,1,ROUTID)
         TN=XH+XBARRH*COSAIH-(XW+XBARRW*COSAIH)
         EPOWR=EPSLON(J)+DEPOWR
         ZHEFF=ZS-ZH+TN*TAN(DEG*(ALPHAP-EPOWR))
         ZHORP=ZHEFF/PRPRAD
!
!     ----2ND PART OF FIGURE 4.6.3-16
!
         CALL TLINEX(XT4637,Z24637,YF4637,13,2,ABS(ZHORP),YTEMP,        &
     &         DQHOQI,0,0,2,1,Q46316,2,ROUTID)
         DCLHQ(J)=DQHOQI*CLH(J)
!
!     ----LIFT DUE TO CHANGE IN ANGLE OF ATTACK OF HORIZONTAL TAIL
!
         DCLHE(J)=-CLALPH*DEPOWR*(QHOQI(J)+DQHOQI)
         DLH=XH+XBARRH*COSAIH-XCG
         DCMHE(J)=-DLH*DCLHE(J)/CBARR
!
!     ----COMPUTE TOTAL PROPELLER EFFECTS ON LIFT OF WING BODY-TAIL
 1240    DCLPON(J)=DCLT(J)+DCLNP(J)+DCLQ(J)+DCLAW(J)+DCLHQ(J)+DCLHE(J)

!     ----PITCHING MOMENT SECTION
         DCMNP(J)=DCLNP(J)*(XCG-PHALOC)/(CBARR*COSAT)
         XCP=(XW+XBRSRR*COSAIW)-XCG
         DCML(J)=-(DCLQ(J)+DCLAW(J))*XCP/CBARR
         DCMHQ(J)=-DLH*DCLHQ(J)/CBARR
         DCM(J)=DCMT+DCMNP(J)+DCMQ+DCML(J)+DCMHQ(J)+DCMHE(J)

!     ----DRAG SECTION
!     ----COMPUTE(CDLJ)POWER ON
         CLP=(THSTCP*SINAT+CNP*COSAT)*NENGSP
         IF(CLW(J).EQ.0.0) GO TO 1250
         CLWW=CLW(J)+DCLQ(J)
         CDLRAT=(CLWW/CLW(J))**2*(1.+PISQRD*AR*EBAR/(180.*CLWW))+AAK*   &
     &          (BO2/PRPRAD*CLP/CLW(J))**2
         GO TO 1260
 1250    CDLRAT=0.0
 1260    CDLPOW=CDLRAT*CDL(J)
         CDPOW(J)=DCD0S+CDLPOW-CDL(J)
 1270 END DO
      RETURN
      END Subroutine Prpwef
      SUBROUTINE PTCP(RSP,TOR,CASENO,PSTROT,TCPOUT)
!
!***  CALCULATES SUBSONIC CONTROL/FLAP PRESURE RATIO RATIO AND CP
!
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /WINGD/  A(195)
      COMMON /POWR/   SPR(59)
      DIMENSION PP(19),AREA(19),SUMA(19),AMON(19),SUMM(19),TCP(19)      &
     &          ,PSTR(19),RR(19),CPSTR(6),CTCP(6)
      EQUIVALENCE(TANLLE,A(62)),(TANLTE,A(80)),(BETA,SPR(1)),           &
     &           (TANLHL,SPR(14))
      INTEGER CASENO
      LOGICAL ONLY10
      DATA RR/.1,.2,.3,.4,.5,.6,.7,.8,.9,1.,2.,3.,4.,5.,6.,7.,8.,9.,10./
!
 1000 TANLEB=TANLLE/BETA
      IPSTR=0
      ITCP=0
      ONLY10=.FALSE.
      IF(CASENO.GT.2.AND.CASENO.LT.7)ONLY10=.TRUE.
      IF(ONLY10)GO TO 1090
      IF(TOR.EQ.2.0)GO TO 1070
!
!     ---HERE FOR TIP . MACH CONE AREAS 1,2,7 AND 8 .
!
      TP1=1.0+TANLEB
      RINC=.1
      RP=.1
      DO 1010 K=1,19
         PP(K)=ARCCOS((TP1-RP)/(TP1+RP))/PI
         IF(K.EQ.10)RINC=1.0
         RP=RP+RINC
 1010 END DO
      GO TO 1130
 1020 AREA(11)=.37500*PP(10)+.791667*PP(11)-.208333*PP(12)+.041667*PP(13&
     &)
      AREA(12)=-.041667*PP(10)+.541667*PP(11)+.541667*PP(12)-.041667*PP(&
     &13)
      AREA(13)=.041667*PP(10)-.208333*PP(11)+.791667*PP(12)+.375000*PP(1&
     &3)
      AREA(14)=.375000*PP(13)+.791667*PP(14)-.208333*PP(15)+.041667*PP(1&
     &6)
      AREA(15)=-.041667*PP(13)+.541667*PP(14)+.541667*PP(15)-.041667*PP(&
     &16)
      AREA(16)=.041667*PP(13)-.208333*PP(14)+.791667*PP(15)+.375000*PP(1&
     &6)
      AREA(17)=.375000*PP(16)+.791667*PP(17)-.208333*PP(18)+.041667*PP(1&
     &9)
      AREA(18)=-.041667*PP(16)+.541667*PP(17)+.541667*PP(18)-.041667*PP(&
     &19)
      AREA(19)=.041667*PP(16)-.208333*PP(17)+.791667*PP(18)+.375000*PP(1&
     &9)
      SUMA(11)=SUMA(10)+AREA(11)
      DO 1030 K=11,19
         SUMA(K)=SUMA(K-1)+AREA(K)
 1030 END DO
      IF(TOR.EQ.1.0)GO TO 1220
 1040 AMON(11)=.37500*PP(10)+1.583333*PP(11)-.625000*PP(12)+.166667*PP( &
     &           13)
      AMON(12)=-.041667*PP(10)+1.083333*PP(11)+1.625000*PP(12)-.166667* &
     &           PP(13)
      AMON(13)=.041667*PP(10)-.416667*PP(11)+2.375000*PP(12)+1.500000*  &
     &         PP(13)
      AMON(14)=1.5000*PP(13)+3.958333*PP(14)-1.250000*PP(15)+.291667*   &
     & PP(16)
      AMON(15)=-.166667*PP(13)+2.708333*PP(14)+3.250000*PP(15)-.291667* &
     & PP(16)
      AMON(16)=.166667*PP(13)-1.041667*PP(14)+4.750000*PP(15)+2.625*PP( &
     & 16)
      AMON(17)=2.625*PP(16)+6.333333*PP(17)-1.875000*PP(18)+.416667*    &
     & PP(19)
      AMON(18)=-.291667*PP(16)+4.333333*PP(17)+4.875000*PP(18)-.416667* &
     & PP(19)
      AMON(19)=.291667*PP(16)-1.666667*PP(17)+7.12500*PP(18)+3.75*PP(19)
      DO 1050 K=11,19
         SUMM(K)=SUMM(K-1)+AMON(K)
 1050 END DO
      TM=.1
      R=.1
      DO 1060 K=1,19
         PSTR(K)=SUMA(K)/R
         IF(K.EQ.10)TM=1.0
         R=R+TM
         TCP(K)=SUMA(K)/(SUMA(K)+SUMM(K))
 1060 END DO
      GO TO 1260
!
!     ----HERE FOR ROOT
!
 1070 TANSQ=TANLEB**2
      OMTTSQ=1.-2.*TANSQ
      TM=.1
      R=0.
      DO 1080 K=1,19
         IF(K.EQ.11)TM=1.0
         R=R+TM
         RP1SQ=(1.+R)**2
         PP(K)=ARCCOS((TANSQ+OMTTSQ*RP1SQ)/(RP1SQ-TANSQ))/PI
 1080 END DO
      AREA(1)=.130786*PP(1)-.045340*PP(2)
      GO TO 1140
!
!     ----HERE FOR MACH CONE AREAS 3 AND 4 OR 5 AND 6.
!
 1090 IF(CASENO.GT.4)GO TO 1100
      TGEN=TANLTE
      GO TO 1110
 1100 TGEN=TANLHL
 1110 TGEN=TGEN/BETA
      IF(TOR.EQ.2.0)GO TO 1180
!
!     ----HERE FOR TIP
!
      OPTNOB=1.0+TANLEB
      TWTNTN=2.+TANLEB+TGEN
      TNDIF=TANLEB-TGEN
      EN=.1
      DO 1120 K=1,10
         PP(K)=ARCCOS((OPTNOB-TWTNTN*EN)/(OPTNOB-TNDIF*EN))/PI
         EN=EN+0.1
 1120 END DO
 1130 AREA(1)=.113301*PP(1)-.032975*PP(2)
 1140 AREA(2)=.037500*PP(1)+.079167*PP(2)-.020833*PP(3)+.004167*PP(4)
      AREA(3)=-.004167*PP(1)+.054167*PP(2)+.054167*PP(3)-.004167*PP(4)
      AREA(4)=.004167*PP(1)-.020833*PP(2)+.079167*PP(3)+.037500*PP(4)
      IF(.NOT.ONLY10.AND.TOR.EQ.1.0)GO TO 1200
      IF(TOR.EQ.2.0)GO TO 1200
      AREA(5)=.041667*PP(4)+.066667*PP(5)-.008333*PP(6)
      AREA(6)=-.008333*PP(4)+.066667*PP(5)+.041667*PP(6)
      AREA(7)=.037500*PP(6)+.079167*PP(7)-.020833*PP(8)+.004167*PP(9)
      AREA(8)=-.004167*PP(6)+.054167*PP(7)+.054167*PP(8)-.004167*PP(9)
      AREA(9)=.004167*PP(6)-.020833*PP(7)+.079167*PP(8)+.037500*PP(9)
      AREA(10)=-.038494*PP(8)+.121105*PP(9)+.017389*PP(10)
      SUMA(1)=AREA(1)
      DO 1150 K=2,10
         SUMA(K)=AREA(K)+SUMA(K-1)
 1150 END DO
      AMON(1)=.007917*PP(1)-.004167*PP(2)+.001250*PP(3)
      AMON(2)=.005417*PP(1)+.010833*PP(2)-.001250*PP(3)
      AMON(3)=-.002083*PP(1)+.015833*PP(2)+.011250*PP(3)
      AMON(4)=.011250*PP(3)+.031667*PP(4)-.010416*PP(5)+.002500*PP(6)
      AMON(5)=-.001250*PP(3)+.021667*PP(4)+.027083*PP(5)-.002500*PP(6)
      AMON(6)=.001250*PP( 3)-.008333*PP(4)+.039583*PP(5)+.022500*PP(6)
      AMON(7)=0.022500*PP(6)+.055417*PP(7)-.016667*PP(8)+.003750*PP(9)
      AMON(8)=-.002500*PP(6)+.037917*PP(7)+.043334*PP(8)-.003750*PP(9)
      AMON(9)=.002500*PP(6)-.014583*PP(7)+.063334*PP(8)+.033750*PP(9)
      AMON(10)=-.030795*PP(8)+.108995*PP(9)+.017389*PP(10)
      SUMM(1)=AMON(1)
      DO 1160 K=2,10
          SUMM(K)=AMON(K)+SUMM(K-1)
 1160 END DO
      EN=.1
      DO 1170 K=1,10
         PSTR(K)=SUMA(K)/EN
         TCP(K)=(SUMA(K)-SUMM(K))/(SUMA(K)+TGEN*SUMM(K))
         EN=EN+.1
 1170 END DO
      GO TO 1260
!
!     ----HERE FOR ROOT
!
 1180 EN=.1
      TSQ=TANLEB**2
      TMP=2.*(1.-TSQ)
      DO 1190 K=1,10
         PP(K)=ARCCOS(TMP/(1.-TSQ*((1.0-EN)/(1.-TGEN*EN))**2)-1.0)/PI
         EN=EN+.1
 1190 END DO
      AREA(1)=.130786*PP(1)-.045340*PP(2)
      GO TO 1140
 1200 AREA(5)=.037500*PP(4)+.079167*PP(5)-.020833*PP(6)+.004167*PP(7)
      AREA(6)=-.004167*PP(4)+.054167*PP(5)+.054167*PP(6)-.004167*PP(7)
      AREA(7)=.004167*PP(4)-.020833*PP(5)+.079167*PP(6)+.037500*PP(7)
      AREA(8)=.037500*PP(7)+.079167*PP(8)-.020833*PP(9)+.004167*PP(10)
      AREA(9)=-.004167*PP(7)+.054167*PP(8)+.054167*PP(9)-.004167*PP(10)
      AREA(10)=.004167*PP(7)-.020833*PP(8)+.079167*PP(9)+.037500*PP(10)
      SUMA(1)=AREA(1)
      DO 1210 K=2,10
         SUMA(K)=AREA(K)+SUMA(K-1)
 1210 END DO
      IF(.NOT.ONLY10.AND.TOR.EQ.1.0)GO TO 1020
 1220 AMON(1)=.006667*PP(1)-.001667*PP(2)
      AMON(2)=.006667*PP(1)+.008333*PP(2)
      AMON(3)=.007500*PP(2)+.023750*PP(3)-.008333*PP(4)+.002083*PP(5)
      AMON(4)=-.000833*PP(2)+.016250*PP(3)+.021667*PP(4)-.002083*PP(5)
      AMON(5)=.000833*PP(2)-.006250*PP(3)+.031667*PP(4)+.018750*PP(5)
      AMON(6)=.018750*PP(5)+.047500*PP(6)-.014583*PP(7)+.003333*PP(8)
      AMON(7)=-.002083*PP(5)+.032500*PP(6)+.037917*PP(7)-.003333*PP(8)
      AMON(8)=.002083*PP(5)-.012500*PP(6)+.055417*PP(7)+.030000*PP(8)
      AMON(9)=.033333*PP(8)+.060000*PP(9)-.008333*PP(10)
      AMON(10)=-.006667*PP(8)+.060000*PP(9)+.041667*PP(10)
      SUMM(1)=AMON(1)
      DO 1230 K=2,10
         SUMM(K)=AMON(K)+SUMM(K-1)
 1230 END DO
      IF(.NOT.ONLY10.AND.TOR.EQ.1.0)GO TO 1040
      IF(.NOT.ONLY10)GO TO 1020
      EN=.1
      DO 1240 K=1,10
         PSTR(K)=SUMA(K)/EN
         EN=EN+.1
 1240 END DO
      DO 1250 K=1,10
         TCP(K)=(SUMA(K)-SUMM(K))/(SUMA(K)-TGEN*SUMM(K))
 1250 END DO
!
!     ----HERE FOR TABLE LOOKUP.
!
 1260 NP=19
      IF(ONLY10)NP=10
      CALL TBFUNX(RSP,PSTROT,DM,NP,RR,PSTR,CPSTR,IPSTR,MI,NG,0,0,4HPSTR,&
     &            1,4HPTCP)
      CALL TBFUNX(RSP,TCPOUT,DM,NP,RR,TCP,CTCP,ITCP,MI,NG,0,0,4HTCP ,1, &
     &            4HPTCP)
      RETURN
      END
      SUBROUTINE PTINT1(XP,YP,A,AMU,X,Y,XI,YI,NSUM,EFFECT,K,J,NCON,     &
     &VERTUP)
!
!***  CALCULATES THE BOUNDRIES OF THE MACH LINE ON THE VERTICAL TAIL
!
      DIMENSION XP(1),YP(1),A(1),X(1),Y(1),XI(1),YI(1),XDIF(4),YDIF(4)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /VTDATA/ AVT(195)
      LOGICAL EFFECT,VERTUP
!
      ICON=0
      NSUM=0
      INDEX=0
      PIO2=PI/2.0
      LEORTE=0
      IF(J.EQ.2) LEORTE=18
      INOROT=0
      IF(NCON.EQ.1) INOROT=24
      DO 1000 KLM=1,5
         X(KLM)=(XP(KLM)-A(1))*COS(-A(3)/RAD)+(YP(KLM)-A(2))            &
     &          *SIN(-A(3)/RAD)
         Y(KLM)=(YP(KLM)-A(2))*COS(-A(3)/RAD)-(XP(KLM)-A(1))            &
     &          *SIN(-A(3)/RAD)
 1000 END DO
      DO 1130 K=1,4
         XDIF(K)=X(K+1)-X(K)
         YDIF(K)=Y(K+1)-Y(K)
         IF(XDIF(K) .EQ. 0.0 .AND. YDIF(K) .EQ. 0.0) GO TO 1130
         TAMU=SIN(AMU)/COS(AMU)
         XI(K)=(Y(K)*XDIF(K)-X(K)*YDIF(K))/(XDIF(K)*TAMU-YDIF(K))
         YI(K)=XI(K)*TAMU
         IF(K.EQ.2.OR.K.EQ.4) GO TO 1100
         IF(VERTUP) GO TO 1050
         IF(K.NE.1) GO TO 1030
         IF(YI(1).LE.Y(1)) GO TO 1010
         IF((PIO2+AMU).LT.(AVT(59+INOROT)+A(3)/RAD)) GO TO 1020
         GO TO 1130
 1010    IF(YI(1).GE.Y(2)) GO TO 1120
         IF((PIO2+AMU).LT.(AVT(59+INOROT)+A(3)/RAD)) GO TO 1130
 1020    IF(J.EQ.2) GO TO 1140
         INDEX=INDEX+1
         GO TO 1140
 1030    IF(YI(3).GE.Y(3).AND.YI(3).LE.Y(4)) GO TO 1120
         IF(YI(3).LT.Y(3)) GO TO 1040
         IF(J.EQ.2) INDEX=INDEX+1
         GO TO 1140
 1040    IF((PIO2+AMU).GT.(AVT(77+INOROT)+A(3)/RAD)) GO TO 1130
         IF(J.EQ.2) INDEX=INDEX+1
         GO TO 1140
 1050    CONTINUE
         IF(K.NE.1) GO TO 1080
         IF(YI(1).GE.Y(1)) GO TO 1060
         IF((PIO2-AMU).LT.(AVT(59+INOROT)-A(3)/RAD)) GO TO 1070
         GO TO 1130
 1060    IF(YI(1).LE.Y(2)) GO TO 1120
         IF((PIO2-AMU).LT.(AVT(59+INOROT)-A(3)/RAD)) GO TO 1130
 1070    IF(J.EQ.2) GO TO 1140
         INDEX=INDEX+1
         GO TO 1140
 1080    IF(YI(3).LE.Y(3).AND.YI(3).GE.Y(4)) GO TO 1120
         IF(YI(3).GT.Y(3)) GO TO 1090
         IF(J.EQ.2) INDEX=INDEX+1
         GO TO 1140
 1090    IF((PIO2-AMU).GT.(AVT(77+INOROT)-A(3)/RAD)) GO TO 1130
         IF(J.EQ.2) INDEX=INDEX+1
         GO TO 1140
 1100    IF(K.NE.2) GO TO 1110
         IF(XI(2).GE.X(2).AND.XI(2).LE.X(3)) GO TO 1120
        GO TO 1130
 1110    IF(XI(4).GE.X(5).AND.XI(4).LE.X(4)) GO TO 1120
         GO TO 1130
 1120    ICON=ICON+1
         NSUM=NSUM+K
         INDEX=INDEX+1
         IF(ICON.EQ.2) GO TO 1140
 1130 END DO
 1140 CONTINUE
      EFFECT=.FALSE.
      IF(INDEX.GT.0)EFFECT=.TRUE.
      RETURN
      END
      SUBROUTINE PTINT2(XXP,YYP,A,AMU,X,Y,XI,YI,NX,INDXUI,INDXLI,INXUIE,&
     &                  INXLIE,ABORT)
!
!***  CALCULATES BOUNDRIES OF MACH LINES ON BODIES
!
      LOGICAL ABORT
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      DIMENSION XXP(1),YYP(1),A(1),X(42),Y(42),XDIF(42),YDIF(42),XI(42),&
     &          YI(42),XP(42),YP(42)
!
      ABORT=.FALSE.
      TAMU=SIN(AMU)/COS(AMU)
      TMAMU=-TAMU
      INDXUI=0
      INDXLI=0
      INXUIE=0
      INXLIE=0
      DX = -0.0001*XXP(NX)
      DO 1000 KL=1,NX
         XP(KL)=XXP(KL)
 1000 YP(KL)=YYP(KL)
      XP(NX+1)=XP(NX)
      YP(NX+1)=-YP(NX)
      NX1=NX+1
      NXM1=NX-1
      NX22M1=NX+21
      DO 1010 I=1,NX1
         X(I)=(XP(I)-A(1))*COS(-A(3)/RAD)+(YP(I)-A(2))*SIN(-A(3)/RAD)
         Y(I)=(YP(I)-A(2))*COS(-A(3)/RAD)-(XP(I)-A(1))*SIN(-A(3)/RAD)
         X(I+21)=(XP(I)-A(1))*COS(-A(3)/RAD)                            &
     &          +(-YP(I)-A(2))*SIN(-A(3)/RAD)
         Y(I+21)=(-YP(I)-A(2))*COS(-A(3)/RAD)                           &
     &          -(XP(I)-A(1))*SIN(-A(3)/RAD)
         L=I+21
 1010 END DO
      IF(X(NX) .LT. 0.0 .AND. X(NX) .GT. DX) X(NX) = 0.0
      IF(X(NX22M1) .LT. 0.0 .AND. X(NX22M1) .GT. DX) X(NX22M1) = 0.0
      DO 1020 J=1,NX
         IF(0.0.LE.X(J)) GO TO 1030
 1020 END DO
 1030 INDEXU=J-1
      DO 1040 J=1,NX
         IF(0.0.LE.X(J+21)) GO TO 1050
 1040 END DO
 1050 INDEXL=J+20
      DO 1080 K=INDEXU,NX
         XDIF(K)=X(K+1)-X(K)
         YDIF(K)=Y(K+1)-Y(K)
         IF(XDIF(K) .EQ. 0.0 .AND. YDIF(K) .EQ. 0.0) GO TO 1080
         XI(K)=(Y(K)*XDIF(K)-X(K)*YDIF(K))/(XDIF(K)*TAMU-YDIF(K))
         YI(K)=XI(K)*TAMU
         IF(K.NE.INDEXU) GO TO 1070
         IF(X(NX).LT.0.0) GO TO 1060
         YIN=(YDIF(K)/XDIF(K))*(-X(K))+Y(K)
         IF(YIN.GE.0.0) GO TO 1070
 1060    ABORT=.TRUE.
         RETURN
 1070    CONTINUE
         IF(XI(K).GE.X(K).AND.XI(K).LE.X(K+1)) GO TO 1090
         IF(K.NE.NXM1) GO TO 1080
         IF(XI(K).GT.X(K+1)) INXUIE=NX-1
 1080 END DO
      K=NX
 1090 INDXUI=K
      DO 1120 K=INDEXL,NX22M1
         XDIF(K)=X(K+1)-X(K)
         YDIF(K)=Y(K+1)-Y(K)
         IF(XDIF(K) .EQ. 0.0 .AND. YDIF(K) .EQ. 0.0) GO TO 1120
         XI(K)=(Y(K)*XDIF(K)-X(K)*YDIF(K))/(XDIF(K)*TMAMU-YDIF(K))
         YI(K)=-XI(K)*TAMU
         IF(K.NE.INDEXL) GO TO 1110
         IF(X(NX22M1).LT.0.0) GO TO 1100
         YIN=(YDIF(K)/XDIF(K))*(-X(K))+Y(K)
         IF(YIN.LE.0.0) GO TO 1110
 1100    ABORT=.TRUE.
         RETURN
 1110    CONTINUE
         IF(XI(K).GE.X(K).AND.XI(K).LE.X(K+1)) GO TO 1130
         IF(K.NE.(NX22M1-1)) GO TO 1120
         IF(XI(K).GT.X(K+1)) INXLIE=NX22M1-1
 1120 END DO
      K=NX22M1
 1130 INDXLI=K
      RETURN
      END
      SUBROUTINE QUAD(X,Y,XA,YA)
!
!***  COMPUTES PARAMETERS FOR QUADRATIC EXTRAPOLATION
!
      DIMENSION X(3),Y(3),X2(3)
      DATA DERIV/4HDERI/
      DET(A11,A12,A13,A21,A22,A23,A31,A32,A33)= A11*(A22*A33-A23*A32) - &
     & A21*(A12*A33-A13*A32) + A31*(A12*A23-A13*A22)
      DO 1000 I=1,3
 1000 X2(I)=X(I)**2
      D=DET(X2(1),X(1),1.,X2(2),X(2),1.,X2(3),X(3),1.)
      A=DET(Y(1),X(1),1.,Y(2),X(2),1.,Y(3),X(3),1.) /D
      B=DET(X2(1),Y(1),1.,X2(2),Y(2),1.,X2(3),Y(3),1.)/D
      C=DET(X2(1),X(1),Y(1),X2(2),X(2),Y(2),X2(3),X(3),Y(3))/D
!
!     ----TEST FOR TAKING DERIVATIVES
!
      IF(YA.EQ.DERIV)GO TO 1010
!
      YA=XA*(A*XA+B)+C
      RETURN
!
 1010 YA=2.*A*XA+B
      RETURN
      END
      SUBROUTINE QUADIN(Y,N,H,ANS)
! **
! **  NUMERICAL INTEGRATION BY FIVE POINT QUADRATURE, THE TWO
! **  POINT FORMULA, SIMPSON"S RULE OR NEWTON"S 3/8"S RULE
! **
! **  INPUTS
! **       Y  = ARRAY TO BE INTEGRATED
! **       N  = NUMBER OF POINTS IN ARRAY Y
! **       H  = COMMON STEPSIZE BETWEEN SUCESSIVE ELEMENTS OF Y
! **  OUTPUT
! **       ANS= RESULT OF THE INTEGRATION
! **
      DIMENSION Y(N)
      K=N
      ANS=   0.
      IF(H.LE.0. .OR. N.LE.0) RETURN
! **
! **  OMIT QUADRATURE METHOD IF LESS THAN FIVE POINTS
! **
      IF(N.LT.4)GO TO 1010
      DO 1000 I=1,N,4
         K=N-I+1
         IF(K.LT.5)GO TO 1000
         ANS=ANS+7.*Y(I)+32.*Y(I+1)+12.*Y(I+2)+32.*Y(I+3)+7.*Y(I+4)
 1000 END DO
      ANS=ANS*H/22.5
 1010 CONTINUE
! **
! **  IF K = 1 STOP THE INTEGRATION PROCESS
! **  IF K = 2 USE THE TWO POINT FORMULA
! **  IF K = 3 USE SIMPSON"S RULE
! **  IF K = 4 USE NEWTON"S 3/8"S RULE
! **
      GO TO (1020,1030,1040,1050),K
 1020 CONTINUE
      RETURN
 1030 ANS=ANS+H*(Y(N)+Y(N-1))/2.
      RETURN
 1040 ANS=ANS+H*(Y(N-2)+4.*Y(N-1)+Y(N))/3.
      RETURN
 1050 ANS=ANS+3.*H*(Y(N-3)+3.*Y(N-2)+3.*Y(N-1)+Y(N))/8.
      RETURN
      END
      SUBROUTINE READCD(IUNIT, KOL, IEOF)
!
!***  READ AN 80 COLUMN CARD IMAGE FROM UNIT IUNIT AND STORE THE
!***  CHARACTERS IN ARRAY KOL.  VARIABLE IEOF IS TRUE IF AN
!***  END-OF-FILE IS DETECTED.
!
      DIMENSION KOL(80)
!
      LOGICAL IEOF
!
      IEOF=.FALSE.
!
!***  READ CARD OR LOOK FOR A DOUBLE END-OF-FILE
!
      DO 1000 J=1,2
!
!***     FOLLOWING  -TWO- CARDS ARE FOR FORTRAN-IV
!
!        READ(IUNIT,1020)(KOL(I),I=1,80)
!        IF(EOF(IUNIT))1000,1010
!
!***     FOLLOWING CARD IS FOR FORTRAN-V
!
         READ(IUNIT,1020,END=1000)(KOL(I),I=1,80)
         GO TO 1010
!
 1000 END DO
!
      IEOF=.TRUE.
!
 1010 CONTINUE
!
      RETURN
!
 1020 FORMAT(80A1)
!
      END
      SUBROUTINE READXM(IFIG)
!
!***  READS EXTRAPOLATION MESSAGES FROM UNIT 12
!
      INTEGER ROUT
      COMMON /IBODY/   PB, AFIG01(121), AFIG02(121), dum1(158)
      COMMON /IWING/   PW, AFIG03(121), AFIG04(121), dum13(158)
      COMMON /IHT/    PHT, AFIG05(121), AFIG06(121), dum3(138)
      COMMON /IVT/    PVT, AFIG07(121), AFIG08(121), dum4(138)
      COMMON /IVF/    PVF, AFIG09(121), AFIG10(121), dum17(138)
      COMMON /IBW/    PBW, AFIG11(121), AFIG12(121), dum5(138)
      COMMON /IBH/    PBH, AFIG13(121), AFIG14(121), dum6(138)
      COMMON /IBV/    PBV, JFIG01(121), JFIG02(121), dum7(138)
      COMMON /IBWH/  PBWH, JFIG03(121), JFIG04(121), dum8(138)
      COMMON /IBWV/  PBWV, JFIG05(121), JFIG06(121), dum9(138)
      COMMON /IBWHV/PBWHV, JFIG07(121), JFIG08(121), dum12(138)
      COMMON /WINGD/       JFIG09(121)
      COMMON /SBETA/       JFIG10(121), JFIG11(121), JFIG12(121)
      COMMON /BDATA/       JFIG13(121), JFIG14(121), JFIG15(121),       &
     &                     JFIG16(121), JFIG17(121)
      COMMON /WHWB/        JFIG18(121)
      COMMON /WBHCAL/      JFIG19(121)
      COMMON /HTDATA/      JFIG20(121)
      COMMON /VTDATA/ LFIGN(121),LFIGO(121),IOVLY,IOVL,NSTQ,NSTP,FINALR,&
     &                NFIG,IFIGN
      COMMON /WHAERO/ LFIGS(121), IFIGST(20), IEXCD(4), MSSCL(2),       &
     &                ROUT(2), XLL(4), XUL(4), IEXTRL(4,2),             &
     &                IEXTRU(4,2), XVAL(4)
      DIMENSION IFIG(20,121)
      DATA IHBL,IHVAL,IHLAST,IHEAR,IHLIN,IHTRIC,IHQUAD,IHREQD,IHNOT/    &
     &4H    ,4H VAL,4HLAST,4HEAR ,4H LIN,4HTRIC,4HQUAD,4HREQD,4HNOT /
      READ(12,1030) IOVLY,NSTQ,NSTP
      IF(NFIG.EQ.0)IOVL=IOVLY
      NFIG=NFIG+1
      DO 1000 L=1,20
         IFIG(L,NFIG)=IHBL
 1000 END DO
      IF(IOVLY.EQ.999 .OR. IOVLY.LE.0)GO TO 1020
      IF(NSTQ .GT. 5)NSTQ=5
      NN=4*NSTQ
      READ(12,1040)MSSCL(1),MSSCL(2),ROUT(1),ROUT(2),(IFIG(L,NFIG), L=1,&
     &            NN)
      DO 1010 L=1,NSTP
         READ(12,1050)XVAL(L),XLL(L),XUL(L),IEXTRL(L,1),IEXTRU(L,1)
!
!  REPLACE NUMERIC EXTRAPOLATION TYPE WITH HOLLERITH
!  -1 = NOT REQUIRED
!   0 = LAST VALUE USED
!   1 = LINEAR
!   2 = QUADRATIC
!
         IF(IEXTRL(L,1).EQ.0)IEXTRL(L,2)=IHVAL
         IF(IEXTRL(L,1).EQ.0)IEXTRL(L,1)=IHLAST
         IF(IEXTRL(L,1).EQ.1)IEXTRL(L,2)=IHEAR
         IF(IEXTRL(L,1).EQ.1)IEXTRL(L,1)=IHLIN
         IF(IEXTRL(L,1).EQ.2)IEXTRL(L,2)=IHTRIC
         IF(IEXTRL(L,1).EQ.2)IEXTRL(L,1)=IHQUAD
         IF(IEXTRL(L,1).EQ.-1)IEXTRL(L,2)=IHREQD
         IF(IEXTRL(L,1).EQ.-1)IEXTRL(L,1)=IHNOT
         IF(IEXTRU(L,1).EQ.0)IEXTRU(L,2)=IHVAL
         IF(IEXTRU(L,1).EQ.0)IEXTRU(L,1)=IHLAST
         IF(IEXTRU(L,1).EQ.1)IEXTRU(L,2)=IHEAR
         IF(IEXTRU(L,1).EQ.1)IEXTRU(L,1)=IHLIN
         IF(IEXTRU(L,1).EQ.2)IEXTRU(L,2)=IHTRIC
         IF(IEXTRU(L,1).EQ.2)IEXTRU(L,1)=IHQUAD
         IF(IEXTRU(L,1).EQ.-1)IEXTRU(L,2)=IHREQD
         IF(IEXTRU(L,1).EQ.-1)IEXTRU(L,1)=IHNOT
 1010 END DO
      READ(12,1060) FINALR
 1020 CONTINUE
 1030 FORMAT(3I3)
 1040 FORMAT(4A4,20A1)
 1050 FORMAT(3E12.5,2I2)
 1060 FORMAT(E12.5)
      RETURN
      END
      SUBROUTINE REPTCT(ICONST, IREPT, IERR)
!
!***  LOOK FOR REPEAT COUNT ON A CONSTANT.  DEFAULT IS 1.
!
      INTEGER BLANK,STAR
!
      DIMENSION ICONST(80),ITCON(80)
!
      DATA STAR  / 4H*    /
      DATA BLANK / 4H     /
!
      IERR=0
      IREPT=1
!
      DO 1000 I=1,80
         ITCON(I)=BLANK
 1000 END DO
!
!***  LOOK FOR *
!
      ICOL=1
      CALL FINDCH(ICONST, STAR, ICOL)
!
      IF(ICOL .LT. 81)GO TO 1010
!
      GO TO 1030
!
!***  BACKUP AND EXTRACT TO *
!
 1010 ICOL=ICOL-1
      CALL EXTRST(ICONST, 1, ICOL, ITCON)
!
!***  CONVERT COUNT TO INTEGER
!
      CALL TOINT(ITCON, IRR, IERR)
      IF(IRR .NE. 0)IREPT=IRR
!
!***  REMOVE REPEAT COUNT FROM STRING
!
      ICOL=ICOL+2
      J=1
      DO 1020 I=ICOL,80
         ICONST(J)=ICONST(I)
         J=J+1
 1020 END DO
!
 1030 CONTINUE
!
      RETURN
      END
      SUBROUTINE RVALUE(KOL,L,NDML,NF,BLANK,COMMA,NUMBER)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      DIMENSION KOL(80), NUMBER(15)
      INTEGER BLANK, COMMA, FIRST, POWR
      LOGICAL END, SIGN, EXP, STAR, DEC, FLAG
!
 1010 CONTINUE
      END  = .FALSE.
      SIGN = .FALSE.
      EXP  = .FALSE.
      STAR = .FALSE.
      DEC  = .FALSE.
      MULT = 0
      POWR = 0
 1020 CONTINUE
      FIRST = L
      IF(L .GE. 81) GO TO 1140
      IF(KOL(L) .NE. BLANK) GO TO 1030
        L = L+1
        GO TO 1020
 1030 CONTINUE
      DO 1040 J=1,15
      IF(KOL(L) .EQ. NUMBER(J)) GO TO 1050
 1040 END DO
      J = 16
 1050 CONTINUE
      IF(J .GT. 10) GO TO 1060
        IF(.NOT. STAR) MULT = 10*MULT+J-1
        IF(EXP)        POWR = 10*POWR+J-1
        GO TO 1120
 1060 CONTINUE
      IF(J .GT. 12) GO TO 1070
        IF(SIGN) NF = NF+1
        FLAG = (L .EQ. FIRST) .OR. (KOL(L-1) .EQ. NUMBER(15)) .OR.      &
     &         (KOL(L-1) .EQ. NUMBER(14))
        IF(.NOT. FLAG) NF = NF+1
        SIGN = .TRUE.
        GO TO 1120
 1070 CONTINUE
      IF(J .GT. 13) GO TO 1080
        IF(DEC) NF = NF+1
        IF(EXP) NF = NF+1
        DEC = .TRUE.
        GO TO 1120
 1080 CONTINUE
      IF(J .GT. 14) GO TO 1090
        IF(STAR) NF = NF+1
        IF(SIGN) NF = NF+1
        IF(EXP)  NF = NF+1
        IF(DEC)  NF = NF+1
        IF(MULT .EQ. 0) NF = NF+1
        IF(MULT .EQ. 0) MULT = 1
        STAR = .TRUE.
        GO TO 1120
 1090 CONTINUE
      IF(J .GT. 15 .OR. L .EQ. FIRST) GO TO 1100
        IF(.NOT. DEC) NF = NF+1
        IF(EXP)       NF = NF+1
        EXP  = .TRUE.
        SIGN = .FALSE.
        GO TO 1120
 1100 CONTINUE
      IF(KOL(L) .NE. BLANK) GO TO 1110
        NF = NF+1
        GO TO 1120
 1110 CONTINUE
      IF(KOL(L) .EQ. KAND .AND. L .EQ. FIRST) GO TO 1140
      IF(KOL(L) .NE. COMMA .AND. KOL(L) .NE. KAND) GO TO 1140
        END = .TRUE.
!
!***  NUMERIC CHARACTER FOUND
!
 1120 CONTINUE
      IF(L .EQ. FIRST .AND. EXP) GO TO 1140
      IF(END) GO TO 1130
        L = L+1
        GO TO 1030
 1130 CONTINUE
        NDML = NDML+1
        IF(STAR) NDML = NDML-1+MULT
        IF(.NOT. DEC .AND. .NOT. EXP) NF = NF+1
        IF(EXP .AND. POWR .EQ. 0) NF = NF+1
        IF(KOL(L) .EQ. KAND) GO TO 1140
        L = L+1
        GO TO 1010
!
!***  NON-NUMERIC CHARACTER FOUND OR END OF CARD
!
 1140 CONTINUE
      IF(NDML .EQ. 0) NF = NF+1
      RETURN
      END
      SUBROUTINE SDDVC(X, ABETA, SWEPTE, SWEPR, TAPR, TAPER, DHB, ICASE)
!
!***  FIND DOWNWARD DISPLACEMENT OF VORTEX CORE
!***  FIGURE 4.4.1-74
!
      DIMENSION X(2), DHB(2), TAPER(4), DDVC(4)
      DIMENSION ROUTID(2), QA(3), QB(3), QC(3), QD(3)
      DIMENSION LGH(2), VAR(2), CC(6)
      DIMENSION XA(7), YA(10), XB(12), YB1(32), YB2(32)
      DIMENSION XC(8), YC1(15), YC2(15), XD(9), YD(20)
      LOGICAL   FLAG
!
      DATA ROUTID / 4HSDDV, 4HC    /
      DATA QA     / 4H4.4., 4H1-74, 4HA    /
      DATA QB     / 4H4.4., 4H1-74, 4HB    /
      DATA QC     / 4H4.4., 4H1-74, 4HC    /
      DATA QD     / 4H4.4., 4H1-74, 4HD    /
!
!***            FIGURE 4.4.1-74A
!
      DATA XA  /                                                        &
     &          .5, 1.5, 3.0, 5.0, 6.0,                                 &
     &          8., 12. /
      DATA YA  /                                                        &
     &          .5, .81, 1.50, 2.47, 2.93,                              &
     &          .3, .61, 1.21, 2.00, 2.38 /
!
!***            FIGURE 4.4.1-74B
!
      DATA XB  /                                                        &
     &          .5, .75, 1.50, 2.00, 2.50, 3.00, 3.50, 6.00,            &
     &          2., 4., 8., 12. /
      DATA YB1 /                                                        &
     &          1.25, 1.60, 1.60, 2.07, 2.96, 3.81, 4.67, 9.03,         &
     &          .700, .750, 1.12, 1.49, 1.94, 2.51, 2.51, 2.51,         &
     &          .410, .460, .700, .900, 1.11, 1.32, 1.52, 2.58,         &
     &          .310, .330, .500, .630, .800, .960, 1.11, 1.89 /
      DATA YB2 /                                                        &
     &          1.10, 1.50, 1.50, 1.96, 2.75, 3.56, 4.38, 8.33,         &
     &          .600, .670, 1.00, 1.30, 1.63, 2.08, 2.52, 2.52,         &
     &          .310, .340, .540, .700, .860, 1.02, 1.18, 1.94,         &
     &          .220, .221, .320, .450, .580, .700, .810, 1.40 /
!
!***            FIGURE 4.4.1-74C
!
      DATA XC  /                                                        &
     &          .5, 1.0, 2.0, 3.5, 6.0,                                 &
     &          3.2, 6.4, 12.8 /
      DATA YC1 /                                                        &
     &          .910, 1.03, 1.46, 2.41, 4.16,                           &
     &          .500, .600, .940, 1.58, 2.66,                           &
     &          .250, .320, .620, 1.08, 1.81 /
      DATA YC2 /                                                        &
     &          .910, 1.03, 1.40, 2.31, 3.99,                           &
     &         .500, .560, .880, 1.46, 2.41,                            &
     &          .250, .320, .570, .960, 1.59 /
!
!***            FIGURE 4.4.1-74D
!
      DATA XD  /                                                        &
     &          1.0, 1.5, 2.0, 3.75, 6.0,                               &
     &          2., 4., 8., 12.  /
      DATA YD  /                                                        &
     &          1.00, 1.41, 1.88, 4.00, 6.77,                           &
     &          .510, .600, .710, 1.37, 2.20,                           &
     &          .290, .300, .370, .660, 1.02,                           &
     &          .130, .120, .200, .400, .690 /
!
      DO 1020 I=1,2
!
!***  FIGURE 4.4.1-74A -- TAPER = 0.0
!
         VAR(1) = X(I)
         VAR(2) = ABETA
         LGH(1) = 5
         LGH(2) = 2
         CALL INTERX(2, XA, VAR, LGH, YA, DDVC(1), 5, 10,               &
     &               1, 1, 0, 0, 1, 1, 0, 0, QA, 3, ROUTID)
!
!***  FIGURE 4.4.1-74B -- TAPER = 0.25, 0.50 -- SWEEP(C/2) = 0.0
!
         FLAG = (ICASE .EQ. 2) .OR. (ICASE .EQ. 3)
         IF(.NOT. FLAG) GO TO 1000
           LGH(1) = 8
           LGH(2) = 4
           CALL INTERX(2, XB, VAR, LGH, YB1, DDVC(2), 8, 32,            &
     &                 2, 2, 0, 0, 2, 2, 0, 0, QB, 3, ROUTID)
           CALL INTERX(2, XB, VAR, LGH, YB2, DDVC(3), 8, 32,            &
     &                 2, 2, 0, 0, 2, 2, 0, 0, QB, 3, ROUTID)
          IF(ICASE .EQ. 3) DDVC2 = DDVC(2)
          IF(ICASE .EQ. 3) DDVC3 = DDVC(3)
 1000    CONTINUE
!
!***  FIGURE 4.4.1-74C -- TAPER = 0.25, 0.50 -- SWEEP(TE) = 0.0
!
         FLAG = ICASE .EQ. 2
         IF(FLAG) GO TO 1010
           LGH(1) = 5
           LGH(2) = 3
           CALL INTERX(2, XC, VAR, LGH, YC1, DDVC(2), 5, 15,            &
     &                 2, 2, 0, 0, 1, 2, 0, 0, QC, 3, ROUTID)
           CALL INTERX(2, XC, VAR, LGH, YC2, DDVC(3), 5, 15,            &
     &                 2, 2, 0, 0, 1, 2, 0, 0, QC, 3, ROUTID)
           IF(ICASE .EQ. 3) DDVC(2) = DDVC2+SWEPTE*(DDVC(2)-DDVC2)/SWEPR
           IF(ICASE .EQ. 3) DDVC(3) = DDVC3+SWEPTE*(DDVC(3)-DDVC3)/SWEPR
 1010    CONTINUE
!
!***  FIGURE 4.4.1-74D -- TAPER = 1.0
!
         LGH(1) = 5
         LGH(2) = 4
         CALL INTERX(2, XD, VAR, LGH, YD, DDVC(4), 5, 20,               &
     &               2, 2, 0, 0, 1, 2, 0, 0, QD, 3, ROUTID)
!
!***  CALCULATE DHB
!
         IN = 0
         CALL TBFUNX(TAPR, DHB(I), DYDX, 4, TAPER, DDVC, CC,            &
     &               IN, MI, NG, 0, 0, 4HDHB , 1, ROUTID)
 1020 END DO
      RETURN
      END
      SUBROUTINE SDWA(X, Y, Z, AB, SDW)
!
!***  DOWNWASH AT SUPERSONIC SPEEDS
!***  FIGURE 4.4.1-76A (TAPER = 0.00)
!
      DIMENSION ROUTID(2), QA1(3), QA2(3), QA3(3)
      DIMENSION XA1(10), YA1(24), XA2(6), YA2(6), XA3(10), YA3(10)
      DIMENSION LGH(2), VAR(2)
!
      DATA ROUTID / 4HSDWA, 4H     /
      DATA QA1    / 4H4.4., 4H1-76, 4HA1   /
      DATA QA2    / 4H4.4., 4H1-76, 4HA2   /
      DATA QA3    / 4H4.4., 4H1-76, 4HA3   /
!
!***           FIGURE 4.4.1-76A1
!
      DATA XA1 /                                                        &
     &            .90, 1.0, 1.2, 1.4, 1.6, 2.4,                         &
     &            0.0, 0.1, 0.3, 0.5  /
      DATA YA1 /                                                        &
     &            .90, 1.18, 1.65, 1.95, 2.10, 2.34,                    &
     &            .55, 0.84, 1.30, 1.60, 1.74, 2.00,                    &
     &            0.0, 0.00, 0.50, 0.87, 1.10, 1.50,                    &
     &            0.0, 0.00, 0.00, 0.30, 0.61, 1.00 /
!
!***           FIGURE 4.4.1-76A2
!
      DATA XA2 /                                                        &
     &            0.0, 3.0, 0.0,                                        &
     &            4.0, 8.0, 12. /
      DATA YA2 /                                                        &
     &            0.0, 4.45,                                            &
     &            0.0, 3.00,                                            &
     &            0.0, 2.50 /
!
!***           FIGURE 4.4.1-76A3
!
      DATA XA3 /                                                        &
     &            0.0, 3.0, 0.0, 0.0, 0.0,                              &
     &            0.0, 0.3, 0.4, 0.6, 0.8 /
      DATA YA3 /                                                        &
     &            0.00, 0.60,                                           &
     &            -.04, 0.54,                                           &
     &            -.09, 0.44,                                           &
     &            -.17, 0.35,                                           &
     &            -.28, 0.26 /
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76A1
!
      VAR(1) = X
      VAR(2) = Z
      LGH(1) = 6
      LGH(2) = 4
      CALL INTERX(2, XA1, VAR, LGH, YA1, DUM, 6, 24,                    &
     &            2, 0, 0, 0, 1, 2, 0, 0, QA1, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76A2
!
      VAR(1) = DUM
      VAR(2) = AB
      LGH(1) = 2
      LGH(2) = 3
      CALL INTERX(2, XA2, VAR, LGH, YA2, DUM, 3, 6,                     &
     &            0, 1, 0, 0, 1, 1, 0, 0, QA2, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76A3
!
      VAR(1) = DUM
      VAR(2) = Y
      LGH(1) = 2
      LGH(2) = 5
      CALL INTERX(2, XA3, VAR, LGH, YA3, SDW, 5, 10,                    &
     &            0, 0, 0, 0, 1, 2, 0, 0, QA3, 3, ROUTID)
      RETURN
      END
      SUBROUTINE SDWASH(NZ,KEPSLN)
!
!***  COMPUTES DE/DA AND VISCOUS Q/QINF AT THE HORIZONTAL TAIL
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OPTION/ SREF,CBARRW,ROUGFC,BLREF
      COMMON /OVERLY/ NLOG,NMACH,IMACH,NALPHA,IG,NF
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /FLGTCD/ FLC(160)
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ AHT(195)
      COMMON /SUPDW/  MACH, BETA, X(2), Y(2), Z(2), ALPHA(20), ZEFF(40),&
     &                DHB(2), DUM(38), DEPAVG(20), DEPX(40), CLANL(20), &
     &                M(20), ZWAKEC, ZC(20), DELQO, DELE, DELTAZ,       &
     &                XSUR, THETA, DELTE, THETE, JDETCH
      COMMON /WINGI/  WINGIN(101)
      COMMON /HTI/    HTIN(154)
      COMMON /SUPWH/  SLG(141)
      COMMON /IWING/  PWING, WING(400)
      COMMON /IDWASH/ PDWASH, QQINFY(20), DWANGL(20), DEPDA(20)
!
      DIMENSION TAPER(4), ROUTID(2), CC(6)
      DIMENSION DEP(4), SDW(2), CLW(20), DEPA(21), ALP(21), DWA(20)
!
      EQUIVALENCE (CR,WINGIN(6)), (CT,WINGIN(1))
      EQUIVALENCE (AW,A(120)), (SWEPLE,A(58)), (SWEPC2,A(70))
      EQUIVALENCE (SWEPTE,A(76)), (TAPR,A(118))
      EQUIVALENCE (CLW(1),WING(21)), (CLAW,WING(101))
      EQUIVALENCE (CDOW,SLG(80))
      EQUIVALENCE (RL2,A(24)), (GAMMA,A(11))
      EQUIVALENCE (SPAN,WINGIN(4)),(TANLEH,AHT(62)),(DIHEOH,HTIN(14))
      EQUIVALENCE (SPANH,HTIN(4)),(DIHEIH,HTIN(13)),(SPANDI,HTIN(12))
!
      LOGICAL VISDW, FLAG
      REAL    MACH, M
      DATA ROUTID / 4HSDWA, 4HSH   /
      DATA TAPER  / 0.00, 0.25, 0.50, 1.00 /
!
!***  INITIALIZE DATA
!
      CALL INFTGM
      JDETCH = -1
      MACH   = FLC(NZ+2)
      BETA   = SQRT(MACH**2-1.0)
      ABETA  = AW*BETA
      ARG1   = TAN(SWEPLE/RAD)/BETA
      ARG2   = TAN(SWEPTE/RAD)/BETA
      VISDW  = (ARG1 .GT. 1.0) .OR. (ARG2 .GT. 1.0)
      DO 1000 J=1,NALPHA
        ALPHA(J) = FLC(J+22)+ALIW
        CLANL(J) = WING(J+100)
 1000 END DO
      IF(VISDW .OR. KEPSLN .NE. 0) GO TO 1080
!
      X(1) = (XH-XW)/(SPAN*BETA)
      X(2) = (XH-XW+TANLEH*SPANH)/(SPAN*BETA)
      Y(1) = 0.0
      Y(2) = SPANH/SPAN
      Z(1) = ZH-ZW
      Z(2) = Z(1)+TAN(DIHEIH/RAD)*(SPANH-SPANDI)+TAN(DIHEOH/RAD)*SPANDI
      Z(1) = Z(1)/SPAN
      Z(2) = Z(2)/SPAN
!
!***  SET ICASE AND GET DHB
!
      ICASE = 0
      IF(SWEPTE .EQ. 0.0) ICASE = 1
      IF(SWEPTE .GT. 0.0) ICASE = 4
      IF((SWEPTE .LT. 0.0) .AND. (SWEPC2 .LE. 0.0)) ICASE = 2
      IF((SWEPTE .LT. 0.0) .AND. (SWEPC2 .GT. 0.0)) ICASE = 3
!
      SWEPR = ATAN((CR-CT)/(2.0*SPAN))*RAD
      CALL SDDVC(X, ABETA, SWEPTE, SWEPR, TAPR, TAPER, DHB, ICASE)
!
!***  LOOP ON ALPHA AND LOCATION
!
      N = 0
      DO 1070 J=1,NALPHA
        NA = ABS(2.0*ALPHA(J))+1.5
        IF(NA .LT. 2)  NA = 2
        IF(NA .GT. 21) NA = 21
        XNA = NA-1
        DO 1060 K=1,NA
          IF(NF .GE. 0) NF = -1
          IF((K .EQ. NA) .AND. (NF .EQ. -1)) NF = 0
          ALP(K) = ALPHA(J)*(K-1)/XNA
          DO 1050 I=1,2
            IF(K .EQ. NA) N = N+1
            ZE   = Z(I) + DHB(I)*BETA*ALP(K)/RAD
            IF(K .EQ. NA) ZEFF(N) = ZE
            ZE   = ABS(ZE)
            FLAG = (ICASE .EQ. 1) .OR. (ICASE .EQ. 3)
            IF(.NOT. FLAG) GO TO 1010
              CALL SDWA(X(I), Y(I), ZE, ABETA, DEP(1))
              CALL SDWC(X(I), Y(I), ZE, ABETA, DEP(2))
              CALL SDWB(X(I), Y(I), ZE, ABETA, DEP(4))
              IN = 0
              CALL TBFUNX(TAPR, SDW(I), DYDX, 4, TAPER, DEP, CC,        &
     &                    IN, MI, NG, 0, 0, 4HSDW1, 1, ROUTID)
              IF(ICASE .EQ. 3) SDW3 = SDW(I)
 1010       CONTINUE
            FLAG = (ICASE .EQ. 2) .OR. (ICASE .EQ. 3)
            IF(.NOT. FLAG) GO TO 1030
              CALL SDWD(X(I), Y(I), ZE, ABETA, DEP(1))
              CALL SDWB(X(I), Y(I), ZE, ABETA, DEP(4))
              IN = 0
              CALL TBFUNX(TAPR, SDW(I), DYDX, 4, TAPER, DEP, CC,        &
     &                    IN, MI, NG, 0, 0, 4HSDW2, 1, ROUTID)
              IF(ICASE .NE. 3) GO TO 1020
               SDW(I) = SDW(I) + SWEPC2*(SDW3-SDW(I))/SWEPR
 1020         CONTINUE
 1030       CONTINUE
            IF(ICASE .NE. 4) GO TO 1040
              CALL SDWE(X(I), Y(I), ZE, ABETA, TAPR, SDW(I))
 1040       CONTINUE
            IF(K .EQ. NA) DEPX(N) = SDW(I)
 1050     CONTINUE
          IN = 0
          CALL TBFUNX(ALP(K), CLANLJ, DYDX, NALPHA, ALPHA, WING(101),   &
     &                CC, IN, MI, NG, 0, 0, 4HCLAW, 1, ROUTID)
          DEPA(K) = (SDW(1)+SDW(2))/2.0
          DEPA(K) = DEPA(K)*CLANLJ/CLAW
 1060   CONTINUE
        DEPAVG(J) = DEPA(NA)*CLAW/CLANLJ
        DEPDA(J)  = DEPA(NA)
        CALL TRAPZ(DEPA,NA,ALP,DWANGL(J),1)
 1070 END DO
 1080 CONTINUE
      DO 1110 J=1,NALPHA
        IF(KEPSLN.EQ.0 .AND. VISDW) DWANGL(J) =1.62*CLW(J)/(PI*AW)      &
     &                                         *RAD*SREF/A(3)
        ARG    = (DWANGL(J)-ALPHA(J))/RAD+GAMMA
        ARG4   = RL2*COS(ARG)/(COS(GAMMA)*A(16))
        ARG1   = CDOW*(ARG4+0.15)*SREF/A(3)
        ZWAKEC = 0.68*SQRT(ARG1)
        ZWAKET = ZWAKEC*A(16)
        DELQO  = 2.42*SQRT(CDOW*SREF/A(3))/(ARG4+0.3)
        ZC(J)  = ARG4*TAN(ARG)
        DWA(J) = DWANGL(J)/RAD
        TEST   = ABS(ZC(J)/ZWAKEC)
        IF(TEST.GT.1.)GO TO 1090
!
!***    CALCULATE VISCOUS DYNAMIC PRESSURE
!
          DELTAJ    = PI*TEST/2.0
          QQINFY(J) = 1.-DELQO*COS(DELTAJ)**2
          M(J)      = MACH
          GO TO 1100
 1090   CONTINUE
!
!***    CALCULATE NON-VISCOUS DYNAMIC PRESSURE
!
          ZTAIL = ZC(J)*A(16)
          CALL DPRESR(ZTAIL,ZWAKET,ALPHA(J),DWA(J),QQINFY(J),M(J))
          IF(M(J).GT.1.0) GO TO 1100
            JDETCH = J-1
            IF(VISDW) GO TO 1120
            RETURN
 1100   CONTINUE
 1110 END DO
 1120 CONTINUE
      IF(VISDW .AND. KEPSLN .EQ. 0 .AND. JDETCH.GT.0) NALPHA = JDETCH
      IF(JDETCH .EQ. 0) NALPHA = 0
      IF(.NOT.VISDW .AND. KEPSLN .EQ. 0)RETURN
      DO 1130 J=1,NALPHA
        IN = 0
        CALL TBFUNX(ALPHA(J), E, DEPDA(J), NALPHA, ALPHA, DWANGL, CC,   &
     &              IN, MI, NG, 0, 0, 4HDPDA, 1, ROUTID)
 1130 END DO
      RETURN
      END
      SUBROUTINE SDWB(X, Y, Z, AB, SDW)
!
!***  DOWNWASH AT SUPERSONIC SPEEDS
!***  FIGURE 4.4.1-76B (TAPER = 1.00)
!
      DIMENSION ROUTID(2), QB1(3), QB2(3), QB3(3)
      DIMENSION XB1(12), YB1(32), XB2(8), YB2(16), XB3(6), YB3(6)
      DIMENSION LGH(2), VAR(2)
!
      DATA ROUTID / 4HSDWB, 4H     /
      DATA QB1    / 4H4.4., 4H1-76, 4HB1   /
      DATA QB2    / 4H4.4., 4H1-76, 4HB2   /
      DATA QB3    / 4H4.4., 4H1-76, 4HB3   /
!
!***           FIGURE 4.4.1-76B1
!
      DATA XB1 /                                                        &
     &           1.0, 1.2, 1.4, 1.5, 1.6, 2.0, 2.2, 2.4,                &
     &           0.0, 0.1, 0.3, 0.5 /
      DATA YB1 /                                                        &
     &           0.32, 0.74, 1.21, 1.39, 1.44, 1.56, 1.62, 1.77,        &
     &           0.11, 0.60, 1.10, 1.25, 1.30, 1.42, 1.50, 1.62,        &
     &           0.00, 0.20, 0.76, 1.00, 1.10, 1.34, 1.42, 1.47,        &
     &           0.00, 0.00, 0.00, 0.50, 0.75, 1.06, 1.12, 1.20 /
!
!***           FIGURE 4.4.1-76B2
!
      DATA XB2 /                                                        &
     &           0.00, .8, 1.70, 3.0,                                   &
     &           2.00, 4., 8.00, 12. /
      DATA YB2 /                                                        &
     &           0.00, .60, 4.43, 12.7,                                 &
     &           0.00, .80, 1.70, 3.00,                                 &
     &           0.00, .40, 0.80, 1.40,                                 &
     &           0.00, .27, 0.50, 0.94 /
!
!***           FIGURE 4.4.1-76B3
!
      DATA XB3 /                                                        &
     &           0.0, 5.0, 0.0,                                         &
     &           0.0, .15, .30 /
      DATA YB3 /                                                        &
     &           0.0, 1.00,                                             &
     &           0.0, 1.10,                                             &
     &           0.0, 1.20 /
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76B1
!
      VAR(1) = X
      VAR(2) = Z
      LGH(1) = 8
      LGH(2) = 4
      CALL INTERX(2, XB1, VAR, LGH, YB1, DUM, 8, 32,                    &
     &            2, 0, 0, 0, 1, 2, 0, 0, QB1, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76B2
!
      VAR(1) = DUM
      VAR(2) = AB
      LGH(1) = 4
      LGH(2) = 4
      CALL INTERX(2, XB2, VAR, LGH, YB2, DUM, 4, 16,                    &
     &            0, 2, 0, 0, 1, 2, 0, 0, QB2, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76B3
!
      VAR(1) = DUM
      VAR(2) = Y
      LGH(1) = 2
      LGH(2) = 3
      CALL INTERX(2, XB3, VAR, LGH, YB3, SDW, 3, 6,                     &
     &            0, 0, 0, 0, 1, 2, 0, 0, QB3, 3, ROUTID)
      RETURN
      END
      SUBROUTINE SDWC(X, Y, Z, AB, SDW)
!
!***  DOWNWASH AT SUPERSONIC SPEEDS
!***  FIGURE 4.4.1-76C (TAPER = 0.25, 0.50)
!
      DIMENSION SDW(2)
      DIMENSION ROUTID(2), QC1(3), QC2(3), QC3(3), QC4(3)
      DIMENSION XC1(11), YC1(28), XC2(12), YC2(12)
      DIMENSION XC3(5), YC3A(5), YC3B(5), XC4(4), YC4(4)
      DIMENSION LGH(2), VAR(2), CC(6)
!
      DATA ROUTID / 4HSDWC, 4H     /
      DATA QC1    / 4H4.4., 4H1-76, 4HC1   /
      DATA QC2    / 4H4.4., 4H1-76, 4HC2   /
      DATA QC3    / 4H4.4., 4H1-76, 4HC3   /
      DATA QC4    / 4H4.4., 4H1-76, 4HC4   /
!
!***           FIGURE 4.4.1-76C1
!
      DATA XC1 /                                                        &
     &           .900, .950, 1.12, 1.40, 1.80, 2.20, 2.40,              &
     &           0.00, 0.10, 0.30, 0.50 /
      DATA YC1 /                                                        &
     &           0.80, 1.00, 1.30, 1.63, 1.96, 2.08, 2.10,              &
     &           0.00, 0.70, 1.00, 1.39, 1.70, 1.81, 1.80,              &
     &           0.00, 0.00, 0.33, 0.85, 1.20, 1.40, 1.40,              &
     &           0.00, 0.00, 0.00, 0.38, 0.79, 0.99, 1.00 /
!
!***           FIGURE 4.4.1-76C2
!
      DATA XC2 /                                                        &
     &           0.00, 2.50, 4*0.,                                      &
     &           2.70, 3.20, 5.40, 6.40, 10.7, 12.8 /
      DATA YC2 /                                                        &
     &           0.0, 4.60,                                             &
     &           0.0, 3.55,                                             &
     &           0.0, 2.90,                                             &
     &           0.0, 2.50,                                             &
     &           0.0, 1.84,                                             &
     &           0.0, 1.59 /
!
!***           FIGURE 4.4.1-76C3
!
      DATA XC3  / 0.0, 3.00, 3.50, 3.75, 4.00 /
      DATA YC3A / 0.0, 3.00, 3.50, 3.75, 4.00 /
      DATA YC3B / 0.0, 2.35, 3.00, 3.50, 3.50 /
!
!***           FIGURE 4.4.1-76C4
!
      DATA XC4 /                                                        &
     &           0.0, 4.00,                                             &
     &           0.0, .30 /
      DATA YC4 /                                                        &
     &           0.0, .780,                                             &
     &           0.0, .820 /
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76C1
!
      VAR(1) = X
      VAR(2) = Z
      LGH(1) = 7
      LGH(2) = 4
      CALL INTERX(2, XC1, VAR, LGH, YC1, DUM, 7, 28,                    &
     &            2, 0, 0, 0, 1, 2, 0, 0, QC1, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76C2
!
      VAR(1) = DUM
      VAR(2) = AB
      LGH(1) = 2
      LGH(2) = 6
      CALL INTERX(2, XC2, VAR, LGH, YC2, DUM, 6, 12,                    &
     &            0, 2, 0, 0, 1, 2, 0, 0, QC2, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76C3 AND 76C4 AT TAPER = 0.25
!
      IN = 0
      CALL TBFUNX(DUM, DUM2, DYDX, 5, XC3, YC3A, CC, IN,                &
     &            MI, NG, 0, 1, QC3, 3, ROUTID)
!
      VAR(1) = DUM2
      VAR(2) = Y
      LGH(1) = 2
      LGH(2) = 2
      CALL INTERX(2, XC4, VAR, LGH, YC4, SDW(1), 2, 4,                  &
     &            0, 1, 0, 0, 1, 1, 0, 0, QC4, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76C3 AND 76C4 AT TAPER = 0.50
!
      IN = 0
      CALL TBFUNX(DUM, DUM2, DYDX, 5, XC3, YC3B, CC, IN,                &
     &            MI, NG, 0, 1, QC3, 3, ROUTID)
!
      VAR(1) = DUM2
      VAR(2) = Y
      LGH(1) = 2
      LGH(2) = 2
      CALL INTERX(2, XC4, VAR, LGH, YC4, SDW(2), 2, 4,                  &
     &            0, 1, 0, 0, 1, 1, 0, 0, QC4, 3, ROUTID)
      RETURN
      END
      SUBROUTINE SDWD(X, Y, Z, AB, SDW)
!
!***  DOWNWASH AT SUPERSONIC SPEEDS
!***  FIGURE 4.4.1-76D (TAPER = 0.00, 0.25, 0.50)
!
      DIMENSION SDW(3)
      DIMENSION ROUTID(2), QD1(3), QD2(3), QD3(3), QD4(3)
      DIMENSION XD1(9), YD1(20), XD2(9), YD2(20)
      DIMENSION XD3(2), YD3A(2), YD3B(2), YD3C(2), XD4(8), YD4(15)
      DIMENSION LGH(2), VAR(2), CC(6)
!
      DATA ROUTID / 4HSDWD, 4H     /
      DATA QD1    / 4H4.4., 4H1-76, 4HD1   /
      DATA QD2    / 4H4.4., 4H1-76, 4HD2   /
      DATA QD3    / 4H4.4., 4H1-76, 4HD3   /
      DATA QD4    / 4H4.4., 4H1-76, 4HD4   /
!
!***           FIGURE 4.4.1-76D1
!
      DATA XD1 /                                                        &
     &           1.0, 1.4, 1.8, 2.2, 2.4,                               &
     &           0.0, 0.1, 0.3, 0.5 /
      DATA YD1 /                                                        &
     &           1.68, 2.77, 3.38, 3.60, 3.62,                          &
     &           1.05, 2.11, 2.78, 3.00, 3.00,                          &
     &           0.00, 1.20, 1.91, 2.23, 2.30,                          &
     &           0.00, 0.20, 1.10, 1.45, 1.51 /
!
!***           FIGURE 4.4.1-76D2
!
      DATA XD2 /                                                        &
     &           0.0, .2, .3, 1.0, 4.0,                                 &
     &           2.0, 4., 8., 12. /
      DATA YD2 /                                                        &
     &           0.00, .100, .200, 1.00, 7.00,                          &
     &           0.00, .200, .300, 1.00, 4.00,                          &
     &           0.00, .600, .800, 1.20, 2.40,                          &
     &           0.00, .400, .600, 1.00, 1.60 /
!
!***           FIGURE 4.4.1-76D3
!
      DATA XD3  / 0.0, 5.5 /
      DATA YD3A / 0.0, 6.3 /
      DATA YD3B / 0.0, 5.5 /
      DATA YD3C / 0.0, 5.0 /
!
!***           FIGURE 4.4.1-76D4
!
      DATA XD4 /                                                        &
     &           0.0, 0.6, 1.0, 1.5, 6.0,                               &
     &           0.0, .15, .30 /
      DATA YD4 /                                                        &
     &           0.00, .120, .200, .300, 1.20,                          &
     &           .040, .040, .180, .280, 1.14,                          &
     &           .040, .040, .120, .260, .960 /
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76D1
!
      VAR(1) = X
      VAR(2) = Z
      LGH(1) = 5
      LGH(2) = 4
      CALL INTERX(2, XD1, VAR, LGH, YD1, DUM, 5, 20,                    &
     &            2, 0, 0, 0, 1, 2, 0, 0, QD1, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76D2
!
      VAR(1) = DUM
      VAR(2) = AB
      LGH(1) = 5
      LGH(2) = 4
      CALL INTERX(2, XD2, VAR, LGH, YD2, DUM, 5, 20,                    &
     &            0, 2, 0, 0, 1, 2, 0, 0, QD2, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76D3 AND 76D4 AT TAPER = 0.00
!
      IN = 0
      CALL TBFUNX(DUM, DUM2, DYDX, 2, XD3, YD3A, CC, IN,                &
     &            MI, NG, 0, 1, QD3, 3, ROUTID)
!
      VAR(1) = DUM2
      VAR(2) = Y
      LGH(1) = 5
      LGH(2) = 3
      CALL INTERX(2, XD4, VAR, LGH, YD4, SDW(1), 5, 15,                 &
     &            0, 1, 0, 0, 1, 1, 0, 0, QD4, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76D3 AND 76D4 AT TAPER = 0.25
!
      IN = 0
      CALL TBFUNX(DUM, DUM2, DYDX, 2, XD3, YD3B, CC, IN,                &
     &            MI, NG, 0, 1, QD3, 3, ROUTID)
!
      VAR(1) = DUM2
      VAR(2) = Y
      LGH(1) = 5
      LGH(2) = 3
      CALL INTERX(2, XD4, VAR, LGH, YD4, SDW(2), 5, 15,                 &
     &            0, 1, 0, 0, 1, 1, 0, 0, QD4, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76D3 AND 76D4 AT TAPER = 0.50
!
      IN = 0
      CALL TBFUNX(DUM, DUM2, DYDX, 2, XD3, YD3C, CC, IN,                &
     &            MI, NG, 0, 1, QD3, 3, ROUTID)
!
      VAR(1) = DUM2
      VAR(2) = Y
      LGH(1) = 5
      LGH(2) = 3
      CALL INTERX(2, XD4, VAR, LGH, YD4, SDW(3), 5, 15,                 &
     &            0, 1, 0, 0, 1, 1, 0, 0, QD4, 3, ROUTID)
      RETURN
      END
      SUBROUTINE SDWE(X, Y, Z, AB, TAPER, SDW)
!
!***  DOWNWASH AT SUPERSONIC SPEEDS
!***  FIGURE 4.4.1-76E
!
      DIMENSION ROUTID(2), QE1(3), QE2(3), QE3(3), QE4(3)
      DIMENSION XE1(9), YE1(20), XE2(7), YE2(10)
      DIMENSION XE3(4), YE3(4), XE4(8), YE4(15)
      DIMENSION LGH(2), VAR(2)
!
      DATA ROUTID / 4HSDWE, 4H     /
      DATA QE1    / 4H4.4., 4H1-76, 4HE1   /
      DATA QE2    / 4H4.4., 4H1-76, 4HE2   /
      DATA QE3    / 4H4.4., 4H1-76, 4HE3   /
      DATA QE4    / 4H4.4., 4H1-76, 4HE4   /
!
!***           FIGURE 4.4.1-76E1
!
      DATA XE1 /                                                        &
     &           1.0, 1.4, 1.8, 2.2, 2.4,                               &
     &           0.0, 0.1, 0.3, 0.5 /
      DATA YE1 /                                                        &
     &           1.68, 2.77, 3.38, 3.60, 3.62,                          &
     &           1.05, 2.11, 2.78, 3.00, 3.00,                          &
     &           0.00, 1.20, 1.91, 2.23, 2.30,                          &
     &           0.00, 0.20, 1.10, 1.45, 1.51 /
!
!***           FIGURE 4.4.1-76E2
!
      DATA XE2 /                                                        &
     &           0.0, 1.0, 2.0, 3.0, 4.0,                               &
     &           4.0, 5.0 /
      DATA YE2 /                                                        &
     &           0.00, 0.92, 1.97, 3.00, 4.10,                          &
     &           0.00, 1.63, 3.36, 5.20, 7.30 /
!
!***           FIGURE 4.4.1-76E3
!
      DATA XE3 /                                                        &
     &           0.00, 5.50,                                            &
     &           0.25, 0.50 /
      DATA YE3 /                                                        &
     &           0.0, 5.5,                                              &
     &           0.0, 5.0 /
!
!***           FIGURE 4.4.1-76E4
!
      DATA XE4 /                                                        &
     &           0.0, 0.6, 1.0, 1.5, 6.0,                               &
     &           0.0, .15, .30 /
      DATA YE4 /                                                        &
     &           0.00, .120, .200, .300, 1.20,                          &
     &           .040, .040, .180, .280, 1.14,                          &
     &           .040, .040, .120, .260, .960 /
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76E1
!
      VAR(1) = X
      VAR(2) = Z
      LGH(1) = 5
      LGH(2) = 4
      CALL INTERX(2, XE1, VAR, LGH, YE1, DUM, 5, 20,                    &
     &            2, 0, 0, 0, 1, 2, 0, 0, QE1, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76E2
!
      VAR(1) = DUM
      VAR(2) = AB
      LGH(1) = 5
      LGH(2) = 2
      CALL INTERX(2, XE2, VAR, LGH, YE2, DUM, 5, 10,                    &
     &            0, 2, 0, 0, 1, 2, 0, 0, QE2, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76E3
!
      VAR(1) = DUM
      VAR(2) = TAPER
      LGH(1) = 2
      LGH(2) = 2
      CALL INTERX(2, XE3, VAR, LGH, YE3, DUM, 2, 4,                     &
     &            0, 1, 0, 0, 1, 1, 0, 0, QE3, 3, ROUTID)
!
!***  TABLE LOOK UP - FIGURE 4.4.1-76E4
!
      VAR(1) = DUM
      VAR(2) = Y
      LGH(1) = 5
      LGH(2) = 3
      CALL INTERX(2, XE4, VAR, LGH, YE4, SDW, 5, 15,                    &
     &            0, 1, 0, 0, 1, 1, 0, 0, QE4, 3, ROUTID)
      RETURN
      END
      SUBROUTINE SECI(A,CAMBER,ATYPE,TYPEIN,L)
!
!  FOR EACH PLANFORM SET UP INPUT DATA
!
      COMMON /IBODY/  PB, NACA(80), BF(232), CBAR, dum1(87)
      COMMON /IWING/  PW, X(60),dum13(340)
      COMMON / IHT /  PHT, XU(60),XL(60),YU(60),YL(60), dum3(140)
      COMMON / IVT /  PVT, YUN(60),YLN(60), dum4(260)
      COMMON / IBW /  PBW, LL, dum5(379)
      COMMON / IBH /  PBH, THN(60),CAM(60), dum6(260)
      COMMON /IBWH/   PBWH,AI,ALO,CLI,ASEP,CMCO4,CLAO,CLA(20)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
!
      LOGICAL CAMBER
      REAL NACA
      
!      DIMENSION A(380),TYPEIN(162)
      DIMENSION A(*),TYPEIN(*)
! changed by RLC   2021Jan18
      
      DATA STRA / 4HSTRA /
!
      ATYPE=A(1)
      L=60
      DO 1000 I=1,80
         NACA(I)=A(I+1)
 1000 END DO
      IF(ATYPE.LE.UNUSED) GO TO 1060
      L=A(82) + 0.5
      DO 1010 M=1,L
          X(M)=A(M+82)
 1010 END DO
      IF(ATYPE .EQ. 1.) GO TO 1020
      IF(ATYPE .EQ. 2.) GO TO 1040
      GO TO 1060
 1020 DO 1030 M=1,L
         YU(M)=A(M+132)
         YL(M)=A(M+182)
 1030 END DO
      GO TO 1060
 1040 DO 1050 M=1,L
         CAM(M)=A(M+132)
         THN(M)=A(M+182)/2.
 1050 END DO
 1060 CONTINUE
      LL=L
      IF(TYPEIN(15) .NE. STRA) ATYPE=-ATYPE
      DO 1070 M=1,20
         CLA(M)=TYPEIN(20+M)
 1070 END DO
      CHRDTP=TYPEIN(1)
      SSPNOP=TYPEIN(2)
      SSPNE =TYPEIN(3)
      SSPN  =TYPEIN(4)
      CHRDBP=TYPEIN(5)
      CHRDR =TYPEIN(6)
      IF(SSPNOP.LE.10.*UNUSED)CHRDBP=CHRDTP
      IF(SSPNOP.LE.10.*UNUSED)SSPNOP=0.
      TAPRI=CHRDBP/CHRDR
      CREI =CHRDR*(TAPRI+(1.-TAPRI)*(SSPNE-SSPNOP)/(SSPN-SSPNOP))
      TAPRI=CHRDBP/CREI
      TAPRO=0.
      IF(CHRDBP.NE.0.)TAPRO=CHRDTP/CHRDBP
      CREO =CHRDBP
      CBARI=2.*CREI*(1.+TAPRI+TAPRI**2)/(3.*(1.+TAPRI))
      CBARO=2.*CREO*(1.+TAPRO+TAPRO**2)/(3.*(1.+TAPRO))
      AREAI=(SSPN-SSPNOP)*CREI*(1.+TAPRI)
      AREAO=SSPNOP*CREO*(1.+TAPRO)
      CBAR =(CBARI*AREAI+CBARO*AREAO)/(AREAI+AREAO)
      RETURN
      END
      SUBROUTINE SECLEV
      COMMON /IBODY/  PBO, BODY(400)
      COMMON /IWING/  PWG, WING(400)
      COMMON /IHT/    PHT, HT(380)
      COMMON /IVT/    PVT, VT(380)
      COMMON /IBW/    PBW, BW(380)
      COMMON /IBH/    PBH, BH(380)
      COMMON /IBWHV/  PBT, BWHV(380)
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /BODYI/  BODYIN(129)
      COMMON /WINGI/  WINGIN(100)
      COMMON /HTI/    HTIN(154)
      COMMON /WINGD/  A(195),B(49)
      COMMON /SBETA/  STB(135),TRA(108),TRAH(108)
      COMMON /BDATA/  BD(762)
      COMMON /WHWB/   FACT(182)
      COMMON /HTDATA/ AHT(195),BHT(49)
      COMMON /SUPWBB/ SWB(61),SHB(61)
      COMMON /LEVEL2/ SEC(23)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /EXPER/  KLIST,NLIST(100),NNAMES,IMACH,MDATA,KBODY,        &
     &                KWING,KHT,KVT,KWB,KDWASH(3),ALPOW,ALPLW,          &
     &                ALPOH,ALPLH
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART
      LOGICAL DOL2, FLAG
      EQUIVALENCE (SEC(16),DOL2)
!
      IF(.NOT. DOL2) GO TO 1000
      CALL EXSUBT
      IF(WGPL) CALL WINGCL(NALPHA,B(23),ALPOW,ALPLW,TRA(37),            &
     &         WING(101),TRA(38),WING(21),FLC(I+2),WINGIN(16),          &
     &         A(35),A(27),A(7),SEC(1),SEC(2),TRA(70),TRA(1),           &
     &         SEC(17),WING(1),SEC(18),WING(181))
      IF(HTPL) CALL WINGCL(NALPHA,BHT(23),ALPOH,ALPLH,TRAH(37),         &
     &         HT(101),TRAH(38),HT(21),FLC(I+2),HTIN(16),AHT(35),       &
     &         AHT(27),AHT(7),SEC(3),SEC(4),TRAH(70),TRAH(1),           &
     &         SEC(19),HT(1),SEC(20),HT(181))
!
      FLAG = BO .AND. WGPL
      XC = A(161)+XW
      IF(FLAG) CALL WBCLB(NALPHA,WING(21),WING(101),BODY(21),BODY(101), &
     &         WING,BODY,BW(101),FLC(23),BD(255),WINGIN,XC,             &
     &         A(27),ALIW,SWB(35),SWB(11),SEC(6),SEC(9),SEC(5),         &
     &         TRA(12),FLC(I+2),TRA(6),SWB(2),SWB(37),FACT,             &
     &         BW(21),BW,BW(181),SEC(21))
      FLAG = BO .AND. HTPL
      XC = AHT(161)+XH
      IF(FLAG) CALL WBCLB(NALPHA,HT(21),HT(101),BODY(21),BODY(101),     &
     &         HT,BODY,BH(101),FLC(23),BD(255),HTIN,XC,                 &
     &         AHT(27),ALIH,SHB(35),SHB(11),SEC(8),SEC(10),SEC(7),      &
     &         TRAH(12),FLC(I+2),TRAH(6),SHB(2),SHB(37),FACT(142),      &
     &         BH(21),BH,BH(181),SEC(22))
!
      FLAG = BO .AND. WGPL .AND. HTPL
      IF(FLAG) CALL WBTCDO
      IF(.NOT. FLAG) BWHV(1) = UNUSED
      IF(.NOT. VTPL) VT(1) = 0.0
      FLAG = BO .AND. (WGPL .OR. HTPL .OR. VTPL)
      IF(FLAG) CALL CDWBT
      IF(FLAG) CALL CLWBT
 1000 CALL CNCA
      RETURN
      END
      SUBROUTINE SECO(A,CAMBER,ATYPE)
!
!  FOR EACH PLANFORM SET UP OUTPUT DATA
!
      COMMON /IBH/PBH, THN(60),CAM(60),A0,XC,MCC,CLCC,XAC(20),dum6(276)
      COMMON /IBWH/   PBWH,AI,ALO,CLI,ASEP,CMCO4,CLA0,CLA(20),CLMAX0,   &
     &                CLMAX(20)
      COMMON /IBWHV/  PBWHV, RHO,TMAX,DELTAY,XOVC,TOVC,COVC
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)

!      DIMENSION A(162)
      DIMENSION A(*)
! changed by RLC  2021Jan18
      
      IF(A(16).EQ.UNUSED) A(16)=2.*TOVC
      IF(A(17).EQ.UNUSED) A(17)=DELTAY
      IF(A(18).EQ.UNUSED) A(18)=XOVC
      IF(A(19).EQ.UNUSED) A(19)=CLI
      IF(A(20).EQ.UNUSED) A(20)=AI
      NMACH=FLC(1)+0.5
      DO 1000 M=1,NMACH
         IF(A(M+20).EQ.UNUSED) A(M+20)=CLA(M)
         IF(A(M+40).EQ.UNUSED) A(M+40)=CLMAX(M)
         IF(A(M+71).EQ.UNUSED) A(M+71)=XAC(M)
 1000 END DO
      IF(A(61).EQ.UNUSED) A(61)=CMCO4
      IF(A(62).EQ.UNUSED) A(62)=RHO
      A(64)=CAMBER
      IF(A(68).EQ.UNUSED) A(68)=CLMAX0
      IF(A(69).EQ.UNUSED) A(69)=CLA0
      IF(A(10).EQ.UNUSED)A(10)=ALO
      IF(A(93).EQ.UNUSED) A(93)=COVC
      IF(ATYPE.GE.0.) GO TO 1010
      IF(A(63).EQ.UNUSED) A(63)=RHO
      IF(A(65).EQ.UNUSED) A(65)=2.*TOVC
      IF(A(66).EQ.UNUSED) A(66)=XOVC
      IF(A(67).EQ.UNUSED) A(67)=CMCO4
 1010 CONTINUE
      RETURN
      END
      SUBROUTINE SETUP1
!
!***  COMPUTES TRIG FUNCTIONS FOR LIFTING SURFACES
!
      COMMON /WINGD/  A(195), B(48)
      COMMON /HTDATA/ AHT(195), BHT(48)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /BDATA/  BD(762)
      COMMON /WINGI/  WINGIN(101)
      COMMON /HTI/    HTIN(154)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /FLGTCD/ FLC(73), dumflgtcd(87)
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      NM=FLC(1)+.5
      A(174)=WINGIN(18)
      AHT(174)=HTIN(18)
      AVT(174)=VTIN(18)
      AVF(174)=VFIN(18)
      CALL ANGLES(1,A(106))
      CALL ANGLES(1,AHT(106))
      CALL ANGLES(1,AVT(106))
      CALL ANGLES(1,AVF(106))
      CALL ANGLES(1,A(112))
      CALL ANGLES(1,AHT(112))
      CALL ANGLES(1,AVT(112))
      CALL ANGLES(1,AVF(112))
      CALL ANGLES(1,A(138))
      CALL ANGLES(1,AHT(138))
      CALL ANGLES(1,AVT(138))
      CALL ANGLES(1,AVF(138))
      NA=FLC(2)+.5
!
!     ----COMPUTE VARIOUS ALPHAS
!
      TMP=ALIW
      DO 1000 I=1,NA
         B(I+22)=FLC(I+22)+TMP
         BHT(I+22)=FLC(I+22)+ALIH
         BD(I+254)=FLC(I+22)+BD(81)
 1000 END DO
      RETURN
      END
      SUBROUTINE SETUP2
!
!***  SETUP FOR TRANSONIC CONFIGURATION ANALYSIS
!
      COMMON /IWING/  PWNG, WING(400)
      COMMON /IHT/    PHT,  HT(380)
      COMMON /IBW/    PBW,  BW(380)
      COMMON /IBH/    PBH,  BH(380)
      COMMON /FLGTCD/ FLC(96), dumflgtcd(64)
      COMMON /WINGI/  WINGIN(100)
      COMMON /HTI/    HTIN(154)
      COMMON /WINGD/  A(195), B(49)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /WBHCAL/ WBT(155)
      COMMON /LEVEL2/ SECOND(23)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART
      LOGICAL FLAG, DONE
      REAL MFBW, MFBH
      DIMENSION STP(155)
      EQUIVALENCE (TRA(1),FLAG), (SECOND(15),DONE)
      EQUIVALENCE (STP(1),WBT(1)), (SECOND(17),SMACH)
      EQUIVALENCE (SECOND(18),MFBW), (SECOND(19),MFBH)
!
 1000 N = -NF
      GO TO (1010, 1020, 1030, 1040, 1050, 1060, 1070), N
 1010 CONTINUE
        SMACH  = FLC(I+2)
        SUBSON = .TRUE.
        TRANSN = .FALSE.
        MFBW = TRA(6)
        MFBH = TRAH(6)
        FLC(I+2) = 0.6
        B(1) = 0.6
        B(2) = 0.8
        BHT(1) = B(1)
        BHT(2) = B(2)
        WINGIN(I+20) = WINGIN(69)/B(2)
        WINGIN(I+40) = WINGIN(68)
        HTIN(I+20) = HTIN(69)/B(2)
        HTIN(I+40) = HTIN(68)
        FLAG = WGPL .OR. HTPL
        GO TO 1090
 1020 CONTINUE
        SECOND(11) = WBT(67)
        CALL CLBCLC(SECOND(1),WING)
        CALL CLBCLC(SECOND(3),HT)
        FLC(I+2) = 0.7
        B(1) = 0.7
        B(2) = 0.71414284
        BHT(1) = B(1)
        BHT(2) = B(2)
        WINGIN(I+20) = WINGIN(69)/B(2)
        HTIN(I+20) = HTIN(69)/B(2)
        FLAG = BO .AND. WGPL .AND. HTPL
        GO TO 1090
 1030 CONTINUE
        SECOND(12) = WBT(67)
        IF(MFBW .GT. 0.95) MFBW = 0.95
        FLC(I+2) = MFBW
        B(1) = MFBW
        B(2) = SQRT(1.-B(1)**2)
        BHT(1) = B(1)
        BHT(2) = B(2)
        WINGIN(I+20) = WINGIN(69)/B(2)
        HTIN(I+20) = HTIN(69)/B(2)
        FLAG = BO .AND. WGPL
        GO TO 1090
 1040 CONTINUE
        CALL CLBCLC(SECOND(5),BW)
        IF(MFBH .GT. 0.95) MFBH = 0.95
        FLC(I+2) = MFBH
        B(1) = MFBH
        B(2) = SQRT(1.-B(1)**2)
        BHT(1) = B(1)
        BHT(2) = B(2)
        WINGIN(I+20) = WINGIN(69)/B(2)
        HTIN(I+20) = HTIN(69)/B(2)
        FLAG = BO .AND. HTPL
        GO TO 1090
 1050 CONTINUE
        CALL CLBCLC(SECOND(7),BH)
        SUBSON = .FALSE.
        SUPERS = .TRUE.
        FLC(I+2) = 1.4
        FLAG = WGPL .OR. HTPL
        GO TO 1090
 1060 CONTINUE
        CALL CLBCLC(SECOND(2),WING)
        CALL CLBCLC(SECOND(4),HT)
        CALL CLBCLC(SECOND(6),BW)
        CALL CLBCLC(SECOND(8),BH)
        SECOND(9) = BW(101)
        SECOND(10) = BH(101)
        SECOND(14) = STP(155)
        FLC(I+2) = 1.1
        FLAG = BO .AND. WGPL .AND. HTPL
        GO TO 1090
 1070 CONTINUE
        SECOND(13) = STP(155)
        FLC(I+2) = SMACH
        NALPHA   = FLC(2)+0.5
        DONE   = .TRUE.
        SUPERS = .FALSE.
        TRANSN = .TRUE.
        IF(.NOT. WGPL) SECOND(1) = UNUSED
        IF(.NOT. WGPL) SECOND(2) = UNUSED
        IF(.NOT. HTPL) SECOND(3) = UNUSED
        IF(.NOT. HTPL) SECOND(4) = UNUSED
        IF(.NOT. (BO .AND. WGPL)) SECOND(5) = UNUSED
        IF(.NOT. (BO .AND. WGPL)) SECOND(6) = UNUSED
        IF(.NOT. (BO .AND. WGPL)) SECOND(9) = UNUSED
        IF(.NOT. (BO .AND. HTPL)) SECOND(7) = UNUSED
        IF(.NOT. (BO .AND. HTPL)) SECOND(8) = UNUSED
        IF(.NOT. (BO .AND. HTPL)) SECOND(10)= UNUSED
        FLAG = BO .AND. WGPL .AND. HTPL
        IF(.NOT. FLAG) SECOND(11) = UNUSED
        IF(.NOT. FLAG) SECOND(12) = UNUSED
        IF(.NOT. FLAG) SECOND(13) = UNUSED
        IF(.NOT. FLAG) SECOND(14) = UNUSED
        DO 1080 J=17,23
           SECOND(J) = UNUSED
 1080   CONTINUE
        FLAG = .TRUE.
 1090 CONTINUE
      NF = NF-1
      IF(.NOT. FLAG) GO TO 1000
      RETURN
      END
      SUBROUTINE SIMUL2(X,C1,C2,NPT,SIMSOL,ORDNAT)
!
!***  SOLVES FOR WHERE TWO CURVES INTERSECT
!
      DIMENSION CT1(6),CT2(6),ROUTID(2)
      DIMENSION X(1),C1(1),C2(1)
      DATA ROUTID/4HSIMU,4HL2  /,MS/4HSIML/
      I1=0
      I2=0
      DO 1000 I=1,NPT
         CROSS=C2(I)-C1(I)
         IF(CROSS.EQ.0.0)GO TO 1010
         SIGN=CROSS/ABS(CROSS)
         IF(I.EQ.1)GO TO 1000
         IF(SIGN.NE.SIGNP)GO TO 1030
 1000 SIGNP=SIGN
!
!     ----NO ANSWER IF HERE
!
      SIMSOL=-1000.
      ORDNAT=-1000.
      RETURN
 1010 SIMSOL=X(I)
      ORDNAT=C1(I)
      RETURN
 1020 SIMSOL=XTST
      ORDNAT=CD1
      RETURN
 1030 XD2=X(I)-X(I-1)
      KOUNT=0
      XSRT=X(I-1)
 1040 XD2=XD2/2.
      XTST=XSRT+XD2
      CALL TBFUNX(XTST,CD1,D,NPT,X,C1,CT1,I1,MI,NG,0,0,MS,1,ROUTID)
      CALL TBFUNX(XTST,CD2,D,NPT,X,C2,CT2,I2,MI,NG,0,0,MS,1,ROUTID)
      CR=CD2-CD1
      IF(CR.EQ.0.0)GO TO 1020
      IF(CD1.NE.0.0)GO TO 1050
      CDV=CR/CD2
      GO TO 1060
 1050 CDV=CR/CD1
 1060 IF(ABS(CDV).LT.0.001)GO TO 1020
      IF(KOUNT.GT.100)GO TO 1020
      KOUNT=KOUNT+1
      SIGN=CR/ABS(CR)
      IF(SIGN.EQ.SIGNP)XSRT=XTST
      GO TO 1040
      END
      SUBROUTINE SIMUL4(COFF,EQ,UNK)
!
!     ----SUBROUTINE SOLVES  4  SIMULTANEOUS LINEAR EQUATIONS
!
      DIMENSION COFF(16),EQ(4),UNK(4),DE(16)
      CALL DET4(COFF,D)
      DO 1020 M=1,4
         DO 1000 I=1,16
            DE(I)=COFF(I)
 1000    CONTINUE
         K=1
         DO 1010 I=M,16,4
            DE(I)=EQ(K)
            K=K+1
 1010    CONTINUE
         CALL DET4(DE,G)
         UNK(M)=G/D
 1020 END DO
      RETURN
      END
      SUBROUTINE SKIPBL(KOL, KCOL)
!
!***  SKIP BLANK CHARACTERS IN ARRAY KOL, UPDATE KCOL POINTER.
!***  KCOL IS SET TO 81 IF ALL LOCATIONS STARTING AT KCOL ARE BLANK.
!
      INTEGER BLANK
!
      DIMENSION KOL(80)
!
      DATA BLANK / 4H     /
!
 1000 IF(KOL(KCOL) .NE. BLANK)GO TO 1010
      KCOL=KCOL+1
!
      IF(KCOL .LT. 81)GO TO 1000
!
 1010 CONTINUE
!
      RETURN
      END
      SUBROUTINE SLEQ(A,X,B,N,M)
!
!  THIS ROUTINE SOLVES N SIMULTANEOUS EQUATIONS WITH CONSTANTS
!  MATRIX A(I,J) IS USED AS I=ROW AND J=COLUMN
!
      DIMENSION A(N,M),X(N),B(N)
      NP1=N+1
      IND=0
      NM1=N-1
      DO 1000 K=1,N
 1000 A(K,NP1)=B(K)
 1010 DO 1040 K=1,N
         KP1=K+1
!
!  CHECK FOR A ZERO ON THE DIAGONAL
!
         IF(A(K,K).EQ.0.) GO TO 1060
         DO 1020 J=KP1,NP1
 1020    A(K,J)=A(K,J)/A(K,K)
         A(K,K)=1.
         DO 1040 I=1,N
         IF(I.EQ.K) GO TO 1040
         DO 1030 J=KP1,NP1
 1030    A(I,J)=A(I,J)-A(I,K)*A(K,J)
         A(I,K)=0.0
 1040 CONTINUE
!
!  GET THE RESULTS AND STORE IN X
!
      DO 1050 L=1,N
 1050 X(L)=A(L,NP1)
      GO TO 1100
!
!  HERE FOR ZERO ON THE DIAGONAL
!  INTERCHANGE THE ROWS AND TRY NEW SOLUTION
!
 1060 IND=IND+1
      IF(IND.GT.N)GO TO 1090
      DO 1080 I=1,M
         TEMP=A(N,I)
         DO 1070 J=1,NM1
 1070    A(N-J+1,I)=A(N-J,I)
 1080 A(1,I)=TEMP
      GO TO 1010
 1090 CONTINUE
      WRITE(6,1110)
 1100 CONTINUE
 1110 FORMAT(30H0*** WARNING - SLEQ ERRORS ***/)
      RETURN
      END
      SUBROUTINE SLOPE(MACH,CLALPA,RENN,XACM)
!
!***  CALCULATES AIRFOIL SECTION CLA,CM0 AND XAC
!
      COMMON /IBH/    PBH, THN(60),CAM(60),A0,XC,MCC,CLCC, dum6(256)
      COMMON /IBV/    PBV,ZTNU(32),ZCNU(32),ST1NU(32),ST2NU(32),        &
     &                ST3NU(32),ST4NU(32),ST5NU(32),X(32),THNU(32),     &
     &                THMU(32)
      COMMON /IBWH/   PBWH,AI,ALO,CLI,ALPMAX,CMCO4
      COMMON /IBWHV/  PBWHV,RHO
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /IPOWER/ PP,VXOVU(32),VXOVL(32),CPUM(32),CPLM(32),         &
     &                BO(32),CPI(32)
      DIMENSION CL(2),ALPHA(2),CM(2),XI(32),STNU(32)
!
!  WEBER PRESSURE DISTRIBUTION AND CL-ALPHA
!  METHOD INCLUDES COMPRESSIBILITY
!
      REAL LX,MACH,MCC
      XN=32.
      N=XN
      NM1=N-1
      CLALPA=UNUSED
      IF(MACH.GE.1.) GO TO 1070
      ALPHA(1)=ALO
      ALPHA(2)=ALO+1.
      BETA=SQRT(1.-MACH**2)
      A0=SQRT(2.*RHO)
      TMACH=0.
      IF(MACH.NE.0.) TMACH=1./(.7*MACH**2)
 1000 DO 1050 I=1,2
         COSA=COS(ALPHA(I)*DEG)
         SINA=SIN(ALPHA(I)*DEG)
         DO 1020 L=1,NM1
            CPI(L)=1.-(1.+ST1NU(L))**2/(1.+ST2NU(L)**2)
            BO(L)=1.-MACH**2*(1.-MACH*CPI(L))
            IF(BO(L) .LT. 0.) GO TO 1080
            BO(L)=SQRT(BO(L))
            VXOVU(L)=(COSA*(1.+ST1NU(L)/BO(L)+ST4NU(L)/BETA)+SINA/BETA* &
     &               (1.+ST3NU(L)/BO(L))*SQRT((1.-X(L))/X(L)))/SQRT(1.  &
     &               +((ST2NU(L)+ST5NU(L))/BO(L))**2)
            VXOVL(L)=(COSA*(1.+ST1NU(L)/BO(L)-ST4NU(L)/BETA)-SINA/BETA* &
     &               (1.+ST3NU(L)/BO(L))*SQRT((1.-X(L))/X(L)))/SQRT(1.  &
     &               +((ST2NU(L)-ST5NU(L))/BO(L))**2)
            IF(MACH .EQ. 0.) GO TO 1010
            CPUVD=1.+.2*MACH**2*(1.-VXOVU(L)**2)
            IF(CPUVD .LT. 0.) GO TO 1080
            CPLVD=1.+.2*MACH**2*(1.-VXOVL(L)**2)
            IF(CPLVD .LT. 0.) GO TO 1080
            CPUM(L)=TMACH*((CPUVD)**(3.5)-1.)
            CPLM(L)=TMACH*((CPLVD)**(3.5)-1.)
            GO TO 1020
 1010       CPUM(L)=1.-(VXOVU(L))**2
            CPLM(L)=1.-(VXOVL(L))**2
 1020    CONTINUE
!
!  PRESSURE COEFFICIENT AT THE LEADING EDGE
!
         IF(A0.NE.0.)VXOVU(N)=SINA*((1.+ST3NU(N))/(.5*A0))
         IF(A0.EQ.0.)VXOVU(N)=0.
         VXOVL(N)=VXOVU(N)
         CPUVDN=1.+.2*MACH**2*(1.-(VXOVU(N)/BETA)**2)
         IF(CPUVDN .LT. 0.) GO TO 1080
         CPUM(N)=TMACH*((CPUVDN)**(3.5)-1.)
         IF(TMACH .EQ. 0.) CPUM(N)=1.-(VXOVU(N))**2
         CPLM(N)=CPUM(N)
!
!   INTEGRATE THE CP CURVE AT THIS ALPHA
!
         SUMCL=0.0
         DO 1030 L=1,NM1
            LX=-(CPUM(L)-CPLM(L))
            SINTH=SIN(THNU(L))/2.
            SUMCL=SUMCL+LX*SINTH
 1030    CONTINUE
         CL(I)=SUMCL*PI/(COSA*XN)
!
!  PITCHING MOMENT COEFFICIENT
!
         SUMCM=0.0
         DO 1040 L=1,NM1
            LX=CPUM(L)-CPLM(L)
           DCM=LX*(X(L)-.25)*SIN(THNU(L))/2.
 1040    SUMCM=SUMCM+DCM
         CM(I)=SUMCM*PI/XN
 1050 END DO
      IF(ABS(CL(1)) .LE. .001) GO TO 1060
      CLALPA=CL(2)-CL(1)
      ALO=ALO-CL(1)/CLALPA
      ALPHA(1)=ALO
      ALPHA(2)=ALO+1.
      GO TO 1000
 1060 CONTINUE
!
!  GET CORRECTION FACTOR FOR VISCOUS AFFECTS
!
      REN=1.E6
      IF (RENN.GE.10..AND.MCC.NE.0..AND.MACH.NE.0.) REN=RENN
      IF(REN .LT. 2.71828E5)WRITE(6,1170)
      IF(REN .LT. 2.71828E5)REN=2.7182E5
      PHITE=((ZTNU(6)+ZTNU(7))/2.-ZTNU(2))/.089272624
      EXPN=-1.+5.*PHITE/2.
      CON=1.-(ALOG(REN /1.E5))**EXPN*(.232+1.785*PHITE-2.950*PHITE**2)
      IF(CON .LT. .6896) CON=.6896
!
!  GET LIFT CURVE SLOPE FROM THESE TWO ANGLES OF ATTACK
!
      CLALPA=(CL(2)-CL(1))*CON*1.05
!
!  GET PITCHING MOMENT SLOPE
!
      CMALPA=CM(2)-CM(1)
      IF(MACH.EQ.0.0) CMCO4=CM(1)
!
!  NOW THE AERODYNAMIC CENTER
!
      XACM=0.25-CMALPA/CLALPA
 1070 CONTINUE
      GO TO 1090
 1080 CONTINUE
!
!  ANALYSIS FAILING -- PRINT INFORMATIVE DIAGNOSTIC
!
      WRITE(6,1160)
 1090 CONTINUE
      IF(MACH .NE. 0.) GO TO 1150
!
!  CALCULATE THE CREST CRITICAL CONDITIONS FOR THIS AIRFOIL
!
      CLM=CLALPA
      J=N-1
      DO 1100 I=1,NM1
         XI(I)=X(J)
         STNU(I)=ST2NU(J)+ST5NU(J)
 1100 J=J-1
      STC=SINA/COSA
      DO 1110 I=1,NM1
         II=I
         IF(STC .GT. STNU(I)) GO TO 1120
 1110 END DO
 1120 XC=(STC-STNU(II))/(STNU(II-1)-STNU(II))*(XI(II-1)-XI(II))+XI(II)
      DO 1130 I=1,NM1
         II=I
         IF(XC .GT. X(I)) GO TO 1140
 1130 END DO
 1140 VOVU=(XC-X(II))/(X(II-1)-X(II))*(VXOVU(II-1)-VXOVU(II))+VXOVU(II)
      CPCC=1.-VOVU**2
      MCC=1.023-.9507*CPCC-.4140*CPCC**2-.1506*CPCC**3-.0212*CPCC**4
      MCC=1./MCC
      BCC=SQRT(1.-MCC**2)
      CLCC=(ABS(CLM)/(BCC-(MCC**2/(1.+BCC))*ABS(CLM)/2.))*CON
 1150 CONTINUE
 1160 FORMAT(56H ********* COMPUTATIONS IN SUBROUTINE SLOPE HAVE FAILED.&
     &,38H ANALYSIS FOR THIS AIRFOIL IMPOSSIBLE.)
 1170 FORMAT(56H0**** REYNOLDS NUMBER TOO LOW FOR THE AIRFOIL SECTION MO&
     &,61HDULE, SECTION CHARACTERISTICS BASED ON A VALUE OF 2.718E5 ***)
      RETURN
      END
      SUBROUTINE SORTER(A,N,M,IROW,ICOL,B,IR,IC,IFLAG)
!
!  SUBROUTINE TO SORT A TWO DIMENSIONAL INTEGER ARRAY IN ASCENDING ORDER
!
!  INPUTS
!
!     A    - TWO DIMENSIONAL ARRAY TO BE SORTED
!     N    - NUMBER OF ROWS IN ARRAY
!     M    - NUMBER OF COLUMNS IN ARRAY
!     IROW - IF NON-ZERO, SORT ARRAY BASED ON VALUES IN ROW IROW
!     ICOL - IF NON-ZERO, SORT ARRAY BASED ON VALUES IN COLUMN ICOL
!
!  OUTPUTS
!
!     B    - SORTED ARRAY A
!     IR   - ARRAY ELEMENTS GIVE THE ORDER OF ROWS EXCHANGED
!     IC   - ARRAY ELEMENTS GIVE THE ORDER OF COLUMNS EXCHANGED
!     IFLAG- RETURNS A ZERO (0) FOR ARRAY SORTED,  RETURNS A ONE (1)
!            FOR NO ARRAY SORTING PERFORMED
!
!  COMMENTS
!
!     IF ICOL AND IROW ARE BOTH NON-ZERO, THE SORTING WILL BE FIRST
!     PERFORMED BY THE VALUES IN COLUMN ICOL, THEN BY THE VALUES IN
!     ROW IROW. IF THIS OPTION IS SPECIFIED, THE ORIGINAL MATRIX A
!     IS DESTROYED.  FOR A VECTOR, SET M TO ONE AND IROW TO ZERO.
!
!     THIS ROUTINE IS DESIGNED FOR INTEGER ARRAYS, BUT CAN BE
!     USED FOR FLOATING POINT ARRAYS AS WELL BY DELETING THE
!     INTEGER DECLARATION CARD THAT FOLLOWS.
!
      INTEGER A,B,BMIN,BMAX
      DIMENSION A(N,M),B(N,M),IR(N),IC(M)
      IF(N.LE.0) GO TO 1290
      IF(M.LE.0) GO TO 1290
      DO 1000 I=1,N
 1000 IR(I)=I
      DO 1010 I=1,M
 1010 IC(I)=I
      IF(N.EQ.M.AND.N.LT.2) GO TO 1300
      IFLAG=0
      IF(ICOL)1020,1020,1030
 1020 IF(IROW)1250,1250,1130
 1030 CONTINUE
!
!  SORT ARRAY BY THE VALUES IN COLUMN ICOL (REORDER ROWS)
!
      IRR=1
      KK=1
      ISTAT=0
      KOUNT=0
      DO 1040 I=1,N
         DO 1040 J=1,M
 1040 B(I,J)=A(I,J)
      BMAX=B(1,ICOL)
      BMIN=BMAX
 1050 DO 1080 K1=1,N
         K=N-K1+1
         IF(ISTAT)1060,1060,1070
 1060    IF(BMAX.LE.B(K,ICOL))BMAX=B(K,ICOL)
         IF(BMAX.EQ.B(K,ICOL))KK=K
         GO TO 1080
 1070    IF(BMIN.GE.B(K,ICOL))BMIN=B(K,ICOL)
         IF(BMIN.EQ.B(K,ICOL))KK=K
 1080 END DO
      KOUNT=KOUNT+1
      IF(ISTAT)1090,1090,1100
 1090 ISTAT=1
      KOUNT=0
      KK=1
      GO TO 1050
 1100 IF(KOUNT.GE.(N+1))GO TO 1110
      B(KK,ICOL)=BMAX+BMAX
      IR(IRR)=KK
      IRR=IRR+1
      BMIN=BMAX+BMAX
      GO TO 1050
 1110 DO 1120 K=1,N
         LL=IR(K)
         DO 1120 L=1,M
            B(K,L)=A(LL,L)
 1120 CONTINUE
      IFLAG=-1
      GO TO 1020
 1130 CONTINUE
!
!  SORT ARRAY BY THE VALUES IN ROW IROW (REORDER COLUMNS)
!
      IF(IFLAG.GE.0)GO TO 1150
      DO 1140 I=1,N
         DO 1140 J=1,M
 1140 A(I,J)=B(I,J)
 1150 CONTINUE
      IRR=1
      KK=1
      ISTAT=0
      KOUNT=0
      DO 1160 I=1,N
         DO 1160 J=1,M
 1160 B(I,J)=A(I,J)
      BMAX=B(IROW,1)
      BMIN=BMAX
 1170 DO 1200 K1=1,M
         K=M-K1+1
         IF(ISTAT)1180,1180,1190
 1180    IF(BMAX.LE.B(IROW,K))BMAX=B(IROW,K)
         IF(BMAX.EQ.B(IROW,K))KK=K
         GO TO 1200
 1190    IF(BMIN.GE.B(IROW,K))BMIN=B(IROW,K)
         IF(BMIN.EQ.B(IROW,K))KK=K
 1200 END DO
      KOUNT=KOUNT+1
      IF(ISTAT)1210,1210,1220
 1210 ISTAT=1
      KOUNT=0
      KK=1
      GO TO 1170
 1220 IF(KOUNT.GE.(M+1))GO TO 1230
      B(IROW,KK)=BMAX+BMAX
      IC(IRR)=KK
      IRR=IRR+1
      BMIN=BMAX+BMAX
      GO TO 1170
 1230 DO 1240 L=1,M
         LL=IC(L)
         DO 1240 K=1,N
            B(K,L)=A(K,LL)
 1240 CONTINUE
 1250 IFLAG=0
      DO 1260 I=1,N
         IF(IR(I).NE.I) GO TO 1300
 1260 END DO
 1270 DO 1280 I=1,M
         IF(IC(I).NE.I) GO TO 1300
 1280 END DO
 1290 IFLAG=1
 1300 CONTINUE
      RETURN
      END
      SUBROUTINE SPRYAW
!
!    ---THIS SUBROUTINE CALCULATES SUPERSONIC ROLL AND YAW
!     CHARACTERISTICS OF PLAIN T.E. FLAPS (TAPERED AND UNTAPERED),
!     SPOILERS,AND ROLL CHARACTERISTICS OF DIFF DEFLECTED ALL-
!     MOVING HORIZONTAL STABILIZERS.
!
      REAL MACH,IVBH,KHB,KBH,K3,LAMHL,NUGEOM,K1,K2
      LOGICAL TAPERD
      LOGICAL INBORD
      LOGICAL TRANSL
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /WINGI/  WINGIN(77)
      COMMON /WINGD/  A(195)
      COMMON /HTI/    HTIN(131)
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /FLAPIN/ F(69)
      COMMON /IHT/    PHT,HT(380)
      COMMON /IBODY/  PBODY,BODY(400)
      COMMON /IWING/  PWING,WING(400)
      COMMON /POWR/   SPR(59)
      COMMON /WBHCAL/ STP(155)
      COMMON /SUPWH/  STG(141)
      COMMON /HTDATA/ AHT(195),BHT(49)
      DIMENSION ROUTID(2)
      DIMENSION Q22113(3)
      DIMENSION Q22114(3)
      DIMENSION Q21130(3)
      DIMENSION Q212A1(4),Q212A2(4)
      DIMENSION X12A1(11),Y12A1(11),C12A1(6)
      DIMENSION X12A2(11),Y12A2(11),C12A2(6)
      DIMENSION ITRANS(4)
      DIMENSION PASTIM(10)
      DIMENSION CNYWSP(10),CLRLSP(10)
      DIMENSION DELTAS(10)
      DIMENSION TAKTIM(10)
      DIMENSION ALSCHD(20)
      DIMENSION ALSHD(20)
      DIMENSION CLDELB(2)
      DIMENSION TEMPO(2)
      DIMENSION CNYWAL(200)
      DIMENSION DELTAL(10),DELTAR(10)
      DIMENSION CLRLAL(10),CLRLHT(200),CLRLS(200),IVBH(20),GAMMA(20)
      DIMENSION CFACT(10)
      DIMENSION X114A1(3),X114A2(2),Y2114A(6)
      DIMENSION X114E1(1),X114E2(7),Y2114E(7)
      DIMENSION X114F1(1),X114F2(8),Y2114F(8)
      DIMENSION X11301(2),X11302(2),Y21130(4)
      DIMENSION X113A1(4),X113A2(2),Y2113A(8)
      DIMENSION X113B1(4),X113B2(2),Y2113B(8)
      DIMENSION X113C1(4),X113C2(2),Y2113C(8)
      DIMENSION X113E1(2),X113E2(2),Y2113E(4)
      EQUIVALENCE (BSTRO2,WINGIN(2))
      EQUIVALENCE (TAPRI,A(26)),(TAPRO,A(28))
      EQUIVALENCE (ALOCI,F(14)),(ALOCO,F(15))
      EQUIVALENCE (SSPN,WINGIN(4))
      EQUIVALENCE (BETA,SPR(1)),(C1,SPR(2)),(C2,SPR(3)),(LAMHL,SPR(4))
      EQUIVALENCE (PHITE,SPR(5)),(K3,SPR(6)),(SF,SPR(7)),(CLRLF,SPR(8))
      EQUIVALENCE (CLRLAL(1),CLRLSP(1),HT(211))
      EQUIVALENCE (CNYWSP(1),HT(221))
      EQUIVALENCE (CNYWAL(1),BODY(201)),(CLRLHT(1),WING(201))
      EQUIVALENCE (YHS,SPR(11)),(BCLD1 ,SPR(12)),(BCLD2,SPR(13))
      EQUIVALENCE (CFO,F(13)),(CFI,F(12))
      EQUIVALENCE (IVBH(1),STP(133)),(GAMMA(1),STP(111))
      EQUIVALENCE (KHB,SPR(9)),(KBH,SPR(10))
      EQUIVALENCE (CNAHS,HT(101)),(SH,AHT(3)),(SSPNEH,HTIN(3)),         &
     &            (SSPNH,HTIN(4)),(DELTAL(1),F(19)),(DELTAR(1),F(29))
      EQUIVALENCE (SAI100,A(76))
      EQUIVALENCE (SAI050,A(70))
      EQUIVALENCE (DELTAS(1),F(39))
      EQUIVALENCE (SSPNE,WINGIN(3))
      EQUIVALENCE (CLADEG,WING(101)),(SW,A(3))
      EQUIVALENCE (ALSCHD(1),FLC(23))
      EQUIVALENCE (TANLE,A(62)),(TANTE,A(77))
      EQUIVALENCE (TANHL,SPR(14))
      EQUIVALENCE (TLEOB,SPR(32)),(THLOB,SPR(33)),(TTEOB,SPR(34))
      DATA ITRANS/2,3,4,7/
!
!     ----FIGURE 6.2.2.1-13
!
      DATA X113A2 /0.,.01/
      DATA X113A1 /0.,5.,10.,15./
      DATA Y2113A /-.02,-.02,-.02,-.0176,-.02,-.01068,-.02,-.0004/
      DATA X113B2 /0.,.01/
      DATA X113B1 /0.,5.,10.,15./
      DATA Y2113B /0.,0.,0.,1.2,0.,5.15,0.,11.2/
      DATA X113C2 /0.,.06/
      DATA X113C1 /0.,2.,4.,6./
      DATA Y2113C /0.,0.,0.,1.65,0.,3.38,0.,7.65/
      DATA X113E2 /0.,.8/
      DATA X113E1 /0.,45./
      DATA Y2113E /0.,.00795,0.,.00474/
!
!     ----FIGURE 6.2.1.1-30
!
      DATA X114F2 /3.2,2.6,2.2,2.,1.8,1.7,1.6,1.4/
      DATA X114F1 /1./
      DATA Y2114F /2.15,1.9,1.85,2.,2.25,2.5,2.75,4./
      DATA X11302 /0.,1.9/
      DATA X11301 /0.,45./
      DATA Y21130 /0.,.02,0.,.0184/
!
!     FIGURE 6.2.2.1-14
!
      DATA X114A2 /.4,1./
      DATA X114A1 /0.,.5,1./
      DATA Y2114A /8.7,5.5,6.65,3*5.5/
      DATA X114E2 /3.2,2.8,2.4,2.2,2.0,1.8,1.6/
      DATA X114E1 /1./
      DATA Y2114E /.35,.75,1.35,1.75,2.25,2.75,3.5/
!
!*********          FIGURE 4.3.1.2-12-A1          **********************
!
      DATA X12A1 /0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y12A1 /1.0,0.97,0.95,4*0.94,0.95,0.96,0.98,0.99/
      DATA I12A1 /0/
      DATA Q212A1 /4H4.3.,4H1.2-,4H12-A,4H1   /
!
!*********          FIGURE 4.3.1.2-12-A2          **********************
!
      DATA X12A2 /0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y12A2 /0.0,0.11,0.21,0.31,0.41,0.51,0.60,0.70,0.80,0.90,1.0/
      DATA I12A2 /0/
      DATA Q22113 /4H6.2.,4H2.1-,4H13  /
      DATA Q21130 /4H6.2.,4H1.1-,4H30  /
      DATA Q22114 /4H6.2.,4H2.1-,4H14  /
      DATA Q212A2 /4H4.3.,4H1.2-,4H12-A,4H2   /
      DATA ROUTID /4HSPRY,4HAW  /
!
      STYPE=F(18)
      IF(STYPE.EQ.3.)RETURN
      TRANSL=.FALSE.
      INBORD=.TRUE.
      IF((ALOCO/SSPNE).LT.0.99)INBORD=.FALSE.
      IFTYPE=F(17)+.5
      MACH=FLC(IM+2)
      NDELTA=F(16)+.5
      BETA=SQRT(MACH**2-1.)
      IF(STYPE.EQ.5.)GO TO 1070
      C1=2./BETA
      C2=(2.4*MACH**4-4.*BETA**2)/(2.*BETA**4)
      IF(ALOCI.GE.(SSPN-BSTRO2))TRTOE=TAPRO
      IF(ALOCI.LT.(SSPN-BSTRO2))TRTOE=TAPRI
      LAMHL=ATAN(((ALOCO-ALOCI)*TAN(SAI100/RAD)+CFI-CFO)/(ALOCO-ALOCI))
      TANHL=TAN(LAMHL)
      PHITE=2.*ATAN (F(11)/COS(LAMHL))*RAD
      K3=1.-(C2/C1)*(PHITE/RAD)
      SF=2.*(((CFO+CFI)/2.)*(ALOCO-ALOCI))
      AMGCLN=1.
      SPNSPO=(ALOCO-ALOCI)/SSPNE
      GEOM=((ALOCI+ALOCO)/SSPNE)
      BEF=2.*(ALOCO-ALOCI)
      TLEOB=TANLE/BETA
      THLOB=TANHL/BETA
      TTEOB=TANTE/BETA
!
!   ----RETURN IF L.E. OR T.E. OR H.L. IS SUBSONIC
!
      IF(STYPE.NE.4.)GO TO 1040
      IF(THLOB.GE.1.)RETURN
      IF(TTEOB.GE.1.)RETURN
      TRTOFL=CFO/CFI
      IF(TRTOFL.EQ.1.)GO TO 1000
      AFORLF=TRTOFL
      TAPERD=.TRUE.
      GO TO 1010
 1000 AFORLF=((2.*(ALOCO-ALOCI))**2)/SF*BETA
      TAPERD=.FALSE.
 1010 CONTINUE
      CALL DFLCON(THLOB,TTEOB,AFORLF,BETA,INBORD,TAPERD)
!
!     SUPERSONIC ROLLING EFFECTIVENESS OF TAPERED AND UNTAPERED
!     TRAILING EDGE FLAPS
!
      CLRLF=K3*(SF/SR)*(BCLD1/BETA)*.5*((ALOCI/BLREF)+(BEF/(2.*BLREF))*(&
     &      BCLD1/BCLD2))
!
!     SUPERSONIC ROLLING MOMENT COEFFICIENT OF PLAIN
!     TRAILING EDGE CONTROLS
!
      DO 1020 I=1,NDELTA
         CLRLAL(I)=CLRLF*(DELTAL(I)-DELTAR(I))/2.
 1020 END DO
!
!     ----COMPUTE YAWING MOMENT DUE TO AILERON DEFLECTION AT SUPERSONIC
!     SPEEDS
!
      SCALE=SW*2.*SSPNE/(SR*BLREF)
      CLDG=CLADEG
      CLRL=CLRLF
      IF(CLDG.LT.0.0)CLDG=-CLDG
      IF(CLRL.LT.0.0)CLRL=-CLRL
      DO 1030 M=1,NALPHA
         ALSHD(M)=ALSCHD(M)
         IF(ALSHD(M).LT.0.0)ALSHD(M)=-ALSHD(M)
         CALL TLINEX(X113C1,X113C2,Y2113C,4,2,ALSHD(M),CLDG,DEF,0,0,2,1,&
     &               Q22113,3,ROUTID)
         DO 1030 J=1,NDELTA
            I=(M-1)*10+J
            DO 1030 K=1,2
               DELFLP=DELTAL(J)
               IF(K.EQ.2)DELFLP=DELTAR(J)
               IF(DELFLP.LT.0.0)DELFLP=-DELFLP
               CALL TLINEX(X113A1,X113A2,Y2113A,4,2,DELFLP,CLRL,        &
     &                     CLDELB(1),0,0,2,1,Q22113,3,ROUTID)
               CALL TLINEX(X113B1,X113B2,Y2113B,4,2,DELFLP,CLRL,ABC,0,  &
     &                     1,2,1,Q22113,3,ROUTID)
               CLDELB(2)=(10.-ABC+CLDELB(1)*500.)/500.
               SUBAX1=DEF+CLDELB(2)*(2.5+DEF*1.5)/(-.005)
               SUBAX2=GEOM*SUBAX1*.1*.5
               CALL TLINEX(X113E1,X113E2,Y2113E,2,2,SAI050,SUBAX2,      &
     &                     TEMPO(K),0,0,2,1,Q22113,3,ROUTID)
               IF(K.EQ.2)CNYWAL(I)=(TEMPO(2)-TEMPO(1))*SCALE
 1030 CONTINUE
      RETURN
 1040 IF(STYPE.EQ.5.)GO TO 1070
!
!     SPOILER ROLLING MOMENTS AT SUPERSONIC SPEEDS
!
      DO 1050 J=1,NDELTA
         DELSOC=DELTAS(J)
         CALL TLINEX(X114A1,X114A2,Y2114A,3,2,TRTOE,GEOM,VERT,0,1,0,1,  &
     &               Q21130,3,ROUTID)
         VERT2=DELSOC*SPNSPO
         NUGEOM=GEOM*VERT2*10.
         TRNSGF=VERT*NUGEOM*.5
         CALL TLINEX(X114F1,X114F2,Y2114F,1,8,AMGCLN,MACH,ARBIT,0,1,0,  &
     &               2,Q21130,3,ROUTID)
         FINALY=TRNSGF*(.2+ARBIT*.2)
         CALL TLINEX(X11301,X11302,Y21130,2,2,SAE025,FINALY,TAKTIM(J),  &
     &               0,0,1,1,Q21130,3,ROUTID)
         CLRLSP(J)=TAKTIM(J)*SW*2.*SSPNE/(BLREF*SR)
 1050 END DO
!
!     COMPUTE YAWING MOMENT DUE TO SPOILER DEFLECTION AT SUPERSONIC
!     SPEEDS
!
      CALL TLINEX(X114A1,X114A2,Y2114A,3,2,TRTOE,GEOM,VERT,0,1,0,1,     &
     &   Q22114,3,ROUTID)
      CALL TLINEX(X114E1,X114E2,Y2114E,1,7,AMGCLN,MACH,ARBIT,0,1,0,1,   &
     &   Q22114,3,ROUTID)
      DO 1060 J=1,NDELTA
         DELSOC=DELTAS(J)
         VERT2=(DELSOC*SPNSPO)/1.2
         NUGEOM=VERT2*(GEOM+.1)*12.-.1
         TRNSGF=VERT*(.05+.5*NUGEOM)
         FINALY=.2*TRNSGF*(1.+ARBIT)
         PASTIM(J)=FINALY*.005
         CNYWSP(J)=PASTIM(J)*2.*SSPNE*SW/(BLREF*SR)
 1060 END DO
      RETURN
 1070 CONTINUE
!
!     SUPERSONIC ROLLING MOMENT FOR ALL MOVEABLE, DIFFERENTIALLY
!     DEFLECTED HORIZONTAL STABILIZER
!
      RADS=SSPNH-SSPNEH
      RATIO=(SSPNH-SSPNEH)/SSPNH
      YHS=.4*SSPNEH+RADS
 1080 CALL TBFUNX(RATIO,KHB  ,DYDX,11,X12A1,Y12A1,C12A1,I12A1,MI,NG,    &
     &            0,0,Q212A1,4,ROUTID)
 1090 CALL TBFUNX(RATIO,KBH  ,DYDX,11,X12A2,Y12A2,C12A2,I12A2,MI,NG,    &
     &            0,0,Q212A2,4,ROUTID)
      DO 1100 J=1,NALPHA
         DO 1100 K=1,NDELTA
            I=10*(J-1)+K
            CLRLS(I)=.006108 *(IVBH(J)*GAMMA(J)*(RADS/SSPNEH)+(KBH+KHB) &
     &               )*CNAHS*YHS*SH/(BLREF*SR)
            CLRLHT(I)=CLRLS(I)*(DELTAL(K)-DELTAR(K))
 1100 CONTINUE
      RETURN
      END
      SUBROUTINE SSHING
!
!    ---THIS SUBROUTINE CALCULATES THE SUPERSONIC HINGE MOMENT
!       DERIVATIVE FOR FLAT SIDED AND SYMMETRIC BI-CONVEX CONTROLS
!       AND THE AREA MOMENT ABOUT THE HINGE LINE.
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /FLAPIN/ F(69)
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ AHT(195)
      COMMON /WINGI/  WINGIN(77)
      COMMON /HTI/    HTIN(131)
      COMMON /IWING/  PWING, WING(400)
      COMMON /POWR/   SPR(59)
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
      COMMON /IHT/    PHT, HT(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &       HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,TRANSN,     &
     &       HYPERS,SYMFP,ASYFP,TRIMC,TRIM
      REAL LAMHL,LAMHLD
      REAL K,K3
      REAL MU,MACH
      LOGICAL INBORD
      LOGICAL TAPERD
      LOGICAL TRANSL
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,TRANSN,    &
     &        HYPERS,SYMFP,ASYFP,TRIMC,TRIM
      DIMENSION ITRANS(5)
      DIMENSION CPO(10)
      DIMENSION CPI(10),SWF(4),CFACTR(4)
      DIMENSION ETA(5),CF(10),CHRD(5), CFACT(10),CLALDS(10)
      DIMENSION CP(10),CPOCF(4)
      EQUIVALENCE (CPI,F(39)),(CPO,F(49))
      EQUIVALENCE (ALOCI,BIF,F(14)),(ALOCO,BOF,F(15)),(BO2,SSPN)
      EQUIVALENCE (LAMHLD, SPR(4)),(PHITE,SPR(5))
      EQUIVALENCE (TRTOFL,SPR(35))
      EQUIVALENCE (CFI,F(12)),(CFO,F(13))
      EQUIVALENCE (CO,SPR(36))
      EQUIVALENCE (K3,SPR(6)),(C1,SPR(2)),(C2,SPR(3))
      EQUIVALENCE (BETA,SPR(1))
      EQUIVALENCE (TANHL,SPR(14))
      EQUIVALENCE (TLEOB,SPR(32)),(THLOB,SPR(33)),(TTEOB,SPR(34))
      EQUIVALENCE (BCHD,SPR(18))
      EQUIVALENCE (BCLD2,SPR(13))
      EQUIVALENCE (SF,SPR(7))
      EQUIVALENCE (FTYPE,F(17))
      EQUIVALENCE (CLALDS(1),WING(241))
      EQUIVALENCE (CHAT,SPR(53)),(CHAF,SPR(54)),(AMA,SPR(55))
      EQUIVALENCE (CHABC,WING(251)),(CHDELF,SPR(56)),(CHDELR,WING(261))
      DATA ITRANS /2,3,4,7,8/
!
      IF(HTPL)GO TO 1000
      SSPNE=WINGIN(3)
      SAI000=A(59)
      SAI100=A(77)
      CHRDRE=A(10)
      CHRDTP=WINGIN(1)
      TANLE=A(62)
      TANTE=A(80)
      BO2=WINGIN(4)
      CT=WINGIN(1)
      CR=WINGIN(6)
      TAPRI=A(25)
      BSTRO2=WINGIN(2)
      TANTEO=A(104)
      TANLEO=A(86)
      CB=WINGIN(5)
      TAPRO=A(28)
      SR=SREF
      TOVC=WINGIN(18)
      TOVCO=WINGIN(66)
      CLAW=WING(101)
      GO TO 1010
 1000 SSPNE=HTIN(3)
      SAI000=AHT(59)
      SAI100=A(77)
      CHRDRE=AHT(10)
      CHRDTP=HTIN(1)
      TANLE=AHT(62)
      BO2=HTIN(4)
      CR=HTIN(6)
      TAPRI=AHT(25)
      BSTRO2=HTIN(2)
      TANTEO=AHT(104)
      TANLEO=AHT(86)
      CB=HTIN(5)
      TAPRO=AHT(28)
      SR=SREF
      TOVC=HTIN(18)
      TOVCO=HTIN(66)
      CLAW=HT(101)
      TANTE=AHT(80)
 1010 CONTINUE
      MACH=FLC(IM+2)
      BETA=SQRT(MACH**2-1.)
      NDELTA=F(16)+.5
      TRANSL=.FALSE.
      IFTYPE=FTYPE+.5
      IF(IFTYPE.NE.1)GO TO 1020
      LAMHL=ATAN(((ALOCO-ALOCI)*TAN(SAI100)+CFI-CFO)/(ALOCO-ALOCI))
      LAMHLD=LAMHL*RAD
      PHITE=2*ATAN(F(11)/COS(LAMHL))*RAD
      TANHL=TAN(LAMHL)
      TLEOB=TANLE/BETA
      THLOB=TANHL/BETA
      TTEOB=TANTE/BETA
!
!   ----RETURN IF L.E. OR T.E. OR H.L. IS SUBSONIC
!
      IF(TLEOB.GE.1.)RETURN
      IF(THLOB.GE.1.)RETURN
      IF(TTEOB.GE.1.)RETURN
      TRTOFL=CFO/CFI
      CO=CR+ALOCO*(TANTE-TANLE)
      CI=CR+ALOCI*(TANTE-TANLE)
      SPR(31)=CI
      IF(BIF.GT.(BO2-BSTRO2)) SPR(31)=CT+(BO2-BIF)*(TANLEO-TANTEO)
      MU=ARCSIN(1./MACH)
      TEMP=MU*RAD
      C1=2./BETA
      C2=(2.4*MACH**4-4.*BETA**2)/(2.*BETA**4)
      K3 =1.-(C2/C1)*(PHITE/RAD)
      K =TAN(SAI000-LAMHL)*TAN(SAI000-SAI100)
      XT=CO-CFO+(SSPNE-ALOCO)*(TANHL-TANLE)
      XR=CI+ALOCI*(TANLE-TANHL)-CFI
 1020 DO 1030 I=1,5
         IF(IFTYPE.EQ.ITRANS(I))TRANSL=.TRUE.
 1030 END DO
      IF(.NOT.TRANSL)GO TO 1090
!
!*****GEOMETRIC PARAMETERS PER FLAP SEGMENT
!
      DELN4=0.25*(BOF-BIF)/BO2
      ETA(1)=BIF/BO2
      CF(1)=CFI
      ARG1=(CFI-CFO)/(4.*DELN4 )
      ARG2=(TANTE-TANLE)*BO2
      ARG3=BO2*CR
      ARG4=CR
      ARG5=TAPRI
      TC=TOVC
      IF(BIF.LT.(BO2-BSTRO2))GO TO 1040
      ARG2=(TANTEO-TANLEO)*BO2
      ARG3=BO2*CR
      ARG4=CB
      ARG5=TAPRO
      TC=TOVCO
 1040 CONTINUE
      CHRD(1)=ARG4+ETA(1)*ARG2
      SPR(31)=CHRD(1)
      CI=CHRD(1)
      DO 1050 M=2,5
         N=M-1
         ETA(M)=ETA(N)+DELN4
         CHRD(M)=ARG4+ETA(M)*ARG2
         SWF(N)=ARG3*(2.-(1.-ARG5)*(ETA(N)+ETA(M)))
 1050 END DO
      DO 1080 I=1,NDELTA
         CP(1)=CPI(I)
         DO 1070 M=1,5
            IF(M.EQ.1)GO TO 1060
            ARG1=(CPI(I)-CPO(I))/(4.*DELN4)
            CP(M)=CPI(I)-ARG1*(ETA(M)-ETA(1))
 1060       CONTINUE
            N=M-1
            IF(N.EQ.0)GO TO 1070
            CPOCF(N)=(CP(M)/CHRD(M)+CP(N)/CHRD(N))/2.
            CFACTR(N)=(CPOCF(N)-1.)*SWF(N)/SR
 1070    CONTINUE
      CFACT(I)=(CFACTR(1)+CFACTR(2)+CFACTR(3)+CFACTR(4))/4.
 1080 END DO
      GO TO 1310
 1090 CONTINUE
      D=CHRDRE-((ALOCI+ALOCO)/2.)*(TANLE-TANTE)
      C=(CFI+CFO)/2.
      B=D-C
      IF(ALOCI.LT.(SSPN-BSTRO2))TOVCA=TOVC
      IF(ALOCI.GT.(SSPN-BSTRO2))TOVCA=TOVCO
      G=SIN(0.5*PI-SAI000)*B/SIN(0.5*PI+SAI000-LAMHL)
      E=SIN(0.5*PI-SAI100)*C/SIN(0.5*PI+SAI100-LAMHL)
      CHRDPR=G+E
      TOVCP=TOVCA*D/CHRDPR
      XHOC=G/CHRDPR
      INBORD=.TRUE.
      IF((ALOCO/SSPN) .GE. .99)INBORD=.FALSE.
      SF=2.*((CFI+CFO)/2.)*(ALOCO-ALOCI)
      IF(TRTOFL.EQ.1.)GO TO 1100
      AFORLF=TRTOFL
      TAPERD=.TRUE.
      GO TO 1110
 1100 AFORLF=((2.*(ALOCO-ALOCI))**2)/SF*BETA
      TAPERD=.FALSE.
 1110 CONTINUE
!
      CALL DFLCON(THLOB,TTEOB,AFORLF,BETA,INBORD,TAPERD)
!
      PIO2=PI/2.
      I=0
      DO 1300 II=1,2
         I=I+1
         Y=I
         IF(I.EQ.2)GO TO 1120
!
!    *** TIP CHARACTERISTICS ***
!
         V1=ALOCI
         V2=CI
         V3=CFI
         V4=ALOCO
         V5=CO
         V6=CFO
         V7=SSPNE
         GO TO 1130
!
!    *** ROOT CHARACTERISTICS ***
!
 1120    V1=ALOCO
         V2=CO
         V3=CFO
         V4=ALOCI
         V5=CI
         V6=CFI
         V7=0.
!
!     FINDING ALPHA1 THRU ALPHA4
!
 1130    XYZ=V7-V1
         IF(I.EQ.2) XYZ=-XYZ
         ZYX=V7-V4
         IF(I.EQ.2) ZYX=-ZYX
         ARG1=V1*TANLE+V2-V3-V7*TANLE
         IF(ARG1.EQ.0.) GO TO 1140
         ALPHA1=ATAN(XYZ/ARG1)
         IF(ALPHA1.LT.0.) ALPHA1=PI+ALPHA1
         GO TO 1150
 1140    ALPHA1=PIO2
 1150    ARG1=V1*TANLE+V2-V7*TANLE
         IF(ARG1.EQ.0.) GO TO 1160
         ALPHA2=ATAN(XYZ/ARG1)
         IF(ALPHA2.LT.0.) ALPHA2=PI+ALPHA2
         GO TO 1170
 1160    ALPHA2=PIO2
 1170    ARG1=V4*TANLE+V5-V6-V7*TANLE
         IF(ARG1.EQ.0.) GO TO 1180
         ALPHA3=ATAN(ZYX/ARG1)
         IF(ALPHA3.LT.0.) ALPHA3=PI+ALPHA3
         GO TO 1190
 1180    ALPHA3=PIO2
 1190    ARG1=V4*TANLE+V5-V7*TANLE
         IF(ARG1.EQ.0.) GO TO 1200
         ALPHA4=ATAN(ZYX/ARG1)
         IF(ALPHA4.LT.0.) ALPHA4=PI+ALPHA4
         GO TO 1210
 1200    ALPHA4=PIO2
 1210    IF(MU.GT.ALPHA1)KASENO=1
         IF(MU.LE.ALPHA1.AND.MU.GT.ALPHA2.AND.MU.GT.ALPHA3)KASENO=2
         IF(MU.LE.ALPHA2.AND.MU.GT.ALPHA3)KASENO=3
         IF(MU.LE.ALPHA3.AND.MU.GT.ALPHA2)KASENO=4
         IF(MU.LE.ALPHA2.AND.MU.LT.ALPHA3.AND.MU.GT.ALPHA4)KASENO=5
         IF(MU.LE.ALPHA4)KASENO=6
         IF(I.EQ.1)GO TO 1220
         IF(TANLE.EQ.0.0)SPAMT=0.
         IF(TANLE.EQ.0.0)GO TO 1280
!
!    *** ROOT CHARACTERISTICS ***
!
         X1=CHRDRE
         X4=XR
         X5=ALOCO
         X6=ALOCI
         X7=1.-TTEOB
         X8=1.-THLOB
         X9=-TTEOB
         X10=-THLOB
         GO TO 1230
!
!    *** TIP CHARACTERISTICS ***
!
 1220    X1=CHRDTP
         X4=XT
         X5=SSPNE-ALOCI
         X6=SSPNE-ALOCO
         X7=1.+TTEOB
         X8=1.+THLOB
         X9=TTEOB
         X10=THLOB
 1230    SPAMT=0.
         PAM1=0.
         PAM2=0.
         PAM3=0.
         PAM4=0.
         PAM5=0.
         PAM6=0.
         PAM7=0.
         PAM8=0.
         IF(KASENO.EQ.6)GO TO 1280
!
!    ***** AREA 3 *****
!
         R3=1.-(BETA*X6*X7)/X1
         CALL PTCP(R3,Y,3,P3,TCP3)
         PAM3=R3*P3*X1**2*(1./(BETA*X7))*(2.*X1*(1.+X10*TCP3)/(1.+X9*   &
     &        TCP3)-3.*X4)
!
!    ***** AREA 7 *****
!
         R7=X1/(BETA*X6)-X7
         CALL PTCP(R7,Y,7,P7,TCP7)
         PAM7=R7*P7*BETA*X6**2*(3.*X4-2.*BETA*X6*(1.+X10*TCP7)/TCP7)
         SPAMT=PAM3+PAM7
         IF(KASENO.EQ.5)GO TO 1280
         IF(KASENO.LT.4)GO TO 1240
!
!    ***** AREA 1 *****
!
         R1=X1/(BETA*X5)-X7
         CALL PTCP(R1,Y,1,P1,TCP1)
         PAM1=R1*P1*BETA*X5**2*(2.*BETA*X5*(1.+X10*TCP1)/TCP1-3.*X4)
!
!    ***** AREA 4 *****
!
         R4=1.-BETA*X5*X7/X1
         CALL PTCP(R4,Y,4,P4,TCP4)
         PAM4=R4*P4*X1**2*(1./(BETA*X7))*(3.*X4-2.*X1*(1.+X10*TCP4)/    &
     &        (1.+X9*TCP4))
         SPAMT=SPAMT+PAM1+PAM4
         GO TO 1280
 1240 CONTINUE
!
!    ***** AREA 5 *****
!
         R5=1.-BETA*X6*X8/X4
         CALL PTCP(R5,Y,5,P5,TCP5)
         PAM5=R5*P5*X4**3*(1./(BETA*X8))
!
!    ***** AREA 8 *****
!
         R8=X4/(BETA*X6)-X8
         CALL PTCP(R8,Y,8,P8,TCP8)
         PAM8=R8*P8*BETA*X6**2*(2.*BETA*X6*(1.+X10*TCP8)/TCP8-3.*X4)
         SPAMT=SPAMT+PAM5+PAM8
         IF(KASENO.LT.3)GO TO 1250
         GO TO 1260
!
!    ***** AREA 1 *****
!
 1250    R1=X1/(BETA*X5)-X7
         CALL PTCP(R1,Y,1,P1,TCP1)
         PAM1=R1*P1*BETA*X5**2*(2.*BETA*X5*(1.+X10*TCP1)/TCP1-3.*X4)
!
!    ***** AREA 4 *****
!
         R4=1.-BETA*X5*X7/X1
         CALL PTCP(R4,Y,4,P4,TCP4)
         PAM4=R4*P4*X1**2*(1./(BETA*X7))*(3.*X4-2.*X1*(1.+X10*TCP4)/    &
     &        (1.+X9*TCP4))
         SPAMT=SPAMT+PAM1+PAM4
 1260    IF(KASENO.LT.2)GO TO 1270
         GO TO 1280
!
!    ***** AREA 2 *****
!
 1270    R2=X4/(BETA*X5)-X8
         CALL PTCP(R2,Y,2,P2,TCP2)
         PAM2=R2*P2*BETA*X5**2*(3.*X4-2.*BETA*X5*(1.+X10*TCP2)/TCP2)
!
!    ***** AREA 6 *****
!
         R6=1.-BETA*X5*X8/X4
         CALL PTCP(R6,Y,6,P6,TCP6)
         PAM6=-R6*P6*X4**3*(1./(BETA*X8))
         SPAMT=SPAMT+PAM2+PAM6
 1280    CONTINUE
         IF(I.EQ.2)GO TO 1290
         SPAMI=SPAMT
         SPR(37)=PAM1
         SPR(38)=PAM2
         SPR(39)=PAM3
         SPR(40)=PAM4
         SPR(41)=PAM5
         SPR(42)=PAM6
         SPR(43)=PAM7
         SPR(44)=PAM8
         GO TO 1300
 1290    SPAMR=SPAMT
         SPR(45)=PAM1
         SPR(46)=PAM2
         SPR(47)=PAM3
         SPR(48)=PAM4
         SPR(49)=PAM5
         SPR(50)=PAM6
         SPR(51)=PAM7
         SPR(52)=PAM8
 1300 END DO
!
!    **** SUPERSONIC HINGE MOMENT DERIVATIVE FOR FLAT SIDED CONTROLS ***
!
      CHAT=(-2./(RAD*BETA*SQRT(1.-TLEOB**2)))*(1.-(SPAMT+SPAMR)/        &
     &     ((ALOCO-ALOCI)*(CFI**2+CFI*CFO+CFO**2)))
      CHAF=K3*CHAT
!
!    **** AREA MOMENT ABOUT HINGE LINE ****
!
      AMA=(CFI*(ALOCO-ALOCI)/6.)*COS(LAMHL)*((CFO/CFI)**2+CFO/CFI+1.)
!
!    **** SUPERSONIC HINGE MOMENT DERIVATIVE FOR ****
!         SYMMETRIC BI-CONVEX AIRFOILS
!
      CHABC=CHAT*(1.-(.666667*C2*TOVCP/(C1*(1+K)*COS(SAI000-LAMHL)))*(2.&
     &      *(1.+2.*XHOC)-K*(1.-XHOC)**2))
!
!   ** SUPERSONIC HINGE MOMENT DERIVATIVE FOR FLAT CONTROLS WRT DELTA **
!
      CHDELF=K3*BCHD
!
!    **** SUPERSONIC HINGE MOMENT DERIVATIVE FOR SYMMETRIC ****
!         BI-CONVEX AIRFOIL CONTROLS
!
      CHDELR=(1.-1.33333*(C2/C1)*TOVCP*(1.+2.*XHOC))*BCHD
      IF(.NOT.TRANSL)GO TO 1330
 1310 DO 1320 I=1,NDELTA
         CLALDS(I)=CLAW*(1.+CFACT(I))+CLAW
 1320 END DO
 1330 CONTINUE
      CALL SSSYM
      RETURN
      END
      SUBROUTINE SSSYM
!
!     ----THIS SUBROUTINE CALCULATES THE SUPERSONIC PITCHING
!         AND LIFT INCREMENTS.
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /SYNTSS/ SYNA(19)
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ AHT(195)
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
      COMMON /IWING/  PWING, WING(400)
      COMMON /FLAPIN/ F(69)
      COMMON /POWR/   SPR(59)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      REAL K1,K2,K3,MACH
      DIMENSION DELSYM(10)
      DIMENSION DELCM(10),DELCLL(10)
      EQUIVALENCE (BCMD1,SPR(17))
      EQUIVALENCE (CFI,F(12)),(ALOCI,F(14)),(ALOCO,F(15))
      EQUIVALENCE (BETA,SPR(1)),(K3,SPR(6)),(SR,SREF)
      EQUIVALENCE (DELSYM(1),F(1))
      EQUIVALENCE (K1,SPR(15)),(K2,SPR(16))
      EQUIVALENCE (SF,SPR(7)),(TANHL,SPR(14))
      EQUIVALENCE (BCLD1,SPR(12)),(BCLD2,SPR(13))
      EQUIVALENCE (CMD1,SPR(57)),(CMD2,SPR(58)),(CMD3,SPR(59))
      EQUIVALENCE (CMDT,SPR(19)),(DELCM(1),WING(211)),(CLD,SPR(20))
      EQUIVALENCE (DELCLL(1),WING(201))
      EQUIVALENCE (TRTOFL,SPR(35))
!
      MACH=FLC(IM+2)
      NDELTA=F(16)+.5
      FTYPE=F(17)
      XCG=SYNA(1)
      CI=SPR(31)
      IF(HTPL)GO TO 1000
      XW=SYNA(2)
      CR=A(122)
      TANLE=A(62)
      GO TO 1010
 1000 CR=AHT(10)
      TANLE=AHT(62)
      XW=SYNA(6)
 1010 CONTINUE
      IF(FTYPE.NE.1.)GO TO 1040
      K1=K3*(1.+TRTOFL+TRTOFL**2)
      K2=K3*TANHL
!
!     SUPERSONIC PITCHING MOMENT EFFECTIVENESS NO. 1 FOR TRAILING EDGE
!     FLAPS.
!
      BEF=2.*(ALOCO-ALOCI)
      SAVE=CR*SR
      CMD1=K1*.33333*BEF*CFI*BCMD1/SAVE
!
!     SUPERSONIC PITCHING MOMENT EFFECTIVENESS NO. 2
!     FOR TRAILING EDGE FLAPS
!
      CMD2=-K2/2.*BEF*SF *BCLD2/SAVE
!
!     SUPERSONIC PITCHING MOMENT EFFECTIVENESS NO.3
!     FOR TRAILING EDGE FLAPS
!
      DELXF=XW+ALOCI*TANLE+CI-CFI-XCG
      CMD3=-K3*DELXF*SF*BCLD1/SAVE
!
!     TOTAL SUPERSONIC PITCHING MOMENT EFFECTIVENESS FOR TRAILING
!     EDGE FLAPS
!
      CMDT=CMD1+CMD2+CMD3
!
!     SS PITCHING MOMENT INCREMENT
!
      DO 1020 I=1,NDELTA
         DELCM(I)=CMDT*DELSYM(I)
 1020 END DO
!
!     LIFT COEFFICIENT EFFECTIVENESS,T.E. FLAP
!
      CLD=K3*BCLD1*SF/SR
!
!     LIFT COEFFICIENT INCREMENT WRT T.E. FLAPS
!
      DO 1030 I=1,NDELTA
         DELCLL(I)=CLD*DELSYM(I)
 1030 END DO
 1040 CONTINUE
      RETURN
      END
      SUBROUTINE STORXM
!
!***  STORE EXTRAPOLATION MESSAGE DATA
!
      INTEGER ROUT
      COMMON /IBODY/   PB, AFIG01(121), AFIG02(121), dum1(158)
      COMMON /IWING/   PW, AFIG03(121), AFIG04(121), dum13(158)
      COMMON /IHT/    PHT, AFIG05(121), AFIG06(121), dum3(138)
      COMMON /IVT/    PVT, AFIG07(121), AFIG08(121), dum4(138)
      COMMON /IVF/    PVF, AFIG09(121), AFIG10(121), dum17(138)
      COMMON /IBW/    PBW, AFIG11(121), AFIG12(121), dum5(138)
      COMMON /IBH/    PBH, AFIG13(121), AFIG14(121), dum6(138)
      COMMON /IBV/    PBV, JFIG01(121), JFIG02(121), dum7(138)
      COMMON /IBWH/  PBWH, JFIG03(121), JFIG04(121), dum8(138)
      COMMON /IBWV/  PBWV, JFIG05(121), JFIG06(121), dum9(138)
      COMMON /IBWHV/PBWHV, JFIG07(121), JFIG08(121), dum12(138)
      COMMON /WINGD/       JFIG09(121)
      COMMON /SBETA/       JFIG10(121), JFIG11(121), JFIG12(121)
      COMMON /BDATA/       JFIG13(121), JFIG14(121), JFIG15(121),       &
     &                     JFIG16(121), JFIG17(121)
      COMMON /WHWB/        JFIG18(121)
      COMMON /WBHCAL/      JFIG19(121)
      COMMON /HTDATA/      JFIG20(121)
      COMMON /VTDATA/ LFIGN(121),LFIGO(121),IOVLY,IOVL,NSTQ,NSTP,FINALR,&
     &                 NFIG,IFIGN
      COMMON /WHAERO/ LFIGS(121), IFIGST(20), IEXCD(4), MSSCL(2),       &
     &                ROUT(2), XLL(4), XUL(4), IEXTRL(4,2),             &
     &                IEXTRU(4,2), XVAL(4)
      LFIGN(NFIG)=IFIGN
      AFIG01(NFIG)=NSTP
      AFIG02(NFIG)=XVAL(1)
      AFIG03(NFIG)=XVAL(2)
      AFIG04(NFIG)=XVAL(3)
      AFIG05(NFIG)=XVAL(4)
      AFIG06(NFIG)=XLL(1)
      AFIG07(NFIG)=XLL(2)
      AFIG08(NFIG)=XLL(3)
      AFIG09(NFIG)=XLL(4)
      AFIG10(NFIG)=XUL(1)
      AFIG11(NFIG)=XUL(2)
      AFIG12(NFIG)=XUL(3)
      AFIG13(NFIG)=XUL(4)
      AFIG14(NFIG)=FINALR
      JFIG01(NFIG)=MSSCL(1)
      JFIG02(NFIG)=MSSCL(2)
      JFIG03(NFIG)=ROUT(1)
      JFIG04(NFIG)=ROUT(2)
      JFIG05(NFIG)=IEXTRL(1,1)
      JFIG06(NFIG)=IEXTRL(2,1)
      JFIG07(NFIG)=IEXTRL(3,1)
      JFIG08(NFIG)=IEXTRL(4,1)
      JFIG09(NFIG)=IEXTRL(1,2)
      JFIG10(NFIG)=IEXTRL(2,2)
      JFIG11(NFIG)=IEXTRL(3,2)
      JFIG12(NFIG)=IEXTRL(4,2)
      JFIG13(NFIG)=IEXTRU(1,1)
      JFIG14(NFIG)=IEXTRU(2,1)
      JFIG15(NFIG)=IEXTRU(3,1)
      JFIG16(NFIG)=IEXTRU(4,1)
      JFIG17(NFIG)=IEXTRU(1,2)
      JFIG18(NFIG)=IEXTRU(2,2)
      JFIG19(NFIG)=IEXTRU(3,2)
      JFIG20(NFIG)=IEXTRU(4,2)
      RETURN
      END
      SUBROUTINE SUBHYW
!
!     THIS ROUTINE YIELDS THE SUBSONIC H.T.,H.T.-BODY
!     ROLLING DERIVATIVE CLP
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /HTDATA/ A(195),B(49)
      COMMON /HTI/    WINGIN(77)
      COMMON /IHT/    PWING, WING(380)
      COMMON /BDATA/  BD(300),DYN(213)
      COMMON /WHAERO/ DUM1(106),C(51)
      COMMON /SBETA/  DUM2(351),STB(135)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      INTEGER Y71336,D11336,D21336,D31336,Y71337,D11337,D21337,D31337,  &
     & Y2220A,D1220A,D2220A,Y2220B,Y2220C,Y2220D,D1220D,D2220D,Y12224,  &
     & Y12312,Y1219B,Y1219C
      INTEGER Y7133A
      REAL LAMCO4,MACOE
      REAL MACH,LAMB,KAY(20),K,LAMDA
      DIMENSION ROUTID(2)
      DIMENSION CL(20),ALSCHD(20),Z(6),CLSUB(20),ALSCH2(20),            &
     & DCLPD(20),CLPWBS(20),CLTAN(20),CDCDO(20),CL2PAW(20),CD(20)
      DIMENSION Y(6),D(6),E(6),G(6),H(6),O(6),P(6)
      DIMENSION CLA(20),DCDDA(20),DCADA(20)
      DIMENSION CLPTAN(20),DCLDA(20),CDOO(20)
      DIMENSION CYPWBS(20),I2A219(4),QEXPD(5),                          &
     &          QIMPR1(4),QIMPR2(4),QIMPR3(4),Q71336(3),Q71337(3)
      DIMENSION X11336(4),X21336(15),X31336(3),Y71336( 90),             &
     &          D11336(30),D21336(30),D31336(30)
      DIMENSION X1133A(2),X2133A(2),Y7133A(2)
      DIMENSION X11337(4),X21337(9),X31337(3),Y71337( 54),              &
     &          D11337(18),D21337(18),D31337(18)
      DIMENSION X1220A( 13),X2220A( 17),Y2220A( 111),Q2220A(3)
      DIMENSION D1220A( 97),D2220A(14)
      DIMENSION X1220B( 13),X2220B( 10),Y2220B(  65),Q2220B(3)
      DIMENSION X1220C( 13),X2220C( 10),Y2220C(  65),Q2220C(3)
      DIMENSION X1220D( 13),X2220D( 18),Y2220D( 117),Q2220D(3)
      DIMENSION D1220D( 97),D2220D(20)
      DIMENSION X12224(  8),X22224( 10),Y12224(  40),Q12224(3)
      DIMENSION X12312(  6),X22312(  8),Y12312(  24),Q12312(3)
      DIMENSION X1219A( 10),Y1219A(  10),Q1219A(3)
      DIMENSION X1219B(  8),X2219B(  2),Y1219B(   8),Q1219B(3)
      DIMENSION X1219C(  3),X2219C(  2),Y1219C(   3),Q1219C(3)
      DIMENSION CNPWBS(20)
      DIMENSION CNRWBS(20)
      EQUIVALENCE (DCMDCL,DYN(21)),(MACOE,A(16))
      EQUIVALENCE (CL(1),WING(21))
      EQUIVALENCE (ZW,SYNA(7)),(ZCG,SYNA(5)),(GEG,STB(122)),            &
     &  (ALSCHD(1),FLC(23)),(SSPN,WINGIN(4)),(SSPNE,WINGIN(3)),         &
     &  (LAMCO4,A(64)),(SW,A(4)),(TANCO4,A(68)),                        &
     &  (LAMDA,A(27)),(CD(1),WING(1)),(ASTRW,A(120))
      EQUIVALENCE (ALSD,DYN(44)),(CLACLO,DYN(45)),(CDO,DYN(94)),        &
     &          (CLA(1),DYN(47)),(ZEE,DYN(67)),(CLPCLP,DYN(68)),        &
     &          (CLPCL2,DYN(69)),(BAOK,DYN(70)),(BCLPCL,DYN(71)),       &
     &          (DCLPD(1),DYN(72)),(CLPWBS(1),WING(281)),               &
     &    (DCLDA(1),DYN(96)),(DCDDA(1),DYN(116)),(DCADA(1),DYN(136)),   &
     &    (KAY(1),DYN(156)),(CNPWBS(1),WING(321))
      EQUIVALENCE (CYPWBS(1),WING(301)),                                &
     &            (CDOO(1),DYN(184)),(CNRWBS(1),WING(341))
      EQUIVALENCE (D11336(1),Y71336(1)),(D21336(1),Y71336(31)),         &
     &            (D31336(1),Y71336( 61))
      EQUIVALENCE (D11337(1),Y71337(1)),(D21337(1),Y71337(19)),         &
     &            (D31337(1),Y71337(37))
      EQUIVALENCE (D1220A(1),Y2220A(1)),(D2220A(1),Y2220A( 98))
      EQUIVALENCE (D1220D(1),Y2220D(1)),(D2220D(1),Y2220D( 98))
      DATA ROUTID /4HSUBH,4HYW  /
      DATA I2A219 /10,3*0/
      DATA IN /0/, IX/0/, IO/0/, IP/0/, IQ/0/, IR/0/, IS/0/, IT/0/
      DATA QEXPD  /4HEXPE,4HRIME,4HNTAL,4H DAT,4HA   /
      DATA Q12224 /4H7.1.,4H2.2-,4H24  /
      DATA Q12312 /4H7.1.,4H2.3-,4H12  /
      DATA QIMPR1 /4HCLTA,4HN VS,4H ALS,4HCHD /
      DATA QIMPR2 /4HCDCD,4HO VS,4H ALS,4HCHD /
      DATA QIMPR3 /4HCL2P,4HAW V,4HS AL,4HSCHD/
      DATA Q71336 /4H7.1.,4H3.3-,4H6   /
      DATA Q71337 /4H7.1.,4H3.3-,4H7   /
!
!      ----FIGURE 7.1.2.2-20A
!
      DATA Q2220A /4H7.1.,4H2.2-,4H20A /
      DATA X1220A /  .100E+02,  .900E+01,  .800E+01,  .700E+01,         &
     &  .600E+01,  .500E+01,  .450E+01,  .400E+01,  .350E+01,  .300E+01,&
     &  .250E+01,  .200E+01,  .150E+01/
      DATA X2220A / -.193E+02, -.989E+01, -.437E+01,  .134E-01,         &
     &  .104E+02,  .143E+02,  .203E+02,  .251E+02,  .300E+02,  .355E+02,&
     &  .402E+02,  .445E+02,  .505E+02,  .547E+02,  .598E+02,  .651E+02,&
     &  .702E+02/
!
!      ----FIGURE 7.1.2.2-20B
!
      DATA Q2220B /4H7.1.,4H2.2-,4H20B /
      DATA X1220B /  .100E+02,  .900E+01,  .800E+01,  .700E+01,         &
     &  .600E+01,  .500E+01,  .450E+01,  .400E+01,  .350E+01,  .300E+01,&
     &  .250E+01,  .200E+01,  .150E+01/
      DATA X2220B / -.201E+02, -.105E+02,  .230E+00,  .994E+01,         &
     &  .197E+02,  .300E+02,  .403E+02,  .499E+02,  .604E+02,  .703E+02/
!
!      ----FIGURE 7.1.2.2-20C
!
      DATA Q2220C /4H7.1.,4H2.2-,4H20C /
      DATA X1220C /  .100E+02,  .900E+01,  .800E+01,  .700E+01,         &
     &  .600E+01,  .500E+01,  .450E+01,  .400E+01,  .350E+01,  .300E+01,&
     &  .250E+01,  .200E+01,  .150E+01/
      DATA X2220C / -.193E+02, -.937E+01,  .893E-01,  .105E+02,         &
     &  .208E+02,  .304E+02,  .405E+02,  .505E+02,  .607E+02,  .704E+02/
!
!      ----FIGURE 7.1.2.2-20D
!
      DATA Q2220D /4H7.1.,4H2.2-,4H20D /
      DATA X1220D /  .100E+02,  .900E+01,  .800E+01,  .700E+01,         &
     &  .600E+01,  .500E+01,  .450E+01,  .400E+01,  .350E+01,  .300E+01,&
     &  .250E+01,  .200E+01,  .150E+01/
      DATA X2220D / -.200E+02, -.965E+01, -.458E+01,  .293E-01,         &
     &  .556E+01,  .995E+01,  .148E+02,  .203E+02,  .245E+02,  .301E+02,&
     &  .354E+02,  .400E+02,  .447E+02,  .502E+02,  .553E+02,  .602E+02,&
     &  .646E+02,  .698E+02/
!
!      ----FIGURE 7.1.2.2-24
!
      DATA X12224 /  .700E+02,  .600E+02,  .500E+02,  .400E+02,         &
     &  .300E+02,  .200E+02,  .100E+02,  .000E+00/
      DATA X22224 /  .196E+01,  .252E+01,  .302E+01,  .350E+01,         &
     &  .402E+01,  .505E+01,  .599E+01,  .700E+01,  .804E+01,  .100E+02/
!
!      ----FIGURE 7.1.2.3-12
!
      DATA X12312 /  .100E+01,  .800E+00,  .600E+00,  .400E+00,         &
     &  .200E+00,  .000E+00/
      DATA X22312 /  .202E+01,  .307E+01,  .404E+01,  .502E+01,         &
     &  .603E+01,  .808E+01,  .100E+02,  .120E+02/
!
!      ----FIGURE 7.1.2.1-9A
!
      DATA Q1219A /4H7.1.,4H2.1-,4H9A  /
      DATA X1219A /  .822E+00,  .109E+01,  .144E+01,  .207E+01,         &
     &  .257E+01,  .316E+01,  .398E+01,  .462E+01,  .531E+01,  .600E+01/
      DATA Y1219A /  .452E+01,  .381E+01,  .297E+01,  .215E+01,         &
     &  .147E+01,  .966E+00,  .486E+00,  .279E+00,  .117E+00,  .154E-06/
!
!      ----FIGURE 7.1.2.1-9B
!
      DATA Q1219B /4H7.1.,4H2.1-,4H9B  /
      DATA X1219B /  .700E+02,  .650E+02,  .600E+02,  .450E+02,         &
     &  .300E+02,  .000E+00, -.300E+02, -.450E+02/
      DATA X2219B / 0.0,4.5/
!
!      ----FIGURE 7.1.2.1-9C
!
      DATA Q1219C /4H7.1.,4H2.1-,4H9C  /
      DATA X1219C /  .000E+00,  .500E+00,  .100E+01/
      DATA X2219C /  .453E+01, -.963E+00/
      DATA X11336 /  .600E+02,  .500E+02,  .400E+02,  .000E+00/
      DATA X21336 /  .101E+01,  .126E+01,  .151E+01,  .178E+01,         &
     &  .201E+01,  .244E+01,  .299E+01,  .352E+01,  .400E+01,  .501E+01,&
     &  .599E+01,  .698E+01,  .799E+01,  .902E+01,  .994E+01/
      DATA X31336 /0.0,0.2,0.4/
!
!      ----FIGURE 7.1.3.3-6D
!
      DATA X1133A /0.0,1.0/
      DATA X2133A /0.0,4.0/
      DATA X11337 /  .000E+00,  .400E+02,  .500E+02,  .600E+02/
      DATA X21337 /  .103E+01,  .144E+01,  .197E+01,  .297E+01,         &
     &  .397E+01,  .503E+01,  .606E+01,  .706E+01,  .803E+01/
      DATA X31337 /0.0,0.2,0.4/
!
!****    IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
!        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
!
!        THE FORMAT IS AS FOLLOWS-
!
!        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
!
!        WHERE-
!
!        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
!        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
!        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
!             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
!        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
!        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
!        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
!        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
!
      DATA D11336/  122392378,  122366359,  122352345,  122335325,      &
     &  122320318,  122314315,  122313316,  122317157,  122167177,      &
     &  122181187,  122204212,  122218226,  122234241,  122241242,      &
     &  122240239,  133758974,  122116132,  122142160,  122176185,      &
     &  122200209,  122216221,  122224222,  124225341,  133325655,      &
     &  132872102,  122127147,  122160173,  122189201,  122206206,      &
     &  122207205/
      DATA D21336/  122762654,  122584539,  122499463,  122436427,      &
     &  122418408,  122404404,  122402403,  122403381,  122349331,      &
     &  122322312,  122300299,  122297295,  122290289,  122282283,      &
     &  122279279,  122253253,  122253253,  122253256,  122258261,      &
     &  122265270,  122273273,  122272272,  122268175,  122180185,      &
     &  122191196,  122209218,  122222229,  122245253,  122255260,      &
     &  122261261/
      DATA D31336/  111160130,  122950630,  122572509,  122462437,      &
     &  122416388,  122379371,  122370371,  121373150,  122450447,      &
     &  122369347,  112112630,  122291284,  122281278,  122280281,      &
     &  122280283,  122351293,  122272247,  122242230,  122225225,      &
     &  122224223,  122222228,  122236242,  123259951,  132994111,      &
     &  122125130,  122141159,  122169178,  122196204,  122206206,      &
     &  122206205/
      DATA D11337/-1133563462,-1133383332,-1133310299,-1133293293,      &
     &-1133293569,-1133501468,-1133451456,-1133456456,-1133456451,      &
     &-1133670644,-1133608608,-1133619631,-1133631637,-1133642975,      &
     &-1133953952,-1132979101,-1122102103,-1122103103/
      DATA D21337/-1133743503,-1133440371,-1133331297,-1133291291,      &
     &-1133291759,-1133560480,-1133457451,-1133457457,-1133463469,      &
     &-1133806669,-1133623606,-1133611623,-1133634640,-1132646106,      &
     &-1133985949,-1133971988,-1122101101,-1122102102/
      DATA D31337/-1133978712,-1133518417,-1133364346,-1133340334,      &
     &-1132340102,-1133712538,-1133500472,-1133465465,-1133471471,      &
     &-1123107796,-1133664614,-1133626638,-1133644650,-1132656121,      &
     &-1123104979,-1132995101,-1122101103,-1122104105/
      DATA D1220A/-1133347366,-1133375377,-1133379378,-1133376372,      &
     &-1133361354,-1133338321,-1133298280,-1133248215,-1133177339,      &
     &-1133357361,-1133365369,-1133368363,-1133359353,-1133339325,      &
     &-1133308288,-1133267237,-1133211175,-1133326340,-1133345353,      &
     &-1133355355,-1133353347,-1133339329,-1133316301,-1133281258,      &
     &-1133230206,-1133170310,-1133323329,-1133334338,-1133338336,      &
     &-1133332326,-1133319305,-1133290268,-1133251227,-1133198169,      &
     &-1133289303,-1133307311,-1133318318,-1133316310,-1133305298,      &
     &-1133287276,-1133256241,-1133214192,-1133160267,-1133283286,      &
     &-1133289289,-1133292289,-1133286284,-1133280268,-1133261247,      &
     &-1133230208,-1133184157,-1133254266,-1133273277,-1133281281,      &
     &-1133279277,-1133270267,-1133259250,-1133233222,-1133198179,      &
     &-1133151242,-1133250255,-1133261263,-1133263263,-1133262256,      &
     &-1133253247,-1133241228,-1133214193,-1133175150,-1133227232,      &
     &-1133238242,-1133245246,-1133245243,-1133239233,-1133230224,      &
     &-1133212203,-1133184169,-1133140205,-1133211214,-1133216220,      &
     &-1133222222,-1133222219,-1133218213,-1133209198,-1133192176,      &
     &-1133159139,-1133184190,-1133191193,-1133194194,-1133195195,      &
     &-1133194193,-1133193191,-1133184176,-1133161151,-1133131159,      &
     &-1133162164,-1133164168,-1133169169/
      DATA D2220A/-1133169169,-1133165164,-1133161157,-1133156150,      &
     &-1133137120,-1133133132,-1133133134,-1133133134,-1133133133,      &
     &-1133133134,-1133133132,-1133129124,-1133120114, -330102000/
      DATA Y2220B/-1133464486,-1133500494,-1133484457,-1133419364,      &
     &-1133298218,-1133445465,-1133479473,-1133463441,-1133407354,      &
     &-1133291215,-1133428444,-1133450449,-1133437419,-1133388344,      &
     &-1133287209,-1133407414,-1133422422,-1133415398,-1133372331,      &
     &-1133276202,-1133375386,-1133391392,-1133385377,-1133353320,      &
     &-1133270199,-1133340353,-1133358358,-1133353342,-1133325296,      &
     &-1133255189,-1133325330,-1133334334,-1133331324,-1133310299,      &
     &-1133247190,-1133300304,-1133312307,-1133305301,-1133288270,      &
     &-1133237183,-1133278280,-1133282282,-1133281276,-1133268251,      &
     &-1133221178,-1133245248,-1133251251,-1133250248,-1133241232,      &
     &-1133208167,-1133221221,-1133222221,-1133220217,-1133215206,      &
     &-1133192161,-1133183182,-1133182181,-1133180180,-1133178174,      &
     &-1133162140,-1133138139,-1133141141,-1133141141,-1133142141,      &
     &-1133134124/
      DATA Y2220C/-1133523535,-1133539534,-1133519496,-1133456407,      &
     &-1133337245,-1133503509,-1133513505,-1133499475,-1133441390,      &
     &-1133317234,-1133470483,-1133486483,-1133470454,-1133421375,      &
     &-1133312228,-1133445451,-1133453451,-1133445428,-1133400355,      &
     &-1133298223,-1133410415,-1133420414,-1133409392,-1133370338,      &
     &-1133287213,-1133371376,-1133377375,-1133371358,-1133338314,      &
     &-1133269204,-1133343349,-1133354353,-1133349339,-1133321299,      &
     &-1133260204,-1133320320,-1133322322,-1133319316,-1133300280,      &
     &-1133245199,-1133293297,-1133298297,-1133295286,-1133278264,      &
     &-1133238189,-1133264264,-1133263264,-1133262259,-1133248239,      &
     &-1133220180,-1133226226,-1133225226,-1133224222,-1133219207,      &
     &-1133191165,-1133188188,-1133189187,-1133186186,-1133180172,      &
     &-1133163145,-1133149149,-1133149149,-1133148147,-1133146142,      &
     &-1133134121/
      DATA D1220D/-1133560573,-1133575575,-1133573567,-1133560546,      &
     &-1133539520,-1133502481,-1133461430,-1133398367,-1133335280,      &
     &-1133538545,-1133546546,-1133544542,-1133537525,-1133518501,      &
     &-1133484464,-1133446415,-1133384353,-1133319269,-1133508517,      &
     &-1133519517,-1133515512,-1133507499,-1133487475,-1133462442,      &
     &-1133425396,-1133367339,-1133305266,-1133469477,-1133480480,      &
     &-1133477471,-1133469463,-1133454448,-1133434418,-1133401376,      &
     &-1133350321,-1133290246,-1133431434,-1133435435,-1133433431,      &
     &-1133428423,-1133416409,-1133397383,-1133371350,-1133322299,      &
     &-1133273232,-1133385390,-1133391390,-1133389386,-1133384378,      &
     &-1133375368,-1133360353,-1133340325,-1133304284,-1133260224,      &
     &-1133359361,-1133361362,-1133362360,-1133360356,-1133354347,      &
     &-1133339334,-1133323307,-1133288271,-1133249216,-1133332334,      &
     &-1133334334,-1133333333,-1133331329,-1133325322,-1133317310,      &
     &-1133302290,-1133276257,-1133237208,-1133265266,-1133266266,      &
     &-1133266265,-1133265264,-1133262261,-1133258255,-1133250246,      &
     &-1133234222,-1133209183,-1133298300,-1133302302,-1133302301,      &
     &-1133300298,-1133298293,-1133289284,-1133280267,-1133255243,      &
     &-1133225197,-1133230230,-1133230230,-1133230231,-1133230230,      &
     &-1133229228,-1133224223,-1133219216/
      DATA D2220D/-1133208198,-1133188170,-1133189190,-1133190190,      &
     &-1133190189,-1133188187,-1133187184,-1133183181,-1133179175,      &
     &-1133171163,-1133156143,-1133148146,-1133146145,-1133145145,      &
     &-1133146146,-1133145145,-1133144142,-1133142141,-1133141139,      &
     &-1133135122/
      DATA Y12224/-1133407331,-1133278240,-1133216175,-1133146127,      &
     &-1134112891,-1133171137,-1133116103,-1144901734,-1144620532,      &
     &-1144456365,-1144918736,-1144606535,-1144467381,-1144344280,      &
     &-1144239183,-1144567428,-1144382349,-1144297232,-1144183177,      &
     &-1144160125,-1144400303,-1144267223,-1144193165,-1144149120,      &
     &-1144114103,-1144302225,-1144199187,-1144159131,-1145103856,      &
     &-1155683804,-1144230201,-1144165141,-1145136843,-1155686624,      &
     &-1155338463,-1144221179,-1144153141,-1145113850,-1155687398,      &
     &-1155341456/
      DATA Y12312/-1166968781,-1166626494,-1166388197, -176319113,      &
     &-1166941724,-1166541382, -168238339,  166218422,-1166885655,      &
     &-1166450256, -176949195,  166454705,-1166777520,-1166300113,      &
     &  176533337,  166590825,-1166548303, -177979781,  166231499,      &
     &  166724919, -176387127,  166264371,  166473661,  166827994/
      DATA Y1219B/ 122468642 , 122368554 , 122300494 , 122176413,       &
     & 122111372 , 132160292 , -132680236 ,-122168172/
      DATA Y1219C/ 1123153677, 1123161573 , 1123182380 /
      DATA Y7133A/-133110100,-134127830/
!
      BETA=B(2)
      IF( HTPL.AND.(.NOT.BO))GO TO 1000
      DB=(SSPN-SSPNE)/SSPN
      IF(DB.GT.0.3)RETURN
 1000 K=BETA*WINGIN(IM+20)*RAD/(2.*PI)
      MACH=FLC(IM+2)
      XYZ=0.
!
!     H.T.-BODY ROLLING DERIVATIVE,CLP---
!
      CALL TBFUNX(XYZ,ALSD,DYDX,NALPHA,CL,ALSCHD,Y,IN,MI,NG,1,1,QEXPD,5,&
     &            ROUTID)
      CALL TBFUNX(XYZ,CDO,DYDX,NALPHA,CL,CD,D,IO,MI,NG,2,2,             &
     &            QEXPD,5,ROUTID)
      IF(CL(1).LE.0..AND.CL(NALPHA).GE.0.) GO TO 1005
      NNALPH=NALPHA+1
      IF(CL(1).LT.0.) GO TO 1002
      CLSUB(1)=0.
      ALSCH2(1)=ALSD
      DO 1001 J=1,NALPHA
         CLSUB(J+1)=CL(J)
 1001 ALSCH2(J+1)=ALSCHD(J)
      GO TO 1004
 1002 CLSUB(NNALPH)=0.
      ALSCH2(NNALPH)=ALSD
      DO 1003 J=1,NALPHA
         CLSUB(J)=CL(J)
 1003 ALSCH2(J)=ALSCHD(J)
 1004 CALL TBFUNX(ALSD,ABCD,CLACLO,NNALPH,ALSCH2,CLSUB,E,IX,MI,         &
     &            NG,1,1,QEXPD,5,ROUTID)
      GO TO 1006
 1005 CALL TBFUNX(ALSD,ABCD,CLACLO,NALPHA,ALSCHD,CL,Z,IX,MI,            &
     &            NG,1,1,QEXPD,5,ROUTID)
 1006 CONTINUE
      XBOCB=-DCMDCL*CBARR/MACOE
      DO 1010 I=1,NALPHA
         CALL TBFUNX(ALSCHD(I),CDEF,CLA(I),NALPHA,ALSCHD,CL,G,IQ,MI,NG, &
     &               0,0,QEXPD,5,ROUTID)
 1010 END DO
      ZEE=ZW-ZCG
      SINGEG=SIN(GEG/RAD)
      CLPCLP=1.-2.*ZEE*SINGEG/SSPN+3.*(ZEE/SSPN)**2*SINGEG**2
      LAMB=RAD*ATAN(TANCO4/BETA)
!
!           -- FIGURE 7.1.2.2-24 --
!
      CALL TLIP2X(X12224,X22224,Y12224,8,10,LAMCO4,ASTRW,CLPCL2,        &
     &            1,1,1,1,Q12224,3,ROUTID)
      SRSW=SR/SW
      AAAA=4.*SSPN**2/(RAD*SRSW*BLREF**2)
      BAOK  =BETA*ASTRW/K
!
!              FIGURE 7.1.2.2-20 A-D
!
      CALL INTEP3(BAOK,LAMB,LAMDA,X1220A,X2220A,Y2220A,13,17,Q2220A,    &
     &            X1220B,X2220B,Y2220B,13,10,Q2220B,                    &
     &            X1220C,X2220C,Y2220C,13,10,Q2220C,                    &
     &            1,1,1,1,1,1,                                          &
     &            X1220D,X2220D,Y2220D,13,18,Q2220D,BCLPCL)
      BBBB=AAAA*BCLPCL*K*CLPCLP/(BETA*CLACLO)
      DO 1020 I=1,NALPHA
         CLT=CL(I)*SRSW
         DCLPD(I)=CLPCL2*CLT**2-CDO/8.*SRSW
         CLPWBS(I)=BBBB*CLA(I)+AAAA*DCLPD(I)
 1020 END DO
      RETURN
      END
      SUBROUTINE SUBINT(LLOC, LANS)
!
!***  FORCE AN INTEGER INTO AN EXTERNAL ARRAY
!
      LLOC=LANS
!
      RETURN
      END
      SUBROUTINE SUBLAT(STB,WING,WINGIN,BW,A,B,AHT,AVT,VT,VTIN,         &
     &                  VTPL,TVTPAN,HTPL,WGPL,ITY)
!
!  THIS SUBROUTINE COMPUTES THE SUBSONIC LATERAL STABILITY DERIVATIVES
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG
      COMMON /BDATA/  BD(762)
      COMMON /IBODY/  PBODY,BODY(400)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /VTI/    XXXX(154), TVTIN(8)
      COMMON /HTI/    HTIN(154)
      COMMON /FLOLOG/ FLTC,OPTI,BO,XX(14),TRANSN
      COMMON /FLGTCD/ FLC(160)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
!
      LOGICAL FLTC,OPTI,BO,WGPL,TVTPAN,TRANSN,HTPL,VTPL
!
      DIMENSION STB(135),WING(380),WINGIN(100),BW(380),A(195)
      DIMENSION B(49), AHT(195), AVT(195), VT(380), VTIN(100)
      DIMENSION ROUTID(2),Q12127(3),Q2128A(3),Q2128B(3),Q2130B(3),      &
     &          Q2130A(3),Q12129(3),Q12131(3),Q52318(3),Q22126(3),      &
     &          Q1122A(3),Q1122B(3),Q1122C(3),Q1122D(3),Q1124A(3),      &
     &          Q1124B(3),Q1124C(3)
      DIMENSION WTYPE(4)
      DIMENSION C4(6),C5(6),C6(6),C7(6),C8(6),C9(6),C1(6),C2(6)
      DIMENSION X327(3),X227(8),X127(5),Y27(120)
      DIMENSION X128A(7),X228A(10),Y28A(70)
      DIMENSION X128B(3),X228B(9),Y28B(27)
      DIMENSION X129(3),X229(9),X329(3),Y29(81)
      DIMENSION X130A(5),X230A(9),Y30A(45)
      DIMENSION X130B(4),X230B(9),Y30B(36)
      DIMENSION X1526(7),X2526(9),Y526(63)
      DIMENSION X131(4),X231(11),X331(3),X431(3),Y31(396),T31A(132),    &
     &          T31B(132),T31C(132)
      DIMENSION X158A(10),X258A(2),Y58A(20),X158B(5),X258B(3),Y58B(15), &
     &          X158C(5),X258C(2),Y58C(10)
      DIMENSION X5322D(13),Y5322D(13),X122A(2),X222A(19),Y22A(38),X122B(&
     &4),X222B(13),Y22B(52),X5322C(11),Y5322C(11),X5324A(11),Y5324A(11),&
     &X124B(2),X224B(10),Y24B(20),X124C(5),X224C(11),Y24C(55)
!
      EQUIVALENCE(Y31(1),T31A(1)),(Y31(133),T31B(1)),(Y31(265),T31C(1))
!
      DATA ROUTID/4HSUBL,4HAT  /,Q12127/4H5.1.,4H2.1-,4H27  /,          &
     & Q2128A/4H5.1.,4H2.1-,4H28-A/,Q2130B/4H5.1.,4H2.1-,4H30-B/,       &
     & Q2128B/4H5.1.,4H2.1-,4H28-B/,Q2130A/4H5.1.,4H2.1-,4H30-A/,       &
     & Q12129/4H5.1.,4H2.1-,4H29  /,Q12131/4H5.1.,4H2.1-,4H31  /,       &
     & Q52318/4H5.2.,4H3.1-,4H8   /,Q22126/4H5.2.,4H2.1-,4H26  /,       &
     & Q1122A/4H5.3.,4H1.1-,4H22A /,Q1124A/4H5.3.,4H1.1-,4H24A /,       &
     & Q1122B/4H5.3.,4H1.1-,4H22B /,Q1124B/4H5.3.,4H1.1-,4H24B /,       &
     & Q1122C/4H5.3.,4H1.1-,4H22C /,Q1124C/4H5.3.,4H1.1-,4H24C /,       &
     & Q1122D/4H5.3.,4H1.1-,4H22D /
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
!---------          FIGURE 5.1.2.1-27
!
      DATA X327/0.0,0.5,1.0/
      DATA X127/1.0,2.0,4.0,6.0,8.0/
      DATA X227/-20.,0.0,20.,30.,40.,50.,55.,60./
      DATA Y27/.0014,0.0,-.00125,-.002,-.0027,-.0036,-.004,-.0044 ,     &
     &.0015,0.0,-.00145,-.0022,-.003,-.0041,-.005,-.00595 , .0016,0.0,  &
     &-.0016,-.0024,-.0033,-.0047,-.0057,-.0071 , .0016,0.0,-.0016,     &
     &-.0024,-.0035,-.0049,-.006,-.0074 , .0016,0.0,-.0016,-.0027,-.0035&
     &,-.0049,-.006,-.0074 , .0012,0.0,-.0012,-.0019,-.0026,-.0034,     &
     &-.0039,-.0044 , .0013,0.0,-.0013,-.0021,-.003,-.0043,-.00515,     &
     &-.0064 , .0015,0.0,-.0014,-.0024,-.0036,-.005,-.00605,-.0075 ,    &
     &.00165,0.0,-.0016,-.0025,-.0038,-.0054,-.0066,-.0082 , .0018,0.0, &
     &-.00175,-.0027,-.004,-.0058,-.007,-.0089 , .00105,0.0,-.001,-.0016&
     &,-.0023,-.003,-.0035,-.0038 , .0012,0.0,-.0013,-.0021,-.0031,     &
     &-.00435,-.00505,-.0062 , .0014,0.0,-.00165,-.00245,-.0036,-.0052, &
     &-.0061,-.0078 , .00167,0.0,-.0017,-.0028,-.004,-.00595,-.00715,   &
     &-.009 , .0018,0.0,-.0018,-.00295,-.0042,-.0062,-.0078,-.010/
!
!---------          FIGURE 5.1.2.1-28-A                     ------------
!
      DATA X128A/2.,3.,4.,5.,6.,8.,10./
      DATA X228A/0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,0.95/
      DATA Y28A/8*1.0,0.995,0.990 , 6*1.0,1.01,2*1.03,1.02 , 2*1.0,1.01,&
     &1.015,1.025,1.05,1.08,1.09,1.10,1.10 , 1.0,1.01,1.015,1.02,1.05,  &
     &1.09,1.115,1.16,1.20,1.21 , 1.0,1.01,1.02,1.04,1.07,1.12,1.17,1.24&
     &,1.32,1.36 , 1.0,1.01,1.05,1.07,1.12,1.18,1.27,1.40,1.58,1.70 ,   &
     &1.0,1.02,1.05,1.10,1.15,1.23,1.37,1.54,1.84,2.08/
!
!---------          FIGURE 5.1.2.1-28-B                     ------------
!
      DATA X128B/0.0,0.50,1.0/
      DATA X228B/1.0,1.5,2.0,2.5,3.0,4.0,5.0,6.0,8.0/
      DATA Y28B/-.0058,-.00345,-.00235,-.00145,-.001,-.00045,-.00025,   &
     &.00005,.0004 , -.008,-.00555,-.004,-.003,-.00235,-.0014,-.001,    &
     &-.00065,-.0002 , -.0113,-.008,-.00595,-.00465,-.0037,-.00255,     &
     &-.00182,-.00147,-.00097/
!
!---------          FIGURE 5.1.2.1-29                       ------------
!---------     NOTE%  INPUT ABSOLUTE VALUE OF THE           ------------
!---------            SWEEP ANGLE FOR FIG. 5.1.2.1-29       ------------
!---------                 ( THE X129 ARGUMENT )            ------------
!
      DATA X329/0.0,0.5,1.0/
      DATA X129/0.0,40.0,60.0/
      DATA X229/0.0,1.0,2.0,3.0,4.0,5.0,6.0,8.0,10./
      DATA Y29/0.0,-.000052,-.000088,-.00011,-.000134,-.000153,-.000168,&
     &-.00019,-.0002 , 0.0,-.000048,-.000085,-.000108,-.000128,-.000141,&
     &-.000153,-.000173,-.000178 , 0.0,-.00004,-.000073,-.000095,       &
     &-.000108,-.000119,-.000127,-.000135,-.000138 , 0.0,-.000052,      &
     &-.000098,-.000132,-.000162,-.000186,-.000208,-.00024,-.00026 ,    &
     &0.0,-.00005,-.000096,-.000124,-.00015,-.00017,-.000188,-.000217,  &
     &-.00023 , 0.0,-.00005,-.000087,-.000111,-.000129,-.000142,        &
     &-.000153,-.000166,-.000170 , 0.0,-.00005,-.000096,-.000133,       &
     &-.000167,-.000193,-.000216,-.000252,-.00028 , 0.0,-.00005,-.000095&
     &,-.000129,-.000155,-.000178,-.000197,-.000225,-.000245 , 0.0,     &
     &-.00005,-.000088,-.000113,-.000132,-.000147,-0.000159,-.000172,   &
     &-.00018/
!
!---------          FIGURE 5.1.2.1-30-A
!
      DATA X130A/2.,4.,6.,8.,10./
      DATA X230A/0.0,.2,.4,.5,.6,.7,.8,.9,.95/
      DATA Y30A/1.0,1.01,1.018,1.02,1.023,1.03,1.04,1.05,1.057 , 1.0,   &
     &1.012,1.03,1.045,1.06,1.085,1.118,1.16,1.19 , 1.0,1.015,1.045,    &
     &1.07,1.1,1.14,1.197,1.27,1.33 , 1.0,1.018,1.05,1.085,1.125,1.19,  &
     &1.26,1.39,1.485 , 1.0,1.02,1.058,1.097,1.148,1.215,1.325,1.495,   &
     &1.635/
!
!---------          FIGURE 5.1.2.1-30-B                     ------------
!
      DATA X130B/0.0,0.4,0.6,1.0/
      DATA X230B/3.,4.,5.,6.,7.,8.,9.,10.,11./
      DATA Y30B/-.0000192,-.0000222,-.0000238,-.0000231,-.0000230,      &
     &-.0000241,-.000026,-.0000284,-.0000328 , -.000022,-.0000287,      &
     &-.0000323,-.0000335,-.0000339,-.0000342,-.000035,-.000037,-.000042&
     & , -.0000233,-.00003,-.0000335,-.000035,-.0000366,-.000037,       &
     &-.0000375,-.00004,-.000047 , -.0000233,-.00003,-.0000335,-.000035,&
     &-.0000366,-.000037,-.0000375,-.00004,-.000047/
!
!---------          FIGURE 5.1.2.1-31                       ------------
!
      DATA X431 /0.0,0.5,1.0/
      DATA X331 /2.,4.,8./
      DATA X131 /-40.,0.0,40.,60./
      DATA X231 /0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.0/
      DATA T31A/0.,-.0001,-.00026,-.00056,-.001,-.0015,-.00217,-.0028,  &
     &-.00336,-.0039,-.00435 , 0.,-.0001,-.00032,-.0006,-.0011,-.00176, &
     &-.0025,-.0032,-.00385,-.00438,-.0048 , 0.,-.0001,-.0003,-.00063,  &
     &-.00117,-.0018,-.00256,-.0033,-.00395,-.00448,-.00496 , 0.0,      &
     &-.0001,-.0003,-.0006,-.00115,-.0017,-.00236,-.0031,-.0037,-.00417,&
     &-.00450 , .0,-.0001,-.00025,-.00078,-.00153,-.0024,-.00335,-.0043,&
     &-.0051,-.00586,-.0066 , 0.,-.0001,-.00038,-.001,-.00183,-.0029,   &
     &-.00405,-.0052,-.00633,-.00726,-.0079 , 0.,-.0001,-.0004,-.00102, &
     &-.00186,-.00303,-.00425,-.0054,-.00655,-.00736,-.00775 , 0.,-.0001&
     &,-.00040,-.001,-.00177,-.00275,-.0038,-.00476,-.00565,-.00635,    &
     &-.00653 , 0.,-.00008,-.00057,-.00145,-.00255,-.00374,-.00484,     &
     &-.00585,-.00682,-.0077,-.00845 , 0.,-.0001,-.00063,-.00165,-.003, &
     &-.00445,-.00625,-.00786,-.0093,-.01040,-.01110 , 0.,-.00013,-.0009&
     &,-.00195,-.00325,-.00483,-.00655,-.00815,-.0095,-.01035,-.0106 ,  &
     &0.,-.00013,-.0009,-.00195,-.00325,-.0046,-.00585,-.00697,-.00787, &
     &-.0084,-.00842/
      DATA T31B/0.,-.00015,-.0003,-.00065,-.0011,-.0017,-.0025,-.00325, &
     &-.004,-.00453,-.005 , 0.0,-.00015,-.00037,-.00076,                &
     &-.00128,-.0019,-.00276,-.00355,-.00426,-.00493,-.00536 , 0.,      &
     &-.00015,-.00037,-.00076,-.00128,-.0019,-.00276,-.00355,-.00426,   &
     &-.0048,-.0052 , 0.0,-.00014,-.00036,-.0007,-.00125,-.0019,-.0027, &
     &-.0034,-.004,-.00452,-.00508 , 0.,-.0001,-.0004,-.00096,-.00163,  &
     &-.00255,-.0038,-.0051,-.00637,-.00743,-.00825 , 0.,-.0002,-.00065,&
     &-.00125,-.00215,-.0032,-.0045,-.00595,-.0072,-.00845,-.00935 , 0.,&
     &-.0002,-.00065,-.00125,-.00215,-.0032,-.0045,-.00595,-.0072,      &
     &-.00823,-.009 , 0.,-.0001,-.0005,-.00113,-.00185,-.00285,-.004,   &
     &-.0051,-.00605,-.0069,-.00745 , 0.,-.00015,-.0006,-.00125,-.00215,&
     &-.00327,-.0047,-.00645,-.0084,-.0100,-.01140 , 0.,-.0003,-.00094, &
     &-.00192,-.00315,-.0046,-.0068,-.0089,-.0109,-.01255,-.0141 , 0.,  &
     &-.0003,-.0009,-.00195,-.00325,-.00482,-.00675,-.00855,-.01015,    &
     &-.01155,-.01265 , 0.,-.00015,-.0009,-.00176,-.00285,-.00405,-.0053&
     &,-.00665,-.0078,-.00885,-.0097/
      DATA T31C/0.,-.00015,-.00038,-.0007,-.00126,-.0019,-.00268,-.00344&
     &,-.00418,-.00484,-.0053 , 0.,-.00016,-.0004,-.00076,-.0013,-.002, &
     &-.00288,-.0037,-.00445,-.0051,-.0056 , 0.,-.00015,-.00035,-.0007, &
     &-.00125,-.0019,-.00278,-.00356,-.0043,-.005,-.0054 , 0.,-.00012,  &
     &-.0003,-.00067,-.0012,-.0018,-.00257,-.0033,-.00396,-.00458,      &
     &-.00505 , 0.,-.00015,-.0005,-.00115,-.0018,-.00273,-.00385,-.00515&
     &,-.0066,-.0079,-.0088 , 0.,-.00015,-.00052,-.0012,-.0021,-.0033,  &
     &-.00486,-.00627,-.00756,-.0087,-.00972 , 0.,-.00015,-.00052,-.0012&
     &,-.0021,-.0033,-.00465,-.006,-.00728,-.00836,-.00925 , 0.,-.00015,&
     &-.0005,-.00116,-.0019,-.00285,-.004,-.0051,-.0061,-.00705,-.0079 ,&
     &-0.,-.00018,-.0006,-.00125,-.0021,-.00335,-.00505,-.0071,-.00915, &
     &-.01100,-.01255 , 0.,-.00025,-.0009,-.0018,-.0031,-.0048,-.007,   &
     &-.0094,-.01145,-.0133,-.01475 , 0.,-.0003,-.0009,-.00195,-.00327, &
     &-.0048,-.00697,-.0089,-.01057,-.01205,-.0132 , 0.,-.00012,-.00073,&
     &-.00155,-.00265,-.004,-.00536,-.0067,-.00795,-.009,-.010/
!
!                        FIGURE 5.2.2.1-26
!
      DATA X1526/4.0,4.5,5.0,5.5,6.0,7.0,8.0/
      DATA X2526/0.0,.2,.4,.6,.8,1.0,1.2,1.4,1.6/
      DATA Y526/1.0,1.0,1.0,1.0,1.0,1.0,1.0,.99,.97,                    &
     &1.0,1.0,1.0,1.0,1.0,1.0,.98,.948,.911,                            &
     &1.0,1.0,1.0,1.0,.997,.971,.933,.883,.827,                         &
     &1.0,1.0,1.0,.991,.963,.922,.870,.811,.746,                        &
     &1.0,1.0,.995,.970,.932,.884,.829,.764,.695,                       &
     &1.0,1.0,.977,.944,.899,.845,.780,.715,.641,                       &
     &1.0,.985,.960,.921,.870,.812,.745,.670,.592/
!
!                         FIGURE 5.2.3.1-8A
!
      DATA X158A/20.,14.,10.,8.,7.,6.,5.,4.,3.,2.5/
      DATA X258A/.2,.8/
      DATA Y58A/.1,1.88,                                                &
     &.40,2.21,                                                         &
     &.74,2.60,                                                         &
     &.98,2.80,                                                         &
     &1.30,3.13,                                                        &
     &1.61,3.50,                                                        &
     &2.00,3.88,                                                        &
     &2.50,4.40,                                                        &
     &2.99,5.00,                                                        &
     &3.45,5.40/
!
!                        FIGURE 5.2.3.1-8B
!
      DATA X158B/.8,1.0,1.2,1.4,1.6/
      DATA X258B/0.0,3.0,6.0/
      DATA Y58B/0.0,2.35,4.68,                                          &
     &0.0,3.00,6.00,                                                    &
     &0.0,3.60,7.25,                                                    &
     &0.0,4.18,8.50,                                                    &
     &0.0,4.79,9.50/
!
!                        FIGURE 5.2.3.1-8C
!
      DATA X158C/.5,.6,.8,1.,2./
      DATA X258C/0.0,6.0/
      DATA Y58C/-.00048,.00251,                                         &
     &-.00048,.0035,                                                    &
     &-.00048,.00477,                                                   &
     &-.00048,.00559,                                                   &
     &-.00048,.00641/
!
!                        FIGURE 5.3.1.1-22A
!
      DATA X122A/1.0,.6/
      DATA X222A/0.,.125,.25,.5,.75,1.,1.25,1.5,1.75,2.,2.25,2.5,       &
     &3.00,3.25,3.50,3.75,4.00,5.00,7.00/
      DATA Y22A/0.,.40,.720,.990,1.19,1.32,1.40,1.46,1.50,1.51,1.48,1.42&
     &,1.27,1.21,1.17,1.13,1.10,1.04,1.02,                              &
     &0.,.70,.940,1.18,1.35,1.46,1.54,1.60,1.63,1.64,1.60,1.53,1.36,    &
     &1.28,1.21,1.16,1.13,1.06,1.02/
!
!                        FIGURE 5.3.1.1-22B
!
      DATA X122B/.5,.6,.7,.8/
      DATA X222B/0.0,-.2,-.3,-.4,-.5,-.6,-.65,-.7,-.75,-.8,-.85,-.9,-1./
      DATA Y22B/1.05,.94,.90,.87,.86,.87,.90,.93,.98,1.06,1.16,1.29,1.7,&
     &1.15,1.00,.95,.90,.89,.90,.92,.96,1.01,1.08,1.18,1.31,1.70,       &
     &1.22,1.05,.99,.94,.92,.92,.95,.98,1.03,1.10,1.20,1.33,1.70,       &
     &1.29,1.09,1.02,.97,.94,.94,.96,1.0,1.06,1.12,1.22,1.36,1.70/
!
!                        FIGURE 5.3.1.1-22C
!
      DATA X5322C/0.0,.2,.4,.6,.7,.8,.9,1.2,1.4,1.6,2.0/
      DATA Y5322C/0.0,.29,.52,.70,.77,.83,.87,.98,1.04,1.07,1.13/
!
!                        FIGURE 5.3.1.1-22D
!
      DATA X5322D/0.0,.50,1.0,1.5,2.0,2.5,3.0,3.5,4.0,4.5,5.0,5.5,6.0/
      DATA Y5322D/5*.75,.835,.92,6*1.0/
!
!                        FIGURE 5.3.1.1-24A
!
      DATA X5324A/0.0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.0/
      DATA Y5324A/1.5,1.33,1.197,1.098,1.03,1.0,1.03,1.098,1.197,1.33,  &
     &1.5/
!
!                        FIGURE 5.3.1.1-24B
!
      DATA X124B/20.0,0.0/
      DATA X224B/.5,1.0,1.5,2.0,2.5,3.0,3.5,4.0,4.5,5.0/
      DATA Y24B/.90,1.64,2.19,2.63,2.95,3.22,3.44,3.61,3.75,3.86,       &
     &1.0,1.72,2.30,2.75,3.11,3.39,3.62,3.82,3.98,4.11/
!
!                        FIGURE 5.3.1.1-24C
!
      DATA X124C/.2,.4,.6,.8,1.0/
      DATA X224C/0.0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.0/
      DATA Y24C/1.0,.90,.818,.741,.68,.631,.593,.563,.542,.527,.510,    &
     &1.0,.93,.87,.825,.784,.752,.730,.710,.696,.688,.680,              &
     &1.0,.95,.911,.882,.859,.844,.830,.820,.812,.805,.800,             &
     &1.0,.968,.941,.923,.908,.898,.890,.883,.881,.880,.879,            &
     &1.0,.979,.962,.954,.949,.943,.938,.935,.935,.931,.931/
      DATA I4,I5,I6/3*0/
!
      IF(.NOT. WGPL) GO TO 1255
      YA27 =UNUSED
      YA28A=UNUSED
      YA28B=UNUSED
      YA29 =UNUSED
      YA30A=UNUSED
      YA30B=UNUSED
      YA31I=UNUSED
      YA31O=UNUSED
!
!                   LATERAL STABILITY DERIVATIVES
!
      IF(TRANSN)GO TO 1190
!
!     ***** WING ALONE CALCULATIONS *****
!
!     WING ALONE SIDEFORCE DERIVATIVE
!
      BDAT=2.*WINGIN(4)
      ANUM1=6.0*A(44)*A(42)
      DEN1=PI*A(120)*(A(120)+4.*A(43))
      BB=SQRT(1.-(FLC(I+2)*A(43))**2)
      ANUM2=A(120)+4.0*A(43)
      DEN2=A(120)*BB+4.0*A(43)
      DO 1050 J=1,NALPHA
         STB(J+15)=(1./RAD)*(B(J+2)**2)*(ANUM1/DEN1)-.0001*ABS(STB(122))
         IF(B(J+2).EQ.0.0)GO TO 1000
         STB(J+35)=(ANUM2/DEN2)*(STB(J+15)/B(J+2))
         WING(J+140)=STB(J+35)*WING(J+20)
         GO TO 1010
 1000    STB(J+35)=0.0
         WING(J+140)=0.0
 1010    CONTINUE
!
!     WING ALONE YAWING MOMENT DERIVATIVE
!
         IF(J.GT.1)GO TO 1020
         APART=1.0/(4.0*PI*A(120))
         BPART=ABS(A(44))/(PI*A(120)*(A(120)+4.0*A(43)))
         CPART=A(43)-0.5*A(120)-A(120)**2/(8.*A(43))
         EPART=(A(120)+4.*A(43))/(A(120)*BB+4.*A(43))
         ANUM3=(A(120)*BB)**2+4.*A(120)*BB*A(43)-8.0*A(43)*A(43)
         DEN3=A(120)*A(120)+4.0*A(120)*   A(43)-8.0*A(43)*A(43)
 1020    CONTINUE
         IF(WING(J+60).EQ.0.0)GO TO 1030
         DPART=6.0*(WING(J+40)/WING(J+60)/CBARR)*(ABS(A(42))/A(120))
         GO TO 1040
 1030    DPART=0.0
 1040    CONTINUE
         STB(J+75)=(APART-BPART*(CPART+DPART))/RAD
         WING(J+160)=EPART*(ANUM3/DEN3)*STB(J+75)*WING(J+20)**2
         WING(J+160)=WING(J+160)*BDAT*SREF/(BLREF*A(3))
 1050 END DO
!
!---------     TEST FOR CONFIGURATION AND UNIFORM DIHEDRAL ANGLE -------
!
!     WING ALONE ROLLING MOMENT DERIVATIVE
!     (FOR STRAIGHT WING CONFIGURATION WITH UNIFORM DIHEDRAL)
!
      IF(WINGIN(15).NE.WTYPE(1)) GO TO 1120
      IF(A(120).GE.1.0) GO TO 1070
      DO 1060 J=1,NALPHA
         WING(J+180)=-2./(RAD*3.*A(120))*WING(J+20)-STB(122)*A(120)/    &
     &           (6.*RAD**2)*(A(4)/SREF)
 1060 WING(J+180)=WING(J+180)*BDAT/ BLREF
      GO TO 1180
 1070 CONTINUE
      XA2= FLC(I+2)*A(73)
      X1ARG=ABS(A(70))
      XA1=A(120)/A(73)
!
!     ---------     FIGURE 5.1.2.1-27        ----------
!
      CALL TLIN3X(X127,X227,X327,Y27,5,8,3,A(120),X1ARG,A(118),YA27,    &
     &            0,1,0,2,2,0,Q12127,3,ROUTID)
      IF(A(70).LT.0.0) YA27=ABS(YA27)
!
!     ---------     FIGURE 5.1.2.1-28-A      ----------
!
      CALL TLINEX(X128A,X228A,Y28A,7,10,XA1,XA2,YA28A,                  &
     &            0,2,1,2,Q2128A,3,ROUTID)
!
!     ---------     FIGURE 5.1.2.1-28-B      ----------
!
      CALL TLINEX(X128B,X228B,Y28B,3,9,A(118),A(120),YA28B,             &
     &         0,0,0,0,Q2128B,3,ROUTID)
!
!     ---------     FIGURE 5.1.2.1-30-B      ----------
!
      CALL TLINEX(X130B,X230B,Y30B,4,9,A(118),A(120),YA30B,             &
     &            0,2,0,2,Q2130B,3,ROUTID)
      DO 1080 J=1,NALPHA
 1080 STB(J+95)=(YA27*YA28A+YA28B)*WING(J+20)*SREF/A(4)+WINGIN(11)*     &
     &          (A(68))*YA30B
      IF(WINGIN(12).NE.UNUSED.AND.WINGIN(12).NE.0.0)GO TO 1100
!
!     ---------     FIGURE 5.1.2.1-30-A      ----------
!
      CALL TLINEX(X130A,X230A,Y30A,5,9,XA1,XA2,YA30A,                   &
     &            2,2,2,2,Q2130A,3,ROUTID)
!
!     ---------     FIGURE 5.1.2.1-29        ----------
!
      CALL TLIN3X(X129,X229,X329,Y29,3,9,3,X1ARG,A(120),A(118),YA29,    &
     &            0,0,0,2,2,0,Q12129,3,ROUTID)
      DO 1090 J=1,NALPHA
         WING(J+180)=(STB(J+95)+WINGIN(13)*YA29*YA30A)*A(4)/SREF
         WING(J+180)=WING(J+180)*BDAT/BLREF
 1090 END DO
      GO TO 1180
!
!     WING ALONE ROLLING MOMENT DERIVATIVE
!     (FOR STRAIGHT WING CONFIGURATION WITH NON-UNIFORM DIHEDRAL)
!
 1100 CONTINUE
      STB(7)=A(131)/(2.0*PI)*RAD
      X1ARG=ATAN(A(68)/B(2))*RAD
      X3ARG=B(2)*A(120)/STB(7)
      AKOVB=STB(7)/B(2)
!
!     ---------     FIGURE 5.1.2.1-31        ----------  (INBOARD)
!
      CALL TLIN4X(X131,X231,X331,X431,Y31,4,11,3,3,X1ARG,STB(2),X3ARG,  &
     &            A(118),YA31I,0,0,1,0,2,2,1,0,Q12131,3,ROUTID)
!
!     ---------     FIGURE 5.1.2.1-31        ----------  (OUTBOARD)
!
      CALL TLIN4X(X131,X231,X331,X431,Y31,4,11,3,3,X1ARG,STB(3),X3ARG,  &
     &            A(118),YA31O,0,0,1,0,2,2,1,0,Q12131,3,ROUTID)
      DO 1110 J=1,NALPHA
 1110 WING(J+180)=(STB(J+95)+(YA31O-YA31I)*AKOVB*WINGIN(14)/RAD+YA31I/  &
     &            RAD*AKOVB*WINGIN(13))*A(4)/SREF*BDAT/BLREF
      GO TO 1180
!
!     WING ALONE ROLLING MOMENT DERIVATIVE
!              DOUBLE DELTA OR CRANKED WING CONFIGURATION
!     (INBOARD PANEL ROLLING MOMENT)
!
 1120 CONTINUE
      X1ARG=ABS(A(70))
      STB(135)=-2.0/(3.0*RAD*A(163))
!
!     ---------     FIGURE 5.1.2.1-27        -----------
!
      CALL TLIN3X(X127,X227,X327,Y27,5,8,3,A(163),X1ARG,A(25),STB(132), &
     &            0,1,0,2,2,0,Q12127,3,ROUTID)
      IF(A(70).LT.0.0) YA27=ABS(YA27)
!
!     ---------     FIGURE 5.1.2.1-28-A      ----------
!
      XA1I=A(163)/A(73)
      XA2I=A(73)*FLC(I+2)
      CALL TLINEX(X128A,X228A,Y28A,7,10,XA1I,XA2I,STB(134),             &
     &            0,2,1,2,Q2128A,3,ROUTID)
!
!     ---------     FIGURE 5.1.2.1-28-B      ----------
!
      CALL TLINEX(X128B,X228B,Y28B,3,9,A(25),A(163),STB(133),           &
     &         0,0,0,0,Q2128B,3,ROUTID)
!
!     (OUTBOARD PANEL ROLLING MOMENT)
!
      STB(131)=-2.0/(3.*RAD*A(168))
      X1ARG=ABS(A(94))
!
!     ---------     FIGURE 5.1.2.1-27        ----------
!
      CALL TLIN3X(X127,X227,X327,Y27,5,8,3,A(168),X1ARG,A(169),STB(128),&
     &            0,1,0,2,2,0,Q12127,3,ROUTID)
      IF(A(94).LT.0.0) YA27=ABS(YA27)
!
!     ---------     FIGURE 5.1.2.1-28-A      ----------
!
      XA1O=A(168)/A(97)
      XA2O=A(97)*FLC(I+2)
      CALL TLINEX(X128A,X228A,Y28A,7,10,XA1O,XA2O,STB(130),             &
     &            0,2,1,2,Q2128A,3,ROUTID)
!
!     ---------     FIGURE 5.1.2.1-28-B      ----------
!
      CALL TLINEX(X128B,X228B,Y28B,3,9,A(169),A(168),STB(129),          &
     &         0,0,0,0,Q2128B,3,ROUTID)
      STB(58)=A(171)*(A(1)/SREF)+A(172)*(A(167)/SREF)
      IF(A(163).GE.1.0) GO TO 1130
      STB(127)=A(171)*(A(1)/SREF)*STB(135)*(WINGIN(3)-WINGIN(2))/       &
     &  WINGIN(4)
      GO TO 1140
 1130 STB(127)=A(171)*(A(1)/SREF)*(STB(132)*STB(134)+STB(133))*         &
     &(WINGIN(3)-WINGIN(2))/WINGIN(4)
 1140 IF(A(168).GE.1.0)GO TO 1150
      STB(126)=A(172)*(A(167)/SREF)*STB(131)
      GO TO 1160
 1150 STB(126)=A(172)*(A(167)/SREF)*(STB(128)*STB(130)+STB(129))
 1160 CONTINUE
      DO 1170 J=1,NALPHA
 1170 WING(J+180)=(WING(J+20)/STB(58))*(STB(127)+STB(126))*BDAT/BLREF
 1180 CONTINUE
      STB(68)=YA27
      STB(71)=YA28A
      STB(70)=YA28B
      STB(67)=YA29
      STB(66)=YA30A
      STB(69)=YA30B
      STB(64)=YA31I
      STB(65)=YA31O
      IF(BO)GO TO 1190
      GO TO 1330
!
!     ***** WING BODY CALCULATIONS *****
!
!     WING-BODY SIDEFORCE DERIVATIVE(ALL PLANFORMS)
!
 1190 CONTINUE
      ARG=2.0*STB(1)/STB(72)
      IF(ARG.LT.0.0)GO TO 1200
!
!                        FIGURE 5.2.1.1-7
!
      STB(57)=1.0+.49*ARG
      GO TO 1210
 1200 STB(57)=1.0-.85*ARG
 1210 BW(141)=-STB(57)*BODY(101)-0.0001*ABS(STB(122))
!
!     WING-BODY YAWING MOMENT DERIVATIVE(ALL PLANFORMS)
!
      ARG1=FLC(I+42)*BD(1)
      STB(56)=1.+ALOG(1.E-6*ARG1)/4.86
      ARG11=STB(59)/STB(123)
      ARG12=SQRT(STB(61)/STB(60))
      ARG13=BD(1)**2/STB(62)
      ARG14=SYNA(1)/BD(1)
!                        FIGURE 5.2.3.1-8
!
      CALL TLINEX(X158A,X258A,Y58A,10,2,ARG13,ARG14,YDUMY,              &
     &            2,1,2,1,Q52318,3,ROUTID)
      CALL TLINEX(X158B,X258B,Y58B,5,3,ARG12,YDUMY,YDUMY2,              &
     &            2,0,2,1,Q52318,3,ROUTID)
      CALL TLINEX(X158C,X258C,Y58C,5,2,ARG11,YDUMY2,STB(15),            &
     &            2,0,2,1,Q52318,3,ROUTID)
      BW(161)=-STB(15)*STB(56)*(STB(62)*BD(1))/(SREF*BLREF)
      IF(.NOT.TRANSN)GO TO 1220
      RETURN
 1220 CONTINUE
!
!     WING-BODY ROLLING MOMENT DERIVATIVE(ALL PLANFORMS,UNIFORM AND NON-
!     UNIFORM DIHEDRAL)
!
      ANUM=1.2*STB(4)*STB(72)*SQRT(A(120))
      ADEN=RAD*2.0*  WINGIN(4)**2
      STB(14) = ANUM/ADEN
      STB(13)=-.0005*SQRT(A(120))*STB(122)*(STB(72)/(2.0*WINGIN(4)))**2
!
!                        FIGURE 5.2.2.1-26
!
      ARG1=A(120)/A(49)
      ARG2=STB(63)/(2.0*  WINGIN(4))
      CALL TLINEX(X1526,X2526,Y526,7,9,ARG1,ARG2,STB(8),                &
     &            0,0,0,1,Q22126,3,ROUTID)
!
      IF(WINGIN(15).EQ.WTYPE(1))GO TO 1230
      APART= STB(8)*(STB(132)*STB(134)+STB(128)*STB(130))+STB(133)      &
     &      +STB(129)
      FPART=0.0
      EPART=STB(13)
      GO TO 1240
 1230 CONTINUE
      APART=STB(68)*STB(71)*STB(8)+STB(70)
      FPART=WINGIN(11)*A(68)*STB(69)
      EPART=WING(181)*BLREF/BDAT-(STB(96)-STB(13))*A(4)/SREF
 1240 CONTINUE
      DO 1250 J=1,NALPHA
 1250 BW(J+180)=(BW(J+20)*APART+EPART+(STB(14)+FPART)*A(4)/SREF)*       &
     &          BDAT/BLREF
 1255 CONTINUE
!
!   *****WING-BODY-TAIL CALCULATIONS*****
!
      IF(VTPL.OR.TVTPAN)GO TO 1260
      GO TO 1330
 1260 CONTINUE
      VT(141) = 0.0
      VT(161) = 0.0
      DO 1270 J=1,NALPHA
 1270 VT(J+180) = 0.0
      IF(.NOT.VTPL) GO TO 1310
!
!              SINGLE VERTICAL PANEL ON PLANE OF SYMMETRY
!                        FIGURE 5.3.1.1-22A
!
      ARG2=VTIN(4)/(2.0*(VTIN(4)-VTIN(3)))
      CALL TLINEX(X122A,X222A,Y22A,2,19,AVT(118),ARG2,STB(120),         &
     &            0,0,0,0,Q1122A,3,ROUTID)
!
!                        FIGURE 5.3.1.1-22D
!
      CALL TBFUNX(ARG2,STB(118),DYDX,13,X5322D,Y5322D,C6,I6,MI,NG,      &
     &            0,0,Q1122D,3,ROUTID)
      ZH = SYNA(7)-((HTIN(4)-HTIN(3))*AHT(62)+AHT(30)-AHT(16)/4.0)*     &
     &     SIN(SYNA(8)/RAD)
!
      IF(.NOT.HTPL.OR.ZH.LT.0.0) GO TO 1280
!
!                        FIGURE 5.3.1.1-22B
!
      ARG1=STB(9)/STB(10)
      ARG2=-ZH/ VTIN(4)
      CALL TLINEX(X122B,X222B,Y22B,4,13,ARG1,ARG2,STB(121),             &
     &            0,0,2,0,Q1122B,3,ROUTID)
!
!                        FIGURE 5.3.1.1-22C
!
      ARG=(AHT(2)+AHT(119))/AVT(4)
      CALL TBFUNX(ARG,STB(119),DYDX,11,X5322C,Y5322C,C5,I5,MI,NG,       &
     &            0,0,Q1122C,3,ROUTID)
!
      GO TO 1290
 1280 STB(121)=0.0
      STB(119)=0.0
 1290 STB(116)=STB(120)*AVT(120)*(1.+STB(119)*(STB(121)-1.))
      BPART=3.06*((AVT(4)/A(4))/(1.+A(43)))
      CPART=.4* STB(4)/STB(59)+ .009*A(120)
      STB(117)=0.724+BPART+CPART
      ANUM=2.*PI*STB(116)
      APART=STB(116)**2/(VTIN(I+20)*RAD/(2.*PI))**2
      BPART= 1.+AVT(50)**2/B(2)**2
      STB(5)=ANUM/(2.+SQRT(APART*BPART+4.))
      VT(141)=-STB(118)*STB(5)*STB(117)*AVT(4)/(RAD*SREF)
      VT(161)=-VT(141)*STB(11)/BLREF
      DO 1300 J=1,NALPHA
 1300 VT(J+180)=(VT(141)*(STB(12)*COS(FLC(J+22)/RAD)-STB(11)*           &
     &          SIN(FLC(J+22)/RAD)))/BLREF
      IF(SYNA(18).EQ.UNUSED.AND.SYNA(19).EQ.UNUSED) GO TO 1310
!
!     TWIN VERTICAL TAIL CORRECTION
!
      IF(ITY.EQ.0) TVCORR=2*(COS(SYNA(18)/RAD))**2
      IF(ITY.EQ.1) TVCORR=2*(COS(SYNA(19)/RAD))**2
      VT(141)=TVCORR*VT(141)
      VT(161)=TVCORR*VT(161)
      DO 1305 J=1,NALPHA
         VT(J+180)=TVCORR*VT(J+180)
 1305 END DO
 1310 CONTINUE
      IF(.NOT.TVTPAN) GO TO 1330
!
!                        FIGURE 5.3.1.1-24A
!
      ARG =TVTIN(1)/TVTIN(2)
      CALL TBFUNX(ARG ,STB(75),DYDX,11,X5324A,Y5324A,C4,I4,MI,NG,       &
     &            0,0,Q1124A,3,ROUTID)
      STB(6)=TVTIN(2)**2/TVTIN(5)
!
!                        FIGURE 5.3.1.1-24B
!
      ARG2=STB(75)*STB(6)
      STB(116) = ARG2
      ARG1=TVTIN(6)
      CALL TLINEX(X124B,X224B,Y24B,2,10,ARG1,ARG2,STB(73),              &
     &            0,2,0,2,Q1124B,3,ROUTID)
!
!                        FIGURE 5.3.1.1-24C
!
      ARG1=TVTIN(4)/BD(1)
      ARG2=TVTIN(3)/TVTIN(2)
      CALL TLINEX(X124C,X224C,Y24C,5,11,ARG1,ARG2,STB(74),              &
     &            2,0,0,0,Q1124C,3,ROUTID)
!
      TVT=-STB(74)*STB(73)*2.*TVTIN(5)/(SREF*RAD)
      VT(141)=VT(141)+TVT
      VT(161)=VT(161)-TVT*TVTIN(7)/BLREF
!
      DO 1320 J=1,NALPHA
 1320 VT(J+180)=VT(J+180)+TVT*(TVTIN(8)*COS(FLC(J+22)/RAD)-TVTIN(7)*    &
     &  SIN(FLC(J+22)/RAD))/BLREF
 1330 CONTINUE
      RETURN
      END
      SUBROUTINE SUBLOG(LLOC, LANS)
!
!***  FORCE A LOGICAL INTO AN EXTERNAL ARRAY
!
      LOGICAL LLOC,LANS
!
      LLOC=LANS
!
      RETURN
      END
      SUBROUTINE SUBPAH
!
!     THIS ROUTINE YIELDS THE FOLLOWING WING DERIVATIVES-
!       SUBSONIC  CLQ
!                 CMQ
!                 CLADOT
!                 CMADOT
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /HTDATA/ A(195)
      COMMON /HTI/    WINGIN(154)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /BDATA/  XBD(300),DYN(213)
      COMMON /IHT/    PW,WING(380)
      COMMON /SBETA/  XST(243),TRA(108),STB(135)
      COMMON /WHAERO/ XCD(106),C(51)
      COMMON /EXPER/  KEXP(105),KWING
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL KWING
      REAL MACH,LAMDA,MACOE
      DIMENSION ROUTID(2)
      DIMENSION WTYPE(4)
      DIMENSION X21416(8),Y71416(8),Q71416(3)
      DIMENSION X21428(9),Y71428(9)
      DIMENSION I21416(4),I21428(4)
      DIMENSION Q71428(3)
      EQUIVALENCE(WING(101),CLA),(WING(121),CMA),(DYN(21),DCMCLO)
      EQUIVALENCE(COSLC4,A(67)),(TANLC4,A(68)),(ASTRW,A(7))             &
     & ,(SW,A(3)),(MACOE,A(16)),(CRSTR,A(10))                           &
     &,(LAMDA,A(27)),(DXCG,A(173))
      EQUIVALENCE(CLQWT,WING(201)),(CLADWT,WING(241))                   &
     &,(CMQMFB,DYN(1))
      EQUIVALENCE(CLQWSB,WING(201)),(CMQ2,DYN(2)),(CMQWSB,WING(221))    &
     &,(CLG,DYN(4)),(CLADWL,WING(241)),(CMOG,DYN(6)),(CMADPP,DYN(7))    &
     &,(CMADWL,WING(261))
      DATA WTYPE  /4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA ROUTID /4HSUBP,4HAW  /
      DATA Q71416 /4H7.1.,4H4.1-,4H6   /
      DATA X21416 /0.,.25,.5,1.5,2.25,2.75,3.25,4./
      DATA Y71416 /0.,.005,.014,.065,.095,.112,.125,.14/
      DATA X11416 /1./
      DATA I21416 /8,3*0/
      DATA I21428 /9,3*0/
      DATA Q71428 /4H7.1.,4H4.2-,4H8   /
      DATA X21428 /0.,.25,.5,1.25,1.75,2.25,2.75,3.25,4./
      DATA Y71428 /0.,.003,.008,.033,.047,.057,.066,.072,.077/
!
      TYPE=WINGIN(15)
      IF(TRANSN.AND.(TYPE.NE.WTYPE(1)))GO TO 1020
      MACH=FLC(IM+2)
      XACCR=C(6)
      DCMDCL=-DCMCLO*CBARR/MACOE
      DCMCLQ=-C(7)*CBARR/MACOE
      IF(TRANSN)DCMCLQ=(TRA(105)*CRSTR-(SYNA(1)-SYNA(2)))/MACOE
      IF(KWING)DCMCLQ=-(CMA/CLA)*CBARR/MACOE
      IF(TRANSN)DCMDCL=(TRA(95)*CBARR-DXCG)/MACOE
      CCLAL=WING(101)
      CLASM=WINGIN(21)*SQRT(ABS(1.-FLC(3)**2))
      IF(TRANSN)CLASM=WINGIN(69)
!
!    ---- WING PITCHING DERIVATIVES,CLQ,CMQ ----
!
      CLQWSB=(.5+2.*DCMCLQ)*CCLAL*MACOE/CBARR
      IF(TRANSN)CLQWT=CLQWSB
      IF(TRANSN)MACH=TRA(6)
      CMQ2=-0.7*CLASM*COSLC4*(ASTRW*(.5*DCMDCL+2.*DCMDCL**2)/(ASTRW+2.* &
     &   COSLC4)+ASTRW**3*TANLC4**2/((ASTRW+6.*COSLC4)*24.)+.125)*SW/SR &
     &   *(MACOE/CBARR)**2
      IF(MACH.GT.0.2)GO TO 1000
      CMQWSB=CMQ2
      GO TO 1010
 1000 BEE=SQRT(1.-MACH**2*COSLC4**2)
      SAVE=ASTRW**3*TANLC4**2
      CMQWSB=((SAVE/(ASTRW*BEE+6.*COSLC4)+3./BEE)/(SAVE/(ASTRW+6.*COSLC4&
     &       )+3.))*CMQ2
      IF(TRANSN)CMQMFB=CMQWSB
      IF(TRANSN)MACH=FLC(IM+2)
      IF(MACH.GT.1.)GO TO 1020
!
!    ---- WING ACCELERATION DERIVATIVES,CLAD,CMAD ----
!
 1010 IF(LAMDA.NE.0.)GO TO 1020
      BETA=SQRT(1.-MACH**2)
      TEST=BETA*ASTRW
      IF(TEST.GT.4.)GO TO 1020
      IF(TRANSN)XACCR=TRA(105)
!
!           -- FIGURE 7.1.4.1-6 --
!
      CALL INTERX(1,X21416,TEST,I21416,Y71416,BPIAO2,8,8,               &
     &            0,0,0,0,0,0,0,0,Q71416,3,ROUTID)
      CLG=BPIAO2*PI*ASTRW/(-2.*BETA**2)
      EXPID=SW*MACOE/(SR*CBARR)
      CLADWL=(1.5*XACCR*CCLAL*SR/SW+CLG/19.1  )*EXPID
      IF(TRANSN)CLADWT=CLADWL
!
!           -- FIGURE 7.1.4.2-8 --
!
      CALL INTERX(1,X21428,TEST,I21428,Y71428,BCMPAW,9,9,               &
     &            0,0,0,0,0,0,0,0,Q71428,3,ROUTID)
      CMOG=BCMPAW*ASTRW*0.5*PI/BETA**2
      CMADPP=(-2.53125*XACCR**2*CCLAL*SR/SW+.078532*CMOG)*EXPID         &
     &       *MACOE/CBARR
      CMADWL=CMADPP+(DXCG/CBARR)*CLADWL
 1020 CONTINUE
      RETURN
      END
      SUBROUTINE SUBPAW
!
!     THIS ROUTINE YIELDS THE FOLLOWING WING DERIVATIVES-
!       SUBSONIC  CLQ
!                 CMQ
!                 CLADOT
!                 CMADOT
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /WINGD/  A(195)
      COMMON /WINGI/  WINGIN(77)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /POWR/   DYN(213)
      COMMON /IWING/  PW,WING(400)
      COMMON /SBETA/  STB(135),TRA(108)
      COMMON /WHAERO/ C(51)
      COMMON /EXPER/  KEXP(105),KWING
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL KWING
      REAL MACH,LAMDA,MACOE
      DIMENSION ROUTID(2)
      DIMENSION WTYPE(4)
      DIMENSION X21416(8),Y71416(8),Q71416(3)
      DIMENSION X21428(9),Y71428(9)
      DIMENSION I21416(4),I21428(4)
      DIMENSION Q71428(3)
      EQUIVALENCE(WING(101),CLA),(WING(121),CMA),(DYN(21),DCMCLO)
      EQUIVALENCE(COSLC4,A(67)),(TANLC4,A(68)),(ASTRW,A(7))             &
     &    ,(SW,A(3)),(MACOE,A(16)),(CRSTR,A(10))                        &
     &    ,(LAMDA,A(27)),(DXCG,A(173))
      EQUIVALENCE(CLQWT,WING(201)),(CLADWT,WING(241))                   &
     &     ,(CMQMFB,DYN(1))
      EQUIVALENCE(CLQWSB,WING(201)),(CMQ2,DYN(2)),(CMQWSB,WING(221))    &
     &    ,(CLG,DYN(4)),(CLADWL,WING(241)),(CMOG,DYN(6)),(CMADPP,DYN(7))&
     &    ,(CMADWL,WING(261))
      DATA WTYPE  /4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA ROUTID /4HSUBP,4HAW  /
      DATA Q71416 /4H7.1.,4H4.1-,4H6   /
      DATA X21416 /0.,.25,.5,1.5,2.25,2.75,3.25,4./
      DATA Y71416 /0.,.005,.014,.065,.095,.112,.125,.14/
      DATA X11416 /1./
      DATA I21416 /8,3*0/
      DATA I21428 /9,3*0/
      DATA Q71428 /4H7.1.,4H4.2-,4H8   /
      DATA X21428 /0.,.25,.5,1.25,1.75,2.25,2.75,3.25,4./
      DATA Y71428 /0.,.003,.008,.033,.047,.057,.066,.072,.077/
!
      TYPE=WINGIN(15)
      IF(TRANSN.AND.(TYPE.NE.WTYPE(1)))GO TO 1020
      MACH=FLC(IM+2)
      XACCR=C(6)
      DCMDCL=-DCMCLO*CBARR/MACOE
      DCMCLQ=-C(7)*CBARR/MACOE
      IF(TRANSN)DCMCLQ=(TRA(105)*CRSTR-(SYNA(1)-SYNA(2)))/MACOE
      IF(KWING)DCMCLQ=-(CMA/CLA)*CBARR/MACOE
      IF(TRANSN)DCMDCL=(TRA(95)*CBARR-DXCG)/MACOE
      CCLAL=WING(101)
      CLASM=WINGIN(21)*SQRT(ABS(1.-FLC(3)**2))
      IF(TRANSN)CLASM=WINGIN(69)
!
!    ---- WING PITCHING DERIVATIVES,CLQ,CMQ ----
!
      CLQWSB=(.5+2.*DCMCLQ)*CCLAL*MACOE/CBARR
      IF(TRANSN)CLQWT=CLQWSB
      IF(TRANSN)MACH=TRA(6)
      CMQ2=-0.7*CLASM*COSLC4*(ASTRW*(.5*DCMDCL+2.*DCMDCL**2)/(ASTRW+2.* &
     &    COSLC4)+ASTRW**3*TANLC4**2/((ASTRW+6.*COSLC4)*24.)+.125)*SW/SR&
     &    *(MACOE/CBARR)**2
      IF(MACH.GT.0.2)GO TO 1000
      CMQWSB=CMQ2
      GO TO 1010
 1000 BEE=SQRT(1.-MACH**2*COSLC4**2)
      SAVE=ASTRW**3*TANLC4**2
      CMQWSB=((SAVE/(ASTRW*BEE+6.*COSLC4)+3./BEE)/(SAVE/(ASTRW+6.*COSLC4&
     &       )+3.))*CMQ2
      IF(TRANSN)CMQMFB=CMQWSB
      IF(TRANSN)MACH=FLC(IM+2)
      IF(MACH.GT.1.)GO TO 1020
!
!    ---- WING ACCELERATION DERIVATIVES,CLAD,CMAD ----
!
 1010 IF(LAMDA.NE.0.)GO TO 1020
      BETA=SQRT(1.-MACH**2)
      TEST=BETA*ASTRW
      IF(TEST.GT.4.)GO TO 1020
      IF(TRANSN)XACCR=TRA(105)
!
!           -- FIGURE 7.1.4.1-6 --
!
      CALL INTERX(1,X21416,TEST,I21416,Y71416,BPIAO2,8,8,               &
     &            0,0,0,0,0,0,0,0,Q71416,3,ROUTID)
      CLG=0.
      IF(BETA .NE. 0.)CLG=BPIAO2*PI*ASTRW/(-2.*BETA**2)
      EXPID=SW*MACOE/(SR*CBARR)
      CLADWL=(1.5*XACCR*CCLAL*SR/SW+CLG/19.1  )*EXPID
      IF(TRANSN)CLADWT=CLADWL
!
!           -- FIGURE 7.1.4.2-8 --
!
      CALL INTERX(1,X21428,TEST,I21428,Y71428,BCMPAW,9,9,               &
     &            0,0,0,0,0,0,0,0,Q71428,3,ROUTID)
      CMOG=0.
      IF(BETA .NE. 0.)CMOG=BCMPAW*ASTRW*0.5*PI/BETA**2
      CMADPP=(-2.53125*XACCR**2*CCLAL*SR/SW+.078532*CMOG)*EXPID         &
     &       *MACOE/CBARR
      CMADWL=CMADPP+(DXCG/CBARR)*CLADWL
 1020 CONTINUE
      RETURN
      END
      SUBROUTINE SUBREA(LLOC, LANS)
!
!***  FORCE A REAL INTO AN EXTERNAL ARRAY
!
      REAL LLOC,LANS
!
      LLOC=LANS
!
      RETURN
      END
      SUBROUTINE SUBRYW
!
!     THIS ROUTINE YIELDS THE SUBSONIC WING,WING-BODY
!     ROLLING DERIVATIVES,CLP CNP CNR  AND
!     YAWING DERIVATIVE , CYP
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /WINGD/  A(195),B(49)
      COMMON /WINGI/  WINGIN(77)
      COMMON /IWING/  PWING, WING(400)
      COMMON /POWR/   DYN(213)
      COMMON /WHAERO/ C(51)
      COMMON /SBETA/  STB(135)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      INTEGER Y71336,D11336,D21336,D31336,Y71337,D11337,D21337,D31337,  &
     & Y2220A,D1220A,D2220A,Y2220B,Y2220C,Y2220D,D1220D,D2220D,Y12224,  &
     & Y12312,Y1219B,Y1219C
      INTEGER Y7133A
      REAL LAMCO4,MACOE
      REAL MACH,LAMB,KAY(20),K,LAMDA
      DIMENSION ROUTID(2),ALMALO(20)
      DIMENSION CL(20),ALSCHD(20),Z(6),CLSUB(20),ALSCH2(20),CD(20),     &
     &          DCLPD(20),CLPWBS(20),CLTAN(20),CDCDO(20),CL2PAW(20)
      DIMENSION Y(6),D(6),E(6),G(6),H(6),O(6),P(6)
      DIMENSION CLA(20),DCDDA(20),DCADA(20)
      DIMENSION CLPTAN(20),DCLDA(20),CDOO(20)
      DIMENSION CYPWBS(20),I2A219(4),QEXPD(5),                          &
     &          QIMPR1(4),QIMPR2(4),QIMPR3(4),Q71336(3),Q71337(3)
      DIMENSION X11336(4),X21336(15),X31336(3),Y71336( 90),             &
     &          D11336(30),D21336(30),D31336(30)
      DIMENSION X1133A(2),X2133A(2),Y7133A(2)
      DIMENSION X11337(4),X21337(9),X31337(3),Y71337( 54),              &
     &          D11337(18),D21337(18),D31337(18)
      DIMENSION X1220A( 13),X2220A( 17),Y2220A( 111),Q2220A(3)
      DIMENSION D1220A( 97),D2220A(14)
      DIMENSION X1220B( 13),X2220B( 10),Y2220B(  65),Q2220B(3)
      DIMENSION X1220C( 13),X2220C( 10),Y2220C(  65),Q2220C(3)
      DIMENSION X1220D( 13),X2220D( 18),Y2220D( 117),Q2220D(3)
      DIMENSION D1220D( 97),D2220D(20)
      DIMENSION X12224(  8),X22224( 10),Y12224(  40),Q12224(3)
      DIMENSION X12312(  6),X22312(  8),Y12312(  24),Q12312(3)
      DIMENSION X1219A( 10),Y1219A(  10),Q1219A(3)
      DIMENSION X1219B(  8),X2219B(  2),Y1219B(   8),Q1219B(3)
      DIMENSION X1219C(  3),X2219C(  2),Y1219C(   3),Q1219C(3)
      DIMENSION CNPWBS(20)
      DIMENSION CNRWBS(20)
      EQUIVALENCE(DCMDCL,DYN(21)),(MACOE,A(16))
      EQUIVALENCE(CL(1),WING(21)),(THETA,WINGIN(11))
      EQUIVALENCE(ZW,SYNA(3)),(ZCG,SYNA(5)),(GEG,STB(122)),             &
     & (ALSCHD(1),FLC(23)),(SSPN,WINGIN(4)),(SSPNE,WINGIN(3)),          &
     & (LAMCO4,A(64)),(SW,A(4)),(TANCO4,A(68)),                         &
     & (LAMDA,A(27)),(COSLO4,A(67)),(CD(1),WING(1)),(ASTRW,A(120))
      EQUIVALENCE(ALSD,DYN(44)),(CLACLO,DYN(45)),(CDO,DYN(94)),         &
     & (CLA(1),DYN(47)),(ZEE,DYN(67)),(CLPCLP,DYN(68)),                 &
     & (CLPCL2,DYN(69)),(BAOK,DYN(70)),(BCLPCL,DYN(71)),                &
     & (DCLPD(1),DYN(72)),(CLPWBS(1),WING(281)),(CNPCLO,DYN(92)),       &
     & (BEE,DYN(93)),(CNPCLM,DYN(46)),(CNPTHE,DYN(95)),                 &
     & (DCLDA(1),DYN(96)),(DCDDA(1),DYN(116)),(DCADA(1),DYN(136)),      &
     & (KAY(1),DYN(156)),(CNPWBS(1),WING(321))
      EQUIVALENCE(CLPG,DYN(176)),(DCYPG,DYN(177)),(TRANS,DYN(178)),     &
     & (CHANGE,DYN(179)),(CYPCLM,DYN(180)),(CYPWBS(1),WING(301)),       &
     & (TRADE,DYN(181)),(CNRCL2,DYN(182)),(CNRCDO,DYN(183)),            &
     & (CDOO(1),DYN(184)),(CNRWBS(1),WING(341))
      EQUIVALENCE (D11336(1),Y71336(1)),(D21336(1),Y71336(31)),         &
     & (D31336(1),Y71336( 61))
      EQUIVALENCE (D11337(1),Y71337(1)),(D21337(1),Y71337(19)),         &
     & (D31337(1),Y71337(37))
      EQUIVALENCE(D1220A(1),Y2220A(1)),(D2220A(1),Y2220A( 98))
      EQUIVALENCE(D1220D(1),Y2220D(1)),(D2220D(1),Y2220D( 98))
      DATA ROUTID /4HSUBR,4HYW  /
      DATA I2A219 /10,3*0/
      DATA IN/0/, IX/0/, IO/0/, IP/0/, IQ/0/, IR/0/, IS/0/, IT/0/
      DATA QEXPD  /4HEXPE,4HRIME,4HNTAL,4H DAT,4HA   /
      DATA Q12224 /4H7.1.,4H2.2-,4H24  /
      DATA Q12312 /4H7.1.,4H2.3-,4H12  /
      DATA QIMPR1 /4HCLTA,4HN VS,4H ALS,4HCHD /
      DATA QIMPR2 /4HCDCD,4HO VS,4H ALS,4HCHD /
      DATA QIMPR3 /4HCL2P,4HAW V,4HS AL,4HSCHD/
      DATA Q71336 /4H7.1.,4H3.3-,4H6   /
      DATA Q71337 /4H7.1.,4H3.3-,4H7   /
!
!      ----FIGURE 7.1.2.2-20A
!
      DATA Q2220A /4H7.1.,4H2.2-,4H20A /
      DATA X1220A /  .100E+02,  .900E+01,  .800E+01,  .700E+01,         &
     &  .600E+01,  .500E+01,  .450E+01,  .400E+01,  .350E+01,  .300E+01,&
     &  .250E+01,  .200E+01,  .150E+01/
      DATA X2220A / -.193E+02, -.989E+01, -.437E+01,  .134E-01,         &
     &  .104E+02,  .143E+02,  .203E+02,  .251E+02,  .300E+02,  .355E+02,&
     &  .402E+02,  .445E+02,  .505E+02,  .547E+02,  .598E+02,  .651E+02,&
     &  .702E+02/
!
!      ----FIGURE 7.1.2.2-20B
!
      DATA Q2220B/4H7.1.,4H2.2-,4H20B /
      DATA X1220B/  .100E+02,  .900E+01,  .800E+01,  .700E+01,          &
     &  .600E+01,  .500E+01,  .450E+01,  .400E+01,  .350E+01,  .300E+01,&
     &  .250E+01,  .200E+01,  .150E+01/
      DATA X2220B/ -.201E+02, -.105E+02,  .230E+00,  .994E+01,          &
     &  .197E+02,  .300E+02,  .403E+02,  .499E+02,  .604E+02,  .703E+02/
!
!      ----FIGURE 7.1.2.2-20C
!
      DATA Q2220C/4H7.1.,4H2.2-,4H20C /
      DATA X1220C/  .100E+02,  .900E+01,  .800E+01,  .700E+01,          &
     &  .600E+01,  .500E+01,  .450E+01,  .400E+01,  .350E+01,  .300E+01,&
     &  .250E+01,  .200E+01,  .150E+01/
      DATA X2220C/ -.193E+02, -.937E+01,  .893E-01,  .105E+02,          &
     &  .208E+02,  .304E+02,  .405E+02,  .505E+02,  .607E+02,  .704E+02/
!
!      ----FIGURE 7.1.2.2-20D
!
      DATA Q2220D/4H7.1.,4H2.2-,4H20D /
      DATA X1220D/  .100E+02,  .900E+01,  .800E+01,  .700E+01,          &
     &  .600E+01,  .500E+01,  .450E+01,  .400E+01,  .350E+01,  .300E+01,&
     &  .250E+01,  .200E+01,  .150E+01/
      DATA X2220D/ -.200E+02, -.965E+01, -.458E+01,  .293E-01,          &
     &  .556E+01,  .995E+01,  .148E+02,  .203E+02,  .245E+02,  .301E+02,&
     &  .354E+02,  .400E+02,  .447E+02,  .502E+02,  .553E+02,  .602E+02,&
     &  .646E+02,  .698E+02/
!
!      ----FIGURE 7.1.2.2-24
!
      DATA X12224/  .700E+02,  .600E+02,  .500E+02,  .400E+02,          &
     &  .300E+02,  .200E+02,  .100E+02,  .000E+00/
      DATA X22224/  .196E+01,  .252E+01,  .302E+01,  .350E+01,          &
     &  .402E+01,  .505E+01,  .599E+01,  .700E+01,  .804E+01,  .100E+02/
!
!      ----FIGURE 7.1.2.3-12
!
      DATA X12312/  .100E+01,  .800E+00,  .600E+00,  .400E+00,          &
     &  .200E+00,  .000E+00/
      DATA X22312/  .202E+01,  .307E+01,  .404E+01,  .502E+01,          &
     &  .603E+01,  .808E+01,  .100E+02,  .120E+02/
!
!      ----FIGURE 7.1.2.1-9A
!
      DATA Q1219A/4H7.1.,4H2.1-,4H9A  /
      DATA X1219A/  .822E+00,  .109E+01,  .144E+01,  .207E+01,          &
     &  .257E+01,  .316E+01,  .398E+01,  .462E+01,  .531E+01,  .600E+01/
      DATA Y1219A/  .452E+01,  .381E+01,  .297E+01,  .215E+01,          &
     &  .147E+01,  .966E+00,  .486E+00,  .279E+00,  .117E+00,  .154E-06/
!
!      ----FIGURE 7.1.2.1-9B
!
      DATA Q1219B/4H7.1.,4H2.1-,4H9B  /
      DATA X1219B/  .700E+02,  .650E+02,  .600E+02,  .450E+02,          &
     &  .300E+02,  .000E+00, -.300E+02, -.450E+02/
      DATA X2219B/ 0.0,4.5/
!
!      ----FIGURE 7.1.2.1-9C
!
      DATA Q1219C/4H7.1.,4H2.1-,4H9C  /
      DATA X1219C/  .000E+00,  .500E+00,  .100E+01/
      DATA X2219C/  .453E+01, -.963E+00/
      DATA X11336/  .600E+02,  .500E+02,  .400E+02,  .000E+00/
      DATA X21336/  .101E+01,  .126E+01,  .151E+01,  .178E+01,          &
     &  .201E+01,  .244E+01,  .299E+01,  .352E+01,  .400E+01,  .501E+01,&
     &  .599E+01,  .698E+01,  .799E+01,  .902E+01,  .994E+01/
      DATA X31336/0.0,0.2,0.4/
!
!      ----FIGURE 7.1.3.3-6D
!
      DATA X1133A /0.0,1.0/
      DATA X2133A /0.0,4.0/
      DATA X11337 /  .000E+00,  .400E+02,  .500E+02,  .600E+02/
      DATA X21337 /  .103E+01,  .144E+01,  .197E+01,  .297E+01,         &
     &  .397E+01,  .503E+01,  .606E+01,  .706E+01,  .803E+01/
      DATA X31337 /0.0,0.2,0.4/
!
!        IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
!        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
!
!        THE FORMAT IS AS FOLLOWS-
!
!        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
!
!        WHERE-
!
!        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
!        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
!        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
!             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
!        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
!        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
!        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
!        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
!
      DATA D11336/  122392378,  122366359,  122352345,  122335325,      &
     &  122320318,  122314315,  122313316,  122317157,  122167177,      &
     &  122181187,  122204212,  122218226,  122234241,  122241242,      &
     &  122240239,  133758974,  122116132,  122142160,  122176185,      &
     &  122200209,  122216221,  122224222,  124225341,  133325655,      &
     &  132872102,  122127147,  122160173,  122189201,  122206206,      &
     &  122207205/
      DATA D21336/  122762654,  122584539,  122499463,  122436427,      &
     &  122418408,  122404404,  122402403,  122403381,  122349331,      &
     &  122322312,  122300299,  122297295,  122290289,  122282283,      &
     &  122279279,  122253253,  122253253,  122253256,  122258261,      &
     &  122265270,  122273273,  122272272,  122268175,  122180185,      &
     &  122191196,  122209218,  122222229,  122245253,  122255260,      &
     &  122261261/
      DATA D31336/  111160130,  122950630,  122572509,  122462437,      &
     &  122416388,  122379371,  122370371,  121373150,  122450447,      &
     &  122369347,  112112630,  122291284,  122281278,  122280281,      &
     &  122280283,  122351293,  122272247,  122242230,  122225225,      &
     &  122224223,  122222228,  122236242,  123259951,  132994111,      &
     &  122125130,  122141159,  122169178,  122196204,  122206206,      &
     &  122206205/
      DATA D11337/-1133563462,-1133383332,-1133310299,-1133293293,      &
     &-1133293569,-1133501468,-1133451456,-1133456456,-1133456451,      &
     &-1133670644,-1133608608,-1133619631,-1133631637,-1133642975,      &
     &-1133953952,-1132979101,-1122102103,-1122103103/
      DATA D21337/-1133743503,-1133440371,-1133331297,-1133291291,      &
     &-1133291759,-1133560480,-1133457451,-1133457457,-1133463469,      &
     &-1133806669,-1133623606,-1133611623,-1133634640,-1132646106,      &
     &-1133985949,-1133971988,-1122101101,-1122102102/
      DATA D31337/-1133978712,-1133518417,-1133364346,-1133340334,      &
     &-1132340102,-1133712538,-1133500472,-1133465465,-1133471471,      &
     &-1123107796,-1133664614,-1133626638,-1133644650,-1132656121,      &
     &-1123104979,-1132995101,-1122101103,-1122104105/
      DATA D1220A/-1133347366,-1133375377,-1133379378,-1133376372,      &
     &-1133361354,-1133338321,-1133298280,-1133248215,-1133177339,      &
     &-1133357361,-1133365369,-1133368363,-1133359353,-1133339325,      &
     &-1133308288,-1133267237,-1133211175,-1133326340,-1133345353,      &
     &-1133355355,-1133353347,-1133339329,-1133316301,-1133281258,      &
     &-1133230206,-1133170310,-1133323329,-1133334338,-1133338336,      &
     &-1133332326,-1133319305,-1133290268,-1133251227,-1133198169,      &
     &-1133289303,-1133307311,-1133318318,-1133316310,-1133305298,      &
     &-1133287276,-1133256241,-1133214192,-1133160267,-1133283286,      &
     &-1133289289,-1133292289,-1133286284,-1133280268,-1133261247,      &
     &-1133230208,-1133184157,-1133254266,-1133273277,-1133281281,      &
     &-1133279277,-1133270267,-1133259250,-1133233222,-1133198179,      &
     &-1133151242,-1133250255,-1133261263,-1133263263,-1133262256,      &
     &-1133253247,-1133241228,-1133214193,-1133175150,-1133227232,      &
     &-1133238242,-1133245246,-1133245243,-1133239233,-1133230224,      &
     &-1133212203,-1133184169,-1133140205,-1133211214,-1133216220,      &
     &-1133222222,-1133222219,-1133218213,-1133209198,-1133192176,      &
     &-1133159139,-1133184190,-1133191193,-1133194194,-1133195195,      &
     &-1133194193,-1133193191,-1133184176,-1133161151,-1133131159,      &
     &-1133162164,-1133164168,-1133169169/
      DATA D2220A/-1133169169,-1133165164,-1133161157,-1133156150,      &
     &-1133137120,-1133133132,-1133133134,-1133133134,-1133133133,      &
     &-1133133134,-1133133132,-1133129124,-1133120114, -330102000/
      DATA Y2220B/-1133464486,-1133500494,-1133484457,-1133419364,      &
     &-1133298218,-1133445465,-1133479473,-1133463441,-1133407354,      &
     &-1133291215,-1133428444,-1133450449,-1133437419,-1133388344,      &
     &-1133287209,-1133407414,-1133422422,-1133415398,-1133372331,      &
     &-1133276202,-1133375386,-1133391392,-1133385377,-1133353320,      &
     &-1133270199,-1133340353,-1133358358,-1133353342,-1133325296,      &
     &-1133255189,-1133325330,-1133334334,-1133331324,-1133310299,      &
     &-1133247190,-1133300304,-1133312307,-1133305301,-1133288270,      &
     &-1133237183,-1133278280,-1133282282,-1133281276,-1133268251,      &
     &-1133221178,-1133245248,-1133251251,-1133250248,-1133241232,      &
     &-1133208167,-1133221221,-1133222221,-1133220217,-1133215206,      &
     &-1133192161,-1133183182,-1133182181,-1133180180,-1133178174,      &
     &-1133162140,-1133138139,-1133141141,-1133141141,-1133142141,      &
     &-1133134124/
      DATA Y2220C/-1133523535,-1133539534,-1133519496,-1133456407,      &
     &-1133337245,-1133503509,-1133513505,-1133499475,-1133441390,      &
     &-1133317234,-1133470483,-1133486483,-1133470454,-1133421375,      &
     &-1133312228,-1133445451,-1133453451,-1133445428,-1133400355,      &
     &-1133298223,-1133410415,-1133420414,-1133409392,-1133370338,      &
     &-1133287213,-1133371376,-1133377375,-1133371358,-1133338314,      &
     &-1133269204,-1133343349,-1133354353,-1133349339,-1133321299,      &
     &-1133260204,-1133320320,-1133322322,-1133319316,-1133300280,      &
     &-1133245199,-1133293297,-1133298297,-1133295286,-1133278264,      &
     &-1133238189,-1133264264,-1133263264,-1133262259,-1133248239,      &
     &-1133220180,-1133226226,-1133225226,-1133224222,-1133219207,      &
     &-1133191165,-1133188188,-1133189187,-1133186186,-1133180172,      &
     &-1133163145,-1133149149,-1133149149,-1133148147,-1133146142,      &
     &-1133134121/
      DATA D1220D/-1133560573,-1133575575,-1133573567,-1133560546,      &
     &-1133539520,-1133502481,-1133461430,-1133398367,-1133335280,      &
     &-1133538545,-1133546546,-1133544542,-1133537525,-1133518501,      &
     &-1133484464,-1133446415,-1133384353,-1133319269,-1133508517,      &
     &-1133519517,-1133515512,-1133507499,-1133487475,-1133462442,      &
     &-1133425396,-1133367339,-1133305266,-1133469477,-1133480480,      &
     &-1133477471,-1133469463,-1133454448,-1133434418,-1133401376,      &
     &-1133350321,-1133290246,-1133431434,-1133435435,-1133433431,      &
     &-1133428423,-1133416409,-1133397383,-1133371350,-1133322299,      &
     &-1133273232,-1133385390,-1133391390,-1133389386,-1133384378,      &
     &-1133375368,-1133360353,-1133340325,-1133304284,-1133260224,      &
     &-1133359361,-1133361362,-1133362360,-1133360356,-1133354347,      &
     &-1133339334,-1133323307,-1133288271,-1133249216,-1133332334,      &
     &-1133334334,-1133333333,-1133331329,-1133325322,-1133317310,      &
     &-1133302290,-1133276257,-1133237208,-1133265266,-1133266266,      &
     &-1133266265,-1133265264,-1133262261,-1133258255,-1133250246,      &
     &-1133234222,-1133209183,-1133298300,-1133302302,-1133302301,      &
     &-1133300298,-1133298293,-1133289284,-1133280267,-1133255243,      &
     &-1133225197,-1133230230,-1133230230,-1133230231,-1133230230,      &
     &-1133229228,-1133224223,-1133219216/
      DATA D2220D/-1133208198,-1133188170,-1133189190,-1133190190,      &
     &-1133190189,-1133188187,-1133187184,-1133183181,-1133179175,      &
     &-1133171163,-1133156143,-1133148146,-1133146145,-1133145145,      &
     &-1133146146,-1133145145,-1133144142,-1133142141,-1133141139,      &
     &-1133135122/
      DATA Y12224/-1133407331,-1133278240,-1133216175,-1133146127,      &
     &-1134112891,-1133171137,-1133116103,-1144901734,-1144620532,      &
     &-1144456365,-1144918736,-1144606535,-1144467381,-1144344280,      &
     &-1144239183,-1144567428,-1144382349,-1144297232,-1144183177,      &
     &-1144160125,-1144400303,-1144267223,-1144193165,-1144149120,      &
     &-1144114103,-1144302225,-1144199187,-1144159131,-1145103856,      &
     &-1155683804,-1144230201,-1144165141,-1145136843,-1155686624,      &
     &-1155338463,-1144221179,-1144153141,-1145113850,-1155687398,      &
     &-1155341456/
      DATA Y12312/-1166968781,-1166626494,-1166388197, -176319113,      &
     &-1166941724,-1166541382, -168238339,  166218422,-1166885655,      &
     &-1166450256, -176949195,  166454705,-1166777520,-1166300113,      &
     &  176533337,  166590825,-1166548303, -177979781,  166231499,      &
     &  166724919, -176387127,  166264371,  166473661,  166827994/
      DATA Y1219B/ 122468642 , 122368554 , 122300494 , 122176413,       &
     & 122111372 , 132160292 , -132680236 ,-122168172/
      DATA Y1219C/ 1123153677, 1123161573 , 1123182380 /
      DATA Y7133A/-133110100,-134127830/
      BETA=B(2)
      IF( WGPL.AND.(.NOT.BO))GO TO 1000
      DB=(SSPN-SSPNE)/SSPN
      IF(DB.GT.0.3)RETURN
 1000 K=BETA*WINGIN(IM+20)*RAD/(2.*PI)
      MACH=FLC(IM+2)
      XYZ=0.
!
!     WING-BODY ROLLING DERIVATIVE,CLP---
!
      CALL TBFUNX(XYZ,ALSD,DYDX,NALPHA,CL,ALSCHD,Y,IN,MI,NG,1,1,QEXPD,5,&
     &            ROUTID)
      CALL TBFUNX(XYZ,CDO,DYDX,NALPHA,CL,CD,D,IO,MI,NG,2,2,             &
     &            QEXPD,5,ROUTID)
      IF(CL(1).LE.0..AND.CL(NALPHA).GE.0.) GO TO 1050
      NNALPH=NALPHA+1
      IF(CL(1).LT.0.) GO TO 1020
      CLSUB(1)=0.
      ALSCH2(1)=ALSD
      DO 1010 J=1,NALPHA
         CLSUB(J+1)=CL(J)
 1010 ALSCH2(J+1)=ALSCHD(J)
      GO TO 1040
 1020 CLSUB(NNALPH)=0.
      ALSCH2(NNALPH)=ALSD
      DO 1030 J=1,NALPHA
         CLSUB(J)=CL(J)
 1030 ALSCH2(J)=ALSCHD(J)
 1040 CALL TBFUNX(ALSD,ABCD,CLACLO,NNALPH,ALSCH2,CLSUB,E,IX,MI,         &
     &            NG,1,1,QEXPD,5,ROUTID)
      GO TO 1060
 1050 CALL TBFUNX(ALSD,ABCD,CLACLO,NALPHA,ALSCHD,CL,Z,IX,MI,            &
     &            NG,1,1,QEXPD,5,ROUTID)
 1060 CONTINUE
      XBOCB=-DCMDCL*CBARR/MACOE
      DO 1070 I=1,NALPHA
         CALL TBFUNX(ALSCHD(I),CDEF,CLA(I),NALPHA,ALSCHD,CL,G,IQ,MI,NG, &
     &               0,0,QEXPD,5,ROUTID)
 1070 END DO
      ZEE=ZW-ZCG
      SINGEG=SIN(GEG/RAD)
      CLPCLP=1.-2.*ZEE*SINGEG/SSPN+3.*(ZEE/SSPN)**2*SINGEG**2
      LAMB=RAD*ATAN(TANCO4/BETA)
!
!           -- FIGURE 7.1.2.2-24 --
!
      CALL TLIP2X(X12224,X22224,Y12224,8,10,LAMCO4,ASTRW,CLPCL2,        &
     &            1,1,1,1,Q12224,3,ROUTID)
      SRSW=SR/SW
      AAAA=4.*SSPN**2/(RAD*SRSW*BLREF**2)
      BAOK  =BETA*ASTRW/K
!
!              FIGURE 7.1.2.2-20 A-D
!
      CALL INTEP3(BAOK,LAMB,LAMDA,X1220A,X2220A,Y2220A,13,17,Q2220A,    &
     &            X1220B,X2220B,Y2220B,13,10,Q2220B,                    &
     &            X1220C,X2220C,Y2220C,13,10,Q2220C,                    &
     &            1,1,1,1,1,1,                                          &
     &            X1220D,X2220D,Y2220D,13,18,Q2220D,BCLPCL)
      BBBB=AAAA*BCLPCL*K*CLPCLP/(BETA*CLACLO)
      DO 1080 I=1,NALPHA
         CLT=CL(I)*SRSW
         DCLPD(I)=CLPCL2*CLT**2-CDO/8.*SRSW
         CLPWBS(I)=BBBB*CLA(I)+AAAA*DCLPD(I)
 1080 END DO
!
!     ---WING-BODY ROLLING DERIVATIVE,CNP---
!
      DO 1090 I=1,NALPHA
 1090 ALMALO(I) = ALSCHD(I)-ALSD
      BEE=SQRT(1.-MACH**2*COSLO4**2)
      CCCC=(ASTRW+4.*COSLO4)/(ASTRW*BEE+4.*COSLO4)
      DDDD=(ASTRW*BEE+.5*(ASTRW*BEE+COSLO4)*TANCO4**2)
      EEEE=ASTRW+.5*(ASTRW+COSLO4)*TANCO4**2
      IF(CL(I).EQ.0.0)GO TO 1100
      CNPCLO=-(ASTRW+6.*(ASTRW+COSLO4)*(XBOCB*TANCO4/ASTRW+TANCO4**2/12.&
     &        ))/((ASTRW+4.*COSLO4)*6.)
      CNPCLM   =CCCC*DDDD*CNPCLO/EEEE
      GO TO 1110
 1100 CNPCLM=0.
 1110 CONTINUE
      DO 1120 I=1,NALPHA
         CLTAN(I)=CL(I)*SRSW*TAN(ALMALO(I)/RAD)
         CDCDO(I)=(CD(I)-CDO)*SRSW
         CL2PAW(I)=(CL(I)*SRSW)**2/(ASTRW*PI)
 1120 END DO
!
!           -- FIGURE 7.1.2.3-12 --
!
      CALL TLIP2X(X12312,X22312,Y12312,6, 8,LAMDA,ASTRW,CNPTHE,2,1,2,1, &
     &            Q12312,3,ROUTID)
      CNP=CNPTHE*THETA
      FFFF=AAAA*BLREF/(2.*SSPN)
      DO 1150 I=1,NALPHA
         CLPTAN(I)=CLPWBS(I)*TAN(ALMALO(I)/RAD)
         IF(CL(I).EQ.0.0)GO TO 1130
         CALL TBFUNX(ALSCHD(I),ABC,DCLDA(I),NALPHA,ALSCHD,CLTAN,H,IR,   &
     &               MI,NG,1,1,QIMPR1,4,ROUTID)
         CALL TBFUNX(ALSCHD(I),ABC,DCDDA(I),NALPHA,ALSCHD,CDCDO,O,IS,   &
     &               MI,NG,1,1,QIMPR2,4,ROUTID)
         CALL TBFUNX(ALSCHD(I),ABC,DCADA(I),NALPHA,ALSCHD,CL2PAW,P,IT,  &
     &               MI,NG,1,1,QIMPR3,4,ROUTID)
         KAY(I)=(DCLDA(I)-DCDDA(I))/(DCLDA(I)-DCADA(I))
         GO TO 1140
 1130    CONTINUE
         KAY(I)=1.
 1140    CONTINUE
         CNPWBS(I)=(KAY(I)-1.)*CLPTAN(I)+(KAY(I)*(CNPCLM*CL(I)*SRSW)    &
     &             +CNP)*AAAA
 1150 END DO
!
!     WING-BODY YAWING DERIVATIVE,CYP---
!
      CLPG=BCLPCL*K/BETA
      DCYPG=(3.*SINGEG*(1.-2.*ZEE*SINGEG/SSPN))*CLPG
!
!           -- FIGURE 7.1.2.1-9  --
!
      CALL INTERX(1,X1219A,ASTRW,I2A219,Y1219A,TRANS,10,10,1,0,0,0,0,0  &
     &           ,0,0,Q1219A,3,ROUTID)
      CALL TLIP2X(X1219B,X2219B,Y1219B,8,2,LAMCO4,TRANS,CHANGE,1        &
     &           ,1,1,1,Q1219B,3,ROUTID)
      CALL TLIP2X(X1219C,X2219C,Y1219C,3,2,LAMDA,CHANGE,CYPCLO,         &
     &            0,0,1,1,Q1219C,3,ROUTID)
      AABB=ASTRW+4.*COSLO4
      BBCC=ASTRW*BEE+4.*COSLO4
      CCDD=ASTRW*BEE+COSLO4
      DDEE=ASTRW+COSLO4
      CYPCLM=AABB*CCDD*CYPCLO/(BBCC*DDEE)
      FFPG=FFFF*DCYPG
      DO 1160 I=1,NALPHA
         CYPWBS(I)=FFPG+FFFF*CYPCLM*SRSW*KAY(I)*CL(I)
 1160 END DO
!
!     WING-BODY ROLLING DERIVATIVE,CNR---
!          --- FIGURE 7.1.3.3-7  --
!           -- FIGURE 7.1.3.3-6  --
!
      CALL TLIP3X(X11336,X21336,X31336,Y71336,4,15,3,LAMCO4,ASTRW,XBOCB,&
     &            TRADE,0,1,0,2,1,1,Q71336,3,ROUTID)
      CALL TLIP2X(X1133A,X2133A,Y7133A,2,2,LAMDA,TRADE,CNRCL2,0,1,0,1,  &
     &            Q71336,3,ROUTID)
      CALL TLIP3X(X11337,X21337,X31337,Y71337,4, 9,3,ABS(LAMCO4),       &
     &            ASTRW,XBOCB,CNRCDO,0,1,0,2,1,1,Q71337,3,ROUTID)
      DO 1170 I=1,NALPHA
         CDOO(I)=CD(I)*SRSW-CL2PAW(I)
         CNRWBS(I)=AAAA*((CNRCL2*(CL(I)*SRSW)**2)+CNRCDO*CDOO(I))
 1170 END DO
      RETURN
      END
      SUBROUTINE SUBWBT
!
!     THIS ROUTINE YIELDS THE FOLLOWING WING-BODY-TAIL DERIVATIVES-
!       SUBSONIC    CYP    (YAW)
!                   CNP    (ROLL)
!                   CNR    (ROLL)
!
      REAL MACH,LP,LPF
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /SBETA/  STB(135),TRA(108),TRAH(108),STBH(135)
      COMMON /IBWHV/  PBWHV,BWHV(380)
      COMMON /IBWV/   PBWV,BWV(380)
      COMMON /IBWH/   PBWH,BWH(380)
      COMMON /IHT/    PHT,HT(380)
      COMMON /IBW/    PBW,BW(380)
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /IVT/    PVT,VT(380)
      COMMON /IVF/    PVF,VF(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      DIMENSION ROUTID(2)
      DIMENSION ALSCHD(20),CYPWBT(20),CYPWBS(20),CNPWBT(20),            &
     &          CNPWBS(20),CNRWBT(20),CNRWBS(20)
      EQUIVALENCE(CYPWBT(1),BWHV(301)),(CNPWBT(1),BWHV(321)),           &
     &  (CNRWBT(1),BWHV(341)),(CYPWBS(1),BW(301)),(CNPWBS(1),BW(321)),  &
     &  (CNRWBS(1),BW(341))
      EQUIVALENCE (ALSCHD(1),FLC(23)),(ZP,STB(12)),(LP,STB(11)),        &
     &  (DYBV,VT(141)),(ZPF,STBH(12)),(LPF,STBH(11)),(DYBF,VF(141))
      DATA ROUTID/4HSUBW,4HBT  /
      DO 1030 I=1,NALPHA
         COSAL=COS(ALSCHD(I)/RAD)
         SINAL=SIN(ALSCHD(I)/RAD)
         IF(.NOT. VTPL) GO TO 1010
         ZEE=ZP*COSAL-LP*SINAL
         VT(I+300)=2.*(ZEE-ZP)*DYBV/BLREF
         ABCDE=LP*COSAL+ZP*SINAL
         VT(I+320)=-(ABCDE*2.*(ZEE-ZP))*DYBV/BLREF**2
         VT(I+340)=2.* ABCDE**2*DYBV/BLREF**2
 1010    CONTINUE
         IF(.NOT. VFPL)GO TO 1020
         ZEE=ZPF*COSAL-LPF*SINAL
         VF(I+300)=(2.*ZEE-ZPF)*DYBF/BLREF
         ABCDE=LPF*COSAL+ZPF*SINAL
         VF(I+320)=-(2.*ABCDE*(ZEE-ZPF))*DYBF/BLREF**2
         VF(I+340)= 2.*ABCDE**2*DYBV/BLREF**2
 1020    CONTINUE
!
!   GET IOM INCREMENT FOR V.T. TO CYP, CNP AND CNR
!   SET IOM INCREMENT FOR H.T. TO ZERO
!
         BWHV(I+300) = BW(I+300) + VT(I+300) + VF(I+300)
         BWHV(I+320) = BW(I+320) + VT(I+320) + VF(I+320)
         BWHV(I+340) = BW(I+340) + VT(I+340) + VF(I+340)
         HT(I+300) = 0.0
         HT(I+320) = 0.0
         HT(I+340) = 0.0
!
!   ACTUALLY B-W-H-V IS THE SAME AS B-W-V
!
         BWV(I+300) = BWHV(I+300)
         BWV(I+320) = BWHV(I+320)
         BWV(I+340) = BWHV(I+340)
!
!   ACTUALLY B-W-H IS THE SAME AS B-W
!
         BWH(I+300) = BW(I+300)
         BWH(I+320) = BW(I+320)
         BWH(I+340) = BW(I+340)
 1030 END DO
      RETURN
      END
      SUBROUTINE SUPCLD
!
!  THIS ROUTINE YIELDS THE SUPERSONIC WING ACCELERATION DERIVATIVE,CLAD
!
      INTEGER Y14111,D14111,D24111,D34111,D3A111,Y1A111,D1A111,D2A111
      REAL MACOE
      REAL MACH,LSTAR,LAMDA
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /SUPWH/  SLG(141)
      COMMON /POWR/   DYN(213)
      COMMON /WINGD/  A(195)
      COMMON /IWING/  PWING, WING(400)
      COMMON /WINGI/  WINGIN(101)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,       &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      DIMENSION ROUTID(2)
      DIMENSION Q71417(3),Q14111(3)
      DIMENSION I2A417(4),I2B417(4),I2C417(4)
      DIMENSION X2A417(16),Y1A417(16)
      DIMENSION X2B417(26),Y1B417(26)
      DIMENSION X2C417(15),Y1C417(15)
      DIMENSION X24111(15),X14111(7),X34111(5),Y14111(263)
      DIMENSION D14111( 99),D24111( 95),D34111(69)
      DIMENSION X2A111(15),X1A111(7),X3A111(5),Y1A111(263)
      DIMENSION D1A111( 99),D2A111( 95),D3A111( 69)
      EQUIVALENCE (D14111(1),Y14111(1)),(D24111(1),Y14111(100))
      EQUIVALENCE (D34111(1),Y14111(195))
      EQUIVALENCE (D1A111(1),Y1A111(1)),(D2A111(1),Y1A111(100))
      EQUIVALENCE (D3A111(1),Y1A111(195))
      EQUIVALENCE (MACOE,A(16)),(LSTAR,A(29)),                          &
     &            (XACCR,SLG(134)),(CRSTR,A(10)),                       &
     &            (ASTRW,A(7)),(LAMDA ,A(27)),(BETA,SLG(1)),            &
     &            (TANLE,A(62)),(SW,A(3))
      EQUIVALENCE (EPPBC,DYN(9)),(GBC,DYN(10)),(XACCRB,DYN(14)),        &
     &       (F2N,DYN(24)),(F3X,DYN(25)),(F1N,DYN(23)),(CLAD1,DYN(22)), &
     &       (CLAD2,DYN(16)),(CLADWH,WING(241))
      DATA Q71417 /4H7.1.,4H4.1-,4H7   /
      DATA Q14111 /4H7.1.,4H4.1-,4H11  /
      DATA I2A417 /16,3*0/, I2B417 /26,3*0/, I2C417 /15,3*0/
!
!                       FIGURE 7141-7  F1(N)
!
      DATA X2A417                                                       &
     & / -1., -.8, -.6, -.4, -.2, 0., .2, .4, .5, .6, .7, .8, .85, .9,  &
     &    .95, 1.0  /
      DATA Y1A417                                                       &
     & / 1.7, 1.57, 1.42, 1.3, 1.17, 1., .87, .7, .65, .56, .45, .37,   &
     &   .33, .23, .2, 0. /
!
!                      FIGURE 7141-7  F2(N)
!
      DATA X2B417                                                       &
     & / -1., -.9, -.8, -.7, -.6, -.5, -.4, -.3, -.2, -.1, 0., .1, .2,  &
     &   .3, .4, .45, .5, .55, .6, .65, .7, .75, .8, .85, .9, .95 /
      DATA Y1B417                                                       &
     & / 1.2, 1.19, 1.18, 1.17, 1.16, 1.14, 1.13, 1.1, 1.08, 1.05, 1.,  &
     &   1., 1., 1., 1.01, 1.03, 1.05, 1.07, 1.12, 1.15, 1.2, 1.28,     &
     &   1.37, 1.5, 1.75, 2.5  /
!
!                       FIGURE 7141-7 F3(X)
!
      DATA X2C417                                                       &
     & / -1.0, -.8, -.6, -.4, -.2, 0., .2, .3, .4, .5, .6, .7, .8, .85 ,&
     &     1./
      DATA Y1C417                                                       &
     & /.66, .7, .75, .83, .92,1.02,1.19,1.34,1.52,1.83,2.3,3.2,5.25,   &
     & 7.3 , 14. /
      DATA X24111/0.,8.,12.,16.,20.,24.,28.,32.,34.,36.,38.,40.,42.,44.,&
     &45./
      DATA X14111/3.,4.,5.,6.,8.,12.,20./
      DATA X34111/0.,.25,.5,.75,1./
      DATA X2A111/0.,8.,12.,16.,20.,24.,28.,32.,34.,36.,38.,40.,42.,44.,&
     &45./
      DATA X1A111/3.,4.,5.,6.,8.,12.,20./
      DATA X3A111/0.,.25,.5,.75,1./
!
!        IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
!        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
!
!        THE FORMAT IS AS FOLLOWS-
!
!        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
!
!        WHERE-
!
!        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
!        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
!        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
!             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
!        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
!        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
!        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
!        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
!
      DATA D14111/  203000220,  133300360,  133400440,  133470480,      &
     &  133480480,  133470460,  133430400,  330390000,  133190250,      &
     &  133300340,  133360360,  133340320,  133300270,  133210140,      &
     &  340600000,  203000170,  133220250,  133280270,  133250200,      &
     &  133160100, 1144400500,-1133130220, -330260000,  133150180,      &
     &  133200220,  133200140,  340500000,-1133100210,-1133390600,      &
     &-1132840100,  203000110,  133140140,  134110600,-1143400200,      &
     &-1133300460,-1133670990,-1122139190, -320220000,  144700700,      &
     & 1144400300,-1133200300,-1133600800,-1122120160,-1122220320,      &
     &-1122450500,  204000300,-1144100800,-1133210500,-1132700120,      &
     &-1122160210,-1122290460,-1121670105, -114132500,  133240290,      &
     &  133330350,  133350340,  133320300,  133300300,  133300300,      &
     &  133310310,  143300180,  133210220,  133210200,  134140500,      &
     & 1204000700,-1133150230,-1133300350, -134380300,  133140160,      &
     &  133150130, 1144800200,-1133170280,-1133400550,-1133690800,      &
     &-1133890920,  143200120,  114120100, 1144800200,-1133150370,      &
     &-1133510700,-1132920120,-1122142165, -124173100,  144800700,      &
     & 1144200500,-1133170370,-1133700940,-1122124165,-1122220279,      &
     &-1122320350,  144100400, 1204000700,-1133200400,-1132700120,      &
     &-1122150200,-1122280390,-1122530700, -320800000,-1144100600/
      DATA D24111/                                                      &
     &-1133170350,-1132500100,-1122170230,-1122320450,-1122650950,      &
     &-1111150197,  133240320,  133340350,  133330320,  133310340,      &
     &  133360380,  133410440,  133470500,  133510170,  133220220,      &
     &  133200160,  330100000,-1133100150,-1133200230,-1133230220,      &
     &-1133200190,  133110140,  113150120, 1144500500,-1133200440,      &
     &-1133570700,-1133790850,-1133910960, -124100900,  133120100,      &
     & 1144500300,-1133180400,-1133700910,-1122112132,-1122150166,      &
     &-1122180189,  143600100, 1144400400,-1133150340,-1132650100,      &
     &-1122150200,-1122250300,-1122330380, -124400400, 1144400300,      &
     &-1133130300,-1132600100,-1122160220,-1122300400,-1122530700,      &
     &-1122830920, 1144200100,-1143900220,-1133410700,-1122130210,      &
     &-1122300390,-1122550850,-1111126190, -113228360,  133400400,      &
     &  133380370,  133370390,  133430450,  133470520,  133560600,      &
     &  133630650,  133280280,  133250210,  134150600,-1143500130,      &
     &-1133160180,-1133200210,-1133220220, -133220200,  133200150,      &
     &  330100000,-1133130320,-1133550630,-1133700750,-1133820870,      &
     &-1133900920,  133150150,  134100300,-1133100270,-1133550900,      &
     &-1122106124,-1122140158,-1122172190, -123199120,  134100400,      &
     &-1143700220,-1133450800,-1122140180,-1122240300,-1122330370/
      DATA D34111/                                                      &
     &-1122400400,  144800400,-1143400160,-1133350700,-1122110200,      &
     &-1122260360,-1122490630,-1122770900, -124990400,-1143100100,      &
     &-1133250500,-1122100140,-1122240330,-1122480680,-1121980140,      &
     &-1111200245,  133440420,  133390380,  133370380,  133400400,      &
     &  133400400,                                                      &
     &  133420430,  133230160,  134100100,-1133150370,-1132670110,      &
     &-1122134156,-1122175193,-1122210230, -123240160,  134120400,      &
     &-1133100280,-1133550800,-1122150210,-1122260310,-1122350420,      &
     &-1122470500,  134120600,-1143400180,-1133400710,-1122130220,      &
     &-1122290390,-1122500660,-1121800100, -114110700, 1203000100,      &
     &-1133270520,-1132900140,-1122300430,-1122660950,-1111131178,      &
     &-1111235270,  133440450,  133460330,  133310280,  133200130,      &
     & 1144500600,-1133140180,-1133220250,-1133300320,-1133330350,      &
     &  133270230,  133180100,-1143400200,-1133420690,-1133800900,      &
     &-1122100110,-1122120128, -320130000/
      DATA D1A111/  122400385,  122378375,  122370365,  122365362,      &
     &  122362365,  122365366,  122368370,  122372400,  122388383,      &
     &  122380377,  122375375,  122376378,  122380382,  122385390,      &
     &  122395401,  122400389,  122386385,  122382382,  122382385,      &
     &  122390395,  122398405,  122410420,  122426400,  122391388,      &
     &  122387387,  122387390,  122396401,  122405411,  122421430,      &
     &  122444450,  122400393,  122392390,  122394396,  122402410,      &
     &  122417426,  122435450,  122467485,  122495400,  122396396,      &
     &  122397402,  122407417,  122432442,  122457470,  122495520,      &
     &  122555574,  122400399,  122400405,  122410420,  122435455,      &
     &  122470485,  122510552,  122605675,  122717394,  122385380,      &
     &  122378377,  122378379,  122382384,  122388391,  122394400,      &
     &  122406409,  122396389,  122386385,  122385390,  122391398,      &
     &  122402407,  122413420,  122430447,  122455398,  122393392,      &
     &  122393395,  122401410,  122420427,  122437448,  122461480,      &
     &  122500513,  122397391,  122390392,  122392395,  122401410,      &
     &  122416424,  122432442,  122455472,  122482398,  122395395,      &
     &  122398402,  122410420,  122435445,  122458474,  122498523,      &
     &  122558572,  122399398,  122400403,  122410420,  122432452,      &
     &  122467485,  122509540,  122582640,  122675399,  122400403/
      DATA D2A111/                                                      &
     &  122408416,  122429447,  122471488,  122512548,  122600675,      &
     &  122780840,  122381376,  122375375,  122377380,  122385390,      &
     &  122395400,  122403410,  122417425,  122429387,  122384384,      &
     &  122385387,  122395402,  122410417,  122425433,  122442454,      &
     &  122467475,  122391388,  122387390,  122395403,  122412425,      &
     &  122433445,  122455471,  122490508,  122520392,  122390390,      &
     &  122395400,  122408418,  122435446,  122459475,  122498520,      &
     &  122543557,  122395394,  122395400,  122406415,  122428450,      &
     &  122462480,  122505533,  122567602,  122625397,  122397400,      &
     &  122405412,  122425442,  122465483,  122507540,  122575625,      &
     &  122680720,  122398399,  122402410,  122418433,  122453483,      &
     &  122502530,  122574627,  122710850,  122935367,  122367368,      &
     &  122370373,  122379384,  122392395,  122400405,  122411419,      &
     &  122429433,  122377377,  122379382,  122387393,  122404416,      &
     &  122425432,  122440453,  122467480,  122488382,  122383385,      &
     &  122389395,  122403416,  122433444,  122456471,  122488506,      &
     &  122527539,  122386387,  122389393,  122400411,  122426445,      &
     &  122458473,  122492514,  122540566,  122580390,  122392395,      &
     &  122400408,  122420437,  122460476,  122496520,  122553592/
      DATA D3A111/                                                      &
     &  122633658,  122394396,  122399403,  122415428,  122448475,      &
     &  122496522,  122558600,  122662750,  122780396,  122399403,      &
     &  122412421,  122437459,  122490513,  122547590,  122660770,      &
     &  121910100,  122356357,  122361365,  122370378,  122389400,      &
     &  122405411,  122416420,  122428433,  122440365,  122370373,      &
     &  122377383,  122392409,  122430440,  122444458,  122466478,      &
     &  122490495,  122372376,  122380385,  122392402,  122418440,      &
     &  122452470,  122485500,  122520540,  122550378,  122382385,      &
     &  122392400,  122411425,  122450460,  122480508,  122530555,      &
     &  122585600,  122383388,  122392397,  122407420,  122440470,      &
     &  122490520,  122550580,  122620670,  122685388,  122393397,      &
     &  122404413,  122425450,  122480504,  122540574,  122624695,      &
     &  122770820,  122394398,  122404411,  122421435,  122465492,      &
     &  122520558,  122600660,  122725940,  310105000/
      DATA ROUTID/4HSUPC,4HLD  /
!
      IF(TANLE.EQ.0.)TANLE=.00001
      COTLE=1./TANLE
      BCOTLE=BETA*COTLE
      ACOTBC=RAD*ATAN(1./BCOTLE)
      XACCRB=XACCR*CRSTR/CBARR
      SAVE=MACOE*SW/(CBARR*SR)
      BA=BETA*ASTRW
      EN=1.-4.*COTLE/ASTRW
!
!    ---- SUPERSONIC WING ACCELERATION DERIVATIVE,CLAD ----
!
      MACH=FLC(IM+2)
      QLAMDA=9.
      IF(BCOTLE.GE.1.)GO TO 1060
      IF(LAMDA.NE.0.)GO TO 1010
!
!           -- FIGURE 7.1.4.1-7 F1(N) --
!
 1000 CALL INTERX(1,X2A417,EN,I2A417,Y1A417,F1N,16,16,1,0,0,0,1,0,0,0,  &
     &            Q71417,3,ROUTID)
!
!           -- FIGURE 7.1.4.1-7 F2(N) --
!
      CALL INTERX(1,X2B417,EN,I2B417,Y1B417,F2N,26,26,1,0,0,0,1,0,0,0,  &
     &            Q71417,3,ROUTID)
!
!           -- FIGURE 7.1.4.1-7 F3(X) --
!
      CALL INTERX(1,X2C417,EN,I2C417,Y1C417,F3X,15,15,2,0,0,0,2,0,0,0,  &
     &            Q71417,3,ROUTID)
      F3X=F3X*(1.-EN)
      CLADWH=-.027414*ASTRW*MACH**2/BETA**2*(-3.*GBC*F3X+2.*EPPBC*F2N+  &
     &       EPPBC*F1N/MACH**2)*SAVE
      IF(QLAMDA.LT.5.)GO TO 1040
      GO TO 1070
 1010 IF(LAMDA.LT.0.25)GO TO 1030
!
!           -- CALCA IS THE EQUATION SHOWN BY FIGURE 7.1.4.1-8 --
!
 1020 CALL CALCA(DYN,A,WINGIN)
      CLADWH=SAVE/(RAD*BETA**2)*(MACH**2*CLAD1-CLAD2)
      IF(QLAMDA.LT.0.25)GO TO 1050
      GO TO 1070
 1030 CONTINUE
      QLAMDA=LAMDA
      LAMDA=0.
      GO TO 1000
 1040 CLD1=CLADWH
      LAMDA=.25
      GO TO 1020
 1050 CLADWH=(CLADWH-CLD1)*4.*QLAMDA+CLD1
      GO TO 1070
!
!           -- FIGURE 7.1.4.1-11A,B,C,D,E,F,G,H,I,J,K,L,M,N,O --
!
 1060 CALL TLIP3X(X14111,X24111,X34111,Y14111,7,15,5,BA,ACOTBC,LAMDA,   &
     &            BCLAD1,2,1,0,1,1,0,Q14111,3,ROUTID)
      CALL TLIP3X(X1A111,X2A111,X3A111,Y1A111,7,15,5,BA,ACOTBC,LAMDA,   &
     &            BCLAD2,2,1,0,2,1,0,Q14111,3,ROUTID)
      CLADWH=SAVE/(RAD*BETA**3)*(MACH**2*BCLAD1-BCLAD2)
 1070 CONTINUE
      IF(TANLE.EQ..00001)TANLE=0.
      RETURN
      END
      SUBROUTINE SUPCM0
!
!***  CALCULATES SUPERSONIC CONFIGURATION  CM0
!
      COMMON /IBW/    PBW,    BW(380)
      COMMON /IBH/    PBH,    BH(380)
      COMMON /FLGTCD/ FLC(160)
      COMMON /SUPBOD/ SBD(229)
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /WINGI/  WGIN(101)
      COMMON /HTI/    HTIN(154)
      COMMON /BDATA/  BD(762)
      COMMON /WINGD/  A(195), B(49)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      EQUIVALENCE (BW(41),CMOWB), (BH(41),CMOHB)
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
!
!***  WING-BODY CMO
!
      IF(.NOT. WGPL) GO TO 1010
      DB  = 2.0*(WGIN(4)-WGIN(3))
      XLN = (XW+0.5*DB*A(38))/DB
      XLA = (XW+WGIN(6)+0.5*DB*A(80))/DB
      XLA = BD(1)/DB-XLA
      RN  = FLC(I+2)*A(122)
      DBM = SBD(120)
      WL  = 0.5*ZW/DBM
      VT  = 0.0
      HD  = 0.0
      DOB = 0.5*DBM/WGIN(4)
      CALL WBCM0(A(120), A(38), WGIN(16), XLN, XLA, A(118), WGIN(62),   &
     &      WGIN(11), WGIN(93), WGIN(94), RN, FLC(96), WL,              &
     &      VT, HD, DOB, FLC(I+2), CMOWB)
      TRA(73) = CMOWB
 1010 CONTINUE
!
!***  HORIZONTAL-BODY CMO
!
      IF(.NOT. HTPL) GO TO 1020
      DB  = 2.0*(HTIN(4)-HTIN(3))
      XLN = (XH+0.5*DB*AHT(38))/DB
      XLA = (XH+HTIN(6)+0.5*DB*AHT(80))/DB
      XLA = BD(1)/DB-XLA
      RN  = FLC(I+2)*AHT(122)
      DBM = SBD(120)
      WL  = 0.5*ZW/DBM
      VT  = 0.0
      HD  = 0.0
      DOB = 0.5*DBM/HTIN(4)
      CALL WBCM0(AHT(120), AHT(38), HTIN(16), XLN, XLA, AHT(118),       &
     &      HTIN(62),HTIN(11), HTIN(93), HTIN(94), RN, FLC(96), WL,     &
     &      VT, HD, DOB, FLC(I+2), CMOHB)
      TRAH(73) = CMOHB
 1020 CONTINUE
      RETURN
      END
      SUBROUTINE SUPCMD
!
!     THIS ROUTINE YIELDS THE SUPERSONIC WING ACCELERATION DERIVATIVE,CM
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /WINGD/  A(195)
      COMMON /SUPWH/  SLG(141)
      COMMON /POWR/   DYN(213)
      COMMON /IWING/  PWING, WING(400)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,       &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      INTEGER D14213,D24213,D34213,Y1A213,D1A213,D2A213,D3A213,Y14213
      REAL MACOE
      REAL MACH,LSTAR,LAMDA
      DIMENSION ROUTID(2)
      DIMENSION Q71429(3),Q14213(3)
      DIMENSION I2A429(4),I2B429(4)
      DIMENSION X2B429(18),Y7B429(18)
      DIMENSION X2A429(17),Y7A429(17)
      DIMENSION D14213( 99),D24213( 95),D34213( 69)
      DIMENSION X2A213(15),X1A213(7),X3A213(5),Y1A213(263)
      DIMENSION X24213(15),X14213(7),X34213(5),Y14213(263)
      DIMENSION D1A213( 99),D2A213( 95),D3A213( 69)
      EQUIVALENCE (D14213(1),Y14213(1)),(D24213(1),Y14213(100)),        &
     &            (D34213(1),Y14213(195))
      EQUIVALENCE (D1A213(1),Y1A213(1)),(D2A213(1),Y1A213(100))
      EQUIVALENCE (D3A213(1),Y1A213(195))
      EQUIVALENCE (MACOE,A(16)),(LSTAR,A(29)),(TANLE,A(62)),            &
     &(XACCR,SLG(134)),(CRSTR,A(10)),(SW,A(3)),(DXCG,A(173)),           &
     &(ASTRW,A(7)),(LAMDA ,A(27)),(BETA,SLG(1))
      EQUIVALENCE (EPPBC,DYN(9)),(GBC,DYN(10)),(XACCRB,DYN(14)),        &
     &(F5N,DYN(17)),(F7N,DYN(18)),(F11N,DYN(19)),(CMADPP,DYN(7)),       &
     &(CLADWH,WING(241)),(F6N,DYN(8)),(F8N,DYN(5)),(CMADWH,WING(261))
      EQUIVALENCE (CMAD1,DYN(26)),(CMAD2,DYN(27))
      DATA Q71429 /4H7.1.,4H4.2-,4H9   /
      DATA Q14213 /4H7.1.,4H4.2-,4H13  /
      DATA              I2A429/17,3*0.0/,I2B429/18,3*0.0/
!
!                        FIGURE 7142-9 (F6(N))
!
      DATA X2A429                                                       &
     & / -1., -.8, -.6, -.4, -.2, 0., .1, .2, .3, .4, .5, .6, .7, .75,  &
     &   .8, .85, .9  /
      DATA Y7A429                                                       &
     & / 5.43, 4.6, 3.7, 2.8, 1.9, 1., .45, -.05, -.6, -1.25, -1.88,    &
     &   -2.6, -3.5, -4., -4.93, -6., -7.5 /
!
!                        FIGURE 7142-9  (F8(N))
!
      DATA X2B429                                                       &
     & / -1., -.9, -.8, -.7, -.6, -.5, -.4, -.3, -.2, -.1, 0., .1, .2,  &
     &    .3, .4, .5, .6, .7 /
      DATA Y7B429                                                       &
     & / .385, .35, .32, .293, .27, .25, .23, .22, .21, .21, .22, .235, &
     &   .275, .34, .45, .6, .875, 1.45  /
      DATA X24213/0.,8.,12.,16.,20.,24.,28.,32.,34.,36.,38.,40.,42.,44.,&
     &45./
      DATA X14213/3.,4.,5.,6.,8.,12.,20./
      DATA X34213/0.,.25,.5,.75,1./
      DATA X2A213/0.,8.,12.,16.,20.,24.,28.,32.,34.,36.,38.,40.,42.,44.,&
     &45./
      DATA X1A213/3.,4.,5.,6.,8.,12.,20./
      DATA X3A213/0.,.25,.5,.75,1./
!
!        IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
!        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
!
!        THE FORMAT IS AS FOLLOWS-
!
!        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
!
!        WHERE-
!
!        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
!        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
!        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
!             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
!        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
!        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
!        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
!        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
!
      DATA D14213/  122600550,  122540543,  122555575,  122595615,      &
     &  122625635,  122650665,  122675690,  122700600,  122600600,      &
     &  122610620,  122640665,  122690705,  122725750,  122790830,      &
     &  122880900,  122600615,  122625640,  122665690,  122725775,      &
     &  122805845,  122885940,  111101109,  112114600,  122625650,      &
     &  122675705,  122745800,  122865910,  121980106,  111115125,      &
     &  111136143,  122600657,  122690735,  122780850,  121940105,      &
     &  111113122,  111135150,  111170200,  112210600,  122710770,      &
     &  122850940,  111105120,  111142155,  111180220,  111265320,      &
     &  111385420,  122600800,  121925105,  111122144,  111175215,      &
     &  111250320,  111450605,  310800103,  202114575,  122590600,      &
     &  122615630,  122650680,  122715735,  122750770,  122735800,      &
     &  122820825,  122575615,  122635660,  122690735,  122785860,      &
     &  122900950,  111101108,  111114120,  112123580,  122635670,      &
     &  122710750,  122815900,  111100107,  111114123,  111134146,      &
     &  111159166,  122585650,  122700750,  122815900,  111100115,      &
     &  111125136,  111150167,  111180205,  112220590,  122690760,      &
     &  122840940,  111105121,  111144157,  111175200,  111235275,      &
     &  111325345,  122590765,  121875100,  111115135,  111160200,      &
     &  111225280,  111350440,  111540650,  112700595,  121900110/
      DATA D24213/                                                      &
     &  111130157,  111190235,  111310365,  111450570,  310750101,      &
     &     133152,  122510560,  122580615,  122650685,  122735800,      &
     &  122830870,  122900930,  121965100,  112102530,  122590635,      &
     &  122680740,  122805890,  121990105,  111113119,  111126135,      &
     &  111144147,  122535625,  122680750,  122820915,  111103120,      &
     &  111130142,  111154166,  111180195,  112205540,  122650720,      &
     &  122800900,  111101118,  111140155,  111170185,  111210235,      &
     &  111255270,  122545710,  122800915,  111105122,  111146180,      &
     &  111205235,  111275315,  111365410,  112435550,  122800950,      &
     &  111113134,  111161200,  111255300,  111360460,  111580715,      &
     &  111860980,  122550990,  111123154,  111190235,  111290390,      &
     &  111470600,  310790110,     155220,  202265465,  122535575,      &
     &  122620665,  122720790,  122855895,  122935975,  111101105,      &
     &  111110112,  122490585,  122640700,  122775860,  121975110,      &
     &  111119128,  111136145,  111155165,  112170500,  122625695,      &
     &  122775875,  121995115,  111135148,  111160170,  111185200,      &
     &  111220230,  122510655,  122745850,  121965113,  111133160,      &
     &  111175190,  111210230,  111255285,  112300520,  122720845,      &
     &  121980115,  111136165,  111210240,  111275320,  111365415/
      DATA D34213/                                                      &
     &  111465490,  122525840,  111101122,  111148180,  111225300,      &
     &  111350435,  111545675,  310835100,  202108565,  111105134,      &
     &  111163210,  111265340,  111450550,  111715975,     133183,      &
     &     258300,  122400490,  122530600,  122650700,  122790900,      &
     &  121930102,  111111116,  111120130,  112134410,  122530600,      &
     &  122700750,  122830950,  111115120,  111131141,  111160169,      &
     &  111180187,  122440610,  122680770,  121870100,  111119140,      &
     &  111158170,  111184204,  111220240,  112250460,  122670750,      &
     &  122850980,  111117135,  111169182,  111208230,  111257282,      &
     &  111312330,  122470730,  121800100,  111120140,  111170212,      &
     &  111235270,  111310365,  111430500,  112560480,  121850110,      &
     &  111130160,  111196250,  111320460,  111500550,  111680850,      &
     &     105116,  121490110,  111140184,  111239297,  111375550,      &
     &  111610900,     106147,     209280,     322000/
      DATA D1A213/-1122300300,-1122305307,-1122310313,-1122317330,      &
     &-1122335342,-1122350357,-1122364370,-1122375300,-1122305310,      &
     &-1122318327,-1122335350,-1122365375,-1122385395,-1122412426,      &
     &-1122440450,-1122300315,-1122325335,-1122345362,-1122380400,      &
     &-1122413428,-1122445465,-1122490520,-1122530300,-1122320335,      &
     &-1122350365,-1122382410,-1122433455,-1122480510,-1122540570,      &
     &-1122600615,-1122300330,-1122350375,-1122400427,-1122463506,      &
     &-1122535568,-1122613660,-1122713775,-1122805300,-1122357390,      &
     &-1122425470,-1122515570,-1122640690,-1122750837,-1121935105,      &
     &-1111118123,-1122300400,-1122460520,-1122590670,-1122770900,      &
     &-1121990111,-1111132154,-1111180211,-1112227290,-1122300307,      &
     &-1122316327,-1122340355,-1122375385,-1122400415,-1122430450,      &
     &-1122467475,-1122290313,-1122325340,-1122357375,-1122400430,      &
     &-1122450470,-1122495525,-1122552582,-1122600290,-1122320336,      &
     &-1122363382,-1122410442,-1122485510,-1122540580,-1122620670,      &
     &-1122725750,-1122290330,-1122355380,-1122410440,-1122482535,      &
     &-1122570615,-1122665725,-1122795865,-1122900290,-1122350380,      &
     &-1122420460,-1122510563,-1122640690,-1122755835,-1121925103,      &
     &-1111115123,-1122290380,-1122435490,-1122560635,-1122720840,      &
     &-1121915102,-1111120138,-1111162188,-1112200290,-1122450540/
      DATA D2A213/                                                      &
     &-1122635740,-1121875102, -111120135,-1111163198,-1111238285,      &
     &-1111343370,-1122265285,-1122300315,-1122335355,-1122375405,      &
     &-1122420435,-1122455480,-1122505530,-1122550275,-1122305325,      &
     &-1122350370,-1122400435,-1122480506,-1122535570,-1122610655,      &
     &-1122695720,-1122275320,-1122343370,-1122407445,-1122493550,      &
     &-1122590635,-1122685745,-1122805875,-1122910275,-1122330365,      &
     &-1122400440,-1122487550,-1122625665,-1122725800,-1122875965,      &
     &-1111107110,-1122275355,-1122400450,-1122505570,-1122650755,      &
     &-1122825905,-1111100112,-1111125150,-1112160275,-1122400470,      &
     &-1122545630,-1122730853,-1111103110,-1111130150,-1111175200,      &
     &-1111240260,-1122275490,-1122605735,-1121870104,-1111130150,      &
     &-1111175200,-1111235290,-1111365470,-1112510245,-1122278295,      &
     &-1122315335,-1122363390,-1122425440,-1122465490,-1122515545,      &
     &-1122570590,-1122255300,-1122320350,-1122380420,-1122463515,      &
     &-1122550580,-1122617660,-1122710760,-1122790265,-1122315350,      &
     &-1122380425,-1122470530,-1122600650,-1122700760,-1122830900,      &
     &-1121980102,-1122265330,-1122370415,-1122463520,-1122590685,      &
     &-1122740805,-1122890990,-1111109119,-1112124270,-1122360415,      &
     &-1122475540,-1122615710,-1122840920,-1111103115,-1111130150/
      DATA D3A213/                                                      &
     &-1111170180,-1122270415,-1122500585,-1122683800,-1121950115,      &
     & -111130150,-1111175200,-1111225275,-1112290270,-1122530650,      &
     &-1122800965,-1111120140,-1111170200,-1111230275,-1111320400,      &
     &-1111525600,-1122235262,-1122280311,-1122339376,-1122426488,      &
     &-1122520552,-1122585624,-1122655690,-1122713240,-1122290318,      &
     &-1122345380,-1122425485,-1122560600,-1122640681,-1122730777,      &
     &-1122825850,-1122250310,-1122345380,-1122428476,-1122550625,      &
     &-1122670725,-1122782860,-1121958107,-1112112250,-1122327375,      &
     &-1122424475,-1122541620,-1122710770,-1122832910,-1111103118,      &
     &-1111130138,-1122255360,-1122423480,-1122560650,-1122758890,      &
     &-1121975108,-1111122140,-1111161180,-1112192258,-1122415510,      &
     &-1122610720,-1121850103,-1111125104,-1111160184,-1111218255,      &
     &-1111295320,-1122260540,-1122688850,-1111103125,-1111158185,      &
     &-1111218263,-1111326417,-1111510608, -310660000/
      DATA ROUTID/4HSUPC,4HMD  /
!
      IF(TANLE.EQ.0.)TANLE=.00001
      COTLE=1./TANLE
      MACH=FLC(IM+2)
      BCOTLE=BETA*COTLE
      ACOTBC=RAD*ATAN(1./BCOTLE)
      XACCRB=XACCR*CRSTR/CBARR
      SAVE=MACOE*SW/(CBARR*SR)
      BA=BETA*ASTRW
      DEE=.66667*LSTAR
      EN=1.-4.*COTLE/ASTRW
!
!    ---- SUPERSONIC ACCELERATION DERIVATIVE,CMAD ----
!
      QLAMDA=8.
      IF(BCOTLE.GE.1.)GO TO 1060
      IF(LAMDA.NE.0.)GO TO  1010
!
!           -- FIGURE 7.1.4.2-9 F6(N) --
!
 1000 CALL INTERX(1,X2A429,EN,I2A429,Y7A429,F6N,17,17,1,0,0,0,1,0,0,0,  &
     &           Q71429,3,ROUTID)
!
!           -- FIGURE 7.1.4.2-9 F8(N) --
!
      CALL INTERX(1,X2B429,EN,I2B429,Y7B429,F8N,18,18,1,0,0,0,1,0,0,0,  &
     &            Q71429,3,ROUTID)
      XX=-.010281*ASTRW*MACH**2/BETA**2*SAVE*MACOE/CBARR
      YY=GBC*F7N+5.3333*EPPBC*F5N/F11N
      ZZ=SAVE*MACOE/(CBARR*RAD)
      WW=1.77778*ASTRW*MACH**2*EPPBC*F8N/BETA**2+.19635*ASTRW*EPPBC*    &
     &   F6N/BETA**2
      CMADPP=XX*YY+ZZ*WW-(DEE*CLADWH)/CBARR
      IF(QLAMDA.LT.5.)GO TO 1040
      GO TO 1070
 1010 IF(LAMDA.LT.0.25)GO TO 1030
 1020 CONTINUE
      CMADPP=SAVE*MACOE/(BETA**2*CBARR*RAD)*(MACH**2*CMAD1-CMAD2)
      IF(QLAMDA.LT.0.25)GO TO 1050
      GO TO 1070
 1030 CONTINUE
      QLAMDA=LAMDA
      LAMDA=0.
      GO TO 1000
 1040 CMDD1=CMADWH
      LAMDA=.25
      GO TO 1020
 1050 CMADPP=(CMADPP-CMDD1)*4.*LAMDA+CMDD1
      GO TO 1070
!
!           -- FIGURE 7.1.4.2-13A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P --
!
 1060 CALL TLIP3X(X14213,X24213,X34213,Y14213,7,15,5,BA,ACOTBC,LAMDA,   &
     &            BCMAD1,1,1,0,2,1,0,Q14213,3,ROUTID)
      CALL TLIP3X(X1A213,X2A213,X3A213,Y1A213,7,15,5,BA,ACOTBC,LAMDA,   &
     &            BCMAD2,1,1,0,2,1,0,Q14213,3,ROUTID)
      CMADPP=SAVE*MACOE/(CBARR*RAD)*(MACH**2/BETA**3*BCMAD1+(MACH**2/   &
     &       BETA**2+1.)*BCMAD2/BETA)
 1070 CMADWH=CMADPP+DXCG*CLADWH/CBARR
      IF(TANLE.EQ..00001)TANLE=0.
      RETURN
      END
      SUBROUTINE SUPCMQ
!
!***  THIS ROUTINE YIELDS THE SUPERSONIC WING PITCHING DERIVATIVE,CMQ
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /WINGD/  A(195)
      COMMON /WINGI/  WINGIN(77)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /POWR/   DYN(213)
      COMMON /IWING/  PW, WING(400)
      COMMON /SUPWH/  SLG(141)
      COMMON /SBETA/  STB(135),TRA(108)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      INTEGER Y71129,D11129,D21129,D31129,D41129,D51129,D61129,Y11210,  &
     & D11210,D21210,D31210,D41210,D51210,D61210,D71210,D81210,D91210,  &
     & D10210
      REAL MACOE
      REAL MACH,LSTAR,LAMDA
      DIMENSION ROUTID(2)
      DIMENSION WTYPE(4)
      DIMENSION Q71128(3),Q71129(3),Q11210(3)
      DIMENSION I2A128(4),I2B128(4)
      DIMENSION X2A128(16),Y1A128(16)
      DIMENSION X2B128(17),Y1B128(17)
      DIMENSION X21129(40),X11129(8),X31129(3),Y71129(430)
      DIMENSION D11129( 80),D21129( 80),D31129( 80),D41129( 80),D51129( &
     &          80),D61129( 80)
      DIMENSION X21210(26),X11210(9),X31210(5),Y11210( 585)
      DIMENSION D11210( 65),D21210( 52),D31210( 65),D41210( 52),D51210( &
     &  65),D61210( 52),D71210( 65),D81210( 52),D91210( 65),D10210( 52)
      DIMENSION CX(6),QCLAMA(3)
      EQUIVALENCE (D11129(1),Y71129(1)),(D21129(1),Y71129( 81)),(D31129(&
     &1),Y71129(161)),(D41129(1),Y71129(241)),(D51129(1),Y71129(321)),  &
     &(D61129(1),Y71129(401))
      EQUIVALENCE (D11210(1),Y11210(1)),(D21210(1),Y11210( 66)),(D31210(&
     &1),Y11210(118)),(D41210(1),Y11210(183)),(D51210(1),Y11210(235)),(D&
     &61210(1),Y11210(300)),(D71210(1),Y11210(352)),(D81210(1),Y11210(41&
     &7)),(D91210(1),Y11210(469)),(D10210(1),Y11210( 534))
      EQUIVALENCE(MACOE,A(16)),(LSTAR,A(29)),(CRSTR,A(10))              &
     &,(ASTRW,A(7)),(LAMDA ,A(27)),(TANLE,A(62)),(SW,A(3)),(DXCG,A(173))
      EQUIVALENCE(EPPBC,DYN(9)),(GBC,DYN(10)),(CLQPWH,DYN(11))          &
     &,(XACCRB,DYN(14)),(CMQMFB,DYN(1)),(CMQWT,WING(221))               &
     &,(CLQWH,WING(201)),(F5N,DYN(17)),(F7N,DYN(18)),(F11N,DYN(19))     &
     &,(CMQPWH,DYN(20)),(CMQWH,WING(221)),(BCLQPP,DYN(15))
      DATA Q71128 /4H7.1.,4H1.2-,4H8   /
      DATA Q71129 /4H7.1.,4H1.2-,4H9   /
      DATA Q11210 /4H7.1.,4H1.2-,4H10  /
      DATA I2A128 /16,3*0/, I2B128 /17,3*0/
      DATA QCLAMA /4HCLA ,4HVS M,4HACH /
      DATA IX /0/
!
!                   FIGURE 7.1.1.2-8  F5(N)
!
      DATA X2A128                                                       &
     & / -1.0, -0.8, -0.6, -0.4, -0.2, 0.0, 0.1, 0.2, 0.3, 0.4, 0.5,    &
     &    0.6, 0.65, 0.7, 0.75, 0.8  /
      DATA Y1A128                                                       &
     & / -0.17, -0.15, -0.13, -0.10, -0.06, 0.0, 0.04, 0.09, 0.17, 0.26,&
     &    0.39, 0.62, 0.80, 1.10, 1.44, 2.00  /
!
!                   FIGURE 7.1.1.2-8   F7(N)
!
      DATA X2B128                                                       &
     & / -1.0, -0.8, -0.6, -0.4, -0.2, 0.0, 0.1, 0.2, 0.3, 0.4, 0.5,    &
     &    0.6, 0.65, 0.7, 0.75, 0.8, 0.85 /
      DATA Y1B128                                                       &
     & / 3.9, 3.35, 2.8, 2.2, 1.65, 1.0, 0.07, 0.035, -0.005, -0.5 ,    &
     &   -1.0, -1.6, -2.2, -2.4, -2.9, -3.7, -6.0  /
!
!                                FIGURE 7.1.1.2-9A,B,C
!
      DATA X21129                                                       &
     & / 0., .1, .2, .25, .3, .35, .385, .4, .43, .45, .46, .48, .53,   &
     &   .55, .56, .575, .6, .61, .62, .635, .65, .675, .69, .715, .725,&
     &   .75, .76, .775, .79, .805, .815, .835, .85, .87, .88, .91, .93,&
     &   .945, .97, 1. /
      DATA X11129/1.,2.,3.,4.,5.,6.,8.,10./
      DATA X31129/.25,.5,.75/
!
! FIGURE 7.1.1.2-10A,B,C,D,E,F,G,H,I,J,K (TAPER RATIO=0,.25,.5,.75,1.)
!
      DATA X21210                                                       &
     & / 0., .1, .2, .5, .7, 1.0, 2., 4., 5., 6., 8., 9., 11., 12., 14.,&
     &  15., 18., 20., 22., 24., 27., 32., 35., 36., 40., 45. /
      DATA X11210/1.,2.,3.,4.,5.,6.,8.,12.,20./
      DATA X31210/0.,.25,.5,.75,1./
!
!        IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
!        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
!
!        THE FORMAT IS AS FOLLOWS-
!
!        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
!
!        WHERE-
!
!        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
!        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
!        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
!             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
!        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
!        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
!        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
!        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
!
      DATA D11129/  202000250,  122400500,  122600550,  122400400,      &
     &  122400350,  122300300,  122300300,  122300300,  122250200,      &
     &  122200200,  122200200,  122200200,  122200200,  122200200,      &
     &  122200200,  122200200,  122200200,  122200200,  122200200,      &
     &  122200200,  202000300,  122550700,  121850105,  111120120,      &
     &  111120110,  111105100,  122900900,  122900900,  122850800,      &
     &  122800800,  122800750,  122700700,  122700600,  122600600,      &
     &  122550550,  122550500,  122500500,  122500500,  122500500,      &
     &  122500500,  202000300,  122550700,  121850105,  111120125,      &
     &  111145155,  111160180,  111175165,  111165165,  111155155,      &
     &  111150145,  111145140,  111135130,  111130120,  111120115,      &
     &  111110110,  111105100,  111100100,  111100100,  112100950,      &
     &  122900900,  202000300,  122550700,  121850105,  111120125,      &
     &  111145155,  111160180,  111230260,  111260260,  111250250,      &
     &  111250235,  111230220,  111215200,  111200190,  111190180,      &
     &  111175170,  111170160,  111155150,  111150150,  111145140,      &
     &  111135135/
      DATA D21129/  202000300,  122550700,  121850105,  111120125,      &
     &  111145155,  111160180,  111230260,  111270290,  111340360,      &
     &  111350350,  111345335,  111320300,  111295285,  111285280,      &
     &  111270260,  111250250,  111240230,  111230210,  111200200,      &
     &  111190180,  202000300,  122550700,  121850105,  111120125,      &
     &  111145155,  111160180,  111230260,  111270290,  111340360,      &
     &  111380420,  111460455,  111445440,  111425410,  111400390,      &
     &  111380365,  111360350,  111340330,  111320300,  111290280,      &
     &  111270250,  202000300,  122550700,  121850105,  111120125,      &
     &  111145155,  111160180,  111230260,  111270290,  111340360,      &
     &  111380420,  111460550,  111600740,  111730720,  111710700,      &
     &  111685660,  111650620,  111600580,  111570530,  111510490,      &
     &  111480450,  202000300,  122550700,  121850105,  111120125,      &
     &  111145155,  111160180,  111230260,  111270290,  111340360,      &
     &  111380420,  111460550,  111600740,  111780980,     109108,      &
     &     107106,  201104990,  111960920,  111900840,  111800780,      &
     &  111750720/
      DATA D31129/  202000100,  122220260,  122290330,  122390410,      &
     &  122460500,  122480450,  122410390,  122370370,  122360360,      &
     &  122360350,  122340330,  122330330,  122320310,  122310310,      &
     &  122310310,  122310310,  122310310,  122310310,  122310300,      &
     &  122300300,  202000200,  122410500,  122610760,  122870940,      &
     &  121980100,  111100100,  111100100,  111100100,  112100990,      &
     &  122970920,  122910870,  122850800,  122780750,  122740720,      &
     &  122710700,  122690680,  122670660,  122650620,  122620610,      &
     &  122600600,  202000200,  122410500,  122610760,  122870940,      &
     &  121980117,  111125140,  111176170,  111166165,  111161161,      &
     &  111160160,  111160160,  111154150,  111146140,  111138132,      &
     &  111130126,  111124120,  111118115,  111112100,  111100100,      &
     &  111100100,  202000200,  122410500,  122610760,  122870940,      &
     &  121980117,  111125140,  111182203,  111220238,  111268262,      &
     &  111260255,  111250246,  111242240,  111238235,  111227222,      &
     &  111219210,  111208200,  111198190,  111185177,  111172167,      &
     &  111160155/
      DATA D41129/  202000200,  122410500,  122610760,  122870940,      &
     &  121980117,  111125140,  111182203,  111220238,  111268287,      &
     &  111300335,  111370360,  111353350,  111345338,  111337336,      &
     &  111333320,  111313300,  111294286,  111280267,  111260250,      &
     &  111240230,  202000200,  122410500,  122610760,  122870940,      &
     &  121980117,  111125140,  111182203,  111220238,  111268287,      &
     &  111300335,  111370445,  111500490,  111482470,  111465462,      &
     &  111458450,  111448432,  111420406,  111400380,  111369352,      &
     &  111340325,  202000200,  122410500,  122610760,  122870940,      &
     &  121980117,  111125140,  111182203,  111220238,  111268287,      &
     &  111300335,  111370445,  111500575,  111640815,  111807800,      &
     &  111790778,  111773760,  111750725,  111710670,  111647622,      &
     &  111595570,  202000200,  122410500,  122610760,  122870940,      &
     &  121980117,  111125140,  111182203,  111220238,  111268287,      &
     &  111300335,  111370445,  111500575,  111640815,  310920104,      &
     &     123122,     121119,     118117,     115109,     105101,      &
     &  111960900/
      DATA D51129/  203000500,  133700900,  122120150,  122200200,      &
     &  122200200,  122200200,  122210220,  122220220,  122230230,      &
     &  122230230,  122230240,  122240260,  122270270,  122270280,      &
     &  122280280,  122280280,  122290290,  122290300,  122300300,      &
     &  122300300,  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  122860830,  122830830,  122820810,      &
     &  122810810,  122800800,  122800800,  122800800,  122800800,      &
     &  122780750,  122740700,  122700690,  122680650,  122630630,      &
     &  122620600,  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  111123140,  111146155,  111153150,      &
     &  111150150,  111146142,  111141140,  111140137,  111135134,      &
     &  111134132,  111132130,  111130124,  111122117,  111113111,      &
     &  111108100,  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  111123140,  111146162,  111195205,      &
     &  111220250,  111243238,  111232230,  111228220,  111220218,      &
     &  111213210,  111210205,  111205201,  111198188,  111183180,      &
     &  111178170/
      DATA D61129/  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  111123140,  111146162,  111195205,      &
     &  111220250,  111280330,  111351345,  111340332,  111330325,      &
     &  111320318,  111313310,  111305302,  111300292,  111282277,      &
     &  111267250,  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  111123140,  111146162,  111195205,      &
     &  111220250,  111280330,  111370450,  111482470,  111465458,      &
     &  111452448,  111444438,  111430425,  111420410,  111400388,      &
     &  111370355,  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  111123140,  111146162,  111195205,      &
     &  111220250,  111280330,  111370450,  111482600,  111670815,      &
     &  111800790,  111780763,  111752733,  111730705,  111690677,      &
     &  111650632,  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  111123140,  111146162,  111195205,      &
     &  111220250,  111280330,  111370450,  111482600,  111670815,      &
     &  310965111,     126124,     122121,     119116,     114113,      &
     &     107102/
      DATA D11210/  122100100,  122100100,  122100100,  133999993,      &
     &  133989986,  133980979,  133970969,  133965963,  133952949,      &
     &  133945939,  133930919,  133909905,  133895880,  122100100,      &
     &  122100100,  123100995,  133993983,  133979975,  133965960,      &
     &  133950945,  133939935,  133923915,  133909900,  133889873,      &
     &  133865863,  133855845,  122100100,  122100100,  123100995,      &
     &  133990973,  133965960,  133943939,  133925920,  133909905,      &
     &  133885875,  133869860,  133850845,  133840843,  133853885,      &
     &  122100100,  123100998,  133995990,  133979959,  133950935,      &
     &  133915910,  133890883,  133870865,  133850840,  133830828,      &
     &  133825835,  133850863,  132909100,  122100100,  133995990,      &
     &  133988985,  133965939,  133940915,  133890882,  133865853,      &
     &  133835830,  133820815,  133815815,  133825873,  133920940,      &
     &  122105120/
      DATA D21210/  122100100,  133995989,  133985980,  133955925,      &
     &  133913893,  133869859,  133835828,  133813810,  133800805,      &
     &  133815825,  133859959,  122105109,  122127160,  122100100,      &
     &  133990980,  133975970,  133940893,  133878863,  133829820,      &
     &  133800790,  133785789,  133809835,  133873925,  122102128,      &
     &  122149160,  122210310,  122100100,  133990979,  133965960,      &
     &  133920850,  133829812,  133783780,  133785795,  133830850,      &
     &  132961109,  122123143,  122180260,  122330360,  122510760,      &
     &  122100100,  133990965,  133950925,  133910775,  133769775,      &
     &  133810839,  132950140,  122129145,  122210260,  122310390,      &
     &  122510820,  111110118,  111173280/
      DATA D31210/  122100100,  123100990,  133990980,  133965930,      &
     &  133920900,  133880865,  133845835,  133819810,  133790780,      &
     &  133770760,  133745733,  133725725,  133728760,  122100100,      &
     &  133990985,  133980975,  133955920,  133905885,  133860849,      &
     &  133825818,  133800770,  133770760,  133745740,  133730735,      &
     &  133750755,  133800925,  123100995,  133990980,  133975970,      &
     &  133950910,  133890870,  133843830,  133805799,  133780770,      &
     &  133755750,  133745745,  133750780,  133825845,  132945109,      &
     &  133885885,  133882880,  133875870,  133860835,  133825810,      &
     &  133790780,  133760759,  133750749,  133740745,  133750760,      &
     &  133783865,  133955985,  122119157,  133875875,  133872870,      &
     &  133865860,  133845815,  133805790,  133770755,  133745743,      &
     &  133740735,  133745759,  133783820,  132880105,  122120123,      &
     &  122152200/
      DATA D41210/  133860860,  133855850,  133845840,  133825795,      &
     &  133780770,  133753743,  133733733,  133740745,  133775815,      &
     &  133865925,  122105133,  122157160,  122230280,  133875870,      &
     &  133865860,  133850845,  133830780,  133760750,  133735733,      &
     &  133740750,  133783809,  132900101,  122113127,  122158230,      &
     &  122280300,  122370505,  133880870,  133860845,  133835825,      &
     &  133800750,  133735733,  133745770,  133845905,  122105117,      &
     &  122150200,  122230280,  122350550,  122730750,  111100140,      &
     &  133880870,  133860850,  133830805,  133760725,  133750800,      &
     &  132970114,  122157170,  122240300,  122400500,  122630800,      &
     &  111107173,  111235245,  111350515/
      DATA D51210/  133945943,  133940925,  133920913,  133883833,      &
     &  133809783,  133730705,  133650640,  133620590,  133550520,      &
     &  133500490,  133470530,  133630660,  132820108,  133860855,      &
     &  133855850,  133840835,  133810765,  133750730,  133695683,      &
     &  133660630,  133620610,  133570560,  133550550,  133570650,      &
     &  133760790,  132980126,  133800800,  133800789,  133785780,      &
     &  133760729,  133715700,  133675665,  133635630,  133623620,      &
     &  133600600,  133600620,  133640760,  133900950,  122117152,      &
     &  133755753,  133750749,  133743739,  133728700,  133685670,      &
     &  133655649,  133633625,  133625630,  133630650,  133670690,      &
     &  133730900,  122109115,  122149198,  133743742,  133742735,      &
     &  133733730,  133715685,  133680660,  133645643,  133640625,      &
     &  133630640,  133690720,  133770820,  132920118,  122149154,      &
     &  122214295/
      DATA D61210/  133745743,  133742735,  133732725,  133710683,      &
     &  133680665,  133667665,  133675663,  133690710,  133780845,      &
     &  132930103,  122122161,  122205214,  122279430,  133745743,      &
     &  133740735,  133730720,  133700670,  133665660,  133670689,      &
     &  133735760,  133830890,  122105122,  122140162,  122200265,      &
     &  122320350,  122500730,  133745740,  133740730,  133725715,      &
     &  133690670,  133680705,  133783840,  132995110,  122134150,      &
     &  122209252,  122330400,  122490720,  121900100,  111139215,      &
     &  133750745,  133740725,  133712700,  133680750,  133840955,      &
     &  122128154,  122224250,  122350390,  122550700,  121900105,      &
     &  111150235,  111320340,  111465655/
      DATA D71210/  133740729,  133710660,  133625580,  133500500,      &
     &  133500500,  133500600,  133600600,  133600600,  133600500,      &
     &  133500400,  330200000,          0,  133100400,  133720702,      &
     &  133689685,  133605565,  133500500,  133500500,  133500600,      &
     &  133600600,  133600600,  133600500,  133500400,  133300300,      &
     &  133400500,  132600120,  133695680,  133665615,  133590545,      &
     &  133500500,  133500500,  133500600,  133600600,  133600600,      &
     &  133600500,  133500500,  133600600,  133800900,  122110200,      &
     &  133690672,  133650605,  133580550,  133500500,  133500500,      &
     &  133500600,  133600600,  133600600,  133600600,  133600600,      &
     &  132700100,  122120130,  122170320,  133690672,  133650615,      &
     &  133585575,  133500500,  133500500,  133500600,  133600600,      &
     &  133600600,  133600600,  133700900,  122100130,  122150170,      &
     &  122230360/
      DATA D81210/  133685670,  133650605,  133600600,  133600600,      &
     &  133600600,  133600600,  133600600,  133600700,  133800900,      &
     &  122100130,  122140190,  122230240,  122320470,  133685660,      &
     &  133640620,  133635700,  133700700,  133700700,  133700700,      &
     &  133700700,  133900900,  122120140,  122160200,  122240340,      &
     &  122400430,  122600890,  133680660,  133650690,  132775102,      &
     &  122103103,  122103103,  122103103,  122110140,  122160180,      &
     &  122250300,  122350430,  122580850,  111108116,  111152240,      &
     &  133675655,  133665930,  122127130,  122130130,  122130130,      &
     &  122150190,  122270310,  122400460,  122660840,  111103125,      &
     &  111172265,  111350375,  111494680/
      DATA D91210/  133700700,  133700700,  133700700,  133700690,      &
     &  133690690,  133690690,  133710720,  133740750,  133780820,      &
     &  133840860,  133890945,  133980990,  122103109,  133660660,      &
     &  133660660,  133660660,  133670690,  133690690,  133700700,      &
     &  133710730,  133740760,  133800830,  133860890,  132940104,      &
     &  122112114,  122124135,  133660660,  133660660,  133660660,      &
     &  133670690,  133690700,  133700700,  133710730,  133750760,      &
     &  133810850,  133900945,  122102121,  122133136,  122153174,      &
     &  133660660,  133660660,  133660660,  133670690,  133690710,      &
     &  133710720,  133730750,  133770790,  133850890,  132960102,      &
     &  122114144,  122167173,  122202238,  133660660,  133660660,      &
     &  133660660,  133670690,  133690710,  133720740,  133770800,      &
     &  133840870,  132970103,  122112120,  122136173,  122204214,      &
     &  122250300/
      DATA D10210/  133660660,  133660660,  133660660,  133670700,      &
     &  133710730,  133770790,  133860860,  133940980,  122113122,      &
     &  122135148,  122169222,  122250270,  122350450,  133660660,      &
     &  133660670,  133670670,  133680710,  133730770,  133840870,      &
     &  132970101,  122114123,  122157178,  122212232,  122250350,      &
     &  122400450,  122550750,  133660660,  133660670,  133670670,      &
     &  133700790,  133850940,  122108119,  122151162,  122194214,      &
     &  122300350,  122400450,  122600850,  111115120,  111155205,      &
     &  133660670,  133680690,  133710720,  132820106,  122124151,      &
     &  122200220,  122350350,  122500550,  122750900,  111115140,      &
     &  111185285,  111370400,  111535720/
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA ROUTID/4HSUPC,4HMQ  /
!
      TYPE=WINGIN(15)
      IF(TYPE.NE.WTYPE(1))RETURN
      IF(TANLE.EQ.0.)TANLE=.00001
      COTLE=1./TANLE
      IF(TRANSN)GO TO 1000
      MACH=FLC(IM+2)
      BETA=SQRT(MACH**2-1.)
      CNA1=SLG(7)
      XACCR=SLG(134)
      DCMDCL=SLG(135)
 1000 SAVE=MACOE*SW/(CBARR*SR)
      EN=1.-4.*COTLE/ASTRW
      DEE=.66667*LSTAR
      IF(TRANSN)GO TO 1100
!
!    ---- SUPERSONIC WING PITCHING DERIVATIVE,CMQ ----
!
 1010 CONTINUE
      BCOTLE=BETA*COTLE
      XACCRB=XACCR*CRSTR/CBARR
      BA=BETA*ASTRW
      QLAMDA=10.
      IF(BCOTLE.GE.1.)GO TO 1080
      IF(LAMDA.NE.0.)GO TO 1030
!
!           -- FIGURE 7.1.1.2-8 F5(N)
!
 1020 CALL INTERX(1,X2A128,EN,I2A128,Y1A128,F5N,16,16,1,0,0,0,1,0,0,0,  &
     &            Q71128,3,ROUTID)
      F5N=(1.-EN)*F5N
!
!           -- FIGURE 7.1.1.2-8 F7(N)
!
      CALL INTERX(1,X2B128,EN,I2B128,Y1B128,F7N,17,17,1,0,0,0,1,0,0,0,  &
     &            Q71128,3,ROUTID)
!
!           -- FIGURE 7.1.1.2-8 F11(N)) --
!
      F11N=1.-EN
      AAA=-.01028*ASTRW
      BBB=GBC*F7N
      CCC=5.3333*EPPBC*(F5N/F11N)
      DDD=-(DEE-XACCR*CRSTR)/CBARR
      CMQPWH=AAA*(BBB+CCC)+DDD*CLQPWH+2.*DDD**2*CNA1/RAD
      IF(QLAMDA.LT.5.)GO TO 1060
      GO TO 1090
 1030 IF(LAMDA.LT.0.25)GO TO 1050
      IF(LAMDA.GT.0.75)RETURN
!
!           -- FIGURE 7.1.1.2-9A,B,C --
!
 1040 CALL TLIP3X(X11129,X21129,X31129,Y71129,8,40,3,BA,BCOTLE,LAMDA,   &
     &            BCMQPP,1,1,0,1,1,0,Q71129,3,ROUTID)
      CMQPWH=(XACCRB*BCLQPP-BCMQPP*MACOE/CBARR)*SAVE/(BETA*RAD)
      IF(QLAMDA.LT.0.25)GO TO 1070
      GO TO 1090
 1050 CONTINUE
      QLAMDA=LAMDA
      LAMDA=0.
      GO TO 1020
 1060 CMQP1=CMQPWH
      LAMDA=.25
      GO TO 1040
 1070 CMQPWH=(CMQPWH-CMQP1)*4.*QLAMDA+CMQP1
      GO TO 1090
 1080 ACOTBC=RAD*ATAN(1./BCOTLE)
!
!              FIGURE 7.1.1.2-10 A-K
!
      CALL TLIP3X(X11210,X21210,X31210,Y11210,9,26,5,BA,ACOTBC,LAMDA,   &
     &            BCMQP,1,1,0,2,1,0,Q11210,3,ROUTID)
      CMQPWH=-(BCMQP/(RAD*BETA))*SAVE*MACOE/CBARR
 1090 CMQWH=CMQPWH+DCMDCL*CLQWH
      IF(.NOT.TRANSN)RETURN
      GO TO 1110
 1100 MACH=1.2
      BETA=0.663325
      XACCR=TRA(105)
      DCMDCL=(DXCG-XACCR*CRSTR)/CBARR
      CALL TBFUNX(MACH,CNA1,DYDX,5,TRA(16),TRA(21),CX,                  &
     &            IX,MI,NG,0,0,QCLAMA,3,ROUTID)
      GO TO 1010
!
!**        TRANSONIC FAIRING - WING ALONE CMQ
!
 1110 CLAM=WING(101)
      CLAMFB=TRA(12)
      IF(FLC(IM+2) .LE. TRA(6))GO TO 1120
!
!**   MACH BETWEEN FORCE BREAK AND 1.2 USE EQ 7.1.1.4-C
!
      CMQ12=CMQWH
      CMQWT=(CLAM-CLAMFB)/(CNA1-CLAMFB)*(CMQ12-CMQMFB)+CMQMFB
      GO TO 1130
!
!**   MACH BETWEEN .6 AND FORCE BREAK USE EQ 7.1.1.2-C, BUT INTERPOLATE
!          BETWEEN M=.6 INSTEAD OF M=1.2
!
 1120 BEE=SQRT(1-.36*A(67)**2)
      TOP=A(7)**3*A(68)**2
      COMPF=((TOP/(A(7)*BEE+6.*A(67))+3./BEE)/(TOP/(A(7)+6.*A(67))+3.))
      CMQ6=COMPF*DYN(2)
!
!**   COMPUTE M=.6 CL-ALPHA, EQ 4.1.3.2-49
!
      TEMP1=2.*PI*A(7)*DR
      TEMP2=(A(7)*DR*2.*PI/WINGIN(69))**2
      CLA6=(TEMP1/(2.+SQRT(TEMP2*(1.+A(50)**2/.8)+4.)))*A(3)/SR
      CMQWT=(CLAM-CLAMFB)/(CLA6-CLAMFB)*(CMQ6-CMQMFB)+CMQMFB
 1130 IF(TANLE .EQ. .00001)TANLE=0.0
      RETURN
      END
      SUBROUTINE SUPDRG
!
!***  CALCULATES SUPERSONIC WING DRAG
!
      COMMON /OVERLY/ NLOG,NMACH,N,NALPHA,IG
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /WINGD/  A(195),B(48)
      COMMON /WINGI/  WINGIN(77)
      COMMON /SUPWH/  SLG(141)
      DIMENSION VAB(4),LGB(4)
      REAL MACH,KSHARP
      REAL LHS,LERBW,LERI,LERO
      DIMENSION ROUTID(2),Q15258(3)
      DIMENSION WTYPE(4)
      DIMENSION T15258(5),DS5258(5),DR5258(5)
      DIMENSION X27M(4),X27I(4),C27(6)
      EQUIVALENCE (RNFS,A(129)),(RNN,SLG(90)),(RLCOFF,SLG(89)),(CF,     &
     &SLG(88)),(CDF,SLG(87)),(SRSTAR,A(3)),(CBARI,A(15))                &
     &,(CBARO,A(17)),(RNI,SLG(86)),(RNO,SLG(85)),(CFI,SLG(84)),(CFO,    &
     &SLG(83)),(SISTAR,A(1)),(SOSTAR,A(2)),(P,SLG(82)),(DRAGC,SLG(81)   &
     &),(CDO,SLG(80)),(CDW,SLG(79))
      EQUIVALENCE (SBW,SLG(119)),(CR,WINGIN(6))
      EQUIVALENCE  (SIGMA,A(18))
      EQUIVALENCE (LERO,WINGIN(63)),(LERI,WINGIN(62)),(KSHARP,          &
     &WINGIN(71)),(TCEFF,WINGIN(70)),(CB,WINGIN(5)),                    &
     &(CT,WINGIN(1)),(SPANS,WINGIN(3))
      EQUIVALENCE (BETA,SLG(1)),(BOVERT,SLG(2)),(COSLE,A(61)),          &
     &(DETACH,SLG(94))
      EQUIVALENCE (TANLEO,A(86)),(TANLEI,A(62)),(COSLEO,A(85)),         &
     &(ARSTAR,A(7)),(CRSTAR,A(10))
      DATA Q15127 /4HCEPT/, Q15258 /4H4.1.,4H5.2-,4H58  /
      DATA ROUTID /4HSUPD,4HRG  /
      DATA WTYPE  /4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA X27M   /0.0,1.0,2.0,3.0/
      DATA X27I   /1.57780,1.67221,1.98509,2.28874/
      DATA I27    /0/
!
!              FIGURE 4.1.5.2-58
!
      DATA T15258/0.0,.28,.40,.50, 1.87/
      DATA DS5258/.54,.54,.559,.60,1.95/
      DATA DR5258/.54,.54,.593,.68,2.0/
!
      IF(TANLEO.EQ.0.0)TANLEO=.00001
      IF(TANLEI.EQ.0.0)TANLEI=.00001
!
!  ***WING SUPERSONIC ZERO-LIFT SKIN FRICTION DRAG,STRAIGHT TAPERED WING
!
      MACH=FLC(N+2)
      BETA=SQRT(MACH**2-1.)
      IF(WINGIN(15).NE.WTYPE(1))GO TO 1020
      CBAR=CBARI
 1000 RNN=CBAR*RNFS
      IF(RUFF.EQ.0.0)GO TO 1010
      ARG=12.*CBAR/RUFF
!
!                   FIGURE 4.1.5.1-27 (EQUATION FOR RLCOFF)
!
      RACH = MACH
      IF(RACH.GT.3.0)RACH=3.0
      CALL TBFUNX(RACH,CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,             &
     &            0,0,Q15127,3,ROUTID)
      RLCOFF=ARG**1.0482*10.0**CEPT
      IF(RLCOFF.LT.RNN)RNN=RLCOFF
 1010 CALL FIG26(RNN,RACH,CF)
      IF(WINGIN(15).NE.WTYPE(1))GO TO 1030
      CDF=CF*SRSTAR/SR*2.
      GO TO 1050
!
!  ***WING SUPERSONIC ZERO-LIFT SKIN FRICTION DRAG,NON-STRAIGHT WING***
!
 1020 CONTINUE
      CBAR=CBARI
      GO TO 1000
 1030 CONTINUE
      IF(CBAR.EQ.CBARO)GO TO 1040
      RNI=RNN
      CFI=CF
      CBAR=CBARO
      GO TO 1000
 1040 RNO=RNN
      CFO=CF
      CDF=(CFI*SISTAR+CFO*SOSTAR)/SR*2.
 1050 CONTINUE
!
!   ***SUPERSONIC WING ZERO-LIFT WAVE DRAG,SHARP L.E.,ALL PLANFORMS***
!
      IF(WINGIN(15).EQ.WTYPE(1))GO TO 1060
      TA=TANLEO
      S=SBW
      CA=COSLEO
      LERBW=LERO*((CR+CT+2.*CB)/4.)
      GO TO 1070
 1060 TA=TANLEI
      S=A(3)
      CA =COSLE
      LERBW=LERI*((CR+CT)/2.)
 1070 CONTINUE
      BOVERT=BETA/TA
      IF(KSHARP.EQ.UNUSED)GO TO 1080
      ARG=KSHARP*TCEFF**2*S  /SR
      CDW=ARG/BETA
      IF(BOVERT.LT.1.)CDW=ARG/TA
      GO TO 1090
 1080 CONTINUE
!
!  ***SUPERSONIC WING ZERO-LIFT WAVE DRAG,ROUND L.E.,ALL PLANFORMS***
!
      ARG1=1.28*MACH**3*CA    **6/(1.+MACH**3*CA    **3)
      ARG2=2.*LERBW*(2.*SPANS)/(SR*CA)
      CDLE=ARG1*ARG2
      ARG=     16.*TCEFF**2*S  /(3.*SR)
      IF(BOVERT.GE.1.)CDW=CDLE+ARG/BETA
      IF(BOVERT.LT.1.)CDW=CDLE+ARG/TA
 1090 CONTINUE
      CDO=CDF+CDW
!
!   ***SUPERSONIC INDUCED DRAG,STRAIGHT TAPERED PLANFORM***
!
      IF(WINGIN(15).NE.WTYPE(1))RETURN
      RLW=CT+SIGMA*CRSTAR
      P=SRSTAR/(RLW*2.*SPANS)
      ARG=(1.+P)/(PI*ARSTAR*P)
      ARG1=BETA*SPANS/RLW
!
!                   FIGURE 4.1.5.2-58 (PI*A*(CDL/CL**2)*(P/(1+P)))
!
      VAB(1)=ARG1
      LGB(1)=5
      IF(KSHARP.EQ.UNUSED) GO TO 1100
      CALL INTERX(1,T15258,VAB,LGB,DS5258,DRAGC,5,5,                    &
     &            0,0,0,0,1,0,0,0,Q15258,3,ROUTID)
      GO TO 1110
 1100 CALL INTERX(1,T15258,VAB,LGB,DR5258,DRAGC,5,5,                    &
     &            0,0,0,0,1,0,0,0,Q15258,3,ROUTID)
 1110 CONTINUE
      IF(TANLEO.EQ.0.00001)TANLEO=0.0
      IF(TANLEI.EQ.0.00001)TANLEI=0.0
      RETURN
      END
      SUBROUTINE SUPHB
!
!***  CALCULATES SUPERSONIC HORIZONTAL TAIL-BODY CL,CD,CLA AND CMA
!
      REAL MACH,NXX,KWB,KBW,IVBW  ,KKBW,KKWB
      DIMENSION ROUTID(2),Q1211A(3),Q1211B(3),Q31210(3),Q1212A(3),      &
     &          Q1212B(3),Q2118A(3),Q2118B(3),Q2137A(3),Q2137B(3)
      DIMENSION T4312B(8),D4312B(8)
      DIMENSION CDW(20),CDB(20),WTYPE(4),IVBW(20),GAMMA(20)
      DIMENSION T4337A(11),D4337A(24),T4337B(12),D4337B(20)
      DIMENSION T4312A(11),D4312A(11)
      DIMENSION TFIG10(11),DKWB10(11),DKBW10(11)
      DIMENSION T4218A(18),DL218A(54),DR218A(54),T4218B(14),DL218B(42), &
     &          DR218B(42)
      DIMENSION LGH(4),VAR(4),CD(20),CN(20),CA(20),CL(20),CLB(20),      &
     &          CLW(20),ALPHAB(20),CDL(20)
      DIMENSION CM(20)
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(160)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /HTI/    W(2),SPANS,SPAN,W1,CR,W2(8),TYPE
      COMMON /BODYI/  NXX,XCOOR(20),S(20),P(20),R(20),ZU(20),ZL(20),    &
     &                BNOSE,BTAIL,RLN, dum2(5)
      COMMON /BDATA/  BD(762)
      COMMON /HTDATA/ AHT(195)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /SUPBOD/ SBD(229)
      COMMON /SUPWBB/  SWB(61),SHB(61)
      COMMON /SUPWH/  SLG(141), STG(141)
      COMMON /IBODY/  PBODY, BODY(400)
      COMMON /IHT/    PHT, HT(380)
      COMMON /IBH/    PBH, BH(380)
!
      EQUIVALENCE (CA(1),BH(81)),(CDW(1),HT(1)),(CMA,BH(121)),          &
     &(DXCG,AHT(173)),(CLAB,SBD(18)),(KKWB,SHB(2)),                     &
     &(XACN,SHB(3)),(CDOWB,SHB(4)),(DELXW,BD(89)),(ARSTAR,AHT(7)),      &
     &(CD(1),BH(1)),(DD,SHB(5)),(XW,SYNA(6)),(CLB(1),BODY(21)),         &
     &(ALIW,SYNA(8)),(BETA,SHB(6)),(CLAW,HT(101)),                      &
     &(XACW,STG(134)),(CLABW,SHB(7)) ,(XACBW,SHB(8))
      EQUIVALENCE (CLA,BH(101)), (CDL(1),STG(53))
      EQUIVALENCE (CL(1),BH(21)),(FA,SHB(9)),(CLI,SHB(10)),             &
     &(KBW,SHB(11)),(CDOB,SBD(124)),(IVBW(1),SHB(12)),(RKBW,SHB(32)),   &
     &(CLAWB,SHB(33)),(TANL ,AHT(62)),(CRSTAR,AHT(10)),                 &
     &(TAPEXP,AHT(27)),(CN(1),BH(61)),(FN, SHB(34)),(CDB(1),BODY(1)),   &
     &(CLW(1),HT(21)),(KWB,SHB(35)),(XAC,SHB(36)), (CDOW,STG(80)),      &
     &(DN,SBD(4)),(D1,SBD(5)),(KKBW,SHB(37)),(RLAP,SHB(38))
      EQUIVALENCE (XACA,SHB(39)),(GAMMA(1),SHB(40)),                    &
     &(TRINO,SHB(60)),(XCPLN,SHB(61)),(ALPHAB(1),BD(255))               &
     &,(CM(1),BH(41))
!
      DATA ROUTID/4HSUPW,4HB   /,                                       &
     & Q31210/4H4.3.,4H1.2-,4H10  /,Q1212A/4H4.3.,4H1.2-,4H12A /,       &
     & Q2118A/4H4.2.,4H2.1-,4H23A /,Q1212B/4H4.3.,4H1.2-,4H12B /,       &
     & Q2118B/4H4.2.,4H2.1-,4H23B /,Q2137A/4H4.3.,4H2.2-,4H37A /,       &
     &                              Q2137B/4H4.3.,4H2.2-,4H37B /
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
!                   FIGURE 4.3.1,2-10 KWB
!
      DATA TFIG10/0.0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.0/
      DATA DKWB10/1.0,1.08,1.16,1.26,1.36,1.46,1.56,1.67,1.78,1.89,2.0/
!
!                   FIGURE 4.3.1.2-10 KBW
!
      DATA DKBW10/0.0,.13,.29,.45,.62,.80,1.0,1.22,1.45,1.70,2.0/
!
!               FIGURE 4.2.2.1-23A (LEFT SIDE)
!
      DATA T4218A                                                       &
     &  / 0., 0.2, 0.4, 0.6, 0.8, 1.0 , 3*0.0,                          &
     &    0.0, 0.4, 0.8, 1.2, 1.6, 2.0, 3.0, 4.0, 5.0 /
      DATA DL218A                                                       &
     & /  0.543,  0.542,  0.541,  0.540,  0.534,  0.526,                &
     &    0.400,  0.409,  0.418,  0.430,  0.441,  0.450,                &
     &    0.305,  0.328,  0.350,  0.369,  0.387,  0.400,                &
     &    0.238,  0.265,  0.295,  0.318,  0.339,  0.356,                &
     &    0.198,  0.221,  0.246,  0.274,  0.298,  0.320,                &
     &    0.160,  0.185,  0.210,  0.239,  0.262,  0.288,                &
     &    0.065,  0.095,  0.122,  0.150,  0.177,  0.210,                &
     &    0.000,  0.005,  0.035,  0.062,  0.089,  0.130,                &
     &    0.000,  0.000,  0.000,  0.000,  0.002,  0.050  /
!
!               FIGURE 4.2.2.1-23A (RIGHT SIDE)
!
      DATA DR218A                                                       &
     &  / 0.445,  0.464,  0.485,  0.500,  0.518,  0.526,                &
     &    0.448,  0.455,  0.460,  0.460,  0.459,  0.450,                &
     &    0.460,  0.449,  0.438,  0.424,  0.412,  0.400,                &
     &    0.450,  0.430,  0.412,  0.394,  0.375,  0.356,                &
     &    0.432,  0.410,  0.388,  0.365,  0.343,  0.320,                &
     &    0.420,  0.394,  0.369,  0.340,  0.314,  0.288 ,               &
     &    0.388,  0.354,  0.322,  0.278,  0.244,  0.210,                &
     &    0.357,  0.314,  0.273,  0.216,  0.171,  0.130,                &
     &    0.325,  0.274,  0.225,  0.154,  0.100,  0.050  /
!
!              FIGURE 4.2.2.1-23B (LEFT SIDE)
!
      DATA T4218B                                                       &
     &  / 0., 0.2, 0.4, 0.6, 0.8, 1.0  , 0.,                            &
     &    0.0, 0.5, 1.0, 2.0, 3.0, 4.0, 5.0 /
      DATA DL218B                                                       &
     & /  .665,  .665,  .665,  .665,  .665,  .665,                      &
     &    .425,  .492,  .539,  .550,  .550,  .550,                      &
     &    .330,  .370,  .405,  .438,  .459,  .470,                      &
     &    .184,  .215,  .250,  .284,  .318,  .350,                      &
     &    .060,  .097,  .133,  .170,  .206,  .240,                      &
     &    .000,  .000,  .044,  .083,  .127,  .170,                      &
     &    .000,  .000,  .000,  .020,  .063,  .105  /
!
!              FIGURE 4.2.2.1-23B (RIGHT SIDE)
!
      DATA DR218B                                                       &
     & /  .665,  .665,  .665,  .665,  .665,  .665,                      &
     &    .480,  .500,  .519,  .536,  .546,  .550,                      &
     &    .338,  .388,  .430,  .458,  .471,  .470,                      &
     &    .338,  .372,  .394,  .394,  .375,  .350,                      &
     &    .410,  .375,  .341,  .308,  .272,  .240,                      &
     &    .377,  .338,  .294,  .251,  .211,  .170,                      &
     &    .342,  .300,  .246,  .194,  .146,  .100   /
!
!                   FIGURE 4.3.1.2-12A (KBW)
!
      DATA T4312A/0.0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.0/
      DATA D4312A/0.0,.11,.21,.31,.41,.51,.6,.7,.8,.9,1.0/
!
!                   FIGURE 4.3.1.2-12B (KWB)
!
      DATA T4312B/.015,.1,.2,.3,.4,.6,.8,.975/
      DATA D4312B/1.,.975,.956,.947,.941,.950,.978,1.0/
!
!                   FIGURE 4.3.2.2-37A
!
      DATA T4337A/0.0,.4,.8,1.2,1.6,2.,2.4,2.8,                         &
     &           .1,1.0,999999./
      DATA D4337A/                                                      &
     &.5,.72,.900,1.08,1.24,1.39,1.53,1.68,                             &
     &.5,.72,.910,1.09,1.25,1.41,1.57,1.72,                             &
     &.5,.73,.920,1.11,1.27,1.43,1.59,1.74/
!
!                   FIGURE 4.3.2.2-37B
!
      DATA T4337B/0.0,.1,.2,.3,.4,.5,.6,.8,1.0,2.8,                     &
     &            0.2,999999./
      DATA D4337B/                                                      &
     &0.5,.56,.595,.62,.64,.65,.66,.669,.669,.671,                      &
     &0.5,.54,.578,.60,.62,.638,.649,.66,.669,.671/
!
      NX=NXX+.5
      DCYL=(DN+D1)/2.
      MACH=FLC(I+2)
      BETA=SQRT(MACH**2-1.)
      RLB=XCOOR(NX)
      DD=2.0*(SPAN-SPANS)
      TANLE=TANL
      IF(TANLE.EQ.0.0)TANLE=.00001
!
!   ***SUPERSONIC H.T.-BODY LIFT CURVE SLOPE,BODY IN PRESENCE OF H.T.***
!                         NON-TRIANGULAR H.T.S
!
      IF(TAPEXP.EQ.0.0)GO TO 1050
      ARG1=BETA*ARSTAR*(1.0+TAPEXP)
      ARG2=1.+TANLE/BETA
      TRINO=ARG1*ARG2
      IF(TRINO.LE.4.)GO TO 1030
 1000 OLE=AHT(34)
      DX=RLB-XW-DD*AHT(38)-CRSTAR
      IF(DX.LE.(-CRSTAR))RKBW=0.
      IF(DX.LE.(-CRSTAR))GO TO 1020
      CALL INTKBW(MACH,OLE,CRSTAR,DD,DX,RKBW,RXAC)
 1020 KBW=RKBW/(RAD*BETA*(SREF/AHT(3))*CLAW*(TAPEXP+1.)*(2.*SPAN/DD-1.))
      GO TO 1040
 1030 CONTINUE
      LGH(1)=11
      VAR(1)=DD/(2.*SPAN)
!
!                   FIGURE 4.3.1.2-10 KBW
!
      CALL INTERX(1,TFIG10,VAR,LGH,DKBW10,KBW,11,11,                    &
     &            0,0,0,0,0,0,0,0,Q31210,3,ROUTID)
 1040 CONTINUE
      GO TO 1060
!
!  ***SUPERSONIC H.T.-BODY LIFT CURVE SLOPE,BODY IN PRESENCE OF H.T.***
!                         TRIANGULAR H.T.
!
 1050 CONTINUE
      ARG=BETA*ARSTAR
      IF(ARG.GT.1.)GO TO 1000
      GO TO 1030
 1060 CONTINUE
!
!  ***SUPERSONIC H.T.-BODY LIFT CURVE SLOPE
!
      ALBO=BD(81)
      IF(BD(81).EQ.UNUSED)ALBO=0.0
      DO 1070 J=1,NALPHA
 1070 ALPHAB(J)=FLC(J+22)+ALBO
      VAR(1)=(SPAN-SPANS)/SPAN
      LGH(1)=11
!
!                   FIGURE 4.3.1.2-10 KWB
!
      CALL INTERX(1,TFIG10,VAR,LGH,DKWB10,KWB,11,11,                    &
     &            0,0,0,0,0,0,0,0,Q31210,3,ROUTID)
      CLAWB=CLAW*KWB
      CLABW=CLAW*KBW
      CLA=CLABW+CLAWB+CLAB
!
!  ***SUPERSONIC H.T.-BODY LIFT AT ANGLE OF ATTACK***
!
      IF(TYPE.NE.WTYPE(1))GO TO 1100
      IF(ALIW.EQ.0.0.OR.(ALIW.EQ.UNUSED))GO TO 1080
!
!                   FIGURE 4.3.1.2-12A (KBW) INCIDENCE
!
      CALL INTERX(1,T4312A,VAR,LGH,D4312A,KKBW,11,11,                   &
     &            0,0,0,0,0,0,0,0,Q1212A,3,ROUTID)
!
!                   FIGURE 4.3.1.2-12B (KWB) INCIDENCE
!
      LGH(1)=8
      CALL INTERX(1,T4312B,VAR,LGH,D4312B,KKWB,8,8,                     &
     &            0,0,0,0,0,0,0,0,Q1212B,3,ROUTID)
 1080 CLI=CLAW*ALIW
      DETCL=0.0
      XCBO4=XW+AHT(161)
      BMBS=SPAN-SPANS
      CALL BODOWG(BD(255),XCBO4,BMBS,SPAN,AHT(27),                      &
     &            IVBW,GAMMA,NALPHA)
      ARG1=KWB+KBW
      ARG2=(KKWB+KKBW)*CLI
      ARG3=CLAW*(DD/(2.*SPAN))
      DO 1090 J=1,NALPHA
         DETCL=ARG3*ALPHAB(J)*IVBW(J)*GAMMA(J)
 1090 CL(J)=CLB(J)+ARG1*(CLW(J)-CLI)+ARG2+DETCL
!
!  ***SUPERSONIC CENTER OF PRESSURE FOR BODY NOSE AND FORBODY***
!
 1100 CONTINUE
      DELXW=(SPAN-SPANS)*TANLE*COS(ALIW/RAD)
      RLAP=XW+DELXW-RLN
      ARG1=RLN
      IF(RLAP.LT.0.)ARG1=RLN+RLAP
      IF(RLAP.LT.0.)RLAP=0.0
      FA=RLAP/DCYL
      FN=ARG1/DCYL
      VAR(1)=BETA/FN
      VAR(2)=FA/FN
      LGH(1)=6
      LGH(2)=9
      IF(BNOSE.EQ.1.)GO TO 1120
!
!                   FIGURE 4.2.2.1-23A LEFT SIDE(XCP) OGIVE
!
      IF(VAR(1).GT.1.)GO TO 1110
      CALL INTERX(2,T4218A,VAR,LGH,DL218A,XCPLN,9,54,                   &
     &   0,0,0,0,0,0,0,0,Q2118A,3,ROUTID)
      GO TO 1140
 1110 VAR(1)=1./VAR(1)
!
!                   FIGURE 4.2.2.1-23A RIGHT SIDE(XCP) OGIVE
!
      CALL INTERX(2,T4218A,VAR,LGH,DR218A,XCPLN,9,54,                   &
     &   0,0,0,0,0,0,0,0,Q2118A,3,ROUTID)
      GO TO 1140
 1120 CONTINUE
!
!                   FIGURE 4.2.2.1-23B LEFT SIDE(XCP) CONE
!
      LGH(2)=7
      IF(VAR(1).GT.1.)GO TO 1130
      CALL INTERX(2,T4218B,VAR,LGH,DL218B,XCPLN,7,42,                   &
     &            0,0,0,0,0,0,0,0,Q2118B,3,ROUTID)
      GO TO 1140
 1130 VAR(1)=1./VAR(1)
!
!                   FIGURE 4.2.2.1-23B RIGHT SIDE(XCP) CONE
!
      CALL INTERX(2,T4218B,VAR,LGH,DR218B,XCPLN,7,42,                   &
     &            0,0,0,0,0,0,0,0,Q2118B,3,ROUTID)
 1140 CONTINUE
      XACN=(XCPLN-1.)*(ARG1+RLAP)/CBARR
!
!  ***SUPERSONIC H.T.-LIFT CARRYOVER ON BODY***
!
      VAR(1)=BETA*DD/CRSTAR
      VAR(2)=BETA/TANLE
      ARG=(XW+CR)/RLB
      IF(ARG.GT.1.)GO TO 1150
!
!                   FIGURE 4.3.2.2-37A(XAC)B(W)
!
      LGH(1)=8
      LGH(2)=3
      CALL INTERX(2,T4337A,VAR,LGH,D4337A,XACA,8,24,                    &
     &            0,0,0,0,1,0,0,0,Q2137A,3,ROUTID)
      GO TO 1160
!
!                   FIGURE 4.3.2.2-37B(XAC)B(W)
!
 1150 LGH(1)=10
      LGH(2)=2
      CALL INTERX(2,T4337B,VAR,LGH,D4337B,XACA,10,20,                   &
     &            0,0,0,0,0,0,0,0,Q2137B,3,ROUTID)
 1160 XACBW=XACA*CRSTAR/CBARR
      XACW=XACW*CRSTAR/CBARR
!
!  ***SUPERSONIC H.T.-BODY PITCHING MOMENT SLOPE***
!
      DNUM=XACN*CLAB+XACW*CLAWB+XACBW*CLABW
      DNOM=CLAB+CLAWB+CLABW
      XAC  =DNUM/DNOM
      CMA=(DXCG/CBARR-XAC)*CLA
!
!  ***SUPERSONIC H.T.-BODY DRAG***
!
      CDOWB=CDOW+CDOB
      DO 1170 J=1,NALPHA
         COSA=COS(FLC(J+22)/RAD)
         SINA=SIN(FLC(J+22)/RAD)
         CD(J)=CDOW+CDL(J)+CDB(J)
         CN(J)=CL(J)*COSA+CD(J)*SINA
!
!   COMPUTE DELTA XCP WING-BODY
!
         DXCPWB=DXCG/CBARR-SLG(134)
!
!   COMPUTE DELTA XCP BODY-WING
!
         DXCPBW=DXCG/CBARR-SWB(8)
!
!   COMPUTE DELTA CN VORTEX
!
         DCNV=SWB(11+J)*SWB(39+J)*SWB(5)/(2*SPAN)*BD(254+J)*HT(101)
!
!   COMPUTE WING-BODY PITCHING MOMENT
!
         BH(40+J)=BODY(40+J)+HT(60+J)*SWB(35)*DXCPWB                    &
     &            +HT(101)*SYNA(4)*SWB(2)*DXCPWB/RAD                    &
     &            +HT(60+J)*SWB(11)*DXCPBW                              &
     &            +HT(101)*SYNA(4)*SWB(37)*DXCPBW/RAD                   &
     &            +DCNV*DXCPBW                                          &
     &            +HT(80+J)*(SYNA(3)-SYNA(5))/CBARR
 1170 CA(J)=CD(J)*COSA-CL(J)*SINA
      RETURN
      END
      SUBROUTINE SUPHLD
!
!  THIS ROUTINE YIELDS THE SUPERSONIC WING ACCELERATION DERIVATIVE,CLAD
!
      INTEGER Y14111,D14111,D24111,D34111,D3A111,Y1A111,D1A111,D2A111
      REAL MACOE
      REAL MACH,LSTAR,LAMDA
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /SUPWH/  XSLG(141),SLG(141)
      COMMON /BDATA/  XBD(300),DYN(213)
      COMMON /HTDATA/ A(195)
      COMMON /IHT/    PWING, WING(380)
      COMMON /HTI/    WINGIN(101)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,       &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      DIMENSION ROUTID(2)
      DIMENSION Q71417(3),Q14111(3)
      DIMENSION I2A417(4),I2B417(4),I2C417(4)
      DIMENSION X2A417(16),Y1A417(16)
      DIMENSION X2B417(26),Y1B417(26)
      DIMENSION X2C417(15),Y1C417(15)
      DIMENSION X24111(15),X14111(7),X34111(5),Y14111(263)
      DIMENSION D14111( 99),D24111( 95),D34111(69)
      DIMENSION X2A111(15),X1A111(7),X3A111(5),Y1A111(263)
      DIMENSION D1A111( 99),D2A111( 95),D3A111( 69)
      EQUIVALENCE (D14111(1),Y14111(1)),(D24111(1),Y14111(100))
      EQUIVALENCE (D34111(1),Y14111(195))
      EQUIVALENCE (D1A111(1),Y1A111(1)),(D2A111(1),Y1A111(100))
      EQUIVALENCE (D3A111(1),Y1A111(195))
      EQUIVALENCE (MACOE,A(16)),(LSTAR,A(29)),                          &
     &            (XACCR,SLG(134)),(CRSTR,A(10)),                       &
     &            (ASTRW,A(7)),(LAMDA ,A(27)),(BETA,SLG(1)),            &
     &            (TANLE,A(62)),(SW,A(3))
      EQUIVALENCE (EPPBC,DYN(9)),(GBC,DYN(10)),(XACCRB,DYN(14)),        &
     &(F2N,DYN(24)),(F3X,DYN(25)),(F1N,DYN(23)),(CLAD1,DYN(22)),        &
     &(CLAD2,DYN(16)),(CLADWH,WING(241))
      DATA Q71417 /4H7.1.,4H4.1-,4H7   /
      DATA Q14111 /4H7.1.,4H4.1-,4H11  /
      DATA I2A417 /16,3*0/, I2B417 /26,3*0/, I2C417 /15,3*0/
!
!                       FIGURE 7141-7  F1(N)
!
      DATA X2A417                                                       &
     & / -1., -.8, -.6, -.4, -.2, 0., .2, .4, .5, .6, .7, .8, .85, .9,  &
     &    .95, 1.0  /
      DATA Y1A417                                                       &
     & / 1.7, 1.57, 1.42, 1.3, 1.17, 1., .87, .7, .65, .56, .45, .37,   &
     &   .33, .23, .2, 0. /
!
!                      FIGURE 7141-7  F2(N)
!
      DATA X2B417                                                       &
     & / -1., -.9, -.8, -.7, -.6, -.5, -.4, -.3, -.2, -.1, 0., .1, .2,  &
     &   .3, .4, .45, .5, .55, .6, .65, .7, .75, .8, .85, .9, .95 /
      DATA Y1B417                                                       &
     & / 1.2, 1.19, 1.18, 1.17, 1.16, 1.14, 1.13, 1.1, 1.08, 1.05, 1.,  &
     &   1., 1., 1., 1.01, 1.03, 1.05, 1.07, 1.12, 1.15, 1.2, 1.28,     &
     &   1.37, 1.5, 1.75, 2.5  /
!
!                       FIGURE 7141-7 F3(X)
!
      DATA X2C417                                                       &
     & / -1.0, -.8, -.6, -.4, -.2, 0., .2, .3, .4, .5, .6, .7, .8, .85 ,&
     &     1./
      DATA Y1C417                                                       &
     & /.66, .7, .75, .83, .92,1.02,1.19,1.34,1.52,1.83,2.3,3.2,5.25,   &
     & 7.3 , 14. /
      DATA X24111/0.,8.,12.,16.,20.,24.,28.,32.,34.,36.,38.,40.,42.,44.,&
     &45./
      DATA X14111 /3.,4.,5.,6.,8.,12.,20./
      DATA X34111 /0.,.25,.5,.75,1./
      DATA X2A111/0.,8.,12.,16.,20.,24.,28.,32.,34.,36.,38.,40.,42.,44.,&
     &45./
      DATA X1A111 /3.,4.,5.,6.,8.,12.,20./
      DATA X3A111 /0.,.25,.5,.75,1./
!
!        IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
!        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
!
!        THE FORMAT IS AS FOLLOWS-
!
!        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
!
!        WHERE-
!
!        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
!        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
!        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
!             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
!        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
!        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
!        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
!        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
!
      DATA D14111/  203000220,  133300360,  133400440,  133470480,      &
     &  133480480,  133470460,  133430400,  330390000,  133190250,      &
     &  133300340,  133360360,  133340320,  133300270,  133210140,      &
     &  340600000,  203000170,  133220250,  133280270,  133250200,      &
     &  133160100, 1144400500,-1133130220, -330260000,  133150180,      &
     &  133200220,  133200140,  340500000,-1133100210,-1133390600,      &
     &-1132840100,  203000110,  133140140,  134110600,-1143400200,      &
     &-1133300460,-1133670990,-1122139190, -320220000,  144700700,      &
     & 1144400300,-1133200300,-1133600800,-1122120160,-1122220320,      &
     &-1122450500,  204000300,-1144100800,-1133210500,-1132700120,      &
     &-1122160210,-1122290460,-1121670105, -114132500,  133240290,      &
     &  133330350,  133350340,  133320300,  133300300,  133300300,      &
     &  133310310,  143300180,  133210220,  133210200,  134140500,      &
     & 1204000700,-1133150230,-1133300350, -134380300,  133140160,      &
     &  133150130, 1144800200,-1133170280,-1133400550,-1133690800,      &
     &-1133890920,  143200120,  114120100, 1144800200,-1133150370,      &
     &-1133510700,-1132920120,-1122142165, -124173100,  144800700,      &
     & 1144200500,-1133170370,-1133700940,-1122124165,-1122220279,      &
     &-1122320350,  144100400, 1204000700,-1133200400,-1132700120,      &
     &-1122150200,-1122280390,-1122530700, -320800000,-1144100600/
      DATA D24111/                                                      &
     &-1133170350,-1132500100,-1122170230,-1122320450,-1122650950,      &
     &-1111150197,  133240320,  133340350,  133330320,  133310340,      &
     &  133360380,  133410440,  133470500,  133510170,  133220220,      &
     &  133200160,  330100000,-1133100150,-1133200230,-1133230220,      &
     &-1133200190,  133110140,  113150120, 1144500500,-1133200440,      &
     &-1133570700,-1133790850,-1133910960, -124100900,  133120100,      &
     & 1144500300,-1133180400,-1133700910,-1122112132,-1122150166,      &
     &-1122180189,  143600100, 1144400400,-1133150340,-1132650100,      &
     &-1122150200,-1122250300,-1122330380, -124400400, 1144400300,      &
     &-1133130300,-1132600100,-1122160220,-1122300400,-1122530700,      &
     &-1122830920, 1144200100,-1143900220,-1133410700,-1122130210,      &
     &-1122300390,-1122550850,-1111126190, -113228360,  133400400,      &
     &  133380370,  133370390,  133430450,  133470520,  133560600,      &
     &  133630650,  133280280,  133250210,  134150600,-1143500130,      &
     &-1133160180,-1133200210,-1133220220, -133220200,  133200150,      &
     &  330100000,-1133130320,-1133550630,-1133700750,-1133820870,      &
     &-1133900920,  133150150,  134100300,-1133100270,-1133550900,      &
     &-1122106124,-1122140158,-1122172190, -123199120,  134100400,      &
     &-1143700220,-1133450800,-1122140180,-1122240300,-1122330370/
      DATA D34111/                                                      &
     &-1122400400,  144800400,-1143400160,-1133350700,-1122110200,      &
     &-1122260360,-1122490630,-1122770900, -124990400,-1143100100,      &
     &-1133250500,-1122100140,-1122240330,-1122480680,-1121980140,      &
     &-1111200245,  133440420,  133390380,  133370380,  133400400,      &
     &  133400400,                                                      &
     &  133420430,  133230160,  134100100,-1133150370,-1132670110,      &
     &-1122134156,-1122175193,-1122210230, -123240160,  134120400,      &
     &-1133100280,-1133550800,-1122150210,-1122260310,-1122350420,      &
     &-1122470500,  134120600,-1143400180,-1133400710,-1122130220,      &
     &-1122290390,-1122500660,-1121800100, -114110700, 1203000100,      &
     &-1133270520,-1132900140,-1122300430,-1122660950,-1111131178,      &
     &-1111235270,  133440450,  133460330,  133310280,  133200130,      &
     & 1144500600,-1133140180,-1133220250,-1133300320,-1133330350,      &
     &  133270230,  133180100,-1143400200,-1133420690,-1133800900,      &
     &-1122100110,-1122120128, -320130000/
      DATA D1A111/  122400385,  122378375,  122370365,  122365362,      &
     &  122362365,  122365366,  122368370,  122372400,  122388383,      &
     &  122380377,  122375375,  122376378,  122380382,  122385390,      &
     &  122395401,  122400389,  122386385,  122382382,  122382385,      &
     &  122390395,  122398405,  122410420,  122426400,  122391388,      &
     &  122387387,  122387390,  122396401,  122405411,  122421430,      &
     &  122444450,  122400393,  122392390,  122394396,  122402410,      &
     &  122417426,  122435450,  122467485,  122495400,  122396396,      &
     &  122397402,  122407417,  122432442,  122457470,  122495520,      &
     &  122555574,  122400399,  122400405,  122410420,  122435455,      &
     &  122470485,  122510552,  122605675,  122717394,  122385380,      &
     &  122378377,  122378379,  122382384,  122388391,  122394400,      &
     &  122406409,  122396389,  122386385,  122385390,  122391398,      &
     &  122402407,  122413420,  122430447,  122455398,  122393392,      &
     &  122393395,  122401410,  122420427,  122437448,  122461480,      &
     &  122500513,  122397391,  122390392,  122392395,  122401410,      &
     &  122416424,  122432442,  122455472,  122482398,  122395395,      &
     &  122398402,  122410420,  122435445,  122458474,  122498523,      &
     &  122558572,  122399398,  122400403,  122410420,  122432452,      &
     &  122467485,  122509540,  122582640,  122675399,  122400403/
      DATA D2A111/                                                      &
     &  122408416,  122429447,  122471488,  122512548,  122600675,      &
     &  122780840,  122381376,  122375375,  122377380,  122385390,      &
     &  122395400,  122403410,  122417425,  122429387,  122384384,      &
     &  122385387,  122395402,  122410417,  122425433,  122442454,      &
     &  122467475,  122391388,  122387390,  122395403,  122412425,      &
     &  122433445,  122455471,  122490508,  122520392,  122390390,      &
     &  122395400,  122408418,  122435446,  122459475,  122498520,      &
     &  122543557,  122395394,  122395400,  122406415,  122428450,      &
     &  122462480,  122505533,  122567602,  122625397,  122397400,      &
     &  122405412,  122425442,  122465483,  122507540,  122575625,      &
     &  122680720,  122398399,  122402410,  122418433,  122453483,      &
     &  122502530,  122574627,  122710850,  122935367,  122367368,      &
     &  122370373,  122379384,  122392395,  122400405,  122411419,      &
     &  122429433,  122377377,  122379382,  122387393,  122404416,      &
     &  122425432,  122440453,  122467480,  122488382,  122383385,      &
     &  122389395,  122403416,  122433444,  122456471,  122488506,      &
     &  122527539,  122386387,  122389393,  122400411,  122426445,      &
     &  122458473,  122492514,  122540566,  122580390,  122392395,      &
     &  122400408,  122420437,  122460476,  122496520,  122553592/
      DATA D3A111/                                                      &
     &  122633658,  122394396,  122399403,  122415428,  122448475,      &
     &  122496522,  122558600,  122662750,  122780396,  122399403,      &
     &  122412421,  122437459,  122490513,  122547590,  122660770,      &
     &  121910100,  122356357,  122361365,  122370378,  122389400,      &
     &  122405411,  122416420,  122428433,  122440365,  122370373,      &
     &  122377383,  122392409,  122430440,  122444458,  122466478,      &
     &  122490495,  122372376,  122380385,  122392402,  122418440,      &
     &  122452470,  122485500,  122520540,  122550378,  122382385,      &
     &  122392400,  122411425,  122450460,  122480508,  122530555,      &
     &  122585600,  122383388,  122392397,  122407420,  122440470,      &
     &  122490520,  122550580,  122620670,  122685388,  122393397,      &
     &  122404413,  122425450,  122480504,  122540574,  122624695,      &
     &  122770820,  122394398,  122404411,  122421435,  122465492,      &
     &  122520558,  122600660,  122725940,  310105000/
      DATA ROUTID/4HSUPC,4HLD  /
!
      IF(TANLE.EQ.0.)TANLE=.00001
      COTLE=1./TANLE
      BCOTLE=BETA*COTLE
      ACOTBC=RAD*ATAN(1./BCOTLE)
      XACCRB=XACCR*CRSTR/CBARR
      SAVE=MACOE*SW/(CBARR*SR)
      BA=BETA*ASTRW
      EN=1.-4.*COTLE/ASTRW
!
!    ---- SUPERSONIC WING ACCELERATION DERIVATIVE,CLAD ----
!
      MACH=FLC(IM+2)
      QLAMDA=9.
      IF(BCOTLE.GE.1.)GO TO 1060
      IF(LAMDA.NE.0.)GO TO 1010
!
!           -- FIGURE 7.1.4.1-7 F1(N) --
!
 1000 CALL INTERX(1,X2A417,EN,I2A417,Y1A417,F1N,16,16,1,0,0,0,1,0,0,0,  &
     &            Q71417,3,ROUTID)
!
!           -- FIGURE 7.1.4.1-7 F2(N) --
!
      CALL INTERX(1,X2B417,EN,I2B417,Y1B417,F2N,26,26,1,0,0,0,1,0,0,0,  &
     &            Q71417,3,ROUTID)
!
!           -- FIGURE 7.1.4.1-7 F3(X) --
!
      CALL INTERX(1,X2C417,EN,I2C417,Y1C417,F3X,15,15,2,0,0,0,2,0,0,0,  &
     &            Q71417,3,ROUTID)
      F3X=F3X*(1.-EN)
      CLADWH=-.027414*ASTRW*MACH**2/BETA**2*(-3.*GBC*F3X+2.*EPPBC*F2N+  &
     &        EPPBC*F1N/MACH**2)*SAVE
      IF(QLAMDA.LT.5.)GO TO 1040
      GO TO 1070
 1010 IF(LAMDA.LT.0.25)GO TO 1030
!
!           -- CALCA IS THE EQUATION SHOWN BY FIGURE 7.1.4.1-8 --
!
 1020 CALL CALCA(DYN,A,WINGIN)
      CLADWH=SAVE/(RAD*BETA**2)*(MACH**2*CLAD1-CLAD2)
      IF(QLAMDA.LT.0.25)GO TO 1050
      GO TO 1070
 1030 CONTINUE
      QLAMDA=LAMDA
      LAMDA=0.
      GO TO 1000
 1040 CLD1=CLADWH
      LAMDA=.25
      GO TO 1020
 1050 CLADWH=(CLADWH-CLD1)*4.*QLAMDA+CLD1
      GO TO 1070
!
!           -- FIGURE 7.1.4.1-11A,B,C,D,E,F,G,H,I,J,K,L,M,N,O --
!
 1060 CALL TLIP3X(X14111,X24111,X34111,Y14111,7,15,5,BA,ACOTBC,LAMDA,   &
     &            BCLAD1,2,1,0,1,1,0,Q14111,3,ROUTID)
      CALL TLIP3X(X1A111,X2A111,X3A111,Y1A111,7,15,5,BA,ACOTBC,LAMDA,   &
     &            BCLAD2,2,1,0,2,1,0,Q14111,3,ROUTID)
      CLADWH=SAVE/(RAD*BETA**3)*(MACH**2*BCLAD1-BCLAD2)
 1070 CONTINUE
      IF(TANLE.EQ..00001)TANLE=0.
      RETURN
      END
      SUBROUTINE SUPHMD
!
!     THIS ROUTINE YIELDS THE SUPERSONIC WING ACCELERATION DERIVATIVE,CM
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /HTDATA/ A(195)
      COMMON /SUPWH/  XSLG(141),SLG(141)
      COMMON /BDATA/  XBD(300),DYN(213)
      COMMON /IHT/    PWING, WING(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,       &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      INTEGER D14213,D24213,D34213,Y1A213,D1A213,D2A213,D3A213,Y14213
      REAL MACOE
      REAL MACH,LSTAR,LAMDA
      DIMENSION ROUTID(2)
      DIMENSION Q71429(3),Q14213(3)
      DIMENSION I2A429(4),I2B429(4)
      DIMENSION X2B429(18),Y7B429(18)
      DIMENSION X2A429(17),Y7A429(17)
      DIMENSION D14213( 99),D24213( 95),D34213( 69)
      DIMENSION X2A213(15),X1A213(7),X3A213(5),Y1A213(263)
      DIMENSION X24213(15),X14213(7),X34213(5),Y14213(263)
      DIMENSION D1A213( 99),D2A213( 95),D3A213( 69)
      EQUIVALENCE (D14213(1),Y14213(1)),(D24213(1),Y14213(100)),(D34213(&
     &1),Y14213(195))
      EQUIVALENCE(D1A213(1),Y1A213(1)),(D2A213(1),Y1A213(100))
      EQUIVALENCE(D3A213(1),Y1A213(195))
      EQUIVALENCE(MACOE,A(16)),(LSTAR,A(29)),(TANLE,A(62)),             &
     &(XACCR,SLG(134)),(CRSTR,A(10)),(SW,A(3)),(DXCG,A(173)),           &
     &(ASTRW,A(7)),(LAMDA ,A(27)),(BETA,SLG(1))
      EQUIVALENCE(EPPBC,DYN(9)),(GBC,DYN(10)),(XACCRB,DYN(14)),         &
     &(F5N,DYN(17)),(F7N,DYN(18)),(F11N,DYN(19)),(CMADPP,DYN(7)),       &
     &(CLADWH,WING(241)),(F6N,DYN(8)),(F8N,DYN(5)),(CMADWH,WING(261))
      EQUIVALENCE(CMAD1,DYN(26)),(CMAD2,DYN(27))
      DATA Q71429 /4H7.1.,4H4.2-,4H9   /
      DATA Q14213 /4H7.1.,4H4.2-,4H13  /
      DATA              I2A429/17,3*0.0/,I2B429/18,3*0.0/
!
!                        FIGURE 7142-9 (F6(N))
!
      DATA X2A429                                                       &
     & / -1., -.8, -.6, -.4, -.2, 0., .1, .2, .3, .4, .5, .6, .7, .75,  &
     &   .8, .85, .9  /
      DATA Y7A429                                                       &
     & / 5.43, 4.6, 3.7, 2.8, 1.9, 1., .45, -.05, -.6, -1.25, -1.88,    &
     &   -2.6, -3.5, -4., -4.93, -6., -7.5 /
!
!                        FIGURE 7142-9  (F8(N))
!
      DATA X2B429                                                       &
     & / -1., -.9, -.8, -.7, -.6, -.5, -.4, -.3, -.2, -.1, 0., .1, .2,  &
     &    .3, .4, .5, .6, .7 /
      DATA Y7B429                                                       &
     & / .385, .35, .32, .293, .27, .25, .23, .22, .21, .21, .22, .235, &
     &   .275, .34, .45, .6, .875, 1.45  /
      DATA X24213/0.,8.,12.,16.,20.,24.,28.,32.,34.,36.,38.,40.,42.,44.,&
     &45./
      DATA X14213 /3.,4.,5.,6.,8.,12.,20./
      DATA X34213 /0.,.25,.5,.75,1./
      DATA X2A213/0.,8.,12.,16.,20.,24.,28.,32.,34.,36.,38.,40.,42.,44.,&
     &45./
      DATA X1A213 /3.,4.,5.,6.,8.,12.,20./
      DATA X3A213 /0.,.25,.5,.75,1./
!
!        IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
!        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
!
!        THE FORMAT IS AS FOLLOWS-
!
!        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
!
!        WHERE-
!
!        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
!        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
!        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
!             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
!        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
!        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
!        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
!        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
!
      DATA D14213/  122600550,  122540543,  122555575,  122595615,      &
     &  122625635,  122650665,  122675690,  122700600,  122600600,      &
     &  122610620,  122640665,  122690705,  122725750,  122790830,      &
     &  122880900,  122600615,  122625640,  122665690,  122725775,      &
     &  122805845,  122885940,  111101109,  112114600,  122625650,      &
     &  122675705,  122745800,  122865910,  121980106,  111115125,      &
     &  111136143,  122600657,  122690735,  122780850,  121940105,      &
     &  111113122,  111135150,  111170200,  112210600,  122710770,      &
     &  122850940,  111105120,  111142155,  111180220,  111265320,      &
     &  111385420,  122600800,  121925105,  111122144,  111175215,      &
     &  111250320,  111450605,  310800103,  202114575,  122590600,      &
     &  122615630,  122650680,  122715735,  122750770,  122735800,      &
     &  122820825,  122575615,  122635660,  122690735,  122785860,      &
     &  122900950,  111101108,  111114120,  112123580,  122635670,      &
     &  122710750,  122815900,  111100107,  111114123,  111134146,      &
     &  111159166,  122585650,  122700750,  122815900,  111100115,      &
     &  111125136,  111150167,  111180205,  112220590,  122690760,      &
     &  122840940,  111105121,  111144157,  111175200,  111235275,      &
     &  111325345,  122590765,  121875100,  111115135,  111160200,      &
     &  111225280,  111350440,  111540650,  112700595,  121900110/
      DATA D24213/                                                      &
     &  111130157,  111190235,  111310365,  111450570,  310750101,      &
     &     133152,  122510560,  122580615,  122650685,  122735800,      &
     &  122830870,  122900930,  121965100,  112102530,  122590635,      &
     &  122680740,  122805890,  121990105,  111113119,  111126135,      &
     &  111144147,  122535625,  122680750,  122820915,  111103120,      &
     &  111130142,  111154166,  111180195,  112205540,  122650720,      &
     &  122800900,  111101118,  111140155,  111170185,  111210235,      &
     &  111255270,  122545710,  122800915,  111105122,  111146180,      &
     &  111205235,  111275315,  111365410,  112435550,  122800950,      &
     &  111113134,  111161200,  111255300,  111360460,  111580715,      &
     &  111860980,  122550990,  111123154,  111190235,  111290390,      &
     &  111470600,  310790110,     155220,  202265465,  122535575,      &
     &  122620665,  122720790,  122855895,  122935975,  111101105,      &
     &  111110112,  122490585,  122640700,  122775860,  121975110,      &
     &  111119128,  111136145,  111155165,  112170500,  122625695,      &
     &  122775875,  121995115,  111135148,  111160170,  111185200,      &
     &  111220230,  122510655,  122745850,  121965113,  111133160,      &
     &  111175190,  111210230,  111255285,  112300520,  122720845,      &
     &  121980115,  111136165,  111210240,  111275320,  111365415/
      DATA D34213/                                                      &
     &  111465490,  122525840,  111101122,  111148180,  111225300,      &
     &  111350435,  111545675,  310835100,  202108565,  111105134,      &
     &  111163210,  111265340,  111450550,  111715975,     133183,      &
     &     258300,  122400490,  122530600,  122650700,  122790900,      &
     &  121930102,  111111116,  111120130,  112134410,  122530600,      &
     &  122700750,  122830950,  111115120,  111131141,  111160169,      &
     &  111180187,  122440610,  122680770,  121870100,  111119140,      &
     &  111158170,  111184204,  111220240,  112250460,  122670750,      &
     &  122850980,  111117135,  111169182,  111208230,  111257282,      &
     &  111312330,  122470730,  121800100,  111120140,  111170212,      &
     &  111235270,  111310365,  111430500,  112560480,  121850110,      &
     &  111130160,  111196250,  111320460,  111500550,  111680850,      &
     &     105116,  121490110,  111140184,  111239297,  111375550,      &
     &  111610900,     106147,     209280,     322000/
      DATA D1A213/-1122300300,-1122305307,-1122310313,-1122317330,      &
     &-1122335342,-1122350357,-1122364370,-1122375300,-1122305310,      &
     &-1122318327,-1122335350,-1122365375,-1122385395,-1122412426,      &
     &-1122440450,-1122300315,-1122325335,-1122345362,-1122380400,      &
     &-1122413428,-1122445465,-1122490520,-1122530300,-1122320335,      &
     &-1122350365,-1122382410,-1122433455,-1122480510,-1122540570,      &
     &-1122600615,-1122300330,-1122350375,-1122400427,-1122463506,      &
     &-1122535568,-1122613660,-1122713775,-1122805300,-1122357390,      &
     &-1122425470,-1122515570,-1122640690,-1122750837,-1121935105,      &
     &-1111118123,-1122300400,-1122460520,-1122590670,-1122770900,      &
     &-1121990111,-1111132154,-1111180211,-1112227290,-1122300307,      &
     &-1122316327,-1122340355,-1122375385,-1122400415,-1122430450,      &
     &-1122467475,-1122290313,-1122325340,-1122357375,-1122400430,      &
     &-1122450470,-1122495525,-1122552582,-1122600290,-1122320336,      &
     &-1122363382,-1122410442,-1122485510,-1122540580,-1122620670,      &
     &-1122725750,-1122290330,-1122355380,-1122410440,-1122482535,      &
     &-1122570615,-1122665725,-1122795865,-1122900290,-1122350380,      &
     &-1122420460,-1122510563,-1122640690,-1122755835,-1121925103,      &
     &-1111115123,-1122290380,-1122435490,-1122560635,-1122720840,      &
     &-1121915102,-1111120138,-1111162188,-1112200290,-1122450540/
      DATA D2A213/                                                      &
     &-1122635740,-1121875102, -111120135,-1111163198,-1111238285,      &
     &-1111343370,-1122265285,-1122300315,-1122335355,-1122375405,      &
     &-1122420435,-1122455480,-1122505530,-1122550275,-1122305325,      &
     &-1122350370,-1122400435,-1122480506,-1122535570,-1122610655,      &
     &-1122695720,-1122275320,-1122343370,-1122407445,-1122493550,      &
     &-1122590635,-1122685745,-1122805875,-1122910275,-1122330365,      &
     &-1122400440,-1122487550,-1122625665,-1122725800,-1122875965,      &
     &-1111107110,-1122275355,-1122400450,-1122505570,-1122650755,      &
     &-1122825905,-1111100112,-1111125150,-1112160275,-1122400470,      &
     &-1122545630,-1122730853,-1111103110,-1111130150,-1111175200,      &
     &-1111240260,-1122275490,-1122605735,-1121870104,-1111130150,      &
     &-1111175200,-1111235290,-1111365470,-1112510245,-1122278295,      &
     &-1122315335,-1122363390,-1122425440,-1122465490,-1122515545,      &
     &-1122570590,-1122255300,-1122320350,-1122380420,-1122463515,      &
     &-1122550580,-1122617660,-1122710760,-1122790265,-1122315350,      &
     &-1122380425,-1122470530,-1122600650,-1122700760,-1122830900,      &
     &-1121980102,-1122265330,-1122370415,-1122463520,-1122590685,      &
     &-1122740805,-1122890990,-1111109119,-1112124270,-1122360415,      &
     &-1122475540,-1122615710,-1122840920,-1111103115,-1111130150/
      DATA D3A213/                                                      &
     &-1111170180,-1122270415,-1122500585,-1122683800,-1121950115,      &
     & -111130150,-1111175200,-1111225275,-1112290270,-1122530650,      &
     &-1122800965,-1111120140,-1111170200,-1111230275,-1111320400,      &
     &-1111525600,-1122235262,-1122280311,-1122339376,-1122426488,      &
     &-1122520552,-1122585624,-1122655690,-1122713240,-1122290318,      &
     &-1122345380,-1122425485,-1122560600,-1122640681,-1122730777,      &
     &-1122825850,-1122250310,-1122345380,-1122428476,-1122550625,      &
     &-1122670725,-1122782860,-1121958107,-1112112250,-1122327375,      &
     &-1122424475,-1122541620,-1122710770,-1122832910,-1111103118,      &
     &-1111130138,-1122255360,-1122423480,-1122560650,-1122758890,      &
     &-1121975108,-1111122140,-1111161180,-1112192258,-1122415510,      &
     &-1122610720,-1121850103,-1111125104,-1111160184,-1111218255,      &
     &-1111295320,-1122260540,-1122688850,-1111103125,-1111158185,      &
     &-1111218263,-1111326417,-1111510608, -310660000/
      DATA ROUTID/4HSUPC,4HMD  /
!
      IF(TANLE.EQ.0.)TANLE=.00001
      COTLE=1./TANLE
      MACH=FLC(IM+2)
      BCOTLE=BETA*COTLE
      ACOTBC=RAD*ATAN(1./BCOTLE)
      XACCRB=XACCR*CRSTR/CBARR
      SAVE=MACOE*SW/(CBARR*SR)
      BA=BETA*ASTRW
      DEE=.66667*LSTAR
      EN=1.-4.*COTLE/ASTRW
!
!    ---- SUPERSONIC ACCELERATION DERIVATIVE,CMAD ----
!
      QLAMDA=8.
      IF(BCOTLE.GE.1.)GO TO 1060
      IF(LAMDA.NE.0.)GO TO  1010
!
!           -- FIGURE 7.1.4.2-9 F6(N) --
!
 1000 CALL INTERX(1,X2A429,EN,I2A429,Y7A429,F6N,17,17,1,0,0,0,1,0,0,0,  &
     &           Q71429,3,ROUTID)
!
!           -- FIGURE 7.1.4.2-9 F8(N) --
!
      CALL INTERX(1,X2B429,EN,I2B429,Y7B429,F8N,18,18,1,0,0,0,1,0,0,0,  &
     &            Q71429,3,ROUTID)
      XX=-.010281*ASTRW*MACH**2/BETA**2*SAVE*MACOE/CBARR
      YY=GBC*F7N+5.3333*EPPBC*F5N/F11N
      ZZ=SAVE*MACOE/(CBARR*RAD)
      WW=1.77778*ASTRW*MACH**2*EPPBC*F8N/BETA**2+.19635*ASTRW*EPPBC*    &
     &   F6N/BETA**2
      CMADPP=XX*YY+ZZ*WW-(DEE*CLADWH)/CBARR
      IF(QLAMDA.LT.5.)GO TO 1040
      GO TO 1070
 1010 IF(LAMDA.LT.0.25)GO TO 1030
 1020 CONTINUE
      CMADPP=SAVE*MACOE/(BETA**2*CBARR*RAD)*(MACH**2*CMAD1-CMAD2)
      IF(QLAMDA.LT.0.25)GO TO 1050
      GO TO 1070
 1030 CONTINUE
      QLAMDA=LAMDA
      LAMDA=0.
      GO TO 1000
 1040 CMDD1=CMADWH
      LAMDA=.25
      GO TO 1020
 1050 CMADPP=(CMADPP-CMDD1)*4.*LAMDA+CMDD1
      GO TO 1070
!
!           -- FIGURE 7.1.4.2-13A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P --
!
 1060 CALL TLIP3X(X14213,X24213,X34213,Y14213,7,15,5,BA,ACOTBC,LAMDA,   &
     &            BCMAD1,1,1,0,2,1,0,Q14213,3,ROUTID)
      CALL TLIP3X(X1A213,X2A213,X3A213,Y1A213,7,15,5,BA,ACOTBC,LAMDA,   &
     &            BCMAD2,1,1,0,2,1,0,Q14213,3,ROUTID)
      CMADPP=SAVE*MACOE/(CBARR*RAD)*(MACH**2/BETA**3*BCMAD1+(MACH**2/   &
     &       BETA**2+1.)*BCMAD2/BETA)
 1070 CMADWH=CMADPP+DXCG*CLADWH/CBARR
      IF(TANLE.EQ..00001)TANLE=0.
      RETURN
      END
      SUBROUTINE SUPHMQ
!
!     THIS ROUTINE YIELDS THE SUPERSONIC WING PITCHING DERIVATIVE,CMQ
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /HTDATA/ A(195)
      COMMON /HTI/    WINGIN(77)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /BDATA/  XBD(300),DYN(213)
      COMMON /IHT/    PW, WING(380)
      COMMON /SUPWH/  XSLG(141),SLG(141)
      COMMON /SBETA/  XSTB(243),TRA(108),STB(135)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      INTEGER Y71129,D11129,D21129,D31129,D41129,D51129,D61129,Y11210,  &
     & D11210,D21210,D31210,D41210,D51210,D61210,D71210,D81210,D91210,  &
     & D10210
      REAL MACOE
      REAL MACH,LSTAR,LAMDA
      DIMENSION ROUTID(2)
      DIMENSION WTYPE(4)
      DIMENSION Q71128(3),Q71129(3),Q11210(3)
      DIMENSION I2A128(4),I2B128(4)
      DIMENSION X2A128(16),Y1A128(16)
      DIMENSION X2B128(17),Y1B128(17)
      DIMENSION X21129(40),X11129(8),X31129(3),Y71129(430)
      DIMENSION D11129( 80),D21129( 80),D31129( 80),D41129( 80),D51129( &
     &80),D61129( 80)
      DIMENSION X21210(26),X11210(9),X31210(5),Y11210( 585)
      DIMENSION D11210( 65),D21210( 52),D31210( 65),D41210( 52),D51210( &
     &65),D61210( 52),D71210( 65),D81210( 52),D91210( 65),D10210( 52)
      DIMENSION CX(6),QCLAMA(3)
      EQUIVALENCE (D11129(1),Y71129(1)),(D21129(1),Y71129( 81)),(D31129(&
     &1),Y71129(161)),(D41129(1),Y71129(241)),(D51129(1),Y71129(321)),  &
     &(D61129(1),Y71129(401))
      EQUIVALENCE (D11210(1),Y11210(1)),(D21210(1),Y11210( 66)),(D31210(&
     &1),Y11210(118)),(D41210(1),Y11210(183)),(D51210(1),Y11210(235)),(D&
     &61210(1),Y11210(300)),(D71210(1),Y11210(352)),(D81210(1),Y11210(41&
     &7)),(D91210(1),Y11210(469)),(D10210(1),Y11210( 534))
      EQUIVALENCE(MACOE,A(16)),(LSTAR,A(29)),(CRSTR,A(10))              &
     &,(ASTRW,A(7)),(LAMDA ,A(27)),(TANLE,A(62)),(SW,A(3)),(DXCG,A(173))
      EQUIVALENCE(EPPBC,DYN(9)),(GBC,DYN(10)),(CLQPWH,DYN(11))          &
     &,(XACCRB,DYN(14)),(CMQMFB,DYN(1)),(CMQWT,WING(221))               &
     &,(CLQWH,WING(201)),(F5N,DYN(17)),(F7N,DYN(18)),(F11N,DYN(19))     &
     &,(CMQPWH,DYN(20)),(CMQWH,WING(221)),(BCLQPP,DYN(15))
      DATA Q71128 /4H7.1.,4H1.2-,4H8   /
      DATA Q71129 /4H7.1.,4H1.2-,4H9   /
      DATA Q11210 /4H7.1.,4H1.2-,4H10  /
      DATA I2A128 /16,3*0/,I2B128/17,3*0/
      DATA QCLAMA /4HCLA ,4HVS M,4HACH /
      DATA IX/0/
!
!                   FIGURE 7.1.1.2-8  F5(N)
!
      DATA X2A128                                                       &
     & / -1.0, -0.8, -0.6, -0.4, -0.2, 0.0, 0.1, 0.2, 0.3, 0.4, 0.5,    &
     &    0.6, 0.65, 0.7, 0.75, 0.8  /
      DATA Y1A128                                                       &
     & / -0.17, -0.15, -0.13, -0.10, -0.06, 0.0, 0.04, 0.09, 0.17, 0.26,&
     &    0.39, 0.62, 0.80, 1.10, 1.44, 2.00  /
!
!                   FIGURE 7.1.1.2-8   F7(N)
!
      DATA X2B128                                                       &
     & / -1.0, -0.8, -0.6, -0.4, -0.2, 0.0, 0.1, 0.2, 0.3, 0.4, 0.5,    &
     &    0.6, 0.65, 0.7, 0.75, 0.8, 0.85 /
      DATA Y1B128                                                       &
     & / 3.9, 3.35, 2.8, 2.2, 1.65, 1.0, 0.07, 0.035, -0.005, -0.5 ,    &
     &   -1.0, -1.6, -2.2, -2.4, -2.9, -3.7, -6.0  /
!
!                                FIGURE 7.1.1.2-9A,B,C
!
      DATA X21129                                                       &
     & / 0., .1, .2, .25, .3, .35, .385, .4, .43, .45, .46, .48, .53,   &
     &   .55, .56, .575, .6, .61, .62, .635, .65, .675, .69, .715, .725,&
     &   .75, .76, .775, .79, .805, .815, .835, .85, .87, .88, .91, .93,&
     &   .945, .97, 1. /
      DATA X11129/1.,2.,3.,4.,5.,6.,8.,10./
      DATA X31129/.25,.5,.75/
!
! FIGURE 7.1.1.2-10A,B,C,D,E,F,G,H,I,J,K (TAPER RATIO=0,.25,.5,.75,1.)
!
      DATA X21210                                                       &
     & / 0., .1, .2, .5, .7, 1.0, 2., 4., 5., 6., 8., 9., 11., 12., 14.,&
     &  15., 18., 20., 22., 24., 27., 32., 35., 36., 40., 45. /
      DATA X11210/1.,2.,3.,4.,5.,6.,8.,12.,20./
      DATA X31210/0.,.25,.5,.75,1./
!
!        IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
!        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
!
!        THE FORMAT IS AS FOLLOWS-
!
!        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
!
!        WHERE-
!
!        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
!        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
!        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
!             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
!        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
!        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
!        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
!        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
!
      DATA D11129/  202000250,  122400500,  122600550,  122400400,      &
     &  122400350,  122300300,  122300300,  122300300,  122250200,      &
     &  122200200,  122200200,  122200200,  122200200,  122200200,      &
     &  122200200,  122200200,  122200200,  122200200,  122200200,      &
     &  122200200,  202000300,  122550700,  121850105,  111120120,      &
     &  111120110,  111105100,  122900900,  122900900,  122850800,      &
     &  122800800,  122800750,  122700700,  122700600,  122600600,      &
     &  122550550,  122550500,  122500500,  122500500,  122500500,      &
     &  122500500,  202000300,  122550700,  121850105,  111120125,      &
     &  111145155,  111160180,  111175165,  111165165,  111155155,      &
     &  111150145,  111145140,  111135130,  111130120,  111120115,      &
     &  111110110,  111105100,  111100100,  111100100,  112100950,      &
     &  122900900,  202000300,  122550700,  121850105,  111120125,      &
     &  111145155,  111160180,  111230260,  111260260,  111250250,      &
     &  111250235,  111230220,  111215200,  111200190,  111190180,      &
     &  111175170,  111170160,  111155150,  111150150,  111145140,      &
     &  111135135/
      DATA D21129/  202000300,  122550700,  121850105,  111120125,      &
     &  111145155,  111160180,  111230260,  111270290,  111340360,      &
     &  111350350,  111345335,  111320300,  111295285,  111285280,      &
     &  111270260,  111250250,  111240230,  111230210,  111200200,      &
     &  111190180,  202000300,  122550700,  121850105,  111120125,      &
     &  111145155,  111160180,  111230260,  111270290,  111340360,      &
     &  111380420,  111460455,  111445440,  111425410,  111400390,      &
     &  111380365,  111360350,  111340330,  111320300,  111290280,      &
     &  111270250,  202000300,  122550700,  121850105,  111120125,      &
     &  111145155,  111160180,  111230260,  111270290,  111340360,      &
     &  111380420,  111460550,  111600740,  111730720,  111710700,      &
     &  111685660,  111650620,  111600580,  111570530,  111510490,      &
     &  111480450,  202000300,  122550700,  121850105,  111120125,      &
     &  111145155,  111160180,  111230260,  111270290,  111340360,      &
     &  111380420,  111460550,  111600740,  111780980,     109108,      &
     &     107106,  201104990,  111960920,  111900840,  111800780,      &
     &  111750720/
      DATA D31129/  202000100,  122220260,  122290330,  122390410,      &
     &  122460500,  122480450,  122410390,  122370370,  122360360,      &
     &  122360350,  122340330,  122330330,  122320310,  122310310,      &
     &  122310310,  122310310,  122310310,  122310310,  122310300,      &
     &  122300300,  202000200,  122410500,  122610760,  122870940,      &
     &  121980100,  111100100,  111100100,  111100100,  112100990,      &
     &  122970920,  122910870,  122850800,  122780750,  122740720,      &
     &  122710700,  122690680,  122670660,  122650620,  122620610,      &
     &  122600600,  202000200,  122410500,  122610760,  122870940,      &
     &  121980117,  111125140,  111176170,  111166165,  111161161,      &
     &  111160160,  111160160,  111154150,  111146140,  111138132,      &
     &  111130126,  111124120,  111118115,  111112100,  111100100,      &
     &  111100100,  202000200,  122410500,  122610760,  122870940,      &
     &  121980117,  111125140,  111182203,  111220238,  111268262,      &
     &  111260255,  111250246,  111242240,  111238235,  111227222,      &
     &  111219210,  111208200,  111198190,  111185177,  111172167,      &
     &  111160155/
      DATA D41129/  202000200,  122410500,  122610760,  122870940,      &
     &  121980117,  111125140,  111182203,  111220238,  111268287,      &
     &  111300335,  111370360,  111353350,  111345338,  111337336,      &
     &  111333320,  111313300,  111294286,  111280267,  111260250,      &
     &  111240230,  202000200,  122410500,  122610760,  122870940,      &
     &  121980117,  111125140,  111182203,  111220238,  111268287,      &
     &  111300335,  111370445,  111500490,  111482470,  111465462,      &
     &  111458450,  111448432,  111420406,  111400380,  111369352,      &
     &  111340325,  202000200,  122410500,  122610760,  122870940,      &
     &  121980117,  111125140,  111182203,  111220238,  111268287,      &
     &  111300335,  111370445,  111500575,  111640815,  111807800,      &
     &  111790778,  111773760,  111750725,  111710670,  111647622,      &
     &  111595570,  202000200,  122410500,  122610760,  122870940,      &
     &  121980117,  111125140,  111182203,  111220238,  111268287,      &
     &  111300335,  111370445,  111500575,  111640815,  310920104,      &
     &     123122,     121119,     118117,     115109,     105101,      &
     &  111960900/
      DATA D51129/  203000500,  133700900,  122120150,  122200200,      &
     &  122200200,  122200200,  122210220,  122220220,  122230230,      &
     &  122230230,  122230240,  122240260,  122270270,  122270280,      &
     &  122280280,  122280280,  122290290,  122290300,  122300300,      &
     &  122300300,  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  122860830,  122830830,  122820810,      &
     &  122810810,  122800800,  122800800,  122800800,  122800800,      &
     &  122780750,  122740700,  122700690,  122680650,  122630630,      &
     &  122620600,  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  111123140,  111146155,  111153150,      &
     &  111150150,  111146142,  111141140,  111140137,  111135134,      &
     &  111134132,  111132130,  111130124,  111122117,  111113111,      &
     &  111108100,  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  111123140,  111146162,  111195205,      &
     &  111220250,  111243238,  111232230,  111228220,  111220218,      &
     &  111213210,  111210205,  111205201,  111198188,  111183180,      &
     &  111178170/
      DATA D61129/  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  111123140,  111146162,  111195205,      &
     &  111220250,  111280330,  111351345,  111340332,  111330325,      &
     &  111320318,  111313310,  111305302,  111300292,  111282277,      &
     &  111267250,  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  111123140,  111146162,  111195205,      &
     &  111220250,  111280330,  111370450,  111482470,  111465458,      &
     &  111452448,  111444438,  111430425,  111420410,  111400388,      &
     &  111370355,  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  111123140,  111146162,  111195205,      &
     &  111220250,  111280330,  111370450,  111482600,  111670815,      &
     &  111800790,  111780763,  111752733,  111730705,  111690677,      &
     &  111650632,  202000150,  122300400,  122480600,  122700740,      &
     &  122780820,  122880900,  111123140,  111146162,  111195205,      &
     &  111220250,  111280330,  111370450,  111482600,  111670815,      &
     &  310965111,     126124,     122121,     119116,     114113,      &
     &     107102/
      DATA D11210/  122100100,  122100100,  122100100,  133999993,      &
     &  133989986,  133980979,  133970969,  133965963,  133952949,      &
     &  133945939,  133930919,  133909905,  133895880,  122100100,      &
     &  122100100,  123100995,  133993983,  133979975,  133965960,      &
     &  133950945,  133939935,  133923915,  133909900,  133889873,      &
     &  133865863,  133855845,  122100100,  122100100,  123100995,      &
     &  133990973,  133965960,  133943939,  133925920,  133909905,      &
     &  133885875,  133869860,  133850845,  133840843,  133853885,      &
     &  122100100,  123100998,  133995990,  133979959,  133950935,      &
     &  133915910,  133890883,  133870865,  133850840,  133830828,      &
     &  133825835,  133850863,  132909100,  122100100,  133995990,      &
     &  133988985,  133965939,  133940915,  133890882,  133865853,      &
     &  133835830,  133820815,  133815815,  133825873,  133920940,      &
     &  122105120/
      DATA D21210/  122100100,  133995989,  133985980,  133955925,      &
     &  133913893,  133869859,  133835828,  133813810,  133800805,      &
     &  133815825,  133859959,  122105109,  122127160,  122100100,      &
     &  133990980,  133975970,  133940893,  133878863,  133829820,      &
     &  133800790,  133785789,  133809835,  133873925,  122102128,      &
     &  122149160,  122210310,  122100100,  133990979,  133965960,      &
     &  133920850,  133829812,  133783780,  133785795,  133830850,      &
     &  132961109,  122123143,  122180260,  122330360,  122510760,      &
     &  122100100,  133990965,  133950925,  133910775,  133769775,      &
     &  133810839,  132950140,  122129145,  122210260,  122310390,      &
     &  122510820,  111110118,  111173280/
      DATA D31210/  122100100,  123100990,  133990980,  133965930,      &
     &  133920900,  133880865,  133845835,  133819810,  133790780,      &
     &  133770760,  133745733,  133725725,  133728760,  122100100,      &
     &  133990985,  133980975,  133955920,  133905885,  133860849,      &
     &  133825818,  133800770,  133770760,  133745740,  133730735,      &
     &  133750755,  133800925,  123100995,  133990980,  133975970,      &
     &  133950910,  133890870,  133843830,  133805799,  133780770,      &
     &  133755750,  133745745,  133750780,  133825845,  132945109,      &
     &  133885885,  133882880,  133875870,  133860835,  133825810,      &
     &  133790780,  133760759,  133750749,  133740745,  133750760,      &
     &  133783865,  133955985,  122119157,  133875875,  133872870,      &
     &  133865860,  133845815,  133805790,  133770755,  133745743,      &
     &  133740735,  133745759,  133783820,  132880105,  122120123,      &
     &  122152200/
      DATA D41210/  133860860,  133855850,  133845840,  133825795,      &
     &  133780770,  133753743,  133733733,  133740745,  133775815,      &
     &  133865925,  122105133,  122157160,  122230280,  133875870,      &
     &  133865860,  133850845,  133830780,  133760750,  133735733,      &
     &  133740750,  133783809,  132900101,  122113127,  122158230,      &
     &  122280300,  122370505,  133880870,  133860845,  133835825,      &
     &  133800750,  133735733,  133745770,  133845905,  122105117,      &
     &  122150200,  122230280,  122350550,  122730750,  111100140,      &
     &  133880870,  133860850,  133830805,  133760725,  133750800,      &
     &  132970114,  122157170,  122240300,  122400500,  122630800,      &
     &  111107173,  111235245,  111350515/
      DATA D51210/  133945943,  133940925,  133920913,  133883833,      &
     &  133809783,  133730705,  133650640,  133620590,  133550520,      &
     &  133500490,  133470530,  133630660,  132820108,  133860855,      &
     &  133855850,  133840835,  133810765,  133750730,  133695683,      &
     &  133660630,  133620610,  133570560,  133550550,  133570650,      &
     &  133760790,  132980126,  133800800,  133800789,  133785780,      &
     &  133760729,  133715700,  133675665,  133635630,  133623620,      &
     &  133600600,  133600620,  133640760,  133900950,  122117152,      &
     &  133755753,  133750749,  133743739,  133728700,  133685670,      &
     &  133655649,  133633625,  133625630,  133630650,  133670690,      &
     &  133730900,  122109115,  122149198,  133743742,  133742735,      &
     &  133733730,  133715685,  133680660,  133645643,  133640625,      &
     &  133630640,  133690720,  133770820,  132920118,  122149154,      &
     &  122214295/
      DATA D61210/  133745743,  133742735,  133732725,  133710683,      &
     &  133680665,  133667665,  133675663,  133690710,  133780845,      &
     &  132930103,  122122161,  122205214,  122279430,  133745743,      &
     &  133740735,  133730720,  133700670,  133665660,  133670689,      &
     &  133735760,  133830890,  122105122,  122140162,  122200265,      &
     &  122320350,  122500730,  133745740,  133740730,  133725715,      &
     &  133690670,  133680705,  133783840,  132995110,  122134150,      &
     &  122209252,  122330400,  122490720,  121900100,  111139215,      &
     &  133750745,  133740725,  133712700,  133680750,  133840955,      &
     &  122128154,  122224250,  122350390,  122550700,  121900105,      &
     &  111150235,  111320340,  111465655/
      DATA D71210/  133740729,  133710660,  133625580,  133500500,      &
     &  133500500,  133500600,  133600600,  133600600,  133600500,      &
     &  133500400,  330200000,          0,  133100400,  133720702,      &
     &  133689685,  133605565,  133500500,  133500500,  133500600,      &
     &  133600600,  133600600,  133600500,  133500400,  133300300,      &
     &  133400500,  132600120,  133695680,  133665615,  133590545,      &
     &  133500500,  133500500,  133500600,  133600600,  133600600,      &
     &  133600500,  133500500,  133600600,  133800900,  122110200,      &
     &  133690672,  133650605,  133580550,  133500500,  133500500,      &
     &  133500600,  133600600,  133600600,  133600600,  133600600,      &
     &  132700100,  122120130,  122170320,  133690672,  133650615,      &
     &  133585575,  133500500,  133500500,  133500600,  133600600,      &
     &  133600600,  133600600,  133700900,  122100130,  122150170,      &
     &  122230360/
      DATA D81210/  133685670,  133650605,  133600600,  133600600,      &
     &  133600600,  133600600,  133600600,  133600700,  133800900,      &
     &  122100130,  122140190,  122230240,  122320470,  133685660,      &
     &  133640620,  133635700,  133700700,  133700700,  133700700,      &
     &  133700700,  133900900,  122120140,  122160200,  122240340,      &
     &  122400430,  122600890,  133680660,  133650690,  132775102,      &
     &  122103103,  122103103,  122103103,  122110140,  122160180,      &
     &  122250300,  122350430,  122580850,  111108116,  111152240,      &
     &  133675655,  133665930,  122127130,  122130130,  122130130,      &
     &  122150190,  122270310,  122400460,  122660840,  111103125,      &
     &  111172265,  111350375,  111494680/
      DATA D91210/  133700700,  133700700,  133700700,  133700690,      &
     &  133690690,  133690690,  133710720,  133740750,  133780820,      &
     &  133840860,  133890945,  133980990,  122103109,  133660660,      &
     &  133660660,  133660660,  133670690,  133690690,  133700700,      &
     &  133710730,  133740760,  133800830,  133860890,  132940104,      &
     &  122112114,  122124135,  133660660,  133660660,  133660660,      &
     &  133670690,  133690700,  133700700,  133710730,  133750760,      &
     &  133810850,  133900945,  122102121,  122133136,  122153174,      &
     &  133660660,  133660660,  133660660,  133670690,  133690710,      &
     &  133710720,  133730750,  133770790,  133850890,  132960102,      &
     &  122114144,  122167173,  122202238,  133660660,  133660660,      &
     &  133660660,  133670690,  133690710,  133720740,  133770800,      &
     &  133840870,  132970103,  122112120,  122136173,  122204214,      &
     &  122250300/
      DATA D10210/  133660660,  133660660,  133660660,  133670700,      &
     &  133710730,  133770790,  133860860,  133940980,  122113122,      &
     &  122135148,  122169222,  122250270,  122350450,  133660660,      &
     &  133660670,  133670670,  133680710,  133730770,  133840870,      &
     &  132970101,  122114123,  122157178,  122212232,  122250350,      &
     &  122400450,  122550750,  133660660,  133660670,  133670670,      &
     &  133700790,  133850940,  122108119,  122151162,  122194214,      &
     &  122300350,  122400450,  122600850,  111115120,  111155205,      &
     &  133660670,  133680690,  133710720,  132820106,  122124151,      &
     &  122200220,  122350350,  122500550,  122750900,  111115140,      &
     &  111185285,  111370400,  111535720/
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA ROUTID/4HSUPC,4HMQ  /
!
      TYPE=WINGIN(15)
      IF(TYPE.NE.WTYPE(1))RETURN
      IF(TANLE.EQ.0.)TANLE=.00001
      COTLE=1./TANLE
      IF(TRANSN)GO TO 1000
      MACH=FLC(IM+2)
      BETA=SQRT(MACH**2-1.)
      CNA1=SLG(7)
      XACCR=SLG(134)
      DCMDCL=SLG(135)
 1000 SAVE=MACOE*SW/(CBARR*SR)
      EN=1.-4.*COTLE/ASTRW
      DEE=.66667*LSTAR
      IF(TRANSN)GO TO 1100
!
!    ---- SUPERSONIC WING PITCHING DERIVATIVE,CMQ ----
!
 1010 CONTINUE
      BCOTLE=BETA*COTLE
      XACCRB=XACCR*CRSTR/CBARR
      BA=BETA*ASTRW
      QLAMDA=10.
      IF(BCOTLE.GE.1.)GO TO 1080
      IF(LAMDA.NE.0.)GO TO 1030
!
!           -- FIGURE 7.1.1.2-8 F5(N)
!
 1020 CALL INTERX(1,X2A128,EN,I2A128,Y1A128,F5N,16,16,1,0,0,0,1,0,0,0,  &
     &            Q71128,3,ROUTID)
      F5N=(1.-EN)*F5N
!
!           -- FIGURE 7.1.1.2-8 F7(N)
!
      CALL INTERX(1,X2B128,EN,I2B128,Y1B128,F7N,17,17,1,0,0,0,1,0,0,0,  &
     &            Q71128,3,ROUTID)
!
!           -- FIGURE 7.1.1.2-8 F11(N)) --
!
      F11N=1.-EN
      AAA=-.01028*ASTRW
      BBB=GBC*F7N
      CCC=5.3333*EPPBC*(F5N/F11N)
      DDD=-(DEE-XACCR*CRSTR)/CBARR
      CMQPWH=AAA*(BBB+CCC)+DDD*CLQPWH+2.*DDD**2*CNA1/RAD
      IF(QLAMDA.LT.5.)GO TO 1060
      GO TO 1090
 1030 IF(LAMDA.LT.0.25)GO TO 1050
      IF(LAMDA.GT.0.75)RETURN
!
!           -- FIGURE 7.1.1.2-9A,B,C --
!
 1040 CALL TLIP3X(X11129,X21129,X31129,Y71129,8,40,3,BA,BCOTLE,LAMDA,   &
     &            BCMQPP,1,1,0,1,1,0,Q71129,3,ROUTID)
      CMQPWH=(XACCRB*BCLQPP-BCMQPP*MACOE/CBARR)*SAVE/(BETA*RAD)
      IF(QLAMDA.LT.0.25)GO TO 1070
      GO TO 1090
 1050 CONTINUE
      QLAMDA=LAMDA
      LAMDA=0.
      GO TO 1020
 1060 CMQP1=CMQPWH
      LAMDA=.25
      GO TO 1040
 1070 CMQPWH=(CMQPWH-CMQP1)*4.*QLAMDA+CMQP1
      GO TO 1090
 1080 ACOTBC=RAD*ATAN(1./BCOTLE)
!
!              FIGURE 7.1.1.2-10 A-K
!
      CALL TLIP3X(X11210,X21210,X31210,Y11210,9,26,5,BA,ACOTBC,LAMDA,   &
     &            BCMQP,1,1,0,2,1,0,Q11210,3,ROUTID)
      CMQPWH=-(BCMQP/(RAD*BETA))*SAVE*MACOE/CBARR
 1090 CMQWH=CMQPWH+DCMDCL*CLQWH
      IF(.NOT.TRANSN)RETURN
      GO TO 1110
 1100 MACH=1.2
      BETA=0.663325
      XACCR=TRA(105)
      DCMDCL=(DXCG-XACCR*CRSTR)/CBARR
      CALL TBFUNX(MACH,CNA1,DYDX,5,TRA(16),TRA(21),CX,                  &
     &            IX,MI,NG,0,0,QCLAMA,3,ROUTID)
      GO TO 1010
 1110 CMQ12=CMQWH
      CLAM=WING(101)
      CLAMFB=TRA(12)
      CMQWT=(CLAM-CLAMFB)/(CNA1-CLAMFB)*(CMQ12-CMQMFB)+CMQMFB
      IF(TANLE.EQ..00001)TANLE=0.
      RETURN
      END
      SUBROUTINE SUPHYW
!
!     THIS ROUTINE YIELDS THE SUPERSONIC H.T.,H.T.-BODY
!     ROLLING DERIVATIVES,CLP AND CNP,AND
!     YAWING DERIVATIVE , CYP
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /HTDATA/ A(195)
      COMMON /HTI/    WINGIN(77)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /BDATA/  BD(300),DYN(213)
      COMMON /SUPWH/  GR(141),SLG(141)
      COMMON /IBH/    PBW,BW(380)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /IHT/    PWING, WING(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      INTEGER Y2225A,Y2225B,Y2225C,Y2225D,Y2225E,Y2110A,Y2110C,Y2110B,  &
     & Y2314A,Y2314B,Y2314C,Y2314D,Y2317A,Y2317B,Y2317C,Y2317D
      REAL MACH,LAMLE,LAMDA
      DIMENSION ALSCHD(20),CYPWBH(20),CNPWBH(20),CYPWSP(20)
      DIMENSION ROUTID(2)
      DIMENSION X1225A(  7),X2225A( 17),Y2225A(  60),Q2225A(3)
      DIMENSION X1225B(  7),X2225B( 13),Y2225B(  46),Q2225B(3)
      DIMENSION X1225C(  7),X2225C( 13),Y2225C(  46),Q2225C(3)
      DIMENSION X1225D(  7),X2225D( 14),Y2225D(  49),Q2225D(3)
      DIMENSION X1225E(  7),X2225E( 17),Y2225E(  60),Q2225E(3)
      DIMENSION X1110A( 14),X2110A(  9),Y2110A(  63),Q2110A(3)
      DIMENSION X1110C(  5),X2110C(  5),Y2110C(  13),Q2110C(3)
      DIMENSION X1110B(  7),X2110B( 19),Y2110B(  67),Q2110B(3)
      DIMENSION X1314A( 10),X2314A( 14),Y2314A(  70),Q2314A(3)
      DIMENSION X1314B( 10),X2314B( 14),Y2314B(  70),Q2314B(3)
      DIMENSION X1314C( 10),X2314C( 13),Y2314C(  65),Q2314C(3)
      DIMENSION X1314D( 10),X2314D( 13),Y2314D(  65),Q2314D(3)
      DIMENSION X12316(  9),Y12316(  9),Q12316(3)
      DIMENSION X13170(  2),X23170(  4),Y23170(2)
      DIMENSION X1317A(  5),X2317A( 15),Y2317A(  38),Q2317A(3)
      DIMENSION X1317B(  5),X2317B( 13),Y2317B(  33),Q2317B(3)
      DIMENSION X1317C(  5),X2317C( 15),Y2317C(  38),Q2317C(3)
      DIMENSION X1317D(  5),X2317D( 14),Y2317D(  35),Q2317D(3)
      EQUIVALENCE(CNACNA,SLG(3)),(TANCO2,A(74)),(LAMLE,A(58)),(SW,A(4)) &
     &,(XCG,SYNA(1)),(SSPNE,WINGIN(3)),(SSPN,WINGIN(4)),                &
     &(AW,A(120)),(LAMDA,A(118)),(BETA,SLG(1)),(ALSCHD(1),FLC(23)),     &
     &(TANLE,A(62))
      EQUIVALENCE(CLPWBH,WING(281)),(TRENS,DYN(204)),(CHENGE,DYN(205)), &
     &(CYPA,DYN(206)),(CYPWSP(1),WING(301)),(CNPTAS,DYN(207)),          &
     &(CNPA1,DYN(208)),(CNPA2,DYN(209)),(CNPA3,DYN(210)),               &
     &(CNPA,DYN(211)),(CNPAE,DYN(212)),(CNPWBH(1),WING(321)),           &
     &(CNPBA,DYN(213)),(XW,SYNA(1)),(CR,WINGIN(6))
      DATA ROUTID/4HSUPH,4HYW  /
!
!      ----FIGURE 7.1.2.2-25A
!
      DATA Q2225A/4H7.1.,4H2.2-,4H25A /
      DATA X1225A/  .000E+00,  .100E+01,  .200E+01,  .300E+01,          &
     &  .400E+01,  .500E+01,  .600E+01/
      DATA X2225A/ -.699E-01,  .100E+01,  .147E+01,  .203E+01,          &
     &  .250E+01,  .291E+01,  .403E+01,  .445E+01,  .503E+01,  .541E+01,&
     &  .597E+01,  .646E+01,  .706E+01,  .797E+01,  .858E+01,  .909E+01,&
     &  .100E+02/
!
!      ----FIGURE 7.1.2.2-25B
!
      DATA Q2225B/4H7.1.,4H2.2-,4H25B /
      DATA X1225B/  .000E+00,  .100E+01,  .200E+01,  .300E+01,          &
     &  .400E+01,  .500E+01,  .600E+01/
      DATA X2225B/  .296E-01,  .202E+01,  .279E+01,  .330E+01,          &
     &  .428E+01,  .526E+01,  .571E+01,  .625E+01,             .697E+01,&
     &  .748E+01,  .805E+01,  .903E+01,  .100E+02/
!
!      ----FIGURE 7.1.2.2-25C
!
      DATA Q2225C/4H7.1.,4H2.2-,4H25C /
      DATA X1225C/  .000E+00,  .100E+01,  .200E+01,  .300E+01,          &
     &  .400E+01,  .500E+01,  .600E+01/
      DATA X2225C/  .125E-01,  .199E+01,  .268E+01,  .332E+01,          &
     &  .369E+01,  .433E+01,  .468E+01,  .539E+01,  .571E+01,  .668E+01,&
     &  .802E+01,  .903E+01,  .100E+02/
!
!      ----FIGURE 7.1.2.2-25D
!
      DATA Q2225D/4H7.1.,4H2.2-,4H25D /
      DATA X1225D/  .000E+00,  .100E+01,  .200E+01,  .300E+01,          &
     &  .400E+01,  .500E+01,  .600E+01/
      DATA X2225D/  .140E-01,  .199E+01,  .224E+01,  .256E+01,          &
     &  .275E+01,  .328E+01,  .371E+01,  .433E+01,  .502E+01,  .560E+01,&
     &  .698E+01,  .802E+01,  .901E+01,  .100E+02/
!
!      ----FIGURE 7.1.2.2-25E
!
      DATA Q2225E/4H7.1.,4H2.2-,4H25E /
      DATA X1225E/  .000E+00,  .100E+01,  .200E+01,  .300E+01,          &
     &  .400E+01,  .500E+01,  .600E+01/
      DATA X2225E/  .180E-01,  .205E+01,  .217E+01,  .237E+01,          &
     &  .258E+01,  .284E+01,  .302E+01,  .353E+01,  .402E+01,  .449E+01,&
     &  .504E+01,  .546E+01,  .602E+01,  .701E+01,  .803E+01,  .900E+01,&
     &  .100E+02/
!
!      ----FIGURE 7.1.2.1-10A
!
      DATA Q2110A/4H7.1.,4H2.1-,4H10A /
      DATA X1110A/  .100E+02,  .150E+02,  .200E+02,  .250E+02,          &
     &  .300E+02,  .350E+02,  .400E+02,  .450E+02,  .500E+02,  .550E+02,&
     &  .600E+02,  .650E+02,  .700E+02,  .750E+02/
      DATA X2110A/  .134E+01,  .149E+01,  .160E+01,  .179E+01,          &
     &  .200E+01,  .240E+01,  .297E+01,  .349E+01,  .399E+01/
!
!      ----FIGURE 7.1.2.1-10B
!
      DATA Q2110B/4H7.1.,4H2.1-,4H10B /
      DATA X1110B/  .100E+01,  .200E+01,  .300E+01,  .400E+01,          &
     &  .800E+01,  .120E+02,  .200E+02/
      DATA X2110B/  .238E+00,  .550E+00,  .842E+00,  .127E+01,          &
     &  .216E+01,  .282E+01,  .325E+01,  .398E+01,  .430E+01,  .464E+01,&
     &  .498E+01,  .543E+01,  .596E+01,  .694E+01,  .795E+01,  .901E+01,&
     &  .999E+01,  .110E+02,  .120E+02/
!
!      ----FIGURE 7.1.2.1-10C
!
      DATA Q2110C/4H7.1.,4H2.1-,4H10C /
      DATA X1110C/  .000E+00,  .250E+00,  .500E+00,  .750E+00,          &
     &  .100E+01/
      DATA X2110C/ -.600E+01, -.243E+01, -.197E+01, -.102E+01,          &
     &  .000E+00/
!
!      ----FIGURE 7.1.2.3-14A
!
      DATA Q2314A/4H7.1.,4H2.3-,4H14A /
      DATA X1314A/  .200E+01,  .300E+01,  .400E+01,  .500E+01,          &
     &  .600E+01,  .700E+01,  .800E+01,  .100E+02,  .150E+02,  .200E+02/
      DATA X2314A/  .323E+00,  .399E+00,  .451E+00,  .493E+00,          &
     &  .527E+00,  .537E+00,  .553E+00,  .584E+00,  .631E+00,  .651E+00,&
     &  .700E+00,  .802E+00,  .902E+00,  .100E+01/
!
!      ----FIGURE 7.1.2.3-14B
!
      DATA Q2314B/4H7.1.,4H2.3-,4H14B /
      DATA X1314B/  .200E+01,  .300E+01,  .400E+01,  .500E+01,          &
     &  .600E+01,  .700E+01,  .800E+01,  .100E+02,  .150E+02,  .200E+02/
      DATA X2314B/  .326E+00,  .393E+00,  .443E+00,  .478E+00,          &
     &  .502E+00,  .519E+00,  .552E+00,  .569E+00,  .616E+00,  .647E+00,&
     &  .700E+00,  .799E+00,  .900E+00,  .100E+01/
!
!      ----FIGURE 7.1.2.3-14C
!
      DATA Q2314C/4H7.1.,4H2.3-,4H14C /
      DATA X1314C/  .200E+01,  .300E+01,  .400E+01,  .500E+01,          &
     &  .600E+01,  .700E+01,  .800E+01,  .100E+02,  .150E+02,  .200E+02/
      DATA X2314C/  .369E+00,  .444E+00,  .492E+00,  .532E+00,          &
     &  .563E+00,  .585E+00,  .615E+00,  .641E+00,  .675E+00,  .747E+00,&
     &  .795E+00,  .898E+00,  .100E+01/
!
!      ----FIGURE 7.1.2.3-14D
!
      DATA Q2314D/4H7.1.,4H2.3-,4H14D /
      DATA X1314D/  .200E+01,  .300E+01,  .400E+01,  .500E+01,          &
     &  .600E+01,  .700E+01,  .800E+01,  .100E+02,  .150E+02,  .200E+02/
      DATA X2314D/  .401E+00,  .492E+00,  .546E+00,  .589E+00,          &
     &  .611E+00,  .639E+00,  .666E+00,  .693E+00,  .731E+00,  .753E+00,&
     &  .804E+00,  .902E+00,  .100E+01/
!
!      ----FIGURE 7.1.2.3-16
!
      DATA Q12316/4H7.1.,4H2.3-,4H16  /
      DATA I22316 /9/
      DATA X12316/  .301E+00,  .498E+00,  .750E+00,  .846E+00,          &
     &  .922E+00,  .949E+00,  .974E+00,  .987E+00,  .997E+00/
      DATA Y12316/ -.168E+00, -.135E+00, -.851E-01, -.626E-01,          &
     & -.385E-01, -.293E-01, -.190E-01, -.115E-01, -.575E-03/
!
!      ----FIGURE 7.1.2.3-17A
!
      DATA Q2317A/4H7.1.,4H2.3-,4H17A /
      DATA X1317A/  .200E+01,  .300E+01,  .400E+01,  .800E+01,          &
     &  .120E+02/
      DATA X2317A/  .100E+01,  .115E+01,  .125E+01,  .138E+01,          &
     &  .153E+01,  .175E+01,  .201E+01,  .249E+01,  .301E+01,  .351E+01,&
     &  .397E+01,  .449E+01,  .549E+01,  .648E+01,  .698E+01/
!
!      ----FIGURE 7.1.2.3-17B
!
      DATA Q2317B/4H7.1.,4H2.3-,4H17B /
      DATA X1317B/  .200E+01,  .300E+01,  .400E+01,  .800E+01,          &
     &  .120E+02/
      DATA X2317B/  .101E+01,  .127E+01,  .150E+01,  .167E+01,          &
     &  .184E+01,  .202E+01,  .253E+01,  .303E+01,  .352E+01,  .403E+01,&
     &  .502E+01,  .603E+01,  .700E+01/
!
!      ----FIGURE 7.1.2.3-17C
!
      DATA Q2317C/4H7.1.,4H2.3-,4H17C /
      DATA X1317C/  .200E+01,  .300E+01,  .400E+01,  .800E+01,          &
     &  .120E+02/
      DATA X2317C/  .100E+01,  .113E+01,  .131E+01,  .150E+01,          &
     &  .164E+01,  .181E+01,  .198E+01,  .220E+01,  .250E+01,  .299E+01,&
     &  .347E+01,  .398E+01,  .496E+01,  .597E+01,  .693E+01/
!
!      ----FIGURE 7.1.2.3-17D
!
      DATA Q2317D/4H7.1.,4H2.3-,4H17D /
      DATA X1317D/  .200E+01,  .300E+01,  .400E+01,  .800E+01,          &
     &  .120E+02/
      DATA X2317D/  .100E+01,  .110E+01,  .125E+01,  .136E+01,          &
     &  .149E+01,  .174E+01,  .200E+01,  .251E+01,  .303E+01,  .351E+01,&
     &  .400E+01,  .501E+01,  .603E+01,  .699E+01/
!
!        IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
!        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
!
!        THE FORMAT IS AS FOLLOWS-
!
!        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
!
!        WHERE-
!
!        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
!        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
!        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
!             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
!        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
!        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
!        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
!        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
!
      DATA Y2225A/-1143985102,-1133105107,-1134109960,-1144760690,      &
     &-1144620570,-1144530490,-1144460410,-1144390370,-1144330990,      &
     &-1143990100,-1133101101,-1144990760,-1144710630,-1144580540,      &
     &-1144510470,-1144420400,-1144380340,-1144990960,-1144940930,      &
     &-1144910890,-1144830750,-1144670610,-1144560520,-1144490430,      &
     &-1144410390,-1144350860,-1144830820,-1144810810,-1144800760,      &
     &-1144750730,-1144660600,-1144560510,-1144440420,-1144400350,      &
     &-1144750740,-1144740730,-1144730730,-1144710710,-1144690680,      &
     &-1144650590,-1144540460,-1144440410,-1144360670,-1144670670,      &
     &-1144670680,-1144680670,-1144660650,-1144640630,-1144620600,      &
     &-1144510460,-1144430380,-1144580590,-1144590600,-1144610620,      &
     &-1144630620,-1144620610,-1144600590,-1144580560,-1144500460,      &
     & -340410000/
      DATA Y2225B/-1143988134,-1133123114,-1144938780,-1144725671,      &
     &-1144615576,-1144541485,-1144441988,-1133124119,-1134113954,      &
     &-1144806743,-1144681623,-1144588551,-1144488445,-1143987113,      &
     &-1133111110,-1144969827,-1144771701,-1144632594,-1144557495,      &
     &-1144448928,-1133102102,-1134101967,-1144857802,-1144741660,      &
     &-1144622578,-1144514461,-1144839906,-1144938933,-1144903876,      &
     &-1144825776,-1144697650,-1144601544,-1144487771,-1144791824,      &
     &-1144843862,-1144828815,-1144797737,-1144690640,-1144565505,      &
     &-1144691708,-1144732747,-1144780787,-1144778764,-1144738713,      &
     &-1144674602, -340533000/
      DATA Y2225C/-1143987137,-1133127116,-1133111100,-1144944855,      &
     &-1144809713,-1144615562,-1144511982,-1133131124,-1133116110,      &
     &-1134100944,-1144853814,-1144720619,-1144563511,-1143982119,      &
     &-1133118112,-1133109102,-1144976883,-1144839734,-1144628566,      &
     &-1144516943,-1133107109,-1133108107,-1134102974,-1144901860,      &
     &-1144761640,-1144576523,-1144877935,-1144968999,-1144991974,      &
     &-1144972913,-1144880791,-1144677605,-1144546820,-1144827854,      &
     &-1144878891,-1144913904,-1144886880,-1144809700,-1144633566,      &
     &-1144738726,-1144749773,-1144786809,-1144826850,-1144844830,      &
     &-1144730656, -340594000/
      DATA Y2225D/-1143985141,-1133136132,-1133128119,-1133112103,      &
     &-1144940869,-1144731654,-1144592541,-1143985131,-1133128125,      &
     &-1133123117,-1133111105,-1144953871,-1144735654,-1144592541,      &
     &-1143985117,-1133120120,-1133119114,-1133109104,-1144952887,      &
     &-1144747666,-1144599544,-1143953103,-1133104106,-1133106110,      &
     &-1133107103,-1144966906,-1144767687,-1144617566,-1144893908,      &
     &-1144938958,-1144968985,-1143998101,-1144975917,-1144800723,      &
     &-1144651578,-1144822803,-1144824843,-1144857889,-1144911929,      &
     &-1144938917,-1144820741,-1144671594,-1144760724,-1144735757,      &
     &-1144770804,-1144831846,-1144864871,-1144819755,-1144685615/
      DATA Y2225E/-1143988129,-1133129130,-1133129128,-1133125117,      &
     &-1133110102,-1144960910,-1144850760,-1144680620,-1144570980,      &
     &-1133125126,-1133126126,-1133125123,-1133117109,-1134103960,      &
     &-1144910850,-1144760680,-1144630570,-1143990113,-1133116118,      &
     &-1133118118,-1133118115,-1133109105,-1144980930,-1144870780,      &
     &-1144700640,-1144580960,-1133104105,-1133107109,-1133112114,      &
     &-1133112108,-1134104990,-1144940890,-1144790720,-1144650600,      &
     &-1144900930,-1144930950,-1144970980,-1144000102,-1133104102,      &
     &-1144980940,-1144900820,-1144730670,-1144610840,-1144820830,      &
     &-1144850860,-1144880890,-1144920940,-1144960960,-1144950920,      &
     &-1144820750,-1144680630,-1144770730,-1144740750,-1144770780,      &
     &-1144790820,-1144850860,-1144880890,-1144900850,-1144770710,      &
     & -340650000/
      DATA Y2110A/  111106130,  111148177,  111211274,  111364445,      &
     &  112525828,  121994112,  111134162,  111223327,  111438563,      &
     &  122706802,  121879100,  111115142,  111179209,  112237582,      &
     &  122661713,  122817930,  111115144,  111168189,  122508572,      &
     &  122628699,  122787958,  111118137,  112155445,  122498552,      &
     &  122618695,  122824999,  111116130,  122410452,  122491540,      &
     &  122602713,  122861997,  112112330,  122408429,  122485533,      &
     &  122637755,  122868969,  122262342,  122399436,  122485565,      &
     &  122669757,  122855209,  122272314,  122395436,  122503587,      &
     &  122665731,  122140215,  122260338,  122398450,  122525588,      &
     &  123651831,  122136166,  122228288,  122392452,  122505560,      &
     &  133466831,  122108150,  122196291,  122388445,  123487464,      &
     &  133531715,  132877125,  122192271,  122344413/
      DATA Y2110B/  122439402,  122374346,  122310295,  122278249,      &
     &  122230218,  122199189,  122184161,  122152147,  122145136,      &
     &  122138599,  122532489,  122425344,  122306285,  122249228,      &
     &  122202190,  122172157,  122145138,  122127118,  122115113,      &
     &  122728659,  122599519,  122384335,  122304247,  122219188,      &
     &  122160136,  122121111,  133976951,  133974909,  132771910,      &
     &  122804715,  122600426,  122351320,  122252199,  122158133,      &
     &  122117107,  133821749,  133679679,  133680679,  122778767,      &
     &  122751716,  122601478,  122380249,  122190135,  123111797,      &
     &  133625482,  133409385,  133363363,  132318951,  122938919,      &
     &  122877741,  122596481,  122251164,  123116790,  133517433,      &
     &  133388364,  133340317,  133318295,  111346307,  111272224,      &
     &  112140889,  122612244,  123123675,  133449356,  133185206,      &
     &  133138114,  133136137,  330136000/
      DATA Y2110C/  124358230,  340230000,  142230505,  122145106,      &
     &  134413230,  122610248,  122209106,  142230677,  122324285,      &
     &  124161230,  122728367,  122326220,  340230000/
      DATA Y2314A/-1133828841,-1133849855,-1133858858,-1133859862,      &
     &-1133866866,-1133867869,-1133869870,-1133818817,-1133819824,      &
     &-1133826824,-1133825826,-1133826826,-1133825817,-1133813805,      &
     &-1133808808,-1133808808,-1133808806,-1133807806,-1133806805,      &
     &-1133800793,-1133783772,-1133767788,-1133796799,-1133798796,      &
     &-1133796796,-1133793791,-1133786776,-1133765753,-1133666739,      &
     &-1133770784,-1133788790,-1133790788,-1133785785,-1133779767,      &
     &-1133754742,-1133797793,-1133790788,-1133787787,-1133785784,      &
     &-1133779776,-1133772761,-1133746733,-1133799796,-1133792789,      &
     &-1133786785,-1133784780,-1133775774,-1133767754,-1133741723,      &
     &-1133826809,-1133798790,-1133784783,-1133780775,-1133769766,      &
     &-1133759745,-1133732714,-1133847821,-1133806794,-1133785783,      &
     &-1133779772,-1133762758,-1133751736,-1133721702,-1133824805,      &
     &-1133793783,-1133776774,-1133771765,-1133756753,-1133745730,      &
     &-1133713697/
      DATA Y2314B/-1122138141,-1122143144,-1122145145,-1122147147,      &
     &-1122149149,-1122151153,-1122155157,-1122137136,-1122137138,      &
     &-1122138139,-1122139139,-1122140140,-1122141141,-1122141142,      &
     &-1122133134,-1122134135,-1122134135,-1122135135,-1122136136,      &
     &-1122136136,-1122135135,-1122133133,-1122132132,-1122133133,      &
     &-1122133133,-1122133132,-1122132132,-1122132130,-1122126130,      &
     &-1122131132,-1122132132,-1122132131,-1122131131,-1122131130,      &
     &-1122129127,-1122140135,-1122133131,-1122131131,-1122130130,      &
     &-1122130130,-1122129128,-1122126126,-1122127129,-1122129130,      &
     &-1122130130,-1122130129,-1122129128,-1122128127,-1122126124,      &
     &-1122121125,-1122126127,-1122128128,-1122128128,-1122128127,      &
     &-1122126125,-1122123122,-1122118122,-1122124125,-1122126126,      &
     &-1122126126,-1122126126,-1122124123,-1122121119,-1122124124,      &
     &-1122125125,-1122125125,-1122125125,-1122124124,-1122123122,      &
     &-1122119117/
      DATA Y2314C/-1122189195,-1122198201,-1122202204,-1122206206,      &
     &-1122209213,-1122215220,-1122225177,-1122185187,-1122188188,      &
     &-1122189190,-1122191192,-1122193195,-1122196199,-1122171178,      &
     &-1122181182,-1122182182,-1122182183,-1122183184,-1122185186,      &
     &-1122186178,-1122178178,-1122178178,-1122178178,-1122178178,      &
     &-1122178178,-1122178178,-1122163169,-1122172174,-1122174174,      &
     &-1122174174,-1122174174,-1122173173,-1122172185,-1122179176,      &
     &-1122175174,-1122173173,-1122173173,-1122172172,-1122169168,      &
     &-1122146158,-1122163167,-1122168169,-1122170170,-1122169169,      &
     &-1122168167,-1122165144,-1122156161,-1122164166,-1122167168,      &
     &-1122168168,-1122167166,-1122164162,-1122139150,-1122155159,      &
     &-1122161162,-1122163164,-1122164163,-1122162159,-1122156201,      &
     &-1122188181,-1122177173,-1122171168,-1122166164,-1122160159,      &
     &-1122156154/
      DATA Y2314D/-1122228237,-1122242245,-1122247249,-1122252254,      &
     &-1122256258,-1122262269,-1122276210,-1122221225,-1122226227,      &
     &-1122229229,-1122230233,-1122233234,-1122238242,-1122211215,      &
     &-1122216217,-1122217218,-1122219219,-1122220220,-1122220223,      &
     &-1122223206,-1122208209,-1122210211,-1122211211,-1122211211,      &
     &-1122212212,-1122212213,-1122208207,-1122207207,-1122207207,      &
     &-1122207207,-1122207207,-1122207206,-1122205203,-1122203203,      &
     &-1122202202,-1122204204,-1122203203,-1122203202,-1122201200,      &
     &-1122202202,-1122202202,-1122202201,-1122201201,-1122201201,      &
     &-1122200198,-1122196176,-1122186191,-1122194195,-1122196196,      &
     &-1122197197,-1122197196,-1122194191,-1122145167,-1122176182,      &
     &-1122185187,-1122189190,-1122191191,-1122190187,-1122183173,      &
     &-1122180183,-1122185186,-1122187187,-1122188188,-1122188187,      &
     &-1122183181/
      DATA Y2317A/-1133142138,-1133130121,-1134113991,-1144879753,      &
     &-1144692655,-1144625609,-1144580559,-1144552943,-1144881812,      &
     &-1144672580,-1144475431,-1144371338,-1144317297,-1144288278,      &
     &-1144258256,-1144696641,-1144534411,-1144349288,-1144250211,      &
     &-1144187178,-1144174167,-1144151150,-1144148354,-1144249182,      &
     &-1144130104,-1155776710,-1155639593,-1155572459,-1155412365,      &
     &-1155342342,-1144214123,-1155900662,-1155525365,-1155343320,      &
     &-1155274274,-1155252229,-1155205205, -350205000/
      DATA Y2317B/-1133410391,-1133366353,-1133340326,-1133302281,      &
     &-1133267262,-1133248240,-1133233267,-1133247215,-1133197181,      &
     &-1133175156,-1133140134,-1133126120,-1133119115,-1133198175,      &
     &-1133143123,-1133108103,-1144904847,-1144810751,-1144678663,      &
     &-1143659102,-1144668473,-1144368329,-1144318281,-1144267231,      &
     &-1144206202,-1144163159,-1144660362,-1144221184,-1144159147,      &
     &-1144134131,-1144118116,-1144111107, -340102000/
      DATA Y2317C/-1133681675,-1133659642,-1133624608,-1133591577,      &
     &-1133562537,-1133521509,-1133490480,-1133469455,-1133434413,      &
     &-1133387371,-1133354341,-1133319301,-1133279265,-1133257244,      &
     &-1133239229,-1133330321,-1133296275,-1133258239,-1133220200,      &
     &-1133183166,-1133158151,-1133147138,-1133135159,-1133143111,      &
     &-1144869740,-1144667597,-1144538511,-1144455406,-1144392388,      &
     &-1144385371,-1134114888,-1144571374,-1144322307,-1144278278,      &
     &-1144198187,-1144186172,-1144191188, -340207000/
      DATA Y2317D/-1133932927,-1133914898,-1133889860,-1133836807,      &
     &-1133778754,-1133743717,-1133707690,-1133612602,-1133576568,      &
     &-1133550529,-1133495457,-1133425406,-1133389379,-1133360357,      &
     &-1133460449,-1133424413,-1133382348,-1133319283,-1133266247,      &
     &-1133241227,-1133214211,-1133234209,-1133179162,-1133134121,      &
     &-1134101918,-1144849702,-1144686654,-1144645636,-1133177118,      &
     &-1144927838,-1144648592,-1144524394,-1144398339,-1144323314,      &
     &-1144305295/
      DATA X13170 /2.,12./, X23170 /0.,7.,0.,7./, Y23170 /0.,0./
!
      MACH=FLC(IM+2)
      COTLE=1./TANLE
      IF(HTPL.AND.(.NOT.BO))GO TO 1000
      DB=(SSPN-SSPNE)/SSPN
      IF(DB.GT.0.3)RETURN
 1000 ASTAN2=AW*TANCO2
      BAW=BETA*AW
!
!     ---SUPER WING,WING-BODY ROLLING  DERIVATIVE,CLP---
!              FIGURE 7.1.2.2-25 A-E
!
      CALL INTEP3(ASTAN2,BAW,LAMDA,X1225A,X2225A,Y2225A,7,17,Q2225A,    &
     &            X1225B,X2225B,Y2225B,7,13,Q2225B,                     &
     &            X1225C,X2225C,Y2225C,7,13,Q2225C,                     &
     &            X1225D,X2225D,Y2225D,7,14,Q2225D,                     &
     &            X1225E,X2225E,Y2225E,7,17,Q2225E,CLPA)
      SAVE=4.*SW*SSPN**2/(RAD*SR*BLREF**2)
      CLPWBH=CLPA*CNACNA*SAVE*AW/4.
!
!     ---SUPER WING,WING-BODY YAWING DERIVATIVE,CYP---
!           -- FIGURE 7.1.2.1-10 --
!
      CALL TLIP2X(X1110A,X2110A,Y2110A,14, 9,LAMLE,MACH,TRENS,2,1,2,1,  &
     &            Q2110A,3,ROUTID)
      CALL TLIP2X(X1110B,X2110B,Y2110B,7,19,BAW,TRENS,CHENGE,2,1,2,1,   &
     &            Q2110B,3,ROUTID)
      CHENGE=-CHENGE
      CALL TLIP2X(X1110C,X2110C,Y2110C,5,5,LAMDA,CHENGE,CYPA,1,1,2,1,   &
     &            Q2110C,3,ROUTID)
      TEMP=CYPA*SW*SSPN/(SR*BLREF*1641.645)
      DO 1010 I=1,NALPHA
         CYPWSP(I)=TEMP*ALSCHD(I)
 1010 END DO
!
!     ----SUPER WING,WING-BODY ROLLING DERIVATIVE,CNP---
!
      BCOTLE=BETA*COTLE
      IF(BCOTLE.GE.1.)GO TO 1030
!
!              FIGURE 7.1.2.3-14 A-D
!
      CALL INTEP3( BAW, BCOTLE, LAMDA, 0, 0, 0, 1, 1, 0                 &
     &           ,X1314A,X2314A,Y2314A,10,14,Q2314A                     &
     &           ,X1314B,X2314B,Y2314B,10,14,Q2314B                     &
     &           ,X1314C,X2314C,Y2314C,10,13,Q2314C                     &
     &           ,X1314D,X2314D,Y2314D,10,13,Q2314D,CNPTAS)
      CNPA1 =CNPTAS*TANLE
!
!           -- FIGURE 7.1.2.3-16 --
!
      CALL INTERX(1,X12316,BCOTLE,I22316,Y12316,CNPAAS,9,9,1,0,0,0,1,   &
     &            0,0,0,Q12316,3,ROUTID)
      CNPA2=CNPAAS*AW
      CNPA3=CNPAAS*AW*TANLE**2
      CNPA=CNPA1+CNPA2+CNPA3
      CNAPE=SAVE*(CNPA+CYPA*(XCG-XW)/CR*AW*(1.+LAMDA))
      DO 1020 I=1,NALPHA
 1020 CNPWBH(I)=(CNPAE-CLPWBH)*ALSCHD(I)/RAD
      GO TO 1050
 1030 CONTINUE
!
!              FIGURE 7.1.2.3-17 A-D
!
      CALL INTEP3( BAW, BCOTLE, LAMDA, 0, 0, 0, 1, 1, 0,                &
     &             X1317A,X2317A,Y2317A,5,15,Q2317A,                    &
     &             X1317B,X2317B,Y2317B,5,13,Q2317B,                    &
     &             X1317C,X2317C,Y2317C,5,15,Q2317C,                    &
     &             X1317D,X2317D,Y2317D,5,14,Q2317D,CNPBA)
      AAAAA=BETA*CNPBA
      BBBBB=2.*XCG/(BLREF*AW*(1.+LAMDA))-.5*TANLE
      CCCCC=(AAAAA+BBBBB*CYPA*BLREF/(2.*SSPN))*SAVE
      DO 1040 I=1,NALPHA
         CNPWBH(I)=(CCCCC-CLPWBH)*ALSCHD(I)/RAD
 1040 END DO
 1050 CONTINUE
      RETURN
      END
      SUBROUTINE SUPLAF
!
!***  SUPERSONIC VENTRAL FIN LATERAL STABILITY
!
      COMMON /IVF/     PVT,    VT(380)
      COMMON /IBW/     PBW,    BWI(380)
      COMMON /IBWV/    PBWV,   BWV(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZHH, ALIH, XV,        &
     &                VERTUP, HINAX, XVF, SC, ZV, ZVF, YV, YF,          &
     &                PHIV, PHIF
      COMMON /WINGI/  WINGIN(101)
      COMMON /VTI/    VV(162), VTIN(154)
      COMMON /HTI/    HTIN(154)
      COMMON /SBETA/  SSS(31), SLA(31)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /VTDATA/ AAA(195), AVT(195)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL VHPLA, VERTUP
!
      DIMENSION ROUTID(2), QAMF(3), XAMF(3), YAMF(3), CC(6)
      DIMENSION ALPHA(20), SYNA(19)
      DIMENSION RLPH(20), SVB(20), SVWB(20), SVHB(20)
!
      EQUIVALENCE (ALPHA(1),FLC(23))
      EQUIVALENCE (DCVWHB,VT(141)), (DCYHWB,SLA(23))
      EQUIVALENCE (RKVWB,SLA(24)), (RKVB,SLA(25)), (RKPVWB,SLA(26))
      EQUIVALENCE (DCYBV,SLA(27)), (RKVHB,SLA(28)), (ZP,SLA(29))
      EQUIVALENCE (RLP,SLA(30)), (CNAV,SLA(31))
      EQUIVALENCE (SYNA(1),XCG), (SPAN,WINGIN(4))
      EQUIVALENCE (RLPH(1),HTIN(95)), (SVWB(1),VTIN(95))
      EQUIVALENCE (SVB(1),VTIN(115)), (SVHB(1),VTIN(135))
!
      DATA WTYPE  / 4HSTRA /
      DATA ROUTID / 4HSUPL, 4HAF   /
      DATA QAMF   / 4H5.3., 4H1.1-, 4H25A  /
      DATA XAMF   / 0.0, 0.40, 1.0 /
      DATA YAMF   / 0.5, 1.79, 4.0 /
!
      ZH = ZHH-((HTIN(4)-HTIN(3))*AHT(62)+AHT(30))*SIN(ALIH/RAD)
      SVSTAR = AVT(3)
      VHPLA  = .FALSE.
      SCALE  = 2.0*SPAN/BLREF
!
!       ***VERTICAL TAIL ADDED TO WING-BODY***
!
      R1=VTIN(4)-VTIN(3)
      R1OBA=R1/VTIN(4)
      R2OBO2=R1/WINGIN(4)
      ZHOR1=-ZW/R1
 1000 IF(VERTUP)ZHOR1=-ZHOR1
!
!            CALL SUBROUTINE MASRAT FOR FIG.5.3.1.1-25B-P
!
      CALL MASRAT(R2OBO2,R1OBA,ZHOR1,ARG1)
      IF(VHPLA)GO TO 1010
!
!              FIGURE 5.3.1.1-25A KV(B)
!
      IN = 0
      CALL TBFUNX(R1OBA, RKVB, DYDX, 3, XAMF, YAMF, CC,                 &
     &            IN, MI, NG, 0, 1, QAMF, 3, ROUTID)
      RKVWB=ARG1
      RKPVWB= (RKVB*SVB(I)+RKVWB*SVWB(I))/SVSTAR
      DCYBV=-RKPVWB*CNAV
!
!       ***VERTICAL PANEL ADDED TO WING-BODY-HORIZONTAL TAIL***
!
      IF(.NOT. HTPL) GO TO 1020
      R2OBO2=R1/HTIN(4)
      ZHOR1=ZH/R1
      VHPLA=.TRUE.
      GO TO 1000
 1010 RKVHB=ARG1
      DCVWHB=DCYBV-RKVHB*SVHB(I)/SVSTAR*CNAV
 1020 CONTINUE
!
!  *** WING-BODY-TAIL DERIVATIVES ***
!
      BW=2.*SPAN
      DELX=AVT(62)*(VTIN(4)-VTIN(3))
      RLP=SYNA(9)-SYNA(1)+DELX+AVT(30)
      ZP=-SYNA(5)+VTIN(4)-VTIN(3)+AVT(31)+SYNA(14)
      VT(141) = DCYBV
      VT(161) = -DCYBV*RLP/BLREF
      BWV(141) = BWV(141)+VT(141)
      BWV(161) = BWV(161)+VT(161)
      IF(WINGIN(15).NE.WTYPE) GO TO 1050
      DO 1030 J=1,NALPHA
         ALP=ALPHA(J)/RAD
         DZ=(ZP*COS(ALP)-RLP*SIN(ALP))/BW
         BWV(J+180)=BWV(J+180)+DCYBV*DZ*SCALE
 1030 END DO
      IF(.NOT. HTPL) GO TO 1050
      BWHV(141)=BWHV(141)+DCVWHB
      BWHV(161)=BWHV(161)-DCVWHB*RLP/BLREF
      DO 1040 J=1,NALPHA
         ALP=ALPHA(J)/RAD
         DZ=(ZP*COS(ALP)-RLP*SIN(ALP))/BW
         VT(J+180) = DCVWHB*DZ*SCALE
         BWHV(J+180)=BWHV(J+180)+VT(J+180)
 1040 END DO
 1050 CONTINUE
      RETURN
      END
      SUBROUTINE SUPLAH
!
! ************SUPERSONIC LATERAL STABILITY************
!                    HORIZONTAL TAIL
!                 BODY-HORIZONTAL TAIL
!
      COMMON /FLOLOG/FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
      COMMON /OPTION/ SR,CRBAR,ROUGFC,BLREF
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /BDATA/  BD(762)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /SYNTSS/ SYNA(19)
      COMMON /HTDATA/ A(195)
      COMMON /SUPWH/  SLGG(141),SLG(141)
      COMMON /SBETA/  SLAA(31),SLA(31)
      COMMON /SUPBOD/ SBD(227)
      COMMON /BODYI/  BODYIN(129)
      COMMON /HTI/    WINGIN(100)
      COMMON /IHT/    PWING, WING(380)
      COMMON /IBH/    PBW, BWI(380)
!
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
!
      DIMENSION ROUTID(2)
      DIMENSION Q51116(3),Q71118(3),Q225AE(3),Q52318(3)
      REAL MACH
      DIMENSION SEXT(20),SVB(20),SVWB(20),RLPH(20)
      DIMENSION VAR(4),LGH(4)
      DIMENSION C1(6),C2(6)
      DIMENSION X158A(10),X258A(2),Y58A(20),X158B(5),X258B(3),Y58B(15), &
     &          X158C(5),X258C(2),Y58C(10)
      DIMENSION WTYPE(4)
      DIMENSION X12225(39),Y2225A(119),Y2225B(119),Y2225C(119),         &
     &          Y2225D(119),Y2225E(119),Y12225(595)
      DIMENSION X71118(8),Y71118(8),X51116(16),Y51116(16)
      DIMENSION CLB(20),ALPHA(20),CLBWB(20),SHB(20),SVHB(20),           &
     &          CLBW(20),CNW(20),CYBW(20),CNBW(20)
!
      EQUIVALENCE (TANMID,A(74))
      EQUIVALENCE (SLA(3),X),(DIHEQ,SLA(4)),(CYBW(1),WING(141)),        &
     &(QBC,SLA(5)),(EBC,SLA(6)),(CLPTOA,SLA(7)),(CLP,SLA(8))            &
     &,(CLBD,SLA(9)),(CLBW(1),WING(181)),(ZW,SLA(10)),(RKI,SLA(11)),    &
     &(CYBWB,BWI(141)),(RNN,SLA(12)),(RKRL,SLA(13)),(RH1,SLA(14)),(RH2, &
     &SLA(15)),(SBS,SLA(16)),(RKN,SLA(17)),(CNBWB,BWI(161))             &
     &,(CNBW(1),WING(161))
      EQUIVALENCE (ZWP,SLA(18)),(CLBZW,SLA(19)),(DCLB,SLA(20)),(CLBWB(1)&
     &,BWI(181))
      EQUIVALENCE (MACH,SLA(1)),(BETA,SLA(2)),(SWEPE,A(59)),(TAPR,A(118)&
     &),(AR,A(120)),(TANLE,A(62)),(XW,SYNA(6)),(CR,WINGIN(6)),          &
     &(XCG,SYNA(1)),(ALPHA(1),FLC(23)),(SPAN,WINGIN(4)),(SLG(3),CLPCTY),&
     &(COSLE,A(61)),(CNW(1),WING(61)),(CNAW,SLG(7))
      EQUIVALENCE (SPANO,WINGIN(3)),(CLAB,SBD(18)),(RLB,BD(1)),         &
     &(ALPHAI,SYNA(8))
      EQUIVALENCE (Y12225(1),Y2225A(1)),(Y12225(120),Y2225B(1)),        &
     &(Y12225(239),Y2225C(1)),(Y12225(358),Y2225D(1)),(Y12225(477),     &
     & Y2225E(1))
!
      DATA ROUTID/4HSUPL,4HAH  /
      DATA Q51116/4H5.1.,4H1.1-,4H6   /,Q71118/4H7.1.,4H1.1-,4H8   /,   &
     &     Q225AE/4H7.1.,4H2.2-,4H25AE/,Q52318/4H5.2.,4H3.1-,4H8   /
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
!                         FIGURE 5.2.3.1-8A
!
      DATA X158A/20.,14.,10.,8.,7.,6.,5.,4.,3.,2.5/
      DATA X258A/.2,.8/
      DATA Y58A/.1,1.88,                                                &
     &.40,2.21,                                                         &
     &.74,2.60,                                                         &
     &.98,2.80,                                                         &
     &1.30,3.13,                                                        &
     &1.61,3.50,                                                        &
     &2.00,3.88,                                                        &
     &2.50,4.40,                                                        &
     &2.99,5.00,                                                        &
     &3.45,5.40/
!                        FIGURE 5.2.3.1-8B
!
      DATA X158B/.8,1.0,1.2,1.4,1.6/
      DATA X258B/0.0,3.0,6.0/
      DATA Y58B/0.0,2.35,4.68,                                          &
     &0.0,3.00,6.00,                                                    &
     &0.0,3.60,7.25,                                                    &
     &0.0,4.18,8.50,                                                    &
     &0.0,4.79,9.50/
!
!                        FIGURE 5.2.3.1-8C
!
      DATA X158C/.5,.6,.8,1.,2./
      DATA X258C/0.0,6.0/
      DATA Y58C/-.00048,.00251,                                         &
     &-.00048,.0035,                                                    &
     &-.00048,.00477,                                                   &
     &-.00048,.00559,                                                   &
     &-.00048,.00641/
!
!     ----FIGURE 7.1.1.1-8 ELLIPTIC INTEGRAL OF THE STABILITY DERIVATIVE
!
      DATA X71118 /0.,.05,.1,.165,.25,.35,.8,1.0/
      DATA Y71118 /1.0,.995,.985,.966,.940,.90,.705,.631/
!
!     ----FIGURE 5.1.1.1-6 ELLIPTIC INTEGRAL FACTOR OF STABILITY DERIV.
!
      DATA X51116/0.,.1,.2,.45,.55,.65,.7,.75,.8,.85,.875,.9,.95,.974,  &
     & .99,1.0/
      DATA Y51116/1.,1.028,1.078,1.241,1.284,1.3,1.287,1.26,1.207,1.125,&
     &1.05,.970,.75,.55,.350,0./
!
!----FIGURE 7.1.2.2.-25 (A-E) ROLL DAMPING PARAMETER.
!
      DATA X12225/0.,1.,2.,2.45,3.,3.31,4.,4.7,5.,5.3,5.75,6.,6.7,7.,8.,&
     &9.,10.,                                                           &
     &0.0,1.,2.,3.,4.,5.,6.,10*0.0,                                     &
     &0.0,.25,.50,.75,1.0/
      DATA Y2225A /-.098,-.1025,-.1067,-.1088,-.0954,-.087,-.075,-.065, &
     &-.0615,-.0585,-.054,-.052,-.047,-.0455,-.0408,-.0363,-.0338      ,&
     &-.098,-.099,-.1008,-.1015,-.099,-.09,-.077,-.0666,-.063,-.06,-.055&
     &,-.0535,-.048,-.0465,-.0414,-.0368,-.0335    , -.098,-.0958,-.0925&
     &,-.0908,-.0888,-.087,-.085,-.071,-.0665,-.064,-.0578,-.0555,-.050,&
     &-.048,-.0424,-.0376,-.034   ,-.085,-.082,-.0814,-.0806,-.079,-.078&
     &,-.0764,-.074,-.073,-.068,-.062,-.060,-.053,-.051,-.044,-.0387,   &
     &-.0345   ,-.0748,-.074,3*-.073,-.0729,-.0713,-.0696,-.0686,-.0678,&
     &-.066,-.065,-.056,-.0531,-.046,-.040,-.0350   ,-.0665,-.0668,-.067&
     &,-.067,-.0672,-.067,-.0663,-.065,-.0647,-.064,-.063,-.0627,-.0610,&
     &-.060,-.0497,-.0425,-.037    ,-.0575,-.0585,-.06,-.0605,-.0614,   &
     &-.0616,-.0626,-.062,-.0615,-.061,-.060,-.0599,-.0582,-.058,-.0558,&
     &-.0454,-.040 /
      DATA Y2225B /-.0985,-.116,-.135,-.1285,-.1185,-.113,-.098,-.0865, &
     &-.081,-.077,-.072,-.0695,-.0635,-.061,-.054,-.049,-.0445        , &
     &-.0985,-.1115,-.125,-.123,-.1165,-.110,-.101,-.0895,-.0833,-.080, &
     &-.073,-.071,-.0645,-.062,-.055,-.0495,-.045    ,-.0985,-.1058,    &
     &-.113,-.112,-.1108,-.110,-.101,-.0905,-.085,-.0815,-.075,-.0728,  &
     &-.0655,-.063,-.056,-.05,-.0455    ,-.092,-.097,-.1025,-.1028,-.102&
     &,-.101,-.098,-.0925,-.088,-.0845,-.079,-.076,-.069,-.0655,-.058,  &
     &-.0516,-.0465    ,-.084,-.0871,-.0905,-.092,-.0936,-.0931,-.0913, &
     &-.089,-.088,-.087,-.082,-.0795,-.0725,-.069,-.061,-.0542,-.049    &
     &,-.0765,-.0776,-.0788,-.081,-.083,-.084,-.086,-.0843,-.0835,-.083,&
     &-.0814,-.0806,-.076,-.0731,-.0644,-.057,-.0509   ,-.069,-.0696,   &
     &-.070,-.072,-.0739,-.0746,-.077,-.0786,-.0789,-.0783,-.0773,-.077,&
     &-.075,-.0735,-.0684,-.0606,-.0536 /
      DATA Y2225C /-.098,-.119,-.1375,-.131,-.123,-.118,-.1055,-.095,   &
     &-.090,-.086,-.0815,-.0777,-.0712,-.0682,-.0619,-.056,-.0512,      &
     &-.098,-.114,-.131,-.127,-.121,-.1175,-.1055,-.0977,-.0938,-.086,  &
     &-.0815,-.0782,-.0721,-.069,-.062,-.056,-.0512     ,-.098,-.1088,  &
     &-.119,-.1182,-.1155,-.1133,-.1055,-.0977,-.0940,-.089,-.0842,-.081&
     &,-.0730,-.0692,-.0620,-.056,-.0512     ,-.095,-.1011,-.1075,-.1091&
     &,-.1081,-.1078,-.104,-.0977,-.0950,-.0905,-.086,-.0831,-.076,-.073&
     &,-.0645,-.0576,-.052    ,-.0875,-.091,-.094,-.0958,-.0982,-.0996, &
     &-.0985,-.0977,-.0950,-.0915,-.0879,-.0855,-.0791,-.076,-.0675,    &
     &-.0605,-.0548      ,-.0816,-.0822,-.0826,-.0843,-.0865,-.0875,    &
     &-.0905,-.0906,-.0899,-.0886,-.0879,-.0855,-.0806,-.0778,-.070,    &
     &-.063,-.056     ,-.0738,-.073,-.0725,-.0740,-.076,-.0770,-.08,    &
     &-.0827,-.084,-.085,-.0845,-.0841,-.083,-.081,-.073,-.0657,-.059  /
      DATA Y2225D /-.0989,-.120,-.1415,-.1335,-.124,-.119,-.108,-.099,  &
     &-.094,-.090,-.0861,-.083,-.0775,-.074,-.066,-.060,-.0545         ,&
     &-.0989,-.1145,-.1311,-.1265,-.120,-.117,-.108,-.099,-.094,-.090,  &
     &-.0861,-.083,-.0775,-.074,-.066,-.060,-.0545     ,-.0989,-.108,   &
     &-.1171,-.121,-.117,-.1144,-.107,-.100,-.096,-.093,-.0882,-.085,   &
     &-.0795,-.075,-.067,-.0605,-.055     ,-.0959,-.0999,-.1038,-.1056, &
     &-.1085,-.111,-.1054,-.100,-.097,-.0935,-.090,-.0865,-.0816,-.0775,&
     &-.069,-.0623,-.0565     ,-.0899,-.0906,-.0915,-.096,-.098,-.099,  &
     &-.101,-.100,-.0972,-.0950,-.092,-.089,-.0841,-.0806,-.0725,-.065, &
     &-.0585     ,-.083,-.082,-.081,-.0845,-.088,-.0898,-.093,-.094,    &
     &-.0935,-.0934,-.092,-.0900,-.086,-.0825,-.0745,-.067,-.060       ,&
     &-.0765,-.0746,-.073,-.076,-.0798,-.0815,-.0846,-.086,-.0867,-.0875&
     &,-.0875,-.0865,-.0841,-.0825,-.0755,-.0686,-.062  /
      DATA Y2225E /-.098,-.1135,-.1283,-.130,-.1245,-.1200,-.1090,-.100,&
     &-.0960,-.0915,-.0881,-.0860,-.0794,-.076,-.0681,-.062,-.057      ,&
     &-.098,-.112,-.1255,-.1265,-.1230,-.1190,-.1090,-.100,-.096,-.0915,&
     &-.0881,-.0860,-.0794,-.076,-.0681,-.062,-.057    ,-.098,-.1051,   &
     &-.1125,-.1180,-.1178,-.1160,-.1090,-.102,-.0985,-.0935,-.09,-.0868&
     &,-.0815,-.0775,-.0695,-.063,-.0578    ,-.100,-.091,-.1040,-.1083, &
     &-.114,-.1128,-.1075,-.1020,-.0985,-.0950,-.092,-.089,-.0831,-.0795&
     &,-.072,-.065,-.059     ,-.090,-.0912,-.0920,-.0955,-.0994,-.1010, &
     &-.1045,-.102,-.0980,-.0950,-.0930,-.09,-.0850,-.0811,-.073,-.066, &
     &-.0606     ,-.0832,-.0823,-.0815,-.0850,-.0889,-.0910,-.094,-.0956&
     &,-.096,-.096,-.093,-.0905,-.0860,-.083,-.075,-.0682,-.0625       ,&
     &-.076,-.0743,-.0725,-.0751,-.0787,-.0810,-.084,-.0870,-.088,-.089,&
     &-.0895,-.090,-.0867,-.084,-.0767,-.0705,-.065   /
!
!  *** CYB WING ALONE ***
!
      SCALE=2.*WINGIN(4)/BLREF
      MACH=FLC(I +2)
      BETA=SQRT(MACH**2-1.)
      NX=BODYIN(1)+.5
      RLB=BODYIN(NX+1)
      RM=MACH**2
      RB=BETA**2
      IF(WINGIN(13).EQ.UNUSED)WINGIN(13)=0.0
      IF(WINGIN(12).EQ.UNUSED)WINGIN(12)=0.0
      IF(WINGIN(14).EQ.UNUSED)WINGIN(14)=0.0
      ARG=WINGIN(3)-WINGIN(12)
      DIHEQ=(WINGIN(13)*ARG+WINGIN(14)*WINGIN(12))/WINGIN(3)
      IF(WINGIN(15).NE.WTYPE(1)) GO TO 1060
      IF(SWEPE.EQ.0.AND.TAPR.EQ.1.AND.(AR*BETA.GE.1.0))GO TO 1000
      ARG=BETA/.00001
      IF(TANLE.NE.0.0)ARG=BETA/TANLE
      IF(TAPR.EQ.0.0.AND.(ARG.LE.1.0))GO TO 1020
      GO TO 1040
 1000 CONTINUE
      X=XW+0.5*CR-XCG
      ARG1= 1./(PI*AR**2*RB)
      ARG2=4.*RM/3.+8.*RM*X/CRBAR
      ARG3=PI* AR*(1.-RB)*(3.+RB)/(3.*BETA**3)
      DO 1010 J=1,NALPHA
         ALP= (ALPHA(J)/RAD)**2
         CYBW(J)=-ALP*8.0*RM/(RAD*PI*RB*AR) -.0001*ABS(DIHEQ)
!
!  *** CNB WING ALONE ***
!
         CNBW(J)=SCALE*ALP*ARG1*(ARG2-ARG3)/RAD
 1010 END DO
      GO TO 1040
 1020 CONTINUE
!
!              FIGURE 5.1.1.1-6 (1./Q(BC))
!
      VAR(1)=ARG
      LGH(1)=16
      CALL INTERX(1,X51116,VAR,LGH,Y51116,QBC,16,16,                    &
     &            0,0,0,0,0,0,0,0,Q51116,3,ROUTID)
!
!              FIGURE 7.1.1.1-8 (EBC)
!
      LGH(1)=8
      CALL INTERX(1,X71118,VAR,LGH,Y71118,EBC,8,8,                      &
     &            0,0,0,0,0,0,0,0,Q71118,3,ROUTID)
      ARG1= PI*AR*RM/(4.*RAD*QBC)
      X=XW+.6666*SPAN*TANLE-XCG
      ARG2=PI/3.*(EBC+(AR**2/16.+X/CRBAR)*RM/QBC)/RAD
      DO 1030 J=1,NALPHA
         ALP= (ALPHA(J)/RAD)**2
         CYBW(J)=-ALP*ARG1-.0001*ABS(DIHEQ)
 1030 CNBW(J)=SCALE*ALP*ARG2
 1040 CONTINUE
!
! *** CLB WING ALONE ***
!              FIGURE 7.1.2.2-25A-E  (CLPTOA)
!
      VAR(1)=BETA*AR
      VAR(2)=AR*TANMID
      VAR(3)=TAPR
      LGH(1)=17
      LGH(2)=7
      LGH(3)=5
      CALL INTERX(3,X12225,VAR,LGH,Y12225,CLPTOA,17,597,                &
     &            0,0,0,0,2,2,0,0,Q225AE,3,ROUTID)
      CLP= CLPTOA*AR*CLPCTY
      CLBD=2.*DIHEQ*(1.+2.*TAPR)*CLP/(RAD**2.*(1.+3.*TAPR))
      ARG1=(1.+TAPR*(1.+SWEPE))*(1.+SWEPE/2.)*TANLE/BETA
      ARG2= RM*COSLE**2/AR+(TANLE/4.)**1.3333
      DO 1050 J=1,NALPHA
 1050 CLBW(J)=SCALE*(CLBD-0.061*CNW(J)*CNAW*ARG1*ARG2/RAD)
!
!  *** CYB WING-BODY ***
!
 1060 IF(.NOT.BO)RETURN
      SPANIN=SPAN-SPANO
      ARG=SIN(SYNA(8)/RAD)
      ZW=-SYNA(7)+(.25*A(10)+BD(89))*ARG-SPANIN*TAN(WINGIN(13)/RAD)
      ARG=ZW/(SPANIN)
      RKI= 1.0+.49*ARG
      IF(ARG.LT.0.0)RKI=1.0-.85*ARG
      CYBWB=-RKI*CLAB-0.0001*ABS(DIHEQ)
!
!  *** CNB WING-BODY ***
!
      RNN=FLC(I +42)*RLB
!
!              EQUATION FOR FIG.5.2.3.1-9 KRL
!
      RKRL=1.+ALOG(1.E-6*RNN)/4.86
      ARG11=1.0
      NV=BODYIN(1)+.5
      QL=RLB*.25
      TFL=RLB*.75
      I1=0
      I2=0
      CALL TBFUNX(QL,RH1,DYDX,NV,BODYIN(2),BODYIN(62),C1,I1,MI,NG,      &
     &            0,0,4HRH1 ,1,ROUTID)
      RH1=2.*RH1
      CALL TBFUNX(TFL,RH2,DYDX,NV,BODYIN(2),BODYIN(62),C2,I2,MI,NG,     &
     &            0,0,4HRH2 ,1,ROUTID)
      RH2=2.*RH2
      ARG12=SQRT(RH1/RH2)
      CALL TRAPZ(BODYIN(62),NV,BODYIN(2),SBS,1)
      SBS=2.*SBS
      ARG13=RLB**2/SBS
      ARG14=XCG/RLB
!
!                   FIGURE 5.2.3.1-8 (KN)
!
      CALL TLINEX(X158A,X258A,Y58A,10,2,ARG13,ARG14,YDUMY,              &
     &            2,1,2,1,Q52318,3,ROUTID)
      CALL TLINEX(X158B,X258B,Y58B,5,3,ARG12,YDUMY,YDUMY2,              &
     &            2,0,2,1,Q52318,3,ROUTID)
      CALL TLINEX(X158C,X258C,Y58C,5,2,ARG11,YDUMY2,RKN,                &
     &            2,0,2,1,Q52318,3,ROUTID)
      CNBWB=-RKN*RKRL*SBS*RLB/(SR*BLREF)
      IF(WINGIN(15).NE.WTYPE(1)) GO TO 1080
!
!  *** CLB WING-BODY ***
!
      ZWP=ZW+CR*SIN(ALPHAI/RAD)/4.0
      ARG1=SQRT(AR)
      DBODY = 2.0*SPANIN
      CLBZW =  0.6*ARG1*ZWP*DBODY/(RAD*SPAN**2)
      ARG= (DBODY/(2.*SPAN))**2*DIHEQ
      DCLB=-0.0005*ARG1*ARG
      ARG2=CLBZW+DCLB
      DO 1070 J=1,NALPHA
 1070 CLBWB(J)=CLBW(J)+ARG2*SCALE
 1080 CONTINUE
      RETURN
      END
      SUBROUTINE SUPLAT
!
! ************SUPERSONIC LATERAL STABILITY************
!                        WING
!                     WING-BODY
!
      COMMON /OPTION/ SR,CRBAR,ROUGFC,BLREF
      COMMON /FLGTCD/ FLC(160)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /BDATA/  BD(762)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF
      COMMON /SYNTSS/ SYNA(19)
      COMMON /WINGD/  A(195)
      COMMON /SUPWH/  SLG(141)
      COMMON /SBETA/  SLA(31)
      COMMON /SUPBOD/ SBD(227)
      COMMON /HTDATA/ AHT(195)
      COMMON /BODYI/  BODYIN(129)
      COMMON /WINGI/  WINGIN(100)
      COMMON /HTI/    HTIN(154)
      COMMON /IWING/  PWING, WING(400)
      COMMON /IBW/    PBW, BWI(380)
      COMMON /IBWH/   PBWH, BWH(380)
      COMMON /IBWV/   PBWV, BWV(380)
      COMMON /IBWHV/  PBWHV, BWHV(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
!
      DIMENSION ROUTID(2)
      DIMENSION Q51116(3),Q71118(3),Q225AE(3),Q52318(3),Q125OO(3)
      REAL MACH
      DIMENSION SEXT(20),RLPH(20)
      DIMENSION VAR(4),LGH(4),ZAR(4),ILGH(4)
      DIMENSION C1(6),C2(6)
      DIMENSION X158A(10),X258A(2),Y58A(20),X158B(5),X258B(3),Y58B(15), &
     &X158C(5),X258C(2),Y58C(10)
      DIMENSION WTYPE(4)
      DIMENSION X12225(39),Y2225A(119),Y2225B(119),Y2225C(119),         &
     &Y2225D(119),Y2225E(119),Y12225(595)
      DIMENSION X71118(8),Y71118(8),X51116(16),Y51116(16),              &
     &          XA25OO( 6),YA25OO( 6),XB25OO(8),YB25OO(8)
      DIMENSION ALPHA(20),CLBWB(20),SHB(20),                            &
     &CLBW(20),CNW(20),CYBW(20),CNBW(20)
!
      EQUIVALENCE (TANMID,A(74))
      EQUIVALENCE (SLA(3),X),(DIHEQ,SLA(4)),(CYBW(1),WING(141)),        &
     &(QBC,SLA(5)),(EBC,SLA(6)),(CLPTOA,SLA(7)),(CLP,SLA(8))            &
     &,(CLBD,SLA(9)),(CLBW(1),WING(181)),(ZW,SLA(10)),(RKI,SLA(11)),    &
     &(CYBWB,BWI(141)),(RNN,SLA(12)),(RKRL,SLA(13)),(RH1,SLA(14)),(RH2, &
     &SLA(15)),(SBS,SLA(16)),(RKN,SLA(17)),(CNBWB,BWI(161))             &
     &,(CNBW(1),WING(161))
      EQUIVALENCE (ZWP,SLA(18)),(CLBZW,SLA(19)),(DCLB,SLA(20)),(CLBWB(1)&
     &,BWI(181))
      EQUIVALENCE (MACH,SLA(1)),(BETA,SLA(2)),(SWEPE,A(59)),(TAPR,A(118)&
     &),(AR,A(120)),(TANLE,A(62)),(XW,SYNA(2)),(CR,WINGIN(6)),          &
     &(XCG,SYNA(1)),(ALPHA(1),FLC(23)),(SPAN,WINGIN(4)),(SLG(3),CLPCTY),&
     &(COSLE,A(61)),(CNW(1),WING(61)),(CNAW,SLG(7))
      EQUIVALENCE (SPANO,WINGIN(3)),(CLAB,SBD(18)),(RLB,BD(1)),         &
     &(ALPHAI,SYNA(4))
      EQUIVALENCE (ZHH,SYNA(7)), (ALIH,SYNA(8))
      EQUIVALENCE (RKHBHL,SLA(21)),(RKHB,SLA(22)),(DCYHWB,SLA(23)),     &
     &  (SHB(1),HTIN(115)),(SEXT(1),HTIN(135))
      EQUIVALENCE (RLPH(1),HTIN(95))
      EQUIVALENCE (Y12225(1),Y2225A(1)),(Y12225(120),Y2225B(1)),        &
     &(Y12225(239),Y2225C(1)),(Y12225(358),Y2225D(1)),(Y12225(477),     &
     & Y2225E(1))
!
      DATA ROUTID/4HSUPL,4HAT  /
      DATA Q51116/4H5.1.,4H1.1-,4H6   /,Q71118/4H7.1.,4H1.1-,4H8   /,   &
     &Q225AE/4H7.1.,4H2.2-,4H25AE/,Q52318/4H5.2.,4H3.1-,4H8   /,Q125OO/ &
     &4H5.3.,4H1.1-,4H25OO/
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
!                         FIGURE 5.2.3.1-8A
!
      DATA X158A/20.,14.,10.,8.,7.,6.,5.,4.,3.,2.5/
      DATA X258A/.2,.8/
      DATA Y58A/.1,1.88,                                                &
     &.40,2.21,                                                         &
     &.74,2.60,                                                         &
     &.98,2.80,                                                         &
     &1.30,3.13,                                                        &
     &1.61,3.50,                                                        &
     &2.00,3.88,                                                        &
     &2.50,4.40,                                                        &
     &2.99,5.00,                                                        &
     &3.45,5.40/
!                        FIGURE 5.2.3.1-8B
!
      DATA X158B/.8,1.0,1.2,1.4,1.6/
      DATA X258B/0.0,3.0,6.0/
      DATA Y58B/0.0,2.35,4.68,                                          &
     &0.0,3.00,6.00,                                                    &
     &0.0,3.60,7.25,                                                    &
     &0.0,4.18,8.50,                                                    &
     &0.0,4.79,9.50/
!
!                        FIGURE 5.2.3.1-8C
!
      DATA X158C/.5,.6,.8,1.,2./
      DATA X258C/0.0,6.0/
      DATA Y58C/-.00048,.00251,                                         &
     &-.00048,.0035,                                                    &
     &-.00048,.00477,                                                   &
     &-.00048,.00559,                                                   &
     &-.00048,.00641/
!
!     ----FIGURE 7.1.1.1-8 ELLIPTIC INTEGRAL OF THE STABILITY DERIVATIVE
!
      DATA X71118 /0.,.05,.1,.165,.25,.35,.8,1.0/
      DATA Y71118 /1.0,.995,.985,.966,.940,.90,.705,.631/
!
!     ----FIGURE 5.3.1.1-25OO APPARENT MASS FACTORS
!
      DATA XA25OO/0.,.2,.4,.6,.8,1.0/
      DATA XB25OO/0.,.1,.2,.3,.4,.6,.8,1.0/
      DATA YA25OO/0.,.01,.04,.12,.22,.35/
      DATA YB25OO/1.275,1.24,1.18,1.08,.95,.69,.51,.35/
!
!     ----FIGURE 5.1.1.1-6 ELLIPTIC INTEGRAL FACTOR OF STABILITY DERIV.
!
      DATA X51116/0.,.1,.2,.45,.55,.65,.7,.75,.8,.85,.875,.9,.95,.974,  &
     & .99,1.0/
      DATA Y51116/1.,1.028,1.078,1.241,1.284,1.3,1.287,1.26,1.207,1.125,&
     &1.05,.970,.75,.55,.350,0./
!
!----FIGURE 7.1.2.2.-25 (A-E) ROLL DAMPING PARAMETER.
!
      DATA X12225/0.,1.,2.,2.45,3.,3.31,4.,4.7,5.,5.3,5.75,6.,6.7,7.,8.,&
     &9.,10.,                                                           &
     &0.0,1.,2.,3.,4.,5.,6.,10*0.0,                                     &
     &0.0,.25,.50,.75,1.0/
      DATA Y2225A /-.098,-.1025,-.1067,-.1088,-.0954,-.087,-.075,-.065, &
     &-.0615,-.0585,-.054,-.052,-.047,-.0455,-.0408,-.0363,-.0338      ,&
     &-.098,-.099,-.1008,-.1015,-.099,-.09,-.077,-.0666,-.063,-.06,-.055&
     &,-.0535,-.048,-.0465,-.0414,-.0368,-.0335    , -.098,-.0958,-.0925&
     &,-.0908,-.0888,-.087,-.085,-.071,-.0665,-.064,-.0578,-.0555,-.050,&
     &-.048,-.0424,-.0376,-.034   ,-.085,-.082,-.0814,-.0806,-.079,-.078&
     &,-.0764,-.074,-.073,-.068,-.062,-.060,-.053,-.051,-.044,-.0387,   &
     &-.0345   ,-.0748,-.074,3*-.073,-.0729,-.0713,-.0696,-.0686,-.0678,&
     &-.066,-.065,-.056,-.0531,-.046,-.040,-.0350   ,-.0665,-.0668,-.067&
     &,-.067,-.0672,-.067,-.0663,-.065,-.0647,-.064,-.063,-.0627,-.0610,&
     &-.060,-.0497,-.0425,-.037    ,-.0575,-.0585,-.06,-.0605,-.0614,   &
     &-.0616,-.0626,-.062,-.0615,-.061,-.060,-.0599,-.0582,-.058,-.0558,&
     &-.0454,-.040 /
      DATA Y2225B /-.0985,-.116,-.135,-.1285,-.1185,-.113,-.098,-.0865, &
     &-.081,-.077,-.072,-.0695,-.0635,-.061,-.054,-.049,-.0445        , &
     &-.0985,-.1115,-.125,-.123,-.1165,-.110,-.101,-.0895,-.0833,-.080, &
     &-.073,-.071,-.0645,-.062,-.055,-.0495,-.045    ,-.0985,-.1058,    &
     &-.113,-.112,-.1108,-.110,-.101,-.0905,-.085,-.0815,-.075,-.0728,  &
     &-.0655,-.063,-.056,-.05,-.0455    ,-.092,-.097,-.1025,-.1028,-.102&
     &,-.101,-.098,-.0925,-.088,-.0845,-.079,-.076,-.069,-.0655,-.058,  &
     &-.0516,-.0465    ,-.084,-.0871,-.0905,-.092,-.0936,-.0931,-.0913, &
     &-.089,-.088,-.087,-.082,-.0795,-.0725,-.069,-.061,-.0542,-.049    &
     &,-.0765,-.0776,-.0788,-.081,-.083,-.084,-.086,-.0843,-.0835,-.083,&
     &-.0814,-.0806,-.076,-.0731,-.0644,-.057,-.0509   ,-.069,-.0696,   &
     &-.070,-.072,-.0739,-.0746,-.077,-.0786,-.0789,-.0783,-.0773,-.077,&
     &-.075,-.0735,-.0684,-.0606,-.0536 /
      DATA Y2225C /-.098,-.119,-.1375,-.131,-.123,-.118,-.1055,-.095,   &
     &-.090,-.086,-.0815,-.0777,-.0712,-.0682,-.0619,-.056,-.0512,      &
     &-.098,-.114,-.131,-.127,-.121,-.1175,-.1055,-.0977,-.0938,-.086,  &
     &-.0815,-.0782,-.0721,-.069,-.062,-.056,-.0512     ,-.098,-.1088,  &
     &-.119,-.1182,-.1155,-.1133,-.1055,-.0977,-.0940,-.089,-.0842,-.081&
     &,-.0730,-.0692,-.0620,-.056,-.0512     ,-.095,-.1011,-.1075,-.1091&
     &,-.1081,-.1078,-.104,-.0977,-.0950,-.0905,-.086,-.0831,-.076,-.073&
     &,-.0645,-.0576,-.052    ,-.0875,-.091,-.094,-.0958,-.0982,-.0996, &
     &-.0985,-.0977,-.0950,-.0915,-.0879,-.0855,-.0791,-.076,-.0675,    &
     &-.0605,-.0548      ,-.0816,-.0822,-.0826,-.0843,-.0865,-.0875,    &
     &-.0905,-.0906,-.0899,-.0886,-.0879,-.0855,-.0806,-.0778,-.070,    &
     &-.063,-.056     ,-.0738,-.073,-.0725,-.0740,-.076,-.0770,-.08,    &
     &-.0827,-.084,-.085,-.0845,-.0841,-.083,-.081,-.073,-.0657,-.059  /
      DATA Y2225D /-.0989,-.120,-.1415,-.1335,-.124,-.119,-.108,-.099,  &
     &-.094,-.090,-.0861,-.083,-.0775,-.074,-.066,-.060,-.0545         ,&
     &-.0989,-.1145,-.1311,-.1265,-.120,-.117,-.108,-.099,-.094,-.090,  &
     &-.0861,-.083,-.0775,-.074,-.066,-.060,-.0545     ,-.0989,-.108,   &
     &-.1171,-.121,-.117,-.1144,-.107,-.100,-.096,-.093,-.0882,-.085,   &
     &-.0795,-.075,-.067,-.0605,-.055     ,-.0959,-.0999,-.1038,-.1056, &
     &-.1085,-.111,-.1054,-.100,-.097,-.0935,-.090,-.0865,-.0816,-.0775,&
     &-.069,-.0623,-.0565     ,-.0899,-.0906,-.0915,-.096,-.098,-.099,  &
     &-.101,-.100,-.0972,-.0950,-.092,-.089,-.0841,-.0806,-.0725,-.065, &
     &-.0585     ,-.083,-.082,-.081,-.0845,-.088,-.0898,-.093,-.094,    &
     &-.0935,-.0934,-.092,-.0900,-.086,-.0825,-.0745,-.067,-.060       ,&
     &-.0765,-.0746,-.073,-.076,-.0798,-.0815,-.0846,-.086,-.0867,-.0875&
     &,-.0875,-.0865,-.0841,-.0825,-.0755,-.0686,-.062  /
      DATA Y2225E /-.098,-.1135,-.1283,-.130,-.1245,-.1200,-.1090,-.100,&
     &-.0960,-.0915,-.0881,-.0860,-.0794,-.076,-.0681,-.062,-.057      ,&
     &-.098,-.112,-.1255,-.1265,-.1230,-.1190,-.1090,-.100,-.096,-.0915,&
     &-.0881,-.0860,-.0794,-.076,-.0681,-.062,-.057    ,-.098,-.1051,   &
     &-.1125,-.1180,-.1178,-.1160,-.1090,-.102,-.0985,-.0935,-.09,-.0868&
     &,-.0815,-.0775,-.0695,-.063,-.0578    ,-.100,-.091,-.1040,-.1083, &
     &-.114,-.1128,-.1075,-.1020,-.0985,-.0950,-.092,-.089,-.0831,-.0795&
     &,-.072,-.065,-.059     ,-.090,-.0912,-.0920,-.0955,-.0994,-.1010, &
     &-.1045,-.102,-.0980,-.0950,-.0930,-.09,-.0850,-.0811,-.073,-.066, &
     &-.0606     ,-.0832,-.0823,-.0815,-.0850,-.0889,-.0910,-.094,-.0956&
     &,-.096,-.096,-.093,-.0905,-.0860,-.083,-.075,-.0682,-.0625       ,&
     &-.076,-.0743,-.0725,-.0751,-.0787,-.0810,-.084,-.0870,-.088,-.089,&
     &-.0895,-.090,-.0867,-.084,-.0767,-.0705,-.065   /
!
!  *** CYB WING ALONE ***
!
      LF = 0
      ZH = ZHH-((HTIN(4)-HTIN(3))*AHT(62)+AHT(30))*SIN(ALIH/RAD)
      SCALE=2.*WINGIN(4)/BLREF
      MACH=FLC(I +2)
      BETA=SQRT(MACH**2-1.)
      NX=BODYIN(1)+.5
      RLB=BODYIN(NX+1)
      RM=MACH**2
      RB=BETA**2
      IF(WINGIN(13).EQ.UNUSED)WINGIN(13)=0.0
      IF(WINGIN(12).EQ.UNUSED)WINGIN(12)=0.0
      IF(WINGIN(14).EQ.UNUSED)WINGIN(14)=0.0
      ARG=WINGIN(3)-WINGIN(12)
      DIHEQ=(WINGIN(13)*ARG+WINGIN(14)*WINGIN(12))/WINGIN(3)
      IF(WINGIN(15).NE.WTYPE(1)) GO TO 1060
      IF(SWEPE.EQ.0.AND.TAPR.EQ.1.AND.(AR*BETA.GE.1.0))GO TO 1000
      ARG=BETA/.00001
      IF(TANLE.NE.0.0)ARG=BETA/TANLE
      IF(TAPR .EQ. 0.0 .AND. (ARG .LT. .998))GO TO 1020
      GO TO 1040
 1000 CONTINUE
      X=XW+0.5*CR-XCG
      ARG1= 1./(PI*AR**2*RB)
      ARG2=4.*RM/3.+8.*RM*X/CRBAR
      ARG3=PI* AR*(1.-RB)*(3.+RB)/(3.*BETA**3)
      DO 1010 J=1,NALPHA
         ALP= (ALPHA(J)/RAD)**2
         CYBW(J)=-ALP*8.0*RM/(RAD*PI*RB*AR) -.0001*ABS(DIHEQ)
!
!  *** CNB WING ALONE ***
!
         CNBW(J)=SCALE*ALP*ARG1*(ARG2-ARG3)/RAD
 1010 END DO
      GO TO 1040
 1020 CONTINUE
!                        FIGURE 5.1.1.1-6 (1./Q(BC))
      VAR(1)=ARG
      LGH(1)=16
      CALL INTERX(1,X51116,VAR,LGH,Y51116,QBC,16,16,                    &
     &0,0,0,0,0,0,0,0,Q51116,3,ROUTID)
!
!                            FIGURE 7.1.1.1-8 (EBC)
!
      LGH(1)=8
      CALL INTERX(1,X71118,VAR,LGH,Y71118,EBC,8,8,                      &
     &0,0,0,0,0,0,0,0,Q71118,3,ROUTID)
      ARG1= PI*AR*RM/(4.*RAD*QBC)
      X=XW+.6666*SPAN*TANLE-XCG
      ARG2=PI/3.*(EBC+(AR**2/16.+X/CRBAR)*RM/QBC)/RAD
      DO 1030 J=1,NALPHA
         ALP= (ALPHA(J)/RAD)**2
         CYBW(J)=-ALP*ARG1-.0001*ABS(DIHEQ)
         CNBW(J)=SCALE*ALP*ARG2
 1030 END DO
 1040 CONTINUE
!
! *** CLB WING ALONE ***
!                      FIGURE 7.1.2.2-25A-E  (CLPTOA)
      VAR(1)=BETA*AR
      VAR(2)=AR*TANMID
      VAR(3)=TAPR
      LGH(1)=17
      LGH(2)=7
      LGH(3)=5
      CALL INTERX(3,X12225,VAR,LGH,Y12225,CLPTOA,17,597,                &
     &0,0,0,0,2,2,0,0,Q225AE,3,ROUTID)
      CLP= CLPTOA*AR*CLPCTY
      CLBD=2.*DIHEQ*(1.+2.*TAPR)*CLP/(RAD**2.*(1.+3.*TAPR))
      ARG1=(1.+TAPR*(1.+SWEPE))*(1.+SWEPE/2.)*TANLE/BETA
      ARG2= RM*COSLE**2/AR+(ABS(TANLE/4.))**1.3333
      DO 1050 J=1,NALPHA
         CLBW(J)=SCALE*(CLBD-0.061*CNW(J)*CNAW*ARG1*ARG2/RAD)
 1050 END DO
!
!  *** CYB WING-BODY ***
!
 1060 IF(.NOT.BO)RETURN
      SPANIN=SPAN-SPANO
      ARG=SIN(SYNA(4)/RAD)
      ZW=-SYNA(3)+(.25*A(10)+BD(66))*ARG-SPANIN*TAN(WINGIN(13)/RAD)
      ARG=ZW/(SPANIN)
      RKI= 1.0+.49*ARG
      IF(ARG.LT.0.0)RKI=1.0-.85*ARG
      CYBWB=-RKI*CLAB-0.0001*ABS(DIHEQ)
!
!  *** CNB WING-BODY ***
!
      RNN=FLC(I +42)*RLB
!                          EQUATION FOR FIGURE 5.2.3.1-9 KRL
      RKRL=1.+ALOG(1.E-6*RNN)/4.86
      ARG11=1.0
      NV=BODYIN(1)+.5
      QL=RLB*.25
      TFL=RLB*.75
      I1=0
      I2=0
      CALL TBFUNX(QL,RH1,DYDX,NV,BODYIN(2),BODYIN(62),C1,I1,MI,NG,      &
     &0,0,4HRH1 ,1,ROUTID)
      RH1=2.*RH1
      CALL TBFUNX(TFL,RH2,DYDX,NV,BODYIN(2),BODYIN(62),C2,I2,MI,NG,     &
     &0,0,4HRH2 ,1,ROUTID)
      RH2=2.*RH2
      ARG12=SQRT(RH1/RH2)
      CALL TRAPZ(BODYIN(62),NV,BODYIN(2),SBS,1)
      SBS=2.*SBS
      ARG13=RLB**2/SBS
      ARG14=XCG/RLB
!
!                   FIGURE 5.2.3.1-8 (KN)
!
      CALL TLINEX(X158A,X258A,Y58A,10,2,ARG13,ARG14,YDUMY,              &
     &           2,1,2,1,Q52318,3,ROUTID)
      CALL TLINEX(X158B,X258B,Y58B,5,3,ARG12,YDUMY,YDUMY2,              &
     &           2,0,2,1,Q52318,3,ROUTID)
      CALL TLINEX(X158C,X258C,Y58C,5,2,ARG11,YDUMY2,RKN,                &
     &          2,0,2,1,Q52318,3,ROUTID)
      CNBWB=-RKN*RKRL*SBS*RLB/(SR*BLREF)
      IF(WINGIN(15).NE.WTYPE(1)) GO TO 1080
!
!  *** CLB WING-BODY ***
!
      ZWP= ZW+CR*SIN(ALPHAI/RAD)/4.0
      ARG1=SQRT(AR)
      DBODY = 2.0*SPANIN
      CLBZW =  0.6*ARG1*ZWP*DBODY/(RAD*SPAN**2)
      ARG= (DBODY/(2.*SPAN))**2*DIHEQ
      DCLB=-0.0005*ARG1*ARG
      ARG2=CLBZW+DCLB
      DO 1070 J=1,NALPHA
      CLBWB(J)=CLBW(J)+ARG2*SCALE
      BWV(J+180)=BWI(J+180)
 1070 END DO
      BWV(141)=BWI(141)
      BWV(161)=BWI(161)
 1080 CONTINUE
!
!       ***HORIZONTAL TAIL ADDED TO WING-BODY***
!
      IF(.NOT.HTPL)GO TO 1110
      RH= HTIN(4)-HTIN(3)
!
!              FIGURE 5.3.1.1-25OO (KH(B))HL=RKHBHL
!
      IF(ABS(ZH).GT.RH.OR.(ZH/RH.EQ.0.0))GO TO 1110
      ARG=RH/HTIN(4)
      IF(ARG.LT.1.0)GO TO 1090
      VAR(1)=1./ARG
      LGH(1)=6
      CALL INTERX(1,XA25OO,VAR,LGH,YA25OO,RKHBHL,6,6,                   &
     &            0,0,0,0,0,0,0,0,Q125OO,3,ROUTID)
      GO TO 1100
 1090 VAR(1)=ARG
      LGH(1)=8
      CALL INTERX(1,XB25OO,VAR,LGH,YB25OO,RKHBHL,8,8,                   &
     &            0,0,0,0,0,0,0,0,Q125OO,3,ROUTID)
 1100 RKHB=RKHBHL*(1.-(1.-(ZH/RH)**2)**0.5)
      DCYHWB=-RKHB*CLAB*SHB(I)/SEXT(I)
      GO TO 1120
 1110 DCYHWB=0.0
      IF(.NOT. HTPL) GO TO 1120
      IF((ZH/RH) .NE. 0.0) LF = 1
 1120 CONTINUE
      IF(.NOT. HTPL) GO TO 1140
      BWH(141)=CYBWB+DCYHWB
      BWH(161)=CNBWB-DCYHWB*RLPH(I)/BLREF
      BWHV(141) = BWH(141)
      BWHV(161) = BWH(161)
      IF(WINGIN(15).NE.WTYPE(1)) GO TO 1140
      DO 1130 J=1,NALPHA
         BWH(J+180)=CLBWB(J)
         BWV(J+180)=BWI(J+180)
         BWHV(J+180)=BWH(J+180)
 1130 END DO
 1140 CONTINUE
      RETURN
      END
      SUBROUTINE SUPLAV
!
!***  SUPERSONIC VERTICAL TAIL LATERAL STABILITY
!
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IBW/     PBW,    BWI(380)
      COMMON /IBWV/    PBWV,   BWV(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZHH, ALIH, XV,        &
     &                VERTUP, HINAX, XVF, SC, ZV, ZVF, YV, YF,          &
     &                PHIV, PHIF
      COMMON /WINGI/  WINGIN(101)
      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
      COMMON /HTI/    HTIN(154)
      COMMON /SBETA/  SLA(31)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /VTDATA/ AVT(195), AVF(195)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      LOGICAL VHPLA, VERTUP
!
      DIMENSION ROUTID(2), QAMF(3), XAMF(3), YAMF(3), CC(6)
      DIMENSION ALPHA(20), SYNA(19)
      DIMENSION RLPH(20), SVB(20), SVWB(20), SVHB(20)
!
      EQUIVALENCE (ALPHA(1),FLC(23))
      EQUIVALENCE (DCYHWB,SLA(23))
      EQUIVALENCE (RKVWB,SLA(24)), (RKVB,SLA(25)), (RKPVWB,SLA(26))
      EQUIVALENCE (DCYBV,SLA(27)), (RKVHB,SLA(28)), (ZP,SLA(29))
      EQUIVALENCE (RLP,SLA(30)), (CNAV,SLA(31))
      EQUIVALENCE (SYNA(1),XCG), (SPAN,WINGIN(4))
      EQUIVALENCE (RLPH(1),HTIN(95)), (SVWB(1),VTIN(95))
      EQUIVALENCE (SVB(1),VTIN(115)), (SVHB(1),VTIN(135))
!
      DATA WTYPE  / 4HSTRA /
      DATA ROUTID / 4HSUPL, 4HAV   /
      DATA QAMF   / 4H5.3., 4H1.1-, 4H25A  /
      DATA XAMF   / 0.0, 0.40, 1.0 /
      DATA YAMF   / 0.5, 1.79, 4.0 /
!
      ZH = ZHH-((HTIN(4)-HTIN(3))*AHT(62)+AHT(30))*SIN(ALIH/RAD)
      SVSTAR = AVT(3)
      VHPLA  = .FALSE.
      SCALE  = 2.0*SPAN/BLREF
!
!       ***VERTICAL TAIL ADDED TO WING-BODY***
!
      R1=VTIN(4)-VTIN(3)
      R1OBA=R1/VTIN(4)
      R2OBO2=R1/WINGIN(4)
      ZHOR1=-ZW/R1
 1000 IF(.NOT.VERTUP)ZHOR1=-ZHOR1
!
!         CALL  SUBROUTINE MASRAT FOR FIG.5.3.1.1-25B-P
!
      CALL MASRAT(R2OBO2,R1OBA,ZHOR1,ARG1)
      IF(VHPLA)GO TO 1010
!
!              FIGURE 5.3.1.1-25A KV(B)
!
      IN = 0
      CALL TBFUNX(R1OBA, RKVB, DYDX, 3, XAMF, YAMF, CC,                 &
     &            IN, MI, NG, 0, 1, QAMF, 3, ROUTID)
      RKVWB=ARG1
      RKPVWB= (RKVB*SVB(I)+RKVWB*SVWB(I))/SVSTAR
      DCYBV=-RKPVWB*CNAV
!
!       ***VERTICAL PANEL ADDED TO WING-BODY-HORIZONTAL TAIL***
!
      IF(.NOT. HTPL) GO TO 1020
      R2OBO2=R1/HTIN(4)
      ZHOR1=ZH/R1
      VHPLA=.TRUE.
      GO TO 1000
 1010 RKVHB=ARG1
      DCVWHB=DCYBV-RKVHB*SVHB(I)/SVSTAR*CNAV
 1020 CONTINUE
!
!  *** WING-BODY-TAIL DERIVATIVES ***
!
      BW=2.*SPAN
      DELX=AVT(62)*(VTIN(4)-VTIN(3))
      RLP=SYNA(9)-SYNA(1)+DELX+AVT(30)
      ZP=-SYNA(5)+VTIN(4)-VTIN(3)+AVT(31)+SYNA(14)
      VT(141) = DCYBV
      VT(161) = -DCYBV*RLP/BLREF
      BWV(141) = BWV(141)+VT(141)
      BWV(161) = BWV(161)+VT(161)
      IF(WINGIN(15).NE.WTYPE) GO TO 1050
      DO 1030 J=1,NALPHA
         ALP=ALPHA(J)/RAD
         DZ=(ZP*COS(ALP)-RLP*SIN(ALP))/BW
      VT(J+180)=DCYBV*DZ*SCALE
      BWV(J+180)=BWV(J+180)+VT(J+180)
 1030 END DO
      IF(.NOT. HTPL) GO TO 1050
      VT(141)=DCVWHB
      VT(161)=-DCVWHB*RLP/BLREF
      BWHV(141)=BWHV(141)+DCVWHB
      BWHV(161)=BWHV(161)-DCVWHB*RLP/BLREF
      DO 1040 J=1,NALPHA
         ALP=ALPHA(J)/RAD
         DZ=(ZP*COS(ALP)-RLP*SIN(ALP))/BW
         VT(J+180) = DCVWHB*DZ*SCALE
         BWHV(J+180)=BWHV(J+180)+VT(J+180)
 1040 END DO
 1050 CONTINUE
      RETURN
      END
      SUBROUTINE SUPLNG
!
!***  CALCULATES SUPERSONIC WING CL, CLA AND CMA
!
      DIMENSION ROUTID(2),Q3250A(3),Q3250B(3),Q3246A(3),Q3246G(3),      &
     & Q3359A(3),Q3359B(3),Q3361A(3),Q3360A(3),Q246AF(4),               &
     & Q13252(3),Q13253(3),Q13251(3),Q222AF(4),Q15127(3),Q15258(3)
      REAL MACH,KSHARP
      REAL LHS,LERBW,LERI,LERO
      DIMENSION T13246(52),D13246(1104),VAA(4),LGA(4),VAB(4),LGB(4),    &
     & A1350(17), B1350(19),DA50(72),DB50(88),G13246(9),DG3246(9),      &
     &A13359(22),D13359(99),ALSCHD(20),BR3359(21),DR3359(110),BL3359(20)&
     &,DL3359(50),ALPHAJ(20),CNAAA(20),T61A(9),                         &
     &SLOPE(9)
      DIMENSION DS5258(5),DR5258(5),T15258 (5)
      DIMENSION R13252(12),DRND52(12),S13252(12),DSHP52(12),T13251(12), &
     &D13251(12)
      DIMENSION WTYPE(4)
      DIMENSION CAF(20)
      DIMENSION CN(20),CL(20),DUMY4(184),DR360A(156),SUPAF(216),SUBAF(21&
     &6)
      DIMENSION DUMYC(108),DUMYD(108)
      DIMENSION TL360A(24),DL360A(72),TR360A(25),T13253(24),D13253(140),&
     &T422AF(18),DUMY7(65),DUMY8(91),DUMYA(108),DUMYB(108)
      DIMENSION T455(10),D455(10),CD(20),CDL(20)
      DIMENSION DUMY1(184),DUMY2(184),DUMY3(184),DUMY5(184),DUMY6(184)
      DIMENSION EPSLON(20),CM(20)
      DIMENSION X27M(4),X27I(4),C27(6)
      COMMON /OVERLY/ NLOG,NMACH,MIDX,NALPHA
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /OPTION/ SW,CBARR,RUFF,BLREF
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /SUPWH/  SLG(141)
      COMMON /WINGD/  A(195)
      COMMON /WINGI/  HTIN(100)
!
!********* HTIN CORRESPONDS TO WINGIN ELSEWHERE ***********************
!
      COMMON /IWING/ PWING,HT(400)
!
!********* HT CORRESPONDS TO WING ELSEWHERE ***************************
!
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &    HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,TRANSN,HYPERS
      LOGICAL       FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,    &
     &   HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,TRANSN,HYPERS
      EQUIVALENCE (CLADEG,HT(101)),(CMADEG,HT(121)),(CAF(1),HT(81))
      EQUIVALENCE (RKL,SLG(133)),(S2,SLG(74)),(A2,SLG(73))
      EQUIVALENCE  (CNAAAP,SLG(75))
      EQUIVALENCE(CM,HT(41))
      EQUIVALENCE (SRSTAR,A(3)),(P,SLG(82)),(DRAGC,SLG(81)),            &
     &  (CDO,SLG(80)),(CDL(1),SLG(53)),(CD(1),HT(1))
      EQUIVALENCE (SBW,SLG(119)),(CNTBW,SLG(77)),(XACCRI,SLG(76))
      EQUIVALENCE (TAPEXP,A(27)),(SO,A(167))
      EQUIVALENCE  (CBP,A(166)),              (BSTARB,A(23))
      EQUIVALENCE (TANLE,A(62)),(BETA,SLG(1)),(SWEPLE,A(58)),(AR,A(7  ))&
     &,(TRATIP,A(25)),(BOVERT,SLG(2)),(CNNNT,SLG(3)),(COSLE,A(61)),     &
     &(DELTAY,HTIN(17)),(BCNA,SLG(4)),(DELTYT,SLG(8)),(DELTDT,SLG(9)),  &
     &(E,SLG(11)),(CC,SLG(12)),(ALSCHD(1),FLC(23)),(ALPHAI,SYNA(4)),    &
     &(ALPHAJ(1),SLG(33)),(CNAAA(1),SLG(13)),(SINLE,A(60))              &
     &,(DETACH,SLG(94)),(CNAAST,SLG(116)),(DETALP,SLG(117))
      EQUIVALENCE (CNTHRY,SLG(5)),(CNA1,SLG(7)),(TLE192,SLG(10)),       &
     &(RMACH,SLG(93)),(CN(1),HT(61)),(CL(1),HT(21)),(DETANG,SLG(115)),  &
     &(XACCRO,SLG(78))
      EQUIVALENCE (SPAN,HTIN(4)),(SPANO,HTIN(2)),(CRBW,SLG(118))        &
     &,(TANTEO,A(104)),(CB,HTIN(5)),(CT,HTIN(1)),(TAPBW,SLG(121))       &
     &,(TANLEI,A(62)),(TANTEI,A(80)),(CN1,SLG(127)),(CN2,SLG(128)),     &
     &(ARBW,SLG(120)),(CLEBW,SLG(122)),(CRGLV,SLG(123)),(SGLV,SLG(124)) &
     &,(ARGLV,SLG(125)),(BE,SLG(126)),(CNAE,SLG(129)),(CNAGLV,SLG(130)) &
     &,(CNABW,SLG(131)),(CLEGLV,SLG(132)),(TANLEO,A(86)),(DETXCG,A(173))
      EQUIVALENCE (ARSTAR,A(7)),(XACCR,SLG(134)),(DCMCL,SLG(135)),      &
     &(CRSTAR,A(10)),(CMA,SLG(136)),(ARIP,A(5))                         &
     & ,(TAPIP,A(26)),(CNCNTI,SLG(137)),(TAPOP,A(169)),(COSLEO,A(85)),  &
     &(AROP,A(168)),(SI,A(1)),          (CNCNTO,SLG(138)),(CNATI,SLG(139&
     &)),(CNATO,SLG(140)),(CNAI,SLG(92)),(CNAO,SLG(91))
      EQUIVALENCE (D13246(1),DUMY1(1)),(D13246(185),DUMY2(1)),(D13246(36&
     &9),DUMY3(1)),(D13246(553),DUMY4(1)),(D13246(737),DUMY5(1)) ,      &
     &(D13246(921),DUMY6(1))
      EQUIVALENCE (SUBAF(1),DUMYA(1)),(SUBAF(109),DUMYB(1))
      EQUIVALENCE (SUPAF(1),DUMYC(1)),(SUPAF(109),DUMYD(1))
      EQUIVALENCE (DR360A(1),DUMY7(1)),(DR360A(66),DUMY8(1))
      EQUIVALENCE (SWTEI,A(76)),(SWTEO,A(100))
      EQUIVALENCE (LERO,HTIN(63)),(LERI,HTIN(62)),(KSHARP,HTIN(71))
      EQUIVALENCE (SPANS,HTIN(3)),(XW,SYNA(2)),(XCG,SYNA(1))
      EQUIVALENCE (SWEPLO,A(82))
      EQUIVALENCE (SLG(141),RKT)
      LOGICAL CNPRME
      LOGICAL SUPLE,ROUND,DETACH, GLOVE,PITCH  ,TRANS
      DATA ROUTID/4HSUPL,4HNG  /,Q3250A/4H4.1.,4H3.2-,4H60A /,          &
     &                           Q3250B/4H4.1.,4H3.2-,4H60B /,          &
     & Q3246A/4H4.1.,4H3.2-,4H56A /,Q3359A/4H4.1.,4H3.3-,4H59A /,       &
     & Q3246G/4H4.1.,4H3.2-,4H56G /,Q3359B/4H4.1.,4H3.3-,4H59B /,       &
     & Q3361A/4H4.1.,4H3.3-,4H61A /,                                    &
     & Q3360A/4H4.1.,4H3.3-,4H60A /,Q246AF/4H4.1.,4H3.2-,4H56A-,4HF   /,&
     & Q13252/4H4.1.,4H3.2-,4H62  /,Q13253/4H4.1.,4H3.2-,4H63  /,       &
     & Q15127/4H4.1.,4H5.1-,4H27  /,Q13251/4H4.1.,4H3.2-,4H61  /,       &
     & Q15258/4H4.1.,4H5.2-,4H58  /,Q222AF/4H4.1.,4H4.2-,4H26A-,4HF   /
!
!                  FIGURE 4.1.5.1-27
!
      DATA X27M /0.0,1.0,2.0,3.0/
      DATA X27I /1.57780,1.67221,1.98509,2.28874/
      DATA I27  /0/
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
!                FIGURE 4.1.3.2-65
!
      DATA T455                                                         &
     &/0.,.2,.4,.8,1.,1.25,1.6667,2.5,5.,10./
      DATA D455                                                         &
     &/1.,1.27,1.58,2.28,2.70,2.56,2.49,2.44,2.405,2.4/
!
!              FIGURE 4.1.3.2-60A (CNA/CNA)T FOR SUBSONIC L.E.
!
      DATA A1350/                                                       &
     & 0.,     .3,     .4,     .5,     .6,     .7,     .8,     .9,      &
     & 1.0001 ,                                                         &
     & 0.,     .41,    .82,    1.24,   2.12,   3.18,   6.95,   16.1 /
      DATA DA50/                                                        &
     & 1.,     1.,     1.,     1.,     1.,     1.,     1.,     1.,      &
     &         1.,                                                      &
     & 1.05,   1.05,   1.05,   1.05,   .985,   .945,   .915,   .9,      &
     & .9,                                                              &
     & 1.04,   1.04,   1.04,   1.04,   .965,   .908,   .87,    .85,     &
     & .84,                                                             &
     & 1.12,   1.12,   1.12,   1.015,  .94,    .88,    .838,   .81,     &
     & .796,                                                            &
     & 1.11,   1.11,   1.11,   1.,     .903,   .84,    .795,   .765,    &
     & .75,                                                             &
     & 1.08,   1.08,   1.08,   .954,   .865,   .8,     .75,    .72,     &
     & .7,                                                              &
     & 1.2,    1.2,    1.043,  .907,   .817,   .75,    .707,   .675,    &
     & .66,                                                             &
     & 1.14,   1.14,   .975,    .857,  .772,   .717,   .675,   .65,     &
     & .632 /
!
!              FIGURE 4.1.3.2-60B (CNA/CNA)T FOR SUPERSONIC L.E.
!
      DATA B1350/                                                       &
     & 0.,     .1,     .2,      .3,    .4,     .5,     .6,     .7,      &
     & .8,     .9,     1.0001 ,                                         &
     & 0.,     4.,     8.,      12.,   20.,    30.,    50.,    70./
      DATA DB50/                                                        &
     & 1.,     1.,     1.,      1.,    1.,     1.,     1.,     1.,      &
     & 1.,     1.,     1.,                                              &
     & 1.15,   1.15,   1.15,    1.15,  1.095,  1.04,   .99,    .96,     &
     & .935,   .915,   .9,                                              &
     & 1.12,   1.12,   1.12,    1.12,  1.05,   .985,   .94,    .905,    &
     & .88,    .857,   .84,                                             &
     & 1.15,   1.15,   1.15,    1.08,  1.005,  .945,   .902,   .87,     &
     & .842,   .82,    .796,                                            &
     & 1.22,   1.14,   1.05,    .98,   .93,    .89,    .853,   .823,    &
     & .795,   .77,    .75,                                             &
     & 1.13,   1.05,   .98,    .925,   .88,    .845,   .81,    .782,    &
     & .752,   .73,    .7,                                              &
     & 1.02,   .942,   .895,   .855,   .82,    .79,    .76,    .735,    &
     & .71,    .685,   .66,                                             &
     & 1.,     .92,    .87,    .825,   .79,    .755,   .728,   .7,      &
     & .678,   .655,   .632 /
!
!              FIGURE 4.1.3.2-56G (CNA/A) FOR A*BETA LESS THAN 1.0
!
      DATA G13246/0.,.2,.4,.45,.5,.6,.8,.9,1.0/
      DATA DG3246/1.61,1.58,1.55,1.57,1.62,1.75,1.94,2.0,2.0/
!
!              FIGURE 4.1.3.2-61 (KL)
!
      DATA T13251/.015,.03,.05,.075,.11,.16,.23,.45,.90,1.2,1.7,2.0/
      DATA D13251/.963,.94,.92,.90,.88,.86,.84,.80,.76,.74,.72,.709/
!
!              FIGURE 4.1.5.2-58
!
      DATA T15258/0.0,.28,.40,.50, 1.87/
      DATA DS5258/.54,.54,.559,.60,1.95/
      DATA DR5258/.54,.54,.593,.68,2.0/
!
!              FIGURE 4.1.3.2-56A-F (WING SUPERSONIC CNA)
!
      DATA T13246                                                       &
     &  / 0.,.1,.2,.3,.33,.4,.5,.6,.7,.8,.9,1.0,1.111,1.25,1.429,1.667, &
     &    2.0,2.5,2.941,4.167,7.143,14.286, 30. ,                       &
     &    .25,.5,1.,2.,3.,4.,5.,6. , 15*0.,                             &
     &    0.,.2,.25,.3333,.5,1.0/
!
!     FIG 4.1.3.2-56A
!
      DATA DUMY1                                                        &
     &  /  .39, .39, .39, .39, .39, .39, .39, .39, .39, .39, .39, .41,  &
     &     .44, .5 , .58, .65, .80,1.0 ,1.15,1.55,2.40,3.92,4.0 ,       &
     &     .77, .77, .78, .78, .79, .79, .80, .80, .80, .81, .82, .84,  &
     &     .92,1.0 ,1.18,1.32,1.60,1.9 ,2.18,2.80,3.84,3.92,4.0 ,       &
     &    1.55,1.56,1.57,1.57,1.59,1.59,1.60,1.63,1.66,1.68,1.70,1.75,  &
     &    1.88,2.09,2.30,2.6 ,2.94,3.35,3.70,3.80,3.98,3.98,4.0 ,       &
     &    3.15,3.15,3.15,3.15,3.15,3.15,3.17,3.19,3.23,3.27,3.33,3.4 ,  &
     &    3.46,3.54,3.60,3.7 ,3.75,3.8 ,3.86,3.91,4.0 ,4.0 ,4.0 ,       &
     &    4.71,4.74,4.83,5.09,5.25,5.05,4.80,4.55,4.30,4.09,3.90,3.72,  &
     &    3.78,3.8 ,3.83,3.88,3.90,3.94,3.92,3.96,4.0 ,4.0 ,4.0 ,       &
     &    6.29,6.2 ,5.99,5.72,5.61,5.42,5.18,4.9 ,4.64,4.42,4.2 ,4.0 ,  &
     &    4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,       &
     &    6.3 ,6.34,6.39,6.08,5.97,5.78,5.5 ,5.2 ,4.95,4.7 ,4.48,4.25,  &
     &    4.2 ,4.18,4.14,4.11,4.07,4.05,4.04,4.02,4.  ,4.  ,4.  ,       &
     &    6.32,6.4 ,6.4 ,6.34,6.32,6.13,5.82,5.51,5.25,4.99,4.73,4.5 ,  &
     &    4.4 ,4.32,4.27,4.2 ,4.13,4.11,4.07,4.04,4.  ,4.  ,4.  /
!
!     FIG 4.1.3.2-56B
!
      DATA DUMY2                                                        &
     &  /  .41, .41, .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .41,  &
     &     .41, .48, .56, .67, .84,1.08,1.29,1.83,2.80,3.8 ,4.0 ,       &
     &     .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .83, .85,  &
     &     .98,1.09,1.27,1.48,1.80,2.25,2.53,3.22,3.79,3.92,4.  ,       &
     &    1.57,1.59,1.6 ,1.6 ,1.6 ,1.61,1.63,1.65,1.69,1.73,1.77,1.8 ,  &
     &    2.  ,2.26,2.57,2.9 ,3.27,3.53,3.65,3.8 ,3.91,3.97,4.  ,       &
     &    3.17,3.17,3.22,3.4 ,3.5 ,3.6 ,3.7 ,3.67,3.58,3.49,3.37,3.23,  &
     &    3.38,3.52,3.62,3.71,3.80,3.88,3.9 ,3.95,3.97,3.99,4.0 ,       &
     &    4.72,5.  ,5.1 ,5.02,4.97,4.84,4.64,4.45,4.24,4.05,3.89,3.70,  &
     &    3.84,3.91,3.97,3.99,4.0 ,4.  ,4.  ,4.  ,3.99,4.  ,4.  ,       &
     &    5.57,5.6 ,5.62,5.61,5.6 ,5.42,5.15,4.91,4.7 ,4.48,4.25,4.08,  &
     &    4.13,4.18,4.16,4.11,4.09,4.05,4.02,4.01,4.  ,4.  ,4.  ,       &
     &    5.73,5.77,5.79,5.79,5.77,5.75,5.6 ,5.33,5.08,4.83,4.59,4.4 ,  &
     &    4.42,4.4 ,4.32,4.23,4.17,4.08,4.05,4.03,4.01,4.  ,4.  ,       &
     &    5.83,5.88,5.91,5.93,5.93,5.91,5.88,5.68,5.4 ,5.14,4.9 ,4.7 ,  &
     &    4.68,4.59,4.46,4.33,4.23,4.13,4.1 ,4.06,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56C
!
      DATA DUMY3                                                        &
     &  /  .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .42,  &
     &     .43, .5 , .6 , .71, .9 ,1.12,1.35,1.97,2.95,3.80,4.  ,       &
     &     .8 , .8 , .8 , .8 , .8 , .8 , .8 , .81, .82, .83, .83, .88,  &
     &     .95,1.06,1.23,1.46,1.83,2.3 ,2.65,3.32,3.76,3.92,4.  ,       &
     &    1.59,1.59,1.59,1.59,1.59,1.6 ,1.62,1.65,1.68,1.72,1.78,1.82,  &
     &    2.  ,2.29,2.65,3.  ,3.27,3.5 ,3.6 ,3.78,3.90,3.98,4.  ,       &
     &    3.14,3.2 ,3.41,3.62,3.68,3.75,3.7 ,3.62,3.51,3.42,3.3 ,3.18,  &
     &    3.34,3.5 ,3.6 ,3.7 ,3.8 ,3.85,3.88,3.93,3.98,4.0 ,4.  ,       &
     &    4.7 ,4.85,5.02,4.98,4.91,4.8 ,4.6 ,4.4 ,4.2 ,4.  ,3.82,3.68,  &
     &    3.8 ,3.9 ,3.98,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    5.4 ,5.44,5.45,5.45,5.42,5.35,5.12,4.9 ,4.69,4.48,4.22,4.02,  &
     &    4.12,4.18,4.17,4.15,4.1 ,4.05,4.04,4.01,4.  ,4.  ,4.  ,       &
     &    5.61,5.63,5.64,5.62,5.61,5.6 ,5.54,5.3 ,5.02,4.8 ,4.6 ,4.39,  &
     &    4.42,4.44,4.38,4.26,4.16,4.1 ,4.07,4.03,4.01,4.  ,4.  ,       &
     &    5.72,5.75,5.76,5.78,5.77,5.76,5.72,5.69,5.4 ,5.15,4.9 ,4.68,  &
     &    4.68,4.6 ,4.49,4.33,4.22,4.15,4.10,4.06,4.02,4.01,4.  /
!
!      FIG 4.1.3.2-56D
!
      DATA DUMY4                                                        &
     &  /  .41, .41, .41, .41, .41, .41, .41, .41, .41, .41, .41, .41,  &
     &     .43, .50, .6 , .71, .89,1.11,1.35,2.00,3.00,3.72,4.00,       &
     &     .82, .82, .81, .8 , .8 , .81, .82, .83, .84, .85, .87, .89,  &
     &     .98,1.1 ,1.3 ,1.5 ,1.82,2.23,2.68,3.3 ,3.7 ,3.91,4.  ,       &
     &    1.6 ,1.59,1.58,1.58,1.58,1.59,1.60,1.62,1.66,1.73,1.81,1.92,  &
     &    2.2 ,2.45,2.7 ,2.98,3.22,3.45,3.59,3.75,3.7 ,3.91,4.  ,       &
     &    3.13,3.18,3.32,3.6 ,3.64,3.72,3.70,3.64,3.54,3.45,3.3 ,3.14,  &
     &    3.32,3.48,3.6 ,3.7 ,3.79,3.87,3.9 ,3.95,3.99,4.  ,4.  ,       &
     &    4.71,4.76,4.8 ,4.83,4.84,4.7 ,4.53,4.34,4.18,4.  ,3.82,3.63,  &
     &    3.78,3.9 ,3.98,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    5.2 ,5.22,5.22,5.2 ,5.2 ,5.15,5.1 ,4.88,4.63,4.42,4.21,4.0 ,  &
     &    4.15,4.21,4.21,4.17,4.14,4.07,4.05,4.03,4.01,4.  ,4.  ,       &
     &    5.45,5.47,5.47,5.45,5.45,5.41,5.36,5.3 ,5.02,4.81,4.58,4.36,  &
     &    4.45,4.47,4.41,4.30,4.19,4.12,4.08,4.02,4.  ,4.  ,4.  ,       &
     &    5.58,5.59,5.59,5.59,5.59,5.58,5.57,5.53,5.41,5.14,4.91,4.65,  &
     &    4.7 ,4.65,4.53,4.4 ,4.27,4.16,4.12,4.05,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56E
!
      DATA DUMY5                                                        &
     & /   .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 ,  &
     &     .44, .52, .63, .78, .98,1.21,1.4 ,2.07,3.07,3.6 ,4.  ,       &
     &     .8 , .8 , .79, .79, .79, .79, .8 , .81, .83, .85, .88, .9 ,  &
     &    1.01,1.17,1.38,1.62,2.00,2.50,2.74,3.22,3.66,3.87,4.  ,       &
     &    1.58,1.59,1.62,1.71,1.76,1.77,1.8 ,1.85,1.88,1.91,1.92,1.93,  &
     &    2.13,2.4 ,2.6 ,2.88,3.12,3.39,3.51,3.71,3.87,3.99,4.  ,       &
     &    3.15,3.21,3.38,3.61,3.7 ,3.67,3.59,3.5 ,3.4 ,3.29,3.17,3.03,  &
     &    3.18,3.37,3.51,3.67,3.78,3.85,3.88,3.93,3.98,4.  ,4.  ,       &
     &    4.42,4.42,4.41,4.40,4.39,4.38,4.35,4.25,4.08,3.9 ,3.72,3.57,  &
     &    3.70,3.86,3.93,3.99,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    4.88,4.85,4.81,4.80,4.79,4.77,4.73,4.68,4.53,4.35,4.15,3.99,  &
     &    4.08,4.20,4.23,4.19,4.1 ,4.07,4.05,4.01,4.  ,4.  ,4.  ,       &
     &    5.08,5.09,5.08,5.08,5.07,5.06,5.03,4.99,4.92,4.74,4.53,4.3 ,  &
     &    4.43,4.48,4.43,4.32,4.20,4.12,4.08,4.03,4.01,4.  ,4.  ,       &
     &    5.19,5.21,5.22,5.23,5.23,5.23,5.23,5.21,5.19,5.09,4.88,4.6 ,  &
     &    4.72,4.69,4.58,4.41,4.28,4.18,4.12,4.07,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56F
!
      DATA DUMY6                                                        &
     & /   .4 , .4 , .4 , .4 , .4 , .41, .44, .49, .51, .54, .59, .61,  &
     &     .69, .75, .81, .9 ,1.01,1.26,1.53,2.1 ,2.9 ,3.42,4.  ,       &
     &     .81, .81, .81, .83, .84, .86, .88, .91, .99,1.02,1.1 ,1.19,  &
     &    1.3 ,1.42,1.58,1.75,2.  ,2.34,2.6 ,3.  ,3.46,3.71,4.   ,      &
     &    1.6 ,1.58,1.59,1.6 ,1.6 ,1.61,1.67,1.7 ,1.79,1.86,1.92,2.  ,  &
     &    2.13,2.32,2.51,2.75,2.97,3.2 ,3.35,3.58,3.8 ,3.9 ,4.  ,       &
     &    3.13,3.1 ,3.08,3.05,3.04,3.03,3.01,2.99,2.95,2.93,2.91,2.89,  &
     &    3.02,3.2 ,3.37,3.52,3.67,3.77,3.82,3.88,3.92,3.97,4.  ,       &
     &    3.79,3.84,3.86,3.8 ,3.79,3.72,3.63,3.58,3.5 ,3.47,3.43,3.41,  &
     &    3.57,3.75,3.89,3.98,4.  ,3.98,3.94,3.93,3.92,3.99,4.  ,       &
     &    4.12,4.2 ,4.19,4.09,4.06,4.03,3.99,3.95,3.92,3.9 ,3.88,3.87,  &
     &    4.01,4.1 ,4.21,4.21,4.12,4.05,4.  ,3.96,3.99,4.  ,4.  ,       &
     &    4.39,4.45,4.44,4.39,4.35,4.31,4.27,4.25,4.25,4.25,4.25,4.25,  &
     &    4.37,4.50,4.49,4.39,4.23,4.1 ,4.03,3.99,4.  ,4.  ,4.  ,       &
     &    4.6 ,4.68,4.65,4.59,4.57,4.54,4.5 ,4.45,4.48,4.53,4.59,4.61,  &
     &    4.71,4.75,4.69,4.5 ,4.31,4.18,4.08,4.01,4.  ,4.  ,4.  /
!
!              FIGURE 4.1.3.3-59A
!
      DATA A13359                                                       &
     & / 0.0, 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, 70.0, 80.0 , 2*0.,    &
     &   .7,.8,.9,1.0,1.1,1.25,1.5,2.0,2.5,3.0,3.25  /
      DATA D13359                                                       &
     & / 0.,3.50,4.95,5.85,6.40,6.83,7.25,7.57,7.85,                    &
     &   0.,3.00,4.19,4.95,5.58,6.04,6.49,6.80,7.00,                    &
     &   0.,2.34,3.40,4.00,4.49,4.91,5.28,5.63,5.92,                    &
     &   0.,1.86,2.78,3.20,3.53,3.90,4.25,4.60,4.85,                    &
     &   0.,1.42,2.20,2.68,3.05,3.34,3.62,3.87,4.06,                    &
     &   0.,1.10,1.62,1.94,2.19,2.40,2.64,2.80,2.95,                    &
     &   0.,0.92,1.35,1.65,1.84,2.00,2.17,2.28,2.35,                    &
     &   0.,0.73,1.10,1.35,1.54,1.67,1.76,1.83,1.85,                    &
     &   0.,0.62,0.94,1.00,1.10,1.12,1.12,1.10,1.09,                    &
     &   0.,0.54,0.72,0.68,0.42,0.0 ,0.0 ,0.0, 0.0 ,                    &
     &   0.,0.45,0.63,0.51,0.23,0.0 ,0.0 , 0.0 ,0.0 /
!
!              FIGURE 4.1.3.3-59B (LEFT SIDE)
!
      DATA BL3359                                                       &
     & / 0.5,0.6,0.7,0.8,1.0,5*0,                                       &
     &   0.6,0.8,1.0,1.2,1.6,2.0,2.4,2.6,2.8,3.0/
      DATA DL3359                                                       &
     & / 2.03,1.95,1.90,1.86,1.78,                                      &
     &   1.94,1.87,1.82,1.77,1.70,                                      &
     &   1.82,1.75,1.69,1.64,1.57,                                      &
     &   1.71,1.63,1.58,1.54,1.46,                                      &
     &   1.51,1.44,1.37,1.32,1.24,                                      &
     &   1.32,1.24,1.16,1.10,0.99,                                      &
     &   0.98,0.89,0.82,0.75,0.65,                                      &
     &   0.58,0.52,0.47,0.42,0.37,                                      &
     &   0.18,0.15,0.12,0.13,0.17,                                      &
     &   0.00,0.00,0.00,0.00,0.00/
!
!              FIGURE 4.1.3.3-59B (RIGHT SIDE)
!
      DATA BR3359                                                       &
     & / 0., .1, .2, .3, .4, .5, .6, .7, .8, .9, 1.0 ,                  &
     &   0.6,0.8,1.0,1.2,1.6,2.0,2.4,2.6,2.8,3.0/
      DATA DR3359                                                       &
     & / 7*1.69,1.7,1.72,1.75,1.77,                                     &
     &   1.69,1.66,1.64,1.62,1.60,1.60,1.61,1.63,1.65,1.67,1.69,        &
     &   1.69,1.64,1.59,1.56,1.52,1.51,1.51,1.51,1.52,1.54,1.57,        &
     &   1.69,1.61,1.55,1.49,1.44,1.41,1.39,1.40,1.41,1.43,1.46,        &
     &   1.69,1.56,1.45,1.36,1.28,1.22,1.18,1.17,1.18,1.20,1.23,        &
     &   1.69,1.52,1.34,1.20,1.08,0.99,0.94,0.91,0.91,0.94,0.98,        &
     &   1.69,1.40,1.14,0.94,0.80,0.70,0.65,0.62,0.61,0.63,0.65,        &
     &   1.69,1.32,1.08,0.89,0.74,0.64,0.54,0.47,0.42,0.38,0.37,        &
     &   1.69,1.32,1.04,0.84,0.67,0.54,0.45,0.34,0.27,0.20,0.17,        &
     &   1.69,1.31,1.02,0.79,0.61,0.46,0.33,0.21,0.12,0.03,0.0/
!
!                FIGURE 4.1.3.3-60A (LEFT SIDE)
!
      DATA TL360A                                                       &
     & /  0, 0.2, 0.4, 0.6, 0.8, 1.0   , 6*0.,                          &
     &   1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.2, 2.26, 2.4, 2.6, 2.8, 3.0 /
      DATA DL360A                                                       &
     & / 1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.48, 1.25, 1.03, 0.85, 0.70, 0.60,                            &
     &   0.84, 0.63, 0.50, 0.42, 0.37, 0.37,                            &
     &   0.34, 0.25, 0.17, 0.13, 0.11, 0.16,                            &
     &   0.0,  0.0,  0.0,  0.0,  0.0,  0.0    /
!
!                FIGURE 4.1.3.3-60A (RIGHT SIDE)
!
      DATA TR360A                                                       &
     & / 0.0, 0.2, 0.220, 0.24, 0.270, 0.3, 0.32, 0.375, 0.4, 0.471,    &
     &   0.6, 0.8, 1.0  ,                                               &
     &   1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.2, 2.26, 2.4, 2.6, 2.8, 3.0 /
      DATA DUMY7                                                        &
     & / 1.68, 1.46, 1.45, 1.40, 1.31, 1.23, 1.16, 1.05, 1.00, 0.88,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.41, 1.40, 1.40, 1.31, 1.23, 1.16, 1.05, 1.00, 0.88,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.37, 1.35, 1.33, 1.31, 1.23, 1.16, 1.05, 1.00, 0.88,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.30, 1.26, 1.24, 1.21, 1.18, 1.16, 1.05, 1.00, 0.88,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.24, 1.20, 1.16, 1.14, 1.11, 1.10, 1.05, 1.00, 0.88,    &
     &                                             0.72, 0.64, 0.68/
      DATA DUMY8/                                                       &
     &   1.68, 1.16, 1.11, 1.10, 1.07, 1.04, 1.02, 0.96, 0.94, 0.88,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.11, 1.07, 1.03, 1.00, 0.97, 0.95, 0.89, 0.87, 0.81,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.10, 1.03, 1.02, 0.98, 0.95, 0.93, 0.87, 0.85, 0.79,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.07, 1.00, 0.98, 0.95, 0.90, 0.87, 0.81, 0.79, 0.72,    &
     &                                             0.63, 0.56, 0.60,    &
     &   1.68, 1.04, 0.98, 0.94, 0.90, 0.86, 0.83, 0.76, 0.74, 0.66,    &
     &                                             0.54, 0.42, 0.37,    &
     &   1.68, 1.03, 0.97, 0.92, 0.86, 0.77, 0.76, 0.69, 0.65, 0.57,    &
     &                                             0.42, 0.25, 0.16,    &
     &   1.68, 1.02, 0.96, 0.90, 0.84, 0.775,0.75, 0.67, 0.63, 0.52,    &
     &                                             0.34, 0.10, 0.0  /
!
!              FIGURE 4.1.3.2-62 LEADING-EDGE-EFFECT FACTORS FOR NORMAL-
!                                FORCE-CURVE SLOPE AT SUPERSONIC SPEEDS
!              FIGURE 4.1.3.2-62 (ROUND LEADING EDGE)
!
      DATA R13252                                                       &
     & / 0., .5, .94, 1., 1.05, 1.5, 2., 2.5, 3., 3.5, 4., 20./
      DATA DRND52                                                       &
     & / 1.043, .97, .893, .89, .894, .987, 1.005, 1.02, 1.025, 1.03,   &
     & 1.034, 1.034 /
!
!              FIGURE 4.1.3.2-62 (SHARP LEADING EDGE)
!
      DATA S13252                                                       &
     & / 0., .5, .94, 1., 1.05, 1.5, 2., 2.5, 3., 3.5, 4., 20./
      DATA DSHP52                                                       &
     & / 1.08, 1.013, .94, .942, .948, 1.005, 1.03, 1.04, 1.048, 1.05,  &
     & 1.055, 1.055 /
!
!              FIGURE 4.1.3.2-63 WING SUPERSONIC NORMAL-FORCE-CURVE
!              SLOPE, TAPER RATIO ZERO
!
      DATA T13253                                                       &
     &  / .0,.2,.4,.6,.8,1.,1.2,1.4,1.6,1.8,2.,2.4,2.8,3.2 ,            &
     &     -1.0, -0.8, -0.6, -0.4, -0.2, 0.0, 0.2, 0.4, 0.6, 0.8 /
      DATA D13253                                                       &
     &  / 1.57 ,1.69 ,1.752,1.78 ,1.774,1.7  ,1.472,1.288,1.15 ,1.034,  &
     &     .938, .795, .69 , .605,                                      &
     &    1.57 ,1.708,1.76 ,1.778,1.727,1.56 ,1.35 ,1.18 ,1.047, .947,  &
     &     .86 , .72 , .617, .543,                                      &
     &    1.57 ,1.708,1.77 ,1.737,1.575,1.418,1.233,1.07 , .94 , .842,  &
     &     .768, .646, .558, .49 ,                                      &
     &    1.57 ,1.708,1.763,1.618,1.442,1.278,1.104, .955, .845, .758,  &
     &     .68 , .57 , .49 , .428,                                      &
     &    1.57 ,1.708,1.548,1.41 ,1.275,1.133, .98 , .84 , .738, .66 ,  &
     &     .594, .495, .425, .37 ,                                      &
     &    1.57 ,1.49 ,1.367,1.245,1.12 , .995, .845, .725, .628, .555,  &
     &     .5  , .423, .363, .312,                                      &
     &    1.254,1.273,1.169,1.062, .958, .848, .7  , .59 , .518, .465,  &
     &     .415, .345, .29 , .253,                                      &
     &     .94 , .943, .948, .875, .788, .695, .55 , .465, .404, .36 ,  &
     &     .325, .268, .227, .196,                                      &
     &     .62 , .623, .63 , .648, .597, .537, .403, .335, .287, .25 ,  &
     &     .22 , .18 , .15 , .13 , .31 , .315, .327, .347, .391, .35 ,  &
     &     .23 , .177, .147, .129, .112, .09 , .073, .062 /
!
!              FIGURE 4.1.3.3-61A
!
      DATA T61A/1.0,1.5,2.0,2.5,3.0,4.0,5.0,6.0,7.0/
      DATA SLOPE/59.375,41.667,33.0,27.778,23.611,16.667,12.5,8.75,6.0/
!
!           ****** FIGURE 4.1.4.2-26(A),(B),(C),(D),(E),(F) ******
!              ****SUPERSONIC****
!
      DATA T422AF                                                       &
     &/0.,.2,.4,.6,.8,1.,                                               &
     &1.,2.,3.,4.,5.,6.,                                                &
     &0.,.2,.25,.33,.5,1./
      DATA DUMYA/                                                       &
     &  .165,   .210,   .250,   .290,   .310,   .345,   .335,   .365,   &
     &  .390,   .415,   .445,   .470,   .500,   .540,   .560,   .560,   &
     &  .560,   .560,   .670,   .670,   .670,   .670,   .670,   .670,   &
     &  .830,   .775,   .775,   .775,   .775,   .775,   .990,   .930,   &
     &  .895,   .895,   .895,   .895,                                   &
     &  .200,   .230,   .280,   .305,   .335,   .360,   .400,   .445,   &
     &  .485,   .500,   .520,   .530,   .600,   .630,   .650,   .660,   &
     &  .665,   .665,   .795,   .800,   .800,   .805,   .810,   .815,   &
     &  .970,   .965,   .955,   .955,   .955,   .955,   1.150,  1.135,  &
     &  1.120,  1.100,  1.100,  1.105,                                  &
     &  .230,   .275,   .300,   .330,   .350,   .370,   .415,   .470,   &
     &  .500,   .530,   .545,   .550,   .630,   .670,   .680,   .685,   &
     &  .690,   .690,   .830,   .835,   .835,   .840,   .845,   .850,   &
     &  1.030,  1.015,  1.005,  1.000,  1.005,  1.010,  1.250,  1.225,  &
     &  1.200,  1.170,  1.165,  1.160/
      DATA DUMYB/                                                       &
     &  .220,   .280,   .315,   .345,   .375,   .390,   .440,   .500,   &
     &  .535,   .560,   .570,   .580,   .670,   .700,   .720,   .725,   &
     &  .740,   .740,   .880,   .885,   .895,   .900,   .900,   .900,   &
     &  1.070,  1.070,  1.075,  1.075,  1.080,  1.080,  1.270,  1.260,  &
     &  1.260,  1.255,  1.255,  1.255,                                  &
     &  .250,   .300,   .330,   .380,   .415,   .445,   .500,   .560,   &
     &  .600,   .620,   .635,   .640,   .750,   .780,   .800,   .820,   &
     &  .820,   .825,   .980,   .990,   1.000,  1.020,  1.020,  1.020,  &
     &  1.190,  1.200,  1.200,  1.210,  1.220,  1.225,  1.380,  1.390,  &
     &  1.400,  1.410,  1.420,  1.420,                                  &
     &  .340,   .380,   .410,   .460,   .500,   .540,   .680,   .700,   &
     &  .730,   .770,   .790,   .840,   .950,   .990,   1.010,  1.050,  &
     &  1.080,  1.120,  1.200,  1.240,  1.290,  1.330,  1.370,  1.420,  &
     &  1.440,  1.500,  1.550,  1.610,  1.670,  1.720,  1.680,  1.760,  &
     &  1.820,  1.890,  1.950,  2.020/
      DATA DUMYC/                                                       &
     &  .415,   .410,   .400,   .385,   .370,   .345,   .500,   .500,   &
     &  .495,   .485,   .480,   .470,   .585,   .580,   .580,   .575,   &
     &  .570,   .560,   .670,   .670,   .670,   .670,   .670,   .670,   &
     &  .750,   .750,   .755,   .760,   .765,   .775,   .830,   .840,   &
     &  .845,   .855,   .870,   .895,                                   &
     &  .460,   .455,   .445,   .420,   .390,   .360,   .575,   .575,   &
     &  .570,   .560,   .545,   .530,   .695,   .695,   .690,   .685,   &
     &  .680,   .665,   .800,   .805,   .805,   .810,   .815,   .815,   &
     &  .920,   .930,   .935,   .945,   .970,   .955,   1.040,  1.045,  &
     &  1.050,  1.075,  1.110,  1.105,                                  &
     &  .475,   .465,   .450,   .430,   .400,   .370,   .600,   .600,   &
     &  .595,   .585,   .575,   .550,   .725,   .730,   .730,   .725,   &
     &  .715,   .690,   .850,   .850,   .855,   .865,   .870,   .850,   &
     &  .970,   .975,   .980,   1.000,  1.020,  1.010,  1.110,  1.110,  &
     &  1.110,  1.130,  1.180,  1.160/
      DATA DUMYD/                                                       &
     &  .500,   .490,   .470,   .450,   .425,   .390,   .640,   .635,   &
     &  .630,   .620,   .600,   .580,   .770,   .775,   .780,   .775,   &
     &  .765,   .740,   .920,   .915,   .920,   .930,   .935,   .900,   &
     &  1.050,  1.055,  1.060,  1.080,  1.105,  1.080,  1.195,  1.200,  &
     &  1.205,  1.225,  1.265,  1.255,                                  &
     &  .550,   .535,   .525,   .500,   .475,   .445,   .720,   .715,   &
     &  .710,   .690,   .670,   .640,   .890,   .890,   .890,   .885,   &
     &  .870,   .825,   1.060,  1.050,  1.050,  1.060,  1.065,  1.020,  &
     &  1.215,  1.215,  1.220,  1.245,  1.270,  1.225,  1.380,  1.380,  &
     &  1.395,  1.420,  1.470,  1.420,                                  &
     &  .760,   .730,   .700,   .650,   .600,   .540,   1.000,  1.000,  &
     &  .970,   .930,   .890,   .840,   1.240,  1.230,  1.230,  1.220,  &
     &  1.190,  1.120,  1.500,  1.480,  1.480,  1.490,  1.470,  1.420,  &
     &  1.750,  1.720,  1.730,  1.760,  1.780,  1.720,  2.000,  1.970,  &
     &  1.980,  2.020,  2.070,  2.020/
!
      SQP3=12.4707672
      CNPRME=.FALSE.
      MACH=FLC(MIDX+2)
      IF(TANLEO.EQ.0.0)TANLEO=.00001
      IF(TANLEI.EQ.0.0)TANLEI=.00001
      BETA=SQRT(MACH**2-1.)
      DO 1000 J=1,NALPHA
      ALPHAJ(J)= (ALSCHD(J)+ALPHAI)/RAD
 1000 END DO
      IF(HTIN(15).NE.WTYPE(1))GO TO 1310
!
!       **STRAIGHT TAPERED SUPERSONIC NORMAL FORCE SLOPE**
!
      BOVERT=BETA/TANLE
      CA=COSLE
      IF( BOVERT.GT.1.0)GO TO 1010
      SUPLE=.FALSE.
      GO TO 1020
 1010 SUPLE=.TRUE.
 1020 CONTINUE
      PITCH=.FALSE.
!
!                   FIGURE 4.1.3.2-60A (CNA/CNA)T FOR SUBSONIC L.E.
!
 1030 DELTYT=DELTAY/CA
      IF(SUPLE)GO TO 1040
      VAB(1)=BOVERT
      VAB(2)=DELTYT
      LGB(1)=9
      LGB(2)=8
      CALL INTERX(2,A1350,VAB,LGB,DA50,CNCNT,9,72,                      &
     &            0,0,0,0,0,2,0,0,Q3250A,3,ROUTID)
      IF(CNCNT.GT.1.)CNCNT=1.
      IF(PITCH)GO TO 1320
      CNNNT=CNCNT
      GO TO 1050
!
!                   FIGURE 4.1.3.2-60B (CNA/CNA)T FOR SUPERSONIC L.E.
!
 1040 CONTINUE
      ARG=DELTAY/(5.85*CA)
      DELTDT=ATAN(ARG)*RAD
      VAB(1)=1./BOVERT
      VAB(2)=DELTDT
      LGB(1)=11
      LGB(2)=8
      CALL INTERX(2,B1350,VAB,LGB,DB50,CNCNT,11,88,                     &
     &            0,0,0,0,0,2,0,0,Q3250B,3,ROUTID)
      IF(CNCNT.GT.1.)CNCNT=1.
      IF(PITCH)GO TO 1320
      CNNNT=CNCNT
 1050 IF(TRATIP.EQ.1.0.AND.SWEPLE.EQ.0.0) GO TO 1060
!
!                   NON-RECTANGULAR WING ANALYSIS
!                   FIGURES 4.1.3.2-56A THROUGH F
!
      VAA(1)=BOVERT
      VAA(2)=AR*TANLE
      VAA(3)=TAPEXP
      LGA(1)=23
      LGA(2)=8
      LGA(3)=6
      CALL INTERX(3,T13246,VAA,LGA,D13246,BCNA,23,1104,                 &
     &            0,2,0,0,0,2,0,0,Q3246A,3,ROUTID)
      IF(SUPLE)GO TO 1080
      CNTHRY=BCNA/TANLE
      GO TO 1090
 1060 CONTINUE
!
!                        RECTANGULAR WING ANALYSIS
!
      IF(AR*BETA.GT.1.0)GO TO 1070
!
!                        FIGURE 4.1.3.2-56G(CNA/A)
!
      VAB(1)=AR*BETA
      LGB(1)=9
      CALL INTERX(1,G13246,VAB,LGB,DG3246,CNAA,9,9,                     &
     &            0,0,0,0,0,0,0,0,Q3246G,3,ROUTID)
      CNTHRY=CNAA*AR
      GO TO 1090
 1070 BCNA= 4.-2.*(1./(AR*BETA))
 1080 CNTHRY=BCNA/BETA
 1090 CNA=CNTHRY*CNCNT
      CNA1=CNA*SRSTAR/SW
      TLE192=TANLE/1.92
      IF(TLE192.LE.1.)GO TO 1100
      ARG=DELTAY/(5.85*COSLE)
      DELTDT=ATAN(ARG)*RAD
!
!                   FIGURE 4.1.3.3-59A (VALUE OF CC)
!
      VAB(1)=DELTDT
      VAB(2)=CNA*TLE192
      LGB(1)=9
      LGB(2)=11
      CALL INTERX(2,A13359,VAB,LGB,D13359,CC,11,99,                     &
     &            0,2,0,0,2,2,0,0,Q3359A,3,ROUTID)
      E=CNA*(TLE192+CC*(TLE192-1.))
      GO TO 1110
 1100 E=CNA
 1110 CONTINUE
      IF(SUPLE)GO TO 1160
!
!     WING LIFT IN THE NONLINEAR ANGLE OF ATTACK RANGE SUBSONIC L.E.
!                         STRAIGHT TAPERED WING
!           COMPUTATION OF LIFT COEFICIENT VS ANGLE OF ATTACK
!
      ARG=E*BOVERT
      DO 1150 J=1,NALPHA
         IF(ALPHAJ(J).NE.0.0)GO TO 1120
         CNAAA(J)=0.0
         GO TO 1140
 1120    ARG1=CNCNT/(BETA*ABS(TAN(ALPHAJ(J))))
         IF(ARG1.GT.1.)GO TO 1130
!
!              FIGURE 4.1.3.3-59B (CN(AA)) RIGHT SIDE
!
         VAB(1)=ARG1
         VAB(2)=ARG
         LGB(1)=11
         LGB(2)=10
         CALL INTERX(2,BR3359,VAB,LGB,DR3359,CNAAA(J),11,110,           &
     &               2,2,0,0,0,0,0,0,Q3359B,3,ROUTID)
         GO TO 1140
 1130    CONTINUE
!
!              FIGURE 4.1.3.3-59B(CN(AA)) LEFT SIDE
!
         VAB(1)=1./ARG1
         VAB(2)=ARG
         LGB(1)=5
         LGB(2)=10
         CALL INTERX(2,BL3359,VAB,LGB,DL3359,CNAAA(J),10,50,            &
     &               2,2,0,0,0,0,0,0,Q3359B,3,ROUTID)
 1140    CONTINUE
         CN(J)=CNA* SIN(2.*ALPHAJ(J))/2.+CNAAA(J)*SIN(ALPHAJ(J))*ABS    &
     &         (SIN(ALPHAJ(J)))
         CN(J)=CN(J)*SRSTAR/SW
         CL(J)=CN(J)*COS(ALPHAJ(J))
 1150 END DO
      GO TO 1420
!
!     WING LIFT IN THE NONLINEAR ANGLE OF ATTACK RANGE SUPERSONIC L.E.
!                         STRAIGHT TAPERED WING
 1160 CONTINUE
!
! ****IF SHOCK IS ATTACHED AT ZERO ANGLE OF ATTACK SET DETACH=FALSE
!
      TRANS=.FALSE.
      RMACH=MACH*SQRT(1.-SINLE **2)
      IF(RMACH.LT.1.)GO TO 1250
      CALL ANGDET(RMACH,DELMAX)
      IF(DELTDT/RAD.GT.DELMAX)GO TO 1250
      DETACH=.FALSE.
!
!         FIND ANGLE OF ATTACH AT WHICH SHOCK WILL START TO DETACH
!
      ANGLE=1.
      ANGMAX=ABS(ALPHAJ(1))
      IF(ANGMAX.LT.ABS(ALPHAJ(NALPHA)))ANGMAX=ABS(ALPHAJ(NALPHA))
 1170 DEG=ANGLE/RAD
      RRMACH=MACH* (1.-(SINLE *COS(DEG))**2)**.5
      IF(RRMACH.LT.1.)GO TO 1180
      CALL ANGDET(RRMACH,DELMAX)
      IF((DELTDT/RAD+TAN(DEG)/COSLE).LT.DELMAX)GO TO 1180
      DETANG=DEG
      GO TO 1200
 1180 ANGLE=ANGLE+1.
      IF(ANGLE.GT.ANGMAX)GO TO 1190
      GO TO 1170
 1190 DETANG=90./RAD
      GO TO 1220
 1200 CONTINUE
!
!              FIGURE 4.1.3.3-60B
!
      BTANA = BETA*TAN(DETANG)
      CALL FIG60B(BETA, BTANA, CNAAST)
!
!              FIGURE 4.1.3.3-61A
!
      VAB(1)=BETA
      LGB(1)=9
      CALL INTERX(1,T61A,VAB,LGB,SLOPE,DELCN,9,9,                       &
     &            0,0,0,0,2,0,0,0,Q3361A,3,ROUTID)
      DETALP=DELCN*CNAAST/RAD
      ALPHAP=DETANG+DETALP
      CNPRME = .TRUE.
      J=1
      ARG2=BETA*ABS(TAN(ALPHAP))
      GO TO 1280
 1210 CNAAAP=CNAAA(J)
      CNPRME=.FALSE.
 1220 J=0
 1230 J=J+1
      IF(ABS(ALPHAJ(J)).LT.DETANG)GO TO 1240
      TRANS=.TRUE.
      RATIO=(ABS(ALPHAJ(J))-DETANG)/(ALPHAP-DETANG)
      ARG2=BETA*ABS(TAN(ALPHAJ(J)))
      IF(ABS(ALPHAJ(J)).LT.ALPHAP)GO TO 1300
      TRANS=.FALSE.
      GO TO 1270
 1240 CONTINUE
!
!              FIGURE 4.1.3.3-60B
!
      BTANA = BETA*ABS(TAN(ALPHAJ(J)))
      CALL FIG60B(BETA, BTANA, CNAAA(J))
      TRANS=.FALSE.
      GO TO 1300
 1250 CONTINUE
      DETACH=.TRUE.
!
!              SUPERSONIC WING LIFT VS ANGLE OF ATTACK WITH DETACHED
!                   SHOCK AT ZERO ANGLE OF ATTACK
!
      J=0
 1260 J=J+1
      ARG2=BETA*ABS(TAN(ALPHAJ(J)))
 1270 IF(ALPHAJ(J).NE.0.0)GO TO 1280
      CNAAA(J)=0.0
      GO TO 1300
 1280 ARG1=CNCNT/ARG2
!
!                   FIGURE 4.1.3.3-60A (CNAAA) RIGHT SIDE
!
      VAB(2)=E
      IF(ARG1.GT.1.) GO TO 1290
      VAB(1)=ARG1
      LGB(1)=13
      LGB(2)=12
      CALL INTERX(2,TR360A,VAB,LGB,DR360A,CNAAA(J),13,156,              &
     &            2,0,0,0,0,0,0,0,Q3360A,3,ROUTID)
      GO TO 1300
 1290 CONTINUE
!
!                   FIGURE 4.1.3.3-60A (CNAAA) LEFT SIDE
!
      VAB(1)=1./ARG1
      LGB(1)=6
      LGB(2)=12
      CALL INTERX(2,TL360A,VAB,LGB,DL360A,CNAAA(J),12,72,               &
     &            0,0,0,0,0,0,0,0,Q3360A,3,ROUTID)
 1300 CONTINUE
      IF(CNPRME) GO TO 1210
      IF(TRANS) CNAAA(J)=CNAAST-RATIO*(CNAAST-CNAAAP)
      CN(J)=CNA*SIN(2.*ALPHAJ(J))/2.0+                                  &
     &   CNAAA(J)*SIN(ALPHAJ(J))*ABS(SIN(ALPHAJ(J)))
      CN(J)=CN(J)* SRSTAR/SW
      CL(J)=CN(J)*COS(ALPHAJ(J))
      IF(J.GE.NALPHA)GO TO 1420
      IF(DETACH)GO TO 1260
      GO TO 1230
!
!    ***SUPERSONIC NORMAL FORCE SLOPE,NON-STRAIGHT TAPERED WINGS***
!                    BASIC WING COMPONENT
!
 1310 CONTINUE
      SPANIN=SPANS-SPANO
      CRBW=CB+SPANIN*(TANLEO-TANTEO)
      SBW=(CRBW+CT)*SPANS
      ARBW=4.*SPANS**2/SBW
      TAPBW=CT/CRBW
      BOVERT=BETA/TANLEO
      SUPLE=.FALSE.
      IF(BOVERT.GT.1.)SUPLE=.TRUE.
!
!                   FIGURE 4.1.3.2-56A-F (CNABW)
!
      VAB(1)=BOVERT
      VAB(2)=ARBW*TANLEO
      VAB(3)=TAPBW
      PITCH=.FALSE.
      I=0
      GLOVE=.FALSE.
      TA=TANLEO
 1320 LGB(1)=23
      LGB(2)=8
      LGB(3)=6
      IF(I.NE.0) VAB(2)=ARP*TA
      CALL INTERX(3,T13246,VAB,LGB,D13246,BCNA,23,1104,                 &
     &            0,2,0,0,0,2,0,0,Q246AF,4,ROUTID)
      CNTHRY=BCNA/TA
      IF(SUPLE)CNTHRY=BCNA/BETA
      IF(PITCH.AND.I.EQ.1)GO TO 1520
      IF(PITCH.AND.I.EQ.2)GO TO 1530
!
!                   LEADING-EDGE-EFFECT PARAMETERS
!              FIGURE 4.1.3.2-62 (CLE)BW
!
      ROUND=.FALSE.
      IF(KSHARP.EQ.UNUSED)ROUND=.TRUE.
      VAB(1)=BOVERT
      LGB(1)=12
!
!              SHARP LEADING EDGE
!
      IF(ROUND)GO TO 1330
      CALL INTERX(1,S13252,VAB,LGB,DSHP52,CLE  ,12,12,                  &
     &            0,0,0,0,0,0,0,0,Q13252,3,ROUTID)
      GO TO 1340
!
!              ROUND LEADING EDGE
!
 1330 CALL INTERX(1,R13252,VAB,LGB,DRND52,CLE  ,12,12,                  &
     &            0,0,0,0,0,0,0,0,Q13252,3,ROUTID)
 1340 IF(GLOVE)GO TO 1370
      CNTBW=CNTHRY
      CLEBW=CLE
      IF(TANLEO.GE.TANLEI)GO TO 1350
      CNABW=CNTBW*SBW/SW *CLEBW
      GO TO 1360
 1350 CONTINUE
      S2=SPANIN**2*TANLEO
      A2=4.*SPANIN**2/S2
      VAB(2)=A2*TANLEO
      VAB(3)=0.0
      CALL INTERX(3,T13246,VAB,LGB,D13246,BCNA,23,1104,                 &
     &            0,2,0,0,0,2,0,0,Q246AF,4,ROUTID)
      CNT2=BCNA/BETA
      IF(VAB(1).GT.1.)CNT2  =BCNA/TANLEO
      CNABW=(CNTHRY*SBW/SW-CNT2  *  S2/SW )*CLEBW
 1360 CONTINUE
!
!                        GLOVE COMPONENT
!
      IF(ABS(SWEPLE-SWEPLO).LT.4.)GO TO 1380
      CRGLV=TANLEI*SPANIN
      SGLV=CRGLV*SPANIN
      ARGLV=4.*SPANIN**2/SGLV
      VAB(1)=BETA/TANLEI
      VAB(2)=ARGLV*TANLEI
      VAB(3)=0.0
      GLOVE=.TRUE.
      BOVERT=VAB(1)
      SUPLE=.FALSE.
      TA=TANLEI
      IF(BOVERT.GT.1.)SUPLE=.TRUE.
      GO TO 1320
 1370 CONTINUE
      CLEGLV=CLE
      CNAGLV=CNTHRY*CLEGLV*SGLV/SW
!
!              FIGURE 4.1.3.2-63 (CN1=CNA/A)
!
      GO TO 1390
 1380 CNAGLV=0.0
!
!                        EXTENSION COMPONENT
!
 1390 IF(ABS(SWTEI-SWTEO).LT.4.)GO TO 1400
      BE= 2.*SPANIN
      VAB(1)=BETA/TANLEI
      VAB(2)=TANTEI/TANLEI
      LGB(1)=14
      LGB(2)=10
      CALL INTERX(2,T13253,VAB,LGB,D13253,CN1,14,140,                   &
     &            2,2,0,0,2,2,0,0,Q13253,3,ROUTID)
      VAB(2)=TANTEO/TANLEI
      CALL INTERX(2,T13253,VAB,LGB,D13253,CN2,14,140,                   &
     &            2,2,0,0,2,2,0,0,Q13251,3,ROUTID)
      CNAE=(CN1-CN2)*BE**2/SW
      GO TO 1410
 1400 CNAE=0.0
!
!**SUPERSONIC NORMAL FORCE SLOPE,NON-STRAIGHT TAPERED WINGS,TOTAL WING
!
 1410 CONTINUE
!
!              FIGURE 4.1.3.2-61
!
      VAB(1)=CNAGLV/(CLEGLV*BETA)*SW/A(4)
      LGB(1)= 12
      CALL INTERX(1,T13251,VAB,LGB,D13251,RKL,12,12,                    &
     &            2,0,0,0,2,0,0,0,Q13251,3,ROUTID)
      CNA1=RKL*(CNABW+CNAGLV+CNAE)
 1420 CONTINUE
!
!      ***PITCHING MOMENT SLOPES AT LOW ANGLE OF ATTACK,STRAIGHT TAPERED
!
      DXW=(SPAN-SPANS)*TANLEI*COS(ALPHAI/RAD)
      DETXCG=XCG-(XW+DXW)
      IF(HTIN(15).NE.WTYPE(1))GO TO 1500
!
!              FIGURE 4.1.4.2-26A-F (XAC/CRSTAR)
!
      TA=TANLE
      ARP=ARSTAR
      TAPR=TAPEXP
      PITCH=.FALSE.
      VAB(2)=ARP*TA
      VAB(3)=TAPR
 1430 LGB(1)=6
      LGB(2)=6
      LGB(3)=6
      IF(BOVERT.GT.1.)GO TO 1440
      VAB(1)=BOVERT
      CALL INTERX(3,T422AF,VAB,LGB,SUBAF,XACCR,6,216,                   &
     &            0,2,0,0,0,2,0,0,Q222AF,4,ROUTID)
      GO TO 1450
 1440 VAB(1)=1./BOVERT
      CALL INTERX(3,T422AF,VAB,LGB,SUPAF,XACCR,6,216,                   &
     & 0,2,0,0,0,2,0,0,Q222AF,4,ROUTID)
 1450 CONTINUE
      IF(BOVERT.GE.0.) GO TO 1455
      VAB(1)=1./BOVERT
      CALL FWDXAC(VAB(2),VAB(3),VAB(1),MACH,ROUTID,XACCR)
 1455 CONTINUE
      IF(SWEPLE .LT. 1.E-10 .AND. HTIN(MIDX+71) .NE. UNUSED)            &
     &      XACCR=HTIN(MIDX+71)*A(16)/CRSTAR
      IF(PITCH)GO TO 1460
      GO TO 1480
 1460 IF(I.EQ.1)XACCRI=XACCR
      IF(I.EQ.2)GO TO 1470
      GO TO 1030
 1470 ARG1=XACCR*CBP/CRSTAR
      ARG2=BSTARB/(CRSTAR*2.)*TANLEO
      ARG3=BSTARB*TANLEI/CRSTAR
      XACCRO=ARG1-ARG2+ARG3
      GO TO 1030
 1480 DCMCL=(DETXCG/CRSTAR-XACCR)*CRSTAR/CBARR
      CMA=DCMCL*CNA1
      DO 1490 J=1,NALPHA
         IF(ALPHAJ(J).GT.0.175)GO TO 1490
         CM(J)=CMA*ALPHAJ(J)
 1490 END DO
      GO TO 1540
!
!   ***SUPERSONIC WING PITCHING MOMENT SLOPE,NON-STRAIGHT TAPERED WINGS*
!
 1500 CONTINUE
      ARP=ARIP
      I=1
      CA=COSLE
      TA=TANLE
      TAPR=TAPIP
 1510 BOVERT=BETA/TA
      VAB(1)=BOVERT
      VAB(2)=ARP*TA
      VAB(3)=TAPR
      SUPLE=.FALSE.
      IF(BOVERT.GT.1.)SUPLE=.TRUE.
      PITCH=.TRUE.
      GO TO 1430
 1520 CNCNTI=CNCNT
      CNATI=CNTHRY
      CNAI=CNCNTI*CNATI
      CA=COSLEO
      TA=TANLEO
      TAPR=TAPOP
      I=2
      ARP=AROP
      GO TO 1510
 1530 CNCNTO=CNCNT
      CNATO=CNTHRY
      CNAO=CNCNTO*CNATO
      ARG1=CNAI*SI*XACCRI + CNAO*SO*XACCRO
      ARG2=CNAI*SI+CNAO*SO
      XACCR=ARG1/ARG2
      GO TO 1480
 1540 CONTINUE
      ARG=(1.+P)/(PI*ARSTAR*P)
!
!  ***SUPERSONIC WING DRAG,CN AND CA VS ANGLE OF ATTACK***
!
      DO 1550 J=1,NALPHA
         CDL(J)=DRAGC*ARG*SW/SRSTAR*CL(J)**2
         CD(J)=CDO + CDL(J)
         COSA=COS(FLC(J+22)/RAD)
         SINA=SIN(FLC(J+22)/RAD)
         IF(CL(J).NE.UNUSED) CN(J)=CL(J)*COSA+CD(J)*SINA
         IF(CL(J).NE.UNUSED) CAF(J)=CD(J)*COSA-CL(J)*SINA
 1550 END DO
      IF(CMA.NE.UNUSED) CMADEG=CMA/RAD
      IF(CNA1.NE.UNUSED) CLADEG=CNA1/RAD
      IF(TANLEO.EQ.0.00001)TANLEO=0.0
      IF(TANLEI.EQ.0.00001)TANLEI=0.0
      RETURN
      END
      SUBROUTINE SUPLTG(KEPSLN)
!
!***  COMPUTES SUPERSONIC HORIZONTAL TAIL CL,CLA AND CMA
!
      DIMENSION ROUTID(2),Q3250A(3),Q3250B(3),Q3246A(3),Q3246G(3),      &
     & Q3359A(3),Q3359B(3),Q3361A(3),Q3360A(3),Q246AF(4),               &
     & Q13252(3),Q13253(3),Q13251(3),Q222AF(4),Q15127(3),Q15258(3)
      REAL MACH,KSHARP
      REAL LHS,LERBW,LERI,LERO
      DIMENSION T13246(52),D13246(1104),VAA(4),LGA(4),VAB(4),LGB(4),    &
     & A1350(17), B1350(19),DA50(72),DB50(88),G13246(9),DG3246(9),      &
     &A13359(22),D13359(99),ALSCHD(20),BR3359(21),DR3359(110),BL3359(20)&
     &,DL3359(50),ALPHAJ(20),CNAAA(20),T61A(9),SLOPE(9)
      DIMENSION DS5258(5),DR5258(5),T15258 (5)
      DIMENSION R13252(12),DRND52(12),S13252(12),DSHP52(12),T13251(12), &
     &          D13251(12)
      DIMENSION WTYPE(4)
      DIMENSION CAF(20)
      DIMENSION CN(20),CL(20),DUMY4(184),DR360A(156),SUPAF(216),SUBAF(21&
     &6)
      DIMENSION DUMYC(108),DUMYD(108)
      DIMENSION TL360A(24),DL360A(72),TR360A(25),T13253(24),D13253(140),&
     &          T422AF(18),DUMY7(65),DUMY8(91),DUMYA(108),DUMYB(108)
      DIMENSION CD(20),CDL(20)
      DIMENSION DUMY1(184),DUMY2(184),DUMY3(184),DUMY5(184),DUMY6(184)
      DIMENSION EPSLON(20),CM(20)
      DIMENSION X27M(4),X27I(4),C27(6)
!
!************** A IN THIS ROUTINE CORRESPONDS TO AHT ELSEWHERE *********
!
      COMMON /OVERLY/ NLOG,NMACH,MIDX,NALPHA
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /OPTION/ SW,CBARR,RUFF,BLREF
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /SUPWH/  SLG(141),STG(141)
      COMMON /HTDATA/ A(195)
      COMMON /HTI/    HTIN(154)
      COMMON /WINGI/  WINGIN(100)
      COMMON /IHT/    PHT,HT(380)
      COMMON /IDWASH/ PDWASH,DWASH(60)
      EQUIVALENCE (CLADEG,HT(101)),(CMADEG,HT(121)),(CAF(1),HT(81))
      EQUIVALENCE (RKL,STG(133)),(S2,STG(74)),(A2,STG(73))
      EQUIVALENCE  (CNAAAP,STG(75))
      EQUIVALENCE(CM,HT(41))
      EQUIVALENCE (RNN,STG(90)),(RLCOFF,STG(89)),(CF,                   &
     &STG(88)),(CDF,STG(87)),(SRSTAR,A(3)),(CBARI,A(15))                &
     &,(CBARO,A(17)),(RNI,STG(86)),(RNO,STG(85)),(CFI,STG(84)),(CFO,    &
     &STG(83)),(SISTAR,A(1)),(SOSTAR,A(2)),(P,STG(82)),(DRAGC,STG(81)   &
     &),(CDO,STG(80)),(CDW,STG(79)),(CDL(1),STG(53)),(CD(1),HT(1))
      EQUIVALENCE (SBW,STG(119)),(CNTBW,STG(77)),(XACCRI,STG(76)),      &
     &(CR,HTIN(6))
      EQUIVALENCE (TAPEXP,A(27)),(SO,A(167))
      EQUIVALENCE (CBP,A(166)),              (BSTARB,A(23))
      EQUIVALENCE (TANLE,A(62)),(BETA,STG(1)),(SWEPLE,A(58)),(AR,A(7  ))&
     &,(TRATIP,A(25)),(BOVERT,STG(2)),(CNNNT,STG(3)),(COSLE,A(61)),     &
     &(DELTAY,HTIN(17)),(BCNA,STG(4)),(DELTYT,STG(8)),(DELTDT,STG(9)),  &
     &(E,STG(11)),(CC,STG(12)),(ALSCHD(1),FLC(23)),(ALPHAI,SYNA(8)),    &
     &(ALPHAJ(1),STG(33)),(CNAAA(1),STG(13)),(SINLE,A(60))              &
     &,(DETACH,STG(94)),(CNAAST,STG(116)),(DETALP,STG(117))
      EQUIVALENCE (CNTHRY,STG(5)),(CNA1,STG(7)),(TLE192,STG(10)),       &
     &(RMACH,STG(93)),(CN(1),HT(61)),(CL(1),HT(21)),(DETANG,STG(115)),  &
     &(XACCRO,STG(78))
      EQUIVALENCE (SPAN,HTIN(4)),(SPANO,HTIN(2)),(CRBW,STG(118))        &
     &,(TANTEO,A(104)),(CB,HTIN(5)),(CT,HTIN(1)),(TAPBW,STG(121))       &
     &,(TANLEI,A(62)),(TANTEI,A(80)),(CN1,STG(127)),(CN2,STG(128)),     &
     &(ARBW,STG(120)),(CLEBW,STG(122)),(CRGLV,STG(123)),(SGLV,STG(124)) &
     &,(ARGLV,STG(125)),(BE,STG(126)),(CNAE,STG(129)),(CNAGLV,STG(130)) &
     &,(CNABW,STG(131)),(CLEGLV,STG(132)),(TANLEO,A(86)),(DETXCG,A(173))
      EQUIVALENCE (ARSTAR,A(7)),(XACCR,STG(134)),(DCMCL,STG(135)),      &
     &(CRSTAR,A(10)),(CMA,STG(136)),(ARIP,A(5))                         &
     & ,(TAPIP,A(26)),(CNCNTI,STG(137)),(TAPOP,A(169)),(COSLEO,A(85)),  &
     &(AROP,A(168)),(SI,A(1)),          (CNCNTO,STG(138)),(CNATI,STG(139&
     &)),(CNATO,STG(140)),(CNAI,STG(92)),(CNAO,STG(91))
      EQUIVALENCE  (SIGMA,A(18))
      EQUIVALENCE (D13246(1),DUMY1(1)),(D13246(185),DUMY2(1)),(D13246(36&
     &9),DUMY3(1)),(D13246(553),DUMY4(1)),(D13246(737),DUMY5(1)) ,      &
     &(D13246(921),DUMY6(1))
      EQUIVALENCE (SUBAF(1),DUMYA(1)),(SUBAF(109),DUMYB(1))
      EQUIVALENCE (SUPAF(1),DUMYC(1)),(SUPAF(109),DUMYD(1))
      EQUIVALENCE (DR360A(1),DUMY7(1)),(DR360A(66),DUMY8(1))
      EQUIVALENCE (SWTEI,A(76)),(SWTEO,A(100)),(SR,SW)
      EQUIVALENCE (LERO,HTIN(63)),(LERI,HTIN(62)),(KSHARP,HTIN(71))     &
     &,(TCEFF,HTIN(70))
      EQUIVALENCE (SPANS,HTIN(3)),(XH,SYNA(6)),(XCG,SYNA(1))
      EQUIVALENCE (SWEPLO,A(82))
      LOGICAL CNPRME
      LOGICAL SUPLE,ROUND,DETACH, GLOVE,PITCH  ,TRANS
      DATA ROUTID/4HSUPL,4HTG  /,Q3250A/4H4.1.,4H3.2-,4H60A /,          &
     &                           Q3250B/4H4.1.,4H3.2-,4H60B /,          &
     & Q3246A/4H4.1.,4H3.2-,4H56A /,Q3359A/4H4.1.,4H3.3-,4H59A /,       &
     & Q3246G/4H4.1.,4H3.2-,4H56G /,Q3359B/4H4.1.,4H3.3-,4H59B /,       &
     & Q3361A/4H4.1.,4H3.3-,4H61A /,                                    &
     & Q3360A/4H4.1.,4H3.3-,4H60A /,Q246AF/4H4.1.,4H3.2-,4H56A-,4HF   /,&
     & Q13252/4H4.1.,4H3.2-,4H62  /,Q13253/4H4.1.,4H3.2-,4H63  /,       &
     & Q15127/4H4.1.,4H5.1-,4H27  /,Q13251/4H4.1.,4H3.2-,4H61  /,       &
     & Q15258/4H4.1.,4H5.2-,4H58  /,Q222AF/4H4.1.,4H4.2-,4H26A-,4HF   /
!
!              FIGURE 4.1.5.1-27
!
      DATA X27M/0.0,1.0,2.0,3.0/
      DATA X27I/1.57780,1.67221,1.98509,2.28874/
      DATA I27/0/
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
!              FIGURE 4.1.3.2-60A (CNA/CNA)T FOR SUBSONIC L.E.
!
      DATA A1350/                                                       &
     & 0.,     .3,     .4,     .5,     .6,     .7,     .8,     .9,      &
     & 1.0001 ,                                                         &
     & 0.,     .41,    .82,    1.24,   2.12,   3.18,   6.95,   16.1 /
      DATA DA50/                                                        &
     & 1.,     1.,     1.,     1.,     1.,     1.,     1.,     1.,      &
     &         1.,                                                      &
     & 1.05,   1.05,   1.05,   1.05,   .985,   .945,   .915,   .9,      &
     & .9,                                                              &
     & 1.04,   1.04,   1.04,   1.04,   .965,   .908,   .87,    .85,     &
     & .84,                                                             &
     & 1.12,   1.12,   1.12,   1.015,  .94,    .88,    .838,   .81,     &
     & .796,                                                            &
     & 1.11,   1.11,   1.11,   1.,     .903,   .84,    .795,   .765,    &
     & .75,                                                             &
     & 1.08,   1.08,   1.08,   .954,   .865,   .8,     .75,    .72,     &
     & .7,                                                              &
     & 1.2,    1.2,    1.043,  .907,   .817,   .75,    .707,   .675,    &
     & .66,                                                             &
     & 1.14,   1.14,   .975,    .857,  .772,   .717,   .675,   .65,     &
     & .632 /
!
!              FIGURE 4.1.3.2-60B (CNA/CNA)T FOR SUPERSONIC L.E.
!
      DATA B1350/                                                       &
     & 0.,     .1,     .2,      .3,    .4,     .5,     .6,     .7,      &
     & .8,     .9,     1.0001 ,                                         &
     & 0.,     4.,     8.,      12.,   20.,    30.,    50.,    70./
      DATA DB50/                                                        &
     & 1.,     1.,     1.,      1.,    1.,     1.,     1.,     1.,      &
     & 1.,     1.,     1.,                                              &
     & 1.15,   1.15,   1.15,    1.15,  1.095,  1.04,   .99,    .96,     &
     & .935,   .915,   .9,                                              &
     & 1.12,   1.12,   1.12,    1.12,  1.05,   .985,   .94,    .905,    &
     & .88,    .857,   .84,                                             &
     & 1.15,   1.15,   1.15,    1.08,  1.005,  .945,   .902,   .87,     &
     & .842,   .82,    .796,                                            &
     & 1.22,   1.14,   1.05,    .98,   .93,    .89,    .853,   .823,    &
     & .795,   .77,    .75,                                             &
     & 1.13,   1.05,   .98,    .925,   .88,    .845,   .81,    .782,    &
     & .752,   .73,    .7,                                              &
     & 1.02,   .942,   .895,   .855,   .82,    .79,    .76,    .735,    &
     & .71,    .685,   .66,                                             &
     & 1.,     .92,    .87,    .825,   .79,    .755,   .728,   .7,      &
     & .678,   .655,   .632 /
!
!              FIGURE 4.1.3.2-56G (CNA/A) FOR A*BETA LESS THAN 1.0
!
      DATA G13246/0.,.2,.4,.45,.5,.6,.8,.9,1.0/
      DATA DG3246/1.61,1.58,1.55,1.57,1.62,1.75,1.94,2.0,2.0/
!
!              FIGURE 4.1.3.2-61 (KL)
!
      DATA T13251/.015,.03,.05,.075,.11,.16,.23,.45,.90,1.2,1.7,2.0/
      DATA D13251/.963,.94,.92,.90,.88,.86,.84,.80,.76,.74,.72,.709/
!
!              FIGURE 4.1.5.2-58
!
      DATA T15258/0.0,.28,.40,.50, 1.87/
      DATA DS5258/.54,.54,.559,.60,1.95/
      DATA DR5258/.54,.54,.593,.68,2.0/
!
!              FIGURE 4.1.3.2-56A-F (WING SUPERSONIC CNA)
!
      DATA T13246                                                       &
     &  / 0.,.1,.2,.3,.33,.4,.5,.6,.7,.8,.9,1.0,1.111,1.25,1.429,1.667, &
     &    2.0,2.5,2.941,4.167,7.143,14.286, 30. ,                       &
     &    .25,.5,1.,2.,3.,4.,5.,6. , 15*0.,                             &
     &    0.,.2,.25,.3333,.5,1.0/
!
!     FIG 4.1.3.2-56A
!
      DATA DUMY1                                                        &
     &  /  .39, .39, .39, .39, .39, .39, .39, .39, .39, .39, .39, .41,  &
     &     .44, .5 , .58, .65, .80,1.0 ,1.15,1.55,2.40,3.92,4.0 ,       &
     &     .77, .77, .78, .78, .79, .79, .80, .80, .80, .81, .82, .84,  &
     &     .92,1.0 ,1.18,1.32,1.60,1.9 ,2.18,2.80,3.84,3.92,4.0 ,       &
     &    1.55,1.56,1.57,1.57,1.59,1.59,1.60,1.63,1.66,1.68,1.70,1.75,  &
     &    1.88,2.09,2.30,2.6 ,2.94,3.35,3.70,3.80,3.98,3.98,4.0 ,       &
     &    3.15,3.15,3.15,3.15,3.15,3.15,3.17,3.19,3.23,3.27,3.33,3.4 ,  &
     &    3.46,3.54,3.60,3.7 ,3.75,3.8 ,3.86,3.91,4.0 ,4.0 ,4.0 ,       &
     &    4.71,4.74,4.83,5.09,5.25,5.05,4.80,4.55,4.30,4.09,3.90,3.72,  &
     &    3.78,3.8 ,3.83,3.88,3.90,3.94,3.92,3.96,4.0 ,4.0 ,4.0 ,       &
     &    6.29,6.2 ,5.99,5.72,5.61,5.42,5.18,4.9 ,4.64,4.42,4.2 ,4.0 ,  &
     &    4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,       &
     &    6.3 ,6.34,6.39,6.08,5.97,5.78,5.5 ,5.2 ,4.95,4.7 ,4.48,4.25,  &
     &    4.2 ,4.18,4.14,4.11,4.07,4.05,4.04,4.02,4.  ,4.  ,4.  ,       &
     &    6.32,6.4 ,6.4 ,6.34,6.32,6.13,5.82,5.51,5.25,4.99,4.73,4.5 ,  &
     &    4.4 ,4.32,4.27,4.2 ,4.13,4.11,4.07,4.04,4.  ,4.  ,4.  /
!
!     FIG 4.1.3.2-56B
!
      DATA DUMY2                                                        &
     &  /  .41, .41, .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .41,  &
     &     .41, .48, .56, .67, .84,1.08,1.29,1.83,2.80,3.8 ,4.0 ,       &
     &     .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .83, .85,  &
     &     .98,1.09,1.27,1.48,1.80,2.25,2.53,3.22,3.79,3.92,4.  ,       &
     &    1.57,1.59,1.6 ,1.6 ,1.6 ,1.61,1.63,1.65,1.69,1.73,1.77,1.8 ,  &
     &    2.  ,2.26,2.57,2.9 ,3.27,3.53,3.65,3.8 ,3.91,3.97,4.  ,       &
     &    3.17,3.17,3.22,3.4 ,3.5 ,3.6 ,3.7 ,3.67,3.58,3.49,3.37,3.23,  &
     &    3.38,3.52,3.62,3.71,3.80,3.88,3.9 ,3.95,3.97,3.99,4.0 ,       &
     &    4.72,5.  ,5.1 ,5.02,4.97,4.84,4.64,4.45,4.24,4.05,3.89,3.70,  &
     &    3.84,3.91,3.97,3.99,4.0 ,4.  ,4.  ,4.  ,3.99,4.  ,4.  ,       &
     &    5.57,5.6 ,5.62,5.61,5.6 ,5.42,5.15,4.91,4.7 ,4.48,4.25,4.08,  &
     &    4.13,4.18,4.16,4.11,4.09,4.05,4.02,4.01,4.  ,4.  ,4.  ,       &
     &    5.73,5.77,5.79,5.79,5.77,5.75,5.6 ,5.33,5.08,4.83,4.59,4.4 ,  &
     &    4.42,4.4 ,4.32,4.23,4.17,4.08,4.05,4.03,4.01,4.  ,4.  ,       &
     &    5.83,5.88,5.91,5.93,5.93,5.91,5.88,5.68,5.4 ,5.14,4.9 ,4.7 ,  &
     &    4.68,4.59,4.46,4.33,4.23,4.13,4.1 ,4.06,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56C
!
      DATA DUMY3                                                        &
     &  /  .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .42,  &
     &     .43, .5 , .6 , .71, .9 ,1.12,1.35,1.97,2.95,3.80,4.  ,       &
     &     .8 , .8 , .8 , .8 , .8 , .8 , .8 , .81, .82, .83, .83, .88,  &
     &     .95,1.06,1.23,1.46,1.83,2.3 ,2.65,3.32,3.76,3.92,4.  ,       &
     &    1.59,1.59,1.59,1.59,1.59,1.6 ,1.62,1.65,1.68,1.72,1.78,1.82,  &
     &    2.  ,2.29,2.65,3.  ,3.27,3.5 ,3.6 ,3.78,3.90,3.98,4.  ,       &
     &    3.14,3.2 ,3.41,3.62,3.68,3.75,3.7 ,3.62,3.51,3.42,3.3 ,3.18,  &
     &    3.34,3.5 ,3.6 ,3.7 ,3.8 ,3.85,3.88,3.93,3.98,4.0 ,4.  ,       &
     &    4.7 ,4.85,5.02,4.98,4.91,4.8 ,4.6 ,4.4 ,4.2 ,4.  ,3.82,3.68,  &
     &    3.8 ,3.9 ,3.98,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    5.4 ,5.44,5.45,5.45,5.42,5.35,5.12,4.9 ,4.69,4.48,4.22,4.02,  &
     &    4.12,4.18,4.17,4.15,4.1 ,4.05,4.04,4.01,4.  ,4.  ,4.  ,       &
     &    5.61,5.63,5.64,5.62,5.61,5.6 ,5.54,5.3 ,5.02,4.8 ,4.6 ,4.39,  &
     &    4.42,4.44,4.38,4.26,4.16,4.1 ,4.07,4.03,4.01,4.  ,4.  ,       &
     &    5.72,5.75,5.76,5.78,5.77,5.76,5.72,5.69,5.4 ,5.15,4.9 ,4.68,  &
     &    4.68,4.6 ,4.49,4.33,4.22,4.15,4.10,4.06,4.02,4.01,4.  /
!
!      FIG 4.1.3.2-56D
!
      DATA DUMY4                                                        &
     &  /  .41, .41, .41, .41, .41, .41, .41, .41, .41, .41, .41, .41,  &
     &     .43, .50, .6 , .71, .89,1.11,1.35,2.00,3.00,3.72,4.00,       &
     &     .82, .82, .81, .8 , .8 , .81, .82, .83, .84, .85, .87, .89,  &
     &     .98,1.1 ,1.3 ,1.5 ,1.82,2.23,2.68,3.3 ,3.7 ,3.91,4.  ,       &
     &    1.6 ,1.59,1.58,1.58,1.58,1.59,1.60,1.62,1.66,1.73,1.81,1.92,  &
     &    2.2 ,2.45,2.7 ,2.98,3.22,3.45,3.59,3.75,3.7 ,3.91,4.  ,       &
     &    3.13,3.18,3.32,3.6 ,3.64,3.72,3.70,3.64,3.54,3.45,3.3 ,3.14,  &
     &    3.32,3.48,3.6 ,3.7 ,3.79,3.87,3.9 ,3.95,3.99,4.  ,4.  ,       &
     &    4.71,4.76,4.8 ,4.83,4.84,4.7 ,4.53,4.34,4.18,4.  ,3.82,3.63,  &
     &    3.78,3.9 ,3.98,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    5.2 ,5.22,5.22,5.2 ,5.2 ,5.15,5.1 ,4.88,4.63,4.42,4.21,4.0 ,  &
     &    4.15,4.21,4.21,4.17,4.14,4.07,4.05,4.03,4.01,4.  ,4.  ,       &
     &    5.45,5.47,5.47,5.45,5.45,5.41,5.36,5.3 ,5.02,4.81,4.58,4.36,  &
     &    4.45,4.47,4.41,4.30,4.19,4.12,4.08,4.02,4.  ,4.  ,4.  ,       &
     &    5.58,5.59,5.59,5.59,5.59,5.58,5.57,5.53,5.41,5.14,4.91,4.65,  &
     &    4.7 ,4.65,4.53,4.4 ,4.27,4.16,4.12,4.05,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56E
!
      DATA DUMY5                                                        &
     & /   .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 ,  &
     &     .44, .52, .63, .78, .98,1.21,1.4 ,2.07,3.07,3.6 ,4.  ,       &
     &     .8 , .8 , .79, .79, .79, .79, .8 , .81, .83, .85, .88, .9 ,  &
     &    1.01,1.17,1.38,1.62,2.00,2.50,2.74,3.22,3.66,3.87,4.  ,       &
     &    1.58,1.59,1.62,1.71,1.76,1.77,1.8 ,1.85,1.88,1.91,1.92,1.93,  &
     &    2.13,2.4 ,2.6 ,2.88,3.12,3.39,3.51,3.71,3.87,3.99,4.  ,       &
     &    3.15,3.21,3.38,3.61,3.7 ,3.67,3.59,3.5 ,3.4 ,3.29,3.17,3.03,  &
     &    3.18,3.37,3.51,3.67,3.78,3.85,3.88,3.93,3.98,4.  ,4.  ,       &
     &    4.42,4.42,4.41,4.40,4.39,4.38,4.35,4.25,4.08,3.9 ,3.72,3.57,  &
     &    3.70,3.86,3.93,3.99,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    4.88,4.85,4.81,4.80,4.79,4.77,4.73,4.68,4.53,4.35,4.15,3.99,  &
     &    4.08,4.20,4.23,4.19,4.1 ,4.07,4.05,4.01,4.  ,4.  ,4.  ,       &
     &    5.08,5.09,5.08,5.08,5.07,5.06,5.03,4.99,4.92,4.74,4.53,4.3 ,  &
     &    4.43,4.48,4.43,4.32,4.20,4.12,4.08,4.03,4.01,4.  ,4.  ,       &
     &    5.19,5.21,5.22,5.23,5.23,5.23,5.23,5.21,5.19,5.09,4.88,4.6 ,  &
     &    4.72,4.69,4.58,4.41,4.28,4.18,4.12,4.07,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56F
!
      DATA DUMY6                                                        &
     & /   .4 , .4 , .4 , .4 , .4 , .41, .44, .49, .51, .54, .59, .61,  &
     &     .69, .75, .81, .9 ,1.01,1.26,1.53,2.1 ,2.9 ,3.42,4.  ,       &
     &     .81, .81, .81, .83, .84, .86, .88, .91, .99,1.02,1.1 ,1.19,  &
     &    1.3 ,1.42,1.58,1.75,2.  ,2.34,2.6 ,3.  ,3.46,3.71,4.   ,      &
     &    1.6 ,1.58,1.59,1.6 ,1.6 ,1.61,1.67,1.7 ,1.79,1.86,1.92,2.  ,  &
     &    2.13,2.32,2.51,2.75,2.97,3.2 ,3.35,3.58,3.8 ,3.9 ,4.  ,       &
     &    3.13,3.1 ,3.08,3.05,3.04,3.03,3.01,2.99,2.95,2.93,2.91,2.89,  &
     &    3.02,3.2 ,3.37,3.52,3.67,3.77,3.82,3.88,3.92,3.97,4.  ,       &
     &    3.79,3.84,3.86,3.8 ,3.79,3.72,3.63,3.58,3.5 ,3.47,3.43,3.41,  &
     &    3.57,3.75,3.89,3.98,4.  ,3.98,3.94,3.93,3.92,3.99,4.  ,       &
     &    4.12,4.2 ,4.19,4.09,4.06,4.03,3.99,3.95,3.92,3.9 ,3.88,3.87,  &
     &    4.01,4.1 ,4.21,4.21,4.12,4.05,4.  ,3.96,3.99,4.  ,4.  ,       &
     &    4.39,4.45,4.44,4.39,4.35,4.31,4.27,4.25,4.25,4.25,4.25,4.25,  &
     &    4.37,4.50,4.49,4.39,4.23,4.1 ,4.03,3.99,4.  ,4.  ,4.  ,       &
     &    4.6 ,4.68,4.65,4.59,4.57,4.54,4.5 ,4.45,4.48,4.53,4.59,4.61,  &
     &    4.71,4.75,4.69,4.5 ,4.31,4.18,4.08,4.01,4.  ,4.  ,4.  /
!
!              FIGURE 4.1.3.3-59A
!
      DATA A13359                                                       &
     & / 0.0, 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, 70.0, 80.0 , 2*0.,    &
     &   .7,.8,.9,1.0,1.1,1.25,1.5,2.0,2.5,3.0,3.25  /
      DATA D13359                                                       &
     & / 0.,3.50,4.95,5.85,6.40,6.83,7.25,7.57,7.85,                    &
     &   0.,3.00,4.19,4.95,5.58,6.04,6.49,6.80,7.00,                    &
     &   0.,2.34,3.40,4.00,4.49,4.91,5.28,5.63,5.92,                    &
     &   0.,1.86,2.78,3.20,3.53,3.90,4.25,4.60,4.85,                    &
     &   0.,1.42,2.20,2.68,3.05,3.34,3.62,3.87,4.06,                    &
     &   0.,1.10,1.62,1.94,2.19,2.40,2.64,2.80,2.95,                    &
     &   0.,0.92,1.35,1.65,1.84,2.00,2.17,2.28,2.35,                    &
     &   0.,0.73,1.10,1.35,1.54,1.67,1.76,1.83,1.85,                    &
     &   0.,0.62,0.94,1.00,1.10,1.12,1.12,1.10,1.09,                    &
     &   0.,0.54,0.72,0.68,0.42,0.0 ,0.0 ,0.0, 0.0 ,                    &
     &   0.,0.45,0.63,0.51,0.23,0.0 ,0.0 , 0.0 ,0.0 /
!
!              FIGURE 4.1.3.3-59B (LEFT SIDE)
!
      DATA BL3359                                                       &
     & / 0.5,0.6,0.7,0.8,1.0,5*0,                                       &
     &   0.6,0.8,1.0,1.2,1.6,2.0,2.4,2.6,2.8,3.0/
      DATA DL3359                                                       &
     & / 2.03,1.95,1.90,1.86,1.78,                                      &
     &   1.94,1.87,1.82,1.77,1.70,                                      &
     &   1.82,1.75,1.69,1.64,1.57,                                      &
     &   1.71,1.63,1.58,1.54,1.46,                                      &
     &   1.51,1.44,1.37,1.32,1.24,                                      &
     &   1.32,1.24,1.16,1.10,0.99,                                      &
     &   0.98,0.89,0.82,0.75,0.65,                                      &
     &   0.58,0.52,0.47,0.42,0.37,                                      &
     &   0.18,0.15,0.12,0.13,0.17,                                      &
     &   0.00,0.00,0.00,0.00,0.00/
!
!              FIGURE 4.1.3.3-59B (RIGHT SIDE)
!
      DATA BR3359                                                       &
     & / 0., .1, .2, .3, .4, .5, .6, .7, .8, .9, 1.0 ,                  &
     &   0.6,0.8,1.0,1.2,1.6,2.0,2.4,2.6,2.8,3.0/
      DATA DR3359                                                       &
     & / 7*1.69,1.7,1.72,1.75,1.77,                                     &
     &   1.69,1.66,1.64,1.62,1.60,1.60,1.61,1.63,1.65,1.67,1.69,        &
     &   1.69,1.64,1.59,1.56,1.52,1.51,1.51,1.51,1.52,1.54,1.57,        &
     &   1.69,1.61,1.55,1.49,1.44,1.41,1.39,1.40,1.41,1.43,1.46,        &
     &   1.69,1.56,1.45,1.36,1.28,1.22,1.18,1.17,1.18,1.20,1.23,        &
     &   1.69,1.52,1.34,1.20,1.08,0.99,0.94,0.91,0.91,0.94,0.98,        &
     &   1.69,1.40,1.14,0.94,0.80,0.70,0.65,0.62,0.61,0.63,0.65,        &
     &   1.69,1.32,1.08,0.89,0.74,0.64,0.54,0.47,0.42,0.38,0.37,        &
     &   1.69,1.32,1.04,0.84,0.67,0.54,0.45,0.34,0.27,0.20,0.17,        &
     &   1.69,1.31,1.02,0.79,0.61,0.46,0.33,0.21,0.12,0.03,0.0/
!
!                FIGURE 4.1.3.3-60A (LEFT SIDE)
!
      DATA TL360A                                                       &
     & /  0, 0.2, 0.4, 0.6, 0.8, 1.0   , 6*0.,                          &
     &   1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.2, 2.26, 2.4, 2.6, 2.8, 3.0 /
      DATA DL360A                                                       &
     & / 1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.60, 1.35, 1.12, 0.94, 0.79, 0.68,                            &
     &   1.48, 1.25, 1.03, 0.85, 0.70, 0.60,                            &
     &   0.84, 0.63, 0.50, 0.42, 0.37, 0.37,                            &
     &   0.34, 0.25, 0.17, 0.13, 0.11, 0.16,                            &
     &   0.0,  0.0,  0.0,  0.0,  0.0,  0.0    /
!
!                FIGURE 4.1.3.3-60A (RIGHT SIDE)
!
      DATA TR360A                                                       &
     & / 0.0, 0.2, 0.220, 0.24, 0.270, 0.3, 0.32, 0.375, 0.4, 0.471,    &
     &   0.6, 0.8, 1.0  ,                                               &
     &   1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.2, 2.26, 2.4, 2.6, 2.8, 3.0 /
      DATA DUMY7                                                        &
     & / 1.68, 1.46, 1.45, 1.40, 1.31, 1.23, 1.16, 1.05, 1.00, 0.88,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.41, 1.40, 1.40, 1.31, 1.23, 1.16, 1.05, 1.00, 0.88,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.37, 1.35, 1.33, 1.31, 1.23, 1.16, 1.05, 1.00, 0.88,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.30, 1.26, 1.24, 1.21, 1.18, 1.16, 1.05, 1.00, 0.88,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.24, 1.20, 1.16, 1.14, 1.11, 1.10, 1.05, 1.00, 0.88,    &
     &                                             0.72, 0.64, 0.68/
      DATA DUMY8/                                                       &
     &   1.68, 1.16, 1.11, 1.10, 1.07, 1.04, 1.02, 0.96, 0.94, 0.88,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.11, 1.07, 1.03, 1.00, 0.97, 0.95, 0.89, 0.87, 0.81,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.10, 1.03, 1.02, 0.98, 0.95, 0.93, 0.87, 0.85, 0.79,    &
     &                                             0.72, 0.64, 0.68,    &
     &   1.68, 1.07, 1.00, 0.98, 0.95, 0.90, 0.87, 0.81, 0.79, 0.72,    &
     &                                             0.63, 0.56, 0.60,    &
     &   1.68, 1.04, 0.98, 0.94, 0.90, 0.86, 0.83, 0.76, 0.74, 0.66,    &
     &                                             0.54, 0.42, 0.37,    &
     &   1.68, 1.03, 0.97, 0.92, 0.86, 0.77, 0.76, 0.69, 0.65, 0.57,    &
     &                                             0.42, 0.25, 0.16,    &
     &   1.68, 1.02, 0.96, 0.90, 0.84, 0.775,0.75, 0.67, 0.63, 0.52,    &
     &                                             0.34, 0.10, 0.0  /
!
!              FIGURE 4.1.3.2-62 LEADING-EDGE-EFFECT FACTORS FOR NORMAL-
!                                FORCE-CURVE SLOPE AT SUPERSONIC SPEEDS
!              FIGURE 4.1.3.2-62 (ROUND LEADING EDGE)
!
      DATA R13252                                                       &
     & / 0., .5, .94, 1., 1.05, 1.5, 2., 2.5, 3., 3.5, 4., 20./
      DATA DRND52                                                       &
     & / 1.043, .97, .893, .89, .894, .987, 1.005, 1.02, 1.025, 1.03,   &
     & 1.034, 1.034 /
!
!              FIGURE 4.1.3.2-62 (SHARP LEADING EDGE)
!
      DATA S13252                                                       &
     & / 0., .5, .94, 1., 1.05, 1.5, 2., 2.5, 3., 3.5, 4., 20./
      DATA DSHP52                                                       &
     & / 1.08, 1.013, .94, .942, .948, 1.005, 1.03, 1.04, 1.048, 1.05,  &
     & 1.055, 1.055 /
!
!              FIGURE 4.1.3.2-63 WING SUPERSONIC NORMAL-FORCE-CURVE
!              SLOPE, TAPER RATIO ZERO
!
      DATA T13253                                                       &
     &  / .0,.2,.4,.6,.8,1.,1.2,1.4,1.6,1.8,2.,2.4,2.8,3.2 ,            &
     &     -1.0, -0.8, -0.6, -0.4, -0.2, 0.0, 0.2, 0.4, 0.6, 0.8 /
      DATA D13253                                                       &
     &  / 1.57 ,1.69 ,1.752,1.78 ,1.774,1.7  ,1.472,1.288,1.15 ,1.034,  &
     &     .938, .795, .69 , .605,                                      &
     &    1.57 ,1.708,1.76 ,1.778,1.727,1.56 ,1.35 ,1.18 ,1.047, .947,  &
     &     .86 , .72 , .617, .543,                                      &
     &    1.57 ,1.708,1.77 ,1.737,1.575,1.418,1.233,1.07 , .94 , .842,  &
     &     .768, .646, .558, .49 ,                                      &
     &    1.57 ,1.708,1.763,1.618,1.442,1.278,1.104, .955, .845, .758,  &
     &     .68 , .57 , .49 , .428,                                      &
     &    1.57 ,1.708,1.548,1.41 ,1.275,1.133, .98 , .84 , .738, .66 ,  &
     &     .594, .495, .425, .37 ,                                      &
     &    1.57 ,1.49 ,1.367,1.245,1.12 , .995, .845, .725, .628, .555,  &
     &     .5  , .423, .363, .312,                                      &
     &    1.254,1.273,1.169,1.062, .958, .848, .7  , .59 , .518, .465,  &
     &     .415, .345, .29 , .253,                                      &
     &     .94 , .943, .948, .875, .788, .695, .55 , .465, .404, .36 ,  &
     &     .325, .268, .227, .196,                                      &
     &     .62 , .623, .63 , .648, .597, .537, .403, .335, .287, .25 ,  &
     &     .22 , .18 , .15 , .13 , .31 , .315, .327, .347, .391, .35 ,  &
     &     .23 , .177, .147, .129, .112, .09 , .073, .062 /
!
!              FIGURE 4.1.3.3-61A
!
      DATA T61A/1.0,1.5,2.0,2.5,3.0,4.0,5.0,6.0,7.0/
      DATA SLOPE/59.375,41.667,33.0,27.778,23.611,16.667,12.5,8.75,6.0/
!
!           ****** FIGURE 4.1.4.2-26(A),(B),(C),(D),(E),(F) ******
!              ****SUPERSONIC****
!
      DATA T422AF                                                       &
     &/0.,.2,.4,.6,.8,1.,                                               &
     &1.,2.,3.,4.,5.,6.,                                                &
     &0.,.2,.25,.33,.5,1./
      DATA DUMYA/                                                       &
     &  .165,   .210,   .250,   .290,   .310,   .345,   .335,   .365,   &
     &  .390,   .415,   .445,   .470,   .500,   .540,   .560,   .560,   &
     &  .560,   .560,   .670,   .670,   .670,   .670,   .670,   .670,   &
     &  .830,   .775,   .775,   .775,   .775,   .775,   .990,   .930,   &
     &  .895,   .895,   .895,   .895,                                   &
     &  .200,   .230,   .280,   .305,   .335,   .360,   .400,   .445,   &
     &  .485,   .500,   .520,   .530,   .600,   .630,   .650,   .660,   &
     &  .665,   .665,   .795,   .800,   .800,   .805,   .810,   .815,   &
     &  .970,   .965,   .955,   .955,   .955,   .955,   1.150,  1.135,  &
     &  1.120,  1.100,  1.100,  1.105,                                  &
     &  .230,   .275,   .300,   .330,   .350,   .370,   .415,   .470,   &
     &  .500,   .530,   .545,   .550,   .630,   .670,   .680,   .685,   &
     &  .690,   .690,   .830,   .835,   .835,   .840,   .845,   .850,   &
     &  1.030,  1.015,  1.005,  1.000,  1.005,  1.010,  1.250,  1.225,  &
     &  1.200,  1.170,  1.165,  1.160/
      DATA DUMYB/                                                       &
     &  .220,   .280,   .315,   .345,   .375,   .390,   .440,   .500,   &
     &  .535,   .560,   .570,   .580,   .670,   .700,   .720,   .725,   &
     &  .740,   .740,   .880,   .885,   .895,   .900,   .900,   .900,   &
     &  1.070,  1.070,  1.075,  1.075,  1.080,  1.080,  1.270,  1.260,  &
     &  1.260,  1.255,  1.255,  1.255,                                  &
     &  .250,   .300,   .330,   .380,   .415,   .445,   .500,   .560,   &
     &  .600,   .620,   .635,   .640,   .750,   .780,   .800,   .820,   &
     &  .820,   .825,   .980,   .990,   1.000,  1.020,  1.020,  1.020,  &
     &  1.190,  1.200,  1.200,  1.210,  1.220,  1.225,  1.380,  1.390,  &
     &  1.400,  1.410,  1.420,  1.420,                                  &
     &  .340,   .380,   .410,   .460,   .500,   .540,   .680,   .700,   &
     &  .730,   .770,   .790,   .840,   .950,   .990,   1.010,  1.050,  &
     &  1.080,  1.120,  1.200,  1.240,  1.290,  1.330,  1.370,  1.420,  &
     &  1.440,  1.500,  1.550,  1.610,  1.670,  1.720,  1.680,  1.760,  &
     &  1.820,  1.890,  1.950,  2.020/
      DATA DUMYC/                                                       &
     &  .415,   .410,   .400,   .385,   .370,   .345,   .500,   .500,   &
     &  .495,   .485,   .480,   .470,   .585,   .580,   .580,   .575,   &
     &  .570,   .560,   .670,   .670,   .670,   .670,   .670,   .670,   &
     &  .750,   .750,   .755,   .760,   .765,   .775,   .830,   .840,   &
     &  .845,   .855,   .870,   .895,                                   &
     &  .460,   .455,   .445,   .420,   .390,   .360,   .575,   .575,   &
     &  .570,   .560,   .545,   .530,   .695,   .695,   .690,   .685,   &
     &  .680,   .665,   .800,   .805,   .805,   .810,   .815,   .815,   &
     &  .920,   .930,   .935,   .945,   .970,   .955,   1.040,  1.045,  &
     &  1.050,  1.075,  1.110,  1.105,                                  &
     &  .475,   .465,   .450,   .430,   .400,   .370,   .600,   .600,   &
     &  .595,   .585,   .575,   .550,   .725,   .730,   .730,   .725,   &
     &  .715,   .690,   .850,   .850,   .855,   .865,   .870,   .850,   &
     &  .970,   .975,   .980,   1.000,  1.020,  1.010,  1.110,  1.110,  &
     &  1.110,  1.130,  1.180,  1.160/
      DATA DUMYD/                                                       &
     &  .500,   .490,   .470,   .450,   .425,   .390,   .640,   .635,   &
     &  .630,   .620,   .600,   .580,   .770,   .775,   .780,   .775,   &
     &  .765,   .740,   .920,   .915,   .920,   .930,   .935,   .900,   &
     &  1.050,  1.055,  1.060,  1.080,  1.105,  1.080,  1.195,  1.200,  &
     &  1.205,  1.225,  1.265,  1.255,                                  &
     &  .550,   .535,   .525,   .500,   .475,   .445,   .720,   .715,   &
     &  .710,   .690,   .670,   .640,   .890,   .890,   .890,   .885,   &
     &  .870,   .825,   1.060,  1.050,  1.050,  1.060,  1.065,  1.020,  &
     &  1.215,  1.215,  1.220,  1.245,  1.270,  1.225,  1.380,  1.380,  &
     &  1.395,  1.420,  1.470,  1.420,                                  &
     &  .760,   .730,   .700,   .650,   .600,   .540,   1.000,  1.000,  &
     &  .970,   .930,   .890,   .840,   1.240,  1.230,  1.230,  1.220,  &
     &  1.190,  1.120,  1.500,  1.480,  1.480,  1.490,  1.470,  1.420,  &
     &  1.750,  1.720,  1.730,  1.760,  1.780,  1.720,  2.000,  1.970,  &
     &  1.980,  2.020,  2.070,  2.020/
!
      SQP3=12.4707672
      CNPRME=.FALSE.
      MACH=FLC(MIDX+2)
      RNFS=FLC(MIDX+42)
      DXH=(HTIN(4)-HTIN(3))*A(62)*COS(SYNA(8)/RAD)
      DETXCG=SYNA(1)-(SYNA(6)+DXH)
      IF(TANLEO.EQ.0.0)TANLEO=.00001
      IF(TANLEI.EQ.0.0)TANLEI=.00001
      BETA=SQRT(MACH**2-1.)
      DO 1000 J=1,NALPHA
         ALPHAJ(J)= (ALSCHD(J)+ALPHAI)/RAD
 1000 END DO
      IF(HTIN(15).NE.WTYPE(1))GO TO 1310
!
!       **STRAIGHT TAPERED SUPERSONIC NORMAL FORCE SLOPE**
!
      BOVERT=BETA/TANLE
      CA=COSLE
      IF( BOVERT.GT.1.0)GO TO 1010
      SUPLE=.FALSE.
      GO TO 1020
 1010 SUPLE=.TRUE.
 1020 CONTINUE
      PITCH=.FALSE.
!
!                   FIGURE 4.1.3.2-60A (CNA/CNA)T FOR SUBSONIC L.E.
!
 1030 DELTYT=DELTAY/CA
      IF(SUPLE)GO TO 1040
      VAB(1)=BOVERT
      VAB(2)=DELTYT
      LGB(1)=9
      LGB(2)=8
      CALL INTERX(2,A1350,VAB,LGB,DA50,CNCNT,9,72,                      &
     &            0,0,0,0,0,2,0,0,Q3250A,3,ROUTID)
      IF(CNCNT.GT.1.)CNCNT=1.
      IF(PITCH)GO TO 1320
      CNNNT=CNCNT
      GO TO 1050
!
!                   FIGURE 4.1.3.2-60B (CNA/CNA)T FOR SUPERSONIC L.E.
!
 1040 CONTINUE
      ARG=DELTAY/(5.85*CA)
      DELTDT=ATAN(ARG)*RAD
      VAB(1)=1./BOVERT
      VAB(2)=DELTDT
      LGB(1)=11
      LGB(2)=8
      CALL INTERX(2,B1350,VAB,LGB,DB50,CNCNT,11,88,                     &
     &            0,0,0,0,0,2,0,0,Q3250B,3,ROUTID)
      IF(CNCNT.GT.1.)CNCNT=1.
      IF(PITCH)GO TO 1320
      CNNNT=CNCNT
 1050 IF(TRATIP.EQ.1.0.AND.SWEPLE.EQ.0.0) GO TO 1060
!
!                   NON-RECTANGULAR WING ANALYSIS
!                   FIGURES 4.1.3.2-56A THROUGH F
!
      VAA(1)=BOVERT
      VAA(2)=AR*TANLE
      VAA(3)=TAPEXP
      LGA(1)=23
      LGA(2)=8
      LGA(3)=6
      CALL INTERX(3,T13246,VAA,LGA,D13246,BCNA,23,1104,                 &
     &            0,2,0,0,0,2,0,0,Q3246A,3,ROUTID)
      IF(SUPLE)GO TO 1080
      CNTHRY=BCNA/TANLE
      GO TO 1090
 1060 CONTINUE
!
!                        RECTANGULAR WING ANALYSIS
!
      IF(AR*BETA.GT.1.0)GO TO 1070
!
!                        FIGURE 4.1.3.2-56G(CNA/A)
!
      VAB(1)=AR*BETA
      LGB(1)=9
      CALL INTERX(1,G13246,VAB,LGB,DG3246,CNAA,9,9,                     &
     & 0,0,0,0,0,0,0,0,Q3246G,3,ROUTID)
      CNTHRY=CNAA*AR
      GO TO 1090
 1070 BCNA= 4.-2.*(1./(AR*BETA))
 1080 CNTHRY=BCNA/BETA
 1090 CNA=CNTHRY*CNCNT
      CNA1=CNA*SRSTAR/SW
      TLE192=TANLE/1.92
      IF(TLE192.LE.1.)GO TO 1100
      ARG=DELTAY/(5.85*COSLE)
      DELTDT=ATAN(ARG)*RAD
!
!                   FIGURE 4.1.3.3-59A (VALUE OF CC)
!
      VAB(1)=DELTDT
      VAB(2)=CNA*TLE192
      LGB(1)=9
      LGB(2)=11
      CALL INTERX(2,A13359,VAB,LGB,D13359,CC,11,99,                     &
     &            0,2,0,0,2,2,0,0,Q3359A,3,ROUTID)
      E=CNA*(TLE192+CC*(TLE192-1.))
      GO TO 1110
 1100 E=CNA
 1110 CONTINUE
      IF(SUPLE)GO TO 1160
!
!     WING LIFT IN THE NONLINEAR ANGLE OF ATTACK RANGE SUBSONIC L.E.
!                         STRAIGHT TAPERED WING
!           COMPUTATION OF LIFT COEFICIENT VS ANGLE OF ATTACK
!
      ARG=E*BOVERT
      DO 1150 J=1,NALPHA
         IF(ALPHAJ(J).NE.0.0)GO TO 1120
         CNAAA(J)=0.0
         GO TO 1140
 1120    ARG1=CNCNT/(BETA*ABS(TAN(ALPHAJ(J))))
         IF(ARG1.GT.1.)GO TO 1130
!
!              FIGURE 4.1.3.3-59B (CN(AA)) RIGHT SIDE
!
         VAB(1)=ARG1
         VAB(2)=ARG
         LGB(1)=11
         LGB(2)=10
         CALL INTERX(2,BR3359,VAB,LGB,DR3359,CNAAA(J),11,110,           &
     &               2,2,0,0,0,0,0,0,Q3359B,3,ROUTID)
         GO TO 1140
 1130    CONTINUE
!
!              FIGURE 4.1.3.3-59B(CN(AA)) LEFT SIDE
!
         VAB(1)=1./ARG1
         VAB(2)=ARG
         LGB(1)=5
         LGB(2)=10
         CALL INTERX(2,BL3359,VAB,LGB,DL3359,CNAAA(J),10,50,            &
     &               2,2,0,0,0,0,0,0,Q3359B,3,ROUTID)
 1140    CONTINUE
         CN(J)=CNA* SIN(2.*ALPHAJ(J))/2.+CNAAA(J)*SIN(ALPHAJ(J))*       &
     &         ABS(SIN(ALPHAJ(J)))
         CN(J)=CN(J)*SRSTAR/SW
 1150 CL(J)=CN(J)*COS(ALPHAJ(J))
      GO TO 1430
!
!     WING LIFT IN THE NONLINEAR ANGLE OF ATTACK RANGE SUPERSONIC L.E.
!                         STRAIGHT TAPERED WING
!
 1160 CONTINUE
!
! ****IF SHOCK IS ATTACHED AT ZERO ANGLE OF ATTACK SET DETACH=FALSE
!
      TRANS=.FALSE.
      RMACH=MACH*SQRT(1.-SINLE **2)
      IF(RMACH.LT.1.)GO TO 1250
      CALL ANGDET(RMACH,DELMAX)
      IF(DELTDT/RAD.GT.DELMAX)GO TO 1250
      DETACH=.FALSE.
!
!         FIND ANGLE OF ATTACH AT WHICH SHOCK WILL START TO DETACH
!
      ANGLE=1.
      ANGMAX=ABS(ALPHAJ(1))
      IF(ANGMAX.LT.ABS(ALPHAJ(NALPHA)))ANGMAX=ABS(ALPHAJ(NALPHA))
 1170 DEG=ANGLE/RAD
      RRMACH=MACH* (1.-(SINLE *COS(DEG))**2)**.5
      IF(RRMACH.LT.1.)GO TO 1180
      CALL ANGDET(RRMACH,DELMAX)
      IF((DELTDT/RAD+TAN(DEG)/COSLE).LT.DELMAX)GO TO 1180
      DETANG=DEG
      GO TO 1200
 1180 ANGLE=ANGLE+1.
      IF(ANGLE.GT.ANGMAX)GO TO 1190
      GO TO 1170
 1190 DETANG=90./RAD
      GO TO 1220
 1200 CONTINUE
!
!              FIGURE 4.1.3.3-60B
!
      BTANA = BETA*TAN(DETANG)
      CALL FIG60B(BETA, BTANA, CNAAST)
!
!              FIGURE 4.1.3.3-61A
!
      VAB(1)=BETA
      LGB(1)=9
      CALL INTERX(1,T61A,VAB,LGB,SLOPE,DELCN,9,9,                       &
     &            0,0,0,0,2,0,0,0,Q3361A,3,ROUTID)
      DETALP=DELCN*CNAAST/RAD
      ALPHAP=DETANG+DETALP
      CNPRME = .TRUE.
      J=1
      ARG2=BETA*ABS(TAN(ALPHAP))
      GO TO 1280
 1210 CNAAAP=CNAAA(J)
      CNPRME=.FALSE.
 1220 J=0
 1230 J=J+1
      IF(ABS(ALPHAJ(J)).LT.DETANG)GO TO 1240
      TRANS=.TRUE.
      RATIO=(ABS(ALPHAJ(J))-DETANG)/(ALPHAP-DETANG)
      ARG2=BETA*ABS(TAN(ALPHAJ(J)))
      IF(ABS(ALPHAJ(J)).LT.ALPHAP)GO TO 1300
      TRANS=.FALSE.
      GO TO 1270
 1240 CONTINUE
!
!              FIGURE 4.1.3.3-60B
!
      BTANA = BETA*ABS(TAN(ALPHAJ(J)))
      CALL FIG60B(BETA, BTANA, CNAAA(J))
      TRANS=.FALSE.
      GO TO 1300
 1250 CONTINUE
      DETACH=.TRUE.
!
!              SUPERSONIC WING LIFT VS ANGLE OF ATTACK WITH DETACHED
!                   SHOCK AT ZERO ANGLE OF ATTACK
!
      J=0
 1260 J=J+1
      ARG2=BETA*ABS(TAN(ALPHAJ(J)))
 1270 IF(ALPHAJ(J).NE.0.0)GO TO 1280
      CNAAA(J)=0.0
      GO TO 1300
 1280 ARG1=CNCNT/ARG2
!
!                   FIGURE 4.1.3.3-60A (CNAAA) RIGHT SIDE
!
      VAB(2)=E
      IF(ARG1.GT.1.) GO TO 1290
      VAB(1)=ARG1
      LGB(1)=13
      LGB(2)=12
      CALL INTERX(2,TR360A,VAB,LGB,DR360A,CNAAA(J),13,156,              &
     &            2,0,0,0,0,0,0,0,Q3360A,3,ROUTID)
      GO TO 1300
 1290 CONTINUE
!
!                   FIGURE 4.1.3.3-60A (CNAAA) LEFT SIDE
!
      VAB(1)=1./ARG1
      LGB(1)=6
      LGB(2)=12
      CALL INTERX(2,TL360A,VAB,LGB,DL360A,CNAAA(J),12,72,               &
     &            0,0,0,0,0,0,0,0,Q3360A,3,ROUTID)
 1300 CONTINUE
      IF(CNPRME) GO TO 1210
      IF(TRANS) CNAAA(J)=CNAAST-RATIO*(CNAAST-CNAAAP)
      CN(J)=CNA*SIN(2.*ALPHAJ(J))/2.0+                                  &
     &   CNAAA(J)*SIN(ALPHAJ(J))*ABS(SIN(ALPHAJ(J)))
      CN(J)=CN(J)* SRSTAR/SW
      CL(J)=CN(J)*COS(ALPHAJ(J))
      IF(J.GE.NALPHA)GO TO 1430
      IF(DETACH)GO TO 1260
      GO TO 1230
!
!    ***SUPERSONIC NORMAL FORCE SLOPE,NON-STRAIGHT TAPERED WINGS***
!                    BASIC WING COMPONENT
!
 1310 CONTINUE
      SPANIN=SPANS-SPANO
      CRBW=CB+SPANIN*(TANLEO-TANTEO)
      SBW=(CRBW+CT)*SPANS
      ARBW=4.*SPANS**2/SBW
      TAPBW=CT/CRBW
      BOVERT=BETA/TANLEO
      SUPLE=.FALSE.
      IF(BOVERT.GT.1.)SUPLE=.TRUE.
!
!                   FIGURE 4.1.3.2-56A-F (CNABW)
!
      VAB(1)=BOVERT
      VAB(2)=ARBW*TANLEO
      VAB(3)=TAPBW
      PITCH=.FALSE.
      I=0
      GLOVE=.FALSE.
      TA=TANLEO
 1320 LGB(1)=23
      LGB(2)=8
      LGB(3)=6
      IF(I.NE.0) VAB(2)=ARP*TA
      CALL INTERX(3,T13246,VAB,LGB,D13246,BCNA,23,1104,                 &
     &            0,2,0,0,0,2,0,0,Q246AF,4,ROUTID)
      CNTHRY=BCNA/TA
      IF(SUPLE)CNTHRY=BCNA/BETA
      IF(PITCH.AND.I.EQ.1)GO TO 1530
      IF(PITCH.AND.I.EQ.2)GO TO 1540
!
!                   LEADING-EDGE-EFFECT PARAMETERS
!              FIGURE 4.1.3.2-62 (CLE)BW
!
      ROUND=.FALSE.
      IF(KSHARP.EQ.UNUSED)ROUND=.TRUE.
      VAB(1)=BOVERT
      LGB(1)=12
!
!              SHARP LEADING EDGE
!
      IF(ROUND)GO TO 1330
      CALL INTERX(1,S13252,VAB,LGB,DSHP52,CLE  ,12,12,                  &
     & 0,0,0,0,0,0,0,0,Q13252,3,ROUTID)
      GO TO 1340
!
!              ROUND LEADING EDGE
!
 1330 CALL INTERX(1,R13252,VAB,LGB,DRND52,CLE  ,12,12,                  &
     &            0,0,0,0,0,0,0,0,Q13252,3,ROUTID)
 1340 IF(GLOVE)GO TO 1370
      CNTBW=CNTHRY
      CLEBW=CLE
      IF(TANLEO.GE.TANLEI)GO TO 1350
      CNABW=CNTBW*SBW/SW *CLEBW
      GO TO 1360
 1350 CONTINUE
      S2=SPANIN**2*TANLEO
      A2=4.*SPANIN**2/S2
      VAB(2)=A2*TANLEO
      VAB(3)=0.0
      CALL INTERX(3,T13246,VAB,LGB,D13246,BCNA,23,1104,                 &
     &            0,2,0,0,0,2,0,0,Q246AF,4,ROUTID)
      CNT2=BCNA/BETA
      IF(VAB(1).GT.1.)CNT2  =BCNA/TANLEO
      CNABW=(CNTHRY*SBW/SW-CNT2  *  S2/SW )*CLEBW
 1360 CONTINUE
!
!                        GLOVE COMPONENT
!
      IF(ABS(SWEPLE-SWEPLO).LT.4.)GO TO 1380
      CRGLV=TANLEI*SPANIN
      SGLV=CRGLV*SPANIN
      ARGLV=4.*SPANIN**2/SGLV
      VAB(1)=BETA/TANLEI
      VAB(2)=ARGLV*TANLEI
      VAB(3)=0.0
      GLOVE=.TRUE.
      BOVERT=VAB(1)
      SUPLE=.FALSE.
      TA=TANLEI
      IF(BOVERT.GT.1.)SUPLE=.TRUE.
      GO TO 1320
 1370 CONTINUE
      CLEGLV=CLE
      CNAGLV=CNTHRY*CLEGLV*SGLV/SW
!
!              FIGURE 4.1.3.2-63 (CN1=CNA/A)
!
      GO TO 1390
 1380 CNAGLV=0.0
!
!                        EXTENSION COMPONENT
!
 1390 IF(ABS(SWTEI-SWTEO).LT.4.)GO TO 1400
      BE= 2.*SPANIN
      VAB(1)=BETA/TANLEI
      VAB(2)=TANTEI/TANLEI
      LGB(1)=14
      LGB(2)=10
      CALL INTERX(2,T13253,VAB,LGB,D13253,CN1,14,140,                   &
     &            2,2,0,0,2,2,0,0,Q13253,3,ROUTID)
      VAB(2)=TANTEO/TANLEI
      CALL INTERX(2,T13253,VAB,LGB,D13253,CN2,14,140,                   &
     &            2,2,0,0,2,2,0,0,Q13253,3,ROUTID)
      CNAE=(CN1-CN2)*BE**2/SW
      GO TO 1410
 1400 CNAE=0.0
!
! **SUPERSONIC NORMAL FORCE SLOPE,NON-STRAIGHT TAPERED WINGS,TOTAL WING
!
 1410 CONTINUE
!
!              FIGURE 4.1.3.2-61
!
      VAB(1)=CNAGLV/(CLEGLV*BETA)*SW/A(4)
      LGB(1)= 12
      CALL INTERX(1,T13251,VAB,LGB,D13251,RKL,12,12,                    &
     &            2,0,0,0,2,0,0,0,Q13251,3,ROUTID)
      CNA1=RKL*(CNABW+CNAGLV+CNAE)
      DO 1420 J=1,NALPHA
         IF(ALPHAJ(J).GT.0.175)GO TO 1420
         CN(J)=CNA1*SIN(2.*ALPHAJ(J))/2.
         CL(J)=CN(J)*COS(ALPHAJ(J))
 1420 END DO
 1430 CONTINUE
!
!      ***PITCHING MOMENT SLOPES AT LOW ANGLE OF ATTACK,STRAIGHT TAPERED
!
      DXW=(SPAN-SPANS)*TANLEI*COS(ALPHAI/RAD)
      DETXCG=XCG-(XH+DXW)
      IF(HTIN(15).NE.WTYPE(1))GO TO 1510
!
!              FIGURE 4.1.4.2-26A-F (XAC/CRSTAR)
!
      TA=TANLE
      ARP=ARSTAR
      TAPR=TAPEXP
      PITCH=.FALSE.
      VAB(2)=ARP*TA
      VAB(3)=TAPR
 1440 LGB(1)=6
      LGB(2)=6
      LGB(3)=6
      IF(BOVERT.GT.1.)GO TO 1450
      VAB(1)=BOVERT
      CALL INTERX(3,T422AF,VAB,LGB,SUBAF,XACCR,6,216,                   &
     &            0,2,0,0,0,2,0,0,Q222AF,4,ROUTID)
      GO TO 1460
 1450 VAB(1)=1./BOVERT
      CALL INTERX(3,T422AF,VAB,LGB,SUPAF,XACCR,6,216,                   &
     &            0,2,0,0,0,2,0,0,Q222AF,4,ROUTID)
 1460 CONTINUE
      IF(BOVERT.GE.0.) GO TO 1455
      VAB(1)=1./BOVERT
      CALL FWDXAC(VAB(2),VAB(3),VAB(1),MACH,ROUTID,XACCR)
 1455 CONTINUE
      IF(SWEPLE .LT. 1.E-10 .AND. HTIN(MIDX+71) .NE. UNUSED)            &
     &          XACCR = HTIN(MIDX+71)*A(122)/CRSTAR
      IF(PITCH)GO TO 1470
      GO TO 1490
 1470 IF(I.EQ.1)XACCRI=XACCR
      IF(I.EQ.2)GO TO 1480
      GO TO 1030
 1480 ARG1=XACCR*CBP/CRSTAR
      ARG2=BSTARB/(CRSTAR*2.)*TANLEO
      ARG3=BSTARB*TANLEI/CRSTAR
      XACCRO=ARG1-ARG2+ARG3
      GO TO 1030
 1490 DCMCL=(DETXCG/CRSTAR-XACCR)*CRSTAR/CBARR
      CMA=DCMCL*CNA1
      DO 1500 J=1,NALPHA
         IF(ALPHAJ(J).GT.0.175)GO TO 1500
         CM(J)=CMA*ALPHAJ(J)
 1500 END DO
      GO TO 1550
!
!   ***SUPERSONIC WING PITCHING MOMENT SLOPE,NON-STRAIGHT TAPERED WINGS*
!
 1510 CONTINUE
      ARP=ARIP
      I=1
      CA=COSLE
      TA=TANLE
      TAPR=TAPIP
 1520 BOVERT=BETA/TA
      VAB(1)=BOVERT
      VAB(2)=ARP*TA
      VAB(3)=TAPR
      SUPLE=.FALSE.
      IF(BOVERT.GT.1.)SUPLE=.TRUE.
      PITCH=.TRUE.
      GO TO 1440
 1530 CNCNTI=CNCNT
      CNATI=CNTHRY
      CNAI=CNCNTI*CNATI
      CA=COSLEO
      TA=TANLEO
      TAPR=TAPOP
      I=2
      ARP=AROP
      GO TO 1520
 1540 CNCNTO=CNCNT
      CNATO=CNTHRY
      CNAO=CNCNTO*CNATO
      ARG1=CNAI*SI*XACCRI + CNAO*SO*XACCRO
      ARG2=CNAI*SI+CNAO*SO
      XACCR=ARG1/ARG2
      GO TO 1490
 1550 CONTINUE
!
!  ***WING SUPERSONIC ZERO-LIFT SKIN FRICTION DRAG,STRAIGHT TAPERED WING
!
      IF(HTIN(15).NE.WTYPE(1))GO TO 1580
      CBAR=CBARI
 1560 RNN=CBAR*RNFS
      IF(RUFF.EQ.0.0)GO TO 1570
      ARG=12.*CBAR/RUFF
!
!                   FIGURE 4.1.5.1-27 (EQUATION FOR RLCOFF)
!
      RACH = MACH
      IF(RACH.GT.3.0)RACH=3.0
      CALL TBFUNX(RACH,CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,             &
     &            0,0,Q15127,3,ROUTID)
      RLCOFF=ARG**1.0482*10.0**CEPT
      IF(RLCOFF.LT.RNN)RNN=RLCOFF
 1570 CALL FIG26(RNN,RACH,CF)
      IF(HTIN(15).NE.WTYPE(1))GO TO 1590
      CDF=CF*SRSTAR/SR*2.
      GO TO 1610
!
!  ***WING SUPERSONIC ZERO-LIFT SKIN FRICTION DRAG,NON-STRAIGHT WING***
!
 1580 CONTINUE
      CBAR=CBARI
      GO TO 1560
 1590 CONTINUE
      IF(CBAR.EQ.CBARO)GO TO 1600
      RNI=RNN
      CFI=CF
      CBAR=CBARO
      GO TO 1560
 1600 RNO=RNN
      CFO=CF
      CDF=(CFI*SISTAR+CFO*SOSTAR)/SR*2.
 1610 CONTINUE
!
!   ***SUPERSONIC WING ZERO-LIFT WAVE DRAG,SHARP L.E.,ALL PLANFORMS***
!
      IF(HTIN(15).EQ.WTYPE(1))GO TO 1620
      TA=TANLEO
      S=SBW
      CA=COSLEO
      LERBW=LERO*((CR+CT+2.*CB)/4.)
      GO TO 1630
 1620 TA=TANLEI
      S=SRSTAR
      CA =COSLE
      LERBW=LERI*((CR+CT)/2.)
 1630 CONTINUE
      BOVERT=BETA/TA
      IF(KSHARP.EQ.UNUSED)GO TO 1640
      ARG=KSHARP*TCEFF**2*S  /SR
      CDW=ARG/BETA
      IF(BOVERT.LT.1.)CDW=ARG/TA
      GO TO 1650
 1640 CONTINUE
!
!  ***SUPERSONIC WING ZERO-LIFT WAVE DRAG,ROUND L.E.,ALL PLANFORMS***
!
      ARG1=1.28*MACH**3*CA    **6/(1.+MACH**3*CA    **3)
      ARG2=2*LERBW*(2.*SPANS)/(SR*CA)
      CDLE=ARG1*ARG2
      ARG=     16.*TCEFF**2*S  /(3.*SR)
      IF(BOVERT.GE.1.)CDW=CDLE+ARG/BETA
      IF(BOVERT.LT.1.)CDW=CDLE+ARG/TA
 1650 CONTINUE
      CDO=CDF+CDW
!
!   ***SUPERSONIC INDUCED DRAG,STRAIGHT TAPERED PLANFORM***
!
      IF(HTIN(15).NE.WTYPE(1))GO TO 1670
      RLW=CT+SIGMA*CRSTAR
      P=SRSTAR/(RLW*2.*SPANS)
      ARG=(1.+P)/(PI*ARSTAR*P)
      ARG1=BETA*SPANS/RLW
!
!                   FIGURE 4.1.5.2-58 (PI*A*(CDL/CL**2)*(P/(1+P)))
!
      VAB(1)=ARG1
      LGB(1)=5
      IF(KSHARP.EQ.UNUSED) GO TO 1660
      CALL INTERX(1,T15258,VAB,LGB,DS5258,DRAGC,5,5,                    &
     & 0,0,0,0,1,0,0,0,Q15258,3,ROUTID)
      GO TO 1670
 1660 CALL INTERX(1,T15258,VAB,LGB,DR5258,DRAGC,5,5,                    &
     & 0,0,0,0,1,0,0,0,Q15258,3,ROUTID)
 1670 CONTINUE
!
!  ***SUPERSONIC WING DRAG,CN AND CA VS ANGLE OF ATTACK***
!
      DO 1680 J=1,NALPHA
         CDL(J)=DRAGC*ARG*SW/SRSTAR*CL(J)**2
         CD(J)=CDO + CDL(J)
         COSA=COS(FLC(J+22)/RAD)
         SINA=SIN(FLC(J+22)/RAD)
         CN(J)=CL(J)*COSA+CD(J)*SINA
         CAF(J)=CD(J)*COSA-CL(J)*SINA
 1680 END DO
      CMADEG=CMA/RAD
      CLADEG=CNA1/RAD
      IF(TANLEO.EQ.0.00001)TANLEO=0.0
      IF(TANLEI.EQ.0.00001)TANLEI=0.0
      RETURN
      END
      SUBROUTINE SUPPAH
!
!     THIS ROUTINE YIELDS THE SUPERSONIC WING PITCHING DERIVATIVE,CLQ
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /HTDATA/ A(195)
      COMMON /HTI/    WINGIN(154)
      COMMON /IHT/    PW, WING(380)
      COMMON /BDATA/  XBD(300),DYN(213)
      COMMON /SUPWH/  XSLG(141),SLG(141)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      INTEGER Y71118,Y7A119,Y11110,D11110,D21110,D31110,D41110,D51110,  &
     & D61110,Y11111,D11111,D21111,D31111,D41111,D51111,D61111,D71111,  &
     & D81111,D91111,D10111
      REAL MACOE
      REAL MACH,LSTAR,LAMDA
      DIMENSION ROUTID(2)
      DIMENSION WTYPE(4)
      DIMENSION Q71118(3),Q11110(3),Q11111(3)
      DIMENSION I2A119(4),I2B119(4)
      DIMENSION X21118(12),X11118(2),Y71118(12)
      DIMENSION X2A119(15),XA1119(1),Y7A119( 8)
      DIMENSION X2B119(17),Y7B119(17)
      DIMENSION X21110(37),X11110(8),X31110(3),Y11110(444)
      DIMENSION D11110(74),D21110(74),D31110( 74),D41110( 74)
      DIMENSION D51110(74),D61110(74)
      DIMENSION X21111(24),X11111(9),X31111(5),Y11111( 540)
      DIMENSION D11111(60),D21111(48),D31111(60),D41111(48)
      DIMENSION D51111(60),D61111(48),D71111(60),D81111(48),D91111(60)
      DIMENSION D10111(48)
      EQUIVALENCE (D11110(1),Y11110(1)),(D21110(1),Y11110( 75))
      EQUIVALENCE (D31110(1),Y11110(149)),(D41110(1),Y11110(223))
      EQUIVALENCE (D51110(1),Y11110(297)),(D61110(1),Y11110(371))
      EQUIVALENCE (D11111(1),Y11111(1)),(D21111(1),Y11111( 61))
      EQUIVALENCE (D31111(1),Y11111(109)),(D41111(1),Y11111(169))
      EQUIVALENCE (D51111(1),Y11111(217)), (D61111(1),Y11111(277))
      EQUIVALENCE (D71111(1),Y11111(325)),(D81111(1),Y11111(385))
      EQUIVALENCE (D91111(1),Y11111(433)),(D10111(1),Y11111(493))
      EQUIVALENCE (MACOE,A(16)),(LSTAR,A(29)),(CNA1,SLG(7))
      EQUIVALENCE (XACCR,SLG(134)),(CRSTR,A(10))
      EQUIVALENCE (ASTRW,A(7)),(LAMDA ,A(27)),(BETA,SLG(1))
      EQUIVALENCE (DCMDCL,SLG(135))
      EQUIVALENCE (TANLE,A(62)),(SW,A(3)),(BCLQ,DYN(15))
      EQUIVALENCE (EPPBC,DYN(9)),(GBC,DYN(10)),(CLQPWH,DYN(11))
      EQUIVALENCE (F3N,DYN(12)),(F4N,DYN(13)),(XACCRB,DYN(14))
      EQUIVALENCE (CLQWH,WING(201))
      DATA Q71118 /4H7.1.,4H1.1-,4H8   /
      DATA Q11110 /4H7.1.,4H1.1-,4H10  /
      DATA Q11111 /4H7.1.,4H1.1-,4H11  /
      DATA I2A119 /15,3*0/,I2B119/17,3*0/
      DATA X11118 /1.,2./
      DATA X21118                                                       &
     &  / 0., .05, .1, .2, .3, .4, .5, .6, .7, .8, .9, 1.0 /
!
!                   FIGURE  7.1.1.1-9    F3(N)
!
      DATA X2A119                                                       &
     & / -1.0, -.8, -.6, -.4, -.2, 0., .2, .3, .4, .5, .6, .7, .8, .85 ,&
     &     1./
!
!                   FIGURE 7.1.1.1-9   F4(N)
!
      DATA X2B119                                                       &
     & / -1.0, -.8, -.6, -.4, -.2, 0., .2, .3, .4, .5, .6, .7, .8, .85, &
     &     .9, .95, 1.0 /
      DATA Y7B119                                                       &
     & / 1.69,1.55,1.42,1.285,1.14,1.0, .845, .77, .69, .61, .53, .44,  &
     &    .35, .29, .23, .14 ,0.  /
!
!              FIGURE 7.1.1.1-10A,B,C   (TAPER RATIO = .25, .5, .75)
!
      DATA X21110                                                       &
     & / .0  , .237, .270, .30 , .308, .388, .4  , .426, .46 , .473,    &
     &   .483, .522, .555, .567, .6  , .612, .622, .638, .65 , .674,    &
     &   .69 , .716, .73 , .75 , .76 , .77 , .779, .793, .81 , .82 ,    &
     &   .846, .854, .88 , .9  , .917, .942,1.0   /
      DATA X11110/1.,2.,3.,4.,5.,6.,8.,10./
      DATA X31110/.25,.5,.75/
!
! FIGURE 7.1.1.1-11A,B,C,D,E,F,G,H,I,J,K (TAPER RATIO=0,.25,.5,.75,1.)
!
      DATA X21111                                                       &
     & / 0.  , 2.  , 4.  , 6.  , 8.  ,10.  ,12.  ,14.  ,16.  ,18.  ,    &
     &  20.  ,22.  ,24.  ,26.  ,28.  ,30.  ,32.  ,34.  ,36.  ,38.  ,    &
     &  40.  ,42.  ,44.  ,45.    /
      DATA X11111/1.,2.,3.,4.,5.,6.,8.,12.,20./
      DATA X31111                                                       &
     & / 0.  ,  .25,  .5 ,  .75, 1.   /
!
!        IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
!        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
!
!        THE FORMAT IS AS FOLLOWS-
!
!        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
!
!        WHERE-
!
!        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
!        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
!        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
!             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
!        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
!        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
!        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
!        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
!
      DATA Y71118/  123100996,  133986956,  133921880,  133835792,      &
     &  133748704,  133668630,  123100989,  133964880,  133798726,      &
     &  133660600,  133544500,  133459422/
      DATA Y7A119 /133660700 , 133750830 , 132920102 , 122119134 ,      &
     & 122152183 , 122230320 , 122525730 , 310140000/
      DATA D11110/  202000430,  122460480,  122475460,  122460455,      &
     &  122440440,  122435435,  122420415,  122410400,  122400400,      &
     &  122400400,  122400400,  122400400,  122400400,  122400400,      &
     &  122400400,  122400400,  122400400,  122400400,  320400000,      &
     &  122430490,  122550565,  122735720,  122740760,  122750740,      &
     &  122720700,  122695680,  122680675,  122670660,  122650650,      &
     &  122640640,  122630630,  122627625,  122620615,  122610605,      &
     &  122605600,  122600600,  122590580,  202000430,  122490550,      &
     &  122565735,  122740800,  122890920,  122960990,  111101100,      &
     &  122970960,  122955940,  122930920,  122905890,  122880870,      &
     &  122870865,  122860855,  122845840,  122830820,  122810807,      &
     &  122800795,  320770000,  122430490,  122550565,  122735740,      &
     &  122800890,  122920960,  111108121,  111123125,  111126126,      &
     &  111124122,  111119118,  111115114,  111112111,  111111110,      &
     &  111108108,  111107105,  111104103,  111102100,  122998970/
      DATA D21110/  202000430,  122490550,  122565735,  122740800,      &
     &  122890920,  121960108,  111121127,  111141148,  111148148,      &
     &  111149150,  111148144,  111144140,  111140138,  111138137,      &
     &  111135135,  111133130,  111128125,  111134122,  310117000,      &
     &  122430490,  122550565,  122735740,  122800890,  122920960,      &
     &  111108121,  111127141,  111148153,  111162171,  111173174,      &
     &  111176173,  111170168,  111167166,  111163160,  111159156,      &
     &  111155152,  111149148,  111145139,  202000430,  122490550,      &
     &  122565735,  122740800,  122890920,  121960108,  111121127,      &
     &  111141148,  111153162,  111171187,  111200226,  111227228,      &
     &  111229229,  111228224,  111220218,  111214212,  111207203,      &
     &  111200196,  310186000,  122430490,  122550565,  122735740,      &
     &  122800890,  122920960,  111108121,  111127141,  111148153,      &
     &  111162171,  111187200,  111226239,  111268284,  111284286,      &
     &  111288288,  111284276,  111273267,  111261257,  111252240/
      DATA D31110/  202000360,  122400420,  122430480,  122490490,      &
     &  122485480,  122475450,  122450440,  122420430,  122420410,      &
     &  122400400,  122400400,  122400400,  122400400,  122400400,      &
     &  122400400,  122400400,  122400400,  122400400,  320400000,      &
     &  122360400,  122450460,  122580600,  122660670,  122670680,      &
     &  122700710,  122715720,  122720710,  122700700,  122690680,      &
     &  122670660,  122650655,  122650645,  122635640,  122635620,      &
     &  122620610,  122605600,  122600600,  202000360,  122400450,      &
     &  122460580,  122600660,  122730775,  122790925,  122940945,      &
     &  122955960,  122963970,  122968970,  122968960,  122955940,      &
     &  122935930,  122925920,  122905900,  122890885,  122870860,      &
     &  122850840,  320815000,  122360400,  122450460,  122580600,      &
     &  122660730,  122775790,  121925103,  111108120,  111119120,      &
     &  111120121,  111121122,  111121121,  111121120,  111120119,      &
     &  111118117,  111116114,  111114112,  111110109,  111106103/
      DATA D41110/  202000360,  122400450,  122460580,  122600660,      &
     &  122730775,  122790925,  111103108,  111120125,  111130138,      &
     &  111145146,  111147148,  111148149,  111149149,  111149149,      &
     &  111147145,  111142141,  111138136,  111134131,  310128000,      &
     &  122360400,  122450460,  122580600,  122660730,  122775790,      &
     &  121925103,  111108120,  111125130,  111138145,  111160174,      &
     &  111174175,  111177177,  111177178,  111178178,  111177173,      &
     &  111173169,  111166164,  111160152,  202000360,  122400450,      &
     &  122460580,  122600660,  122730775,  122790925,  111103108,      &
     &  111120126,  111130138,  111145160,  111180194,  111210234,      &
     &  111230235,  111236236,  111236237,  111237237,  111232228,      &
     &  111225219,  310206000,  122360400,  122450460,  122580600,      &
     &  122660730,  122775790,  121925103,  111108120,  111125130,      &
     &  111138145,  111160180,  111194210,  111234250,  111262276,      &
     &  111299299,  111300300,  111300301,  111296292,  111284269/
      DATA D51110/  202000300,  122320360,  122360390,  122390405,      &
     &  122410418,  122420425,  122430430,  122440440,  122443445,      &
     &  122445445,  122450450,  122445443,  122440440,  122441440,      &
     &  122440439,  122438438,  122435432,  122430420,  320410000,      &
     &  122300320,  122360360,  122460470,  122510590,  122592597,      &
     &  122605620,  122625640,  122642645,  122650650,  122655660,      &
     &  122660658,  122660657,  122655650,  122653640,  122638630,      &
     &  122635620,  122615610,  122605600,  202000300,  122320360,      &
     &  122360460,  122470510,  122590610,  122640720,  122825865,      &
     &  122865867,  122870870,  122878880,  122880882,  122885890,      &
     &  122890890,  122885890,  122885885,  122880880,  122870855,      &
     &  122845835,  320800000,  122300320,  122360360,  122460470,      &
     &  122510590,  122610640,  122720825,  122865980,  111102106,      &
     &  111113113,  111113114,  111114115,  111115115,  111115115,      &
     &  111115115,  111115115,  111115114,  111113111,  111109105/
      DATA D61110/  202000300,  122320360,  122360460,  122470510,      &
     &  122590610,  122640720,  122825865,  121980102,  111106113,      &
     &  111119132,  111140140,  111140141,  111142142,  111142142,      &
     &  111141141,  111141141,  111140140,  111139136,  310131000,      &
     &  122300320,  122360360,  122460470,  122510590,  122610640,      &
     &  122720825,  122865980,  111102107,  111113119,  111132140,      &
     &  111159170,  111170170,  111170171,  111170171,  111171171,      &
     &  111170170,  111170169,  111166160,  202000300,  122320360,      &
     &  122360460,  122470510,  122590610,  122640720,  122825865,      &
     &  121980102,  111106113,  111119132,  111140159,  111170190,      &
     &  111205216,  111230230,  111231231,  111232232,  111233232,      &
     &  111231230,  310219000,  122300320,  122360360,  122460470,      &
     &  122510590,  122610640,  122720825,  122865980,  111102106,      &
     &  111113119,  111132140,  111159170,  111190205,  111216230,      &
     &  111249283,  111300300,  111300300,  111300300,  111299285/
      DATA D11111/  204000680,  133142190,  133240295,  133355410,      &
     &  133455500,  133540590,  133630670,  133720760,  133800850,      &
     &  133900940,  122100105,  122109112,  204000640,  133130180,      &
     &  133220270,  133320370,  133405440,  133470500,  133540570,      &
     &  133600620,  133650675,  133700720,  133755770,  133785800,      &
     &  204000600,  133118170,  133207250,  133295320,  133355380,      &
     &  133408416,  133450465,  133480490,  133500500,  133490475,      &
     &  133455425,  133390360,  204000560,  133106151,  133190222,      &
     &  133251277,  133300320,  133333342,  133348350,  133347342,      &
     &  133333319,  133296259,  133205132,  144450200,  204000520,      &
     &  143950133,  133166193,  133216236,  133252263,  133271273,      &
     &  133269260,  133245224,  133196155,  134102350,-1143750190,      &
     &-1133375420/
      DATA D21111/  204000440,  143840117,  133147169,  133186201,      &
     &  133209215,  133214204,  133189169,  133141105,  340540000,      &
     &-1143900215,-1133370565,-1133820980,  204000380,  144710940,      &
     &  133113130,  133138144,  133140130,  134113900,  144600240,      &
     &-1143350110,-1133190310,-1133480690,-1132970136,-1122188219,      &
     &  204000380,  144710940,  133113130,  133135140,  340500000,      &
     &-1144300800,-1133180270,-1133380500,-1133650850,-1122119170,      &
     &-1122227310,-1122480530,  204000380,  144710940,  133113130,      &
     &  133135140,-1133500100,-1133180290,-1133420590,-1132750100,      &
     &-1122125165,-1122220303,-1122420630,-1111104140/
      DATA D31111/  143530140,  133230320,  133360410,  133470520,      &
     &  133570630,  133690740,  133810880,  132940102,  122110118,      &
     &  122128138,  122152164,  122181188,  143460120,  133190280,      &
     &  133320360,  133400440,  133480510,  133530550,  133565590,      &
     &  133615640,  133670700,  133740790,  133850915,  132980103,      &
     &  143400105,  133160205,  133244276,  133300330,  133345355,      &
     &  133360360,  133365360,  133360350,  133340335,  133320315,      &
     &  133310320,  133320335,  144300890,  133127156,  133180200,      &
     &  133208222,  133228230,  133223210,  133190180,  133150120,      &
     &  340600000,-1143600120,-1133190250,-1133330370,  144270690,      &
     &  133100120,  133139150,  133159160,  133158147,  133130107,      &
     &  134100500, 1204000700,-1133150240,-1133360480,-1133590710,      &
     &-1133850920/
      DATA D41111/  144240580,  143880101,  133112120,  133120116,      &
     &  134109870,  144560150,-1144350700,-1133150240,-1133370520,      &
     &-1133730960,-1122119141,-1122163173,  144200440,  144600740,      &
     &  144800800,  144710500, 1144251000,-1143490107,-1133180240,      &
     &-1133360510,-1133690940,-1122125166,-1122216268,-1122328355,      &
     &  144100290,  144380400,  144330200, 1204000300,-1143720127,      &
     &-1133190275,-1133400590,-1133740900,-1122123160,-1122210295,      &
     &-1122402540,-1122720810,  144100180,  144190110,-1154500280,      &
     &-1143640110,-1133171250,-1133338465,-1133640800,-1122103138,      &
     &-1122184245,-1122380480,-1121680100,-1111164198/
      DATA D51111/  133360410,  133470530,  133600650,  133710780,      &
     &  133850910,  132970104,  122112119,  122127135,  122143155,      &
     &  122169187,  122210239,  122277297,  133290330,  133380420,      &
     &  133460490,  133530550,  133580610,  133630660,  133680710,      &
     &  133740770,  133820870,  133920980,  122105115,  122129136,      &
     &  133240273,  133295317,  133325335,  133340347,  133355350,      &
     &  133340335,  133325322,  133322340,  133350363,  133383408,      &
     &  133432462,  133492510,  133180198,  133210220,  133223227,      &
     &  133221219,  133201195,  133170138,  134100520, 1204000550,      &
     &-1133110145,-1133170185,-1133190192,-1133185183,  133121133,      &
     &  133148155,  133158155,  133150135,  134113850,  340450000,      &
     &-1143600135,-1133220325,-1133450570,-1133675760,-1133840905,      &
     &-1132970100/
      DATA D61111/  143930106,  133117150,  133140130,  134110800,      &
     &  144500200,-1144300900,-1133160250,-1133370500,-1133670850,      &
     &-1122106126,-1122145163,-1122180188,  144630820,  144900910,      &
     &  144860720,  144450100,-1144300900,-1133150230,-1133330450,      &
     &-1133630840,-1122102144,-1122180224,-1122273320,-1122372400,      &
     &  144470560,  144550460,  340260000,-1144280500,-1133100150,      &
     &-1133250430,-1133580730,-1122100128,-1122160210,-1122280380,      &
     &-1122535700,-1121920105,  144200250,  145220900,-1144150480,      &
     &-1133100150,-1133250350,-1133480630,-1132800100,-1122128163,      &
     &-1122215290,-1122400580,-1121860130,-1111190228/
      DATA D71111/  133780800,  133815830,  133860890,  133925960,      &
     &  122100105,  122115119,  122128137,  122148162,  122175191,      &
     &  122209227,  122247270,  122294307,  133550550,  133550550,      &
     &  133560570,  133580590,  133605625,  133640670,  133700730,      &
     &  133770835,  133905980,  122109120,  122133146,  122161169,      &
     &  133380380,  133385395,  133400402,  133402398,  133389382,      &
     &  133370365,  133373385,  133400428,  133452484,  133515544,      &
     &  133578585,  133590598,  133265270,  133273273,  133270263,      &
     &  133250235,  133213187,  133152108,  145580800,-1144500970,      &
     &-1133135235,-1133187208,-1133220290,-1133300300,  133200208,      &
     &  133209208,  133202189,  133170141,  134109620, 1144100620,      &
     &-1133142230,-1133370490,-1133570613,-1133680740,-1133785920,      &
     &-1133950980/
      DATA D81111/  133160118,  133165160,  133150135,  134110800,      &
     & 1144330250,-1143950180,-1133178390,-1133540720,-1132930115,      &
     &-1122135152,-1122163180,-1122190200,  133113115,  133118112,      &
     &  144980730, 1145371000,-1143700145,-1133233340,-1133470625,      &
     &-1132850115,-1122148185,-1122225268,-1122308350,-1122392420,      &
     &  144700720,  144680580,  145400900,-1144600830,-1133150235,      &
     &-1133390485,-1133665880,-1122118153,-1122200270,-1122370497,      &
     &-1122630770,-1122910990,  144450430,  144320200,-1154800450,      &
     &-1143900150,-1133240350,-1133490650,-1132850113,-1122145192,      &
     &-1122250335,-1122460662,-1121940136,-1111205245/
      DATA D91111/  122104105,  122106107,  122108109,  122111113,      &
     &  122116119,  122123129,  122134141,  122150160,  122171185,      &
     &  122200217,  122235254,  122276287,  133665663,  133665671,      &
     &  133682693,  133709728,  133748768,  133790820,  133890875,      &
     &  133900932,  133950980,  122100100,  122104108,  122113111,      &
     &  133445443,  133440432,  133426419,  133408398,  133383377,      &
     &  133370365,  133365368,  133372382,  133390391,  133392392,      &
     &  133392392,  133392392,  133328328,  133330310,  133298278,      &
     &  133258228,  133192150,  134108600, 1144150300,-1143790130,      &
     &-1133162230,-1133250330,-1133380390,-1133400400,  133260260,      &
     &  133250235,  133220200,  133165125,  144720150,-1143550135,      &
     &-1133220325,-1133438560,-1133680800,-1132880100,-1122108118,      &
     &-1122125130/
      DATA D10111/  133220215,  133208198,  133170140,  134100550,      &
     & 1204000700,-1133155250,-1133370510,-1133678872,-1122108135,      &
     &-1122155177,-1122200212,-1122229240,  133168160,  133152132,      &
     &  134105750, 1144270250,-1133100180,-1133280400,-1133555738,      &
     &-1132955124,-1122159202,-1122249302,-1122360413,-1122472500,      &
     &  133112105,  144920700,  145450800,-1143450108,-1133192290,      &
     &-1133410563,-1133750975,-1122126166,-1122221293,-1122390508,      &
     &-1122648802,-1122983107,  144620590,  144450250,-1154800500,      &
     &-1133108180,-1133270382,-1133515682,-1132898116,-1122155198,      &
     &-1122260355,-1122500770,-1111120176,-1111232264/
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA ROUTID/4HSUPP,4HAW  /
!
      TYPE=WINGIN(15)
      IF(TANLE.EQ.0.)TANLE=.00001
      IF(TRANSN)BETA=SQRT(1.2**2-1.)
      COTLE=1./TANLE
      BCOTLE=BETA*COTLE
      XACCRB=XACCR*CRSTR/CBARR
      SAVE=MACOE*SW/(CBARR*SR)
      BA=BETA*ASTRW
      QLAMDA=10.
      IF(BCOTLE.GT.1.)GO TO 1060
 1000 IF(LAMDA .NE.0.)GO TO 1010
!
!    ---- SUPERSONIC WING PITCHING DERIVATIVE,CLQ ----
!
      DUMM=1.
!
!           -- FIGURE 7.1.1.1-8 --
!
      CALL TLIP2X(X11118,X21118,Y71118,2,12,DUMM,BCOTLE,EPPBC,          &
     &            0,0,0,2,Q71118,3,ROUTID)
      DUMM=2.
      CALL TLIP2X(X11118,X21118,Y71118,2,12,DUMM,BCOTLE,GBC,            &
     &            0,0,0,2,Q71118,3,ROUTID)
      IF(TYPE.NE.WTYPE(1))RETURN
      EN=1.-4.*COTLE/ASTRW
!
!           -- FIGURE 7.1.1.1-9 --
!
      CALL TLIP1X(X2A119,Y7A119,15,EN,F3N,1,1,Q2A119,3,ROUTID)
      CALL INTERX(1,X2B119,EN,I2B119,Y7B119,F4N,17,17,1,0,0,0,1,0,0,0,  &
     &            Q2B119,3,ROUTID)
      F4N=F4N/(1.-EN)
      F3N=F3N*(1.-EN)
      DEE=.66667*LSTAR
      CLQPWH=.027414*ASTRW*(3.*GBC*F3N-2.*EPPBC*F4N)*SAVE+2.*(DEE-XACCR*&
     &       CRSTR)*CNA1/(CBARR*RAD)
      IF(QLAMDA.LT.5.)GO TO 1040
      GO TO 1070
 1010 IF(LAMDA.LT.0.25)GO TO 1030
 1020 CONTINUE
!
!           -- FIGURE 7.1.1.1-10A,B,C --
!
      CALL TLIP3X(X11110,X21110,X31110,Y11110,8,37,3,BA,BCOTLE,LAMDA,   &
     &   BCLQ,1,0,0,2,0,0,Q11110,3,ROUTID)
      CLQPP=BCLQ/BETA
      CLQPWH=(CLQPP*SAVE-2.*XACCRB*CNA1)/RAD
      IF(QLAMDA.LT.0.25)GO TO 1050
      GO TO 1070
 1030 QLAMDA=LAMDA
      LAMDA=0.
      GO TO 1000
 1040 CLQPW1=CLQPWH
      LAMDA=.25
      GO TO 1020
 1050 CLQPWH=((CLQPWH-CLQPW1)/.25)*QLAMDA+CLQPW1
      LAMDA=QLAMDA
      GO TO 1070
 1060 CONTINUE
!
!           -- FIGURE 7.1.1.1-11A,B,C,D,E,F,G,H,I,J,K, --
!
      CALL TLIP3X(X11111,X21111,X31111,Y11111,9,24,5,BA,BCOTLE,LAMDA,   &
     &            BCLQPP,1,0,0,2,1,0,Q11111,3,ROUTID)
      CLQPWH=BCLQPP*SAVE/(BETA*RAD)
 1070 CONTINUE
      IF(TRANSN)RETURN
      CLQWH=CLQPWH-2.*DCMDCL*CNA1/RAD
      IF(TANLE.EQ..00001)TANLE=0.
      RETURN
      END
      SUBROUTINE SUPPAW
!
!***  THIS ROUTINE YIELDS THE SUPERSONIC WING PITCHING DERIVATIVE,CLQ
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /WINGD/  A(195)
      COMMON /WINGI/  WINGIN(77)
      COMMON /IWING/  PW, WING(400)
      COMMON /POWR/   DYN(213)
      COMMON /SUPWH/  SLG(141)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      INTEGER Y71118,Y7A119,Y11110,D11110,D21110,D31110,D41110,D51110,  &
     & D61110,Y11111,D11111,D21111,D31111,D41111,D51111,D61111,D71111,  &
     & D81111,D91111,D10111
      REAL MACOE
      REAL MACH,LSTAR,LAMDA
      DIMENSION ROUTID(2)
      DIMENSION WTYPE(4)
      DIMENSION Q71118(3),Q11110(3),Q11111(3)
      DIMENSION I2A119(4),I2B119(4)
      DIMENSION X21118(12),X11118(2),Y71118(12)
      DIMENSION X2A119(15),XA1119(1),Y7A119( 8)
      DIMENSION X2B119(17),Y7B119(17)
      DIMENSION X21110(37),X11110(8),X31110(3),Y11110(444)
      DIMENSION D11110( 74),D21110( 74),D31110( 74),D41110( 74)
      DIMENSION D51110(74),D61110( 74)
      DIMENSION X21111(24),X11111(9),X31111(5),Y11111( 540)
      DIMENSION D11111(60),D21111( 48),D31111( 60),D41111(48)
      DIMENSION D51111(60),D61111(48),D71111( 60),D81111(48),D91111(60)
      DIMENSION D10111(48)
      EQUIVALENCE (D11110(1),Y11110(1)),(D21110(1),Y11110( 75))
      EQUIVALENCE (D31110(1),Y11110(149)),(D41110(1),Y11110(223))
      EQUIVALENCE (D51110(1),Y11110(297)),(D61110(1),Y11110(371))
      EQUIVALENCE (D11111(1),Y11111(1)),(D21111(1),Y11111( 61))
      EQUIVALENCE (D31111(1),Y11111(109)),(D41111(1),Y11111(169))
      EQUIVALENCE (D51111(1),Y11111(217)) 
      EQUIVALENCE (D61111(1),Y11111(277)),(D71111(1),Y11111(325))
      EQUIVALENCE (D81111(1),Y11111(385)),(D91111(1),Y11111(433))
      EQUIVALENCE (D10111(1),Y11111(493))
      EQUIVALENCE (MACOE,A(16)),(LSTAR,A(29)),(CNA1,SLG(7))
      EQUIVALENCE (XACCR,SLG(134)),(CRSTR,A(10))
      EQUIVALENCE (ASTRW,A(7)),(LAMDA ,A(27)),(BETA,SLG(1))
      EQUIVALENCE (DCMDCL,SLG(135))
      EQUIVALENCE (TANLE,A(62)),(SW,A(3)),(BCLQ,DYN(15))
      EQUIVALENCE (EPPBC,DYN(9)),(GBC,DYN(10)),(CLQPWH,DYN(11))
      EQUIVALENCE (F3N,DYN(12)),(F4N,DYN(13)),(XACCRB,DYN(14))
      EQUIVALENCE (CLQWH,WING(201))
      DATA Q71118 /4H7.1.,4H1.1-,4H8   /
      DATA Q11110 /4H7.1.,4H1.1-,4H10  /
      DATA Q11111 /4H7.1.,4H1.1-,4H11  /
      DATA I2A119 /15,3*0/, I2B119 /17,3*0/
      DATA X11118 /1.,2./
      DATA X21118                                                       &
     &  / 0., .05, .1, .2, .3, .4, .5, .6, .7, .8, .9, 1.0 /
!
!                   FIGURE  7.1.1.1-9    F3(N)
!
      DATA X2A119                                                       &
     & / -1.0, -.8, -.6, -.4, -.2, 0., .2, .3, .4, .5, .6, .7, .8, .85 ,&
     &     1./
!
!                   FIGURE 7.1.1.1-9   F4(N)
!
      DATA X2B119                                                       &
     & / -1.0, -.8, -.6, -.4, -.2, 0., .2, .3, .4, .5, .6, .7, .8, .85, &
     &     .9, .95, 1.0 /
      DATA Y7B119                                                       &
     & / 1.69,1.55,1.42,1.285,1.14,1.0, .845, .77, .69, .61, .53, .44,  &
     &    .35, .29, .23, .14 ,0.  /
!
!              FIGURE 7.1.1.1-10A,B,C   (TAPER RATIO = .25, .5, .75)
!
      DATA X21110                                                       &
     & / .0  , .237, .270, .30 , .308, .388, .4  , .426, .46 , .473,    &
     &   .483, .522, .555, .567, .6  , .612, .622, .638, .65 , .674,    &
     &   .69 , .716, .73 , .75 , .76 , .77 , .779, .793, .81 , .82 ,    &
     &   .846, .854, .88 , .9  , .917, .942,1.0   /
      DATA X11110/1.,2.,3.,4.,5.,6.,8.,10./
      DATA X31110/.25,.5,.75/
!
! FIGURE 7.1.1.1-11A,B,C,D,E,F,G,H,I,J,K (TAPER RATIO=0,.25,.5,.75,1.)
!
      DATA X21111                                                       &
     & / 0.  , 2.  , 4.  , 6.  , 8.  ,10.  ,12.  ,14.  ,16.  ,18.  ,    &
     &  20.  ,22.  ,24.  ,26.  ,28.  ,30.  ,32.  ,34.  ,36.  ,38.  ,    &
     &  40.  ,42.  ,44.  ,45.    /
      DATA X11111/1.,2.,3.,4.,5.,6.,8.,12.,20./
      DATA X31111                                                       &
     & / 0.  ,  .25,  .5 ,  .75, 1.   /
!
!        IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
!        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
!
!        THE FORMAT IS AS FOLLOWS-
!
!        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
!
!        WHERE-
!
!        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
!        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
!        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
!             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
!        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
!        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
!        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
!        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
!
      DATA Y71118/  123100996,  133986956,  133921880,  133835792,      &
     &  133748704,  133668630,  123100989,  133964880,  133798726,      &
     &  133660600,  133544500,  133459422/
      DATA Y7A119 /133660700 , 133750830 , 132920102 , 122119134 ,      &
     & 122152183 , 122230320 , 122525730 , 310140000/
      DATA D11110/  202000430,  122460480,  122475460,  122460455,      &
     &  122440440,  122435435,  122420415,  122410400,  122400400,      &
     &  122400400,  122400400,  122400400,  122400400,  122400400,      &
     &  122400400,  122400400,  122400400,  122400400,  320400000,      &
     &  122430490,  122550565,  122735720,  122740760,  122750740,      &
     &  122720700,  122695680,  122680675,  122670660,  122650650,      &
     &  122640640,  122630630,  122627625,  122620615,  122610605,      &
     &  122605600,  122600600,  122590580,  202000430,  122490550,      &
     &  122565735,  122740800,  122890920,  122960990,  111101100,      &
     &  122970960,  122955940,  122930920,  122905890,  122880870,      &
     &  122870865,  122860855,  122845840,  122830820,  122810807,      &
     &  122800795,  320770000,  122430490,  122550565,  122735740,      &
     &  122800890,  122920960,  111108121,  111123125,  111126126,      &
     &  111124122,  111119118,  111115114,  111112111,  111111110,      &
     &  111108108,  111107105,  111104103,  111102100,  122998970/
      DATA D21110/  202000430,  122490550,  122565735,  122740800,      &
     &  122890920,  121960108,  111121127,  111141148,  111148148,      &
     &  111149150,  111148144,  111144140,  111140138,  111138137,      &
     &  111135135,  111133130,  111128125,  111134122,  310117000,      &
     &  122430490,  122550565,  122735740,  122800890,  122920960,      &
     &  111108121,  111127141,  111148153,  111162171,  111173174,      &
     &  111176173,  111170168,  111167166,  111163160,  111159156,      &
     &  111155152,  111149148,  111145139,  202000430,  122490550,      &
     &  122565735,  122740800,  122890920,  121960108,  111121127,      &
     &  111141148,  111153162,  111171187,  111200226,  111227228,      &
     &  111229229,  111228224,  111220218,  111214212,  111207203,      &
     &  111200196,  310186000,  122430490,  122550565,  122735740,      &
     &  122800890,  122920960,  111108121,  111127141,  111148153,      &
     &  111162171,  111187200,  111226239,  111268284,  111284286,      &
     &  111288288,  111284276,  111273267,  111261257,  111252240/
      DATA D31110/  202000360,  122400420,  122430480,  122490490,      &
     &  122485480,  122475450,  122450440,  122420430,  122420410,      &
     &  122400400,  122400400,  122400400,  122400400,  122400400,      &
     &  122400400,  122400400,  122400400,  122400400,  320400000,      &
     &  122360400,  122450460,  122580600,  122660670,  122670680,      &
     &  122700710,  122715720,  122720710,  122700700,  122690680,      &
     &  122670660,  122650655,  122650645,  122635640,  122635620,      &
     &  122620610,  122605600,  122600600,  202000360,  122400450,      &
     &  122460580,  122600660,  122730775,  122790925,  122940945,      &
     &  122955960,  122963970,  122968970,  122968960,  122955940,      &
     &  122935930,  122925920,  122905900,  122890885,  122870860,      &
     &  122850840,  320815000,  122360400,  122450460,  122580600,      &
     &  122660730,  122775790,  121925103,  111108120,  111119120,      &
     &  111120121,  111121122,  111121121,  111121120,  111120119,      &
     &  111118117,  111116114,  111114112,  111110109,  111106103/
      DATA D41110/  202000360,  122400450,  122460580,  122600660,      &
     &  122730775,  122790925,  111103108,  111120125,  111130138,      &
     &  111145146,  111147148,  111148149,  111149149,  111149149,      &
     &  111147145,  111142141,  111138136,  111134131,  310128000,      &
     &  122360400,  122450460,  122580600,  122660730,  122775790,      &
     &  121925103,  111108120,  111125130,  111138145,  111160174,      &
     &  111174175,  111177177,  111177178,  111178178,  111177173,      &
     &  111173169,  111166164,  111160152,  202000360,  122400450,      &
     &  122460580,  122600660,  122730775,  122790925,  111103108,      &
     &  111120126,  111130138,  111145160,  111180194,  111210234,      &
     &  111230235,  111236236,  111236237,  111237237,  111232228,      &
     &  111225219,  310206000,  122360400,  122450460,  122580600,      &
     &  122660730,  122775790,  121925103,  111108120,  111125130,      &
     &  111138145,  111160180,  111194210,  111234250,  111262276,      &
     &  111299299,  111300300,  111300301,  111296292,  111284269/
      DATA D51110/  202000300,  122320360,  122360390,  122390405,      &
     &  122410418,  122420425,  122430430,  122440440,  122443445,      &
     &  122445445,  122450450,  122445443,  122440440,  122441440,      &
     &  122440439,  122438438,  122435432,  122430420,  320410000,      &
     &  122300320,  122360360,  122460470,  122510590,  122592597,      &
     &  122605620,  122625640,  122642645,  122650650,  122655660,      &
     &  122660658,  122660657,  122655650,  122653640,  122638630,      &
     &  122635620,  122615610,  122605600,  202000300,  122320360,      &
     &  122360460,  122470510,  122590610,  122640720,  122825865,      &
     &  122865867,  122870870,  122878880,  122880882,  122885890,      &
     &  122890890,  122885890,  122885885,  122880880,  122870855,      &
     &  122845835,  320800000,  122300320,  122360360,  122460470,      &
     &  122510590,  122610640,  122720825,  122865980,  111102106,      &
     &  111113113,  111113114,  111114115,  111115115,  111115115,      &
     &  111115115,  111115115,  111115114,  111113111,  111109105/
      DATA D61110/  202000300,  122320360,  122360460,  122470510,      &
     &  122590610,  122640720,  122825865,  121980102,  111106113,      &
     &  111119132,  111140140,  111140141,  111142142,  111142142,      &
     &  111141141,  111141141,  111140140,  111139136,  310131000,      &
     &  122300320,  122360360,  122460470,  122510590,  122610640,      &
     &  122720825,  122865980,  111102107,  111113119,  111132140,      &
     &  111159170,  111170170,  111170171,  111170171,  111171171,      &
     &  111170170,  111170169,  111166160,  202000300,  122320360,      &
     &  122360460,  122470510,  122590610,  122640720,  122825865,      &
     &  121980102,  111106113,  111119132,  111140159,  111170190,      &
     &  111205216,  111230230,  111231231,  111232232,  111233232,      &
     &  111231230,  310219000,  122300320,  122360360,  122460470,      &
     &  122510590,  122610640,  122720825,  122865980,  111102106,      &
     &  111113119,  111132140,  111159170,  111190205,  111216230,      &
     &  111249283,  111300300,  111300300,  111300300,  111299285/
      DATA D11111/  204000680,  133142190,  133240295,  133355410,      &
     &  133455500,  133540590,  133630670,  133720760,  133800850,      &
     &  133900940,  122100105,  122109112,  204000640,  133130180,      &
     &  133220270,  133320370,  133405440,  133470500,  133540570,      &
     &  133600620,  133650675,  133700720,  133755770,  133785800,      &
     &  204000600,  133118170,  133207250,  133295320,  133355380,      &
     &  133408416,  133450465,  133480490,  133500500,  133490475,      &
     &  133455425,  133390360,  204000560,  133106151,  133190222,      &
     &  133251277,  133300320,  133333342,  133348350,  133347342,      &
     &  133333319,  133296259,  133205132,  144450200,  204000520,      &
     &  143950133,  133166193,  133216236,  133252263,  133271273,      &
     &  133269260,  133245224,  133196155,  134102350,-1143750190,      &
     &-1133375420/
      DATA D21111/  204000440,  143840117,  133147169,  133186201,      &
     &  133209215,  133214204,  133189169,  133141105,  340540000,      &
     &-1143900215,-1133370565,-1133820980,  204000380,  144710940,      &
     &  133113130,  133138144,  133140130,  134113900,  144600240,      &
     &-1143350110,-1133190310,-1133480690,-1132970136,-1122188219,      &
     &  204000380,  144710940,  133113130,  133135140,  340500000,      &
     &-1144300800,-1133180270,-1133380500,-1133650850,-1122119170,      &
     &-1122227310,-1122480530,  204000380,  144710940,  133113130,      &
     &  133135140,-1133500100,-1133180290,-1133420590,-1132750100,      &
     &-1122125165,-1122220303,-1122420630,-1111104140/
      DATA D31111/  143530140,  133230320,  133360410,  133470520,      &
     &  133570630,  133690740,  133810880,  132940102,  122110118,      &
     &  122128138,  122152164,  122181188,  143460120,  133190280,      &
     &  133320360,  133400440,  133480510,  133530550,  133565590,      &
     &  133615640,  133670700,  133740790,  133850915,  132980103,      &
     &  143400105,  133160205,  133244276,  133300330,  133345355,      &
     &  133360360,  133365360,  133360350,  133340335,  133320315,      &
     &  133310320,  133320335,  144300890,  133127156,  133180200,      &
     &  133208222,  133228230,  133223210,  133190180,  133150120,      &
     &  340600000,-1143600120,-1133190250,-1133330370,  144270690,      &
     &  133100120,  133139150,  133159160,  133158147,  133130107,      &
     &  134100500, 1204000700,-1133150240,-1133360480,-1133590710,      &
     &-1133850920/
      DATA D41111/  144240580,  143880101,  133112120,  133120116,      &
     &  134109870,  144560150,-1144350700,-1133150240,-1133370520,      &
     &-1133730960,-1122119141,-1122163173,  144200440,  144600740,      &
     &  144800800,  144710500, 1144251000,-1143490107,-1133180240,      &
     &-1133360510,-1133690940,-1122125166,-1122216268,-1122328355,      &
     &  144100290,  144380400,  144330200, 1204000300,-1143720127,      &
     &-1133190275,-1133400590,-1133740900,-1122123160,-1122210295,      &
     &-1122402540,-1122720810,  144100180,  144190110,-1154500280,      &
     &-1143640110,-1133171250,-1133338465,-1133640800,-1122103138,      &
     &-1122184245,-1122380480,-1121680100,-1111164198/
      DATA D51111/  133360410,  133470530,  133600650,  133710780,      &
     &  133850910,  132970104,  122112119,  122127135,  122143155,      &
     &  122169187,  122210239,  122277297,  133290330,  133380420,      &
     &  133460490,  133530550,  133580610,  133630660,  133680710,      &
     &  133740770,  133820870,  133920980,  122105115,  122129136,      &
     &  133240273,  133295317,  133325335,  133340347,  133355350,      &
     &  133340335,  133325322,  133322340,  133350363,  133383408,      &
     &  133432462,  133492510,  133180198,  133210220,  133223227,      &
     &  133221219,  133201195,  133170138,  134100520, 1204000550,      &
     &-1133110145,-1133170185,-1133190192,-1133185183,  133121133,      &
     &  133148155,  133158155,  133150135,  134113850,  340450000,      &
     &-1143600135,-1133220325,-1133450570,-1133675760,-1133840905,      &
     &-1132970100/
      DATA D61111/  143930106,  133117150,  133140130,  134110800,      &
     &  144500200,-1144300900,-1133160250,-1133370500,-1133670850,      &
     &-1122106126,-1122145163,-1122180188,  144630820,  144900910,      &
     &  144860720,  144450100,-1144300900,-1133150230,-1133330450,      &
     &-1133630840,-1122102144,-1122180224,-1122273320,-1122372400,      &
     &  144470560,  144550460,  340260000,-1144280500,-1133100150,      &
     &-1133250430,-1133580730,-1122100128,-1122160210,-1122280380,      &
     &-1122535700,-1121920105,  144200250,  145220900,-1144150480,      &
     &-1133100150,-1133250350,-1133480630,-1132800100,-1122128163,      &
     &-1122215290,-1122400580,-1121860130,-1111190228/
      DATA D71111/  133780800,  133815830,  133860890,  133925960,      &
     &  122100105,  122115119,  122128137,  122148162,  122175191,      &
     &  122209227,  122247270,  122294307,  133550550,  133550550,      &
     &  133560570,  133580590,  133605625,  133640670,  133700730,      &
     &  133770835,  133905980,  122109120,  122133146,  122161169,      &
     &  133380380,  133385395,  133400402,  133402398,  133389382,      &
     &  133370365,  133373385,  133400428,  133452484,  133515544,      &
     &  133578585,  133590598,  133265270,  133273273,  133270263,      &
     &  133250235,  133213187,  133152108,  145580800,-1144500970,      &
     &-1133135235,-1133187208,-1133220290,-1133300300,  133200208,      &
     &  133209208,  133202189,  133170141,  134109620, 1144100620,      &
     &-1133142230,-1133370490,-1133570613,-1133680740,-1133785920,      &
     &-1133950980/
      DATA D81111/  133160118,  133165160,  133150135,  134110800,      &
     & 1144330250,-1143950180,-1133178390,-1133540720,-1132930115,      &
     &-1122135152,-1122163180,-1122190200,  133113115,  133118112,      &
     &  144980730, 1145371000,-1143700145,-1133233340,-1133470625,      &
     &-1132850115,-1122148185,-1122225268,-1122308350,-1122392420,      &
     &  144700720,  144680580,  145400900,-1144600830,-1133150235,      &
     &-1133390485,-1133665880,-1122118153,-1122200270,-1122370497,      &
     &-1122630770,-1122910990,  144450430,  144320200,-1154800450,      &
     &-1143900150,-1133240350,-1133490650,-1132850113,-1122145192,      &
     &-1122250335,-1122460662,-1121940136,-1111205245/
      DATA D91111/  122104105,  122106107,  122108109,  122111113,      &
     &  122116119,  122123129,  122134141,  122150160,  122171185,      &
     &  122200217,  122235254,  122276287,  133665663,  133665671,      &
     &  133682693,  133709728,  133748768,  133790820,  133890875,      &
     &  133900932,  133950980,  122100100,  122104108,  122113111,      &
     &  133445443,  133440432,  133426419,  133408398,  133383377,      &
     &  133370365,  133365368,  133372382,  133390391,  133392392,      &
     &  133392392,  133392392,  133328328,  133330310,  133298278,      &
     &  133258228,  133192150,  134108600, 1144150300,-1143790130,      &
     &-1133162230,-1133250330,-1133380390,-1133400400,  133260260,      &
     &  133250235,  133220200,  133165125,  144720150,-1143550135,      &
     &-1133220325,-1133438560,-1133680800,-1132880100,-1122108118,      &
     &-1122125130/
      DATA D10111/  133220215,  133208198,  133170140,  134100550,      &
     & 1204000700,-1133155250,-1133370510,-1133678872,-1122108135,      &
     &-1122155177,-1122200212,-1122229240,  133168160,  133152132,      &
     &  134105750, 1144270250,-1133100180,-1133280400,-1133555738,      &
     &-1132955124,-1122159202,-1122249302,-1122360413,-1122472500,      &
     &  133112105,  144920700,  145450800,-1143450108,-1133192290,      &
     &-1133410563,-1133750975,-1122126166,-1122221293,-1122390508,      &
     &-1122648802,-1122983107,  144620590,  144450250,-1154800500,      &
     &-1133108180,-1133270382,-1133515682,-1132898116,-1122155198,      &
     &-1122260355,-1122500770,-1111120176,-1111232264/
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA ROUTID/4HSUPP,4HAW  /
!
      TYPE=WINGIN(15)
      IF(TANLE.EQ.0.)TANLE=.00001
      IF(TRANSN) BETA=SQRT(1.2**2-1.)
      COTLE=1./TANLE
      BCOTLE=BETA*COTLE
      XACCRB=XACCR*CRSTR/CBARR
      SAVE=MACOE*SW/(CBARR*SR)
      BA=BETA*ASTRW
      QLAMDA=10.
      IF(BCOTLE.GT.1.)GO TO 1060
 1000 IF(LAMDA .NE.0.)GO TO 1010
!
!    ---- SUPERSONIC WING PITCHING DERIVATIVE,CLQ ----
!
      DUMM=1.
!
!           -- FIGURE 7.1.1.1-8 --
!
      CALL TLIP2X(X11118,X21118,Y71118,2,12,DUMM,BCOTLE,EPPBC,          &
     &            0,0,0,2,Q71118,3,ROUTID)
      DUMM=2.
      CALL TLIP2X(X11118,X21118,Y71118,2,12,DUMM,BCOTLE,GBC,            &
     &            0,0,0,2,Q71118,3,ROUTID)
      IF(TYPE.NE.WTYPE(1))RETURN
      EN=1.-4.*COTLE/ASTRW
!
!           -- FIGURE 7.1.1.1-9 --
!
      CALL TLIP1X(X2A119,Y7A119,15,EN,F3N,1,1,Q2A119,3,ROUTID)
      CALL INTERX(1,X2B119,EN,I2B119,Y7B119,F4N,17,17,1,0,0,0,1,0,0,0,  &
     &            Q2B119,3,ROUTID)
      F4N=F4N/(1.-EN)
      F3N=F3N*(1.-EN)
      DEE=.66667*LSTAR
      CLQPWH=.027414*ASTRW*(3.*GBC*F3N-2.*EPPBC*F4N)*SAVE+              &
     &   2.*(DEE-XACCR*CRSTR)*CNA1/(CBARR*RAD)
      IF(QLAMDA.LT.5.)GO TO 1040
      GO TO 1070
 1010 IF(LAMDA.LT.0.25)GO TO 1030
 1020 CONTINUE
!
!           -- FIGURE 7.1.1.1-10A,B,C --
!
      CALL TLIP3X(X11110,X21110,X31110,Y11110,8,37,3,BA,BCOTLE,LAMDA,   &
     &   BCLQ,1,0,0,2,0,0,Q11110,3,ROUTID)
      CLQPP=BCLQ/BETA
      CLQPWH=(CLQPP*SAVE-2.*XACCRB*CNA1)/RAD
      IF(QLAMDA.LT.0.25)GO TO 1050
      GO TO 1070
 1030 QLAMDA=LAMDA
      LAMDA=0.
      GO TO 1000
 1040 CLQPW1=CLQPWH
      LAMDA=.25
      GO TO 1020
 1050 CLQPWH=((CLQPWH-CLQPW1)/.25)*QLAMDA+CLQPW1
      LAMDA=QLAMDA
      GO TO 1070
 1060 CONTINUE
!
!           -- FIGURE 7.1.1.1-11A,B,C,D,E,F,G,H,I,J,K, --
!
      CALL TLIP3X(X11111,X21111,X31111,Y11111,9,24,5,BA,BCOTLE,LAMDA,   &
     &            BCLQPP,1,0,0,2,1,0,Q11111,3,ROUTID)
      CLQPWH=BCLQPP*SAVE/(BETA*RAD)
 1070 CONTINUE
      IF(TRANSN)RETURN
      CLQWH=CLQPWH-2.*DCMDCL*CNA1/RAD
      IF(TANLE.EQ..00001)TANLE=0.
      RETURN
      END
      SUBROUTINE SUPRYW
!
!     THIS ROUTINE YIELDS THE SUPERSONIC WING,WING-BODY
!     ROLLING DERIVATIVES,CLP AND CNP,AND
!     YAWING DERIVATIVE , CYP
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /WINGD/  A(195)
      COMMON /WINGI/  WINGIN(77)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /POWR/   DYN(213)
      COMMON /SUPWH/  SLG(141)
      COMMON /IBW/    PBW,BW(380)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /IWING/  PWING, WING(400)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      INTEGER Y2225A,Y2225B,Y2225C,Y2225D,Y2225E,Y2110A,Y2110C,Y2110B,  &
     & Y2314A,Y2314B,Y2314C,Y2314D,Y2317A,Y2317B,Y2317C,Y2317D
      REAL MACH,LAMLE,LAMDA
      DIMENSION ALSCHD(20),CYPWBH(20),CNPWBH(20),CYPWSP(20)
      DIMENSION ROUTID(2)
      DIMENSION X1225A(  7),X2225A( 17),Y2225A(  60),Q2225A(3)
      DIMENSION X1225B(  7),X2225B( 13),Y2225B(  46),Q2225B(3)
      DIMENSION X1225C(  7),X2225C( 13),Y2225C(  46),Q2225C(3)
      DIMENSION X1225D(  7),X2225D( 14),Y2225D(  49),Q2225D(3)
      DIMENSION X1225E(  7),X2225E( 17),Y2225E(  60),Q2225E(3)
      DIMENSION X1110A( 14),X2110A(  9),Y2110A(  63),Q2110A(3)
      DIMENSION X1110C(  5),X2110C(  5),Y2110C(  13),Q2110C(3)
      DIMENSION X1110B(  7),X2110B( 19),Y2110B(  67),Q2110B(3)
      DIMENSION X1314A( 10),X2314A( 14),Y2314A(  70),Q2314A(3)
      DIMENSION X1314B( 10),X2314B( 14),Y2314B(  70),Q2314B(3)
      DIMENSION X1314C( 10),X2314C( 13),Y2314C(  65),Q2314C(3)
      DIMENSION X1314D( 10),X2314D( 13),Y2314D(  65),Q2314D(3)
      DIMENSION X12316(  9),Y12316(  9),Q12316(3)
      DIMENSION X13170(  2),X23170(  4),Y23170(2)
      DIMENSION X1317A(  5),X2317A( 15),Y2317A(  38),Q2317A(3)
      DIMENSION X1317B(  5),X2317B( 13),Y2317B(  33),Q2317B(3)
      DIMENSION X1317C(  5),X2317C( 15),Y2317C(  38),Q2317C(3)
      DIMENSION X1317D(  5),X2317D( 14),Y2317D(  35),Q2317D(3)
      EQUIVALENCE(CNACNA,SLG(3)),(TANCO2,A(74)),(LAMLE,A(58)),(SW,A(4)) &
     &          ,(XCG,SYNA(1)),(SSPNE,WINGIN(3)),(SSPN,WINGIN(4)),      &
     &(AW,A(120)),(LAMDA,A(118)),(BETA,SLG(1)),(ALSCHD(1),FLC(23)),     &
     &(TANLE,A(62))
      EQUIVALENCE(CLPWBH,WING(281)),(TRENS,DYN(204)),(CHENGE,DYN(205)), &
     &          (CYPA,DYN(206)),(CYPWSP(1),WING(301)),(CNPTAS,DYN(207)),&
     &           (CNPA1,DYN(208)),(CNPA2,DYN(209)),(CNPA3,DYN(210)),    &
     &         (CNPA,DYN(211)),(CNPAE,DYN(212)),(CNPWBH(1),WING(321)),  &
     &           (CNPBA,DYN(213)),(XW,SYNA(1)),(CR,WINGIN(6))
      DATA ROUTID/4HSUPR,4HYW  /
!
!      ----FIGURE 7.1.2.2-25A
!
      DATA Q2225A/4H7.1.,4H2.2-,4H25A /
      DATA X1225A/  .000E+00,  .100E+01,  .200E+01,  .300E+01,          &
     &  .400E+01,  .500E+01,  .600E+01/
      DATA X2225A/ -.699E-01,  .100E+01,  .147E+01,  .203E+01,          &
     &  .250E+01,  .291E+01,  .403E+01,  .445E+01,  .503E+01,  .541E+01,&
     &  .597E+01,  .646E+01,  .706E+01,  .797E+01,  .858E+01,  .909E+01,&
     &  .100E+02/
!
!      ----FIGURE 7.1.2.2-25B
!
      DATA Q2225B/4H7.1.,4H2.2-,4H25B /
      DATA X1225B/  .000E+00,  .100E+01,  .200E+01,  .300E+01,          &
     &  .400E+01,  .500E+01,  .600E+01/
      DATA X2225B/  .296E-01,  .202E+01,  .279E+01,  .330E+01,          &
     &  .428E+01,  .526E+01,  .571E+01,  .625E+01,             .697E+01,&
     &  .748E+01,  .805E+01,  .903E+01,  .100E+02/
!
!      ----FIGURE 7.1.2.2-25C
!
      DATA Q2225C/4H7.1.,4H2.2-,4H25C /
      DATA X1225C/  .000E+00,  .100E+01,  .200E+01,  .300E+01,          &
     &  .400E+01,  .500E+01,  .600E+01/
      DATA X2225C/  .125E-01,  .199E+01,  .268E+01,  .332E+01,          &
     &  .369E+01,  .433E+01,  .468E+01,  .539E+01,  .571E+01,  .668E+01,&
     &  .802E+01,  .903E+01,  .100E+02/
!
!      ----FIGURE 7.1.2.2-25D
!
      DATA Q2225D/4H7.1.,4H2.2-,4H25D /
      DATA X1225D/  .000E+00,  .100E+01,  .200E+01,  .300E+01,          &
     &  .400E+01,  .500E+01,  .600E+01/
      DATA X2225D/  .140E-01,  .199E+01,  .224E+01,  .256E+01,          &
     &  .275E+01,  .328E+01,  .371E+01,  .433E+01,  .502E+01,  .560E+01,&
     &  .698E+01,  .802E+01,  .901E+01,  .100E+02/
!
!      ----FIGURE 7.1.2.2-25E
!
      DATA Q2225E/4H7.1.,4H2.2-,4H25E /
      DATA X1225E/  .000E+00,  .100E+01,  .200E+01,  .300E+01,          &
     &  .400E+01,  .500E+01,  .600E+01/
      DATA X2225E/  .180E-01,  .205E+01,  .217E+01,  .237E+01,          &
     &  .258E+01,  .284E+01,  .302E+01,  .353E+01,  .402E+01,  .449E+01,&
     &  .504E+01,  .546E+01,  .602E+01,  .701E+01,  .803E+01,  .900E+01,&
     &  .100E+02/
!
!      ----FIGURE 7.1.2.1-10A
!
      DATA Q2110A/4H7.1.,4H2.1-,4H10A /
      DATA X1110A/  .100E+02,  .150E+02,  .200E+02,  .250E+02,          &
     &  .300E+02,  .350E+02,  .400E+02,  .450E+02,  .500E+02,  .550E+02,&
     &  .600E+02,  .650E+02,  .700E+02,  .750E+02/
      DATA X2110A/  .134E+01,  .149E+01,  .160E+01,  .179E+01,          &
     &  .200E+01,  .240E+01,  .297E+01,  .349E+01,  .399E+01/
!
!      ----FIGURE 7.1.2.1-10B
!
      DATA Q2110B/4H7.1.,4H2.1-,4H10B /
      DATA X1110B/  .100E+01,  .200E+01,  .300E+01,  .400E+01,          &
     &  .800E+01,  .120E+02,  .200E+02/
      DATA X2110B/  .238E+00,  .550E+00,  .842E+00,  .127E+01,          &
     &  .216E+01,  .282E+01,  .325E+01,  .398E+01,  .430E+01,  .464E+01,&
     &  .498E+01,  .543E+01,  .596E+01,  .694E+01,  .795E+01,  .901E+01,&
     &  .999E+01,  .110E+02,  .120E+02/
!
!      ----FIGURE 7.1.2.1-10C
!
      DATA Q2110C/4H7.1.,4H2.1-,4H10C /
      DATA X1110C/  .000E+00,  .250E+00,  .500E+00,  .750E+00,          &
     &  .100E+01/
      DATA X2110C/ -.600E+01, -.243E+01, -.197E+01, -.102E+01,          &
     &  .000E+00/
!
!      ----FIGURE 7.1.2.3-14A
!
      DATA Q2314A/4H7.1.,4H2.3-,4H14A /
      DATA X1314A/  .200E+01,  .300E+01,  .400E+01,  .500E+01,          &
     &  .600E+01,  .700E+01,  .800E+01,  .100E+02,  .150E+02,  .200E+02/
      DATA X2314A/  .323E+00,  .399E+00,  .451E+00,  .493E+00,          &
     &  .527E+00,  .537E+00,  .553E+00,  .584E+00,  .631E+00,  .651E+00,&
     &  .700E+00,  .802E+00,  .902E+00,  .100E+01/
!
!      ----FIGURE 7.1.2.3-14B
!
      DATA Q2314B/4H7.1.,4H2.3-,4H14B /
      DATA X1314B/  .200E+01,  .300E+01,  .400E+01,  .500E+01,          &
     &  .600E+01,  .700E+01,  .800E+01,  .100E+02,  .150E+02,  .200E+02/
      DATA X2314B/  .326E+00,  .393E+00,  .443E+00,  .478E+00,          &
     &  .502E+00,  .519E+00,  .552E+00,  .569E+00,  .616E+00,  .647E+00,&
     &  .700E+00,  .799E+00,  .900E+00,  .100E+01/
!
!      ----FIGURE 7.1.2.3-14C
!
      DATA Q2314C/4H7.1.,4H2.3-,4H14C /
      DATA X1314C/  .200E+01,  .300E+01,  .400E+01,  .500E+01,          &
     &  .600E+01,  .700E+01,  .800E+01,  .100E+02,  .150E+02,  .200E+02/
      DATA X2314C/  .369E+00,  .444E+00,  .492E+00,  .532E+00,          &
     &  .563E+00,  .585E+00,  .615E+00,  .641E+00,  .675E+00,  .747E+00,&
     &  .795E+00,  .898E+00,  .100E+01/
!
!      ----FIGURE 7.1.2.3-14D
!
      DATA Q2314D/4H7.1.,4H2.3-,4H14D /
      DATA X1314D/  .200E+01,  .300E+01,  .400E+01,  .500E+01,          &
     &  .600E+01,  .700E+01,  .800E+01,  .100E+02,  .150E+02,  .200E+02/
      DATA X2314D/  .401E+00,  .492E+00,  .546E+00,  .589E+00,          &
     &  .611E+00,  .639E+00,  .666E+00,  .693E+00,  .731E+00,  .753E+00,&
     &  .804E+00,  .902E+00,  .100E+01/
!
!      ----FIGURE 7.1.2.3-16
!
      DATA Q12316/4H7.1.,4H2.3-,4H16  /
      DATA I22316 /9/
      DATA X12316/  .301E+00,  .498E+00,  .750E+00,  .846E+00,          &
     &  .922E+00,  .949E+00,  .974E+00,  .987E+00,  .997E+00/
      DATA Y12316/ -.168E+00, -.135E+00, -.851E-01, -.626E-01,          &
     & -.385E-01, -.293E-01, -.190E-01, -.115E-01, -.575E-03/
!
!      ----FIGURE 7.1.2.3-17A
!
      DATA Q2317A/4H7.1.,4H2.3-,4H17A /
      DATA X1317A/  .200E+01,  .300E+01,  .400E+01,  .800E+01,          &
     &  .120E+02/
      DATA X2317A/  .100E+01,  .115E+01,  .125E+01,  .138E+01,          &
     &  .153E+01,  .175E+01,  .201E+01,  .249E+01,  .301E+01,  .351E+01,&
     &  .397E+01,  .449E+01,  .549E+01,  .648E+01,  .698E+01/
!
!      ----FIGURE 7.1.2.3-17B
!
      DATA Q2317B/4H7.1.,4H2.3-,4H17B /
      DATA X1317B/  .200E+01,  .300E+01,  .400E+01,  .800E+01,          &
     &  .120E+02/
      DATA X2317B/  .101E+01,  .127E+01,  .150E+01,  .167E+01,          &
     &  .184E+01,  .202E+01,  .253E+01,  .303E+01,  .352E+01,  .403E+01,&
     &  .502E+01,  .603E+01,  .700E+01/
!
!      ----FIGURE 7.1.2.3-17C
!
      DATA Q2317C/4H7.1.,4H2.3-,4H17C /
      DATA X1317C/  .200E+01,  .300E+01,  .400E+01,  .800E+01,          &
     &  .120E+02/
      DATA X2317C/  .100E+01,  .113E+01,  .131E+01,  .150E+01,          &
     &  .164E+01,  .181E+01,  .198E+01,  .220E+01,  .250E+01,  .299E+01,&
     &  .347E+01,  .398E+01,  .496E+01,  .597E+01,  .693E+01/
!
!      ----FIGURE 7.1.2.3-17D
!
      DATA Q2317D/4H7.1.,4H2.3-,4H17D /
      DATA X1317D/  .200E+01,  .300E+01,  .400E+01,  .800E+01,          &
     &  .120E+02/
      DATA X2317D/  .100E+01,  .110E+01,  .125E+01,  .136E+01,          &
     &  .149E+01,  .174E+01,  .200E+01,  .251E+01,  .303E+01,  .351E+01,&
     &  .400E+01,  .501E+01,  .603E+01,  .699E+01/
!
!        IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
!        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
!
!        THE FORMAT IS AS FOLLOWS-
!
!        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
!
!        WHERE-
!
!        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
!        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
!        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
!             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
!        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
!        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
!        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
!        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
!
      DATA Y2225A/-1143985102,-1133105107,-1134109960,-1144760690,      &
     &-1144620570,-1144530490,-1144460410,-1144390370,-1144330990,      &
     &-1143990100,-1133101101,-1144990760,-1144710630,-1144580540,      &
     &-1144510470,-1144420400,-1144380340,-1144990960,-1144940930,      &
     &-1144910890,-1144830750,-1144670610,-1144560520,-1144490430,      &
     &-1144410390,-1144350860,-1144830820,-1144810810,-1144800760,      &
     &-1144750730,-1144660600,-1144560510,-1144440420,-1144400350,      &
     &-1144750740,-1144740730,-1144730730,-1144710710,-1144690680,      &
     &-1144650590,-1144540460,-1144440410,-1144360670,-1144670670,      &
     &-1144670680,-1144680670,-1144660650,-1144640630,-1144620600,      &
     &-1144510460,-1144430380,-1144580590,-1144590600,-1144610620,      &
     &-1144630620,-1144620610,-1144600590,-1144580560,-1144500460,      &
     & -340410000/
      DATA Y2225B/-1143988134,-1133123114,-1144938780,-1144725671,      &
     &-1144615576,-1144541485,-1144441988,-1133124119,-1134113954,      &
     &-1144806743,-1144681623,-1144588551,-1144488445,-1143987113,      &
     &-1133111110,-1144969827,-1144771701,-1144632594,-1144557495,      &
     &-1144448928,-1133102102,-1134101967,-1144857802,-1144741660,      &
     &-1144622578,-1144514461,-1144839906,-1144938933,-1144903876,      &
     &-1144825776,-1144697650,-1144601544,-1144487771,-1144791824,      &
     &-1144843862,-1144828815,-1144797737,-1144690640,-1144565505,      &
     &-1144691708,-1144732747,-1144780787,-1144778764,-1144738713,      &
     &-1144674602, -340533000/
      DATA Y2225C/-1143987137,-1133127116,-1133111100,-1144944855,      &
     &-1144809713,-1144615562,-1144511982,-1133131124,-1133116110,      &
     &-1134100944,-1144853814,-1144720619,-1144563511,-1143982119,      &
     &-1133118112,-1133109102,-1144976883,-1144839734,-1144628566,      &
     &-1144516943,-1133107109,-1133108107,-1134102974,-1144901860,      &
     &-1144761640,-1144576523,-1144877935,-1144968999,-1144991974,      &
     &-1144972913,-1144880791,-1144677605,-1144546820,-1144827854,      &
     &-1144878891,-1144913904,-1144886880,-1144809700,-1144633566,      &
     &-1144738726,-1144749773,-1144786809,-1144826850,-1144844830,      &
     &-1144730656, -340594000/
      DATA Y2225D/-1143985141,-1133136132,-1133128119,-1133112103,      &
     &-1144940869,-1144731654,-1144592541,-1143985131,-1133128125,      &
     &-1133123117,-1133111105,-1144953871,-1144735654,-1144592541,      &
     &-1143985117,-1133120120,-1133119114,-1133109104,-1144952887,      &
     &-1144747666,-1144599544,-1143953103,-1133104106,-1133106110,      &
     &-1133107103,-1144966906,-1144767687,-1144617566,-1144893908,      &
     &-1144938958,-1144968985,-1143998101,-1144975917,-1144800723,      &
     &-1144651578,-1144822803,-1144824843,-1144857889,-1144911929,      &
     &-1144938917,-1144820741,-1144671594,-1144760724,-1144735757,      &
     &-1144770804,-1144831846,-1144864871,-1144819755,-1144685615/
      DATA Y2225E/-1143988129,-1133129130,-1133129128,-1133125117,      &
     &-1133110102,-1144960910,-1144850760,-1144680620,-1144570980,      &
     &-1133125126,-1133126126,-1133125123,-1133117109,-1134103960,      &
     &-1144910850,-1144760680,-1144630570,-1143990113,-1133116118,      &
     &-1133118118,-1133118115,-1133109105,-1144980930,-1144870780,      &
     &-1144700640,-1144580960,-1133104105,-1133107109,-1133112114,      &
     &-1133112108,-1134104990,-1144940890,-1144790720,-1144650600,      &
     &-1144900930,-1144930950,-1144970980,-1144000102,-1133104102,      &
     &-1144980940,-1144900820,-1144730670,-1144610840,-1144820830,      &
     &-1144850860,-1144880890,-1144920940,-1144960960,-1144950920,      &
     &-1144820750,-1144680630,-1144770730,-1144740750,-1144770780,      &
     &-1144790820,-1144850860,-1144880890,-1144900850,-1144770710,      &
     & -340650000/
      DATA Y2110A/  111106130,  111148177,  111211274,  111364445,      &
     &  112525828,  121994112,  111134162,  111223327,  111438563,      &
     &  122706802,  121879100,  111115142,  111179209,  112237582,      &
     &  122661713,  122817930,  111115144,  111168189,  122508572,      &
     &  122628699,  122787958,  111118137,  112155445,  122498552,      &
     &  122618695,  122824999,  111116130,  122410452,  122491540,      &
     &  122602713,  122861997,  112112330,  122408429,  122485533,      &
     &  122637755,  122868969,  122262342,  122399436,  122485565,      &
     &  122669757,  122855209,  122272314,  122395436,  122503587,      &
     &  122665731,  122140215,  122260338,  122398450,  122525588,      &
     &  123651831,  122136166,  122228288,  122392452,  122505560,      &
     &  133466831,  122108150,  122196291,  122388445,  123487464,      &
     &  133531715,  132877125,  122192271,  122344413/
      DATA Y2110B/  122439402,  122374346,  122310295,  122278249,      &
     &  122230218,  122199189,  122184161,  122152147,  122145136,      &
     &  122138599,  122532489,  122425344,  122306285,  122249228,      &
     &  122202190,  122172157,  122145138,  122127118,  122115113,      &
     &  122728659,  122599519,  122384335,  122304247,  122219188,      &
     &  122160136,  122121111,  133976951,  133974909,  132771910,      &
     &  122804715,  122600426,  122351320,  122252199,  122158133,      &
     &  122117107,  133821749,  133679679,  133680679,  122778767,      &
     &  122751716,  122601478,  122380249,  122190135,  123111797,      &
     &  133625482,  133409385,  133363363,  132318951,  122938919,      &
     &  122877741,  122596481,  122251164,  123116790,  133517433,      &
     &  133388364,  133340317,  133318295,  111346307,  111272224,      &
     &  112140889,  122612244,  123123675,  133449356,  133185206,      &
     &  133138114,  133136137,  330136000/
      DATA Y2110C/  124358230,  340230000,  142230505,  122145106,      &
     &  134413230,  122610248,  122209106,  142230677,  122324285,      &
     &  124161230,  122728367,  122326220,  340230000/
      DATA Y2314A/-1133828841,-1133849855,-1133858858,-1133859862,      &
     &-1133866866,-1133867869,-1133869870,-1133818817,-1133819824,      &
     &-1133826824,-1133825826,-1133826826,-1133825817,-1133813805,      &
     &-1133808808,-1133808808,-1133808806,-1133807806,-1133806805,      &
     &-1133800793,-1133783772,-1133767788,-1133796799,-1133798796,      &
     &-1133796796,-1133793791,-1133786776,-1133765753,-1133666739,      &
     &-1133770784,-1133788790,-1133790788,-1133785785,-1133779767,      &
     &-1133754742,-1133797793,-1133790788,-1133787787,-1133785784,      &
     &-1133779776,-1133772761,-1133746733,-1133799796,-1133792789,      &
     &-1133786785,-1133784780,-1133775774,-1133767754,-1133741723,      &
     &-1133826809,-1133798790,-1133784783,-1133780775,-1133769766,      &
     &-1133759745,-1133732714,-1133847821,-1133806794,-1133785783,      &
     &-1133779772,-1133762758,-1133751736,-1133721702,-1133824805,      &
     &-1133793783,-1133776774,-1133771765,-1133756753,-1133745730,      &
     &-1133713697/
      DATA Y2314B/-1122138141,-1122143144,-1122145145,-1122147147,      &
     &-1122149149,-1122151153,-1122155157,-1122137136,-1122137138,      &
     &-1122138139,-1122139139,-1122140140,-1122141141,-1122141142,      &
     &-1122133134,-1122134135,-1122134135,-1122135135,-1122136136,      &
     &-1122136136,-1122135135,-1122133133,-1122132132,-1122133133,      &
     &-1122133133,-1122133132,-1122132132,-1122132130,-1122126130,      &
     &-1122131132,-1122132132,-1122132131,-1122131131,-1122131130,      &
     &-1122129127,-1122140135,-1122133131,-1122131131,-1122130130,      &
     &-1122130130,-1122129128,-1122126126,-1122127129,-1122129130,      &
     &-1122130130,-1122130129,-1122129128,-1122128127,-1122126124,      &
     &-1122121125,-1122126127,-1122128128,-1122128128,-1122128127,      &
     &-1122126125,-1122123122,-1122118122,-1122124125,-1122126126,      &
     &-1122126126,-1122126126,-1122124123,-1122121119,-1122124124,      &
     &-1122125125,-1122125125,-1122125125,-1122124124,-1122123122,      &
     &-1122119117/
      DATA Y2314C/-1122189195,-1122198201,-1122202204,-1122206206,      &
     &-1122209213,-1122215220,-1122225177,-1122185187,-1122188188,      &
     &-1122189190,-1122191192,-1122193195,-1122196199,-1122171178,      &
     &-1122181182,-1122182182,-1122182183,-1122183184,-1122185186,      &
     &-1122186178,-1122178178,-1122178178,-1122178178,-1122178178,      &
     &-1122178178,-1122178178,-1122163169,-1122172174,-1122174174,      &
     &-1122174174,-1122174174,-1122173173,-1122172185,-1122179176,      &
     &-1122175174,-1122173173,-1122173173,-1122172172,-1122169168,      &
     &-1122146158,-1122163167,-1122168169,-1122170170,-1122169169,      &
     &-1122168167,-1122165144,-1122156161,-1122164166,-1122167168,      &
     &-1122168168,-1122167166,-1122164162,-1122139150,-1122155159,      &
     &-1122161162,-1122163164,-1122164163,-1122162159,-1122156201,      &
     &-1122188181,-1122177173,-1122171168,-1122166164,-1122160159,      &
     &-1122156154/
      DATA Y2314D/-1122228237,-1122242245,-1122247249,-1122252254,      &
     &-1122256258,-1122262269,-1122276210,-1122221225,-1122226227,      &
     &-1122229229,-1122230233,-1122233234,-1122238242,-1122211215,      &
     &-1122216217,-1122217218,-1122219219,-1122220220,-1122220223,      &
     &-1122223206,-1122208209,-1122210211,-1122211211,-1122211211,      &
     &-1122212212,-1122212213,-1122208207,-1122207207,-1122207207,      &
     &-1122207207,-1122207207,-1122207206,-1122205203,-1122203203,      &
     &-1122202202,-1122204204,-1122203203,-1122203202,-1122201200,      &
     &-1122202202,-1122202202,-1122202201,-1122201201,-1122201201,      &
     &-1122200198,-1122196176,-1122186191,-1122194195,-1122196196,      &
     &-1122197197,-1122197196,-1122194191,-1122145167,-1122176182,      &
     &-1122185187,-1122189190,-1122191191,-1122190187,-1122183173,      &
     &-1122180183,-1122185186,-1122187187,-1122188188,-1122188187,      &
     &-1122183181/
      DATA Y2317A/-1133142138,-1133130121,-1134113991,-1144879753,      &
     &-1144692655,-1144625609,-1144580559,-1144552943,-1144881812,      &
     &-1144672580,-1144475431,-1144371338,-1144317297,-1144288278,      &
     &-1144258256,-1144696641,-1144534411,-1144349288,-1144250211,      &
     &-1144187178,-1144174167,-1144151150,-1144148354,-1144249182,      &
     &-1144130104,-1155776710,-1155639593,-1155572459,-1155412365,      &
     &-1155342342,-1144214123,-1155900662,-1155525365,-1155343320,      &
     &-1155274274,-1155252229,-1155205205, -350205000/
      DATA Y2317B/-1133410391,-1133366353,-1133340326,-1133302281,      &
     &-1133267262,-1133248240,-1133233267,-1133247215,-1133197181,      &
     &-1133175156,-1133140134,-1133126120,-1133119115,-1133198175,      &
     &-1133143123,-1133108103,-1144904847,-1144810751,-1144678663,      &
     &-1143659102,-1144668473,-1144368329,-1144318281,-1144267231,      &
     &-1144206202,-1144163159,-1144660362,-1144221184,-1144159147,      &
     &-1144134131,-1144118116,-1144111107, -340102000/
      DATA Y2317C/-1133681675,-1133659642,-1133624608,-1133591577,      &
     &-1133562537,-1133521509,-1133490480,-1133469455,-1133434413,      &
     &-1133387371,-1133354341,-1133319301,-1133279265,-1133257244,      &
     &-1133239229,-1133330321,-1133296275,-1133258239,-1133220200,      &
     &-1133183166,-1133158151,-1133147138,-1133135159,-1133143111,      &
     &-1144869740,-1144667597,-1144538511,-1144455406,-1144392388,      &
     &-1144385371,-1134114888,-1144571374,-1144322307,-1144278278,      &
     &-1144198187,-1144186172,-1144191188, -340207000/
      DATA Y2317D/-1133932927,-1133914898,-1133889860,-1133836807,      &
     &-1133778754,-1133743717,-1133707690,-1133612602,-1133576568,      &
     &-1133550529,-1133495457,-1133425406,-1133389379,-1133360357,      &
     &-1133460449,-1133424413,-1133382348,-1133319283,-1133266247,      &
     &-1133241227,-1133214211,-1133234209,-1133179162,-1133134121,      &
     &-1134101918,-1144849702,-1144686654,-1144645636,-1133177118,      &
     &-1144927838,-1144648592,-1144524394,-1144398339,-1144323314,      &
     &-1144305295/
      DATA X13170/2.,12./,X23170/0.,7.,0.,7./,Y23170/0.,0./
!
      MACH=FLC(IM+2)
      COTLE=1./TANLE
      IF(WGPL.AND.(.NOT.BO))GO TO 1000
      DB=(SSPN-SSPNE)/SSPN
      IF(DB.GT.0.3)RETURN
 1000 ASTAN2=AW*TANCO2
      BAW=BETA*AW
!     ---SUPER WING,WING-BODY ROLLING  DERIVATIVE,CLP---
!
!              FIGURE 7.1.2.2-25 A-E
      CALL INTEP3(ASTAN2,BAW,LAMDA,X1225A,X2225A,Y2225A,7,17,Q2225A,    &
     &X1225B,X2225B,Y2225B,7,13,Q2225B,                                 &
     &            X1225C,X2225C,Y2225C,7,13,Q2225C,                     &
     &            X1225D,X2225D,Y2225D,7,14,Q2225D,                     &
     &            X1225E,X2225E,Y2225E,7,17,Q2225E,CLPA)
!
      SAVE=4.*SW*SSPN**2/(RAD*SR*BLREF**2)
      CLPWBH=CLPA*CNACNA*SAVE*AW
!
!     ---SUPER WING,WING-BODY YAWING DERIVATIVE,CYP---
!           -- FIGURE 7.1.2.1-10 --
!
      CALL TLIP2X(X1110A,X2110A,Y2110A,14, 9,LAMLE,MACH,TRENS,2,1,2,1,  &
     &            Q2110A,3,ROUTID)
      CALL TLIP2X(X1110B,X2110B,Y2110B,7,19,BAW,TRENS,CHENGE,2,1,2,1,   &
     &            Q2110B,3,ROUTID)
      CHENGE=-CHENGE
      CALL TLIP2X(X1110C,X2110C,Y2110C,5,5,LAMDA,CHENGE,CYPA,1,1,2,1,   &
     &            Q2110C,3,ROUTID)
      TEMP=CYPA*SW*SSPN/(SR*BLREF*1641.645)
      DO 1010 I=1,NALPHA
         CYPWSP(I)=TEMP*ALSCHD(I)
 1010 END DO
!
!     ----SUPER WING,WING-BODY ROLLING DERIVATIVE,CNP---
!
      BCOTLE=BETA*COTLE
      IF(BCOTLE.GE.1.)GO TO 1030
!
!              FIGURE 7.1.2.3-14 A-D
!
      CALL INTEP3( BAW, BCOTLE, LAMDA, 0, 0, 0, 1, 1, 0                 &
     &            ,X1314A,X2314A,Y2314A,10,14,Q2314A                    &
     &            ,X1314B,X2314B,Y2314B,10,14,Q2314B                    &
     &            ,X1314C,X2314C,Y2314C,10,13,Q2314C                    &
     &            ,X1314D,X2314D,Y2314D,10,13,Q2314D,CNPTAS)
      CNPA1 =CNPTAS*TANLE
!
!           -- FIGURE 7.1.2.3-16 --
!
      CALL INTERX(1,X12316,BCOTLE,I22316,Y12316,CNPAAS,9,9,1,0,0,0,1,   &
     &            0,0,0,Q12316,3,ROUTID)
      CNPA2=CNPAAS*AW
      CNPA3=CNPAAS*AW*TANLE**2
      CNPA=CNPA1+CNPA2+CNPA3
      CNAPE=SAVE*(CNPA+CYPA*(XCG-XW)/CR*AW*(1.+LAMDA))
      DO 1020 I=1,NALPHA
 1020 CNPWBH(I)=(CNPAE-CLPWBH)*ALSCHD(I)/RAD
      GO TO 1050
 1030 CONTINUE
!
!              FIGURE 7.1.2.3-17 A-D
!
      CALL INTEP3( BAW, BCOTLE, LAMDA, 0, 0, 0, 1, 1, 0,                &
     &             X1317A,X2317A,Y2317A,5,15,Q2317A,                    &
     &             X1317B,X2317B,Y2317B,5,13,Q2317B,                    &
     &             X1317C,X2317C,Y2317C,5,15,Q2317C,                    &
     &             X1317D,X2317D,Y2317D,5,14,Q2317D,CNPBA)
      AAAAA=BETA*CNPBA
      BBBBB=2.*XCG/(BLREF*AW*(1.+LAMDA))-.5*TANLE
      CCCCC=(AAAAA+BBBBB*CYPA*BLREF/(2.*SSPN))*SAVE
      DO 1040 I=1,NALPHA
         CNPWBH(I)=(CCCCC-CLPWBH)*ALSCHD(I)/RAD
 1040 END DO
 1050 CONTINUE
      RETURN
      END
      SUBROUTINE SUPWB
!
!***  CALCULATES SUPERSONIC WING-BODY AERO
!
      REAL MACH,NXX,KWB,KBW,IVBW  ,KKBW,KKWB
      DIMENSION ROUTID(2),Q1211A(3),Q1211B(3),Q31210(3),Q1212A(3),      &
     &          Q1212B(3),Q2118A(3),Q2118B(3),Q2137A(3),Q2137B(3)
      DIMENSION T4312B(8),D4312B(8)
      DIMENSION CDW(20),CDB(20),WTYPE(4),IVBW(20),GAMMA(20)
      DIMENSION T4337A(11),D4337A(24),T4337B(12),D4337B(20)
      DIMENSION T4312A(11),D4312A(11)
      DIMENSION TFIG10(11),DKWB10(11),DKBW10(11)
      DIMENSION T4218A(18),DL218A(54),DR218A(54),T4218B(14),DL218B(42), &
     &          DR218B(42)
      DIMENSION LGH(4),VAR(4),CD(20),CN(20),CA(20),CL(20),CLB(20),      &
     &           CLW(20),ALPHAB(20),CDL(20)
      DIMENSION CM(20)
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(160)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /WINGI/  W(2),SPANS,SPAN,W1,CR,W2(8),TYPE
      COMMON /BODYI/  NXX,XCOOR(20),S(20),P(20),R(20),ZU(20),ZL(20),    &
     &                BNOSE,BTAIL,RLN, dum2(5)
      COMMON /BDATA/  BD(762)
      COMMON /WINGD/  A(195)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /SUPBOD/ SBD(229)
      COMMON /SUPWBB/  SWB(61)
      COMMON /SUPWH/  SLG(141)
      COMMON /IBODY/  PBODY, BODY(400)
      COMMON /IWING/  PWING, WING(400)
      COMMON /IBW/    PBW, BW(380)
!
      EQUIVALENCE (CA(1),BW(81)),(CDW(1),WING(1)),(CMA,BW(121)),        &
     & (DXCG,A(173)),(CLAB,SBD(18)),(KKWB,SWB(2)),                      &
     & (XACN,SWB(3)),(CDOWB,SWB(4)),(DELXW,BD(66)),(ARSTAR,A(7)),       &
     & (CD(1),BW(1)),(DD,SWB(5)),(XW,SYNA(2)),(CLB(1),BODY(21)),        &
     & (ALIW,SYNA(4)),(BETA,SWB(6)),(CLAW,WING(101)),                   &
     & (XACW,SLG(134)),(CLABW,SWB(7)) ,(XACBW,SWB(8))
      EQUIVALENCE (CLA,BW(101)),(CDL(1),SLG(53))
      EQUIVALENCE (CL(1),BW(21)),(FA,SWB(9)),(CLI,SWB(10)),             &
     & (KBW,SWB(11)),(CDOB,SBD(124)),(IVBW(1),SWB(12)),(RKBW,SWB(32)),  &
     & (CLAWB,SWB(33)),(TANL ,A(62)),(CRSTAR,A(10)),                    &
     & (TAPEXP,A(27)),(CN(1),BW(61)),(FN, SWB(34)),(CDB(1),BODY(1)),    &
     & (CLW(1),WING(21)),(KWB,SWB(35)),(XAC,SWB(36)) ,(CDOW,SLG(80)),   &
     & (DN,SBD(4)),(D1,SBD(5)),(KKBW,SWB(37)),(RLAP,SWB(38))
      EQUIVALENCE (XACA,SWB(39)),(GAMMA(1),SWB(40)),                    &
     & (TRINO,SWB(60)),(XCPLN,SWB(61)),(ALPHAB(1),BD(255))              &
     & ,(CM(1),BW(41))
!
      DATA ROUTID/4HSUPW,4HB   /,                                       &
     & Q31210/4H4.3.,4H1.2-,4H10  /,Q1212A/4H4.3.,4H1.2-,4H12A /,       &
     & Q2118A/4H4.2.,4H2.1-,4H23A /,Q1212B/4H4.3.,4H1.2-,4H12B /,       &
     & Q2118B/4H4.2.,4H2.1-,4H23B /,Q2137A/4H4.3.,4H2.2-,4H37A /,       &
     &                              Q2137B/4H4.3.,4H2.2-,4H37B /
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
!                   FIGURE 4.3.1,2-10 KWB
!
      DATA TFIG10/0.0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.0/
      DATA DKWB10/1.0,1.08,1.16,1.26,1.36,1.46,1.56,1.67,1.78,1.89,2.0/
!
!                   FIGURE 4.3.1.2-10 KBW
!
      DATA DKBW10/0.0,.13,.29,.45,.62,.80,1.0,1.22,1.45,1.70,2.0/
!
!               FIGURE 4.2.2.1-23A (LEFT SIDE)
!
      DATA T4218A                                                       &
     &  / 0., 0.2, 0.4, 0.6, 0.8, 1.0 , 3*0.0,                          &
     &    0.0, 0.4, 0.8, 1.2, 1.6, 2.0, 3.0, 4.0, 5.0 /
      DATA DL218A                                                       &
     & /  0.543,  0.542,  0.541,  0.540,  0.534,  0.526,                &
     &    0.400,  0.409,  0.418,  0.430,  0.441,  0.450,                &
     &    0.305,  0.328,  0.350,  0.369,  0.387,  0.400,                &
     &    0.238,  0.265,  0.295,  0.318,  0.339,  0.356,                &
     &    0.198,  0.221,  0.246,  0.274,  0.298,  0.320,                &
     &    0.160,  0.185,  0.210,  0.239,  0.262,  0.288,                &
     &    0.065,  0.095,  0.122,  0.150,  0.177,  0.210,                &
     &    0.000,  0.005,  0.035,  0.062,  0.089,  0.130,                &
     &    0.000,  0.000,  0.000,  0.000,  0.002,  0.050  /
!
!               FIGURE 4.2.2.1-23A (RIGHT SIDE)
!
      DATA DR218A                                                       &
     &  / 0.445,  0.464,  0.485,  0.500,  0.518,  0.526,                &
     &    0.448,  0.455,  0.460,  0.460,  0.459,  0.450,                &
     &    0.460,  0.449,  0.438,  0.424,  0.412,  0.400,                &
     &    0.450,  0.430,  0.412,  0.394,  0.375,  0.356,                &
     &    0.432,  0.410,  0.388,  0.365,  0.343,  0.320,                &
     &    0.420,  0.394,  0.369,  0.340,  0.314,  0.288 ,               &
     &    0.388,  0.354,  0.322,  0.278,  0.244,  0.210,                &
     &    0.357,  0.314,  0.273,  0.216,  0.171,  0.130,                &
     &    0.325,  0.274,  0.225,  0.154,  0.100,  0.050  /
!
!              FIGURE 4.2.2.1-23B (LEFT SIDE)
!
      DATA T4218B                                                       &
     &  / 0., 0.2, 0.4, 0.6, 0.8, 1.0  , 0.,                            &
     &    0.0, 0.5, 1.0, 2.0, 3.0, 4.0, 5.0 /
      DATA DL218B                                                       &
     & /  .665,  .665,  .665,  .665,  .665,  .665,                      &
     &    .425,  .492,  .539,  .550,  .550,  .550,                      &
     &    .330,  .370,  .405,  .438,  .459,  .470,                      &
     &    .184,  .215,  .250,  .284,  .318,  .350,                      &
     &    .060,  .097,  .133,  .170,  .206,  .240,                      &
     &    .000,  .000,  .044,  .083,  .127,  .170,                      &
     &    .000,  .000,  .000,  .020,  .063,  .105  /
!
!
!              FIGURE 4.2.2.1-23B (RIGHT SIDE)
!
      DATA DR218B                                                       &
     & /  .665,  .665,  .665,  .665,  .665,  .665,                      &
     &    .480,  .500,  .519,  .536,  .546,  .550,                      &
     &    .338,  .388,  .430,  .458,  .471,  .470,                      &
     &    .338,  .372,  .394,  .394,  .375,  .350,                      &
     &    .410,  .375,  .341,  .308,  .272,  .240,                      &
     &    .377,  .338,  .294,  .251,  .211,  .170,                      &
     &    .342,  .300,  .246,  .194,  .146,  .100   /
!
!                   FIGURE 4.3.1.2-12A (KBW)
!
      DATA T4312A/0.0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.0/
      DATA D4312A/0.0,.11,.21,.31,.41,.51,.6,.7,.8,.9,1.0/
!
!                   FIGURE 4.3.1.2-12B (KWB)
!
      DATA T4312B/.015,.1,.2,.3,.4,.6,.8,.975/
      DATA D4312B/1.,.975,.956,.947,.941,.950,.978,1.0/
!
!                   FIGURE 4.3.2.2-37A
!
      DATA T4337A/0.0,.4,.8,1.2,1.6,2.,2.4,2.8,                         &
     &.1,1.0,999999./
      DATA D4337A/                                                      &
     &.5,.72,.900,1.08,1.24,1.39,1.53,1.68,                             &
     &.5,.72,.910,1.09,1.25,1.41,1.57,1.72,                             &
     &.5,.73,.920,1.11,1.27,1.43,1.59,1.74/
!
!                   FIGURE 4.3.2.2-37B
!
      DATA T4337B/0.0,.1,.2,.3,.4,.5,.6,.8,1.0,2.8,                     &
     &0.2,999999./
      DATA D4337B/                                                      &
     &0.5,.56,.595,.62,.64,.65,.66,.669,.669,.671,                      &
     &0.5,.54,.578,.60,.62,.638,.649,.66,.669,.671/
!
      NX=NXX+.5
      DCYL=(DN+D1)/2.
      MACH=FLC(I+2)
      BETA=SQRT(MACH**2-1.)
      RLB=XCOOR(NX)
      DD=2.0*(SPAN-SPANS)
      TANLE=TANL
      IF(TANLE.EQ.0.0)TANLE=.00001
!
!   ***SUPERSONIC WING-BODY LIFT CURVE SLOPE,BODY IN PRESENCE OF WING***
!                         NON-TRIANGULAR WINGS
!
      IF(TAPEXP.EQ.0.0)GO TO 1050
      ARG1=BETA*ARSTAR*(1.0+TAPEXP)
      ARG2=1.+TANLE/BETA
      TRINO=ARG1*ARG2
      IF(TRINO.LE.4.)GO TO 1030
 1000 OLE=A(34)
      DX=RLB-XW-DD/2.*A(38)-CRSTAR
      IF(DX.LE.(-CRSTAR))RKBW=0.
      IF(DX.LE.(-CRSTAR))GO TO 1020
      CALL INTKBW(MACH,OLE,CRSTAR,DD,DX,RKBW,RXAC)
 1020 KBW=RKBW/(RAD*BETA*(SREF/A(3))*CLAW*(TAPEXP+1.)*(2.*SPAN/DD-1.))
      GO TO 1040
 1030 CONTINUE
      LGH(1)=11
      VAR(1)=DD/(2.*SPAN)
!
!                   FIGURE 4.3.1.2-10 KBW
!
      CALL INTERX(1,TFIG10,VAR,LGH,DKBW10,KBW,11,11,                    &
     &            0,0,0,0,0,0,0,0,Q31210,3,ROUTID)
 1040 CONTINUE
      GO TO 1060
!
!  ***SUPERSONIC WING-BODY LIFT CURVE SLOPE,BODY IN PRESENCE OF WING***
!                         TRIANGULAR WING
!
 1050 CONTINUE
      ARG=BETA*ARSTAR
      IF(ARG.GT.1.)GO TO 1000
      GO TO 1030
 1060 CONTINUE
!
!  ***SUPERSONIC WING-BODY LIFT CURVE SLOPE
!
      ALBO=BD(81)
      IF(BD(81).EQ.UNUSED)ALBO=0.0
      DO 1070 J=1,NALPHA
 1070 ALPHAB(J)=FLC(J+22)+ALBO
      VAR(1)=(SPAN-SPANS)/SPAN
      LGH(1)=11
!
!                   FIGURE 4.3.1.2-10 KWB
!
      CALL INTERX(1,TFIG10,VAR,LGH,DKWB10,KWB,11,11,                    &
     &            0,0,0,0,0,0,0,0,Q31210,3,ROUTID)
      CLAWB=CLAW*KWB
      CLABW=CLAW*KBW
      CLA=CLABW+CLAWB+CLAB
!
!  ***SUPERSONIC WING-BODY LIFT AT ANGLE OF ATTACK***
!
      IF(TYPE.NE.WTYPE(1))GO TO 1100
      IF(ALIW.EQ.0.0.OR.(ALIW.EQ.UNUSED))GO TO 1080
!
!                   FIGURE 4.3.1.2-12A (KBW) INCIDENCE
!
      CALL INTERX(1,T4312A,VAR,LGH,D4312A,KKBW,11,11,                   &
     &            0,0,0,0,0,0,0,0,Q1212A,3,ROUTID)
!
!                   FIGURE 4.3.1.2-12B (KWB) INCIDENCE
!
      LGH(1)=8
      CALL INTERX(1,T4312B,VAR,LGH,D4312B,KKWB,8,8,                     &
     &            0,0,0,0,0,0,0,0,Q1212B,3,ROUTID)
 1080 CLI=CLAW*ALIW
      DETCL=0.0
      BD(83)=XW+A(161)
      BD(535)=SPAN-SPANS
      CALL BODOWG(BD(255),BD(83),BD(535),SPAN,A(27),                    &
     &            IVBW,GAMMA,NALPHA)
      ARG1=KWB+KBW
      ARG2=(KKWB+KKBW)*CLI
      ARG3=CLAW*(DD/(2.*SPAN))
      DO 1090 J=1,NALPHA
         DETCL=ARG3*ALPHAB(J)*IVBW(J)*GAMMA(J)
 1090 CL(J)=CLB(J)+ARG1*(CLW(J)-CLI)+ARG2+DETCL
!
!  ***SUPERSONIC CENTER OF PRESSURE FOR BODY NOSE AND FORBODY***
!
 1100 CONTINUE
      DELXW=(SPAN-SPANS)*TANLE*COS(ALIW/RAD)
      RLAP=XW+DELXW-RLN
      ARG1=RLN
      IF(RLAP.LT.0.)ARG1=RLN+RLAP
      IF(RLAP.LT.0.)RLAP=0.0
      FA=RLAP/DCYL
      FN=ARG1/DCYL
      VAR(1)=BETA/FN
      VAR(2)=FA/FN
      LGH(1)=6
      LGH(2)=9
      IF(BNOSE.EQ.1.)GO TO 1120
!
!                   FIGURE 4.2.2.1-23A LEFT SIDE(XCP) OGIVE
!
      IF(VAR(1).GT.1.)GO TO 1110
      CALL INTERX(2,T4218A,VAR,LGH,DL218A,XCPLN,9,54,                   &
     &            0,0,0,0,0,0,0,0,Q2118A,3,ROUTID)
      GO TO 1140
 1110 VAR(1)=1./VAR(1)
!
!                   FIGURE 4.2.2.1-23A RIGHT SIDE(XCP) OGIVE
!
      CALL INTERX(2,T4218A,VAR,LGH,DR218A,XCPLN,9,54,                   &
     &           0,0,0,0,0,0,0,0,Q2118A,3,ROUTID)
      GO TO 1140
 1120 CONTINUE
!
!                   FIGURE 4.2.2.1-23B LEFT SIDE(XCP) CONE
!
      LGH(2)=7
      IF(VAR(1).GT.1.)GO TO 1130
      CALL INTERX(2,T4218B,VAR,LGH,DL218B,XCPLN,7,42,                   &
     &           0,0,0,0,0,0,0,0,Q2118B,3,ROUTID)
      GO TO 1140
 1130 VAR(1)=1./VAR(1)
!
!                   FIGURE 4.2.2.1-23B RIGHT SIDE(XCP) CONE
!
      CALL INTERX(2,T4218B,VAR,LGH,DR218B,XCPLN,7,42,                   &
     &            0,0,0,0,0,0,0,0,Q2118B,3,ROUTID)
 1140 CONTINUE
      XACN=(XCPLN-1.)*(ARG1+RLAP)/CBARR
!
!  ***SUPERSONIC WING-LIFT CARRYOVER ON BODY***
!
      VAR(1)=BETA*DD/CRSTAR
      VAR(2)=BETA/TANLE
      ARG=(XW+CR)/RLB
      IF(ARG.GT.1.)GO TO 1150
!
!                   FIGURE 4.3.2.2-37A(XAC)B(W)
!
      LGH(1)=8
      LGH(2)=3
      CALL INTERX(2,T4337A,VAR,LGH,D4337A,XACA,8,24,                    &
     &           0,0,0,0,1,0,0,0,Q2137A,3,ROUTID)
      GO TO 1160
!
!                   FIGURE 4.3.2.2-37B(XAC)B(W)
!
 1150 LGH(1)=10
      LGH(2)=2
      CALL INTERX(2,T4337B,VAR,LGH,D4337B,XACA,10,20,                   &
     &           0,0,0,0,0,0,0,0,Q2137B,3,ROUTID)
 1160 XACBW=XACA*CRSTAR/CBARR
      XACW=XACW*CRSTAR/CBARR
!
!  ***SUPERSONIC WING-BODY PITCHING MOMENT SLOPE***
!
      DNUM=XACN*CLAB+XACW*CLAWB+XACBW*CLABW
      DNOM=CLAB+CLAWB+CLABW
      XAC  =DNUM/DNOM
      CMA=(DXCG/CBARR-XAC)*CLA
!
!  ***SUPERSONIC WING-BODY DRAG***
!
      CDOWB=CDOW+CDOB
      DO 1170 J=1,NALPHA
         COSA=COS(FLC(J+22)/RAD)
         SINA=SIN(FLC(J+22)/RAD)
         CD(J)=CDOW+CDL(J)+CDB(J)
         CN(J)=CL(J)*COSA+CD(J)*SINA
!
!   COMPUTE DELTA XCP WING-BODY
!
         DXCPWB=A(173)/CBARR-SLG(134)
!
!   COMPUTE DELTA XCP BODY-WING
!
         DXCPBW=A(173)/CBARR-SWB(8)
!
!   COMPUTE DELTA CN VORTEX
!
         DCNV=SWB(11+J)*SWB(39+J)*SWB(5)/(2*SPAN)*BD(254+J)*WING(101)   &
     &        /RAD
!
!   COMPUTE WING-BODY PITCHING MOMENT
!
         BW(40+J)=BODY(40+J)+WING(60+J)*SWB(35)*DXCPWB                  &
     &           +WING(101)*SYNA(4)*SWB(2)*DXCPWB/RAD                   &
     &           +WING(60+J)*SWB(11)*DXCPBW                             &
     &           +WING(101)*SYNA(4)*SWB(37)*DXCPBW/RAD                  &
     &           +DCNV*DXCPWB                                           &
     &           +WING(80+J)*(SYNA(3)-SYNA(5))/CBARR
 1170 CA(J)=CD(J)*COSA-CL(J)*SINA
      RETURN
      END
      SUBROUTINE SUPWBT(KDEODA,KQOQIN,KEPSLN)
!
!*** SUPERSONIC WING-BODY-TAIL CALCULATIONS
!
      DIMENSION ROUTID(2),Q1211A(3),Q1211B(3),Q31210(3),Q44167(2),      &
     &          Q1212A(3),Q1212B(3)
      REAL MACH,NXX,KWB,KBW,KKBW,KKWB
      REAL IVBH(20),IVWH(20)
      LOGICAL CANARD
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,I,NALPH
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ AHT(195)
      COMMON /BDATA/  BD(762)
      COMMON /SUPWBB/  SWB(61)
      COMMON /SUPDW/  DWA(237)
      COMMON /SUPWH/  SLG(141),STG(141)
      COMMON /WBHCAL/ STP(156)
      COMMON /SUPBOD/ SBD(227)
      COMMON /WHWB/   FACT(182)
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /BODYI/  NXX,XCOOR(20), dum2(108)
      COMMON /WINGI/  WINGIN(101)
      COMMON /HTI/    HTIN(154)
      COMMON /IBW/    PBW, BW(380)
      COMMON /IBWH/   PBWH, BWH(380)
      COMMON /IHT/    PHT, HT(380)
      COMMON /IBWHV/  PBWHV, BWHV(380)
      COMMON /IDWASH/ PDWASH, DWASH(60)
      COMMON /IWING/  PWING, WING(380),dum13(20)
      DIMENSION T4312B(8),D4312B(8)
      DIMENSION T4311A(36),D4311A(270),DUMYA(135),DUMYB(135)
      DIMENSION T4312A(11),D4312A(11)
      DIMENSION TFIG10(11),DKWB10(11),DKBW10(11)
      DIMENSION T4311B(23),D4311B(120)
      DIMENSION QOQINF(20),DEDALP(20),HMACH(20),CLAWBT(20),DELTAT(20)
      DIMENSION CNWBTV(20),CAWBTV(20)
      DIMENSION T4467(21),D4467(135)
      DIMENSION CCDWB(6),CC(6),EPSLON(40)
      DIMENSION LGH(4),VAR(4)
      DIMENSION CMWBT(20)
      DIMENSION GAMMA(20),CLTB(20),CLAH(20),CAA(6),CB(6),CLAHA(20)
      DIMENSION CDWBTV(20),CLH(20),CDWB(20),CDWBT(20),CMAH(20),         &
     &   CMAWBT(20),CLWB(20),CDAWB(20),CLWBT(20),CNWBT(20),CAWBT(20)
      EQUIVALENCE (XCSWPO,A(8)),(CD0VF,STP(156))
      EQUIVALENCE (CLAWB,BW(101)),(WSPAN,WINGIN(4)),                    &
     &            (WKWB,SWB(35)),(WSPANS,WINGIN(3)),(STAILE,AHT(3)),    &
     &            (ARSTRW,A(7)),(TAPEXW,A(27))
      EQUIVALENCE (CNWBT(1),BWH(61)),(CAWBT(1),BWH(81)),(CNWBTV(1),     &
     &             BWHV(61)), (CAWBTV(1),BWHV(81))
      EQUIVALENCE (QOQINF(1),DWASH(1)),(DEDALP(1),DWASH(41))            &
     &           ,(HMACH(1),DWA(189)),(JDETCH,DWA(237))
      EQUIVALENCE (CD0V,STP(1)),(SPAN,HTIN(4)),(CR,HTIN(6))             &
     &           ,(CLAH(1),HT(101)),(CMAWB,BW(121)),(CD0H,STG(80))
      EQUIVALENCE (DD,STP(62)),(TRINO,STP(63)),(RKBW,STP(64)),(KBW,STP( &
     &  65)),(KWB,STP(66)),(CLAHB,STP(67)),(CLABH,STP(68)),(YT,STP(69)),&
     &(RCREO2,STP(70)),(IVWH(1),STP(71)),(DELTAT(1),STP(91)),(CLAWBT(1),&
     &BWH(101)),(KKBW,STP(131)),(KKWB,STP(132)),(IVBH(1),STP(133)),     &
     &(GAMMA(1),STP(111)),(CDAWB(1),STP(42)),(EPSLON(1),DWASH(21))      &
     &,(CLTB(1),STP(22)),(CLWBT(1),BWH(21)),(DXACWB,STP(153))
      EQUIVALENCE (CMAH(1),STP(2)),(CMAWBT(1),BWH(121))                 &
     &,(CD0WBV,STP(155)),(CDWBT(1),BWH(1)),(CDWBTV(1),BWHV(1))          &
     &,(CD0WBT,STP(154)),(CMWBT(1),BWH(41))
      EQUIVALENCE (CDWB(1),BW(1))
      EQUIVALENCE (CLWB(1),BW(21)),(TANLE,AHT(62)),(DN,SBD(4))          &
     &,(CRSTAR,AHT(10)),(TAPEXP,AHT(27))                                &
     &,(CD0WB,SWB(4)),(SPANS,HTIN(3)),(ARSTAR,AHT(7)),(D1,SBD(5))
      EQUIVALENCE (D4311A(1),DUMYA(1)),(D4311A(136),DUMYB(1))
      DATA ROUTID/4HSUPW,4HBT  /,Q1211A/4H4.3.,4H1.2-,4H11A /,          &
     &                           Q1211B/4H4.3.,4H1.2-,4H11B /,          &
     & Q31210/4H4.3.,4H1.2-,4H10  /,Q44167/4H4.4.,4H1-80/,              &
     & Q1212A/4H4.3.,4H1.2-,4H12A /,                                    &
     & Q1212B/4H4.3.,4H1.2-,4H12B /
!
!                   FIGURE 4.3.1.2-10 KWB
!
      DATA TFIG10/0.0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.0/
      DATA DKWB10/1.0,1.08,1.16,1.26,1.36,1.46,1.56,1.67,1.78,1.89,2.0/
!
!                   FIGURE 4.3.1.2-10 KBW
!
      DATA DKBW10/0.0,.13,.29,.45,.62,.80,1.0,1.22,1.45,1.70,2.0/
!
!                   FIGURE 4.3.1.2-12A (KBW)
!
      DATA T4312A/0.0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.0/
      DATA D4312A/0.0,.11,.21,.31,.41,.51,.6,.7,.8,.9,1.0/
!
!                   FIGURE 4.3.1.2-12B (KWB)
!
      DATA T4312B/0.,.1,.2,.3,.4,.6,.8,1./
      DATA D4312B/1.,.975,.956,.947,.941,.950,.978,1.0/
!
!              FIGURE 4.4.1-80(A,B,AND C)
!
      DATA T4467/                                                       &
     & 0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,                             &
     & -4.0,-2.0,0.0,2.0,4.0,4*0.0,                                     &
     & 0.0,0.5,1.0/
      DATA D4467/                                                       &
     & 0.785,0.700,0.625,0.565,0.515,0.490,0.475,0.470,0.470,           &
     & 0.785,0.700,0.625,0.565,0.515,0.490,0.475,0.470,0.470,           &
     & 0.785,0.710,0.645,0.600,0.570,0.555,0.540,0.540,0.540,           &
     & 0.785,0.735,0.695,0.670,0.645,0.630,0.620,0.610,0.600,           &
     & 0.785,0.750,0.730,0.710,0.700,0.690,0.685,0.680,0.675,           &
     & 0.785,0.680,0.600,0.540,0.500,0.480,0.475,0.485,0.505,           &
     & 0.785,0.710,0.645,0.600,0.580,0.565,0.560,0.565,0.570,           &
     & 0.785,0.735,0.700,0.675,0.660,0.650,0.640,0.635,0.630,           &
     & 0.785,0.800,0.810,0.810,0.800,0.790,0.770,0.740,0.710,           &
     & 0.785,0.810,0.830,0.845,0.855,0.855,0.850,0.835,0.810,           &
     & 0.785,0.685,0.605,0.550,0.510,0.505,0.530,0.580,0.645,           &
     & 0.785,0.710,0.670,0.640,0.635,0.650,0.670,0.720,0.770,           &
     & 0.785,0.775,0.780,0.790,0.805,0.820,0.845,0.875,0.905,           &
     & 0.785,0.815,0.840,0.865,0.885,0.905,0.915,0.925,0.930,           &
     & 0.785,0.830,0.870,0.900,0.920,0.935,0.940,0.940,0.935/
!
      CANARD=WINGIN(101) .GT. 2.5
      NALPHA=NALPH
      NA1=NALPH
      DO 990 J=1,NALPH
         IF(HT(J+20).NE.UNUSED.OR.CLWB(J).NE.UNUSED)GO TO 990
         NA1=J-1
  990 END DO
      IF(TANLE.EQ.0.0)TANLE=.00001
      IF(KDEODA.NE.0.AND.KQOQIN.NE.0)GO TO 1000
      IF(JDETCH.EQ.0)RETURN
      IF(JDETCH.GT.0)NALPHA=JDETCH
      GO TO 1020
 1000 CONTINUE
      DO 1010 NN=1,NALPHA
 1010 HMACH(NN)=FLC(I+2)
 1020 NX=NXX+.5
      DCYL=(DN+D1)/2.
      MACH=FLC(I+2)
      BETA=SQRT(MACH**2-1.)
      RLB=XCOOR(NX)
      DD=2.0*(SPAN-SPANS)
      IF(NA1.LT.NALPHA)NALPHA=NA1
!
!   ***SUPERSONIC TAIL-BODY LIFT CURVE SLOPE,BODY IN PRESENCE OF TAIL***
!                         NON-TRIANGULAR TAILS
!
      IF(TAPEXP.EQ.0.0)GO TO 1080
      ARG1=BETA*ARSTAR*(1.0+TAPEXP)
      ARG2=1.+TANLE/BETA
      TRINO=ARG1*ARG2
      IF(TRINO.LE.4.)GO TO 1060
 1030 OLE=AHT(34)
      DX=RLB-XH-DD*AHT(38)-CRSTAR
      IF(DX.LE.(-CRSTAR))RKBW=0.
      IF(DX.LE.(-CRSTAR))GO TO 1050
      CALL INTKBW(MACH,OLE,CRSTAR,DD,DX,RKBW,RXAC)
 1050 KBW=RKBW/(RAD*BETA*(SREF/AHT(3))*CLAH(1)*(TAPEXP+1.)*             &
     &    (2.*SPAN/DD-1.))
      GO TO 1070
 1060 CONTINUE
      LGH(1)=11
      VAR(1)=DD/(2.*SPAN)
!
!                   FIGURE 4.3.1.2-10 KBW
!
      CALL INTERX(1,TFIG10,VAR,LGH,DKBW10,KBW,11,11,                    &
     &            0,0,0,0,0,0,0,0,Q31210,3,ROUTID)
 1070 CONTINUE
      GO TO 1090
!
!  ***SUPERSONIC TAIL-BODY LIFT CURVE SLOPE,BODY IN PRESENCE OF TAIL***
!                         TRIANGULAR TAIL
!
 1080 CONTINUE
      ARG=BETA*ARSTAR
      IF(ARG.GT.1.)GO TO 1030
      GO TO 1060
 1090 CONTINUE
!
!  ***SUPERSONIC TAIL-BODY LIFT CURVE SLOPE
!
      VAR(1)=(SPAN-SPANS)/SPAN
      LGH(1)=11
!
!                   FIGURE 4.3.1.2-10 KWB
!
      CALL INTERX(1,TFIG10,VAR,LGH,DKWB10,KWB,11,11,                    &
     &            0,0,0,0,0,0,0,0,Q31210,3,ROUTID)
      CLAHB=CLAH(1)*KWB
      CLABH=CLAH(1)*KBW
      IF(.NOT. CANARD) GO TO 1100
!
!     ********* COMPUTE WING VORTEX INTERFERENCE PARAMETERS *********
!
      BA=BETA*ARSTRW
      DBWO2=WSPAN-WSPANS
      LGH(1)=9
      LGH(2)=5
      LGH(3)=3
      VAR(1)=BETA*ARSTRW
      VAR(2)=A(120)*A(38)
      VAR(3)=TAPEXW
      CALL INTERX(3,T4467,VAR,LGH,D4467,YT,9,135,                       &
     &            0,0,0,0,1,1,1,0,Q44167,2,ROUTID)
      BVTO2=WSPANS*YT+DBWO2
      Y0=BVTO2
 1100 CONTINUE
      RCREO2=SPAN-SPANS
      DO 1120 J=1,NALPHA
         IF(.NOT. CANARD) GO TO 1110
         Z0=A(12)-(A(24)-A(80)*BVTO2)*TAN((FLC(J+22)+ALIW)/RAD)
         IVWH(J)=ALI(Z0,Y0,SPANS,RCREO2,TAPEXP)
         ANUM=WING(101)*HT(101)*QOQINF(J)*WKWB*SPANS*IVWH(J)
         ADEN=2.0*PI*ARSTAR*(BVTO2-DBWO2)
         DELTAT(J)=(ANUM/ADEN)*RAD*SREF/STAILE
         CLAWBT(J)=CLAWB+(CLAHB+CLABH)*QOQINF(J)+DELTAT(J)
          FACT(J+121)=-DELTAT(J)/((CLAHB+CLABH)*QOQINF(J))
         GO TO 1120
 1110    CLAWBT(J)=CLAWB+(CLAHB+CLABH)*(1.0-DEDALP(J))*QOQINF(J)
 1120 END DO
!
!     *********WING-BODY-TAIL LIFT AT ANGLE OF ATTACK ******************
!
      IF(ALIH.EQ.0.0.OR.(ALIH.EQ.UNUSED))GO TO 1130
!
!                   FIGURE 4.3.1.2-12A (KBW) INCIDENCE
!
      LGH(1)=11
      VAR(1)=(SPAN-SPANS)/SPAN
      CALL INTERX(1,T4312A,VAR,LGH,D4312A,KKBW,11,11,                   &
     &            0,0,0,0,0,0,0,0,Q1212A,3,ROUTID)
!
!                   FIGURE 4.3.1.2-12B (KWB) INCIDENCE
!
      LGH(1)=8
      CALL INTERX(1,T4312B,VAR,LGH,D4312B,KKWB,8,8,                     &
     &            0,0,0,0,0,0,0,0,Q1212B,3,ROUTID)
 1130 CLI=CLAH(1)*ALIH
      DETCL=0.0
      DCLOAL = 0.0
      XCBR4H=XH+AHT(161)
      CALL BODOWG(FLC(23),XCBR4H,RCREO2,SPAN,TAPEXP,                    &
     &            IVBH,GAMMA,NALPHA)
      ARG1=KWB+KBW
      ARG2=(KKWB+KKBW)*CLI
      ARG3=CLAH(1)*(DD/(2.*SPAN))
      SINAI= SIN(ALIH/RAD)
      COSAI=COS(ALIH/RAD)
      TANAI=TAN(ALIH/RAD)
      BD(58)=(HTIN(4)-HTIN(3))*AHT(62)*COSAI
      BD(84)=XCG-(XH+BD(58))
      BD(762)=ZH-BD(58)*TANAI
      BD(761)=STG(134)*AHT(10)
      BD(64)=BD(762)-BD(761)*SINAI-ZCG
      BD(63)=BD(84)-BD(761)*COSAI
      ICDWB=0
      IP=0
      IQ=0
      DO 1190 J=1,NALPHA
         CALL TBFUNX(FLC(J+22),YARG,CDAWB(J) ,NALPHA,FLC(23),BW(1),     &
     &               CCDWB,ICDWB,MI,NG,0,0,4HYARG,1,ROUTID)
         ALPAHT=FLC(J+22)-EPSLON(J)+ALIH
         ALPAT=(STG(J+32)*RAD-EPSLON(J))/RAD
         IF(CANARD) ALPAT=STG(J+32)
         CALL TBFUNX(ALPAT,CLH(J),DYDX,NALPHA,STG(33),HT(21),           &
     &               CAA,IP,MI,NG,0,0,4HCLH ,1,ROUTID)
         CALL TBFUNX(ALPAT,CLAHA(J),DYDX,NALPHA,STG(33),HT(101),        &
     &               CB,IQ,MI,NG,0,0,4HCLHA,1,ROUTID)
         DETCL=ARG3*ALPAHT   *IVBH(J)*GAMMA(J)*QOQINF(J)
         DCLOAL = ARG3*IVBH(J)*GAMMA(J)*QOQINF(J)
 1140    ALPA=FLC(J+22)-EPSLON(J)
         CLTB(J)=(ARG2+(CLH(J)-CLI)*ARG1)*QOQINF(J)*((MACH**2-1.0)/(    &
     &           HMACH(J)**2-1.0))**0.50
         IF(.NOT. CANARD) GO TO 1150
         CLWBT(J)=CLWB(J)+CLTB(J)+DETCL+DELTAT(J)*FLC(J+22)
         FACT(J+101)=0.0
         IF(ALPAHT .EQ. 0.0) GO TO 1160
         FACT(J+101)=(DCLOAL*EPSLON(J+20)                               &
     &               -DELTAT(J)*FLC(J+22))/(DCLOAL                      &
     &               +CLAHA(J)*ARG1*QOQINF(J)*((MACH**2-1.0)/(HMACH(J)  &
     &                **2-1.0))**0.5)
         GO TO 1160
 1150    CONTINUE
         CLWBT(J)=CLWB(J)+CLTB(J)+DETCL
 1160    CONTINUE
!
!     ********* CALCULATE (CM)ALPHA WBT **********
!
         IF(CANARD) ALPA=FLC(J+22)
         SA=SIN(ALPA/RAD)
         CA=COS(ALPA/RAD)
         DXACWB=CMAWB/CLAWB
         APART=(DXACWB)*((-CLWB(J)/RAD+CDAWB(J))*SIN(FLC(J+22)/RAD)+    &
     &         (CLAWB+CDWB(J)/RAD)*COS(FLC(J+22)/RAD))
         ZAC=BD(68)-ZCG    -BD(78)*SLG(134)*A(10)
         BPART=((ZAC)/CBARR)*((CLAWB+CDWB(J)/RAD)*SIN(FLC(J+22)         &
     &         /RAD)+(CLWB(J)/RAD-CDAWB(J))*COS(FLC(J+22)/RAD))
         IK=0
         CALL TBFUNX(ALPAT,CDHT,DCDDA,NALPHA,STG(33),HT(1),CC,IK,MI,NG, &
     &               0,0,4HCDHT,1,ROUTID)
         CLHT=(CLWBT(J)-CLWB(J))/QOQINF(J)
         DCLDA=CLAHB+CLABH
         IF(.NOT. CANARD) GO TO 1170
         DCLDA=DCLDA+DELTAT(J)/QOQINF(J)
 1170 CONTINUE
      CPART=(-CLHT+DCDDA)*SA/RAD
      DPART=( CLHT-DCDDA)*CA/RAD
      EPART=QOQINF(J)*(1.0-DEDALP(J))
      FPART=(DCLDA+CDHT/RAD)*SA
      GPART=(DCLDA+CDHT/RAD)*CA
      CMAH(J)=(BD(63)/CBARR)*(CPART+GPART)*EPART-(BD(64)/               &
     &         CBARR)*(FPART+DPART)*EPART
      IF(.NOT. CANARD) GO TO 1180
      CMAH(J)=CMAH(J)/(1.0-DEDALP(J))
 1180 CMAWBT(J)=APART-BPART+CMAH(J)
!
!     COMPUTE WING-BODY-TAIL PITCHING MOMENT INCLUDING INCIDENCE EFFECTS
!
      CMWBT(J)=CMAWBT(J)*FLC(J+22)+(SLG(136)/RAD)*(SWB(2)+SWB(37))*ALIW &
     &         +(STG(136)/RAD)*(STP(131)+STP(132))*ALIH*QOQINF(J)
!
!     ********* CALCULATE (CD)WBT ***********
!
      CD0WBT=CD0WB+CD0H
      CD0WBV=CD0WBT+CD0V+CD0VF
      CDWBT(J)=CDWB(J)+(CDHT   *COS(EPSLON(J)/RAD)+CLH(J)*              &
     &         SIN(EPSLON(J)/RAD))*QOQINF(J)
      CDWBTV(J)=CDWBT(J)+CD0V+CD0VF
 1190 END DO
!
!     *********CN(J) AND CA(J)*********
!
      DO 1200 J=1,NALPHA
         BWHV(J+120) = CMAWBT(J)
         BWHV(J+100) = CLAWBT(J)
         COSA=COS(FLC(J+22)/RAD)
         SINA=SIN(FLC(J+22)/RAD)
         CNWBT(J)=CLWBT(J)*COSA+CDWBT(J)*SINA
         CAWBT(J)=CDWBT(J)*COSA-CLWBT(J)*SINA
         BWHV(J+20) = CLWBT(J)
         BWHV(J+40)=CMWBT(J)
         CNWBTV(J)=CLWBT(J)*COSA+CDWBTV(J)*SINA
 1200 CAWBTV(J)=CDWBTV(J)*COSA-CLWBT(J)*SINA
      IF(TANLE .EQ. 0.00001)TANLE=0.0
      RETURN
      END
      SUBROUTINE SWITCH(LG,LXGL,LXGU,XAG,XG,NXG)
!
!     ----THIS SUBROUTINE SETS SWITCHES FOR THE INTERPOLATION-
!     ----EXTRAPOLATION SUBROUTINES
!
      DIMENSION XG(1)
      LOGICAL LG(7)
      DO 1000 I=1,7
         LG(I)=.FALSE.
 1000 END DO
      LG(6)=.TRUE.
      IF(XG(1).GT.XG(NXG))LG(6)=.FALSE.
!
!     ----TEST TO DETERMINE IF EXTRAPOLATION IS REQUIRED.
!
      IF(LG(6))GO TO 1010
!
!     ----HERE FOR DESCENDING XG TABLE
!
      IF(XAG.GT.XG(1))LG(3)=.TRUE.
      IF(XAG.LT.XG(NXG))LG(2)=.TRUE.
      GO TO 1020
!
!     ----HERE FOR ASCENDING XG TABLE
!
 1010 IF(XAG.GT.XG(NXG))LG(2)=.TRUE.
      IF(XAG.LT.XG(1))LG(3)=.TRUE.
 1020 IF(LG(2))GO TO 1030
      IF(.NOT.LG(3))GO TO 1050
      IF(LXGL.GE.0)LG(4)=.TRUE.
      IF(LXGL.LE.0)GO TO 1050
      GO TO 1040
 1030 IF(LXGU.GE.0)LG(4)=.TRUE.
      IF(LXGU.LE.0)GO TO 1050
 1040 LG(5)=.TRUE.
      LG(7)=.TRUE.
 1050 RETURN
      END
      SUBROUTINE SWRITE(LAST,FOR,NW,ICONT,NRPEAT,A,B,C,D,E,F,G,H,O,P,Q  &
     &                 ,R,S,T,NDMF,NAF)

! This version copied from the DD distribution
!***  CONTROLS NUMERIC OUTPUT FOR PRINTOUT, WRITES BLANKS,NA OR NDM
!
      DIMENSION A(1),B(1),C(1),D(1),E(1),F(1),G(1),H(1),O(1),P(1),Q(1)
      DIMENSION R(1),S(1),T(1),ICONT(1)
      DIMENSION Z(14),FOR(NW),ICPAT(14),FORM(60),FORSUB(21),IPPAT(14)
      CHARACTER*4 FOR,FORM,FORSUB
      REAL NDM,NA
      LOGICAL NDMF,NAF
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND

      DATA BLANK/4H    /,NDM/4HNDM /,NA/4HNA  /
      DATA FORSUB/                                                      &
     & ',2X ',',A4,','1X  ',',2X ',',A4,','2X  ',',3X ',',A4,','2X  ',  &
     & ',3X ',',A4,','3X  ',',4X ',',A4,','3X  ',',4X ',',A4,','4X  ',  &
     & ',5X ',',A4,','4X  '/

!                    STORE BASIC FORMAT

      DO 1000 I=1,NW
 1000 FORM(I)=FOR(I)
!
!              STORE ZEROS IN PREVIOUS PATTERN

      DO 1010 I=1,14
 1010 IPPAT(I)=0

!              STORE L-TH ELEMENT OF EACH ARRAY IN A---------------
!                   HORIZONTAL ROW ARRAY

      DO 1230 L=1,NRPEAT
          GO TO (1150,1140,1130,1120,1110,1100,1090,1080,1070,1060,1050,&
     & 1040,1030,1020          ),LAST
 1020     Z(14)=T(L)
 1030     Z(13)=S(L)
 1040     Z(12)=R(L)
 1050     Z(11)=Q(L)
 1060     Z(10)=P(L)
 1070     Z(9)=O(L)
 1080     Z(8)=H(L)
 1090     Z(7)=G(L)
 1100     Z(6)=F(L)
 1110     Z(5)=E(L)
 1120     Z(4)=D(L)
 1130     Z(3)=C(L)
 1140     Z(2)=B(L)
 1150     Z(1)=A(L)

!               CONSTRUCT FORMAT FOR HORIZONTAL ROW PRINT OUT

          DO 1220 I=1,LAST
              IF(Z(I).NE.UNUSED) GO TO 1160
                  ICPAT(I)=1
                  Z(I)=NDM
                  NDMF=.TRUE.
                  GO TO 1190
 1160         IF(Z(I).NE.-UNUSED) GO TO 1170
                  ICPAT(I)=1
                  Z(I)=BLANK
                  GO TO 1190
 1170         IF(Z(I).NE.2*UNUSED) GO TO 1180
                  ICPAT(I)=1
                  Z(I)=NA
                  NAF=.TRUE.
                  GO TO 1190
 1180         CONTINUE
                  ICPAT(I)=0
 1190         CONTINUE

!                COMPARE CURRENT PATTERN WITH PREVIOUS PATTERN

              IF(ICPAT(I).EQ.IPPAT(I)) GO TO 1220
              K=4*I-1
              IF(IPPAT(I).NE.0) GO TO 1200
                  J=ICONT(I)-6
                  J2=3*J-2
                  FORM(K)=FORSUB(J2)
                  FORM(K+1)=FORSUB(J2+1)
                  FORM(K+2)=FORSUB(J2+2)
                  GO TO 1210
 1200         CONTINUE
                  FORM(K)=FOR(K)
                  FORM(K+1)=FOR(K+1)
                  FORM(K+2)=FOR(K+2)
 1210         IPPAT(I)=ICPAT(I)
 1220     CONTINUE

!                         PRINT L-TH HORIZONTAL ROW

          WRITE(6,FORM)(Z(J),J=1,LAST)
 1230 CONTINUE
      RETURN
      END Subroutine Swrite
      SUBROUTINE SYNDIM
!
!***  CALCULATES SYNTHESIS DIMENSIONS FOR BODY ANALYSIS
!
      COMMON /BDATA/  BD(762)
      COMMON /WINGI/  CHRDTP,SSPNOP,SSPNE,SSPN,CHRDBP,CHRDR,SAVSI,SAVSO,&
     &                CHSTAT,ALPHAO,TWISTA,SSPNDD,DHDADI,DHDADO,TYPE,   &
     &                TOVC,DELTAY,XOVC,CLI,ALPHAI,CLALPA(20),           &
     &                CLMAX(20),CMO,LERI,LERO,CAMBER,TOVCO,XOVCO,CMOT,  &
     &                CLMAXL,CLAMO,TCEFF,KSHARP,SLOPE(6)
      COMMON /WINGD/  A(195)
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV,YF,        &
     &                PHIV, PHIF
      COMMON /HTI/    HTIN(154)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      BD(87)=2.*(SSPN-SSPNE)
      BD(78)= SIN(BD(77)/RAD)
      BD(79)= COS(BD(77)/RAD)
      BD(80)= BD(78)/BD(79)
      BD(66)= 0.5*BD(87)*A(62)*BD(79)
      BD(67)= BD(33)-(BD(65)+BD(66))
      A(173)=BD(67)
      BD(68)=BD(74)-BD(65)*BD(80)
      AHT(173) = XCG-(XH+(HTIN(4)-HTIN(3))*AHT(62)*COS(ALIH/RAD))
      RETURN
      END
      SUBROUTINE SYPBOD(I)
!
!***  COMPUTES SUPERSONIC BODY ALONE AERO
!
      COMMON /SUPBOD/ SBD(229)
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA
      COMMON /OPTION/ SR,CRBAR,RUFF,BLREF
      COMMON /IBODY/  PBODY,BODY(400)
      COMMON /BODYI/  NXX,XCOOR(20),S(20),PERIM(20),RADIUS(20),         &
     &                ZU(20),ZL(20),BNOSE,BTAIL,RLN,RLA,DS,             &
     &                ITYPE,METHOD,ELLIP
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /WINGI/  WINGIN(100)
      COMMON /HTI/    HTIN(154)
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ AHT(195)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(73), dumflgtcd(87)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS
      COMMON /BDATA/  BD(762)
      LOGICAL         FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS
      LOGICAL NOSCYL,NOSTAL,TAIL,NOSCT,FLARE
      REAL NXX,MC(20)
      REAL MACH
      DIMENSION CN(20),CA(20)
      DIMENSION CD(20)
      DIMENSION VAR(4),LGH(4),ALSCHD(20),RX(20),ALSCHR(20),             &
     &          CDC(20),CFLOW(20),CL(20),CM(20)
      DIMENSION REQ(20),CNVIS(20),CNPOT(20),CMVIS(20),CMPOT(20)
      EQUIVALENCE (REQ(1),BD(536)),(CNPOT(1),BD(556)),                  &
     & (CNVIS(1),BD(576)),(CMPOT(1),BD(596)),(CMVIS(1),BD(616))
      EQUIVALENCE  (CMA,SBD(110)),                                      &
     &(CN(1),BODY(61)),(CA(1),BODY(81))
      EQUIVALENCE (CDN2P,SBD(107)),(CDN2,SBD(108)),                     &
     &(CD(1),BODY(1)),(SS,SBD(111)),(RNB,SBD(112)),                     &
     &(RLCOFF,SBD(113)),(CF,SBD(114)),(CDF,SBD(115)),(CDANF,SBD(116)),  &
     &(CDANC,SBD(117)),(CDAB,SBD(118)),(DMAX,SBD(120)),(CDA,SBD(119)),  &
     &(CDD,SBD(121)),(CPB,SBD(122)),(CDB,SBD(123)),(CDO,SBD(124))
      EQUIVALENCE (ALSCHD (1),FLC(23)),(THETAT,SBD(135))
      EQUIVALENCE (RLBP,SBD(1)),(RLB,SBD(2)),(RLBT,SBD(3)),(DN,SBD(4))  &
     &,(D1,SBD(5)),(D2,SBD(6)),(BETA,SBD(7)),(FA,SBD(8)),(FB,SBD(9)),   &
     &(FN,SBD(10)),(XCPLB,SBD(11)),(CMAOC,SBD(12)),(DELCMA,SBD(13)),    &
     &(THETAB,SBD(14)),(DELCNA,SBD(15)),(THETAF,SBD(16)),(CNAOC,SBD(17))&
     &,(CNA,SBD(18)),(SB,SBD(19)),(SP,SBD(20)),(ALSCHR(1),SBD(21))      &
     &,(MC(1),SBD(41)),(CDC(1),SBD(61)),(CFLOW(1),SBD(81))              &
     &,(CM(1),BODY(41)),(XCPBLB,SBD(101)),(CMAP,SBD(103))               &
     &,(CL(1),BODY(21)),(XC,SBD(105)),(VB,SBD(106))
      DIMENSION ROUTID(2),XVSR(2),Q1121A(3),Q1121B(3),Q1122A(3),        &
     & Q1122B(3),Q1217B(3),Q2118A(3),Q22119(3),Q2120A(3),Q23127(3),     &
     & Q23128(3),Q15127(3),Q3144A(3),Q23160(3),Q23150(3),Q23155(3)      &
     & ,Q2118B(3)
      DIMENSION T4227(22),D4227(120),T4228(20),D4228(100)
      DIMENSION DUMYC(165),DUMYD(110) ,D4355(275)
      DIMENSION T44A(9),D44A(18),T4360(13),D4360(13),T5055(27)
      DIMENSION D4350(275),DUMYA(165),DUMYB(110)
      DIMENSION T4222A(8),D4222A(8),T4222B(6),D4222B(6),T4217B(18),     &
     &          D4217B(18)
      DIMENSION T4218A(18),DL218A(54),DR218A(54),T4218B(14),DL218B(42), &
     &          DR218B(42),T42119(18),D42119(77),T4221A(19),D4221A(88), &
     &          T4221B(18),D4221B(80)
      DIMENSION DUMY1(90),DUMY2(108),D4220A(198),T4220A(29)
      DIMENSION X27M(4),X27I(4),C27(6)
      EQUIVALENCE (D4355(1),DUMYC(1)),(D4355(166),DUMYD(1))
      EQUIVALENCE (DUMYA(1),D4350(1)),(DUMYB(1),D4350(166))
      EQUIVALENCE (D4220A(1),DUMY1(1)),(D4220A(91),DUMY2(1))
      DATA ROUTID/4HSUPB,4HOD  /,XVSR/4HX VS,4H. R /,                   &
     & Q1121A/4H4.2.,4H1.1-,4H21A /,Q1217B/4H4.2.,4H1.2-,4H35B /,       &
     & Q1121B/4H4.2.,4H1.1-,4H21B /,Q2118A/4H4.2.,4H2.1-,4H23A /,       &
     & Q1122A/4H4.2.,4H1.1-,4H22A /,Q2118B/4H4.2.,4H2.1-,4H23B /,       &
     & Q1122B/4H4.2.,4H1.1-,4H22B /,Q22119/4H4.2.,4H2.1-,4H24  /,       &
     & Q2120A/4H4.2.,4H2.1-,4H25A /,Q23127/4H4.2.,4H3.1-,4H27  /,       &
     & Q15127/4H4.1.,4H5.1-,4H27  /,Q23128/4H4.2.,4H3.1-,4H28  /,       &
     & Q3144A/4H4.2.,4H3.1-,4H44A /,Q23160/4H4.2.,4H3.1-,4H60  /,       &
     & Q23150/4H4.2.,4H3.1-,4H50  /,                                    &
     & Q23155/4H4.2.,4H3.1-,4H55  /
!
!                FIGURE 4.1.5.1-27
!
      DATA X27M/0.0,1.0,2.0,3.0/
      DATA X27I/1.57780,1.67221,1.98509,2.28874/
      DATA I27/0/
!
!               FIGURE 4.2.2.1-23A (LEFT SIDE)
!
      DATA T4218A                                                       &
     &  / 0., 0.2, 0.4, 0.6, 0.8, 1.0 , 3*0.0,                          &
     &    0.0, 0.4, 0.8, 1.2, 1.6, 2.0, 3.0, 4.0, 5.0 /
      DATA DL218A                                                       &
     & /  0.543,  0.542,  0.541,  0.540,  0.534,  0.526,                &
     &    0.400,  0.409,  0.418,  0.430,  0.441,  0.450,                &
     &    0.305,  0.328,  0.350,  0.369,  0.387,  0.400,                &
     &    0.238,  0.265,  0.295,  0.318,  0.339,  0.356,                &
     &    0.198,  0.221,  0.246,  0.274,  0.298,  0.320,                &
     &    0.160,  0.185,  0.210,  0.239,  0.262,  0.288,                &
     &    0.065,  0.095,  0.122,  0.150,  0.177,  0.210,                &
     &    0.000,  0.005,  0.035,  0.062,  0.089,  0.130,                &
     &    0.000,  0.000,  0.000,  0.000,  0.002,  0.050  /
!
!               FIGURE 4.2.2.1-23A (RIGHT SIDE)
!
      DATA DR218A                                                       &
     &  / 0.445,  0.464,  0.485,  0.500,  0.518,  0.526,                &
     &    0.448,  0.455,  0.460,  0.460,  0.459,  0.450,                &
     &    0.460,  0.449,  0.438,  0.424,  0.412,  0.400,                &
     &    0.450,  0.430,  0.412,  0.394,  0.375,  0.356,                &
     &    0.432,  0.410,  0.388,  0.365,  0.343,  0.320,                &
     &    0.420,  0.394,  0.369,  0.340,  0.314,  0.288 ,               &
     &    0.388,  0.354,  0.322,  0.278,  0.244,  0.210,                &
     &    0.357,  0.314,  0.273,  0.216,  0.171,  0.130,                &
     &    0.325,  0.274,  0.225,  0.154,  0.100,  0.050  /
!
!              FIGURE 4.2.2.1-23B (LEFT SIDE)
!
      DATA T4218B                                                       &
     &  / 0., 0.2, 0.4, 0.6, 0.8, 1.0  , 0.,                            &
     &    0.0, 0.5, 1.0, 2.0, 3.0, 4.0, 5.0 /
      DATA DL218B                                                       &
     & /  .665,  .665,  .665,  .665,  .665,  .665,                      &
     &    .425,  .492,  .539,  .550,  .550,  .550,                      &
     &    .330,  .370,  .405,  .438,  .459,  .470,                      &
     &    .184,  .215,  .250,  .284,  .318,  .350,                      &
     &    .060,  .097,  .133,  .170,  .206,  .240,                      &
     &    .000,  .000,  .044,  .083,  .127,  .170,                      &
     &    .000,  .000,  .000,  .020,  .063,  .105  /
!
!              FIGURE 4.2.2.1-23B (RIGHT SIDE)
!
      DATA DR218B                                                       &
     & /  .665,  .665,  .665,  .665,  .665,  .665,                      &
     &    .480,  .500,  .519,  .536,  .546,  .550,                      &
     &    .338,  .388,  .430,  .458,  .471,  .470,                      &
     &    .338,  .372,  .394,  .394,  .375,  .350,                      &
     &    .410,  .375,  .341,  .308,  .272,  .240,                      &
     &    .377,  .338,  .294,  .251,  .211,  .170,                      &
     &    .342,  .300,  .246,  .194,  .146,  .100   /
!
!              FIGURE 4.2.2.1-24
!
      DATA T42119                                                       &
     & /  0., .05, .1, .15, .2, .25, .3, .35, .4, .45, .5  ,            &
     &   0., .2, .4, .6, .8, .9, 1.  /
      DATA D42119                                                       &
     & /.320, .348, .365, .394, .439, .480, .504, .518, .529, .537,.541,&
     &  .376, .400, .429, .468, .518, .543, .558, .567, .574, .579,.582,&
     &  .417, .445, .486, .544, .573, .587, .596, .603, .607, .610,.611,&
     &  .440, .486, .564, .600, .614, .621, .626, .630, .632, .633,.634,&
     &  .476, .580, .627, .638, .643, .646, .649, .651, .652, .653,.653,&
     &  .485, .632, .648, .653, .655, .657, .659, .660, .661, .661,.661,&
     &  .667, .667, .667, .667, .667, .667, .667, .667, .667, .667,.667/
!
!              FIGURE 4.2.2.1-25A
!
      DATA T4220A                                                       &
     & /    5.0, 10., 15., 20., 25., 30., 35., 40., 45., 50., 55., 60., &
     &  65.,70., 75., 80., 85., 90.  ,                                  &
     &   0., .1, .2, .3, .4, .5, .6, .7, .8, .9, 1.0  /
      DATA DUMY1                                                        &
     & / -4.03,-3.25,-2.48,-1.80,-1.40,-1.14,-0.95,-0.80,-0.67,-0.56,   &
     &   -0.47,-0.39,-0.32,-0.25,-0.20,-0.13,-0.07,0.0,                 &
     &   -4.03,-3.02,-2.10,-1.60,-1.24,-1.01,-0.85,-0.72,-0.61,-0.52,   &
     &   -0.44,-0.37,-0.30,-0.24,-0.19,-0.12,-0.06,0.0,                 &
     &   -4.03,-2.70,-1.80,-1.34,-1.08,-0.90,-0.77,-0.66,-0.57,-0.49,   &
     &   -0.42,-0.36,-0.29,-0.23,-0.18,-0.11,-0.06,0.0,                 &
     &   -4.03,-2.10,-1.46,-1.10,-0.90,-0.76,-0.67,-0.59,-0.51,-0.46,   &
     &   -0.40,-0.34,-0.28,-0.22,-0.17,-0.10,-0.06,0.0,                 &
     &   -4.03,-1.67,-1.15,-0.90,-0.73,-0.63,-0.57,-0.51,-0.46,-0.41,   &
     &   -0.36,-0.31,-0.26,-0.21,-0.16,-0.10,-0.05,0.0  /
      DATA DUMY2                                                        &
     & / -2.40,-1.24,-0.85,-0.68,-0.58,-0.52,-0.48,-0.43,-0.40,-0.36,   &
     &   -0.32,-0.29,-0.24,-0.20,-0.15,-0.10,-0.05,0.0,                 &
     &   -1.60,-0.84,-0.61,-0.50,-0.44,-0.41,-0.38,-0.35,-0.33,-0.31,   &
     &   -0.28,-0.25,-0.22,-0.18,-0.14,-0.09,-0.04,0.0,                 &
     &   -0.90,-0.52,-0.39,-0.33,-0.31,-0.30,-0.29,-0.28,-0.27,-0.25,   &
     &   -0.23,-0.20,-0.18,-0.14,-0.11,-0.08,-0.04,0.0,                 &
     &   -0.40,-0.26,-0.22,-0.20,-0.20,-0.20,-0.19,-0.19,-0.18,-0.18,   &
     &   -0.17,-0.15,-0.13,-0.11,-0.08,-0.05,-0.03,0.0,                 &
     &   -0.12,-0.09,-0.08,-0.09,-0.09,-0.10,-0.10,-0.10,-0.10,-0.10,   &
     &   -0.09,-0.08,-0.07,-0.06,-0.04,-0.03,-0.02,0.0,                 &
     &   18*0.0 /
!
!             FIGURE 4.2.1.1-21A
!
      DATA T4221A/                                                      &
     &    0.0, .4, .6, .8, 1.0, 1.1, 1.25, 1.43, 1.667, 2.0, 10.0 ,     &
     &    0.0, 0.4, 0.8, 1.2, 2.0, 3.0, 4.0, 5.0  /
      DATA D4221A/                                                      &
     & 2.25,2.46,2.42,2.33,2.21,2.14,2.07,1.99,1.91,1.83,1.43,          &
     & 2.25,2.63,2.69,2.71,2.66,2.61,2.55,2.48,2.39,2.30,1.85,          &
     & 2.25,2.74,2.87,2.93,2.93,2.91,2.87,2.78,2.68,2.56,1.96,          &
     & 2.25,2.78,2.95,3.04,3.09,3.08,3.06,2.96,2.86,2.71,1.96,          &
     & 2.25,2.81,3.01,3.13,3.25,3.27,3.25,3.18,3.06,2.78,1.38,          &
     & 2.25,2.83,3.04,3.19,3.31,3.33,3.33,3.26,3.14,2.87,1.52,          &
     & 2.25,2.83,3.04,3.22,3.34,3.36,3.35,3.30,3.18,2.94,1.74,          &
     & 2.25,2.83,3.04,3.22,3.34,3.36,3.35,3.30,3.18,2.94,1.74 /
!
!            FIGURE 4.2.1.1-21B
!
      DATA T4221B/                                                      &
     &    0.0, .4, .6, .678, .8, .9, 1.0, 1.25, 2.0, 10.0 ,             &
     &     .0, .4, .8, 1.2, 2.0, 3.0, 4.0, 5.0  /
      DATA D4221B/                                                      &
     &    2.08, 1.96, 1.87, 1.84, 1.84, 1.85, 1.85, 1.85, 1.85, 1.85,   &
     &    2.64, 2.59, 2.55, 2.53, 2.47, 2.42, 2.37, 2.35, 2.35, 2.43,   &
     &    2.62, 2.77, 2.79, 2.80, 2.80, 2.80, 2.78, 2.76, 2.76, 2.77,   &
     &    2.51, 2.84, 2.95, 2.98, 3.04, 3.07, 3.08, 3.04, 3.00, 2.94,   &
     &    2.35, 2.86, 3.04, 3.10, 3.20, 3.24, 3.24, 3.28, 3.32, 3.43,   &
     &    2.36, 2.90, 3.10, 3.18, 3.28, 3.30, 3.31, 3.38, 3.47, 3.62,   &
     &    2.37, 2.92, 3.14, 3.25, 3.35, 3.36, 3.37, 3.47, 3.61, 3.80,   &
     &    2.38, 2.95, 3.19, 3.33, 3.40, 3.41, 3.42, 3.56, 3.75, 3.98  /
!
!                   FIGURE 4.2.1.1-22A
!
      DATA T4222A/0.0,.5,1.0,1.25,1.50,1.75,2.0,2.5/
      DATA D4222A/0.0,-.88,-1.44,-1.64,-1.80,-1.90,-1.97,-2.00/
!
!                   FIGURE 4.2.1.1-22B
!
      DATA T4222B/1.0,1.4,1.8,2.2,2.6,3.0/
      DATA D4222B/0.0,2.0,4.5,7.7,11.6,16.0/
!
!                   FIGURE 4.2.1.2-35B
!
      DATA T4217B/0.0,.25,.30,.35,.4,.5,.6,.7,.75,.80,.85,1.0,1.111,    &
     &1.25,1.666,2.5,3.33,10./
      DATA D4217B/1.2,1.2,1.215,1.235,1.265,1.36,1.5,1.67,1.735,1.77,   &
     &1.79,1.785,1.74,1.65,1.47,1.355,1.315,1.255/
!
!                   FIGURE 4.2.3.1-27
!
      DATA T4227/                                                       &
     &0.0,.05,.15,.25,.35,.45,.55,.65,.70,.80,.90,1.0,                  &
     &1.,2.,3.,4.,5.,6.,8.,10.,16.,20./
      DATA D4227/                                                       &
     &4.68,3.55,2.41,1.63,1.05,0.63,0.38,0.20,0.14,0.05,.00,0.0,        &
     &4.68,3.72,2.73,1.96,1.39,0.91,0.58,0.33,0.25,0.09,.01,0.0,        &
     &4.68,3.81,2.90,2.17,1.56,1.06,0.68,0.40,0.30,0.13,.02,0.0,        &
     &4.68,3.89,3.01,2.30,1.70,1.19,0.78,0.45,0.34,0.16,.03,0.0,        &
     &4.68,3.93,3.15,2.42,1.80,1.28,0.85,0.50,0.38,0.18,.04,0.0,        &
     &4.68,3.97,3.25,2.54,1.90,1.35,0.90,0.55,0.41,0.20,.05,0.0,        &
     &4.68,4.06,3.36,2.69,2.04,1.47,1.00,0.60,0.45,0.22,.06,0.0,        &
     &4.68,4.14,3.47,2.80,2.15,1.57,1.06,0.65,0.49,0.24,.07,0.0,        &
     &4.68,4.22,3.65,3.00,2.32,1.71,1.17,0.73,0.55,0.28,.08,0.0,        &
     &4.68,4.34,3.80,3.16,2.48,1.82,1.25,0.80,0.60,0.30,.09,0.0/
!
!                   FIGURE 4.2.3.1-28
!
      DATA T4228/0.0,.05,.15,.30,.40,.50,.60,.75,.85,1.0,               &
     &1.,2.,3.,4.,5.,6.,8.,10.,15.,20./
      DATA D4228/                                                       &
     &0.45,0.58,     0.55,0.41,0.30,0.18,0.11,.060,.030,0.0,            &
     &1.75,1.50,      1.18,0.80,0.58,0.40,0.25,.065,.035,0.0,           &
     &2.49,2.00,     1.52,1.00,0.70,0.48,0.30,.070,.040,0.0,            &
     &3.00,2.35,     1.78,1.15,0.82,0.56,0.34,.075,.045,0.0,            &
     &3.35,2.65,     1.95,1.25,0.90,0.61,0.39,.080,.055,0.0,            &
     &3.72,2.93,     2.10,1.36,1.00,0.67,0.42,.085,.060,0.0,            &
     &4.25,3.25,     2.39,1.50,1.08,0.73,0.48,.095,.065,0.0,            &
     &4.90,3.55,     2.55,1.62,1.14,0.80,0.50,.100,.075,0.0,            &
     &5.10,4.10,     2.90,1.88,1.35,0.90,0.58,.190,.085,0.0,            &
     &5.50,4.45,     3.12,2.01,1.43,0.98,0.62,.250,.100,0.0/
!
!                   FIGURE 4.2.3.1-44A
!
      DATA T44A/ 0.0,.05,.10,.20,.4,1.0,                                &
     &.5,1.,2./
      DATA D44A/                                                        &
     &2.40,2.12,1.94,1.63,1.16,0.0,                                     &
     &1.30,1.18,1.08,0.90,0.65,0.0,                                     &
     &0.64,0.58,0.53,0.44,0.31,0.0/
!
!                   FIGURE 4.2.3.1-60
!
      DATA T4360/1.00,1.125,1.25,1.50,2.0,2.5,3.0,3.5,4.0,4.5,          &
     &5.0,5.5,6.0/
      DATA D4360/.178,.215,.20,.178,.144,.118,.097,.080,.068,           &
     &.057,.049,.042,.037/
!
!                   FIGURE 4.2.3.1-50A-E
!
      DATA T5055/                                                       &
     &1.0,1.5,2.0,2.5,3.0,3.5,4.0,4.5,5.0,5.5,6.0,                      &
     &0.2,0.4,0.6,0.8,1.0,6*0.0,                                        &
     &2.0,3.0,4.0,5.0,6.0/
      DATA DUMYA/                                                       &
     &-.055,-.055,-.055,-.055,-.054,-.052,-.048,-.042,-.037,-.031,-.025,&
     &-.055,-.055,-.055,-.055,-.054,-.052,-.048,-.042,-.037,-.031,-.025,&
     &-.055,-.055,-.055,-.055,-.054,-.052,-.048,-.042,-.037,-.031,-.025,&
     &-.118,-.118,-.118,-.103,-.088,-.075,-.064,-.054,-.046,-.038,-.032,&
     &-.211,-.182,-.147,-.118,-.097,-.081,-.069,-.059,-.050,-.042,-.035,&
     &-.005,-.005,-.005,-.005,-.005,-.005,-.005,-.005,-.005,-.006,-.006,&
     &-.031,-.031,-.031,-.031,-.031,-.031,-.031,-.028,-.026,-.024,-.022,&
     &-.069,-.069,-.069,-.069,-.067,-.058,-.050,-.043,-.037,-.032,-.026,&
     &-.111,-.111,-.111,-.105,-.089,-.073,-.061,-.051,-.044,-.037,-.030,&
     &-.210,-.180,-.145,-.118,-.096,-.080,-.068,-.058,-.050,-.042,-.036,&
     &-.024,-.024,-.024,-.024,-.024,-.024,-.024,-.023,-.021,-.017,-.012,&
     &-.044,-.044,-.044,-.044,-.044,-.043,-.040,-.036,-.032,-.028,-.024,&
     &-.075,-.075,-.075,-.075,-.071,-.062,-.054,-.046,-.040,-.035,-.030,&
     &-.112,-.112,-.111,-.101,-.087,-.074,-.062,-.052,-.045,-.038,-.032,&
     &-.210,-.180,-.144,-.117,-.097,-.082,-.069,-.059,-.050,-.042,-.035/
      DATA DUMYB/                                                       &
     &-.030,-.030,-.030,-.030,-.030,-.030,-.030,-.031,-.029,-.026,-.023,&
     &-.050,-.050,-.050,-.050,-.052,-.050,-.046,-.040,-.035,-.031,-.027,&
     &-.080,-.080,-.080,-.081,-.074,-.065,-.056,-.048,-.041,-.035,-.030,&
     &-.112,-.112,-.112,-.102,-.087,-.074,-.062,-.053,-.045,-.038,-.033,&
     &-.210,-.140,-.146,-.118,-.098,-.082,-.069,-.058,-.050,-.043,-.036,&
     &-.033,-.033,-.033,-.033,-.033,-.033,-.033,-.032,-.029,-.026,-.024,&
     &-.058,-.058,-.058,-.058,-.058,-.054,-.048,-.042,-.037,-.033,-.029,&
     &-.084,-.084,-.084,-.084,-.074,-.065,-.056,-.049,-.042,-.036,-.031,&
     &-.116,-.116,-.116,-.104,-.088,-.074,-.062,-.052,-.045,-.039,-.033,&
     &-.211,-.180,-.146,-.118,-.097,-.081,-.069,-.058,-.050,-.042,-.036/
!
!                   FIGURE 4.2.3.1-55 A-E
!
      DATA DUMYC/                                                       &
     &-.026,-.026,-.026,-.026,-.026,-.026,-.027,-.025,-.023,-.021,-.019,&
     &-.042,-.042,-.042,-.042,-.042,-.042,-.038,-.033,-.027,-.021,-.016,&
     &-.065,-.065,-.065,-.065,-.064,-.058,-.051,-.043,-.035,-.028,-.020,&
     &-.118,-.118,-.118,-.100,-.083,-.070,-.060,-.051,-.043,-.036,-.030,&
     &-.211,-.180,-.144,-.118,-.097,-.081,-.068,-.057,-.049,-.041,-.035,&
     &-.030,-.030,-.030,-.030,-.030,-.030,-.030,-.030,-.030,-.030,-.030,&
     &-.046,-.046,-.046,-.046,-.046,-.045,-.042,-.038,-.035,-.033,-.030,&
     &-.070,-.070,-.070,-.070,-.068,-.060,-.053,-.046,-.040,-.036,-.032,&
     &-.117,-.117,-.117,-.101,-.085,-.072,-.061,-.052,-.044,-.040,-.034,&
     &-.210,-.180,-.144,-.118,-.097,-.081,-.068,-.058,-.049,-.042,-.035,&
     &-.032,-.032,-.032,-.032,-.032,-.032,-.032,-.032,-.030,-.023,-.017,&
     &-.050,-.050,-.050,-.050,-.050,-.050,-.047,-.042,-.037,-.033,-.030,&
     &-.074,-.074,-.074,-.074,-.071,-.063,-.055,-.048,-.041,-.036,-.032,&
     &-.106,-.106,-.107,-.099,-.086,-.074,-.063,-.053,-.045,-.040,-.036,&
     &-.210,-.180,-.144,-.118,-.098,-.082,-.069,-.059,-.050,-.043,-.037/
      DATA DUMYD/                                                       &
     &-.038,-.038,-.038,-.038,-.038,-.038,-.037,-.034,-.032,-.030,-.028,&
     &-.060,-.060,-.060,-.060,-.059,-.054,-.048,-.042,-.038,-.034,-.030,&
     &-.079,-.079,-.079,-.078,-.073,-.064,-.055,-.048,-.041,-.036,-.031,&
     &-.108,-.108,-.108,-.100,-.085,-.073,-.062,-.053,-.045,-.039,-.033,&
     &-.210,-.180,-.145,-.118,-.097,-.082,-.068,-.059,-.050,-.043,-.036,&
     &-.050,-.050,-.050,-.050,-.049,-.046,-.042,-.038,-.033,-.029,-.027,&
     &-.068,-.068,-.068,-.068,-.064,-.057,-.050,-.044,-.038,-.033,-.030,&
     &-.084,-.084,-.084,-.083,-.076,-.067,-.058,-.049,-.042,-.036,-.032,&
     &-.106,-.106,-.106,-.101,-.087,-.074,-.063,-.053,-.045,-.038,-.034,&
     &-.211,-.180,-.146,-.118,-.097,-.081,-.068,-.058,-.049,-.042,-.035/
!
      NX=NXX+.5
      RNFS=FLC(I+42)
      NOSCYL=.FALSE.
      NOSTAL=.FALSE.
      RLBP=RLN+RLA
      RLB=XCOOR(NX)
      RLBT=RLB-RLBP
      IF(BTAIL.NE.1.AND.BTAIL.NE.2.)GO TO 1000
      TAIL=.TRUE.
      GO TO 1010
 1000 TAIL=.FALSE.
      RLBT=0.0
 1010 LOOP=2
      IF(TAIL.AND.(RLA.EQ.0.0))NOSTAL=.TRUE.
      IF(TAIL.AND.(RLA.NE.0.0))LOOP=3
      IF(.NOT.TAIL.AND.(RLA.EQ.0.0))LOOP=1
      LGH(1)=NX
      DO 1110 K=1,LOOP
         GO TO(1020,1030,1040),K
 1020     VAR(1)=RLN
          GO TO 1050
 1030     VAR(1)=RLBP
          IF(NOSTAL)VAR(1)=RLB
          GO TO 1050
 1040     VAR(1)=RLB
 1050     CALL INTERX(1,XCOOR,VAR,LGH,RADIUS,DIA,NX,NX,                 &
     &                0,0,0,0,0,0,0,0,XVSR,2,ROUTID)
         GO TO(1060,1070,1100),K
 1060     DN=DIA*2.
          D1 = DN
          D2=DN
          GO TO 1110
 1070     IF(NOSTAL)GO TO 1090
          IF(LOOP.EQ.2)GO TO 1080
          D1=DIA*2.
          GO TO 1110
 1080     NOSCYL=.TRUE.
          D1=DIA*2.
          D2=D1
          GO TO 1110
 1090     D1=DN
          D2=DIA*2.
          GO TO 1110
 1100     NOSCT=.TRUE.
         D2=DIA*2.
 1110 END DO
      IF(TRANSN)GO TO 1120
      MACH=FLC(I+2)
      BETA=SQRT(MACH**2-1.)
      GO TO 1130
 1120 MACH = 1.4
      BETA = 0.98
!
!  ***BODY SUPERSONIC LIFT CURVE SLOPE***
!
 1130 DCYL=(DN+D1)/2.0
      IF(D2.EQ.0.0)D2=0.3*DCYL
      FA=RLA/DCYL
      FN=RLN/DN
      VAR(1)=BETA/FN
      VAR(2)=FA/FN
      LGH(2)=8
      IF(BNOSE.EQ.1.) GO TO 1140
!
!                   FIGURE 4.2.1.1-21A (CNA FOR OGIVE CYLINDER)
!
      LGH(1)=11
      CALL INTERX(2,T4221A,VAR,LGH,D4221A,CNAOC,11,88,                  &
     &            1,0,0,0,2,2,0,0,Q1121A,3,ROUTID)
      GO TO 1150
!
!                   FIGURE 4.2.1.1-21B (CNA FOR CONE CYLINDER)
!
 1140 LGH(1)=10
      CALL INTERX(2,T4221B,VAR,LGH,D4221B,CNAOC,10,80,                  &
     &            1,0,0,0,1,2,0,0,Q1121B,3,ROUTID)
 1150 CONTINUE
      IF(.NOT.TAIL)GO TO 1170
      IF(D2/D1.GT.1.)GO TO 1160
!
!***  HERE FOR BOATTAIL
!
      THETAB=ATAN(.5*(D1-D2)/RLBT)
      THETAT=THETAB
      FB=RLBT/D1
      VAR(1)=FB/BETA
!
!                   FIGURE 4.2.1.1-22A(INCREMENT IN CNA DUE TO BOATTAIL)
!
      LGH(1)=8
      CALL INTERX(1,T4222A,VAR,LGH,D4222A,DCD1D2,8,8,                   &
     &            0,0,0,0,0,0,0,0,Q1122A,3,ROUTID)
      DELCNA=DCD1D2*(1.-(D2/D1)**2)
      GO TO 1180
 1160 CONTINUE
!
!                   FIGURE 4.2.1.1-22B(INCREMENT IN CNA DUE TO FLARE)
!
      VAR(1)=D2/D1
      LGH(1)=6
      CALL INTERX(1,T4222B,VAR,LGH,D4222B,DCCOS,6,6,                    &
     &            0,0,0,0,2,0,0,0,Q1122B,3,ROUTID)
      ARG=.5*(D2-D1)/RLBT
      THETAF=ATAN(ARG)
      SBD(102)=THETAF
      THETAT=THETAF
      DELCNA=DCCOS*COS(THETAF)**2
      GO TO 1180
 1170 DELCNA=0.0
 1180 CNA =(CNAOC+DELCNA)*PI*D1**2/(4.*RAD*SR)
      IF(TRANSN) GO TO 1200
      SB=PI*D2**2/4.
      A1 = SB
      IF(ELLIP .LE. UNUSED) ELLIP = 1.0
      IF(ELLIP .EQ. 1.0) A1 = CNA*SR*RAD/2.0
      CALL TRAPZ(RADIUS,NX,XCOOR,SP,1)
      SP=SP*2.
!
!  ***SUPERSONIC BODY LIFT VS ANGLE OF ATTACK***
!
      DO 1190 J=1,NALPHA
         ALSCHR(J)=ALSCHD (J)/RAD
         MC(J)=MACH*ABS(SIN(ALSCHR(J)))
!
!                   FIGURE 4.2.1.2-35B(CDC)
!
         VAR(1)=MC(J)
         LGH(1)=18
         CALL INTERX(1,T4217B,VAR,LGH,D4217B,CDC(J),18,18,              &
     &               0,0,0,0,0,0,0,0,Q1217B,3,ROUTID)
         CFLOW(J)=CDC(J)*SP*SIN(ALSCHR(J))**2/SR
         IF(ALSCHR(J) .LT. 0.0) CFLOW(J) = -CFLOW(J)
         IF(ELLIP.LT.1.)AOB=1./ELLIP
         IF(ELLIP.GE.1.)AOB=ELLIP
         IF(ELLIP.GE.1.)CNOCNS=1./AOB
         IF(ELLIP.LT.1.)CNOCNS=AOB
         CNOCNN=1.0
         IF(ELLIP.LT.1.)CNOCNN=1.5*SQRT(AOB)*(-1./AOB**2/(1.-1./AOB**2) &
     &       **1.5*ALOG(AOB*(1.+SQRT(1.-1./AOB**2)))+1./(1.-1./AOB**2))
         IF(ELLIP.GT.1.)CNOCNN=1.5*SQRT(1./AOB)*(AOB**2/(AOB**2-1.)**1.5&
     &                 *ATAN(SQRT(AOB**2-1.))-1./(AOB**2-1.))
         CNPOT(J)=SIN(2.*ALSCHR(J))*COS(ALSCHR(J)/2.)*A1*CNOCNS/SR
         CNVIS(J)=CFLOW(J)*CNOCNN
 1190 CN(J)=SIN(2.*ALSCHR(J))*COS(ALSCHR(J)/2.)*A1*CNOCNS/SR            &
     &  + CFLOW(J)*CNOCNN
 1200 CONTINUE
      LGH(1)=6
!
!  ***SUPERSONIC PITCHING MOMENT SLOPE***
!
      LGH(2)=9
      VAR(1)=BETA/FN
      VAR(2)=FA/FN
      IF(BNOSE.EQ.1.)GO TO 1220
      IF(VAR(1).GT.1.)GO TO 1210
!
!                   FIGURE 4.2.2.1-23A LEFT SIDE (XCP/RLBP)  OGIVE
!
      CALL INTERX(2,T4218A,VAR,LGH,DL218A,XCPLB,9,54,                   &
     &            1,0,0,0,0,2,0,0,Q2118A,3,ROUTID)
      GO TO 1240
 1210 VAR(1)=1./VAR(1)
!
!                   FIGURE 4.2.2.1-23B RIGHT SIDE(XCP/RLBP) OGIVE
!
      CALL INTERX(2,T4218A,VAR,LGH,DR218A,XCPLB,9,54,                   &
     &            1,0,0,0,0,2,0,0,Q2118A,3,ROUTID)
      GO TO 1240
 1220 CONTINUE
!
!                   FIGURE 4.2.2.1-23B LEFT SIDE (XCP/RLBP) CONE
!
      LGH(1)=6
      LGH(2)=7
      IF(VAR(1).GT.1.)GO TO 1230
      CALL INTERX(2,T4218B,VAR,LGH,DL218B,XCPLB,7,42,                   &
     &            1,0,0,0,0,2,0,0,Q2118B,3,ROUTID)
      GO TO 1240
 1230 VAR(1)=1./VAR(1)
!
!                   FIGURE 4.2.2.1-23B RIGHT SIDE (XCP/RLBP) CONE
!
      CALL INTERX(2,T4218B,VAR,LGH,DR218B,XCPLB,7,42,                   &
     &            1,0,0,0,0,2,0,0,Q2118B,3,ROUTID)
 1240 CONTINUE
      CMAOC=(XCG/RLBP-XCPLB)*CNAOC
      IF(.NOT.TAIL)GO TO 1250
      GO TO 1260
 1250 DELCMA=0.0
      GO TO 1280
 1260 CONTINUE
      IF(D2/D1.GE.1.0)GO TO 1270
      FLARE=.FALSE.
!
!                   FIGURE 4.2.2.1-24 (XCPB) BOATTAIL
!
      VAR(1)=BETA*TAN(THETAB)
      VAR(2)=D2/D1
      LGH(1)=11
      LGH(2)=7
      CALL INTERX(2,T42119,VAR,LGH,D42119,XCPBLB,11,77,                 &
     &            0,0,0,0,2,0,0,0,Q22119,3,ROUTID)
      DELCMA=DELCNA*(2.*XCG/RLBP-1.0-XCPBLB*RLBT/RLBP)
      GO TO 1280
 1270 CONTINUE
      FLARE=.TRUE.
      VAR(1)=THETAF*RAD
      VAR(2)=D1/D2
      LGH(1)=18
      LGH(2)=11
!
!                   FIGURE 4.2.2.1-25A (CMAP) FLARE
!
      CALL INTERX(2,T4220A,VAR,LGH,D4220A,CMAP,18,198,                  &
     &            0,0,0,0,0,0,0,0,Q2120A,3,ROUTID)
      DELCMA=CMAP*(D2**3/(D1**2*RLBP))+((XCG-RLBP)/RLBP)*DELCNA
 1280 CMA=(CMAOC +DELCMA)*PI*D1**2*RLBP/(4.*SR*CRBAR*RAD )
      IF(TRANSN)GO TO 1310
!
!                   COMPUTE CENTROID OF PLANFORM AREA
!
      DO 1290 K=1,NX
         REQ(K)=SQRT(S(K)/PI)
 1290 RX(K)=REQ(K)*XCOOR(K)
      CALL TRAPZ(RX,NX,XCOOR,XC,1)
      XC=2.*XC/SP
      CALL TRAPZ(REQ,NX,XCOOR,VB,-1)
!
! *** SUPERSONIC PITCHING MOMENT VS ANGLE OF ATTACK ***
!
      ARG1=VB/(SR*CRBAR)-(RLB-XCG)*SB/(SR*CRBAR)
      IF(ELLIP .EQ. 1.0) ARG1 = CMA*RAD/2.0
      DO 1300 J=1,NALPHA
         CMPOT(J)=SIN(2.*ALSCHR(J))*COS(ALSCHR(J)/2.)*ARG1*CNOCNS
         CMVIS(J)=CFLOW(J)/CRBAR*(XCG-XC)*CNOCNN
 1300 CM(J)=CFLOW(J)/CRBAR*(XCG-XC)*CNOCNN+SIN(2.*ALSCHR(J))*           &
     & COS(ALSCHR(J)/2.)*ARG1*CNOCNS
!
!  ***SUPERSONIC BODY NOSE WAVE DRAG***
!
 1310 VAR(2)=2.*RLN/(BETA*DN)
      VAR(1)=0.0
      IF(BNOSE.EQ.1.)GO TO 1320
!
!                   FIGURE 4.2.3.1-27 (OGIVE)
!
      LGH(1)=12
      LGH(2)=10
      CALL INTERX(2,T4227,VAR,LGH,D4227,CDN2P,12,120,                   &
     &            0,2,0,0,0,2,0,0,Q23127,3,ROUTID)
      GO TO 1330
 1320 LGH(1)=10
      LGH(2)=10
      CALL INTERX(2,T4228,VAR,LGH,D4228,CDN2P,10,100,                   &
     &            0,0,0,0,0,2,0,0,Q23128,3,ROUTID)
 1330 CONTINUE
      CDN2=CDN2P*PI*DN**4/(16.*SR*RLN**2)
!
!  ***SUPERSONIC BODY SKIN FRICTION DRAG***
!
      ISTOP=NX-1
      SS=0.0
      DO 1340 J=1,ISTOP
 1340 SS=SS+ (PERIM(J+1)+PERIM(J))*(XCOOR(J+1)-XCOOR(J))/2.
      RNB=RLB*RNFS
      IF(RUFF.EQ.0.0)GO TO 1350
      ARG=12.*RLB/RUFF
!
!                   FIGURE 4.1.5.1-27 (EQUATION FOR RLCOFF)
!
      RACH=MACH
      IF(RACH.GT.3.0)RACH=3.0
      CALL TBFUNX(RACH,CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,             &
     &            0,0,4HSET ,1,ROUTID)
      RLCOFF=ARG**1.0482*10.0**CEPT
      IF(RLCOFF.LT.RNB)RNB=RLCOFF
!
!                   CALL FIG26 FOR COMPUTATION OF CF
!
 1350 CALL FIG26(RNB,RACH,CF)
      CDF=CF*SS/SR
!
!  ***SUPERSONIC AFTERBODY INTERFERENCE DRAG***
!
      IF(RLA.EQ.0.0)GO TO 1370
      DA=D1
      DB=DN
      ARG=RLA
 1360 VAR(1)=(DB/DA)**2
      VAR(2)=RLN/ARG
      LGH(1)=6
      LGH(2)=3
      CALL INTERX(2,T44A,VAR,LGH,D44A,CDANF,6,18,                       &
     &            0,0,0,0,0,0,0,0,Q3144A,3,ROUTID)
      CDANC=CDANF*PI*DB**4/(16.*SR*ARG**2)
      GO TO 1390
 1370 IF(RLBT.EQ.0.0)GO TO 1380
      DA=D1
      DB=D2
      ARG=RLBT
      GO TO 1360
 1380 CDANC=0.0
 1390 CONTINUE
!
!  ***SUPERSONIC AFTER BODY WAVE DRAG***
!
      IF(RLA.EQ.0.0)GO TO 1430
      IF(.NOT.TAIL)GO TO 1430
      IF(D2/D1.GT.1.)GO TO 1400
      DD=D1
      AA=D2
      GO TO 1410
 1400 DD=D2
      AA=D1
 1410 VAR(2)=2.*RLBT/(BETA*DD)
      VAR(1)=(AA/DD)**2
      LGH(2)=10
      IF(BTAIL.EQ.1.)GO TO 1420
!
!                   FIGURE 4.2.3.1-27 (OGIVE)
!
      LGH(1)=12
      CALL INTERX(2,T4227,VAR,LGH,D4227,CDAB,12,120,                    &
     &            0,2,0,0,0,2,0,0,Q23127,3,ROUTID)
      GO TO 1440
 1420 LGH(1)=10
!
!                   FIGURE 4.2.3.1-28 (CONE)
!
      CALL INTERX(2,T4228,VAR,LGH,D4228,CDAB,10,100,                    &
     &            0,0,0,0,0,2,0,0,Q23128,3,ROUTID)
      GO TO 1440
 1430 CDAB=0.0
      GO TO 1450
 1440 CDA=CDAB*PI*DD**4/(16.*SR*RLBT**2)
 1450 CONTINUE
!
!  ***SUPERSONIC BODY BASE DRAG***
!
      DMAX=RADIUS(1)
      DO 1460 J=1,NX
 1460 IF(DMAX.LT.RADIUS(J))DMAX=RADIUS(J)
      DMAX=2.*DMAX
      IF(RLBT.NE.0.0.OR.(D2/D1.LT.1.0))GO TO 1470
!
!                   FIGURE 4.2.3.1-60 (CDB)
!
      VAR(1)=MACH
      LGH(1)=13
      CALL INTERX(1,T4360,VAR,LGH,D4360,CDD,13,13,                      &
     &            0,0,0,0,0,0,0,0,Q23160,3,ROUTID)
      GO TO 1500
 1470 CONTINUE
      VAR(1)=MACH
      VAR(2)=D2/DMAX
      VAR(3)=RLBT/D1
      LGH(1)=11
      LGH(2)=5
      LGH(3)=5
      IF(BTAIL.EQ.1.)GO TO 1480
!
!                   FIGURE 4.2.3.1-50 (CPB FOR OGIVES)  A-E
!
      CALL INTERX(3,T5055,VAR,LGH,D4350,CPB,11,275,                     &
     &            0,0,2,0,0,0,2,0,Q23150,3,ROUTID)
      GO TO 1490
!
!                   FIGURE 4.2.3.1-55 (CPB FOR CONES)  A-E
!
 1480 CALL INTERX(3,T5055,VAR,LGH,D4355,CPB,11,275,                     &
     &            0,0,2,0,0,0,2,0,Q23155,3,ROUTID)
 1490 CDD=-CPB*(D2/DMAX)**2
 1500 CDB=CDD*PI*DMAX**2/(4.*SR)
!
!  ***SUPERSONIC BODY DRAG AT ANGLE OF ATTACK***
!
      CDO=CDF+CDN2+CDA+CDANC+CDB
      IF(TRANSN)RETURN
      DO 1510 J=1,NALPHA
         COSA=COS(FLC(J+22)/RAD)
         SINA=SIN(FLC(J+22)/RAD)
         CA(J) = CDO*COSA**2
         CL(J) = CN(J)*COSA-CA(J)*SINA
         CD(J) = CA(J)*COSA+CN(J)*SINA
 1510 END DO
      RETURN
      END
      SUBROUTINE TABLEC(C,XM)
!
!***  REGRESSION COEFFICIENTS FOR WBCMO
!
      DIMENSION C(19), CCM(266), ZM(14)
      DIMENSION CR(6), ROUTID(2), QTAB(4)
      DIMENSION C1(70), C2(70), C3(70), C4(56)
      EQUIVALENCE (CCM(1),C1(1)), (CCM(71),C2(1)), (CCM(141),C3(1))
      EQUIVALENCE (CCM(211),C4(1))
!
      DATA ROUTID / 4HTABL, 4HEC   /
      DATA QTAB   / 4HWBCM, 4H0 CO, 4HEF. , 4HC    /
      DATA ZM     / 0.40, 0.60, 0.70, 0.80, 0.90, 0.95, 1.00, 1.10,     &
     &              1.20, 1.30, 1.40, 1.50, 2.00, 2.50  /
!
      DATA C1 /                                                         &
     & -6.1496E-01,  3.0521E-02,  1.0449E-02,  2.4846E-02,  2.3233E-02, &
     & -2.9503E-02, -7.2508E-02, -4.7882E-02, -7.7024E-03, -9.0333E-03, &
     & -6.4029E-02,  1.4988E-02, -1.0257E-01, -9.7877E-02,              &
     &  3.4113E-02, -2.6482E-02,  1.9975E-03, -5.5509E-03, -5.4868E-04, &
     &  5.6041E-02,  1.1805E-01,  8.7861E-02,  6.7409E-02,  8.1884E-02, &
     &  1.1973E-01,  6.6427E-02,  1.7653E-01,  1.6776E-01,              &
     & -4.3111E-03, -3.1117E-03, -1.1029E-03, -2.4707E-03, -2.7806E-03, &
     &  5.2306E-03,  9.1112E-03,  1.2725E-02,  3.7585E-03,  2.9019E-03, &
     &  1.2987E-02,  7.8970E-04,  2.2724E-02,  2.8670E-02,              &
     & -6.7607E-03,  4.0854E-04,  1.9192E-04, -1.4904E-03, -1.4790E-03, &
     & -2.1117E-03, -5.5601E-03,  5.8939E-04, -2.0553E-03, -3.5078E-03, &
     &  1.4900E-03, -6.5439E-03, -6.5667E-03, -4.3908E-03,              &
     &  5.8626E-01,  4.3533E-02,  2.8208E-02,  3.1764E-02,  2.4266E-02, &
     &  2.4656E-02,  1.6164E-02,  4.9004E-02, -1.3639E-02, -2.7873E-02, &
     & -2.9892E-02, -2.2854E-02,  2.6084E-03,  2.0467E-03 /
      DATA C2 /                                                         &
     & -2.1631E-03,  1.0412E-04,  7.9415E-04,  3.6833E-04,  4.0862E-04, &
     &  8.2755E-04, -1.9504E-03, -1.8951E-04, -8.4471E-04, -1.6508E-03, &
     & -1.3285E-03, -9.8949E-04, -3.6847E-04, -1.3417E-03,              &
     & -2.9718E-03, -2.3971E-03, -1.2200E-03,  3.7272E-04, -9.2113E-04, &
     & -1.6469E-03,  4.3904E-03, -1.4263E-03, -2.7075E-03, -7.0990E-04, &
     & -1.9031E-03, -2.4785E-03,  1.5647E-03, -7.7258E-04,              &
     & -1.3161E-03,  1.0412E-02,  5.1328E-03, -3.5006E-03,  9.1995E-04, &
     & -8.5456E-03, -5.0916E-02, -7.3144E-03, -3.5333E-04, -1.0550E-02, &
     &  9.3873E-03, -1.1328E-02, -2.6630E-02, -2.3909E-02,              &
     &  3.4451E-03, -4.9864E-03, -2.9594E-03,  7.3299E-04, -1.0519E-03, &
     &  9.2825E-03,  3.9982E-02,  2.5290E-03, -3.0929E-04,  3.2408E-03, &
     & -4.9618E-03,  2.6880E-03,  1.0089E-02,  9.4275E-03,              &
     & -9.7535E-03, -2.3881E-03,  7.4312E-04,  1.2306E-03,  2.1653E-03, &
     &  3.7542E-03,  1.1703E-04, -1.1616E-04,  1.7132E-03,  5.7507E-04, &
     &  1.1079E-03, -2.3730E-05, -1.8213E-03,  5.7215E-04 /
      DATA C3 /                                                         &
     & -3.9389E+00,  5.6516E-01,  1.2045E-01, -1.0408E-01,  9.8669E-02, &
     & -8.2906E-01,  1.0256E+00, -6.2097E-01, -1.5639E+00, -4.3130E-01, &
     & -8.3720E-01, -1.6698E-01,  9.7612E-01,  1.3090E+00,              &
     & -5.2560E-01, -5.1829E-01, -5.3503E-01, -4.9728E-01, -6.2200E-01, &
     & -3.1518E-01, -3.9402E-01, -3.6576E-01, -2.1108E-01, -1.0254E-01, &
     & -2.9314E-02,  4.5021E-01, -4.7537E+00, -5.3830E+00,              &
     & -4.3982E+00, -4.0930E+00, -4.2059E+00, -3.9283E+00, -4.8034E+00, &
     & -3.1686E+00, -3.4999E+00, -3.1159E+00, -2.5628E+00, -2.0192E+00, &
     & -1.7911E+00,  1.3537E-01, -1.5553E+01, -1.6996E+01,              &
     &  3.6116E-02, -6.9271E-03, -1.3549E-03,  4.8901E-03,  1.8263E-03, &
     &  7.5362E-03,  3.5393E-03,  1.0248E-02,  1.1013E-02,  6.7985E-03, &
     &  1.7144E-03,  2.2793E-03, -1.0677E-03,  1.4219E-02,              &
     &  3.4068E-02,  1.1685E-02,  5.3796E-03,  1.4643E-03,  2.8848E-03, &
     & -3.8225E-03,  3.0079E-02,  4.7945E-03,  1.6835E-03,  8.3637E-03, &
     &  3.4691E-03,  4.0738E-03, -4.2213E-03, -9.1883E-03 /
      DATA C4 /                                                         &
     & -7.3114E-02, -1.0598E-03,  2.0454E-03,  2.7298E-03,  2.5683E-04, &
     & -3.5619E-03,  1.6422E-03, -6.5869E-04,  1.6923E-03,  1.3512E-03, &
     &  1.1693E-03,  3.2272E-03,  4.5941E-03,  2.6961E-03,              &
     &  1.2683E+00, -1.7713E-02, -3.9115E-03, -9.2493E-03,  6.5923E-03, &
     &  7.4832E-03,  2.5312E-02, -3.7542E-02,  1.7427E-02,  2.0635E-02, &
     &  1.8158E-02,  1.6570E-02, -6.3330E-04, -1.6885E-02,              &
     & -1.6503E-01, -5.2268E-02, -4.3905E-02, -5.1001E-02, -1.0221E-01, &
     & -1.9949E-02, -5.3897E-02,  6.3401E-03, -1.3287E-01, -1.3673E-01, &
     & -8.0305E-02, -1.8294E-01, -1.1299E-01, -6.8530E-02,              &
     & -7.7192E-04,  2.5439E-04, -1.2391E-03, -1.1483E-03, -7.8181E-04, &
     & -1.0290E-03, -1.3250E-03, -5.1180E-04, -1.3416E-03, -2.3095E-03, &
     & -2.2940E-03, -1.4919E-03,  9.4537E-04, -9.9505E-04 /
!
      DO 1000 I=1,19
        IN = 0
        ID = 1+14*(I-1)
        CALL TBFUNX(XM,C(I),DYDX,14,ZM,CCM(ID),CR,IN,MI,NG,             &
     &              0,0,QTAB,4,ROUTID)
 1000 END DO
      RETURN
      END

      SUBROUTINE TABLES(B, MACH, ALPHA, NDM)
!
!***  READ MACH TABLES OF CD EQUATION  REGESSION COEFFICIENTS
!
      DIMENSION B(16), BT(2,2,16), M(14)
      REAL MACH, M
      LOGICAL NDM
!
      DATA M /0.00, 0.60, 0.70, 0.80, 0.90, 0.95, 1.00, 1.10,           &
     &        1.20, 1.30, 1.40, 1.50, 2.00, 2.50 /
!
      ALP = ABS(ALPHA)
      NDM = .FALSE.
      IF(MACH .LE. 0.9) IAM = 18
      IF(MACH .GT. 0.9 .AND. MACH .LT. 1.0) IAM = 11
      IF(MACH .GE. 1.0 .AND. MACH .LT. 1.1) IAM = 12
      IF(MACH .GE. 1.1) IAM = 15
      IA = ALP
      ALP1 = IAM
      IF(ALP .GT. ALP1) NDM = .TRUE.
      IF(NDM) GO TO 1030
        IF(IA .EQ. IAM) IA = IAM-1
        IA1 = IA+1
        IA2 = IA+2
        ALP1 = IA
        DO 1010 I=2,14
           IF(MACH .GE. M(I-1) .AND. MACH .LE. M(I)) GO TO 1020
 1010   CONTINUE
        NDM = .TRUE.
 1020   CONTINUE
        IM1 = I-1
        IM2 = I
 1030 CONTINUE
      IF(NDM) GO TO 1070
       I = 0
       DO 1050 IM=IM1,IM2
          J = 0
          I = I+1
          DO 1040 IA=IA1,IA2
             J = J+1
             IF(IM .LE. 4)                  CALL TBSUB(BT,IM,IA,I,J)
             IF(IM .GE. 5 .AND. IM .LE. 10) CALL TBTRN(BT,IM,IA,I,J)
             IF(IM .GE. 11)                 CALL TBSUP(BT,IM,IA,I,J)
 1040     CONTINUE
 1050  CONTINUE
!
       DO 1060 I=1,16
          BA = BT(1,1,I)+(BT(1,2,I)-BT(1,1,I))*(ALP-ALP1)
          BB = BT(2,1,I)+(BT(2,2,I)-BT(2,1,I))*(ALP-ALP1)
          B(I) = BA+(BB-BA)*(MACH-M(IM1))/(M(IM2)-M(IM1))
 1060  CONTINUE
 1070 CONTINUE
      RETURN
      END

      SUBROUTINE TBFUNX(X,Y,DYDX,NP,XA,YA,C,IN,                         &
     &           MI,NG,LEXL,LEXU,MESS,NMSS,ROUT)
!
!**
!** INPUTS
!**
!**    X    = X COORDINATE OF POINT OF INTEREST
!**    NP   = NUMBER OF INPUT DATA POINTS
!**    XA   = ARRAY OF X COORDINATES FOR DATA POINTS
!**    YA   = ARRAY OF Y COORDINATES FOR DATA POINTS
!**    C    = DUMMY ARRAY    -- NOT USED
!**    IN   = DUMMY VARIABLE -- NOT USED
!**    MI   = DUMMY VARIABLE -- NOT USED
!**    NG   = DUMMY VARIABLE -- NOT USED
!**    LEXL = INDICATOR IF BELOW LOWER LIMIT OF DATA
!**           IF .LE. 0, Y IS YA(1) AND DYDX DETERMINED
!**           BY 2ND-ORDER CURVE FIT
!**           IF .EQ. 1, Y IS EXTRAPOLATED LINEARLY USING
!**           SLOPE OF FIRST 2 DATA POINTS
!**           IF .GT. 1, Y AND DYDX ARE DETERMINED BY
!**           2ND-ORDER CURVE FIT
!**    LEXU = INDICATOR IF ABOVE UPPER LIMIT OF DATA
!**           IF .LE. 0, Y IS YA(1) AND DYDX DETERMINED
!**           BY 2ND-ORDER CURVE FIT
!**           IF .EQ. 1, Y IS EXTRAPOLATED LINEARLY USING
!**           SLOPE OF LAST 2 DATA POINTS
!**           IF .GT. 1, Y AND DYDX ARE DETERMINED BY
!**           2ND-ORDER CURVE FIT
!**    MESS = FIGURE NUMBER IN EXTRAPOLATION MESSAGE
!**    NMSS = DIMENSION OF MESS
!**    ROUT = ROUTINE NAME CALLING TBFUNX
!**
!** OUTPUTS
!**
!**    Y    = Y COORDINATE AT POINT OF INTEREST
!**    DYDX = FIRST DERIVATIVE AT POINT OF INTEREST
!**       *          *          *          *          *
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      
!      DIMENSION XA(NP),YA(NP),C(6),MESS(2),ROUT(2),MSSCL(9)
      DIMENSION XA(NP),YA(NP),C(6),MESS(NMSS),ROUT(2),MSSCL(9)
! changed by RLC   2021Jan18
      
      DIMENSION XX(3),YY(3)
      EQUIVALENCE (QSSCL4,MSSCL(4)),(QSSCL6,MSSCL(6))
      DATA MSSCL/4HTBFU, 4HNX  ,2*0,1,4*0/
!**
!**    SET FLAGS FOR USING SUBROUTINE QUAD...
!**
      DATA ADER/4HDERI/,BDER/4HYNOD/
      NP1=NP-1
      IF(NP.LT.3)GO TO 1070
!**
!**    CHECK IF EXTRAPOLATING OR INTERPOLATING
!**
      IF(X.GE.XA(NP).OR.X.LE.XA(1))GO TO 1020
!**
!**    HERE IF INTERPOLATING...
!**
!**    DETERMINE POINTS XA(I) SURROUNDING X...
!**
      DO 1000 I=1,NP1
         IF(X.GE.XA(I))L=I
 1000 END DO
      IF(L.EQ.1)L=2
      L2=L-2
!**
!**    FILL VECTORS FOR SUBROUTINE QUAD...
!**
      DO 1010 I=1,3
         XX(I)=XA(L2+I)
 1010 YY(I)=YA(L2+I)
!**
!**    CALCULATE Y BY LINEAR INTERPOLATION...
!**
      DEL=XX(3)-XX(2)
      XDEL=XX(3)
      IF(DEL.EQ.0.)DEL=UNUSED
      Y=YY(2)+(YY(3)-YY(2))*(X-XX(2))/DEL
      DEL=XX(2)-XX(1)
      XDEL=XX(2)
      IF(DEL.EQ.0.)DEL=UNUSED
      IF(X.LT.XA(2))Y=YY(1)+(YY(2)-YY(1))*(X-XX(1))/DEL
!**
!**    SET FLAG FOR CALCULATING DERIVATIVE AND
!**    CALL QUAD TO CALCULATE DYDX...
!**
      YIND=ADER
      CALL QUAD(XX(1),YY(1),X,YIND)
      DYDX=YIND
      GO TO 1050
!**
!**    HERE IF EXTRAPOLATING...
!**
 1020 CONTINUE
      NP3=NP-3
!**
!**    DETERMINE IF ABOVE OR BELOW DATA LIMITS
!**
      LE=0
      LLE=1
      LIND=LEXL
      IF(X.GE.XA(NP))LE=NP3
      IF(X.GE.XA(NP))LLE=NP
      IF(X.GE.XA(NP))LIND=LEXU
!**
!**    FILL VECTORS FOR SUBROUTINE QUAD...
!**
      DO 1030 I=1,3
         XX(I)=XA(LE+I)
 1030 YY(I)=YA(LE+I)
!**
!**    DETERMINE WHICH METHODS FOR CALCULATING Y AND DYDX
!**
!**    IF USING LINEAR EXTRAPOLATION, CALCULATE
!**    Y AND DYDX...
!**
      DEL=XA(2)-XA(1)
      XDEL=XA(2)
      IF(DEL.EQ.0.)DEL=UNUSED
      IF(LEXL.EQ.1)DYDX=(YA(2)-YA(1))/DEL
      DEL=XA(NP)-XA(NP1)
      XDEL=XA(NP)
      IF(DEL.EQ.0.)DEL=UNUSED
      IF(LEXU.EQ.1.AND.LE.EQ.NP3)DYDX=(YA(NP)-YA(NP1))/DEL
      IF(LEXL.EQ.1)Y=(X-XA(1))*DYDX+YA(1)
      IF(LEXU.EQ.1.AND.LE.EQ.NP3)Y=(X-XA(NP))*DYDX+YA(NP)
      IF(LIND.EQ.1)GO TO 1050
!**
!**    HERE FOR RETURNING VALUES AT ENDPOINTS FOR Y...
!**
      IF(LIND.LE.0)Y=YA(LLE)
      IF(LIND.LE.0)GO TO 1040
!**
!**    IF USING SUBROUTINE QUAD, CALCULATE Y...
!**
      YIND=BDER
      CALL QUAD(XX(1),YY(1),X,YIND)
      Y=YIND
!**
!**    IF USING SUBROUTINE QUAD, CALCULATE DYDX...
!**
 1040 YIND=ADER
      CALL QUAD(XX(1),YY(1),X,YIND)
      DYDX=YIND
 1045 CONTINUE
      IF(X.GE.XA(1).AND.X.LE.XA(NP))GO TO 1050
      MSSCL(3)=NMSS
      QSSCL4=Y
      QSSCL6=X
      MSSCL(7)=NP
      MSSCL(8)=LEXL
      MSSCL(9)=LEXU
      CALL MESSGE(ROUT,MESS,XA,MJ,MJ,MJ,MSSCL)
 1050 CONTINUE
      IF(DEL.EQ.UNUSED)WRITE(6,1060)XDEL,ROUT(1),ROUT(2),(MESS(I),      &
     &                      I=1,NMSS)
 1060 FORMAT(37H WARNING - DUPLICATE X VALUES AT X = ,1PE14.7,          &
     & 24H IN TBFUNX, CALLED FROM ,2A4,12H FOR FIGURE ,4A4)
      RETURN
 1070 IF(NP.LE.1)Y=YA(1)
      IF(NP.LE.1)DYDX=0.
      IF(NP.LE.1)RETURN
      DEL=0.
      DYDX=(YA(2)-YA(1))/(XA(2)-XA(1))
      Y=YA(1)+DYDX*(X-XA(1))
      GO TO 1045
      END

      SUBROUTINE TBSUB(BT,IM,IA,I,J)
!
!***  SUBSONIC CD REGRESION COEFFICIENT TABLES
!
      DIMENSION BSUB(864), BT(2,2,16)
      DIMENSION B0(64),B1(64),B2(64),B3(64),B4(64),B5(64),B6(64),B7(64),&
     & B8(64),B9(64),B10(64),B11(64),B12(64),B13(32)
      EQUIVALENCE (BSUB(1),B0(1)),(BSUB(65),B1(1)),(BSUB(129),B2(1)),   &
     & (BSUB(193),B3(1)),(BSUB(257),B4(1)),(BSUB(321),B5(1)),(BSUB(385),&
     & B6(1)),(BSUB(449),B7(1)),(BSUB(513),B8(1)),(BSUB(577),B9(1)),    &
     & (BSUB(641),B10(1)),(BSUB(705),B11(1)),(BSUB(769),B12(1)),        &
     & (BSUB(833),B13(1))
      DATA B0/                                                          &
     & 4.4885930E-04, 1.6466172E-03, 2.6332238E-04,-6.9094193E-04,      &
     & 1.9223774E-03,-3.9237479E-05,-1.6659401E-04, 7.8742160E-04,      &
     &-2.4286320E-03, 9.9980575E-04,-2.8099894E-05,-1.2679554E-03,      &
     &-2.8362144E-02, 2.9298468E-03,-4.7068298E-03,-3.9218809E-05,      &
     & 3.5343489E-03, 4.4493303E-03, 4.2463490E-04,-1.0899324E-03,      &
     &-1.6224474E-02,-2.8865668E-04,-2.9736874E-04, 4.3430701E-03,      &
     &-8.1697032E-03, 2.7710055E-03, 9.4937068E-06,-1.2983710E-02,      &
     &-5.1788986E-02, 3.7952278E-02,-8.1924498E-03,-2.2274732E-04,      &
     & 1.3167702E-02,-2.3571095E-04, 1.3356669E-04,-2.6622848E-03,      &
     &-3.5622340E-02,-4.2594853E-04,-4.6613021E-04, 7.7534169E-03,      &
     &-2.0226449E-02, 1.0392413E-02,-3.8002967E-04,-5.3499781E-02,      &
     &-7.1050525E-02, 5.7253648E-02,-1.1915766E-02,-3.2953895E-04,      &
     & 2.6080940E-02,-5.8881156E-03,-1.4355913E-04,-5.8832504E-03,      &
     &-5.9013661E-02,-4.3143658E-04,-6.7898026E-04, 1.6526066E-02,      &
     &-4.9525306E-02, 2.7853992E-02,-1.6461264E-03,-1.0679454E-01,      &
     &-8.4942102E-02, 7.4417174E-02,-1.5801720E-02,-3.5790936E-04/
      DATA B1/                                                          &
     & 4.1089863E-02,-1.0994699E-02, 2.2937305E-04,-6.9373399E-03,      &
     &-1.4925289E-01,-8.1930403E-04,-1.2072376E-03, 2.3949113E-02,      &
     &-5.9268754E-02, 3.0836698E-02,-2.2214940E-03,-2.8832860E-02,      &
     &-9.6811116E-02, 2.2042923E-02,-2.2552278E-02,-4.8507238E-04,      &
     & 5.1404808E-02,-4.8175454E-03, 2.2257052E-03,-1.0284252E-02,      &
     &-2.4447268E-01,-1.1168574E-03,-1.6828820E-03, 4.2651802E-02,      &
     &-1.1423558E-01, 6.5117717E-02,-2.7537793E-03, 1.9132972E-01,      &
     &-1.1610109E-01,-1.0823810E-01,-3.2532644E-02,-6.1116740E-04,      &
     & 5.7489973E-02, 3.0284515E-05, 5.3919293E-03,-1.1289421E-02,      &
     &-3.3546823E-01,-1.3747460E-03,-2.6084271E-03, 6.7769229E-02,      &
     &-1.6815060E-01, 9.6094728E-02,-3.0871895E-03, 3.2419640E-01,      &
     &-1.4942586E-01,-3.5912198E-01,-4.7611687E-02,-4.9278955E-04,      &
     & 7.3792398E-02,-8.9043044E-03, 7.3401928E-03,-1.0492109E-02,      &
     &-4.4144338E-01,-1.7494359E-03,-3.2979206E-03, 9.4557822E-02,      &
     &-2.3327237E-01, 1.4238948E-01,-2.0414789E-03, 7.7764571E-01,      &
     &-1.9746423E-01,-4.9930739E-01,-6.3838482E-02,-7.7125826E-04/
      DATA B2/                                                          &
     & 9.5475793E-02,-3.0374423E-02, 8.8466853E-03,-7.8066513E-03,      &
     &-5.8794355E-01,-1.6985149E-03,-4.8570484E-03, 1.1723447E-01,      &
     &-2.5173032E-01, 1.4973515E-01,-2.4280034E-03, 1.5174065E+00,      &
     &-2.9221755E-01,-4.7586030E-01,-7.8628778E-02,-6.7470013E-04,      &
     & 1.2873018E-01,-5.2268814E-02, 8.5452385E-03,-8.2583651E-03,      &
     &-6.9951952E-01,-2.9492334E-03,-4.8697293E-03, 1.4050865E-01,      &
     &-2.8982109E-01, 1.6951829E-01,-2.1462883E-03, 2.2761288E+00,      &
     &-3.4642851E-01,-5.2607334E-01,-9.0969384E-02,-7.5901300E-04,      &
     & 1.5889448E-01,-7.5946987E-02, 8.3336644E-03,-1.2611162E-02,      &
     &-8.2885671E-01,-2.1995942E-03,-5.9542060E-03, 1.6340053E-01,      &
     &-3.2756406E-01, 1.8710023E-01,-3.7027223E-03, 3.8842850E+00,      &
     &-3.9754725E-01,-4.9629009E-01,-1.0051405E-01, 2.0424763E-05,      &
     & 1.8028164E-01,-7.6644123E-02, 7.4474253E-03,-1.5930068E-02,      &
     &-9.0625024E-01,-1.8138052E-03,-3.8621577E-03, 1.9144523E-01,      &
     &-4.2892265E-01, 2.6626474E-01,-2.0222019E-03, 4.3452969E+00,      &
     &-4.3743223E-01,-4.8216325E-01,-1.0222536E-01, 4.4405740E-04/
      DATA B3/                                                          &
     & 2.1131814E-01,-1.1041343E-01, 4.3281354E-03,-1.8591814E-02,      &
     &-7.0087326E-01,-1.3521263E-05,-5.0393753E-03, 2.1709967E-01,      &
     &-5.0194585E-01, 3.0724651E-01,-3.4639400E-03, 3.7631922E+00,      &
     &-4.9084455E-01,-3.0237412E-01,-1.0158598E-01, 9.1807242E-04,      &
     & 2.5118989E-01,-1.4561749E-01, 9.1741630E-04,-1.3606068E-02,      &
     &-6.6341639E-01, 3.8281409E-04,-5.6619756E-03, 2.2050828E-01,      &
     &-5.0066817E-01, 3.0752426E-01,-8.6127920E-04, 3.4831161E+00,      &
     &-5.1915550E-01,-1.1922604E-01,-9.8660529E-02, 2.0917949E-04,      &
     & 2.5845224E-01,-1.5418375E-01, 1.4780490E-03,-4.8254095E-03,      &
     &-6.9529557E-01, 1.5229150E-03,-7.9105906E-03, 2.2127914E-01,      &
     &-4.5957595E-01, 2.8356904E-01, 4.0303194E-04, 4.4369774E+00,      &
     &-5.0870836E-01,-6.1953966E-02,-9.7039342E-02, 9.4502978E-04,      &
     & 2.8928846E-01,-1.8996912E-01, 1.4323548E-03, 8.8644959E-03,      &
     &-8.5331100E-01, 1.6083536E-03,-1.1337869E-02, 2.0553809E-01,      &
     &-3.9034742E-01, 2.5450063E-01, 2.9375588E-03, 6.0180445E+00,      &
     &-4.9258125E-01, 1.7574262E-03,-1.0123742E-01, 8.3130505E-04/
      DATA B4/                                                          &
     & 3.0497837E-01,-2.0239776E-01,-1.9626934E-03, 2.5686312E-02,      &
     &-6.5569198E-01, 9.5541263E-04,-9.0072714E-03, 2.3887885E-01,      &
     &-5.0267315E-01, 3.2742906E-01, 3.6962673E-03, 4.6050005E+00,      &
     &-4.9678451E-01, 6.4524375E-03,-9.7604394E-02, 9.1373397E-05,      &
     & 3.1397533E-01,-2.2017187E-01,-1.4016414E-03, 4.0318791E-02,      &
     &-5.1782024E-01, 2.4724216E-04,-9.2562996E-03, 2.9613328E-01,      &
     &-7.0454794E-01, 4.9100441E-01, 2.0149857E-04, 4.0006886E+00,      &
     &-5.2714890E-01,-1.7117675E-02,-9.1817439E-02, 7.6978840E-04,      &
     &-7.3195639E-05, 2.0101692E-03, 2.1734987E-04,-1.3460347E-03,      &
     &-7.2533563E-03, 6.9625865E-05,-1.3989010E-05, 6.0490705E-03,      &
     &-1.8964671E-02, 1.1371218E-02, 6.7992587E-05, 5.6628495E-02,      &
     &-3.2475021E-02, 2.8143533E-02,-5.4642707E-03, 1.2241230E-04,      &
     &-3.3051730E-04, 4.6258122E-03, 7.3974766E-04,-1.4806779E-03,      &
     &-3.0610979E-02, 1.2121424E-04,-3.7638005E-04, 1.3037436E-02,      &
     &-3.0810691E-02, 1.7299809E-02,-3.7054974E-04, 1.7544210E-01,      &
     &-4.2595334E-02, 4.8669279E-02,-9.7354613E-03, 2.0532309E-04/
      DATA B5/                                                          &
     & 2.9780278E-03, 8.1624575E-03, 1.0379972E-03,-4.0881671E-03,      &
     &-5.7377189E-02, 2.2002579E-04,-2.4449942E-04, 2.1939933E-02,      &
     &-5.9946161E-02, 3.4800462E-02,-5.0994102E-04, 2.7522266E-01,      &
     &-6.6224635E-02, 6.8408072E-02,-1.3333861E-02, 2.7691154E-04,      &
     & 9.5234104E-03, 9.7690411E-03, 1.5846370E-03,-5.9593059E-03,      &
     &-1.0542357E-01, 2.4238175E-04,-7.1255234E-04, 3.3687763E-02,      &
     &-8.7308407E-02, 4.9654800E-02,-7.2291447E-04, 3.5125870E-01,      &
     &-9.9456728E-02, 1.0426939E-01,-1.8880296E-02, 2.4188431E-04,      &
     & 1.3648596E-02, 1.6900074E-02, 2.5486411E-03,-9.5883459E-03,      &
     &-1.6574728E-01, 6.0080551E-04,-4.1632471E-04, 5.3079028E-02,      &
     &-1.4787018E-01, 8.7192774E-02,-7.7875075E-04, 4.1736478E-01,      &
     &-1.0759699E-01, 1.6836029E-02,-2.7335007E-02, 4.2515970E-04,      &
     & 2.1397371E-02, 2.5691286E-02, 4.6796277E-03,-1.2043726E-02,      &
     &-2.1467358E-01,-6.8600930E-05,-6.8842247E-04, 7.0075572E-02,      &
     &-1.9057781E-01, 1.1190552E-01,-7.4058911E-04, 2.1681064E-01,      &
     &-1.4430177E-01,-1.2044883E-01,-4.1737635E-02, 3.4527923E-04/
      DATA B6/                                                          &
     & 3.2796603E-02, 3.2987442E-02, 7.5326227E-03,-1.5522216E-02,      &
     &-3.1023210E-01,-6.7667500E-04,-9.7367633E-04, 8.9319170E-02,      &
     &-2.3841059E-01, 1.3886362E-01,-1.2076702E-03, 5.6157285E-01,      &
     &-1.8065786E-01,-2.7628446E-01,-5.6207392E-02, 1.5462366E-04,      &
     & 4.4269174E-02, 2.9029280E-02, 1.0218088E-02,-1.6167406E-02,      &
     &-4.1625369E-01,-5.6385831E-04,-2.5444294E-03, 1.3154143E-01,      &
     &-3.3205175E-01, 1.9556808E-01, 2.9784380E-05, 1.0876265E+00,      &
     &-2.4522501E-01,-4.6906072E-01,-7.7448905E-02, 3.3625029E-04,      &
     & 7.1560264E-02, 1.4439911E-02, 1.1626758E-02,-1.6051237E-02,      &
     &-5.3882170E-01,-7.9200906E-04,-5.1237121E-03, 1.6180027E-01,      &
     &-3.7175006E-01, 2.1317595E-01, 1.8981316E-03, 1.5256491E+00,      &
     &-3.3415884E-01,-4.3756104E-01,-9.1177285E-02,-4.0033972E-04,      &
     & 1.1008793E-01,-2.0695493E-02, 8.7880157E-03,-1.7482743E-02,      &
     &-5.7938153E-01,-1.3134247E-03,-5.1664710E-03, 1.9467980E-01,      &
     &-4.3250608E-01, 2.4541557E-01, 5.4160245E-03, 2.1190329E+00,      &
     &-4.1419709E-01,-3.6867708E-01,-9.8566592E-02,-5.1344186E-04/
      DATA B7/                                                          &
     & 1.3603187E-01,-4.5796245E-02, 7.9406798E-03,-1.8519945E-02,      &
     &-6.5951067E-01,-5.3474843E-04,-5.2999556E-03, 1.9851702E-01,      &
     &-4.3424481E-01, 2.4918509E-01, 5.8447756E-03, 3.1937418E+00,      &
     &-4.5796067E-01,-3.3091640E-01,-1.0509312E-01, 3.7347153E-04,      &
     & 9.4765246E-02, 6.2992394E-02, 1.0712337E-02,-1.8970948E-02,      &
     &-5.4804075E-01,-1.7306977E-03, 4.9315649E-04, 3.0677384E-01,      &
     &-8.1576067E-01, 5.2282137E-01, 1.5582558E-02, 2.4209471E+00,      &
     &-4.5015442E-01,-1.4213777E-01,-8.9111686E-02,-1.4624775E-03,      &
     & 1.3092870E-01, 2.4762422E-02, 8.4733069E-03,-4.5990758E-03,      &
     &-6.1550915E-01,-3.0144309E-03,-1.3241996E-03, 2.9722220E-01,      &
     &-7.1509749E-01, 4.5468479E-01, 1.5977819E-02, 2.8371468E+00,      &
     &-5.0671482E-01,-5.4381426E-02,-8.9783967E-02,-1.7433565E-03,      &
     & 1.5005344E-01, 7.0164323E-02, 4.5346394E-03,-2.2784080E-02,      &
     &-2.6831436E-01,-3.2275734E-03, 4.8282221E-03, 2.2817892E-01,      &
     &-5.2779698E-01, 2.8269923E-01, 2.2932690E-02,-1.9638312E-01,      &
     &-2.8798437E-01, 2.2776908E-01,-6.8759263E-02,-2.7702246E-03/
      DATA B8/                                                          &
     & 1.1178082E-01, 1.3769341E-01, 4.9981773E-03, 2.3613831E-04,      &
     &-1.3596147E-02,-4.6660416E-03, 1.0132425E-02, 3.0323088E-01,      &
     &-8.1142151E-01, 5.0265276E-01, 2.7900193E-02,-2.4371939E+00,      &
     &-2.6261395E-01, 2.5419468E-01,-5.0778542E-02,-4.6431646E-03,      &
     & 1.6473681E-01, 1.0006750E-01, 1.6847074E-03,-2.0760354E-02,      &
     & 2.3530585E-01, 1.6932767E-03,-2.3199538E-04, 2.8821123E-01,      &
     &-6.8001336E-01, 3.5785061E-01, 3.3952434E-02,-2.9018240E+00,      &
     &-3.1660575E-01, 2.1182406E-01,-7.1094394E-02,-5.1403269E-03,      &
     & 2.7866572E-01,-1.5212294E-02,-1.5016862E-03,-3.3746634E-02,      &
     & 5.3500313E-01, 4.1618608E-03,-7.1388693E-04, 2.6551217E-01,      &
     &-1.0312357E+00, 7.0318127E-01, 2.9077347E-02,-7.1409101E+00,      &
     &-2.0469600E-01, 2.4061882E-01,-6.9276690E-02,-8.0148354E-03,      &
     & 3.5630715E-01,-5.4957870E-02,-2.6851350E-03,-4.2850643E-02,      &
     & 3.2792574E-01, 5.9040785E-03,-6.3229464E-03, 2.2175205E-01,      &
     &-8.7165284E-01, 5.8893001E-01, 2.6771791E-02,-6.4078979E+00,      &
     &-2.7279073E-01, 3.6714154E-01,-6.7780375E-02,-8.9949779E-03/
      DATA B9/                                                          &
     & 2.2072613E-03,-1.4442157E-03,-9.3907249E-05,-7.2844420E-04,      &
     &-7.9726726E-03, 1.4571991E-05,-1.1121671E-04, 4.0435046E-03,      &
     &-8.5231513E-03, 3.6628372E-03,-1.9908477E-04, 4.9856681E-02,      &
     &-3.4640670E-02, 3.7956566E-02,-5.6786649E-03, 1.0911575E-04,      &
     & 3.3827091E-03,-3.0188151E-03, 3.5618758E-04,-5.3896685E-04,      &
     &-4.2930976E-02, 1.6036828E-04,-5.8894139E-04, 1.1490092E-02,      &
     &-2.1192752E-02, 1.0164138E-02,-8.3737844E-04, 2.7903908E-01,      &
     &-5.1003907E-02, 5.3007212E-02,-1.1375032E-02, 3.4272834E-04,      &
     & 1.0221422E-02,-8.9141652E-03, 4.4462411E-04,-1.1832668E-03,      &
     &-9.1712236E-02, 2.8603105E-04,-8.1401668E-04, 1.7405812E-02,      &
     &-3.5941985E-02, 1.9162033E-02,-1.2003491E-03, 4.8013735E-01,      &
     &-7.9366267E-02, 8.3003521E-02,-1.7157365E-02, 5.5354438E-04,      &
     & 2.0135798E-02,-1.1928599E-02, 1.0084624E-03,-3.2017273E-03,      &
     &-1.6796315E-01, 3.1131832E-04,-1.3633950E-03, 2.4547745E-02,      &
     &-5.1232908E-02, 2.6895322E-02,-1.6366835E-03, 8.8189715E-01,      &
     &-1.0986304E-01, 1.1607802E-01,-2.4319585E-02, 6.4954185E-04/
      DATA B10/                                                         &
     & 3.1373378E-02,-1.8954746E-02, 1.7463975E-03,-6.0795546E-03,      &
     &-2.6044583E-01, 7.2922092E-04,-1.6039808E-03, 3.7007444E-02,      &
     &-8.5554302E-02, 4.7116715E-02,-1.8459917E-03, 1.4672441E+00,      &
     &-1.2994897E-01, 4.8528191E-02,-3.6082149E-02, 1.0141018E-03,      &
     & 4.4826970E-02,-2.2088569E-02, 4.0836148E-03,-7.7635348E-03,      &
     &-3.8466251E-01, 3.4625689E-04,-2.6817308E-03, 4.9323872E-02,      &
     &-1.0395080E-01, 5.6546148E-02,-2.7421911E-03, 2.2427187E+00,      &
     &-1.7973506E-01, 1.8711668E-02,-5.0824285E-02, 1.0752089E-03,      &
     & 5.9541222E-02,-2.4272066E-02, 6.2205270E-03,-1.0356113E-02,      &
     &-4.6784776E-01,-4.2101776E-05,-2.7494796E-03, 6.7202806E-02,      &
     &-1.3865042E-01, 7.1610272E-02,-3.6068503E-03, 2.5239811E+00,      &
     &-2.3537189E-01,-6.2303532E-02,-6.3410640E-02, 1.0908414E-03,      &
     & 8.5864305E-02,-4.0465321E-02, 6.7511238E-03,-1.5032519E-02,      &
     &-5.3204876E-01, 2.6173261E-04,-3.8463329E-03, 9.7581804E-02,      &
     &-1.9440979E-01, 9.4935060E-02,-3.1414882E-03, 2.7852774E+00,      &
     &-2.8988993E-01,-2.0397222E-01,-8.0623806E-02, 1.1886319E-03/
      DATA B11/                                                         &
     & 1.2287539E-01,-6.0318012E-02, 6.5601021E-03,-1.9143425E-02,      &
     &-6.1232585E-01,-6.1348954E-05,-5.3325333E-03, 1.3366205E-01,      &
     &-2.7088326E-01, 1.3617229E-01,-2.4415229E-03, 3.3422728E+00,      &
     &-3.4385902E-01,-1.6500336E-01,-8.9365721E-02, 2.3261967E-04,      &
     & 1.5902001E-01,-9.4836116E-02, 4.9963929E-03,-1.7859895E-02,      &
     &-6.7542911E-01, 5.0253857E-07,-6.5144524E-03, 1.4190704E-01,      &
     &-2.5369573E-01, 1.1523426E-01,-2.6327048E-03, 4.1193476E+00,      &
     &-4.0217543E-01,-6.6726983E-02,-9.4278574E-02, 2.1160927E-04,      &
     & 1.9086862E-01,-1.2050396E-01, 3.6971525E-03,-1.9956112E-02,      &
     &-7.0864362E-01, 5.1669008E-04,-6.4480454E-03, 1.2268627E-01,      &
     &-1.9227093E-01, 7.6582491E-02,-3.3759619E-03, 4.8675528E+00,      &
     &-4.3510795E-01, 1.0188390E-02,-9.3770385E-02, 7.1982155E-04,      &
     & 1.9992542E-01,-1.0092729E-01, 2.8588565E-03,-9.3777515E-03,      &
     &-8.0846542E-01,-7.9802098E-04,-3.5866818E-03, 1.2091875E-01,      &
     &-1.7696083E-01, 7.6379836E-02, 1.4869310E-03, 5.2954960E+00,      &
     &-4.4283944E-01, 1.1750218E-02,-8.7529778E-02,-2.1971346E-04/
      DATA B12/                                                         &
     & 2.1761668E-01,-5.8880605E-02, 3.7807501E-03,-1.0952000E-02,      &
     &-8.7034750E-01,-3.1192892E-03,-7.1197003E-04, 1.2945777E-01,      &
     &-2.3012006E-01, 1.1647296E-01, 5.4157451E-03, 4.4113598E+00,      &
     &-3.9268637E-01,-5.5132401E-01,-8.6746812E-02,-1.0543189E-03,      &
     & 2.2825044E-01,-6.1736152E-02, 2.9679062E-03,-5.8903126E-04,      &
     &-7.5253463E-01,-2.8592332E-03, 8.1750425E-04, 1.1290991E-01,      &
     &-1.9584531E-01, 1.0525864E-01, 5.2956678E-03, 2.9335270E+00,      &
     &-2.4896461E-01, 3.9581791E-02,-7.2306216E-02,-1.7494988E-03,      &
     & 2.6344782E-01,-8.4367216E-02,-7.4542346E-05, 1.0698564E-02,      &
     &-7.2073323E-01,-3.5122959E-03, 3.5135404E-03, 1.2110317E-01,      &
     &-3.3286446E-01, 2.3396415E-01, 1.2389731E-02, 1.9491110E+00,      &
     &-2.3601991E-01,-1.3911504E-01,-6.9997311E-02,-3.5733753E-03,      &
     & 2.6727527E-01,-4.5189403E-02, 4.5224745E-04, 1.0676917E-02,      &
     &-8.1611729E-01,-3.1356914E-03, 6.1511323E-03, 1.7304772E-01,      &
     &-5.2065587E-01, 3.6191893E-01, 1.4832411E-02, 2.4400940E+00,      &
     &-2.1888667E-01,-4.0147001E-01,-8.0096543E-02,-3.1546338E-03/
      DATA B13/                                                         &
     & 2.6671880E-01, 3.0235711E-02, 1.6169844E-03, 6.1581396E-03,      &
     &-7.3124474E-01,-4.3488741E-03, 9.6328929E-03, 2.0126683E-01,      &
     &-6.6993481E-01, 4.6675467E-01, 2.2258069E-02, 1.4543400E+00,      &
     &-1.7674601E-01,-4.4420338E-01,-7.8558505E-02,-4.8801601E-03,      &
     & 3.8780212E-01,-6.9581628E-02,-3.3410592E-04,-4.0026840E-02,      &
     &-8.3621517E-03, 6.8011843E-03,-1.1478148E-02, 2.3079091E-01,      &
     &-8.1555879E-01, 5.3140473E-01, 1.9388735E-02,-4.5359688E+00,      &
     &-3.5079455E-01, 6.4898193E-02,-7.2210491E-02,-9.8634884E-03/
!
!***  SET COEFFICIENTS IN BT ARRAY
!
      L = (IA-2)*16
      IF(IM .GE. 2) L = L+(IM-2)*288
      IF(IA .EQ. 1) GO TO 1020
        DO 1010 K=1,16
           BT(I,J,K) = BSUB(K+L)
 1010   CONTINUE
 1020 CONTINUE
      IF(IA .NE. 1) GO TO 1040
        DO 1030 K=1,16
           BT(I,J,K) = 0.0
 1030   CONTINUE
 1040 CONTINUE
      RETURN
      END

      SUBROUTINE TBSUP(BT,IM,IA,I,J)
!
!***  SUPERSONIC CD REGRESSION COEFFICIENT TABLES
!
      DIMENSION BSUP(992), BT(2,2,16)
      DIMENSION B0(32),B1(64),B2(64),B3(64),B4(64),B5(64),B6(64),B7(64),&
     & B8(64),B9(64),B10(64),B11(64),B12(64),B13(64),B14(64),B15(64)
      EQUIVALENCE (BSUP(1),B0(1)),(BSUP(33),B1(1)),(BSUP(97),B2(1)),    &
     & (BSUP(161),B3(1)),(BSUP(225),B4(1)),(BSUP(289),B5(1)),(BSUP(353),&
     & B6(1)),(BSUP(417),B7(1)),(BSUP(481),B8(1)),(BSUP(545),B9(1)),    &
     & (BSUP(609),B10(1)),(BSUP(673),B11(1)),(BSUP(737),B12(1)),        &
     & (BSUP(801),B13(1)),(BSUP(865),B14(1)),(BSUP(929),B15(1))
      DATA B0/                                                          &
     & 1.5717184E-03,-5.5700466E-03,-6.7221350E-04,-6.6786236E-04,      &
     & 4.5433097E-02, 1.9969669E-04, 4.9256161E-04,-3.9831223E-04,      &
     & 8.8362326E-04,-2.0623957E-03,-1.7651034E-04,-2.1100503E-01,      &
     &-1.5906308E-02,-5.8513694E-02,-4.3496676E-03, 2.3648779E-04,      &
     & 2.8257142E-03,-3.8502382E-03,-3.5448885E-04,-2.3076360E-03,      &
     & 8.0265760E-02, 1.9736888E-04, 6.5163989E-04, 5.5585690E-03,      &
     &-1.7227579E-02, 8.8902526E-03,-6.5323198E-04,-3.1471908E-01,      &
     &-2.9924247E-02,-1.3305247E-01,-9.2919767E-03, 3.0221208E-04/
      DATA B1/                                                          &
     & 5.8026873E-03,-5.4304041E-03, 1.1356993E-04,-4.3565184E-03,      &
     & 1.3015795E-01, 4.3597189E-04, 6.5868115E-04, 1.0743231E-02,      &
     &-3.2760568E-02, 1.7901681E-02,-1.1229164E-03,-5.2483147E-01,      &
     &-4.7191650E-02,-1.7721927E-01,-1.3921127E-02, 4.2885845E-04,      &
     & 1.1259273E-02,-7.5504221E-03, 6.0383906E-04,-6.0745366E-03,      &
     & 1.6445410E-01, 3.6491570E-04, 9.4841118E-04, 1.4162526E-02,      &
     &-4.1425139E-02, 2.2824090E-02,-1.5103582E-03,-6.1569637E-01,      &
     &-4.1590594E-02,-2.9398423E-01,-1.8730205E-02, 6.1874581E-04,      &
     & 1.7104805E-02,-6.0239695E-03, 1.4733670E-03,-8.8670887E-03,      &
     & 2.1079546E-01, 5.1905285E-04, 9.2106755E-04, 3.0551378E-02,      &
     &-9.0429366E-02, 5.4294515E-02,-1.7200711E-03,-9.1571760E-01,      &
     &-4.3965105E-02,-4.3206471E-01,-2.3758709E-02, 6.5149274E-04,      &
     & 3.5414886E-02,-1.8187631E-02, 1.0119069E-03,-1.1398517E-02,      &
     & 2.2765297E-01, 4.3173903E-04, 8.3171879E-04, 4.1358300E-02,      &
     &-1.2409329E-01, 7.6495469E-02,-1.8796935E-03,-1.0617819E+00,      &
     &-6.0352813E-02,-5.3016973E-01,-2.9246125E-02, 7.0819352E-04/
      DATA B2/                                                          &
     & 4.0508699E-02,-6.9953352E-03, 3.7614508E-03,-1.6017113E-02,      &
     & 2.4154270E-01, 4.2003719E-04, 5.8566779E-04, 6.1882053E-02,      &
     &-1.9356030E-01, 1.2307751E-01,-1.8342079E-03,-1.2961531E+00,      &
     &-1.6771871E-01,-2.9733801E-01,-3.3139993E-02, 6.2378077E-04,      &
     & 4.4782519E-02,-2.3231246E-03, 5.8262609E-03,-1.8171132E-02,      &
     & 3.4975761E-01, 8.4107416E-04, 3.4309970E-04, 9.6824050E-02,      &
     &-3.0521387E-01, 2.0226133E-01,-2.0165278E-03,-2.3052807E+00,      &
     &-2.1497500E-01,-2.6740837E-01,-3.5876211E-02, 3.7453347E-04,      &
     & 7.5643957E-02,-5.0938539E-03, 5.0935261E-03,-2.7627815E-02,      &
     & 2.0858008E-01, 9.8990975E-04, 1.0354072E-03, 1.9818991E-01,      &
     &-8.5614425E-01, 9.2463863E-01,-1.9272324E-03,-1.1698952E+00,      &
     &-2.4628538E-01,-2.9800701E-01,-4.4002920E-02, 2.9098615E-04,      &
     & 8.9508355E-02, 4.7311336E-03, 6.3212477E-03,-3.4299817E-02,      &
     & 1.6744292E-01, 1.1966927E-03, 2.0405187E-03, 2.2721785E-01,      &
     &-9.5835030E-01, 1.0188208E+00,-2.1926428E-03,-8.3806533E-01,      &
     &-2.5079250E-01,-4.5710349E-01,-5.2179825E-02, 8.1577641E-04/
      DATA B3/                                                          &
     & 1.1793149E-01,-2.7643261E-04, 5.0241314E-03,-4.1276652E-02,      &
     & 1.8049902E-01, 1.6180850E-03, 1.8227042E-03, 2.7364743E-01,      &
     &-1.1535187E+00, 1.2400064E+00,-2.4140305E-03,-9.9790037E-01,      &
     &-2.3820037E-01,-6.6717249E-01,-5.8831919E-02, 9.0829190E-04,      &
     & 8.8744104E-02, 8.1425250E-02, 1.5197407E-02,-4.9329646E-02,      &
     & 2.1049070E-01, 9.0273307E-04, 1.7016903E-03, 3.2167429E-01,      &
     &-1.3444300E+00, 1.4777508E+00,-1.5604387E-03,-1.4272690E+00,      &
     &-2.2909129E-01,-9.1669220E-01,-6.6604555E-02, 7.3630456E-04,      &
     & 2.6017374E-01,-1.2899333E-01,-1.3720281E-02,-4.6684947E-02,      &
     & 1.2047046E-01, 3.6295160E-06, 8.8611767E-03, 1.3441545E-01,      &
     & 6.4673007E-02,-1.0414906E+00,-1.3121774E-03,-9.1704094E-01,      &
     &-1.6346151E-01,-1.4330578E+00,-7.2094738E-02, 2.0774666E-03,      &
     & 6.1492462E-02, 1.2399387E-01, 1.5979007E-02,-2.8680041E-02,      &
     & 4.0721285E-01,-1.7349173E-03, 1.7846879E-02,-2.6916236E-02,      &
     & 8.1493968E-01,-1.7609768E+00,-9.1541037E-03,-5.6136656E+00,      &
     &-2.2960347E-01,-5.2901018E-01,-4.9244829E-02, 5.4983273E-03/
      DATA B4/                                                          &
     & 3.2683957E-01,-6.6896528E-03,-2.3096970E-03,-9.1526151E-02,      &
     & 1.3367563E-01,-1.6098224E-04,-1.1506498E-02, 2.6981944E-01,      &
     &-1.4873152E+00, 2.1998997E+00, 7.5700991E-03, 6.2406600E-02,      &
     &-1.4656562E-01,-5.5797076E-01,-6.5950394E-02,-5.3990260E-03,      &
     & 2.8498890E-04,-5.3122416E-03,-4.7327718E-04, 8.3419634E-04,      &
     & 1.8600196E-02, 1.6462979E-04, 4.0729996E-04, 4.4746958E-03,      &
     &-1.4914565E-02, 1.1247303E-02,-4.2477134E-04,-4.6999101E-02,      &
     &-2.7665038E-02,-3.1455111E-02,-4.4299774E-03, 2.5001471E-04,      &
     & 5.7168044E-03,-1.0907125E-02,-9.8532159E-04, 4.4312887E-04,      &
     & 4.7452450E-02, 1.1061637E-04, 5.4226350E-04, 7.7934414E-03,      &
     &-2.1100592E-02, 1.3910402E-02,-1.1105875E-03,-1.2996060E-01,      &
     &-3.9316908E-02,-1.2354779E-01,-9.3897395E-03, 3.3393386E-04,      &
     & 6.9129579E-03,-8.7888688E-03,-1.8833959E-04,-1.7756638E-03,      &
     & 1.0148674E-01, 3.2612006E-04, 5.8121351E-04, 1.7927404E-02,      &
     &-5.5550288E-02, 3.6401641E-02,-1.3470983E-03,-4.4197243E-01,      &
     &-7.6085269E-02,-1.2497246E-01,-1.3704408E-02, 3.2444601E-04/
      DATA B5/                                                          &
     & 2.0233776E-02,-2.7250145E-02,-1.7159635E-03,-1.0670125E-04,      &
     & 1.0140586E-01, 2.2984378E-04, 1.1189913E-03, 2.6097652E-02,      &
     &-8.1923783E-02, 5.7257861E-02,-2.6001539E-03,-2.8129286E-01,      &
     &-6.6458285E-02,-2.6070029E-01,-1.8204123E-02, 7.1642711E-04,      &
     & 2.6406936E-02,-1.8461902E-02,-2.0333633E-04,-5.9163682E-03,      &
     & 1.8506855E-01, 3.6382070E-04, 4.4824765E-04, 4.7441926E-02,      &
     &-1.4930493E-01, 9.8945737E-02,-2.0486452E-03,-1.0228863E+00,      &
     &-8.0170155E-02,-4.0137005E-01,-2.3067784E-02, 3.2602693E-04,      &
     & 4.9581446E-02,-5.1078152E-02,-2.8307033E-03,-2.2647688E-03,      &
     & 1.3830286E-01, 3.6345399E-04, 1.0209796E-03, 6.1698198E-02,      &
     &-1.9775021E-01, 1.3912916E-01,-3.8974225E-03,-5.8817279E-01,      &
     &-1.0356367E-01,-4.3000740E-01,-2.7580567E-02, 9.1349124E-04,      &
     & 6.2587678E-02,-4.7287542E-02,-1.7235894E-03,-8.3835237E-03,      &
     & 1.6567224E-01, 3.8203108E-04, 7.0223236E-04, 7.8768671E-02,      &
     &-2.5819415E-01, 1.7830962E-01,-3.5804464E-03,-7.7265549E-01,      &
     &-1.5294063E-01,-4.1351551E-01,-3.2753982E-02, 8.2940981E-04/
      DATA B6/                                                          &
     & 7.8265071E-02,-4.6380412E-02,-1.1082306E-03,-1.4979817E-02,      &
     & 2.5049061E-01, 7.2248653E-04, 3.4859404E-04, 1.1264056E-01,      &
     &-3.7443507E-01, 2.5662607E-01,-3.2819489E-03,-1.4194174E+00,      &
     &-1.8419623E-01,-4.5613551E-01,-3.6509410E-02, 4.1331793E-04,      &
     & 9.5227361E-02,-4.5530312E-02,-3.3881562E-04,-2.1967027E-02,      &
     & 3.1504375E-01, 1.2632590E-03,-7.4554948E-05, 1.5081030E-01,      &
     &-5.0534177E-01, 3.4529853E-01,-2.7078558E-03,-2.0093794E+00,      &
     &-2.2162628E-01,-4.8579741E-01,-4.0820625E-02, 6.2955631E-05,      &
     & 1.0838383E-01,-4.6227898E-02, 9.2471787E-04,-2.5049213E-02,      &
     & 3.8814557E-01, 2.0727583E-03,-1.3277524E-03, 2.3586398E-01,      &
     &-9.8430997E-01, 1.0508442E+00,-3.3296575E-03,-3.0443802E+00,      &
     &-2.8647441E-01,-4.3661970E-01,-4.5595527E-02,-7.4869866E-05,      &
     & 1.1457300E-01,-2.8877839E-02, 3.3465268E-03,-3.0593827E-02,      &
     & 4.8120242E-01, 2.6709191E-03,-2.2342431E-03, 2.6174480E-01,      &
     &-1.0283461E+00, 1.0423613E+00,-4.3941848E-03,-4.0852242E+00,      &
     &-3.0031824E-01,-5.7579136E-01,-4.9764726E-02,-2.3119836E-05/
      DATA B7/                                                          &
     & 1.5791512E-01,-5.2944232E-02,-4.8504188E-04,-3.7158284E-02,      &
     & 5.3227824E-01, 2.9057458E-03,-2.4003098E-03, 2.4543381E-01,      &
     &-8.2994896E-01, 6.5777051E-01,-4.5329742E-03,-4.5954571E+00,      &
     &-3.0269217E-01,-6.7817974E-01,-5.2505884E-02,-1.4827498E-04,      &
     & 2.1436656E-01,-1.2313372E-01,-7.9717748E-03,-2.9757120E-02,      &
     & 5.9260166E-01, 2.1987346E-03,-5.3911633E-04, 1.8632692E-01,      &
     &-3.0029172E-01,-2.4103880E-01,-5.4350719E-03,-5.9907122E+00,      &
     &-3.0105782E-01,-9.6184230E-01,-5.7398912E-02, 5.3597265E-04,      &
     & 6.3908041E-02, 9.5217407E-02, 1.7300107E-02,-3.0306865E-02,      &
     & 6.2570256E-01, 7.8790286E-04, 1.0177456E-02, 8.0630109E-03,      &
     & 6.0273206E-01,-1.4295626E+00,-1.2468692E-02,-7.4822655E+00,      &
     &-3.1863153E-01,-3.2659590E-01,-4.3914106E-02, 4.4481419E-03,      &
     & 3.2105953E-01,-7.2313011E-02,-8.1952326E-03,-7.2688222E-02,      &
     & 2.2147197E-01, 3.0024443E-04,-4.8274249E-03, 1.6214252E-01,      &
     &-4.9649966E-01, 3.1937712E-01, 3.1721103E-04,-2.9665070E+00,      &
     &-2.6121581E-01,-4.1800648E-01,-5.2504890E-02,-2.7403075E-03/
      DATA B8/                                                          &
     & 1.0309482E+02,-1.3005202E+02,-2.3012100E+01,-1.2115091E-01,      &
     & 1.4138308E+00,-2.6343501E-01, 5.0732613E+00,-1.4125533E+02,      &
     & 5.8965918E+02,-6.7716602E+02,-1.3511839E+00,-1.3475837E+01,      &
     &-1.4472121E+02, 3.9029053E+02, 3.7379187E-01, 1.4025860E+00,      &
     & 7.5908371E+01,-9.6810486E+01,-1.7289978E+01, 4.3793344E-01,      &
     & 2.4648123E+00,-2.0733470E-01, 3.9949751E+00,-1.0887743E+02,      &
     & 4.7299927E+02,-5.6211011E+02,-1.1336718E+00,-2.1364975E+01,      &
     &-1.2112621E+02, 2.7107422E+02, 2.8760785E-01, 1.1458359E+00,      &
     & 2.7387615E-02,-4.2330150E-02,-6.0628243E-03, 3.8112486E-03,      &
     &-2.8754823E-02, 2.9096194E-04,-4.4616149E-04, 4.0978350E-02,      &
     &-2.3030299E-01, 3.8556767E-01,-4.6118838E-04, 2.6480138E-01,      &
     &-1.2756526E-02,-1.4412636E-01,-6.7714192E-03, 2.5816495E-04,      &
     & 7.5531483E-02,-1.1930120E-01,-1.5860379E-02, 1.1707801E-02,      &
     &-7.6296568E-02, 5.5521145E-04,-1.6613540E-03, 9.2609525E-02,      &
     &-5.6299067E-01, 1.0321112E+00,-1.1576842E-04, 1.1387911E+00,      &
     & 7.3925965E-03,-4.5431155E-01,-1.8369012E-02, 4.8476155E-04/
      DATA B9/                                                          &
     & 7.3637486E-02,-1.1607260E-01,-1.4757369E-02, 1.1193775E-02,      &
     &-5.2013822E-02, 5.6307274E-04,-1.3739574E-03, 9.6646965E-02,      &
     &-5.7350475E-01, 1.0293074E+00,-3.7078094E-04, 1.0143557E+00,      &
     &-1.4887296E-02,-4.5917094E-01,-2.1025252E-02, 5.7766377E-04,      &
     & 8.8199019E-02,-1.3064516E-01,-1.6898066E-02, 1.0671578E-02,      &
     &-4.0462907E-02, 7.2689052E-04,-1.3882199E-03, 1.1594808E-01,      &
     &-6.4778244E-01, 1.1095295E+00,-8.2193292E-04, 9.2579538E-01,      &
     &-3.8590748E-02,-5.6613153E-01,-2.5212675E-02, 7.6030940E-04,      &
     & 1.0523760E-01,-1.5033787E-01,-1.9151550E-02, 1.1211928E-02,      &
     &-6.0028695E-03, 8.5212197E-04,-1.7641813E-03, 1.3154233E-01,      &
     &-7.0979226E-01, 1.1921778E+00,-1.3237207E-03, 7.8750551E-01,      &
     &-4.9744342E-02,-5.7770431E-01,-2.8093573E-02, 7.8722835E-04,      &
     & 1.1737049E-01,-1.5988612E-01,-2.0159863E-02, 1.0735605E-02,      &
     & 8.5135475E-03, 9.7355922E-04,-2.0010802E-03, 1.5481895E-01,      &
     &-8.1082445E-01, 1.3145161E+00,-1.4846984E-03, 6.5558118E-01,      &
     &-5.5152312E-02,-6.5603822E-01,-3.1213842E-02, 8.9811301E-04/
      DATA B10/                                                         &
     & 1.3004541E-01,-1.6403019E-01,-2.0191576E-02, 8.2285069E-03,      &
     & 1.7408796E-02, 9.7052683E-04,-2.1154052E-03, 1.7280453E-01,      &
     &-8.9271122E-01, 1.4154263E+00,-2.0835286E-03, 5.1475871E-01,      &
     &-8.4634483E-02,-6.4573163E-01,-3.3676412E-02, 9.4391406E-04,      &
     & 1.5887111E-01,-1.9847751E-01,-2.3208123E-02, 9.2810616E-03,      &
     & 1.6714267E-02, 1.1371044E-03,-1.8648701E-03, 1.7449427E-01,      &
     &-8.3011693E-01, 1.2539473E+00,-4.1271076E-03, 1.7722780E-01,      &
     &-1.1120433E-01,-7.4441063E-01,-3.7707821E-02, 1.5162942E-03,      &
     & 1.9314319E-01,-2.2421050E-01,-2.7555265E-02, 7.8785494E-03,      &
     & 4.2635173E-02, 1.0047555E-03,-2.3568105E-03, 2.1283627E-01,      &
     &-9.9933976E-01, 1.4784222E+00,-5.0732866E-03,-4.6474416E-02,      &
     &-1.3301516E-01,-8.3799392E-01,-4.2212036E-02, 1.4126776E-03,      &
     & 2.1766388E-01,-2.3029006E-01,-2.9666249E-02, 3.9421320E-03,      &
     & 6.6348553E-02, 8.6828368E-04,-3.2125418E-03, 2.5792521E-01,      &
     &-1.2385139E+00, 1.8380232E+00,-4.9258322E-03, 8.1670821E-02,      &
     &-1.4411247E-01,-9.4663727E-01,-4.8354071E-02, 1.1299879E-03/
      DATA B11/                                                         &
     & 2.2137988E-01,-2.2947663E-01,-2.4799198E-02, 3.0378439E-04,      &
     & 3.9118253E-02, 9.3714590E-04,-2.5049171E-03, 2.2251439E-01,      &
     &-1.0012665E+00, 1.4051371E+00,-4.3573119E-03,-8.6586401E-03,      &
     &-1.7335927E-01,-9.1346842E-01,-5.0401237E-02, 1.5416581E-03,      &
     & 2.7412516E-01,-2.7002317E-01,-3.1684224E-02,-1.5157529E-03,      &
     &-2.5660437E-02, 8.8664959E-04,-3.9822310E-03, 2.8785282E-01,      &
     &-1.3088446E+00, 1.8582716E+00,-4.9439259E-03, 4.2449540E-01,      &
     &-1.7793602E-01,-1.1674767E+00,-6.0587019E-02, 1.5869397E-03,      &
     & 2.9046643E-01,-2.5720716E-01,-3.3396740E-02,-2.3175760E-03,      &
     & 4.5531724E-02, 3.5714405E-04,-4.7665648E-03, 3.6357272E-01,      &
     &-1.6300116E+00, 2.3121529E+00,-6.5617934E-03,-4.5700359E-01,      &
     &-1.9870216E-01,-1.3009109E+00,-6.4126313E-02, 1.1724164E-03,      &
     & 3.7017083E-01,-3.4377474E-01,-4.4536438E-02, 9.9785440E-04,      &
     & 4.5074280E-02, 7.5078942E-04,-4.2091906E-03, 2.8733134E-01,      &
     &-1.0796824E+00, 1.3993578E+00,-1.2873624E-02,-9.1426355E-01,      &
     &-2.1462172E-01,-1.3187160E+00,-6.3968480E-02, 1.5975442E-03/
      DATA B12/                                                         &
     & 5.6237203E-01,-4.7764897E-01,-6.8684459E-02,-2.9807582E-02,      &
     &-1.9183779E-01,-1.0262821E-03,-6.4707771E-03, 1.3656509E-01,      &
     &-1.8101364E-01,-6.4236045E-02,-3.6258749E-03, 2.2768555E+00,      &
     &-1.0917521E-01,-1.6253319E+00,-6.6635489E-02,-1.4473058E-03,      &
     & 4.7805496E-03,-1.2276512E-02,-1.9984050E-03, 1.7768168E-03,      &
     & 2.2675864E-02, 4.1828258E-04, 4.5887288E-04, 3.4987438E-02,      &
     &-1.9529223E-01, 3.0677694E-01,-2.5219214E-03,-3.1167817E-01,      &
     &-4.5739125E-02, 1.0783654E-01,-1.9751543E-03, 4.5508938E-04,      &
     &-2.9007045E-03, 2.5523284E-03, 3.1956402E-04,-9.3582645E-04,      &
     & 1.7385455E-03, 5.2359444E-04, 2.9930612E-04, 1.7273296E-02,      &
     &-4.5367934E-02,-1.6345140E-02,-4.3555908E-04,-4.4533628E-01,      &
     &-6.0100906E-02, 9.2365444E-02,-3.2494017E-03, 4.2471476E-04,      &
     &-6.4333752E-03, 1.8130589E-02, 2.5372603E-03,-5.4796152E-03,      &
     &-4.8227388E-02, 5.7263742E-04,-3.3506984E-04, 4.8257150E-03,      &
     & 8.4923029E-02,-3.1594837E-01, 3.0744544E-03,-6.2776160E-01,      &
     &-6.7924738E-02, 1.1731938E-02,-5.5057928E-03, 3.5271654E-04/
      DATA B13/                                                         &
     & 3.0389261E-02,-1.0178760E-02,-2.8880809E-03,-8.0600381E-03,      &
     &-6.6625834E-02, 3.5197800E-04,-1.2979091E-03, 1.2342554E-02,      &
     & 6.0247075E-02,-2.3701692E-01, 2.2336019E-03,-9.5984334E-01,      &
     &-8.6037040E-02,-8.5495234E-02,-9.3495138E-03, 9.7228418E-05,      &
     & 1.8151206E-01,-1.3661373E-01,-2.8391641E-02,-1.1666249E-02,      &
     &-1.7354834E-01,-1.9385093E-03,-4.3792315E-03, 3.7978776E-02,      &
     &-1.8556315E-01, 5.7010692E-01,-3.3418220E-03,-1.5261912E-01,      &
     &-1.6765743E-02,-5.8262229E-01,-1.8179499E-02,-1.4450576E-03,      &
     & 1.0364610E-01,-4.7534958E-02,-1.2211327E-02,-1.5961967E-02,      &
     &-1.0382479E-01,-1.0918023E-03,-3.0518321E-03, 1.7073181E-02,      &
     & 4.9869910E-02,-1.1415601E-01,-1.5673212E-04,-1.0347996E+00,      &
     &-9.6588135E-02,-3.5116071E-01,-1.8339381E-02,-7.6613971E-04,      &
     & 5.3759616E-02,-1.1563074E-02,-2.5948319E-03,-1.3079338E-02,      &
     &-3.6176451E-02, 1.4587956E-04,-1.7846688E-03, 4.6563175E-02,      &
     &-3.5740022E-02,-2.2868168E-01, 1.4883834E-03,-1.9852238E+00,      &
     &-1.5008712E-01,-2.4464434E-01,-1.8983170E-02, 2.6471145E-04/
      DATA B14/                                                         &
     & 9.8621368E-02,-4.7719564E-02,-9.6658319E-03,-1.5190229E-02,      &
     &-7.9239607E-02, 1.5356127E-05,-2.4184147E-03, 6.3840508E-02,      &
     &-1.2008440E-01,-3.3243474E-02, 6.0782349E-04,-1.4693499E+00,      &
     &-1.2705547E-01,-3.8721561E-01,-2.2821467E-02, 1.8927944E-04,      &
     & 1.5346801E-01,-9.0789378E-02,-1.7544948E-02,-1.8107802E-02,      &
     &-1.1203671E-01,-4.2634108E-04,-3.4485965E-03, 8.9770854E-02,      &
     &-2.0825207E-01, 9.9317849E-02,-3.1763059E-04,-2.0230494E+00,      &
     &-1.8926787E-01,-4.1734248E-01,-2.7243305E-02, 1.3330036E-04,      &
     & 2.3160577E-01,-1.4987737E-01,-2.7984858E-02,-2.3340337E-02,      &
     &-1.8635339E-01,-9.6836174E-04,-5.4502748E-03, 1.1321354E-01,      &
     &-2.5011772E-01, 1.8654537E-01,-2.7122039E-03,-2.2983761E+00,      &
     &-1.9130319E-01,-7.2356349E-01,-3.3868816E-02,-3.8054609E-04,      &
     & 2.1701658E-01,-1.2738901E-01,-2.0260531E-02,-3.3223458E-02,      &
     &-1.9810200E-01,-5.6096050E-04,-3.5920439E-03,-2.8254136E-02,      &
     & 5.4325986E-01,-1.2876196E+00, 6.7245029E-03,-6.7739064E-01,      &
     &-1.4314359E-01,-6.6562527E-01,-3.3537719E-02,-6.4897514E-04/
      DATA B15/                                                         &
     & 2.4584615E-01,-1.4099550E-01,-2.1596991E-02,-3.7543029E-02,      &
     &-1.5241861E-01,-3.2746815E-04,-3.4566999E-03,-2.7548864E-02,      &
     & 5.8868009E-01,-1.4313002E+00, 3.2735954E-03,-8.8389754E-01,      &
     &-1.4942884E-01,-7.5084007E-01,-3.5038725E-02,-1.0538469E-03,      &
     & 3.6687100E-01,-3.5415769E-01,-4.8820660E-02,-5.7605952E-03,      &
     & 3.5939205E-01, 8.0775074E-04, 6.2195398E-04,-7.1572587E-03,      &
     & 5.0163835E-01,-1.0275488E+00,-1.3861593E-02,-4.0093346E+00,      &
     &-1.4865065E-01,-8.4246713E-01,-2.8966583E-02,-1.3190280E-03,      &
     & 2.0577502E-01,-2.4661911E-01,-2.4170250E-02, 2.7980328E-02,      &
     & 6.1627299E-01, 1.2965780E-03, 7.4954815E-03,-2.1773446E-02,      &
     & 8.2050377E-01,-1.6821280E+00,-1.2200680E-02,-7.3919821E+00,      &
     &-1.6566443E-01,-7.2136760E-01,-1.5952006E-02, 9.2987879E-04,      &
     & 3.8158900E-01,-2.8579533E-01,-3.4468174E-02,-3.8791385E-02,      &
     & 1.3253514E-02,-4.0069013E-04,-7.3571480E-04,-3.2694399E-01,      &
     & 2.6763926E+00,-4.9027834E+00, 6.3298978E-03,-2.6522093E+00,      &
     &-1.1596638E-01,-1.1869135E+00,-3.0437835E-02,-1.9400157E-03/
!
!***  SET COEFFICIENTS IN BT ARRAY
!
      L = (IA-2)*16+(IM-11)*240
      IF(IM .GT. 12) L = L+32
      IF(IA .EQ. 1) GO TO 1020
        DO 1010 K=1,16
           BT(I,J,K) = BSUP(K+L)
 1010   CONTINUE
 1020 CONTINUE
      IF(IA .NE. 1) GO TO 1040
        DO 1030 K=1,16
           BT(I,J,K) = 0.0
 1030   CONTINUE
 1040 CONTINUE
      RETURN
      END

      SUBROUTINE TBTRN(BT,IM,IA,I,J)
!
!***  TRANSONIC CD REGRESSION COEFFICIENT TABLES
!
      DIMENSION BTRN(1376), BT(2,2,16)
      DIMENSION B0(32),B1(64),B2(64),B3(64),B4(64),B5(64),B6(64),B7(64),&
     & B8(64),B9(64),B10(64),B11(64),B12(64),B13(64),B14(64),B15(64),   &
     & B16(32),B17(64),B18(64),B19(64),B20(64),B21(64),B22(32)
      EQUIVALENCE (BTRN(1),B0(1)),(BTRN(33),B1(1)),(BTRN(97),B2(1)),    &
     & (BTRN(161),B3(1)),(BTRN(225),B4(1)),(BTRN(289),B5(1)),(BTRN(353),&
     & B6(1)),(BTRN(417),B7(1)),(BTRN(481),B8(1)),(BTRN(545),B9(1)),    &
     & (BTRN(609),B10(1)),(BTRN(673),B11(1)),(BTRN(737),B12(1)),        &
     & (BTRN(801),B13(1)),(BTRN(865),B14(1)),(BTRN(929),B15(1)),        &
     & (BTRN(993),B16(1)),(BTRN(1025),B17(1)),(BTRN(1089),B18(1)),      &
     & (BTRN(1153),B19(1)),(BTRN(1217),B20(1)),(BTRN(1281),B21(1)),     &
     & (BTRN(1345),B22(1))
      DATA B0/                                                          &
     &-1.8315732E-04, 1.4904968E-03, 4.9100700E-04,-7.2902977E-04,      &
     &-1.2882408E-02, 2.0038235E-05,-2.8866064E-04, 3.6838984E-03,      &
     &-5.6397952E-03, 1.7120780E-03,-3.4221099E-04, 1.5303886E-01,      &
     &-3.8906094E-02, 9.4665349E-02,-5.6352280E-03, 9.4005780E-05,      &
     & 8.4985886E-04, 2.2753149E-03, 1.2139117E-03,-1.9444805E-03,      &
     &-3.0231249E-02, 1.9718893E-04,-7.1771769E-04, 1.1442073E-02,      &
     &-2.5204904E-02, 1.3291374E-02,-5.8452762E-04, 4.6100587E-01,      &
     &-7.9864979E-02, 2.0140100E-01,-1.1692267E-02, 1.5516086E-04/
      DATA B1/                                                          &
     & 6.8637617E-03, 5.8076403E-05, 2.1980554E-03,-4.5152046E-03,      &
     &-9.0503812E-02, 3.3344934E-04,-1.1855881E-03, 1.2941897E-02,      &
     &-2.2365227E-02, 7.2805658E-03,-9.3974429E-04, 1.0996056E+00,      &
     &-1.0832834E-01, 2.7199489E-01,-1.9038562E-02, 3.9532199E-04,      &
     & 1.6547330E-02, 1.5234824E-03, 3.8060127E-03,-9.3904212E-03,      &
     &-1.6820127E-01, 4.3695141E-04,-1.9827981E-03, 1.8285669E-02,      &
     &-2.7148519E-02, 4.1803941E-03,-9.2432648E-04, 1.8114605E+00,      &
     &-1.4271629E-01, 2.8821057E-01,-2.8602239E-02, 3.9998116E-04,      &
     & 3.4211360E-02, 2.4975883E-04, 5.8537498E-03,-1.6057417E-02,      &
     &-3.1664699E-01, 1.0835205E-04,-2.5042477E-03, 3.0073531E-02,      &
     &-5.6542072E-02, 1.9043300E-02,-1.1706250E-03, 3.0616608E+00,      &
     &-1.6786361E-01, 1.8234819E-01,-4.0810522E-02, 4.6431553E-04,      &
     & 5.0134607E-02, 7.0650913E-03, 8.1698075E-03,-2.3583189E-02,      &
     &-4.0390897E-01,-9.2482282E-05,-2.9379686E-03, 4.8038539E-02,      &
     &-8.5965753E-02, 2.7079105E-02,-1.9826000E-03, 3.4563046E+00,      &
     &-1.9252396E-01, 3.0403920E-02,-5.0237991E-02, 3.1659752E-04/
      DATA B2/                                                          &
     & 7.7802122E-02,-7.1882531E-03, 8.1800558E-03,-2.8506570E-02,      &
     &-4.8391503E-01,-1.3436156E-04,-2.6716236E-03, 7.8751743E-02,      &
     &-1.5669858E-01, 6.5353811E-02,-1.5748416E-03, 3.4860744E+00,      &
     &-2.6545429E-01, 1.1939073E-01,-5.9830014E-02, 2.2231718E-04,      &
     & 1.0209596E-01,-3.6569007E-02, 7.6573752E-03,-2.6713077E-02,      &
     &-4.9372178E-01, 8.0208713E-04,-4.6952106E-03, 1.0509998E-01,      &
     &-1.7726725E-01, 6.8584085E-02,-7.8784302E-04, 3.2339621E+00,      &
     &-3.1885785E-01,-8.0256127E-03,-6.9842577E-02, 2.4971180E-04,      &
     & 1.4499247E-01,-6.0851403E-02, 6.1462857E-03,-3.3273090E-02,      &
     &-5.8207011E-01, 5.4808683E-04,-4.9867891E-03, 1.2259156E-01,      &
     &-2.0620799E-01, 7.8493178E-02,-9.4818021E-04, 3.8511992E+00,      &
     &-3.5199076E-01,-3.4792595E-02,-7.6333702E-02,-9.1280352E-05,      &
     & 1.6458666E-01,-5.2276757E-02, 7.0767030E-03,-3.9389718E-02,      &
     &-5.7416248E-01, 4.0558097E-04,-5.0725043E-03, 1.3288337E-01,      &
     &-2.1749187E-01, 7.2506905E-02, 7.2749425E-04, 3.6967001E+00,      &
     &-3.8079518E-01,-1.3175648E-01,-8.0180407E-02,-3.0679931E-04/
      DATA B3/                                                          &
     & 1.7307633E-01,-1.7651182E-02, 6.3537844E-03,-3.0879196E-02,      &
     &-6.0311192E-01,-1.4658200E-03,-1.6084658E-03, 1.6047710E-01,      &
     &-2.2384375E-01, 5.1799275E-02,-3.3717370E-04, 2.9635668E+00,      &
     &-4.0789211E-01,-3.0354440E-01,-7.4107111E-02,-1.7428468E-03,      &
     & 2.4566621E-01,-1.3234597E-02,-7.5585279E-04,-4.6988498E-02,      &
     &-5.2502745E-01,-3.8114975E-03, 3.5622013E-03, 1.3104153E-01,      &
     &-1.7884916E-01,-1.2996283E-03, 6.9283098E-03, 1.1161480E+00,      &
     &-3.8814515E-01,-3.9059931E-01,-6.3066781E-02,-5.1224791E-03,      &
     & 2.5979853E-01,-2.5032710E-02,-1.4308177E-02,-3.2214381E-02,      &
     & 2.4891783E-02,-2.6503587E-03, 8.9000538E-03, 1.1813259E-01,      &
     &-2.0084804E-01, 1.7586850E-02, 1.6783871E-02,-1.6757784E+00,      &
     &-3.0250698E-01,-3.6090785E-01,-4.9054395E-02,-6.8225004E-03,      &
     & 2.8659499E-01,-2.0305075E-02,-1.5162539E-02,-3.4124468E-02,      &
     &-2.4196291E-01,-2.4223591E-03, 9.9375956E-03, 8.8594317E-02,      &
     &-7.8714669E-02,-8.3075643E-02, 2.1284264E-02,-1.2470073E-01,      &
     &-2.8642917E-01,-4.2389423E-01,-5.1547468E-02,-6.1568022E-03/
      DATA B4/                                                          &
     & 3.5499609E-01,-1.0279864E-01,-3.0133177E-02,-7.2616935E-03,      &
     &-1.5999454E-01,-3.6495121E-03, 1.5741222E-02, 1.1651069E-01,      &
     &-1.6128248E-01,-9.7467415E-03, 2.5586136E-02,-2.8123074E+00,      &
     &-2.5151396E-01,-5.4633158E-01,-3.9750233E-02,-7.9213232E-03,      &
     &-2.3211755E-02, 5.0911224E-01, 5.8259536E-02,-7.8368187E-02,      &
     & 1.0819072E-01, 1.1000843E-03, 6.8746060E-03, 2.3775902E-02,      &
     & 1.1589897E-01,-2.9280615E-01, 4.0287655E-02,-3.9593115E+00,      &
     &-2.8254777E-01,-9.9404693E-02,-5.4337461E-02,-8.8779256E-03,      &
     & 2.2406774E-03, 4.1838044E-01, 5.1180866E-02,-2.4567191E-02,      &
     &-1.9688404E-01,-1.0585175E-03, 7.6089874E-03,-7.0508361E-02,      &
     & 8.5055888E-02, 1.2949448E+00, 5.0101835E-02,-1.2138815E+00,      &
     &-2.7277464E-01, 2.1318978E-01,-5.3295814E-02,-8.3934702E-03,      &
     &-3.0160320E-01, 8.6541045E-01, 1.2481105E-01,-2.6269779E-02,      &
     &-1.5726537E-01,-4.4153184E-03, 7.8247264E-03,-1.7396367E-01,      &
     & 5.7898319E-01, 5.5814463E-01, 5.5422679E-02,-3.3546963E+00,      &
     &-3.2973796E-01, 5.5879581E-01,-4.7221974E-02,-1.1822317E-02/
      DATA B5/                                                          &
     &-8.3771944E-03, 1.1775870E-02, 1.2133520E-03, 8.8066023E-05,      &
     & 8.0929250E-03,-5.1536132E-05,-2.5158329E-04,-7.8116963E-04,      &
     & 1.6247202E-02,-1.5049644E-02, 1.7805431E-04, 1.2846154E-01,      &
     &-1.1371511E-01, 2.6412314E-01,-7.8982823E-03, 1.1182798E-04,      &
     &-3.5671038E-03, 7.5200498E-03, 1.9270922E-03,-2.1591128E-05,      &
     &-5.5332523E-02, 7.0068309E-06,-7.0121582E-04, 3.1631156E-03,      &
     & 2.7243536E-02,-2.8142039E-02,-2.9783789E-04, 9.8001504E-01,      &
     &-1.2968689E-01, 3.8082647E-01,-1.3541829E-02,-2.8221915E-04,      &
     & 8.1018396E-03, 5.0836168E-03, 2.4362530E-03,-5.1429868E-03,      &
     &-9.6627355E-02, 5.8394537E-05, 8.3866515E-05, 3.0263155E-03,      &
     & 1.7960966E-02,-2.5694948E-02,-1.3116456E-03, 1.4949303E+00,      &
     &-1.6048563E-01, 3.6672539E-01,-2.1102734E-02,-7.1855844E-04,      &
     & 3.1898756E-02,-5.1995069E-03, 1.6484524E-03,-1.3680983E-02,      &
     &-1.5750319E-01, 3.6022882E-04, 2.0144000E-03, 1.4124077E-02,      &
     &-4.3120321E-02, 1.4605477E-02,-2.9089500E-03, 2.1191826E+00,      &
     &-1.3857019E-01, 1.4239389E-01,-3.3047237E-02,-1.4283196E-03/
      DATA B6/                                                          &
     & 5.4700971E-02,-9.7432807E-03, 2.1546863E-03,-2.2673160E-02,      &
     &-2.2959352E-01, 4.9246196E-04, 2.9079113E-03, 1.3579033E-02,      &
     &-4.9916662E-02, 1.2067717E-02,-3.4403545E-03, 2.2459822E+00,      &
     &-1.3530976E-01, 5.3436469E-02,-4.6903294E-02,-1.7151700E-03,      &
     & 8.5795343E-02,-2.0685565E-02, 1.7041569E-03,-3.1146269E-02,      &
     &-3.7570679E-01, 8.3576911E-04, 3.8188894E-03, 2.6396286E-02,      &
     &-8.9467943E-02, 3.4845334E-02,-3.8211807E-03, 3.1137829E+00,      &
     &-2.8421891E-01, 6.2238491E-01,-6.1457895E-02,-2.4080742E-03,      &
     & 1.1674720E-01,-3.7369858E-02, 2.5001229E-03,-3.7731495E-02,      &
     &-5.0555336E-01, 1.0005443E-03, 2.2201790E-03, 2.4534401E-02,      &
     &-4.3886330E-02,-1.6081627E-02,-1.9803797E-03, 4.2365847E+00,      &
     &-3.3754605E-01, 6.4386135E-01,-7.7502549E-02,-2.6324801E-03,      &
     & 1.4670205E-01,-4.7555149E-02, 2.9927073E-04,-4.8319831E-02,      &
     &-4.0433735E-01, 2.4798727E-03, 4.0400289E-03, 1.2247056E-02,      &
     &-4.2673290E-02,-1.4275495E-02,-3.3652119E-03, 3.5576811E+00,      &
     &-4.6400976E-01, 1.4913502E+00,-8.6945534E-02,-3.3692324E-03/
      DATA B7/                                                          &
     & 1.8449205E-01,-7.4018776E-02,-2.6576971E-03,-5.1798828E-02,      &
     &-1.0913335E-02, 1.5321842E-03, 4.2637624E-03,-6.5556467E-03,      &
     & 3.5260655E-02,-8.5735381E-02,-1.4730713E-03,-8.1325662E-01,      &
     &-7.8060549E-01, 2.5341063E+00,-1.0360003E-01,-3.8631691E-03,      &
     & 1.9113225E-01,-2.0697352E-02, 7.9074353E-03,-6.5686107E-02,      &
     &-6.0252261E-01, 1.5198570E-03, 5.2028126E-04, 2.2664346E-02,      &
     & 3.2702178E-02,-1.1326450E-01,-1.2761888E-03, 3.9489346E+00,      &
     &-4.8502392E-01, 1.0404265E-01,-9.9128366E-02,-3.6056340E-03,      &
     & 2.2543979E-01, 2.7162537E-02, 1.1173282E-02,-9.4257832E-02,      &
     &-8.7603980E-01, 2.8576006E-03, 2.9834546E-04, 3.3046515E-04,      &
     & 1.2081856E-01,-2.0285177E-01,-4.5930110E-03, 7.5303669E+00,      &
     &-4.3783695E-01, 3.1376928E-01,-1.0616130E-01,-5.2232258E-03,      &
     &-1.8443023E-03,-5.1049404E-03,-2.2872817E-04, 1.9112907E-03,      &
     & 3.6828332E-02, 3.6753528E-04,-4.2076479E-04,-4.3096915E-03,      &
     & 3.4347016E-02,-3.8369253E-02, 1.6771391E-04,-3.2066625E-01,      &
     & 2.3639143E-02, 1.1395591E-01,-7.1346760E-03, 1.6871284E-04/
      DATA B8/                                                          &
     & 3.9233966E-04, 3.2562716E-03, 1.8416527E-03,-2.3613996E-03,      &
     &-1.1220056E-01, 4.6377839E-04,-6.3432870E-04, 2.7948346E-02,      &
     &-1.0547894E-01, 1.1580902E-01,-9.0662652E-05, 1.4364405E+00,      &
     &-1.2497854E-01,-8.2688816E-03,-1.4943976E-02,-4.3968350E-05,      &
     &-5.0937191E-02, 9.9689960E-02, 1.5202384E-02,-1.4306463E-02,      &
     &-1.7368978E-01, 2.9369700E-04,-8.5686799E-04, 5.4456238E-02,      &
     &-2.3998529E-01, 2.4546820E-01,-4.4570398E-04, 1.8355732E+00,      &
     &-1.4708382E-01,-4.1706461E-01,-2.7093623E-02, 1.4849029E-04,      &
     &-1.1878753E-01, 2.9136342E-01, 4.0046979E-02,-5.5457056E-02,      &
     &-9.4286662E-01, 3.1456561E-04,-9.6919225E-04, 1.6868019E-01,      &
     &-8.7338775E-01, 9.5295733E-01,-2.2642741E-04, 1.2401558E+01,      &
     &-1.0581036E+00,-1.4768076E+00,-4.8211299E-02,-9.7435302E-05,      &
     &-2.6347984E-02, 1.4202422E-01, 2.4143439E-02,-4.1560069E-02,      &
     &-8.4098405E-01, 5.5248337E-04,-1.1216621E-03, 1.3169444E-01,      &
     &-6.1505264E-01, 6.6842830E-01, 6.9359690E-04, 9.6911955E+00,      &
     &-7.6957649E-01,-1.1409750E+00,-6.1118510E-02,-7.2547258E-04/
      DATA B9/                                                          &
     &-6.1606046E-02, 2.4703646E-01, 3.9765432E-02,-6.3382566E-02,      &
     &-1.2132912E+00, 4.8546330E-04,-1.2312066E-03, 1.8757391E-01,      &
     &-9.1157454E-01, 9.9575979E-01,-1.0086766E-03, 1.3901546E+01,      &
     &-9.4293737E-01,-1.8106318E+00,-7.0019901E-02,-8.2828966E-04,      &
     &-5.1856953E-01, 1.0903969E+00, 1.4418501E-01,-1.5945810E-01,      &
     &-1.5179806E+00,-1.6270215E-03, 5.0275140E-03, 4.8849243E-01,      &
     &-2.8281279E+00, 3.1379147E+00,-8.0924146E-03, 1.4809978E+01,      &
     &-3.2404213E+00, 3.2246428E+00,-5.6880098E-02,-2.1083255E-03,      &
     &-4.1208255E-01, 9.5780706E-01, 1.2732971E-01,-1.5440542E-01,      &
     &-1.4566689E+00,-1.0336973E-03, 4.2530149E-03, 4.8904371E-01,      &
     &-2.7902079E+00, 3.1184063E+00,-8.3233975E-03, 1.3659301E+01,      &
     &-2.8931780E+00, 2.7943697E+00,-7.3669851E-02,-2.4952516E-03,      &
     &-5.4876727E-01, 1.1955309E+00, 1.5925246E-01,-1.7971092E-01,      &
     &-1.0791759E+00,-2.0833267E-03, 5.8610514E-03, 4.7045070E-01,      &
     &-2.8395119E+00, 3.1890469E+00,-5.5586584E-03, 8.5401936E+00,      &
     &-4.3022404E+00, 6.6341782E+00,-7.3425591E-02,-2.0312560E-03/
      DATA B10/                                                         &
     &-1.1230698E+00, 2.3402758E+00, 2.8662735E-01,-3.2300389E-01,      &
     &-1.4703503E+00,-4.5727715E-03, 1.3870530E-02, 1.1151171E+00,      &
     &-6.4764433E+00, 7.2324038E+00,-2.1318235E-02, 1.4099910E+01,      &
     &-8.1660519E+00, 1.2549165E+01,-4.3137845E-02,-4.1685514E-03,      &
     &-1.8839350E+00, 2.8079329E+00, 3.9284241E-01,-1.7471206E-01,      &
     & 4.1106024E+00, 6.5955380E-04,-7.2680116E-03,-1.3844643E+00,      &
     & 5.7930737E+00,-6.5894499E+00,-9.7903125E-03,-4.9735474E+01,      &
     & 6.1864138E+00, 1.5143456E+01, 5.8298465E-04,-2.1915550E-04,      &
     &-3.7132664E+00, 6.3957119E+00, 8.8455123E-01,-6.4685392E-01,      &
     &-7.9269686E+00, 1.5833566E-06,-4.9506538E-03, 1.7287884E+00,      &
     &-7.8105383E+00, 8.8563452E+00,-8.2922757E-02, 4.3194016E+01,      &
     &-6.2555342E+00, 1.6754456E+01, 3.5530609E-01, 1.2705645E-03,      &
     &-4.4842139E-02, 8.3724201E-02, 9.4001591E-03,-8.1728809E-03,      &
     &-4.4866927E-02,-9.9310128E-05,-8.3393464E-04, 3.2949597E-02,      &
     &-1.5500045E-01, 1.6983438E-01,-1.6427755E-03, 8.2746190E-01,      &
     &-2.6072621E-02,-2.7050246E-02,-1.0025553E-02,-2.6748836E-05/
      DATA B11/                                                         &
     &-4.3552291E-02, 9.4440997E-02, 1.0290340E-02,-1.3995808E-02,      &
     &-3.9263830E-02,-6.2541047E-05,-5.1267166E-04, 2.7174745E-02,      &
     &-1.1800855E-01, 1.2194157E-01,-1.7368947E-03, 8.8339096E-01,      &
     &-5.2898720E-02, 3.3197743E-03,-1.5017208E-02, 1.0343880E-04,      &
     &-3.8178086E-02, 1.0749304E-01, 1.1762314E-02,-1.9028880E-02,      &
     &-1.3133729E-01,-3.5537500E-04,-9.8484685E-04, 4.6054047E-02,      &
     &-1.9071907E-01, 2.1742702E-01,-1.6380828E-03, 1.6776352E+00,      &
     &-8.1911743E-02, 5.0820716E-02,-2.0144340E-02,-1.3044720E-04,      &
     &-6.1023217E-02, 1.6158324E-01, 1.8693097E-02,-2.9815719E-02,      &
     &-1.4334595E-01,-9.5503565E-05,-1.2909151E-03, 4.3204792E-02,      &
     &-1.8755388E-01, 2.2186512E-01,-1.0093204E-03, 2.1852150E+00,      &
     &-1.0960585E-01, 4.4232704E-02,-2.8506801E-02, 1.9000449E-04,      &
     &-4.9839240E-02, 1.8024993E-01, 2.0321347E-02,-3.9596960E-02,      &
     &-2.1009451E-01,-2.6197778E-04,-1.2506014E-03, 9.8351121E-02,      &
     &-4.2456734E-01, 4.7771138E-01,-9.0716663E-04, 2.8095055E+00,      &
     &-1.3772565E-01, 3.2263555E-02,-3.2724731E-02,-3.2756804E-04/
      DATA B12/                                                         &
     &-3.7170526E-02, 2.0704484E-01, 2.2509560E-02,-5.5453014E-02,      &
     &-3.6705381E-01, 8.6740562E-05,-1.7054724E-03, 9.9023402E-02,      &
     &-4.5320696E-01, 5.5086702E-01, 9.8658563E-04, 4.9878407E+00,      &
     &-1.5322667E-01,-7.5823545E-02,-4.3624181E-02,-4.3566572E-05,      &
     &-8.3621860E-02, 3.2671958E-01, 3.8940769E-02,-7.2284341E-02,      &
     &-5.8530015E-01,-6.4742449E-04,-3.1095073E-03, 1.7054737E-01,      &
     &-7.9733515E-01, 9.6443218E-01, 2.9251671E-03, 6.2512379E+00,      &
     &-1.8095040E-01,-5.5873234E-02,-5.0399013E-02,-6.5478636E-04,      &
     &-1.8808568E-01, 4.3880546E-01, 5.6360003E-02,-6.2715948E-02,      &
     &-5.4913819E-01, 3.4254114E-04, 6.5955427E-04, 1.0551965E-01,      &
     &-2.9837859E-01, 2.5776136E-01, 3.4918734E-03, 5.5830679E+00,      &
     &-2.0403969E-01,-2.2864419E-01,-5.8514677E-02, 1.6207353E-03,      &
     &-1.6552997E-01, 4.3886071E-01, 5.6662071E-02,-7.6802552E-02,      &
     &-4.6355832E-01, 2.2867171E-03,-6.5380475E-04, 1.2364930E-01,      &
     &-3.5773420E-01, 2.8341419E-01, 4.7308989E-03, 5.8954735E+00,      &
     &-2.2346783E-01,-3.5035157E-01,-7.0508361E-02, 1.7394682E-03/
      DATA B13/                                                         &
     &-2.7549297E-01, 5.9413010E-01, 8.4841967E-02,-7.6636255E-02,      &
     &-3.0332476E-01,-9.7417552E-04,-3.7301448E-04, 4.6420459E-02,      &
     & 5.2761193E-02,-2.1425468E-01, 1.0342196E-02, 2.6169043E+00,      &
     &-2.6633990E-01,-2.8725624E-01,-7.3334694E-02, 2.1934670E-03,      &
     &-2.9751432E-01, 6.6052777E-01, 9.3195975E-02,-7.5536430E-02,      &
     &-4.0644920E-01,-2.3484100E-03,-3.6682148E-05, 6.6537321E-02,      &
     & 9.5616221E-02,-2.9549253E-01, 9.3775429E-03, 2.4141865E+00,      &
     &-2.6551837E-01,-3.2246935E-01,-7.4042737E-02, 2.2388918E-03,      &
     &-2.9559624E-01, 7.3732334E-01, 1.0393065E-01,-9.8374248E-02,      &
     &-5.9563881E-01,-1.6418549E-03,-3.0238128E-03, 1.8489695E-01,      &
     &-4.5240098E-01, 2.6825410E-01, 6.9825277E-03, 3.6978827E+00,      &
     &-2.6717877E-01,-3.8297153E-01,-7.9830468E-02, 1.2641014E-03,      &
     &-3.4429187E-01, 8.7459904E-01, 1.2440199E-01,-1.2201989E-01,      &
     &-6.6146910E-01,-2.3664341E-03,-3.0366697E-03, 1.8916523E-01,      &
     &-5.0258052E-01, 2.7871042E-01, 9.6767396E-03, 3.7285500E+00,      &
     &-2.7717483E-01,-3.2919252E-01,-8.4109545E-02, 8.1230700E-04/
      DATA B14/                                                         &
     & 1.7848068E-01, 2.8521544E-01, 2.0899296E-02,-1.4297915E-01,      &
     & 5.6890422E-01,-4.1431673E-03, 1.2232941E-02,-1.7088246E-02,      &
     & 4.2602593E-01,-1.4616795E+00, 1.9471657E-02,-4.7642775E+00,      &
     &-1.8642163E-01,-6.0963929E-02,-4.4410571E-02,-3.5651196E-03,      &
     & 5.3359360E-01,-3.2240760E-01,-6.2267490E-02,-7.7057958E-02,      &
     & 1.5393038E+00,-2.6123126E-03, 2.6371185E-02,-2.6299477E-01,      &
     & 2.2153988E+00,-4.1409483E+00, 2.6585635E-02,-1.4415043E+01,      &
     &-2.3323303E-01, 6.5306485E-02, 1.1267018E-02,-4.4659153E-03,      &
     &-6.2941462E-03,-3.8412814E-03, 3.5760808E-04, 1.9885751E-03,      &
     & 8.7533057E-02, 6.1908830E-04,-7.9928618E-04, 6.0914010E-03,      &
     & 4.0875711E-03,-5.8574863E-03,-1.2207590E-03,-1.1647505E-01,      &
     &-6.3569129E-02, 6.8442166E-02,-7.5411387E-03, 1.9542607E-04,      &
     &-1.1318874E-02, 1.0130066E-02, 2.0885775E-03,-2.0676609E-03,      &
     & 1.1552292E-01, 6.2551140E-04,-4.8789708E-04, 3.2403779E-03,      &
     & 1.6748700E-02,-2.0696033E-02,-1.2749981E-03,-2.0069283E-01,      &
     &-7.7378809E-02, 4.5640007E-02,-1.2598597E-02, 3.6941562E-04/
      DATA B15/                                                         &
     &-1.2026504E-02, 2.2110835E-02, 3.5043913E-03,-8.0622174E-03,      &
     & 1.6419566E-01, 6.5070321E-04, 3.0542165E-04,-1.2160710E-03,      &
     & 2.5982440E-02,-3.3297136E-02,-1.1462639E-03,-4.0599316E-01,      &
     &-6.6946507E-02,-4.4509780E-02,-1.7491464E-02, 5.9812400E-04,      &
     &-1.2057628E-02, 3.3188157E-02, 4.7268644E-03,-1.5255608E-02,      &
     & 2.5094944E-01, 1.0995623E-03, 1.0050589E-03, 6.6402219E-03,      &
     &-9.1876723E-03,-1.4388315E-02,-1.0405814E-03,-4.9070805E-01,      &
     &-6.6824496E-02,-1.4999664E-01,-2.3620762E-02, 8.3554536E-04,      &
     &-2.3296516E-02, 7.2758973E-02, 1.1346672E-02,-2.1960177E-02,      &
     & 1.4635402E-01, 7.2268420E-04, 5.2897216E-05, 1.6145170E-02,      &
     &-2.4051946E-02,-1.3451707E-02,-7.5132749E-04, 3.9103501E-02,      &
     &-5.1204450E-02,-2.9811352E-01,-2.9255342E-02, 8.1529934E-04,      &
     &-1.0908186E-02, 7.2676361E-02, 1.2545168E-02,-2.7803287E-02,      &
     & 1.3903701E-01, 1.0660556E-03,-1.1577402E-04, 2.9098526E-02,      &
     &-6.1888572E-02, 7.4604973E-03,-9.9885091E-04, 2.4032199E-01,      &
     &-5.6169976E-02,-4.1685790E-01,-3.5651647E-02, 9.7975461E-04/
      DATA B16/                                                         &
     &-1.7170563E-02, 1.2153572E-01, 2.0035312E-02,-3.7285250E-02,      &
     &-9.9639483E-03, 1.4223690E-04,-5.6831562E-04, 4.2419963E-02,      &
     &-1.0277259E-01, 2.7922358E-02, 1.3897542E-04, 9.2401230E-01,      &
     &-6.4051211E-02,-4.8130167E-01,-4.0826198E-02, 7.6355203E-04,      &
     &-8.4180832E-03, 1.5381211E-01, 2.4661206E-02,-5.0468434E-02,      &
     &-1.5837950E-01,-1.1899222E-04,-2.0589759E-03,-2.1831956E-02,      &
     & 2.9348361E-01,-5.1236969E-01, 1.9333435E-03, 2.7088280E+00,      &
     &-2.6625614E-03,-7.1579123E-01,-5.0448634E-02, 1.0891855E-03/
      DATA B17/                                                         &
     &-3.6522303E-02, 2.2732431E-01, 3.6905576E-02,-6.1185997E-02,      &
     &-1.9926709E-01,-1.1364627E-03,-2.8919529E-03,-6.1611176E-02,      &
     & 5.6544942E-01,-9.1636223E-01, 4.5573488E-03, 3.3156605E+00,      &
     & 4.6138503E-02,-9.8679632E-01,-5.9836850E-02, 1.1661060E-03,      &
     & 9.5710516E-02, 7.8320265E-02, 1.5705664E-02,-6.3556135E-02,      &
     &-2.3285824E-01,-6.6881115E-04,-2.2928468E-03,-6.8682075E-02,      &
     & 7.0932919E-01,-1.1804371E+00, 5.2035488E-03, 3.6524191E+00,      &
     & 1.1013323E-01,-1.2917557E+00,-6.4518452E-02, 1.2202098E-03,      &
     & 1.5972167E-01, 1.5844796E-02, 1.0227431E-02,-6.6400886E-02,      &
     &-2.8670144E-01,-9.1452571E-04,-2.0622488E-03,-1.1602664E-01,      &
     & 1.0531836E+00,-1.7513838E+00, 5.3121634E-03, 4.0837603E+00,      &
     & 1.6349447E-01,-1.5490265E+00,-7.1579874E-02, 1.5656371E-03,      &
     & 1.2048376E-01, 1.3091475E-01, 2.4150722E-02,-7.3842168E-02,      &
     &-1.8196541E-01,-2.4935722E-03,-6.9452822E-03, 4.7275443E-02,      &
     & 1.8852317E-01,-4.6849793E-01, 7.5881593E-03, 2.2279997E+00,      &
     & 7.6443911E-02,-1.7718792E+00,-8.7734640E-02, 2.8656796E-04/
      DATA B18/                                                         &
     &-3.8087048E-02, 4.3572044E-01, 6.3808084E-02,-1.0452890E-01,      &
     &-4.3467653E-01,-2.4616388E-03,-7.9379156E-03, 3.4891076E-02,      &
     & 1.7525530E-01,-5.0591886E-01, 5.5767223E-03, 6.7193518E+00,      &
     & 2.5183821E-01,-2.0062361E+00,-1.0027993E-01, 4.6974863E-04,      &
     &-1.1557275E-01, 6.3984519E-01, 8.4277630E-02,-1.2261760E-01,      &
     &-4.8088336E-01,-3.2660603E-03,-6.7383759E-03, 1.4918387E-01,      &
     &-5.7902527E-01, 6.1631370E-01, 3.7508528E-04, 5.6431990E+00,      &
     & 2.3828477E-01,-2.0466471E+00,-1.0329503E-01, 2.1730454E-04,      &
     &-1.2823582E+00, 2.6084099E+00, 3.2970411E-01,-2.9107445E-01,      &
     &-1.1266977E-01,-1.5824151E-03,-1.4779080E-02, 2.4269257E+00,      &
     &-1.7162094E+01, 2.7399231E+01,-1.5856452E-02, 1.3490973E+00,      &
     &-5.1026189E-01, 3.5781813E+00,-1.2675518E-01,-8.7245889E-03,      &
     & 1.0727633E-02,-1.6507965E-02,-2.3863607E-03,-1.3002076E-03,      &
     & 3.0766167E-02, 3.1887647E-04, 7.3715020E-04, 2.2440588E-03,      &
     &-1.3668492E-02, 9.0218410E-03,-3.6736694E-04,-8.9733720E-02,      &
     &-1.3342768E-02,-6.0517102E-02,-4.6333447E-03, 2.8232485E-04/
      DATA B19/                                                         &
     & 1.1238605E-02,-1.2355909E-02,-1.8624547E-03,-3.4853695E-03,      &
     & 6.0018588E-02, 2.4609524E-04, 1.1262270E-03, 1.0251392E-02,      &
     &-4.0632371E-02, 2.5653277E-02,-7.0576114E-04,-1.7503321E-01,      &
     &-2.7581073E-02,-1.2623280E-01,-9.6458979E-03, 3.4158258E-04,      &
     & 1.2220591E-02,-9.9173822E-03,-9.0192957E-04,-6.0972907E-03,      &
     & 9.0555847E-02, 5.3990656E-04, 1.1067216E-03, 2.3310702E-02,      &
     &-8.2084239E-02, 5.2667733E-02,-8.5674343E-04,-2.6347232E-01,      &
     &-2.3902822E-02,-2.5254297E-01,-1.4787395E-02, 4.4741831E-04,      &
     & 1.2891274E-02, 9.1046910E-04, 1.0887720E-03,-9.7715482E-03,      &
     & 1.3145161E-01, 1.4322918E-04, 1.5456390E-03, 3.3542827E-02,      &
     &-1.1670625E-01, 7.4143708E-02,-9.1596227E-04,-3.3645439E-01,      &
     &-9.3461834E-03,-4.1783065E-01,-2.0012461E-02, 3.6131847E-04,      &
     & 1.7315060E-02, 4.3604188E-03, 2.5827182E-03,-1.2748905E-02,      &
     & 1.8255395E-01, 3.6502723E-04, 1.2639307E-03, 7.1413755E-02,      &
     &-2.4090713E-01, 1.5986806E-01,-1.0959881E-03,-6.0188127E-01,      &
     & 1.1566228E-03,-6.8713570E-01,-2.6465770E-02, 2.0859245E-04/
      DATA B20/                                                         &
     & 4.0462129E-02,-8.3600469E-03, 1.8254684E-03,-1.7018940E-02,      &
     & 2.0021331E-01, 1.0207575E-04, 1.4664347E-03, 9.1546357E-02,      &
     &-3.1134593E-01, 2.0772278E-01,-9.6614473E-04,-7.1345383E-01,      &
     & 6.9606118E-03,-9.0402293E-01,-3.2921903E-02, 2.3909190E-05,      &
     & 3.9639503E-02, 1.7400712E-02, 6.1974712E-03,-2.2825297E-02,      &
     & 2.2781008E-01,-5.8954768E-04, 2.1647802E-03, 1.1071354E-01,      &
     &-3.8611490E-01, 2.5791878E-01,-7.5581577E-04,-1.0568142E+00,      &
     &-1.3956428E-01,-5.1697451E-01,-3.5407834E-02,-3.1431392E-04,      &
     & 3.8116973E-02, 4.3818716E-02, 1.0162581E-02,-3.1028669E-02,      &
     & 2.5309348E-01, 2.5775167E-04, 1.4177405E-03, 1.8614745E-01,      &
     &-7.6107651E-01, 7.4000818E-01,-1.2535196E-04,-1.3572865E+00,      &
     &-1.7096901E-01,-5.9970242E-01,-4.1571882E-02,-4.1066553E-04,      &
     & 1.2317050E-01,-9.5912479E-03, 1.4267508E-03,-4.2138886E-02,      &
     & 1.4197147E-01,-3.7418462E-03, 6.8129376E-03, 9.9644125E-02,      &
     &-3.0165201E-01,-2.5187426E-03, 3.1520310E-04, 5.1058423E-02,      &
     &-1.7897218E-01,-5.8601469E-01,-4.9575131E-02,-2.4024415E-04/
      DATA B21/                                                         &
     & 1.4136267E-01,-7.4163415E-03, 1.0966547E-03,-5.2274466E-02,      &
     & 2.7808076E-01,-1.4638163E-03, 5.3594820E-03, 1.6929924E-01,      &
     &-5.4852402E-01, 2.0149446E-01, 1.3271624E-03,-1.3921032E+00,      &
     &-2.0709270E-01,-6.9764829E-01,-5.3114895E-02,-5.6103198E-04,      &
     & 7.0218801E-02, 6.1825328E-02, 1.1299808E-02,-4.8902210E-02,      &
     & 5.0921136E-01, 2.0002432E-03, 8.7065920E-03, 2.1573192E-01,      &
     &-3.4730208E-01,-5.5273855E-01, 2.5233666E-03,-3.9380913E+00,      &
     &-2.3021913E-01,-1.1253815E+00,-5.7962906E-02, 7.7465782E-04,      &
     & 8.7456286E-02, 9.7112775E-02, 1.4241368E-02,-5.4043423E-02,      &
     & 2.8855669E-01,-1.2926129E-03, 1.2682915E-02, 1.9175702E-01,      &
     &-2.2055441E-01,-7.1885800E-01, 2.3750861E-03,-2.5009537E+00,      &
     &-2.2683275E-01,-1.1795979E+00,-6.4842761E-02, 1.2681324E-03,      &
     & 3.7881368E-01,-2.0158660E-01,-3.4002353E-02,-7.1689129E-02,      &
     &-3.8881505E-01,-7.9322560E-04, 1.8908370E-02, 2.5610471E-01,      &
     &-6.1300319E-01,-3.4548843E-01, 2.0575060E-03, 4.3956594E+00,      &
     &-8.3433390E-02,-1.8016100E+00,-8.5669219E-02, 2.5340873E-03/
      DATA B22/                                                         &
     & 3.5521770E-01,-1.1760640E-01,-3.0776311E-02,-7.6225460E-02,      &
     & 1.3294613E-01, 2.4620288E-03, 1.2829509E-02, 5.7924390E-01,      &
     &-2.9112549E+00, 3.6286297E+00,-3.4005760E-05,-3.1231642E+00,      &
     &-3.3803684E-01,-5.7097065E-01,-6.8649352E-02, 2.5293464E-04,      &
     &-7.1802318E-01, 1.4794903E+00, 2.1882361E-01,-1.3860470E-01,      &
     & 3.7682319E-01, 2.6162714E-03,-5.7844602E-02, 1.3032961E+00,      &
     &-9.9591446E+00, 1.8124756E+01, 2.1626966E-03,-9.7700739E-01,      &
     &-3.5826600E-01, 2.2847071E+00,-9.0555727E-02,-1.1746924E-02/
!
!***  SET COEFFICIENTS IN BT ARRAY
!
      L = (IA-2)*16
      IF(IM .EQ. 6) L = L+288
      IF(IM .EQ. 7) L = L+464
      IF(IM .GE. 8) L = L+(IM-8)*240+656
      IF(IA .EQ. 1) GO TO 1020
        DO 1010 K=1,16
           BT(I,J,K) = BTRN(K+L)
 1010   CONTINUE
 1020 CONTINUE
      IF(IA .NE. 1) GO TO 1040
!      END                         !!!!!!!!!!!!!!!!!!!!!!!!!!YIKES
        DO 1030 K=1,16
           BT(I,J,K) = 0.0
 1030   CONTINUE
 1040 CONTINUE
      RETURN
      END
      
      LOGICAL FUNCTION TEST(KOL,KEY,NCHAR)
!      INTEGER KOL(1) , KEY(1)
      INTEGER KOL(*) , KEY(*)
      DATA IBLNK/4H      /
!
!     ----TEST FOR NAME IN KEY = NAME IN KOL.NCHAR=NO. OF CHARACTERS
!
      DO 1000 I=1,NCHAR
         IF(KOL(I).NE.KEY(I)) GO TO 1010
 1000 END DO
!
!     ----HERE IF NAME CHECKS
!
      IF(KOL(NCHAR+1).NE.IBLNK)GO TO 1010
      TEST=.TRUE.
      RETURN
!
!     ----HERE IF NAME DOES NOT CHECK
!
 1010 TEST=.FALSE.
      RETURN
      END

      SUBROUTINE TESTOR(KOL,L,NAM,K,IER,LEN,LDM,NUM,NAMES)
!
!***  CHECK IF NAMELIST NAME IS LEGAL INPUT USING NMTEST
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND

!      DIMENSION KOL(1), LEN(1), LDM(1), NAMES(1)
      DIMENSION KOL(*), LEN(1), LDM(1), NAMES(1)      
! changed by RLC   2021Jan18
      DIMENSION NUMBER(15)
      LOGICAL END, FLAG, ARRAY, FOUND, NMTEST
      INTEGER BLANK, EQUAL, COMMA
      DATA NUMBER / 4H0   ,4H1   ,4H2   ,4H3   ,4H4   ,                 &
     &       4H5   ,4H6   ,4H7   ,4H8   ,4H9   ,4H+   ,4H-   ,          &
     &       4H.   ,4H*   ,4HE   /
      DATA END / .TRUE. /
      DATA BLANK / 4H     /, EQUAL / 4H=    /, COMMA / 4H,    /
!
      NA = 0
      NB = 0
      NC = 0
      ND = 0
      NE = 0
      NF = 0
!
!***  UNKNOWN NAMELIST NAME - WRITE CARD AND RETURN
!
      IF(IER .EQ. 0) GO TO 1010
        WRITE(6,1170) (KOL(J),J=1,80)
        GO TO 1160
 1010 CONTINUE
!
!***  END CARD - WRITE CARD AND RETURN
!
      IF(NAM .GE. 2) GO TO 1020
        WRITE(6,1180) (KOL(J),J=1,80)
        END = .TRUE.
        GO TO 1160
 1020 CONTINUE
!
!***  INSERT END CARD IF REQUIRED
!
      FLAG = (K .EQ. 1) .AND. (.NOT. END)
      IF(.NOT. FLAG) GO TO 1030
        WRITE(6,1190)  KAND
        WRITE(11,1200) KAND, (BLANK,J=1,75)
        END = .TRUE.
 1030 CONTINUE
!
!***  FIRST CARD DOES NOT CONTAIN NAMELIST NAME - WRITE CARD AND RETURN
!
      FLAG = (K .EQ. 2) .AND. END
      IF(.NOT. FLAG) GO TO 1040
        WRITE(6,1210) (KOL(J),J=1,80), KAND
        GO TO 1160
 1040 CONTINUE
!
!***  TEST FOR VALID VARIABLE NAME STARTING IN KOL(L)
!
      IF(K .EQ. 1) END = .FALSE.
      IF(KOL(L) .NE. BLANK) GO TO 1050
        L = L+1
        IF(L .GE. 81) GO TO 1150
        GO TO 1040
 1050 CONTINUE
      IF(KOL(L) .EQ. KAND) END = .TRUE.
      IF(END) GO TO 1150
      CALL VNAME(KOL,L,LEN,NUM,NAMES,I,FOUND,ARRAY,NDMS,NF,NUMBER,      &
     &           BLANK,EQUAL)
!
!***  NAME NOT FOUND, IF K=2 CHECK FOR NUMBER CONTINUATION
!***                  IF K=1 SEARCH FOR NEXT NAME
!
      IF(FOUND) GO TO 1090
      IF(K .EQ. 1) GO TO 1070
        NDMS = NDML
        NDML = 0
        DO 1060 J=1,14
        IF(KOL(L) .EQ. NUMBER(J)) GO TO 1120
 1060   CONTINUE
 1070 CONTINUE
      IS = I
      NA = NA+1
 1075 CONTINUE
      IF(L .GE. 81) GO TO 1150
      IF(KOL(L) .EQ. KAND) GO TO 1050
      FLAG = (KOL(L) .EQ. BLANK) .OR. (KOL(L) .EQ. EQUAL) .OR.          &
     &       (KOL(L) .EQ. COMMA)
      IF(FLAG) GO TO 1077
        L = L+1
        GO TO 1075
 1077 CONTINUE
      IF(L .GE. 81) GO TO 1150
      DO 1080 J=1,15
      IF(KOL(L) .EQ. NUMBER(J)) GO TO 1085
 1080 END DO
      FLAG = (KOL(L) .EQ. BLANK) .OR. (KOL(L) .EQ. EQUAL) .OR.          &
     &       (KOL(L) .EQ. COMMA)
      IF(FLAG) GO TO 1085
      IF(NMTEST(KOL(L),TRUE,4)) L = L+3
      IF(NMTEST(KOL(L),TRUE,4)) GO TO 1085
      IF(NMTEST(KOL(L),FALSE,5)) L = L+4
      IF(NMTEST(KOL(L),FALSE,5)) GO TO 1085
      IF(KOL(L-1) .EQ. NUMBER(15)) L = L-1
      GO TO 1040
 1085 CONTINUE
      L = L+1
      GO TO 1077
!
!***  NAME FOUND - SET UP ARRAY DESIGNATION AND CHECK NAME DELIMITERS
!
 1090 CONTINUE
      IS = I
      NDM = IABS(LDM(I))
      NDML = 0
      FLAG = ARRAY .AND. (NDM .EQ. 1)
      IF (.NOT. FLAG) GO TO 1100
        ARRAY = .FALSE.
        NC = NC+1
 1100 CONTINUE
      IF(L .GE. 80) GO TO 1110
      IF(KOL(L) .NE. BLANK) GO TO 1110
        L = L+1
        GO TO 1100
 1110 CONTINUE
      IF(KOL(L) .NE. EQUAL) NB = NB+1
      IF(KOL(L) .EQ. EQUAL) L = L+1
!
!***  CHECK NUMERICAL INPUT AND THE NUMBER OF ARRAY
!***  ELEMENTS INPUT
!
 1120 CONTINUE
      I = IS
      IF(I .EQ. 0) GO TO 1075
      IF(L .GE. 81) GO TO 1150
      IF(KOL(L) .NE. BLANK) GO TO 1130
        L = L+1
        GO TO 1120
 1130 CONTINUE
      IF(LDM(I) .LT. 0) CALL LVALUE(KOL,L,NDML,NF,BLANK,                &
     &                             COMMA,NUMBER)
      IF(LDM(I) .GT. 0) CALL RVALUE(KOL,L,NDML,NF,BLANK,                &
     &                             COMMA,NUMBER)
!
!***  CHECK THE NUMBER OF VALUES LOADED TO THE VARIABLE DIMENSION
!
      IF(NDML .EQ. 0) GO TO 1077
      IF(NDM .EQ. 1 .AND. NDML .GT. 1) ND = ND+1
      NDML = NDML+NDMS
      IF(NDM .GT. 1 .AND. NDML .GT. NDM) NE = NE+1
      IF(L .LE. 80) GO TO 1040
!
!***  END OF CARD OR END OF INPUT ENCOUNTERED
!
 1150 CONTINUE
      NERR = NA+NB+NC+ND+NE+NF
      IF(NERR .EQ. 0) WRITE(6,1180) (KOL(J),J=1,80)
      IF(NERR .NE. 0) WRITE(6,1220) (KOL(J),J=1,80), NA, NB,            &
     &                              NC, ND, NE, NF
 1160 WRITE(11,1230) (KOL(J),J=1,80)
!
!***  FORMATS
!
 1170 FORMAT(1X,80A1,3X,33H** ERROR ** UNKNOWN NAMELIST NAME)
 1180 FORMAT(1X,80A1)
 1190 FORMAT(2X,A1,3HEND,78X,32H** MISSING NAMELIST TERMINATION ,       &
     &       8HADDED **)
 1200 FORMAT(1X,A1,3HEND,75A1)
 1210 FORMAT(1X,80A1,3X,39H** ERROR ** NO NAMELIST NAME FOLLOWING ,A2)
 1220 FORMAT(1X,80A1,3X,11H** ERROR **,I3,2H*A,I3,2H*B,I3,2H*C,         &
     &       I3,2H*D,I3,2H*E,I3,2H*F)
 1230 FORMAT(80A1)
!
      RETURN
      END

      SUBROUTINE THEORY
!
!***  MAIN LOGIC ROUTINE FOR CALCULATING AIRFOIL CHARACTERISTICS
!
      COMMON /IBODY/  PB, NACA(80), BF(232), CBAR, dum1(87)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /IBH/ PBH, THN(60),CAM(60),A0,XC,MCC,CLCC,XAC(20),dum6(276)
      COMMON /IBWH/   PBWH,AI,ALO,CLI,ASEP,CMCO4,CLA0,CLA(20)
      COMMON /IBWHV/  PBWHV, RHO,TMAX,DELTAY
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      INTEGER A4HW,A4HH,A4HV,A4HF
      LOGICAL CRIT,FLAG
      REAL MACH,MCC
      DATA A4HW,A4HH,A4HV,A4HF/4HW   ,4HH   ,4HV   ,4HF   /
!
!  CALCULATE THE SECTION AERODYNAMICS
!
      FLAG=.FALSE.
      CALL IDEAL
      MACH = 0.0
      RENN = 0.0
      CALL SLOPE(MACH,CLA0,RENN,XACO)
      WRITE(6,1020)
      IF(NACA(6).EQ.A4HW)WRITE(6,1030)
      IF(NACA(6).EQ.A4HH)WRITE(6,1040)
      IF(NACA(6).EQ.A4HV)WRITE(6,1050)
      IF(NACA(6).EQ.A4HF)WRITE(6,1060)
      WRITE(6,1070)AI,ALO,CLI,CMCO4,CLA0,RHO,TMAX,DELTAY
!
!  CALCULATE THE LIFT CURVE SLOPE AT MACH NUMBER, CM AND XAC
!
      NMACH=FLC(1) + 0.5
      CRIT=.FALSE.
      DO 1010 I=1,NMACH
         MACH=FLC(I+2)
         RENN=FLC(I+42)*CBAR
         IF(MACH .GE. MCC) CRIT=.TRUE.
         IF(CLA(I) .NE. UNUSED) GO TO 1010
         IF(MACH .GE. MCC) CLA(I)=CLCC
         IF(CRIT) GO TO 1010
         CALL SLOPE(MACH,CLA(I),RENN,XAC(I))
         IF(CLA(I).NE.UNUSED) GO TO 1000
         FLAG=.TRUE.
         WRITE(6,1110) MACH
         GO TO 1010
 1000    WRITE(6,1080) MACH,CLA(I),XAC(I)
 1010 END DO
      IF(CRIT) WRITE(6,1090) MCC,XC,CLCC
      IF (FLAG) CALL CloseFiles
      IF (flag) STOP
 1020 FORMAT(1H1,29X,75HAUTOMATED STABILITY AND CONTROL METHODS PER APRI&
     &L 1976 VERSION OF DATCOM    )
 1030 FORMAT(1H ,55X,23HWING SECTION DEFINITION)
 1040 FORMAT(1H ,50X,34HHORIZONTAL TAIL SECTION DEFINITION)
 1050 FORMAT(1H ,51X,32HVERTICAL TAIL SECTION DEFINITION)
 1060 FORMAT(1H ,52X,30HVENTRAL FIN SECTION DEFINITION)
 1070 FORMAT(1H0,33X,23HIDEAL ANGLE OF ATTACK =,F10.5,5H DEG.//         &
     &   30X,27HZERO LIFT ANGLE OF ATTACK =,F10.5,5H DEG.//             &
     &   33X,24HIDEAL LIFT COEFFICIENT =,F10.5//                        &
     &   18X,39HZERO LIFT PITCHING MOMENT COEFFICIENT =,F10.5//         &
     &   29X,28HMACH ZERO LIFT-CURVE-SLOPE =,F10.5,6H /DEG.//           &
     &   36X,21HLEADING EDGE RADIUS =,F10.5,15H FRACTION CHORD//        &
     &   30X,27HMAXIMUM AIRFOIL THICKNESS =,F10.5,15H FRACTION CHORD//  &
     &   48X, 9HDELTA-Y =,F10.5,14H PERCENT CHORD//)
 1080 FORMAT(1H0,25X,5HMACH=,F7.4,19H LIFT-CURVE-SLOPE =,F10.5,         &
     &   6H /DEG.,5X,6H XAC =,F10.5)
 1090 FORMAT(1H0,36X,43H*** CREST CRITICAL MACH NUMBER EXCEEDED ***//   &
     & 35X,22H CREST CRITICAL MACH =,F10.5//                            &
     & 46X,11H LOCATION =,F10.5,15H FRACTION CHORD//                    &
     & 38X,19H LIFT-CURVE-SLOPE =,F10.5,6H /DEG.)
 1110 FORMAT(   1X,69H     AIRFOIL MODULE UNABLE TO CALCULATE SECTION CL&
     &ALPA FOR MACH NO = ,F7.3,50H  THEREFORE A VALUE MUST BE SPECIFIED &
     &BY THE USER./1X,123H     SEE USERS MANUAL FOR SECTION CHARACTERIST&
     &ICS INPUT.  (NOTE% CLALPA AND CLMAX SHOULD REFERENCE FOOTNOTE 1 ON&
     & PAGE 29. )/)
      RETURN
      END

      SUBROUTINE TLIN1X(X1,Y,NX1,XA1,YA,LX1L,LX1U,MESS,NMSS,ROUT)
!
!***  LINEAR INTERPOLATION FOR Y=F(X)
!
      DIMENSION Y(1),X1(1),DA(3),MESS(20),ROUT(2)
      DIMENSION MSSCL(9),RMSCL(9)
      EQUIVALENCE (RMSCL(1),MSSCL(1))
      LOGICAL NOIN1,NAS1,X1A,X1B,MSSG1,EX1,LG(7)
      EQUIVALENCE (NOIN1,LG(1)),(X1A,LG(2)),(X1B,LG(3)),(MSSG1,LG(4)),  &
     &       (EX1,LG(5)),(DA(1),D0),(DA(2),D1),(DA(3),D2),(NAS1,LG(6))
      DATA TLIN/4H1TIN/,HOL1/4H1EXP/
      DATA MSSCL/4HTLIN,4H1X  ,2*0,1,4*0/
!
      CALL SWITCH(LG,LX1L,LX1U,XA1,X1,NX1)
      IF(LG(7))GO TO 1020
      CALL GLOOK(NX1,XA1,X1,NAS1,NOIN1,I1,T1)
      D2=Y(I1)
      IF(.NOT.NOIN1)D2=Y(I1-1)+T1*(D2-Y(I1-1))
      YA=D2
      IF(MSSG1)GO TO 1000
      RETURN
 1000 IF(ROUT(1).NE.TLIN)GO TO 1010
      ROUT(1)=HOL1
      RETURN
!
!     ----PRINT EXTRAPOLATION MESSAGE
!
 1010 MSSCL(3)=NMSS
      RMSCL(4)=YA
      RMSCL(6)=XA1
      MSSCL(7)=NX1
      MSSCL(8)=LX1L
      MSSCL(9)=LX1U
      CALL MESSGE(ROUT,MESS,X1,LG,LG,LG,MSSCL)
      RETURN
!
!     ----HERE FOR EXTRAPOLATION
!
 1020 IF(X1B)GO TO 1050
!
!     ----HERE FOR XA1 ABOVE
!
      IF(LX1U.GT.1.AND.NX1.GT.2)GO TO 1030
!
!     ----LINEAR EXTRAPOLATION
!
      T1=(XA1-X1(NX1))/(X1(NX1)-X1(NX1-1))
      YA=Y(NX1)+T1*(Y(NX1)-Y(NX1-1))
      GO TO 1000
!
!     ----QUADRATIC EXTRAPOLATION
!
 1030 D2=Y(NX1)
      D1=Y(NX1-1)
      IX=NX1-2
      D0=Y(IX)
 1040 CALL QUAD(X1(IX),DA,XA1,YA)
      GO TO 1000
!
!     ----HERE FOR XA1 BELOW
!
 1050 IF(LX1L.GT.1.AND.NX1.GT.2)GO TO 1060
!
!     ----LINEAR EXTRAPOLATION
!
      T1=(XA1-X1(1))/(X1(2)-X1(1))
      YA=Y(1)+T1*(Y(2)-Y(1))
      GO TO 1000
 1060 D0=Y(1)
      D1=Y(2)
      D2=Y(3)
      IX=1
      GO TO 1040
      END

!+
      SUBROUTINE TLIN3X(X1,X2,X3,Y,NX1,NX2,NX3,XA1,XA2,XA3,YA,LX1L,LX2L,&
     & LX3L,LX1U,LX2U,LX3U,MESS,NMSS,ROUT)
!!! modified 20July1997 RLC
!
!***  LINEAR INTERPOLATION FOR Y=F(X1,X2,X3)
!
      DIMENSION Y(NX1,NX2,NX3),X1(NX1),X2(NX2),X3(NX3)
      DIMENSION DA(3),MESS(20),ROUT(2)
      DIMENSION MSSCL(17),RMSCL(17)
      EQUIVALENCE (RMSCL(1),MSSCL(1))
      LOGICAL NOIN3,NAS3,X3A,X3B,MSSG3,EX3,LG(7)
      EQUIVALENCE (NOIN3,LG(1)),(X3A,LG(2)),(X3B,LG(3)),(MSSG3,LG(4)),  &
     &      (EX3,LG(5)),(DA(1),D0),(DA(2),D1),(DA(3),D2),(NAS3,LG(6))
      DATA TLIN /4H1TIN/, HOL1 /4H1EXP/
      DATA MSSCL /4HTLIN,4H3X  ,2*0,3,12*0/
!
!     ----INITIALIZE SWITCHES.
!
      CALL SWITCH(LG,LX3L,LX3U,XA3,X3,NX3)
      IF(LG(7))GO TO 1110
 1000 CALL GLOOK(NX3,XA3,X3,NAS3,NOIN3,I3,T3)
 1010 ID=I3
      DO 1030 I=1,2
         IX=4-I
!!!         GO TO 1140   ! deleted and following added by RLC
         RO=TLIN
         CALL TLINEX(X1,X2,Y(1,1,ID),NX1,NX2,XA1,XA2,DA(IX),            &
     &    LX1L,LX2L,LX1U,LX2U,MESS,NMSS,RO)
         IF(NOIN3)GO TO 1070
! 1020    IF(NOIN3)GO TO 1070
         ID=ID-1
 1030 END DO

      IF(.NOT.EX3)GO TO 1050
      IF(NX3.LT.3)GO TO 1040
      IF(X3A.AND.LX3U.GT.1)GO TO 1120
      IF(X3B.AND.LX3L.GT.1)GO TO 1180
 1040 IF(X3A)GO TO 1190
 1050 D0=D1
 1060 D2=D0+T3*(D2-D1)
 1070 YA=D2
 1080 IF(MSSG3.OR.RO.EQ.HOL1)GO TO 1090
      RETURN
 1090 IF(ROUT(1).NE.TLIN)GO TO 1100
      ROUT(1)=HOL1
      RETURN
 1100 CONTINUE
!
!     ----PRINT EXTRAPOLATION MESSAGE.
!
      MSSCL(3)=NMSS
      RMSCL(4)=YA
!
!     ----1ST VARIABLE.
!
      RMSCL(6)=XA1
      MSSCL(7)=NX1
      MSSCL(8)=LX1L
      MSSCL(9)=LX1U
!
!     ----2ND VARIABLE.
!
      RMSCL(10)=XA2
      MSSCL(11)=NX2
      MSSCL(12)=LX2L
      MSSCL(13)=LX2U
!
!     ----3RD VARIABLE.
!
      RMSCL(14)=XA3
      MSSCL(15)=NX3
      MSSCL(16)=LX3L
      MSSCL(17)=LX3U
      CALL MESSGE(ROUT,MESS,X1,X2,X3,LG,MSSCL)
      RETURN
!
!     ----HERE FOR EXTRAP.
!
 1110 IF(X3B)GO TO 1160
!
!     ----HERE FOR XA3 ABOVE
!
      T3=XA3-X3(NX3)
      I3=NX3
      GO TO 1170
 1120 I3=I3-2
      ID=I3
      IX=1
 1130 I=0
 1140 RO=TLIN
      CALL TLINEX(X1,X2,Y(1,1,ID),NX1,NX2,XA1,XA2,DA(IX),LX1L,LX2L,LX1U,&
     &            LX2U,MESS,NMSS,RO)
!!!      IF(I.NE.0)GO TO 1020
 1150 CALL QUAD(X3(I3),DA,XA3,YA)
      GO TO 1080
!
!     ----HERE FOR XA3 BELOW
!
 1160 T3=XA3-X3(1)
      I3=2
 1170 T3=T3/(X3(I3)-X3(I3-1))
      GO TO 1010
 1180 D0=D1
      D1=D2
      ID=3
      IX=3
      I3=1
      GO TO 1130
 1190 D0=D2
      GO TO 1060
      END

!+
      SUBROUTINE TLIN4X(X1,X2,X3,X4,Y,NX1,NX2,NX3,NX4,XA1,XA2,XA3,XA4,  &
     & YA,LX1L,LX2L,LX3L,LX4L,LX1U,LX2U,LX3U,LX4U,MESS,NMSS,ROUT)
!!! modified 20July1997 by RLC
!
!***  LINEAR INTERPOLATION OF Y=F(X1,X2,X3,X4)
!     ----STRUCTURE OF Y ARRAY IS Y(NX2,NX1,NX3,NX4)
!
      DIMENSION Y(1),X1(1),X2(1),X3(1),X4(1)
      DIMENSION DA(3),MESS(20),ROUT(2)
      DIMENSION MSSCL(21),RMSCL(21)
      EQUIVALENCE (RMSCL(1),MSSCL(1))
      LOGICAL NOIN4,NAS4,X4A,X4B,MSSG4,EX4,LG(7)
      EQUIVALENCE (NOIN4,LG(1)),(X4A,LG(2)),(X4B,LG(3)),(MSSG4,LG(4)),  &
     &       (EX4,LG(5)),(DA(1),D0),(DA(2),D1),(DA(3),D2),(NAS4,LG(6))
      DATA TLIN/4H1TIN/,HOL1/4H1EXP/
      DATA MSSCL/4HTLIN,4H4X  ,2*0,4,16*0/
!
!     ----INITIALIZE SWITCHES.
!
      CALL SWITCH(LG,LX4L,LX4U,XA4,X4,NX4)
      IF(LG(7))GO TO 1110
 1000 CALL GLOOK(NX4,XA4,X4,NAS4,NOIN4,I4,T4)
 1010 N123=NX1*NX2*NX3
      LOC=N123*(I4-1)+1

      DO 1030 I=1,2
         IX=4-I
!!!         GO TO 1140  ! deleted ad following added by RLC
         RO=TLIN
         CALL TLIN3X(X1,X2,X3,Y(LOC),NX1,NX2,NX3,XA1,XA2,XA3,DA(IX),    &
     &      LX1L,LX2L,LX3L,LX1U,LX2U,LX3U,MESS,NMSS,RO)

         IF(NOIN4)GO TO 1070
! 1020    IF(NOIN4)GO TO 1070
         IF(I.EQ.1)LOC=LOC-N123
 1030 END DO
      IF(.NOT.EX4)GO TO 1050
      IF(NX4.LT.3)GO TO 1040
      IF(X4A.AND.LX4U.GT.1)GO TO 1120
      IF(X4B.AND.LX4L.GT.1) GO TO 1180
 1040 IF(X4A)GO TO 1190
 1050 D0=D1
 1060 D2=D0+T4*(D2-D1)
 1070 YA=D2
 1080 IF(MSSG4.OR.RO.EQ.HOL1)GO TO 1090
      RETURN
 1090 CONTINUE
!
!     ----SUPRESS MESSAGE IF CALLED BY INTERX
!
      IF(ROUT(1).NE.TLIN)GO TO 1100
      ROUT(1)=HOL1
      RETURN
!
!     ----PRINT EXTRAPOLATION MESSAGE.
!
 1100 MSSCL(3)=NMSS
      RMSCL(4)=YA
!
!     ----1ST VARIABLE.
!
      RMSCL(6)=XA1
      MSSCL(7)=NX1
      MSSCL(8)=LX1L
      MSSCL(9)=LX1U
!
!     ----2ND VARIABLE.
!
      RMSCL(10)=XA2
      MSSCL(11)=NX2
      MSSCL(12)=LX2L
      MSSCL(13)=LX2U
!
!     ----3RD VARIABLE.
!
      RMSCL(14)=XA3
      MSSCL(15)=NX3
      MSSCL(16)=LX3L
      MSSCL(17)=LX3U
!
!     ----4TH VARIABLE
!
      RMSCL(18)=XA4
      MSSCL(19)=NX4
      MSSCL(20)=LX4L
      MSSCL(21)=LX4U
      CALL MESSGE(ROUT,MESS,X1,X2,X3,X4,MSSCL)
      RETURN
!
!     ----HERE FOR EXTRAPOLATION.
!
 1110 IF(X4B)GO TO 1160
!
!     ----HERE FOR XA4 ABOVE.
!
      T4=XA4-X4(NX4)
      I4=NX4
      GO TO 1170
 1120 LOC=LOC-N123
      I4=I4-2
      IX=1
 1130 I=0
 1140 RO=TLIN
      CALL TLIN3X(X1,X2,X3,Y(LOC),NX1,NX2,NX3,XA1,XA2,XA3,DA(IX),LX1L,  &
     & LX2L,LX3L,LX1U,LX2U,LX3U,MESS,NMSS,RO)
!      IF(I.NE.0)GO TO 1020
 1150 CALL QUAD(X4(I4),DA,XA4,YA)
      GO TO 1080
!
!     ----HERE FOR XA4 BELOW.
!
 1160 T4=XA4-X4(1)
      I4=2
 1170 T4=T4/(X4(I4)-X4(I4-1))
      GO TO 1010
 1180 D0=D1
      D1=D2
      I4=1
      LOC=LOC+2*N123
      IX=3
      GO TO 1130
 1190 D0=D2
      GO TO 1060
      END

!+
      SUBROUTINE TLINEX(X1,X2,Y,NX1,NX2,XA1,XA2,YA,LX1L,LX2L,LX1U,LX2U, &
     & MESS,NMSS,ROUT)
!!! modified 20July1997 by RLC
!
!***  LINEAR FOR Y=F(X1,X2)
!
      DIMENSION X1(1),X2(1),Y(NX2,NX1),ROUT(2),MESS(20),DA(3)
! dimension of MESS changed from 2 to 20   RLC 2020Dec14
      DIMENSION MSSCL(13),RMSCL(13)
      EQUIVALENCE (RMSCL(1),MSSCL(1))
      LOGICAL NOIN1,NAS1,X1A,X1B,MSSG1,EX1,LG(7)
      EQUIVALENCE (NOIN1,LG(1)),(X1A,LG(2)),(X1B,LG(3)),(MSSG1,LG(4)),  &
     &      (EX1,LG(5)),(DA(1),D0),(DA(2),D1),(DA(3),D2),(NAS1,LG(6))
      DATA TLIN /4H1TIN/, HOL1 /4H1EXP/
      DATA MSSCL /4HTLIN,4HEX  ,2*0,2,8*0/
!
      YA=1.E30
      CALL SWITCH(LG,LX1L,LX1U,XA1,X1,NX1)
      IF(LG(7))GO TO 1100
      CALL GLOOK(NX1,XA1,X1,NAS1,NOIN1,I1,T1)
 1000 ID=I1
      DO 1020 I=1,2
         IX=4-I
!!!         GO TO 1130  ! deleted and following added by RLC
         RO=TLIN
         CALL TLIN1X(X2,Y(1,ID),NX2,XA2,DA(IX),LX2L,LX2U,MESS,NMSS,RO)
         IF(NOIN1)GO TO 1060
! 1010    IF(NOIN1)GO TO 1060
         ID=ID-1
 1020 END DO

      IF(.NOT.EX1)GO TO 1040
      IF(NX1.LT.3)GO TO 1030
      IF(X1A.AND.LX1U.GT.1)GO TO 1110
      IF(X1B.AND.LX1L.GT.1)GO TO 1170
 1030 IF(X1A)GO TO 1180
 1040 D0=D1
 1050 D2=D0+T1*(D2-D1)
 1060 YA=D2
 1070 IF(MSSG1.OR.RO.EQ.HOL1)GO TO 1080
      RETURN
 1080 IF(ROUT(1).NE.TLIN)GO TO 1090
      ROUT(1)=HOL1
      RETURN
 1090 CONTINUE
!
!     ----PRINT EXTRAPOLATION MESSAGE.
!
      MSSCL(3)=NMSS
      RMSCL(4)=YA
!
!     ----1ST VARIABLE.
!
      RMSCL(6)=XA1
      MSSCL(7)=NX1
      MSSCL(8)=LX1L
      MSSCL(9)=LX1U
!
!     ----2ND VARIABLE.
!
      RMSCL(10)=XA2
      MSSCL(11)=NX2
      MSSCL(12)=LX2L
      MSSCL(13)=LX2U
      CALL MESSGE(ROUT,MESS,X1,X2,LG,LG,MSSCL)
      RETURN
!
!     ----HERE FOR EXTRAP.
!
 1100 IF(X1B)GO TO 1150
!
!     ----HERE FOR XA1 ABOVE
!
      T1=XA1-X1(NX1)
      I1=NX1
      GO TO 1160
 1110 I1=I1-2
      ID=I1
      IX=1
 1120 I=0
 1130 RO=TLIN
      CALL TLIN1X(X2,Y(1,ID),NX2,XA2,DA(IX),LX2L,LX2U,MESS,NMSS,RO)
!      IF(I.NE.0)GO TO 1010
 1140 CALL QUAD(X1(I1),DA,XA1,YA)
      GO TO 1070
!
!     ----HERE FOR XA1 BELOW
!
 1150 T1=XA1-X1(1)
      I1=2
 1160 T1=T1/(X1(I1)-X1(I1-1))
      GO TO 1000
 1170 D0=D1
      D1=D2
      ID=3
      IX=3
      I1=1
      GO TO 1120
 1180 D0=D2
      GO TO 1050
      END

      SUBROUTINE TLINVS(X1,X2,Y,NX1,NX2,DA1,XA2,ZA)
!
!***  INTERPOLATES BETWEEN TABLES FOR FG6115
!
      DIMENSION ROUTID(2),Q46115(2)
      DIMENSION X1(1),X2(1),Y(NX2,NX1)
      DATA ROUTID/4HTLIN,4HVS  /,Q46115/4H4.6.,4H1-30/
!
!     ----TEST FOR ZA OUTSIDE RANGE OF TABLE
!     ----TEST FOR XA2.LE.X2(1)
!
      IF(XA2.GT.X2(1))GO TO 1010
      IF(ZA.LT.Y(1,1))GO TO 1000
      GO TO 1060
 1000 IF(ZA.GT.Y(1,NX1))GO TO 1010
      GO TO 1080
!
!     ----TEST XA2.GE.X2(NX2)
!
 1010 IF(XA2.LT.X2(NX2))GO TO 1030
      IF(ZA.LT.Y(NX2,1))GO TO 1020
      GO TO 1060
 1020 IF(ZA.GT.Y(NX2,NX1))GO TO 1030
      GO TO 1080
!
!     ----XA2 WITHIN TABLE.TEST FOR ZA OUTSIDE
!
 1030 DO 1040 I=2,NX2
         IF(X2(I)-XA2)1040,1050,1090
 1040 END DO
 1050 IF(ZA.LT.Y(I,1))GO TO 1070
 1060 DA1=X1(1)
      RETURN
 1070 IF(ZA.GT.Y(I,NX1))GO TO 1100
 1080 DA1=X1(NX1)
      RETURN
 1090 RAT=(XA2-X2(I-1))/(X2(I)-X2(I-1))
      ZTP=Y(I-1,1)+(Y(I,1)-Y(I-1,1))*RAT
      IF(ZA.GE.ZTP)GO TO 1060
      ZTP=Y(I-1,NX1)+(Y(I,NX1)-Y(I-1,NX1))*RAT
      IF(ZA.LE.ZTP)GO TO 1080
 1100 CONTINUE
      NX1O2=NX1/2
      DGSS=X1(NX1O2)
      KOUNT=0
 1110 CALL TLINEX(X1,X2,Y,NX1,NX2,DGSS,XA2,ZGSS,0,0,0,0,Q46115,2,ROUTID)
      KOUNT=KOUNT+1
      IF(ABS(ZGSS-ZA).LT.1.E-3)GO TO 1140
!
!     ----CUTOFF IF T00 MANY PASSES
!
      IF(KOUNT.GT.20)GO TO 1130
      DIN=DGSS*ABS(ZGSS-ZA)/ZGSS
      IF(ZGSS.GT.ZA)GO TO 1120
!
!     ----DECREASE DGSS TO INCREASE ZGSS WHICH WAS TOO SMALL.
!
      DGSS=DGSS-DIN
      IF(DGSS.LT.X1(1))DGSS=X1(1)
      GO TO 1110
!
!     ----INCREASE DGSS TO REDUCE ZGSS WHICH WAS TOO LARGE.
!
 1120 DGSS=DGSS+DIN
      IF(DGSS.GT.X1(NX1))DGSS=X1(NX1)
      GO TO 1110
 1130 CONTINUE
 1140 DA1=DGSS
      RETURN
      END

      SUBROUTINE TLIP1X(X1,Y,NP1,XA1,YA,LX1L,LX1U,MESS,NMSS,ROUT)
!
!***  LINEAR INTERPOLATION FOR A PACKED TABLE Y=F(X)
!

!      DIMENSION Y(2),X1(2),DA(3),MESS(20),ROUT(2),NP1(7)
      DIMENSION Y(2),X1(2),DA(3),MESS(*),ROUT(2),NP1(7)
      DIMENSION MSSCL(9),RMSCL(9)
      EQUIVALENCE (RMSCL(1),MSSCL(1))
      LOGICAL NOIN1,NAS1,X1A,X1B,MSSG1,EX1,LG(7)
      EQUIVALENCE (NOIN1,LG(1)),(X1A,LG(2)),(X1B,LG(3)),(MSSG1,LG(4)),  &
     &      (EX1,LG(5)),(DA(1),D0),(DA(2),D1),(DA(3),D2),(NAS1,LG(6))
      DATA TLIN /4H1TIN/, HOL1 /4H1EXP/
      DATA MSSCL /4HTLIP,4H1X  ,2*0,1,4*0/
!
      NX1=IABS(NP1(1))
      CALL SWITCH(LG,LX1L,LX1U,XA1,X1,NX1)
      IF(LG(7))GO TO 1030
      CALL GLOOK(NX1,XA1,X1,NAS1,NOIN1,I1,T1)
      YI1=YUP(I1,NP1,Y)
      D2=YI1
      IF(NOIN1)GO TO 1000
      YI1M1=YUP(I1-1,NP1,Y)
      D2=YI1M1+T1*(D2-YI1M1)
 1000 YA=D2
      IF(MSSG1)GO TO 1010
      RETURN
 1010 IF(ROUT(1).NE.TLIN)GO TO 1020
      ROUT(1)=HOL1
      RETURN
!
!     ----PRINT EXTRAPOLATION MESSAGE
!
 1020 MSSCL(3)=NMSS
      RMSCL(4)=YA
      RMSCL(6)=XA1
      MSSCL(7)=NX1
      MSSCL(8)=LX1L
      MSSCL(9)=LX1U
      CALL MESSGE(ROUT,MESS,X1,LG,LG,LG,MSSCL)
      RETURN
!
!     ----HERE FOR EXTRAPOLATION
!
 1030 IF(X1B)GO TO 1060
!
!     ----HERE FOR XA1 ABOVE
!
      YNX1=YUP(NX1,NP1,Y)
      YNX1M1=YUP(NX1-1,NP1,Y)
      IF(LX1U.GT.1.AND.NX1.GT.2)GO TO 1040
!
!     ----LINEAR EXTRAPOLATION
!
      T1=(XA1-X1(NX1))/(X1(NX1)-X1(NX1-1))
      YA=YNX1+T1*(YNX1-YNX1M1)
      GO TO 1010
!
!     ----QUADRATIC EXTRAPOLATION
!
 1040 D2=YNX1
      D1=YNX1M1
      IX=NX1-2
      D0=YUP(IX,NP1,Y)
 1050 CALL QUAD(X1(IX),DA,XA1,YA)
      GO TO 1010
!
!     ----HERE FOR XA1 BELOW
!
 1060 Y1=YUP(1,NP1,Y)
      Y2=YUP(2,NP1,Y)
      IF(LX1L.GT.1.AND.NX1.GT.2)GO TO 1070
!
!     ----LINEAR EXTRAPOLATION
!
      T1=(XA1-X1(1))/(X1(2)-X1(1))
      YA=Y1+T1*(Y2-Y1)
      GO TO 1010
 1070 D0=Y1
      D1=Y2
      D2=YUP(3,NP1,Y)
      IX=1
      GO TO 1050
      END

      SUBROUTINE TLIP2X(X1,X2,Y,NXX,NX2,XA1,XA2,YA,LX1L,LX2L,LX1U,LX2U, &
     & MESS,NMSS,ROUT)
!!! modified 20July1997 by RLC
!
!***  LINEAR INTERPOLATION FOR A PACKED TABLE Y=F(X1,X2)
!
      DIMENSION X1(2),X2(2),Y(2),ROUT(2),MESS(2),NP1(7),NXX(7),DA(3)
      DIMENSION MSSCL(13),RMSCL(13)
      EQUIVALENCE (RMSCL(1),MSSCL(1))
      LOGICAL NOIN1,NAS1,X1A,X1B,MSSG1,EX1,LG(7)
      EQUIVALENCE (NOIN1,LG(1)),(X1A,LG(2)),(X1B,LG(3)),(MSSG1,LG(4)),  &
     &      (EX1,LG(5)),(DA(1),D0),(DA(2),D1),(DA(3),D2),(NAS1,LG(6))
      DATA TLIN /4H1TIN/, HOL1 /4H1EXP/
      DATA MSSCL /4HTLIP,4H2X  ,2*0,2,8*0/
!
      IF(NXX(1).GE.0)GO TO 1010
      NX1=NXX(2)
      DO 1000 J=1,7
         NP1(J)=NXX(J)
 1000 END DO
      GO TO 1020
 1010 NP1(1)=-NX2
      NX1=NXX(1)
      NP1(2)=NX1
      NP1(3)=0
      NP1(4)=0
      NP1(6)=0
      NP1(7)=0
 1020 CALL SWITCH(LG,LX1L,LX1U,XA1,X1,NX1)
      IF(LG(7))GO TO 1130
      CALL GLOOK(NX1,XA1,X1,NAS1,NOIN1,I1,T1)
 1030 ID=I1
      DO 1050 I=1,2
         IX=4-I
!!!         GO TO 1160  ! deleted and following added by RLC
         RO=TLIN
         NP1(5)=ID
         CALL TLIP1X(X2,Y,NP1,XA2,DA(IX),LX2L,LX2U,MESS,NMSS,RO)
         IF(NOIN1)GO TO 1090
! 1040    IF(NOIN1)GO TO 1090
         ID=ID-1
 1050 END DO
      IF(.NOT.EX1)GO TO 1070
      IF(NX1.LT.3)GO TO 1060
      IF(X1A.AND.LX1U.GT.1)GO TO 1140
      IF(X1B.AND.LX1L.GT.1)GO TO 1200
 1060 IF(X1A)GO TO 1210
 1070 D0=D1
 1080 D2=D0+T1*(D2-D1)
 1090 YA=D2
 1100 IF(MSSG1.OR.RO.EQ.HOL1)GO TO 1110
      RETURN
 1110 IF(ROUT(1).NE.TLIN)GO TO 1120
      ROUT(1)=HOL1
      RETURN
 1120 CONTINUE
!
!     ----PRINT EXTRAPOLATION MESSAGE.
!
      MSSCL(3)=NMSS
      RMSCL(4)=YA
!
!     ----1ST VARIABLE.
!
      RMSCL(6)=XA1
      MSSCL(7)=NX1
      MSSCL(8)=LX1L
      MSSCL(9)=LX1U
!
!     ----2ND VARIABLE.
!
      RMSCL(10)=XA2
      MSSCL(11)=NX2
      MSSCL(12)=LX2L
      MSSCL(13)=LX2U
      CALL MESSGE(ROUT,MESS,X1,X2,LG,LG,MSSCL)
      RETURN
!
!     ----HERE FOR EXTRAP.
!
 1130 IF(X1B)GO TO 1180
!
!     ----HERE FOR XA1 ABOVE
!
      T1=XA1-X1(NX1)
      I1=NX1
      GO TO 1190
 1140 I1=I1-2
      ID=I1
      IX=1
 1150 I=0
 1160 RO=TLIN
      NP1(5)=ID
      CALL TLIP1X(X2,Y,NP1,XA2,DA(IX),LX2L,LX2U,MESS,NMSS,RO)
!      IF(I.NE.0)GO TO 1040
 1170 CALL QUAD(X1(I1),DA,XA1,YA)
      GO TO 1100
!
!     ----HERE FOR XA1 BELOW
!
 1180 T1=XA1-X1(1)
      I1=2
 1190 T1=T1/(X1(I1)-X1(I1-1))
      GO TO 1030
 1200 D0=D1
      D1=D2
      ID=3
      IX=3
      I1=1
      GO TO 1150
 1210 D0=D2
      GO TO 1080
      END

      SUBROUTINE TLIP3X(X1,X2,X3,Y,NX1,NX2,NX3,XA1,XA2,XA3,YA,LX1L,LX2L,&
     &LX3L,LX1U,LX2U,LX3U,MESS,NMSS,ROUT)
!!! modified 20July1997 by RLC
!
!***  LINEAR INTERPOLATION OF PACKED TABLE Y=F(X1,X2,X3)
!
      DIMENSION Y(2),X1(2),X2(2),X3(2),NP1(7),DA(3),MESS(20),ROUT(2)
      DIMENSION MSSCL(17),RMSCL(17)
      EQUIVALENCE (RMSCL(1),MSSCL(1))
      LOGICAL NOIN3,NAS3,X3A,X3B,MSSG3,EX3,LG(7)
      EQUIVALENCE (NOIN3,LG(1)),(X3A,LG(2)),(X3B,LG(3)),(MSSG3,LG(4)),  &
     &      (EX3,LG(5)),(DA(1),D0),(DA(2),D1),(DA(3),D2),(NAS3,LG(6))
      DATA TLIN /4H1TIN/, HOL1 /4H1EXP/
      DATA MSSCL /4HTLIP,4H3X  ,2*0,3,12*0/
!
!     ----INITIALIZE SWITCHES.
!
      CALL SWITCH(LG,LX3L,LX3U,XA3,X3,NX3)
      IF(LG(7))GO TO 1110
 1000 CALL GLOOK(NX3,XA3,X3,NAS3,NOIN3,I3,T3)
 1010 ID=I3
      DO 1030 I=1,2
         IX=4-I
!!!         GO TO 1140  ! deleted and following added by RLC
         RO=TLIN
         NP1(1)=-NX2
         NP1(2)=NX1
         NP1(3)=NX3
         NP1(4)=0
         NP1(5)=0
         NP1(6)=ID
         NP1(7)=0
         CALL TLIP2X(X1,X2,Y,NP1,NX2,XA1,XA2,DA(IX),LX1L,LX2L,LX1U,     &
     &            LX2U,MESS,NMSS,RO)
         IF(NOIN3)GO TO 1070
! 1020    IF(NOIN3)GO TO 1070
         ID=ID-1
 1030 END DO

      IF(.NOT.EX3)GO TO 1050
      IF(NX3.LT.3)GO TO 1040
      IF(X3A.AND.LX3U.GT.1)GO TO 1120
      IF(X3B.AND.LX3L.GT.1)GO TO 1180
 1040 IF(X3A)GO TO 1190
 1050 D0=D1
 1060 D2=D0+T3*(D2-D1)
 1070 YA=D2
 1080 IF(MSSG3.OR.RO.EQ.HOL1)GO TO 1090
      RETURN
 1090 IF(ROUT(1).NE.TLIN)GO TO 1100
      ROUT(1)=HOL1
      RETURN
 1100 CONTINUE
!
!     ----PRINT EXTRAPOLATION MESSAGE.
!
      MSSCL(3)=NMSS
      RMSCL(4)=YA
!
!     ----1ST VARIABLE.
!
      RMSCL(6)=XA1
      MSSCL(7)=NX1
      MSSCL(8)=LX1L
      MSSCL(9)=LX1U
!
!     ----2ND VARIABLE.
!
      RMSCL(10)=XA2
      MSSCL(11)=NX2
      MSSCL(12)=LX2L
      MSSCL(13)=LX2U
!
!     ----3RD VARIABLE.
!
      RMSCL(14)=XA3
      MSSCL(15)=NX3
      MSSCL(16)=LX3L
      MSSCL(17)=LX3U
      CALL MESSGE(ROUT,MESS,X1,X2,X3,LG,MSSCL)
      RETURN
!
!     ----HERE FOR EXTRAP.
!
 1110 IF(X3B)GO TO 1160
!
!     ----HERE FOR XA3 ABOVE
!
      T3=XA3-X3(NX3)
      I3=NX3
      GO TO 1170
 1120 I3=I3-2
      ID=I3
      IX=1
 1130 I=0
 1140 RO=TLIN
      NP1(1)=-NX2
      NP1(2)=NX1
      NP1(3)=NX3
      NP1(4)=0
      NP1(5)=0
      NP1(6)=ID
      NP1(7)=0
      CALL TLIP2X(X1,X2,Y,NP1,NX2,XA1,XA2,DA(IX),LX1L,LX2L,LX1U,        &
     &            LX2U,MESS,NMSS,RO)
!      IF(I.NE.0)GO TO 1020
 1150 CALL QUAD(X3(I3),DA,XA3,YA)
      GO TO 1080
!
!     ----HERE FOR XA3 BELOW
!
 1160 T3=XA3-X3(1)
      I3=2
 1170 T3=T3/(X3(I3)-X3(I3-1))
      GO TO 1010
 1180 D0=D1
      D1=D2
      ID=3
      IX=3
      I3=1
      GO TO 1130
 1190 D0=D2
      GO TO 1060
      END

      SUBROUTINE TODEC(ALPHA, ANS, IERR)
!
!***  CONVERT AN ALPHANUMERIC STRING INTO A FLOATING POINT CONSTANT
!
!***  INPUTS
!
!  ALPHA - ALPHANUMERIC STRING (MUST BE INTEGER)
!
!***  OUTPUTS
!
!    ANS - FLOATING POINT RESULT
!   IERR - ERROR CODE, 0=NO ERROR OR 1=CONSTANT NOT CORRECT TYPE
!
!**********************************************************************
!***  NOTE - INTEGER ARITHMETIC USED TO INCREASE NUMERICAL ACCURACY ***
!**********************************************************************
!
      INTEGER ALPHA,PLUS,PERIOD,EE,BLANK,POWER,SIGNP,PTEN,RVALUE
!
      DIMENSION ALPHA(80),NUM(10)
!
      LOGICAL FRAC
!
      DATA NUM / 4H0   ,4H1   ,4H2   ,4H3   ,4H4   ,4H5   ,4H6   ,      &
     &           4H7   ,4H8   ,4H9   /
      DATA PLUS, MINUS, PERIOD, EE, BLANK                               &
     &  / 4H+   ,4H-   ,4H.   ,4HE   ,4H    /
!
!*****************************************
!***  INITIALIZE (DEFAULT ANSWER = 0.) ***
!*****************************************
!
      IERR=0
      FRAC=.FALSE.
      LVALUE=0
      RVALUE=0
      POWER=0
      SIGNV=0.
      SIGNP=0
      PTEN=0
!
!*********************
!***  GET MANTISSA ***
!*********************
!
      DO 1070 I=1,80
!
         ICOL=I
!
! ...    SKIP BLANKS
!
         IF(ALPHA(I) .EQ. BLANK)GO TO 1070
!
! ...    IF E IS DETECTED, START EXPONENT
!
         IF(ALPHA(I) .EQ. EE)GO TO 1080
!
! ...    CHECK FOR + SIGN ON NUMBER
!
         IF(ALPHA(I) .NE. PLUS)GO TO 1000
!
! ...    IF ALREADY DEFINED, EXIT
!
         IF(SIGNV .NE. 0.)GO TO 1130
!
! ...    SET PLUS SIGN
!
         SIGNV=1.
         GO TO 1070
!
! ...    CHECK FOR MINUS SIGN ON NUMBER
!
 1000    IF(ALPHA(I) .NE. MINUS)GO TO 1010
!
! ...    IF ALREADY DEFINED, EXIT
!
         IF(SIGNV .NE. 0.)GO TO 1130
!
! ...    SET MINUS SIGN
!
         SIGNV=-1.
         GO TO 1070
!
! ...    IF PERIOD, MUST DO FRACTIONAL PART OF NUMBER
!
 1010    IF(ALPHA(I) .NE. PERIOD)GO TO 1020
!
         FRAC=.TRUE.
         GO TO 1070
!
 1020    IF(FRAC)GO TO 1040
!
! ...    DECODE NUMBERS TO LEFT OF DECIMAL POINT
!
         DO 1030 J=1,10
            IF(ALPHA(I) .EQ. NUM(J))LVALUE=10*LVALUE+J-1
            IF(ALPHA(I) .EQ. NUM(J))GO TO 1070
 1030    CONTINUE
!
! ...    ERROR, CONSTANT NOT REAL OR INTEGER
!
         IERR=1
!
         GO TO 1130
!
! ...    DECODE NUMBERS TO RIGHT OF DECIMAL POINT
!
 1040    DO 1050 J=1,10
            IF(ALPHA(I) .EQ. NUM(J))RVALUE=10*RVALUE+J-1
            IF(ALPHA(I) .EQ. NUM(J))GO TO 1060
 1050    CONTINUE
!
! ...    ERROR, CONSTANT NOT REAL OR INTEGER
!
         IERR=1
!
         GO TO 1130
!
! ...    COUNT NUMBER OF DIGITS RIGHT OF DECIMAL POINT
!
 1060    PTEN=PTEN+1
!
 1070 END DO
!
      GO TO 1130
!
!*********************
!***  GET EXPONENT ***
!*********************
!
 1080 ICOL=ICOL+1
      IF(ICOL .GT. 80)GO TO 1130
!
      DO 1120 I=ICOL,80
!
! ...    CHECK FOR PLUS SIGN ON EXPONENT
!
         IF(ALPHA(I) .NE. PLUS)GO TO 1090
!
! ...    IF ALREADY DEFINED, EXIT
!
         IF(SIGNP .NE. 0)GO TO 1130
!
! ...    SET POSITIVE EXPONENT
!
         SIGNP=1
         GO TO 1120
!
! ...    CHECK FOR NEGATIVE SIGN ON EXPONENT
!
 1090    IF(ALPHA(I) .NE. MINUS)GO TO 1100
!
! ...    IF ALREADY DEFINED, EXIT
!
         IF(SIGNP .NE. 0)GO TO 1130
!
! ...    SET NEGATIVE EXPONENT
!
         SIGNP=-1
         GO TO 1120
!
! ...    DECODE EXPONENT
!
 1100    DO 1110 J=1,10
            IF(ALPHA(I) .EQ. NUM(J))POWER=10*POWER+J-1
            IF(ALPHA(I) .EQ. NUM(J))GO TO 1120
 1110    CONTINUE
!
         GO TO 1130
!
 1120 END DO
!
!***********************
!***  CONVERT NUMBER ***
!***********************
!
! ... VERIFY SIGN FOR MANTISSA AND EXPONENT DEFINED
!
 1130 IF(SIGNV .EQ. 0.)SIGNV=1.
      IF(SIGNP .EQ. 0 )SIGNP=1
!
      ANS=SIGNV*(FLOAT(LVALUE)+FLOAT(RVALUE)*10.**(-PTEN))              &
     &    *10.**(SIGNP*POWER)
!
      RETURN
      END
      SUBROUTINE TOINT(ALPHA, IANS, IERR)
!
!***  CONVERT AN ALPHANUMERIC STRING INTO AN INTEGER CONSTANT
!
!***  INPUTS
!
!  ALPHA - ALPHANUMERIC STRING (MUST BE INTEGER)
!
!***  OUTPUTS
!
!   IANS - INTEGER RESULT
!   IERR - ERROR CODE, 0=NO ERROR OR 1=CONSTANT NOT CORRECT TYPE
!
      INTEGER ALPHA,PERIOD
!
      DIMENSION ALPHA(80)
!
      DATA PERIOD / 4H.    /
!
      IERR=0
      IER1=0
      IER2=0
!
      LCOL=1
!
      CALL FINDCH(ALPHA, PERIOD, LCOL)
!
      IF(LCOL .LT. 81)IER1=1
!
      CALL TODEC(ALPHA, ANS, IER2)
!
      IF(IER1 .GT. 0)IERR=1
      IF(IER2 .GT. 0)IERR=2
!
      SIGN=1
      IF(ANS .LT. 0.)SIGN=-1
      IANS=SIGN*(ABS(ANS)+0.5)
!
      RETURN
      END

      SUBROUTINE TOLOG(ALPHA, LANS, IERR)
!
!***  CONVERT AN ALPHANUMERIC STRING INTO A LOGICAL CONSTANT
!
!***  INPUTS
!
!  ALPHA - ALPHANUMERIC STRING (MUST BE INTEGER)
!
!***  OUTPUTS
!
!   LANS - LOGICAL RESULT
!   IERR - ERROR CODE, 0=NO ERROR OR 1=CONSTANT NOT CORRECT TYPE
!
      INTEGER ALPHA,POINT,BLANK
!
      DIMENSION ALPHA(80),LTRUE(4),LFALSE(5)
!
      LOGICAL LANS
!
      DATA LTRUE  / 4HT   ,4HR   ,4HU   ,4HE   /
      DATA LFALSE / 4HF   ,4HA   ,4HL   ,4HS   ,4HE   /
      DATA POINT  / 4H.    /
      DATA BLANK  / 4H     /
!
      IERR=1
      LANS=.FALSE.
!
!***  SKIP LEADING BLANKS
!
      ICOL=1
      CALL SKIPBL(ALPHA, ICOL)
!
      IF(ICOL .LT. 81)GO TO 1000
!
      GO TO 1060
!
!***  FIRST CHARACTER MUST BE POINT
!
 1000 IF(ALPHA(ICOL) .NE. POINT)GO TO 1060
!
!***  LOOK FOR TRUE
!
! ... TEST FOR .T.
!
      IF(ALPHA(ICOL) .EQ. POINT .AND. ALPHA(ICOL+1) .EQ. LTRUE(1)       &
     &   .AND. ALPHA(ICOL+2) .EQ. POINT)GO TO 1020
!
! ... TEST FOR .TRUE.
!
      IFIR=ICOL+1
      IMAX=IFIR+3
!
      DO 1010 I=IFIR,IMAX
         II=I
         IF(ALPHA(I) .NE. LTRUE(I-IFIR+1))GO TO 1030
 1010 END DO
!
      II=II+1
      IF(ALPHA(II) .NE. POINT)GO TO 1060
!
 1020 LANS=.TRUE.
      IERR=0
!
      GO TO 1060
!
!***  LOOK FOR FALSE
!
! ... TEST FOR .F.
!
 1030 IF(ALPHA(ICOL) .EQ. POINT .AND. ALPHA(ICOL+1) .EQ. LFALSE(1)      &
     &   .AND. ALPHA(ICOL+2) .EQ. POINT)GO TO 1050
!
! ... TEST FOR .FALSE.
!
      IFIR=ICOL+1
      IMAX=IFIR+4
!
      DO 1040 I=IFIR,IMAX
         II=I
         IF(ALPHA(I) .NE. LFALSE(I-IFIR+1))GO TO 1060
 1040 END DO
!
      II=II+1
      IF(ALPHA(II) .NE. POINT)GO TO 1060
!
 1050 LANS=.FALSE.
      IERR=0
!
 1060 CONTINUE
!
      RETURN
      END

      SUBROUTINE TRACM0
!
!***  EXECUTIVE TRANSONIC B-W OR B-H CM0
!
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /FLGTCD/ FLC(160)
      COMMON /SUPBOD/ SBD(229)
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /WINGI/  WGIN(101)
      COMMON /HTI/    HTIN(154)
      COMMON /BDATA/  BD(762)
      COMMON /WINGD/  A(195), B(49)
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
!
      EQUIVALENCE (BW(41),CMOWB), (BH(41),CMOHB)
!
!***  WING-BODY CMO
!
      IF(.NOT. WGPL) GO TO 1010
      DB  = 2.0*(WGIN(4)-WGIN(3))
      XLN = (XW+0.5*DB*A(38))/DB
      XLA = (XW+WGIN(6)+0.5*DB*A(80))/DB
      XLA = BD(1)/DB-XLA
      RN  = FLC(I+2)*A(122)
      DBM = SBD(120)
      WL  = 0.5*ZW/DBM
      VT  = 0.0
      HD  = 0.0
      DOB = 0.5*DBM/WGIN(4)
      CALL WBCM0(A(120), A(38), WGIN(16), XLN, XLA, A(118), WGIN(62),   &
     &      WGIN(11), WGIN(93), WGIN(94), RN, FLC(96), WL,              &
     &      VT, HD, DOB, FLC(I+2), CMOWB)
      TRA(74) = CMOWB
!
!***  HORIZONTAL-BODY CMO
!
 1010 CONTINUE
      IF(.NOT. HTPL) GO TO 1020
      DB  = 2.0*(HTIN(4)-HTIN(3))
      XLN = (XH+0.5*DB*AHT(38))/DB
      XLA = (XH+HTIN(6)+0.5*DB*AHT(80))/DB
      XLA = BD(1)/DB-XLA
      RN  = FLC(I+2)*AHT(122)
      DBM = SBD(120)
      WL  = 0.5*ZW/DBM
      VT  = 0.0
      HD  = 0.0
      DOB = 0.5*DBM/HTIN(4)
      CALL WBCM0(AHT(120), AHT(38), HTIN(16), XLN, XLA, AHT(118),       &
     &      HTIN(62),HTIN(11), HTIN(93), HTIN(94), RN, FLC(96), WL,     &
     &      VT, HD, DOB, FLC(I+2), CMOHB)
      TRAH(74) = CMOHB
 1020 CONTINUE
      RETURN
      END

      SUBROUTINE TRANAC (NPT,X,Y,DYL,DYR,DELY,XVAL,YVAL)
!
!***  COMPUTES TRANSONIC PLANFORM CL BY NON-LINEAR INTERPOLATION
!
      INTEGER RP
      DIMENSION X(NPT),Y(NPT),YP(2)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
!   METHOD - SLOPES ARE DEFINED AT EACH DATA POINT AS A VALUE HALF WAY
!            BETWEEN THE LINEAR SLOPES TO THE RIGHT AND LEFT OF THE
!            POINT. A THIRD ORDER POLYNOMIAL IS DETERMINED FOR EACH
!            INTERVAL BETWEEN DATA POINTS BY USING THE TWO END POINTS
!            AND TWO END POINT SLOPES. THE LEFT AND RIGHT END SLOPES
!            ARE INPUT. THE RESULTING CURVE AND ITS DERIVATIVES ARE
!            CONTINUOUS.
!
!   NPT      NUMBER OF POINTS IN X AND Y ARRAYS
!   X        ABSCISSAS OF INPUT DATA
!   Y        ORDINATES OF INPUT DATA
!   DYL      LEFT END SLOPE
!   DYR      RIGHT END SLOPE
!
!   XVAL     ABSCISSA VALUE AT WHICH INTERPOLATION TO BE PERFORMED
!   YVAL     INTERPOLATED ORDINATE VALUE
!
      NPT1 = NPT-1
      DO 1000 J = 2,NPT1
        IF(XVAL .LT. X(J)) GO TO 1010
 1000 END DO
      J = NPT
 1010 CONTINUE
      J = J-1
      K = J+1
!
      DO 1040 N = 1,2
        MP = J+N-1
        LP = MP-1
        RP = MP+1
!
        IF(MP .NE. 1) GO TO 1020
          YP(N)     = DYL
 1020   IF(MP .EQ. 1 .OR. MP .EQ. NPT) GO TO 1030
          SL    = (Y(LP)-Y(MP))/(X(LP)-X(MP))
          SR    = (Y(MP)-Y(RP))/(X(MP)-X(RP))
          ANGL  = ATAN(SL)
          ANGR  = ATAN(SR)
          ANGAV = (ANGL+ANGR)/2.0
          YP(N) = SIN(ANGAV)/COS(ANGAV)
          IF((NPT .EQ. 8) .AND. (MP .EQ. 5) .AND. (DELY .LT. -UNUSED))  &
     &      YP(N) = 0.0
          IF(SR .EQ. 0.0) GO TO 1030
            IF((SL/SR) .LT. 0.0) YP(N) = 0.0
 1030   IF(MP .NE. NPT) GO TO 1040
          YP(N) = DYR
 1040 END DO
!
      IF((NPT .EQ. 8) .AND. (J .EQ. 5)) Y(J) = Y(J)+DELY
      IF((NPT .EQ. 8) .AND. (K .EQ. 5)) Y(K) = Y(K)+DELY
      X1S  = X(J)*X(J)
      X2S  = X(K)*X(K)
      X12F = X(J)-X(K)
      Y12F = Y(J)-Y(K)
      X12S = X1S-X2S
      X12C = X1S*X(J)-X2S*X(K)
      Y12P = YP(1)-YP(2)
!
      RED = 2.0*X(K)*X12F - X12S
      GRN = 3.0*X2S*X12F - X12C
      YEL = YP(2)*X12F-Y12F
      E   = 3.0*X12S*RED - 2.0*X12F*GRN
      A   = Y12P*RED - 2.0*X12F*YEL
      A   = A/E
      B   = 3.0*X12S*YEL - Y12P*GRN
      B   = B/E
      C   = (Y12F-A*X12C-B*X12S)/X12F
      D   = Y(K)-A*X2S*X(K)-B*X2S-C*X(K)
      IF((NPT .EQ. 8) .AND. (J .EQ. 5)) Y(J) = Y(J)-DELY
      IF((NPT .EQ. 8) .AND. (K .EQ. 5)) Y(K) = Y(K)-DELY
!
      YVAL = (((A*XVAL +B)*XVAL)+C)*XVAL+D
!
      RETURN
      END

      SUBROUTINE TRANCD
!
!***  CALCULATES TRANSONIC WING AND WING-BODY CD
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(95), TR, dumflgtcd(64)
      COMMON /BDATA/  BD(762)
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /HTI/    HTIN(154)
      COMMON /IBH/    PBH, BH(380)
      COMMON /WINGI/  WINGIN(100)
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /IBW/    PBW, BW(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST
      REAL LN, LA
      LOGICAL NA
      DIMENSION CDL(20)
      DATA STRA / 4HSTRA /
!
!***  WING-BODY DRAG
!
      IF(NF .LT. 0) GO TO 1040
      IF(WINGIN(15) .NE. STRA .OR. .NOT. (BO .AND. WGPL)) GO TO 1020
      CD0 = BW(1)
      RN = FLC(I+42)*A(122)
      DB = 2.0*(WINGIN(4)-WINGIN(3))
      LN = (XW + 0.5*DB*A(38))/DB
      LA = (XW + WINGIN(6) + 0.5*DB*A(56))/DB
      IF(BD(2) .LT. (LN*DB)) LN = LN*DB/BD(85)
      IF(BD(2) .GT. (LA*DB)) LA = LA*DB/BD(85)
      LA = BD(1)/DB-LA
      CALL WBCDL(A(120), A(38), WINGIN(16), LN, LA, A(118),             &
     &          WINGIN(62), WINGIN(11), WINGIN(93), WINGIN(94), RN,     &
     &          TR, FLC(I+2), FLC(23), CDL, NA)
      IF(NA) GO TO 1020
        DO 1010 J=1,NALPHA
           BW(J) = CD0 + CDL(J)
           IF(CDL(J) .NE. UNUSED) GO TO 1010
           BW(J) = -UNUSED
 1010 END DO
 1020 CONTINUE
!
!***  H.T.-BODY DRAG
!
      IF(HTIN(15) .NE. STRA .OR. .NOT. HTPL) GO TO 1040
      CD0 = BH(1)
      RN = FLC(I+42)*AHT(122)
      DB = 2.0*(HTIN(4)-HTIN(3))
      LN = (XH + 0.5*DB*AHT(38))/DB
      LA = (XH + HTIN(6) + 0.5*DB*AHT(56))/DB
      IF(BD(2) .LT. (LN*DB)) LN = LN*DB/BD(85)
      IF(BD(2) .GT. (LA*DB)) LA = LA*DB/BD(85)
      LA = BD(1)/DB-LA
      CALL WBCDL(AHT(120), AHT(38), HTIN(16), LN, LA, AHT(118),         &
     &          HTIN(62), HTIN(11), HTIN(93), HTIN(94), RN,             &
     &          TR, FLC(I+2), FLC(23), CDL, NA)
      IF(NA) GO TO 1040
        DO 1030 J=1,NALPHA
           BH(J) = CD0 + CDL(J)
           IF(CDL(J) .NE. UNUSED) GO TO 1030
           BH(J) = -UNUSED
 1030 END DO
 1040 CONTINUE
      RETURN
      END

      SUBROUTINE TRANCM
!
!*** COMPUTES TRANSONIC WING AND WING BODY PITCHING MOMENT SLOPES
!
      DIMENSION ROUTID(2)
      DIMENSION Q225AD(3),Q222AF(3),Q14228(3)
      REAL MACH,MFB
      DIMENSION T428(14),D428(28),XM(6)
      DIMENSION VAR(4),LGH(4),VBAR(4),XMV(6),XACV(6),ZMT(8),XACP(8)
      DIMENSION D425AD(756)
      DIMENSION T425AD(30),DUMY1(63),DUMY2(63),DUMY3(63),DUMY4(63),DUMY5&
     &(63),DUMY6(63),DUMY7(63),DUMY8(63),DUMY9(63),DUMY10(63),DUMY11(63)
      DIMENSION DUMY12(63)
      DIMENSION DUMYA(72),DUMYB(72),DUMYC(72),DUMYD(72),DUMYE(72),DUMYF &
     &(72),DUMYG(72),DUMYH(72),DUMYI(72),DUMYJ(72),DUMYK(72),DUMYL(72)
      DIMENSION T422AF(18),SUBAF1(216),SUBAF2(216),SUPAF1(216)          &
     &,SUPAF2(216)
      COMMON /OVERLY/ NLOG,NMACH,NZ
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &               XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /WINGI/  WINGIN(15),TOVC
      COMMON /SBETA/  STB(135),TRA(108)
      COMMON /SUPWBB/  SWB(61)
      COMMON /WHWB/   FACT(182),WB(39)
      COMMON /WINGD/  A(195),B(49)
      COMMON /BDATA/  BD(762)
      COMMON /IBODY/  PBODY, BODY(400)
      COMMON /IWING/  PWING, WING(400)
      COMMON /IBW/    PBW, BW(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS
      EQUIVALENCE (XACBW4,SWB(8)),(XACBW6,WB(13)),(CLAWB,TRA(71)),      &
     &            (CLABW,TRA(72)),(CLAWBD,BW(101))
      EQUIVALENCE (SUBAF1(1),DUMYA(1)),(SUBAF1(73),DUMYB(1)),(SUBAF1(145&
     &),DUMYC(1)),(SUBAF2(1),DUMYD(1)),(SUBAF2(73),DUMYE(1)),(SUBAF2(145&
     &),DUMYF(1)),(SUPAF1(1),DUMYG(1)),(SUPAF1(73),DUMYH(1)),(SUPAF1(145&
     &),DUMYI(1)),(SUPAF2(1),DUMYJ(1)),(SUPAF2(73),DUMYK(1)),(SUPAF2(145&
     &),DUMYL(1))
      EQUIVALENCE (D425AD(1),DUMY1(1)),(D425AD(64),DUMY2(1)),(D425AD(127&
     &),DUMY3(1)),(D425AD(190),DUMY4(1)),(D425AD(253),DUMY5(1)),(D425AD(&
     &316),DUMY6(1)),(D425AD(379),DUMY7(1)),(D425AD(442),DUMY8(1)),(D425&
     &AD(505),DUMY9(1)),(D425AD(568),DUMY10(1)),(D425AD(631),DUMY11(1)),&
     &(D425AD(694),DUMY12(1))
      EQUIVALENCE (ARSTAR,A(7)),(TANLE,A(62)),(TAPR,A(27))              &
     &,(MACH,TRA(4)),(COSC2,A(73)),(MFB,TRA(6)),(CRSTAR,A(10))          &
     &,(DXCG,A(173)),(CLAW,WING(101)),(CMAB,BODY(121)),(CLAB,BODY(101))
      EQUIVALENCE(XMV(1),TRA(83)),(XACV(1),TRA(89)),                    &
     &(DELXAC,TRA(96)),(XACP(1),TRA(97)),(XAC,TRA(105)),(CMAW,WING(121) &
     &),(XACBW,TRA(106)),(XACWB,TRA(107)),(CMAWB,BW(121))               &
     &,(XACW,TRA(95))
      DATA ROUTID/4HTRAN,4HCM  /
      DATA Q225AD /4H4.1.,4H4.2-,4H30AD/,Q222AF /4H4.1.,4H4.2-,4H26AF/, &
     &     Q14228 /4H4.1.,4H4.2-,4H33  /
      DATA XM/0.5,0.7,0.6,1.3,1.5,1.4/
!
!           ****** FIGURE 4.1.4.2-26(A),(B),(C),(D),(E),(F) ******
!
      DATA T422AF/                                                      &
     &0.,.2,.4,.6,.8,1.,                                                &
     &1.,2.,3.,4.,5.,6.,                                                &
     &0.,.2,.25,.33,.5,1./
      DATA DUMYA/                                                       &
     &  .250,   .245,   .240,   .235,   .230,   .225,   .335,   .335,   &
     &  .335,   .335,   .335,   .335,   .420,   .430,   .435,   .445,   &
     &  .450,   .455,   .500,   .515,   .530,   .540,   .550,   .560,   &
     &  .580,   .600,   .630,   .645,   .660,   .680,   .680,   .695,   &
     &  .720,   .740,   .760,   .780,                                   &
     &  .285,   .275,   .270,   .265,   .260,   .255,   .400,   .410,   &
     &  .415,   .415,   .415,   .410,   .510,   .530,   .535,   .540,   &
     &  .545,   .550,   .640,   .650,   .660,   .675,   .685,   .690,   &
     &  .750,   .765,   .780,   .785,   .800,   .815,   .870,   .880,   &
     &  .895,   .905,   .920,   .930/
      DATA DUMYB/                                                       &
     &  .300,   .295,   .285,   .280,   .275,   .265,   .420,   .420,   &
     &  .425,   .425,   .425,   .430,   .545,   .550,   .560,   .565,   &
     &  .575,   .580,   .670,   .680,   .690,   .700,   .710,   .720,   &
     &  .795,   .805,   .815,   .830,   .840,   .850,   .925,   .945,   &
     &  .960,   .965,   .975,   .980,                                   &
     &  .325,   .320,   .315,   .305,   .300,   .290,   .460,   .460,   &
     &  .460,   .460,   .455,   .455,   .595,   .600,   .600,   .600,   &
     &  .610,   .620,   .735,   .740,   .750,   .760,   .765,   .775,   &
     &  .885,   .890,   .895,   .900,   .910,   .925,   1.045,  1.050,  &
     &  1.050,  1.060,  1.065,  1.075/
      DATA DUMYC/                                                       &
     &  .355,   .350,   .345,   .340,   .330,   .320,   .530,   .530,   &
     &  .525,   .525,   .520,   .520,   .700,   .700,   .700,   .705,   &
     &  .710,   .710,   .880,   .880,   .885,   .890,   .890,   .895,   &
     &  1.040,  1.045,  1.050,  1.055,  1.060,  1.065,  1.200,  1.205,  &
     &  1.210,  1.215,  1.225,  1.230,                                  &
     &  .510,   .490,   .480,   .470,   .460,   .450,   .750,   .750,   &
     &  .750,   .750,   .745,   .740,   1.000,  1.000,  1.000,  1.000,  &
     &  1.000,  1.000,  1.250,  1.250,  1.250,  1.250,  1.250,  1.250,  &
     &  1.500,  1.500,  1.500,  1.490,  1.490,  1.490,  1.740,  1.740,  &
     &  1.740,  1.730,  1.730,  1.730/
      DATA DUMYD/                                                       &
     &  .165,   .180,   .200,   .210,   .220,   .225,   .335,   .335,   &
     &  .335,   .335,   .335,   .335,   .500,   .480,   .465,   .460,   &
     &  .460,   .455,   .670,   .625,   .595,   .580,   .575,   .560,   &
     &  .830,   .750,   .730,   .705,   .695,   .680,   .990,   .860,   &
     &  .835,   .810,   .795,   .780,                                   &
     &  .200,   .215,   .230,   .240,   .250,   .255,   .400,   .400,   &
     &  .400,   .405,   .410,   .410,   .600,   .580,   .565,   .560,   &
     &  .555,   .550,   .795,   .760,   .735,   .715,   .700,   .690,   &
     &  .970,   .910,   .870,   .840,   .825,   .815,   1.150,  1.050,  &
     &  1.000,  .965,   .940,   .930/
      DATA DUMYE/                                                       &
     &  .230,   .240,   .245,   .250,   .260,   .265,   .415,   .420,   &
     &  .425,   .425,   .430,   .430,   .630,   .615,   .600,   .590,   &
     &  .585,   .580,   .830,   .785,   .760,   .740,   .730,   .720,   &
     &  1.030,  .950,   .905,   .880,   .865,   .850,   1.250,  1.090,  &
     &  1.050,  1.015,  .990,   .980,                                   &
     &  .220,   .240,   .250,   .265,   .280,   .290,   .440,   .445,   &
     &  .450,   .450,   .455,   .455,   .670,   .655,   .640,   .630,   &
     &  .625,   .620,   .880,   .830,   .805,   .790,   .780,   .775,   &
     &  1.070,  1.000,  .960,   .940,   .935,   .925,   1.270,  1.170,  &
     &  1.120,  1.100,  1.085,  1.075/
      DATA DUMYF/                                                       &
     &  .250,   .270,   .295,   .310,   .315,   .320,   .500,   .505,   &
     &  .510,   .515,   .520,   .520,   .750,   .740,   .730,   .720,   &
     &  .715,   .710,   .980,   .940,   .915,   .900,   .900,   .895,   &
     &  1.190,  1.120,  1.090,  1.080,  1.070,  1.065,  1.380,  1.300,  &
     &  1.270,  1.250,  1.240,  1.230,                                  &
     &  .340,   .380,   .410,   .430,   .440,   .450,   .680,   .700,   &
     &  .720,   .730,   .730,   .740,   .950,   .980,   1.000,  1.000,  &
     &  1.000,  1.000,  1.200,  1.230,  1.250,  1.250,  1.250,  1.250,  &
     &  1.440,  1.470,  1.480,  1.480,  1.490,  1.490,  1.680,  1.710,  &
     &  1.710,  1.720,  1.720,  1.730/
      DATA DUMYG/                                                       &
     &  .165,   .210,   .250,   .290,   .310,   .345,   .335,   .365,   &
     &  .390,   .415,   .445,   .470,   .500,   .540,   .560,   .560,   &
     &  .560,   .560,   .670,   .670,   .670,   .670,   .670,   .670,   &
     &  .830,   .775,   .775,   .775,   .775,   .775,   .990,   .930,   &
     &  .895,   .895,   .895,   .895,                                   &
     &  .200,   .230,   .280,   .305,   .335,   .360,   .400,   .445,   &
     &  .485,   .500,   .520,   .530,   .600,   .630,   .650,   .660,   &
     &  .665,   .665,   .795,   .800,   .800,   .805,   .810,   .815,   &
     &  .970,   .965,   .955,   .955,   .955,   .955,   1.150,  1.135,  &
     &  1.120,  1.100,  1.100,  1.105/
      DATA DUMYH/                                                       &
     &  .230,   .275,   .300,   .330,   .350,   .370,   .415,   .470,   &
     &  .500,   .530,   .545,   .550,   .630,   .670,   .680,   .685,   &
     &  .690,   .690,   .830,   .835,   .835,   .840,   .845,   .850,   &
     &  1.030,  1.015,  1.005,  1.000,  1.005,  1.010,  1.250,  1.225,  &
     &  1.200,  1.170,  1.165,  1.160,                                  &
     &  .220,   .280,   .315,   .345,   .375,   .390,   .440,   .500,   &
     &  .535,   .560,   .570,   .580,   .670,   .700,   .720,   .725,   &
     &  .740,   .740,   .880,   .885,   .895,   .900,   .900,   .900,   &
     &  1.070,  1.070,  1.075,  1.075,  1.080,  1.080,  1.270,  1.260,  &
     &  1.260,  1.255,  1.255,  1.255/
      DATA DUMYI/                                                       &
     &  .250,   .300,   .330,   .380,   .415,   .445,   .500,   .560,   &
     &  .600,   .620,   .635,   .640,   .750,   .780,   .800,   .820,   &
     &  .820,   .825,   .980,   .990,   1.000,  1.020,  1.020,  1.020,  &
     &  1.190,  1.200,  1.200,  1.210,  1.220,  1.225,  1.380,  1.390,  &
     &  1.400,  1.410,  1.420,  1.420,                                  &
     &  .340,   .380,   .410,   .460,   .500,   .540,   .680,   .700,   &
     &  .730,   .770,   .790,   .840,   .950,   .990,   1.010,  1.050,  &
     &  1.080,  1.120,  1.200,  1.240,  1.290,  1.330,  1.370,  1.420,  &
     &  1.440,  1.500,  1.550,  1.610,  1.670,  1.720,  1.680,  1.760,  &
     &  1.820,  1.890,  1.950,  2.020/
      DATA DUMYJ/                                                       &
     &  .415,   .410,   .400,   .385,   .370,   .345,   .500,   .500,   &
     &  .495,   .485,   .480,   .470,   .585,   .580,   .580,   .575,   &
     &  .570,   .560,   .670,   .670,   .670,   .670,   .670,   .670,   &
     &  .750,   .750,   .755,   .760,   .765,   .775,   .830,   .840,   &
     &  .845,   .855,   .870,   .895,                                   &
     &  .460,   .455,   .445,   .420,   .390,   .360,   .575,   .575,   &
     &  .570,   .560,   .545,   .530,   .695,   .695,   .690,   .685,   &
     &  .680,   .665,   .800,   .805,   .805,   .810,   .815,   .815,   &
     &  .920,   .930,   .935,   .945,   .970,   .955,   1.040,  1.045,  &
     &  1.050,  1.075,  1.110,  1.105/
      DATA DUMYK/                                                       &
     &  .475,   .465,   .450,   .430,   .400,   .370,   .600,   .600,   &
     &  .595,   .585,   .575,   .550,   .725,   .730,   .730,   .725,   &
     &  .715,   .690,   .850,   .850,   .855,   .865,   .870,   .850,   &
     &  .970,   .975,   .980,   1.000,  1.020,  1.010,  1.110,  1.110,  &
     &  1.110,  1.130,  1.180,  1.160,                                  &
     &  .500,   .490,   .470,   .450,   .425,   .390,   .640,   .635,   &
     &  .630,   .620,   .600,   .580,   .770,   .775,   .780,   .775,   &
     &  .765,   .740,   .920,   .915,   .920,   .930,   .935,   .900,   &
     &  1.050,  1.055,  1.060,  1.080,  1.105,  1.080,  1.195,  1.200,  &
     &  1.205,  1.225,  1.265,  1.255/
      DATA DUMYL/                                                       &
     &  .550,   .535,   .525,   .500,   .475,   .445,   .720,   .715,   &
     &  .710,   .690,   .670,   .640,   .890,   .890,   .890,   .885,   &
     &  .870,   .825,   1.060,  1.050,  1.050,  1.060,  1.065,  1.020,  &
     &  1.215,  1.215,  1.220,  1.245,  1.270,  1.225,  1.380,  1.380,  &
     &  1.395,  1.420,  1.470,  1.420,                                  &
     &  .760,   .730,   .700,   .650,   .600,   .540,   1.000,  1.000,  &
     &  .970,   .930,   .890,   .840,   1.240,  1.230,  1.230,  1.220,  &
     &  1.190,  1.120,  1.500,  1.480,  1.480,  1.490,  1.470,  1.420,  &
     &  1.750,  1.720,  1.730,  1.760,  1.780,  1.720,  2.000,  1.970,  &
     &  1.980,  2.020,  2.070,  2.020/
!
!           ****** FIGURE 4.1.4.2-30(A),(B),(C),(D) ******
!
      DATA T425AD/                                                      &
     &0.,.75,1.,1.25,2.,3.,6.,2*0.,                                     &
     &0.,1.,2.,3.,4.,5.,6.,10.,15.,                                     &
     &-2.0000001,-1.0,0.0,1.0000001,5*0.,                               &
     &0.,.2,.5/
      DATA DUMY1/                                                       &
     &  0.,     .100,   .125,   .140,   .160,   .173,   .210,   .175,   &
     &  .230,   .260,   .264,   .280,   .300,   .370,   .340,   .375,   &
     &  .390,   .392,   .400,   .412,   .450,   .496,   .504,   .509,   &
     &  .510,   .518,   .530,   .565,   .655,   .625,   .623,   .623,   &
     &  .625,   .627,   .630,   .810,   .735,   .735,   .732,   .729,   &
     &  .725,   .705,   .970,   .855,   .845,   .835,   .835,   .825,   &
     &  .805,   1.610,  1.280,  1.260,  1.245,  1.215,  1.170,  1.035,  &
     &  2.405,  1.800,  1.725,  1.705,  1.635,  1.555,  1.280/
      DATA DUMY2/                                                       &
     &  0.,     .090,   .115,   .140,   .168,   .200,   .290,   .173,   &
     &  .245,   .270,   .288,   .305,   .320,   .365,   .340,   .390,   &
     &  .405,   .425,   .435,   .445,   .490,   .500,   .525,   .530,   &
     &  .533,   .540,   .553,   .585,   .664,   .650,   .652,   .654,   &
     &  .660,   .667,   .685,   .815,   .780,   .776,   .776,   .778,   &
     &  .780,   .785,   .970,   .900,   .880,   .880,   .880,   .880,   &
     &  .880,   1.610,  1.400,  1.325,  1.270,  1.280,  1.290,  1.310,  &
     &  2.410,  1.980,  1.840,  1.720,  1.745,  1.765,  1.840/
      DATA DUMY3/                                                       &
     &  0.,     .110,   .150,   .199,   .199,   .199,   .199,   .180,   &
     &  .260,   .285,   .310,   .321,   .321,   .321,   .350,   .405,   &
     &  .427,   .440,   .445,   .445,   .445,   .500,   .533,   .543,   &
     &  .550,   .550,   .550,   .550,   .665,   .663,   .662,   .661,   &
     &  .660,   .660,   .660,   .818,   .793,   .788,   .780,   .780,   &
     &  .780,   .780,   .975,   .923,   .905,   .890,   .890,   .890,   &
     &  .890,   1.615,  1.430,  1.380,  1.320,  1.320,  1.320,  1.320,  &
     &  2.415,  2.080,  1.960,  1.845,  1.845,  1.845,  1.845/
      DATA DUMY4/                                                       &
     &  0.,     .120,   .165,   .200,   .200,   .200,   .200,   .175,   &
     &  .275,   .300,   .324,   .324,   .324,   .324,   .335,   .417,   &
     &  .445,   .445,   .445,   .445,   .445,   .500,   .548,   .548,   &
     &  .548,   .548,   .548,   .548,   .665,   .665,   .665,   .665,   &
     &  .665,   .665,   .665,   .815,   .775,   .775,   .775,   .775,   &
     &  .775,   .775,   .985,   .880,   .880,   .880,   .880,   .880,   &
     &  .880,   1.630,  1.280,  1.280,  1.280,  1.280,  1.280,  1.280,  &
     &  2.435,  1.730,  1.730,  1.730,  1.730,  1.730,  1.730/
      DATA DUMY5/                                                       &
     &  0.,     .120,   .135,   .150,   .168,   .186,   .240,   .200,   &
     &  .270,   .280,   .284,   .296,   .315,   .375,   .400,   .425,   &
     &  .426,   .430,   .440,   .450,   .483,   .600,   .575,   .575,   &
     &  .575,   .576,   .577,   .589,   .795,   .730,   .718,   .719,   &
     &  .720,   .721,   .725,   .980,   .860,   .837,   .835,   .830,   &
     &  .825,   .805,   1.175,  1.020,  .980,   .975,   .965,   .955,   &
     &  .910,   1.955,  1.590,  1.470,  1.405,  1.400,  1.390,  1.370,  &
     &  2.930,  2.360,  2.160,  1.960,  1.940,  1.910,  1.830/
      DATA DUMY6/                                                       &
     &  0.,     .085,   .120,   .145,   .186,   .215,   .295,   .205,   &
     &  .270,   .300,   .325,   .348,   .368,   .430,   .400,   .449,   &
     &  .470,   .485,   .495,   .510,   .530,   .600,   .610,   .614,   &
     &  .618,   .632,   .649,   .700,   .800,   .778,   .770,   .773,   &
     &  .780,   .794,   .830,   .978,   .935,   .915,   .916,   .919,   &
     &  .919,   .919,   1.165,  1.085,  1.060,  1.060,  1.055,  1.050,  &
     &  1.045,  1.940,  1.750,  1.695,  1.645,  1.620,  1.585,  1.480,  &
     &  2.905,  2.505,  2.485,  2.450,  2.380,  2.275,  1.965/
      DATA DUMY7/                                                       &
     &  0.,     .125,   .175,   .210,   .215,   .215,   .215,   .200,   &
     &  .290,   .320,   .355,   .360,   .360,   .360,   .400,   .465,   &
     &  .485,   .505,   .510,   .510,   .510,   .600,   .630,   .640,   &
     &  .648,   .650,   .650,   .650,   .800,   .795,   .794,   .793,   &
     &  .793,   .793,   .793,   .980,   .940,   .925,   .910,   .910,   &
     &  .910,   .910,   1.175,  1.070,  1.040,  1.040,  1.040,  1.040,  &
     &  1.040,  1.960,  1.610,  1.490,  1.490,  1.490,  1.490,  1.490,  &
     &  2.940,  2.240,  2.000,  2.000,  2.000,  2.000,  2.000/
      DATA DUMY8/                                                       &
     &  0.,     .150,   .200,   .237,   .237,   .237,   .237,   .200,   &
     &  .320,   .370,   .382,   .382,   .382,   .382,   .400,   .490,   &
     &  .523,   .523,   .523,   .523,   .523,   .600,   .640,   .650,   &
     &  .650,   .650,   .650,   .650,   .800,   .782,   .780,   .780,   &
     &  .780,   .780,   .780,   .980,   .895,   .888,   .888,   .888,   &
     &  .888,   .888,   1.175,  1.040,  1.000,  1.000,  1.000,  1.000,  &
     &  1.000,  1.960,  1.540,  1.420,  1.420,  1.420,  1.420,  1.420,  &
     &  2.940,  1.910,  1.910,  1.910,  1.910,  1.910,  1.910/
      DATA DUMY9/                                                       &
     &  0.,     .120,   .150,   .163,   .178,   .195,   .255,   .260,   &
     &  .335,   .350,   .351,   .365,   .385,   .430,   .500,   .530,   &
     &  .535,   .540,   .550,   .565,   .610,   .753,   .738,   .738,   &
     &  .738,   .735,   .735,   .725,   .975,   .912,   .908,   .904,   &
     &  .894,   .884,   .845,   1.220,  1.140,  1.110,  1.080,  1.060,  &
     &  1.040,  .960,   1.460,  1.330,  1.280,  1.240,  1.210,  1.180,  &
     &  1.090,  2.420,  2.070,  1.960,  1.840,  1.785,  1.725,  1.520,  &
     &  3.600,  3.180,  3.040,  2.900,  2.480,  2.365,  2.000/
      DATA DUMY10/                                                      &
     &  0.,     .095,   .140,   .173,   .230,   .278,   .420,   .260,   &
     &  .34,    .370,   .394,   .420,   .455,   .550,   .510,   .560,   &
     &  .585,   .593,   .610,   .634,   .705,   .750,   .775,   .780,   &
     &  .786,   .798,   .810,   .850,   .980,   .955,   .950,   .950,   &
     &  .948,   .945,   .935,   1.180,  1.105,  1.097,  1.094,  1.080,  &
     &  1.065,  1.015,  1.385,  1.270,  1.240,  1.230,  1.220,  1.205,  &
     &  1.170,  2.150,  1.860,  1.760,  1.650,  1.640,  1.620,  1.560,  &
     &  3.050,  2.500,  2.310,  2.140,  2.115,  2.085,  2.000/
      DATA DUMY11/                                                      &
     &  0.,     .150,   .200,   .260,   .275,   .275,   .275,   .260,   &
     &  .370,   .405,   .445,   .455,   .455,   .455,   .510,   .583,   &
     &  .605,   .630,   .634,   .634,   .634,   .755,   .788,   .800,   &
     &  .800,   .800,   .800,   .800,   .980,   .960,   .950,   .943,   &
     &  .943,   .943,   .943,   1.175,  1.110,  1.093,  1.064,  1.064,  &
     &  1.064,  1.064,  1.360,  1.240,  1.210,  1.163,  1.163,  1.163,  &
     &  1.163,  2.070,  1.750,  1.645,  1.540,  1.540,  1.540,  1.540,  &
     &  2.910,  2.320,  2.125,  1.940,  1.940,  1.940,  1.940/
      DATA DUMY12/                                                      &
     &  0.,     .165,   .245,   .280,   .280,   .280,   .280,   .260,   &
     &  .405,   .475,   .475,   .475,   .475,   .475,   .510,   .610,   &
     &  .650,   .650,   .650,   .650,   .650,   .755,   .800,   .820,   &
     &  .820,   .820,   .820,   .820,   .980,   .961,   .960,   .960,   &
     &  .960,   .960,   .960,   1.180,  6*1.08,                         &
     &                  1.370,  1.250,  1.250,  1.250,  1.250,  1.250,  &
     &  1.250,  2.090,  1.780,  1.780,  1.780,  1.780,  1.780,  1.780,  &
     &  2.910,  2.400,  2.400,  2.400,  2.400,  2.400,  2.400/
!
!           ****** FIGURE 4.1.4.2-33
!
      DATA T428/                                                        &
     &0.,6.6,10.,14.,3*0.,                                              &
     &0.,1.7,2.0,2.5,3.0,4.0,6.0/
      DATA D428/                                                        &
     &  0.,     0.,     0.,     0.,     0.,     0.,     0.,     0.,     &
     &  0.,   0.,   -.100,  -.220,   0.,   0.,  -.210,   -.450,         &
     &  0.,   0.,   -.305,  -.665,   0.,   0.,  -.475,   -1.040,        &
     &  0.,   0.,   -.650,  -1.410/
!
!  *** WING ALONE ***
!  *** TOVC .LE.0.07 ***
!              FIGURE 4.1.4.2-30A-D (XAC/CR)
!
      VAR(1)=ARSTAR*(TOVC)**0.3333
      VAR(2)=ARSTAR*TANLE
      VAR(4)=TAPR
      LGH(1)=7
      LGH(2)=9
      LGH(3)=4
      LGH(4)=3
      VBAR(1)=-2.
      VBAR(2)=-1.
      VBAR(3)=0.
      VBAR(4)=1.
      DO 1000 I=2,5
         XMV(I)=SQRT(1.+VBAR(I-1)*TOVC**.6666)
         VAR(3)=VBAR(I-1)
 1000 CALL TLIN4X(T425AD(10 ),T425AD(1  ),T425AD(19 ),T425AD(28 ),D425AD&
     &,LGH(2),LGH(1),LGH(3),LGH(4),VAR(2),VAR(1),VAR(3),VAR(4),XACV(I), &
     &0,0,0,0,2,1,0,1,Q225AD,3,ROUTID)
      IF(WGPL.AND.(.NOT.BO))DXCG=XCG-XW
      XMV(1)=0.60
      XMV(6)=1.40
!
!              FIGURE 4.1.4.2-26A-F
!
      LGH(1)=6
      LGH(2)=6
      LGH(3)=6
      VAR(3)=TAPR
      DO 1030 I=1,3
         ARG1=TANLE/SQRT(1.0-XM(I)**2)
         IF(ARG1.GT.1.)GO TO 1010
         VAR(1)=ARG1
         CALL INTERX(3,T422AF,VAR,LGH,SUBAF1,XACV(1),6,216,             &
     &               0,2,0,0,0,2,0,0,Q222AF,3,ROUTID)
         GO TO 1020
 1010    VAR(1)=1./ARG1
         CALL INTERX(3,T422AF,VAR,LGH,SUBAF2,XACV(1),6,216,             &
     &               0,2,0,0,0,2,0,0,Q222AF,3,ROUTID)
 1020    CONTINUE
         IF(I.EQ.1)DXAC1=XACV(1)
         IF(I.EQ.2)DXAC1=(XACV(1)-DXAC1)/0.2
 1030 END DO
!
      DO 1060 I=4,6
         ARG=SQRT(XM(I)**2-1.0)/TANLE
         IF(ARG.GT.1.)GO TO 1040
         VAR(1)=ARG
         CALL INTERX(3,T422AF,VAR,LGH,SUPAF1,XACV(6),6,216,             &
     &               0,2,0,0,0,2,0,0,Q222AF,3,ROUTID)
         GO TO 1050
 1040    VAR(1)=1./ARG
         CALL INTERX(3,T422AF,VAR,LGH,SUPAF2,XACV(6),6,216,             &
     &               0,2,0,0,0,2,0,0,Q222AF,3,ROUTID)
 1050    CONTINUE
         IF(I.EQ.4)DXAC2=XACV(6)
         IF(I.EQ.5)DXAC2=(XACV(6)-DXAC2)/0.2
 1060 END DO
      CALL TRANAC(6,XMV,XACV,DXAC1,DXAC2,0.0,MACH,XAC)
      IF(TOVC.LE.0.07)GO TO 1080
!
!  *** TOVC .GT.0.07 ***
!              FIGURE 4.1.4.2-33  DELTA XAC
!
      VAR(1)=TOVC*100.
      VAR(2)=ARSTAR*COSC2**2
      LGH(1)=4
      LGH(2)=7
      CALL INTERX(2,T428,VAR,LGH,D428,DELXAC,7,28,                      &
     &            0,-1,0,0,1,0,0,0,Q14228,3,ROUTID)
      ZMT(1)=0.60
      ZMT(2)=(MFB+.6)/2.
      ZMT(3)=MFB
      ZMT(4)=MFB+.03
      ZMT(5)=MFB+.07
      ZMT(6)=MFB+.14
      ZMT(7)=XMV(5)
      IF((ZMT(6)+0.01).GE.ZMT(7))ZMT(7)=(ZMT(6)+1.4)/2.0
      ZMT(8)=1.4
      DO 1070 I=1,8
         CALL TRANAC(6,XMV,XACV,DXAC1,DXAC2,0.0,ZMT(I),XACP(I))
 1070 END DO
      CALL TRANAC(8,ZMT,XACP,DXAC1,DXAC2,DELXAC,MACH,XAC)
 1080 XACW=XAC*CRSTAR/CBARR
      CMAW=(DXCG/CBARR-XACW)*CLAW
      IF(.NOT.BO)RETURN
!
!  *** WING-BODY ***
!
      CALL WBTRAN(NZ)
      CALL WBCM1(A,WINGIN,BD,WB)
      ARG1= ABS(XACBW4-XACBW6)/0.80
      XACBW= XACBW6+ARG1*(MACH-0.60)
      CNOB=(-CMAB/CLAB*CBARR+DXCG)*CLAB/CBARR
      DNUM = CNOB+XACW*CLAWB+XACBW*CLABW
      DNOM= CLAB+CLAWB+CLABW
      XACWB=DNUM/DNOM
      CMAWB=(DXCG/CBARR-XACWB)*CLAWBD
      RETURN
      END

      SUBROUTINE TRANF (NPT,X,Y,DYL,DYR,XVAL,YVAL)
!
!***  COMPUTES TRANSONIC VENTRAL FIN CL BY NON-LINEAR INTERPOLATION
!
      INTEGER RP
      DIMENSION X(NPT),Y(NPT),YP(2)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
!   METHOD - SLOPES ARE DEFINED AT EACH DATA POINT AS A VALUE HALF WAY
!            BETWEEN THE LINEAR SLOPES TO THE RIGHT AND LEFT OF THE
!            POINT. A THIRD ORDER POLYNOMIAL IS DETERMINED FOR EACH
!            INTERVAL BETWEEN DATA POINTS BY USING THE TWO END POINTS
!            AND TWO END POINT SLOPES. THE LEFT AND RIGHT END SLOPES
!            ARE INPUT. THE RESULTING CURVE AND ITS DERIVATIVES ARE
!            CONTINUOUS.
!
!   NPT      NUMBER OF POINTS IN X AND Y ARRAYS
!   X        ABSCISSAS OF INPUT DATA
!   Y        ORDINATES OF INPUT DATA
!   DYL      LEFT END SLOPE
!   DYR      RIGHT END SLOPE
!
!   XVAL     ABSCISSA VALUE AT WHICH INTERPOLATION TO BE PERFORMED
!   YVAL     INTERPOLATED ORDINATE VALUE
!
      NPT1 = NPT-1
      DO 1000 J = 2,NPT1
        IF(XVAL .LT. X(J)) GO TO 1010
 1000 END DO
      J = NPT
 1010 CONTINUE
      J = J-1
      K = J+1
!
      DO 1040 N = 1,2
        MP = J+N-1
        LP = MP-1
        RP = MP+1
!
        IF(MP .NE. 1) GO TO 1020
          YP(N)     = DYL
 1020   IF(MP .EQ. 1 .OR. MP .EQ. NPT) GO TO 1030
          SL    = (Y(LP)-Y(MP))/(X(LP)-X(MP))
          SR    = (Y(MP)-Y(RP))/(X(MP)-X(RP))
          ANGL  = ATAN(SL)
          ANGR  = ATAN(SR)
          ANGAV = (ANGL+ANGR)/2.0
          YP(N) = SIN(ANGAV)/COS(ANGAV)
           IF(Y(MP) .LE. 0.0) YP(N) = 0.0
          IF((NPT .GT. 10) .AND. (ABS(SL) .LE. UNUSED .OR.              &
     &        ABS(SR) .LE. UNUSED)) YP(N) = 0.0
          IF(SR .EQ. 0.0) GO TO 1030
            IF((SL/SR) .LT. 0.0) YP(N) = 0.0
 1030   IF(MP .NE. NPT) GO TO 1040
          YP(N) = DYR
 1040 END DO
!
      X1S  = X(J)*X(J)
      X2S  = X(K)*X(K)
      X12F = X(J)-X(K)
      Y12F = Y(J)-Y(K)
      X12S = X1S-X2S
      X12C = X1S*X(J)-X2S*X(K)
      Y12P = YP(1)-YP(2)
!
      RED = 2.0*X(K)*X12F - X12S
      GRN = 3.0*X2S*X12F - X12C
      YEL = YP(2)*X12F-Y12F
      E   = 3.0*X12S*RED - 2.0*X12F*GRN
      A   = Y12P*RED - 2.0*X12F*YEL
      A   = A/E
      B   = 3.0*X12S*YEL - Y12P*GRN
      B   = B/E
      C   = (Y12F-A*X12C-B*X12S)/X12F
      D   = Y(K)-A*X2S*X(K)-B*X2S-C*X(K)
!
      YVAL = (((A*XVAL +B)*XVAL)+C)*XVAL+D
      IF(YVAL .LT. 0.0) YVAL = 0.0
!
      RETURN
      END

      SUBROUTINE TRANHB
!
!***  EXECUTIVE FOR TRSONJ CALCULATIONS
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG
      CALL TRSONJ(I)
      RETURN
      END

      SUBROUTINE TRANJT
!
!***  HYPERSONIC TRANSVERSE JET SIZING CALCULATIONS
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /IBODY/  PBODY,JET(200), dum1(200)
      COMMON /SUPDW/  JETA(26)
      COMMON /FLAPIN/ F(48)
      REAL ME,ISP,L,M1(10),K(10),K0(10),MACH,JET,JETA
      LOGICAL LAMNR(10)
      DIMENSION ROUTID(2)
      DIMENSION RS(10),HL(10),HLN(10),XCP(10)
      DIMENSION X1235A(3),X2235A(13),Y3235A(39),Q3235A(3)
      DIMENSION X1235B(5),Y3235B(65),Q3235B(3)
      DIMENSION X1235C(6),X2235C(13),Y3235C(78),Q3235C(3)
      DIMENSION X1235D(6),X2235D(12),Y3235D(72),Q3235D(3)
      DIMENSION X1235E(5),X2235E(12),Q3235E(3),Y3235E(60)
      DIMENSION X13243(4),X23243(6),Y63243(24),Q63243(2)
      DIMENSION X13230(  6),X23230( 11),Y63230(  66),Q63230(3)
      DIMENSION X13231(  5),X23231( 11),Y63231(  55),Q63231(3)
      DIMENSION X13232(  6),X23232( 11),Y63232(  66),Q63232(3)
      DIMENSION X13233(  6),X23233( 15),Y63233(  90),Q63233(3)
      DIMENSION X13240(6),X23240(10),Y63240(60),Q63240(2)
      DIMENSION ALPHA(10),P1PI(10),Q1QI(10),R1RI(10),P1(10),Q1(10),     &
     &RL(10),CFC(10),CFCR(10),FJ0(10),FC(10),PJ0P1M(10),P0J(10),        &
     &P0JT(10),RATE(10),TIME(10),WEIGHT(10)
!
!   JET ARRAY CORRESPONDS TO BODY ARRAY ELSEWHERE
!
      EQUIVALENCE (M1(1),JET(1)),(RL(1),JET(11)),(P1(1),JET(21)),(Q1(1),&
     &JET(31)),(CFC(1),JET(41)),(CFCR(1),JET(51)),(K0(1),JET(61)),      &
     &(K(1),JET(71)),(FJ0(1),JET(81)),(PJ0P1M(1),JET(91)),(P0J(1),JET   &
     &(101)),(P0JT(1),JET(111)),(RATE(1),JET(121)),(XCP(1),JET(138))
      EQUIVALENCE (WEIGHT(1),JET(131)),(QINF,JETA(1)),(CF0,JETA(2)),    &
     &(VEOA,JETA(3)),(FJMAX,JETA(4)),(PJMAX,JETA(5)),(DT,JETA(6))
      EQUIVALENCE (FC(1),F(12)),(ME,F(32)),(ALPHA(1),F(22)),            &
     &(ISP,F(33)),(SPAN,F(34)),(PHE,F(35)),(GP,F(36)),(CC,F(37)),       &
     &(L,F(38)),(LAMNR(1),F(39)) ,(TIME(1),F(1))
      DATA ROUTID/4HTRAN,4HJT  /
!
!      ----FIGURE 63230
!
      DATA Q63230/4H6323,4H0   ,4H    /
      DATA X13230/  .300E+02,  .200E+02,  .150E+02,  .100E+02,          &
     &  .700E+01,  .500E+01/
      DATA X23230/  .907E-01,  .206E+01,  .404E+01,  .404E+01,          &
     &  .598E+01,  .800E+01,  .100E+02,  .121E+02,  .140E+02,  .160E+02,&
     &  .180E+02/
      DATA Y63230/  .141E+01,  .445E+01,  .983E+01,  .983E+01,          &
     &  .187E+02,  .321E+02,  .477E+02,  .671E+02,  .894E+02,  .116E+03,&
     &  .148E+03,  .139E+01,  .272E+01,  .524E+01,  .524E+01,  .954E+01,&
     &  .154E+02,  .226E+02,  .319E+02,  .424E+02,  .542E+02,  .667E+02,&
     &  .137E+01,  .185E+01,  .407E+01,  .407E+01,  .608E+01,  .918E+01,&
     &  .136E+02,  .186E+02,  .246E+02,  .314E+02,  .384E+02,  .138E+01,&
     &  .163E+01,  .258E+01,  .258E+01,  .406E+01,  .526E+01,  .728E+01,&
     &  .989E+01,  .121E+02,  .150E+02,  .184E+02,  .138E+01,  .163E+01,&
     &  .191E+01,  .191E+01,  .298E+01,  .395E+01,  .465E+01,  .598E+01,&
     &  .732E+01,  .865E+01,  .105E+02,  .137E+01,  .141E+01,  .146E+01,&
     &  .146E+01,  .195E+01,  .330E+01,  .354E+01,  .402E+01,  .471E+01,&
     &  .540E+01,  .633E+01/
!
!      ----FIGURE 63231
!
      DATA Q63231/4H6323,4H1   ,4H    /
      DATA X13231/  .200E+02,  .150E+02,  .100E+02,  .700E+01,          &
     &  .500E+01/
      DATA X23231/  .184E-01,  .199E+01,  .402E+01,  .599E+01,          &
     &  .794E+01,  .993E+01,  .119E+02,  .139E+02,  .160E+02,  .179E+02,&
     &  .199E+02/
      DATA Y63231/  .101E+01,  .187E+01,  .285E+01,  .369E+01,          &
     &  .420E+01,  .455E+01,  .475E+01,  .482E+01,  .481E+01,  .477E+01,&
     &  .463E+01,  .996E+00,  .166E+01,  .236E+01,  .305E+01,  .359E+01,&
     &  .398E+01,  .427E+01,  .443E+01,  .448E+01,  .447E+01,  .443E+01,&
     &  .101E+01,  .137E+01,  .185E+01,  .231E+01,  .271E+01,  .309E+01,&
     &  .342E+01,  .366E+01,  .380E+01,  .388E+01,  .389E+01,  .100E+01,&
     &  .124E+01,  .153E+01,  .184E+01,  .215E+01,  .243E+01,  .270E+01,&
     &  .290E+01,  .307E+01,  .318E+01,  .323E+01,  .101E+01,  .115E+01,&
     &  .135E+01,  .153E+01,  .175E+01,  .194E+01,  .212E+01,  .229E+01,&
     &  .240E+01,  .249E+01,  .256E+01/
!
!      ----FIGURE 63232
!
      DATA Q63232/4H6323,4H2   ,4H    /
      DATA X13232/  .300E+02,  .200E+02,  .150E+02,  .100E+02,          &
     &  .700E+01,  .500E+01/
      DATA X23232/  .264E-02,  .204E+01,  .400E+01,  .602E+01,          &
     &  .803E+01,  .100E+02,  .120E+02,  .140E+02,  .160E+02,  .180E+02,&
     &  .200E+02/
      DATA Y63232/  .300E+02,  .241E+02,  .191E+02,  .149E+02,          &
     &  .119E+02,  .976E+01,  .828E+01,  .715E+01,  .615E+01,  .550E+01,&
     &  .484E+01,  .200E+02,  .171E+02,  .145E+02,  .124E+02,  .105E+02,&
     &  .886E+01,  .771E+01,  .662E+01,  .593E+01,  .528E+01,  .480E+01,&
     &  .151E+02,  .135E+02,  .121E+02,  .108E+02,  .945E+01,  .837E+01,&
     &  .727E+01,  .650E+01,  .575E+01,  .506E+01,  .454E+01,  .101E+02,&
     &  .934E+01,  .869E+01,  .800E+01,  .731E+01,  .667E+01,  .614E+01,&
     &  .567E+01,  .510E+01,  .466E+01,  .432E+01,  .695E+01,  .669E+01,&
     &  .625E+01,  .596E+01,  .570E+01,  .522E+01,  .493E+01,  .448E+01,&
     &  .422E+01,  .375E+01,  .345E+01,  .503E+01,  .481E+01,  .464E+01,&
     &  .447E+01,  .421E+01,  .391E+01,  .374E+01,  .361E+01,  .335E+01,&
     &  .309E+01,  .292E+01/
!
!      ----FIGURE 63233
!
      DATA Q63233/4H6323,4H3   ,4H    /
      DATA X13233/  .300E+02,  .200E+02,  .150E+02,  .100E+02,          &
     &  .700E+01,  .500E+01/
      DATA X23233/ -.475E-01,  .196E+01,  .291E+01,  .345E+01,          &
     &  .402E+01,  .535E+01,  .606E+01,  .628E+01,  .806E+01,  .101E+02,&
     &  .120E+02,  .140E+02,  .160E+02,  .180E+02,  .200E+02/
      DATA Y63233/  .101E+01,  .180E+01,  .196E+01,  .198E+01,          &
     &  .197E+01,  .187E+01,  .177E+01,  .172E+01,  .147E+01,  .120E+01,&
     &  .101E+01,  .840E+00,  .710E+00,  .610E+00,  .530E+00,  .101E+01,&
     &  .157E+01,  .177E+01,  .185E+01,  .191E+01,  .199E+01,  .199E+01,&
     &  .198E+01,  .184E+01,  .164E+01,  .145E+01,  .126E+01,  .109E+01,&
     &  .949E+00,  .842E+00,  .101E+01,  .143E+01,  .162E+01,  .172E+01,&
     &  .178E+01,  .191E+01,  .196E+01,  .197E+01,  .196E+01,  .185E+01,&
     &  .172E+01,  .156E+01,  .141E+01,  .127E+01,  .113E+01,  .101E+01,&
     &  .129E+01,  .141E+01,  .148E+01,  .153E+01,  .169E+01,  .176E+01,&
     &  .177E+01,  .189E+01,  .193E+01,  .191E+01,  .184E+01,  .176E+01,&
     &  .166E+01,  .154E+01,  .101E+01,  .122E+01,  .130E+01,  .135E+01,&
     &  .140E+01,  .150E+01,  .156E+01,  .157E+01,  .169E+01,  .180E+01,&
     &  .185E+01,  .188E+01,  .185E+01,  .182E+01,  .175E+01,  .101E+01,&
     &  .115E+01,  .122E+01,  .126E+01,  .129E+01,  .136E+01,  .141E+01,&
     &  .142E+01,  .152E+01,  .162E+01,  .168E+01,  .174E+01,  .176E+01,&
     &  .176E+01,  .175E+01/
!
!              FIGURE 6.3.2-35A
!
      DATA X1235A/20.,10.,4./
      DATA X2235A/4E-3,1E-2,2E-2,4E-2,6E-2,8E-2,1E-1,2E-1,4E-1,8E-1,    &
     &1.,2.,6./
      DATA Y3235A/                                                      &
     &3.4,3.3,3.19,2.94,2.67,2.45,2.30,1.98,1.74,1.56,1.50,1.36,1.21,   &
     &3.17,3.10,3.00,2.84,2.68,2.50,2.37,2.02,1.72,1.56,1.51,1.36,1.21, &
     &2.95,2.94,2.90,2.80,2.69,2.60,2.52,2.19,1.85,1.58,1.50,1.36,1.21/
      DATA Q3235A/4H6.3.,4H2-35,4HA   /
!
!              FIGURE 6.3.2-35B
!
      DATA X1235B/20.,10.,6.,4.,2./
      DATA Y3235B/                                                      &
     &4.10,4.01,3.68,3.05,2.69,2.47,2.32,2.00,1.75,1.56,1.50,1.32,1.20, &
     &4.00,3.88,3.63,3.19,2.81,2.58,2.40,2.04,1.78,1.57,1.50,1.32,1.20, &
     &3.84,3.80,3.61,3.22,2.92,2.69,2.50,2.11,1.80,1.60,1.52,1.32,1.20, &
     &3.67,3.61,3.50,3.30,3.09,2.89,2.70,2.20,1.85,1.60,1.52,1.32,1.20, &
     &3.23,3.20,3.14,3.04,2.96,2.88,2.80,2.41,2.03,1.73,1.68,1.41,1.20/
      DATA Q3235B/4H6.3 ,4H2-35,4HB   /
!
!              FIGURE 6.3.2-35C
!
      DATA X1235C/20.,15.,10.,6.,4.,2./
      DATA X2235C/4E-4,1E-3,4E-3,6E-3,8E-3,1E-2,2E-2,4E-2,6E-2,1E-1,    &
     &2E-1,4E-1,8E-1/
      DATA Y3235C/                                                      &
     &5.68,5.61,5.32,5.12,4.93,4.72,3.80,3.00,2.67,2.32,2.00,1.77,1.59, &
     &5.50,5.49,5.20,5.04,4.88,4.72,3.95,3.10,2.67,2.37,2.00,1.77,1.59, &
     &5.36,5.31,5.10,4.96,4.71,4.68,4.00,3.19,3.79,2.40,2.00,1.77,1.59, &
     &4.94,4.93,4.82,4.78,4.70,4.60,4.14,3.41,2.98,2.55,2.12,1.82,1.60, &
     &4.50,4.46,4.40,4.38,4.32,4.28,4.00,3.53,3.15,2.65,2.18,1.82,1.60, &
     &3.60,3.60,3.59,3.58,3.55,3.53,3.48,3.34,3.20,2.88,2.36,2.00,1.72/
      DATA Q3235C/4H6.3.,4H2-35,4HC   /
!
!              FIGURE 6.3.2-35D
!
      DATA X1235D/20.,15.,10.,6.,4.,2./
      DATA X2235D/4E-4,1E-3,4E-3,6E-3,8E-3,1E-2,2E-2,4E-2,6E-2,1E-1,    &
     &4E-1,8E-1/
      DATA Y3235D/                                                      &
     &7.55,7.40,6.60,6.10,5.60,5.20,3.89,3.12,2.75,2.40,1.77,1.57,      &
     &7.33,7.20,6.49,6.05,5.65,5.30,4.00,3.15,2.75,2.40,1.77,1.57,      &
     &6.89,6.84,6.38,6.01,5.70,5.40,4.18,3.26,2.83,2.48,1.77,1.57,      &
     &6.02,6.02,5.80,5.60,5.43,5.29,4.39,3.40,2.99,2.60,1.90,1.70,      &
     &5.20,5.19,5.03,4.99,4.90,4.80,4.38,3.60,3.09,2.60,1.90,1.70,      &
     &3.81,3.83,3.80,3.78,3.73,3.70,3.60,3.48,3.30,2.90,2.00,1.70/
      DATA Q3235D/4H6.3.,4H2-35,4HD   /
!
!              FIGURE 6.3.2-35E
!
      DATA X2235E/4E-4,1E-3,2E-3,4E-3,6E-3,8E-3,1E-2,2E-2,4E-2,1E-1,    &
     &2E-1,8E-1/
      DATA X1235E/20.,15.,10.,6.,4./
      DATA Y3235E/                                                      &
     &10.0,9.52,8.80,7.45,6.39,5.60,5.10,3.88,3.02,2.37,1.99,1.50,      &
     &1.60,9.29,8.70,7.60,6.60,5.80,5.20,3.95,3.04,2.37,1.99,1.52,      &
     &8.73,8.58,8.20,7.50,6.90,6.26,5.62,4.13,3.21,2.41,2.01,1.54,      &
     &7.12,7.00,6.90,6.60,6.32,6.00,5.70,4.47,3.40,2.58,2.10,1.56,      &
     &5.72,5.71,5.67,5.60,5.48,5.34,5.20,4.52,3.57,2.62,2.20,1.59/
      DATA Q3235E/4H6.3.,4H2-35,4HE   /
!
!              FIGURE 6.3.2-43
!
      DATA X13243/1.0,1.5,1.75,2.0/
      DATA X23243/2.,4.,6.,8.,10.,12./
      DATA Y63243/                                                      &
     &7.50,11.4,15.3,18.9,22.6,26.3,                                    &
     &21.2,31.2,41.8,52.0,63.1,74.0,                                    &
     &50.0,73.1,97.0,121.0,148.0,171.0,                                 &
     &192.,282.,376.,477.,573.,650./
      DATA Q63243/4H6.3.,4H2-43/
!
!              FIGURE 6.3.2-40  K0 FOR TURBULENT B.L.
!
      DATA X13240/20.,15.,10.,6.,4.,2./
      DATA X23240/4E-5,1E-4,2E-4,4E-4,2E-3,6E-3,1E-2,2E-2,4E-2,0.1/
      DATA Y63240/                                                      &
     &3.08,2.92,2.78,2.62,2.21,1.92,1.80,1.65,1.49,1.28,                &
     &3.02,2.96,2.88,2.76,2.40,2.11,1.98,1.80,1.63,1.40,                &
     &2.95,2.94,2.90,2.85,2.63,2.37,2.23,2.05,1.87,1.64,                &
     &2.75,2.75,2.75,2.75,2.70,2.58,2.48,2.33,2.17,1.80,                &
     &2.50,2.50,2.52,2.54,2.55,2.53,2.49,2.41,2.29,2.04,                &
     &2.23,2.23,2.22,2.21,2.21,2.21,2.20,2.20,2.20,2.20/
      DATA Q63240/4H6.3.,4H2-40/
!
      MACH=FLC(IM+2)
      RLN=FLC(IM+42)
      PINF=FLC(IM+73)
      NT=F(11)+.5
      QINF=0.7*PINF*MACH**2
      ARG=GP+1.
      ARG1=GP/(GP-1.)
      CF0= (2./ARG)**ARG1*ARG
      DO 1020 J=1,NT
!
!              FIGURE 6.3.2-30
!
         CALL TLINEX(X13230,X23230,Y63230,6,11,MACH,ALPHA(J),P1PI(J),   &
     &               0,0,0,1,Q63230,3,ROUTID)
!
!              FIGURE 6.3.2-31
!
         CALL TLINEX(X13231,X23231,Y63231,5,11,MACH,ALPHA(J),Q1QI(J),   &
     &               0,0,0,0,Q63231,3,ROUTID)
!
!              FIGURE 6.3.2-32
!
         CALL TLINEX(X13232,X23232,Y63232,6,11,MACH,ALPHA(J),M1(J),     &
     &               0,0,0,0,Q63232,3,ROUTID)
!
!              FIGURE 6.3.2-33
!
         CALL TLINEX(X13233,X23233,Y63233,6,15,MACH,ALPHA(J),R1RI(J),   &
     &               0,0,0,0,Q63233,3,ROUTID)
         P1(J)=P1PI(J)*PINF
         Q1(J)=Q1QI(J)*QINF
         RL(J)=R1RI(J)*RLN*L
         CFC(J)=FC(J)/(Q1(J)*SPAN*L*144.)
         CFCR(J)=1.268*CFC(J)/CF0
         IF(LAMNR(J))GO TO 1000
!
!    ----HERE FOR TURBULENT B.L.
!              FIGURE 6.3.2-40  K0
!
         CALL TLINEX(X13240,X23240,Y63240,6,10,M1(J),CFCR(J),K0(J),     &
     &               0,0,0,0,Q63240,2,ROUTID)
         GO TO 1010
!
!    ----HERE FOR LAMINAR B.L.
!              FIGURE 6.3.2-35 A-E  K0
!
 1000    CALL INTER3(M1(J),CFCR(J),RL(J),X1235A,X2235A,Y3235A,3,13,     &
     &               Q3235A,X1235B,X2235A,Y3235B,5,13,Q3235B,           &
     &               X1235C,X2235C,Y3235C,6,13,Q3235C,                  &
     &               X1235D,X2235D,Y3235D,6,12,Q3235D,                  &
     &               X1235E,X2235E,Y3235E,5,12,Q3235E,K0(J))
 1010    CONTINUE
         ARG1=ARG*ME**2
         ARG2=2.+(GP-1.)*ME**2
         VEOA=(ARG1/ARG2)
         VEOA=SQRT(VEOA)
         PH=PHE/RAD
         ARG1=1.+GP*VEOA*SIN(PH)/ARG
         ARG2=(VEOA+1./VEOA)*COS(PH)/2.
         K(J)=(K0(J)-1.)*ARG1+ARG2
         FJ0(J)=FC(J)/K(J)
!
!              FIGURE 6.3.2-43
!
         CALL TLINEX(X13243,X23243,Y63243,4,6,VEOA,M1(J),PJ0P1M(J),     &
     &               0,0,0,0,Q63243,2,ROUTID)
         P0J(J)=PJ0P1M(J)*P1(J)
 1020 END DO
!
!    ----GET MAXIMUM FJ0 AND P0J
!
      FJMAX=FJ0(1)
      PJMAX=P0J(1)
      DO 1030 J=1,NT
         IF(FJ0(J).GT.FJMAX)FJMAX=FJ0(J)
         IF(P0J(J).GT.PJMAX)PJMAX=P0J(J)
 1030 END DO
      ARG=CC*CF0*SPAN*12.0
      DT=FJMAX/(ARG*PJMAX)
      DO 1040 J=1,NT
         P0JT(J)=FJ0(J)/(ARG*DT)
 1040 RATE(J)=FJ0(J)/ISP
      CALL TRAPZ(RATE,NT,TIME,WEIGHT,0)
!
!    ----LOCATE CONSERVATIVE XCP
!
      DO 1090 J=1,NT
         R2=M1(J)**2
         IF(.NOT.LAMNR(J))GO TO 1080
!
!    ----HERE FOR LAMINAR B.L.
!
         RS(1)=.2*RL(J)
         DO 1050 I=2,10
 1050     RS(I)=.75*RS(I-1)
         NZ=10
         DO 1060 I=1,5
            SAVE=RS(I)
            RS(I)=RS(NZ)
            RS(NZ)=SAVE
 1060    NZ=NZ-1
         ARG=2.*CF0*DT/(L*12.)
         ARG3=ARG*P0JT(J)/P1(J)
         DO 1070 I=1,10
            ARG=RS(I)*(R2-1.)
            CP2=1.60/ARG**0.25
            CX=4.75*CP2
            HL(I)=ARG3/(GP*CX*R2+2.)
            P2=CP2*Q1(J)+P1(J)
            ZI=P2/P1(J)
            ARG1=5.*(ZI-1.)/(7.*R2-5.*(ZI-1.))
            ARG=(7.*R2-(6.*ZI+1.))/(6.*ZI+1.)
            ARG=SQRT(ARG)
            TANSIG=ARG1*ARG
            HLN(I)=(1.-RS(I)/RL(J))*TANSIG
 1070    CONTINUE
         CALL SIMUL2(RS,HL,HLN,10,RLS,HOL)
         IF(RLS.EQ.(-1000.))RLS=RS(10)
         ARG=(RLS*(R2-1.))**0.25
         CP2=1.60/ARG
         G=1.-1./K(J)
         ARG=1.-G/2.*CFC(J)/CP2
         XCP(J)=(1.-G)+G*ARG
         GO TO 1090
 1080    CONTINUE
!
!    ----HERE FOR TURB. B.L.
!
         IF(M1(J).GT.5.0)                                               &
     &            CP2=0.2257-0.0232*M1(J)+0.0014*R2-0.00003*R2*M1(J)
         IF(M1(J).LE.5.0)                                               &
     &            CP2=0.41+0.481*M1(J)-0.0509*R2+0.0061*R2*M1(J)
         G=1.-1./K(J)
         ARG=1.-G/2.*CFC(J)/CP2
         XCP(J)=(1.-G)+G*ARG
 1090 END DO
      DO 1100 J=1,10
 1100 JETA(J+16) = JET(J+70)
      RETURN
      END

      SUBROUTINE TRANWB
!
!***  EXECUTIVE FOR TRSONI CALCULATIONS
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG
      CALL TRSONI(I)
      RETURN
      END

      SUBROUTINE TRANWG(CNA, DCNA)
!
!*** COMPUTES THE LIFT CURVE SLOPE AT MACH=1.4 WHICH IS USED IN TRSONI
!
      REAL MACH,KSHARP
      LOGICAL SUPLE
      DIMENSION DUMY1(184),DUMY2(184),DUMY3(184),DUMY5(184),            &
     &          DUMY6(184),DUMY4(184)
      DIMENSION T13246(52),D13246(1104),VAA(4),LGA(4),VAB(4),LGB(4),    &
     & A1350(17), B1350(19),DA50(72),DB50(88),G13246(9),DG3246(9)
      DIMENSION WTYPE(4)
      DIMENSION ROUTID(2),Q3250A(3),Q3250B(3),Q3246A(3),Q3246G(3)
      DIMENSION XM(3), CN(3), BB(3)
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /WINGD/  A(195)
      COMMON /WINGI/  WINGIN(77)
      COMMON /OPTION/ SW
!
      EQUIVALENCE (SRSTAR,A(3))
      EQUIVALENCE (TAPEXP,A(27)),(TANLE,A(62)),(SWEPLE,A(58)),          &
     &(AR,A(7)),(TRATIP,A(25)),(COSLE,A(61)),(DELTAY,WINGIN(17)),       &
     &(TANLEO,A(86)),(TANLEI,A(62)),(KSHARP,WINGIN(71))
      EQUIVALENCE (D13246(1),DUMY1(1)),(D13246(185),DUMY2(1)),(D13246(36&
     &9),DUMY3(1)),(D13246(553),DUMY4(1)),(D13246(737),DUMY5(1)) ,      &
     &(D13246(921),DUMY6(1))
!
      DATA Q3250A/4H4.1.,4H3.2-,4H60A /,Q3246A/4H4.1.,4H3.2-,4H56A /,   &
     &     Q3250B/4H4.1.,4H3.2-,4H60B /,Q3246G/4H4.1.,4H3.2-,4H56G /,   &
     & ROUTID/4HTRAN,4HWG  /
      DATA XM / 1.3, 1.4, 1.5 /
!
!              FIGURE 4.1.3.2-60A (CNA/CNA)T FOR SUBSONIC L.E.
!
      DATA A1350/                                                       &
     & 0.,     .3,     .4,     .5,     .6,     .7,     .8,     .9,      &
     & 1.0001 ,                                                         &
     & 0.,     .41,    .82,    1.24,   2.12,   3.18,   6.95,   16.1 /
      DATA DA50/                                                        &
     & 1.,     1.,     1.,     1.,     1.,     1.,     1.,     1.,      &
     &         1.,                                                      &
     & 1.05,   1.05,   1.05,   1.05,   .985,   .945,   .915,   .9,      &
     & .9,                                                              &
     & 1.04,   1.04,   1.04,   1.04,   .965,   .908,   .87,    .85,     &
     & .84,                                                             &
     & 1.12,   1.12,   1.12,   1.015,  .94,    .88,    .838,   .81,     &
     & .796,                                                            &
     & 1.11,   1.11,   1.11,   1.,     .903,   .84,    .795,   .765,    &
     & .75,                                                             &
     & 1.08,   1.08,   1.08,   .954,   .865,   .8,     .75,    .72,     &
     & .7,                                                              &
     & 1.2,    1.2,    1.043,  .907,   .817,   .75,    .707,   .675,    &
     & .66,                                                             &
     & 1.14,   1.14,   .975,    .857,  .772,   .717,   .675,   .65,     &
     & .632 /
!
!              FIGURE 4.1.3.2-60B (CNA/CNA)T FOR SUPERSONIC L.E.
!
      DATA B1350/                                                       &
     & 0.,     .1,     .2,      .3,    .4,     .5,     .6,     .7,      &
     & .8,     .9,     1.0001 ,                                         &
     & 0.,     4.,     8.,      12.,   20.,    30.,    50.,    70./
      DATA DB50/                                                        &
     & 1.,     1.,     1.,      1.,    1.,     1.,     1.,     1.,      &
     & 1.,     1.,     1.,                                              &
     & 1.15,   1.15,   1.15,    1.15,  1.095,  1.04,   .99,    .96,     &
     & .935,   .915,   .9,                                              &
     & 1.12,   1.12,   1.12,    1.12,  1.05,   .985,   .94,    .905,    &
     & .88,    .857,   .84,                                             &
     & 1.15,   1.15,   1.15,    1.08,  1.005,  .945,   .902,   .87,     &
     & .842,   .82,    .796,                                            &
     & 1.22,   1.14,   1.05,    .98,   .93,    .89,    .853,   .823,    &
     & .795,   .77,    .75,                                             &
     & 1.13,   1.05,   .98,    .925,   .88,    .845,   .81,    .782,    &
     & .752,   .73,    .7,                                              &
     & 1.02,   .942,   .895,   .855,   .82,    .79,    .76,    .735,    &
     & .71,    .685,   .66,                                             &
     & 1.,     .92,    .87,    .825,   .79,    .755,   .728,   .7,      &
     & .678,   .655,   .632 /
!
!              FIGURE 4.1.3.2-56G (CNA/A) FOR A*BETA LESS THAN 1.0
!
      DATA G13246/0.,.2,.4,.45,.5,.6,.8,.9,1.0/
      DATA DG3246/1.61,1.58,1.55,1.57,1.62,1.75,1.94,2.0,2.0/
!
!              FIGURE 4.1.3.2-56A-F (WING SUPERSONIC CNA)
!
      DATA T13246                                                       &
     &  / 0.,.1,.2,.3,.33,.4,.5,.6,.7,.8,.9,1.0,1.111,1.25,1.429,1.667, &
     &    2.0,2.5,2.941,4.167,7.143,14.286, 30. ,                       &
     &    .25,.5,1.,2.,3.,4.,5.,6. , 15*0.,                             &
     &    0.,.2,.25,.3333,.5,1.0/
!
!     FIG 4.1.3.2-56A
!
      DATA DUMY1                                                        &
     &  /  .39, .39, .39, .39, .39, .39, .39, .39, .39, .39, .39, .41,  &
     &     .44, .5 , .58, .65, .80,1.0 ,1.15,1.55,2.40,3.92,4.0 ,       &
     &     .77, .77, .78, .78, .79, .79, .80, .80, .80, .81, .82, .84,  &
     &     .92,1.0 ,1.18,1.32,1.60,1.9 ,2.18,2.80,3.84,3.92,4.0 ,       &
     &    1.55,1.56,1.57,1.57,1.59,1.59,1.60,1.63,1.66,1.68,1.70,1.75,  &
     &    1.88,2.09,2.30,2.6 ,2.94,3.35,3.70,3.80,3.98,3.98,4.0 ,       &
     &    3.15,3.15,3.15,3.15,3.15,3.15,3.17,3.19,3.23,3.27,3.33,3.4 ,  &
     &    3.46,3.54,3.60,3.7 ,3.75,3.8 ,3.86,3.91,4.0 ,4.0 ,4.0 ,       &
     &    4.71,4.74,4.83,5.09,5.25,5.05,4.80,4.55,4.30,4.09,3.90,3.72,  &
     &    3.78,3.8 ,3.83,3.88,3.90,3.94,3.92,3.96,4.0 ,4.0 ,4.0 ,       &
     &    6.29,6.2 ,5.99,5.72,5.61,5.42,5.18,4.9 ,4.64,4.42,4.2 ,4.0 ,  &
     &    4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,       &
     &    6.3 ,6.34,6.39,6.08,5.97,5.78,5.5 ,5.2 ,4.95,4.7 ,4.48,4.25,  &
     &    4.2 ,4.18,4.14,4.11,4.07,4.05,4.04,4.02,4.  ,4.  ,4.  ,       &
     &    6.32,6.4 ,6.4 ,6.34,6.32,6.13,5.82,5.51,5.25,4.99,4.73,4.5 ,  &
     &    4.4 ,4.32,4.27,4.2 ,4.13,4.11,4.07,4.04,4.  ,4.  ,4.  /
!
!     FIG 4.1.3.2-56B
!
      DATA DUMY2                                                        &
     &  /  .41, .41, .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .41,  &
     &     .41, .48, .56, .67, .84,1.08,1.29,1.83,2.80,3.8 ,4.0 ,       &
     &     .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .83, .85,  &
     &     .98,1.09,1.27,1.48,1.80,2.25,2.53,3.22,3.79,3.92,4.  ,       &
     &    1.57,1.59,1.6 ,1.6 ,1.6 ,1.61,1.63,1.65,1.69,1.73,1.77,1.8 ,  &
     &    2.  ,2.26,2.57,2.9 ,3.27,3.53,3.65,3.8 ,3.91,3.97,4.  ,       &
     &    3.17,3.17,3.22,3.4 ,3.5 ,3.6 ,3.7 ,3.67,3.58,3.49,3.37,3.23,  &
     &    3.38,3.52,3.62,3.71,3.80,3.88,3.9 ,3.95,3.97,3.99,4.0 ,       &
     &    4.72,5.  ,5.1 ,5.02,4.97,4.84,4.64,4.45,4.24,4.05,3.89,3.70,  &
     &    3.84,3.91,3.97,3.99,4.0 ,4.  ,4.  ,4.  ,3.99,4.  ,4.  ,       &
     &    5.57,5.6 ,5.62,5.61,5.6 ,5.42,5.15,4.91,4.7 ,4.48,4.25,4.08,  &
     &    4.13,4.18,4.16,4.11,4.09,4.05,4.02,4.01,4.  ,4.  ,4.  ,       &
     &    5.73,5.77,5.79,5.79,5.77,5.75,5.6 ,5.33,5.08,4.83,4.59,4.4 ,  &
     &    4.42,4.4 ,4.32,4.23,4.17,4.08,4.05,4.03,4.01,4.  ,4.  ,       &
     &    5.83,5.88,5.91,5.93,5.93,5.91,5.88,5.68,5.4 ,5.14,4.9 ,4.7 ,  &
     &    4.68,4.59,4.46,4.33,4.23,4.13,4.1 ,4.06,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56C
!
      DATA DUMY3                                                        &
     &  /  .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .42,  &
     &     .43, .5 , .6 , .71, .9 ,1.12,1.35,1.97,2.95,3.80,4.  ,       &
     &     .8 , .8 , .8 , .8 , .8 , .8 , .8 , .81, .82, .83, .83, .88,  &
     &     .95,1.06,1.23,1.46,1.83,2.3 ,2.65,3.32,3.76,3.92,4.  ,       &
     &    1.59,1.59,1.59,1.59,1.59,1.6 ,1.62,1.65,1.68,1.72,1.78,1.82,  &
     &    2.  ,2.29,2.65,3.  ,3.27,3.5 ,3.6 ,3.78,3.90,3.98,4.  ,       &
     &    3.14,3.2 ,3.41,3.62,3.68,3.75,3.7 ,3.62,3.51,3.42,3.3 ,3.18,  &
     &    3.34,3.5 ,3.6 ,3.7 ,3.8 ,3.85,3.88,3.93,3.98,4.0 ,4.  ,       &
     &    4.7 ,4.85,5.02,4.98,4.91,4.8 ,4.6 ,4.4 ,4.2 ,4.  ,3.82,3.68,  &
     &    3.8 ,3.9 ,3.98,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    5.4 ,5.44,5.45,5.45,5.42,5.35,5.12,4.9 ,4.69,4.48,4.22,4.02,  &
     &    4.12,4.18,4.17,4.15,4.1 ,4.05,4.04,4.01,4.  ,4.  ,4.  ,       &
     &    5.61,5.63,5.64,5.62,5.61,5.6 ,5.54,5.3 ,5.02,4.8 ,4.6 ,4.39,  &
     &    4.42,4.44,4.38,4.26,4.16,4.1 ,4.07,4.03,4.01,4.  ,4.  ,       &
     &    5.72,5.75,5.76,5.78,5.77,5.76,5.72,5.69,5.4 ,5.15,4.9 ,4.68,  &
     &    4.68,4.6 ,4.49,4.33,4.22,4.15,4.10,4.06,4.02,4.01,4.  /
!
!      FIG 4.1.3.2-56D
!
      DATA DUMY4                                                        &
     &  /  .41, .41, .41, .41, .41, .41, .41, .41, .41, .41, .41, .41,  &
     &     .43, .50, .6 , .71, .89,1.11,1.35,2.00,3.00,3.72,4.00,       &
     &     .82, .82, .81, .8 , .8 , .81, .82, .83, .84, .85, .87, .89,  &
     &     .98,1.1 ,1.3 ,1.5 ,1.82,2.23,2.68,3.3 ,3.7 ,3.91,4.  ,       &
     &    1.6 ,1.59,1.58,1.58,1.58,1.59,1.60,1.62,1.66,1.73,1.81,1.92,  &
     &    2.2 ,2.45,2.7 ,2.98,3.22,3.45,3.59,3.75,3.7 ,3.91,4.  ,       &
     &    3.13,3.18,3.32,3.6 ,3.64,3.72,3.70,3.64,3.54,3.45,3.3 ,3.14,  &
     &    3.32,3.48,3.6 ,3.7 ,3.79,3.87,3.9 ,3.95,3.99,4.  ,4.  ,       &
     &    4.71,4.76,4.8 ,4.83,4.84,4.7 ,4.53,4.34,4.18,4.  ,3.82,3.63,  &
     &    3.78,3.9 ,3.98,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    5.2 ,5.22,5.22,5.2 ,5.2 ,5.15,5.1 ,4.88,4.63,4.42,4.21,4.0 ,  &
     &    4.15,4.21,4.21,4.17,4.14,4.07,4.05,4.03,4.01,4.  ,4.  ,       &
     &    5.45,5.47,5.47,5.45,5.45,5.41,5.36,5.3 ,5.02,4.81,4.58,4.36,  &
     &    4.45,4.47,4.41,4.30,4.19,4.12,4.08,4.02,4.  ,4.  ,4.  ,       &
     &    5.58,5.59,5.59,5.59,5.59,5.58,5.57,5.53,5.41,5.14,4.91,4.65,  &
     &    4.7 ,4.65,4.53,4.4 ,4.27,4.16,4.12,4.05,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56E
!
      DATA DUMY5                                                        &
     & /   .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 ,  &
     &     .44, .52, .63, .78, .98,1.21,1.4 ,2.07,3.07,3.6 ,4.  ,       &
     &     .8 , .8 , .79, .79, .79, .79, .8 , .81, .83, .85, .88, .9 ,  &
     &    1.01,1.17,1.38,1.62,2.00,2.50,2.74,3.22,3.66,3.87,4.  ,       &
     &    1.58,1.59,1.62,1.71,1.76,1.77,1.8 ,1.85,1.88,1.91,1.92,1.93,  &
     &    2.13,2.4 ,2.6 ,2.88,3.12,3.39,3.51,3.71,3.87,3.99,4.  ,       &
     &    3.15,3.21,3.38,3.61,3.7 ,3.67,3.59,3.5 ,3.4 ,3.29,3.17,3.03,  &
     &    3.18,3.37,3.51,3.67,3.78,3.85,3.88,3.93,3.98,4.  ,4.  ,       &
     &    4.42,4.42,4.41,4.40,4.39,4.38,4.35,4.25,4.08,3.9 ,3.72,3.57,  &
     &    3.70,3.86,3.93,3.99,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    4.88,4.85,4.81,4.80,4.79,4.77,4.73,4.68,4.53,4.35,4.15,3.99,  &
     &    4.08,4.20,4.23,4.19,4.1 ,4.07,4.05,4.01,4.  ,4.  ,4.  ,       &
     &    5.08,5.09,5.08,5.08,5.07,5.06,5.03,4.99,4.92,4.74,4.53,4.3 ,  &
     &    4.43,4.48,4.43,4.32,4.20,4.12,4.08,4.03,4.01,4.  ,4.  ,       &
     &    5.19,5.21,5.22,5.23,5.23,5.23,5.23,5.21,5.19,5.09,4.88,4.6 ,  &
     &    4.72,4.69,4.58,4.41,4.28,4.18,4.12,4.07,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56F
!
      DATA DUMY6                                                        &
     & /   .4 , .4 , .4 , .4 , .4 , .41, .44, .49, .51, .54, .59, .61,  &
     &     .69, .75, .81, .9 ,1.01,1.26,1.53,2.1 ,2.9 ,3.42,4.  ,       &
     &     .81, .81, .81, .83, .84, .86, .88, .91, .99,1.02,1.1 ,1.19,  &
     &    1.3 ,1.42,1.58,1.75,2.  ,2.34,2.6 ,3.  ,3.46,3.71,4.   ,      &
     &    1.6 ,1.58,1.59,1.6 ,1.6 ,1.61,1.67,1.7 ,1.79,1.86,1.92,2.  ,  &
     &    2.13,2.32,2.51,2.75,2.97,3.2 ,3.35,3.58,3.8 ,3.9 ,4.  ,       &
     &    3.13,3.1 ,3.08,3.05,3.04,3.03,3.01,2.99,2.95,2.93,2.91,2.89,  &
     &    3.02,3.2 ,3.37,3.52,3.67,3.77,3.82,3.88,3.92,3.97,4.  ,       &
     &    3.79,3.84,3.86,3.8 ,3.79,3.72,3.63,3.58,3.5 ,3.47,3.43,3.41,  &
     &    3.57,3.75,3.89,3.98,4.  ,3.98,3.94,3.93,3.92,3.99,4.  ,       &
     &    4.12,4.2 ,4.19,4.09,4.06,4.03,3.99,3.95,3.92,3.9 ,3.88,3.87,  &
     &    4.01,4.1 ,4.21,4.21,4.12,4.05,4.  ,3.96,3.99,4.  ,4.  ,       &
     &    4.39,4.45,4.44,4.39,4.35,4.31,4.27,4.25,4.25,4.25,4.25,4.25,  &
     &    4.37,4.50,4.49,4.39,4.23,4.1 ,4.03,3.99,4.  ,4.  ,4.  ,       &
     &    4.6 ,4.68,4.65,4.59,4.57,4.54,4.5 ,4.45,4.48,4.53,4.59,4.61,  &
     &    4.71,4.75,4.69,4.5 ,4.31,4.18,4.08,4.01,4.  ,4.  ,4.  /
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
      IF(TANLEO.EQ.0.0)TANLEO=.00001
      IF(TANLEI.EQ.0.0)TANLEI=.00001
      DO 1100 I=1,3
         BETA = SQRT(XM(I)**2-1.0)
         BB(I) = BETA
!
!       **STRAIGHT TAPERED SUPERSONIC NORMAL FORCE SLOPE**
!
         BOVERT=BETA/TANLE
         CA=COSLE
         IF( BOVERT.GT.1.0)GO TO 1000
         SUPLE=.FALSE.
         GO TO 1010
 1000    SUPLE=.TRUE.
 1010    CONTINUE
!
!                   FIGURE 4.1.3.2-60A (CNA/CNA)T FOR SUBSONIC L.E.
!
         DELTYT=DELTAY/CA
 1020    IF(SUPLE)GO TO 1030
         VAB(1)=BOVERT
         VAB(2)=DELTYT
         LGB(1)=9
         LGB(2)=8
         CALL INTERX(2,A1350,VAB,LGB,DA50,CNCNT,9,72,                   &
     &               2,2,0,0,0,2,0,0,Q3250A,3,ROUTID)
         GO TO 1040
!
!                   FIGURE 4.1.3.2-60B (CNA/CNA)T FOR SUPERSONIC L.E.
!
 1030    CONTINUE
         ARG=DELTAY/(5.85*CA)
         DELTDT=ATAN(ARG)*RAD
         VAB(1)=1./BOVERT
         VAB(2)=DELTDT
         LGB(1)=11
         LGB(2)=8
         CALL INTERX(2,B1350,VAB,LGB,DB50,CNCNT,11,88,                  &
     &               2,2,0,0,0,2,0,0,Q3250B,3,ROUTID)
 1040    IF(TRATIP.EQ.1.0.AND.SWEPLE.EQ.0.0) GO TO 1060
!
!                   NON-RECTANGULAR WING ANALYSIS
!                   FIGURES 4.1.3.2-56A THROUGH F
!
 1050    VAA(1)=BOVERT
         VAA(2)=AR *TANLE
         VAA(3)=TAPEXP
         LGA(1)=23
         LGA(2)=8
         LGA(3)=6
         CALL INTERX(3,T13246,VAA,LGA,D13246,BCNA,23,1104,              &
     &               0,2,0,0,0,2,0,0,Q3246A,3,ROUTID)
         IF(SUPLE)GO TO 1080
         CNTHRY=BCNA/TANLE
         GO TO 1090
 1060    CONTINUE
!
!                        RECTANGULAR WING ANALYSIS
!
         IF(AR *BETA.GT.1.0)GO TO 1070
!
!                        FIGURE 4.1.3.2-56G(CNA/A)
!
         VAB(1)=AR *BETA
         LGB(1)=9
         CALL INTERX(1,G13246,VAB,LGB,DG3246,CNAA,9,9,                  &
     &               0,0,0,0,0,0,0,0,Q3246G,3,ROUTID)
         CNTHRY=CNAA*AR
         GO TO 1090
 1070    BCNA= 4.-2.*(1./(AR *BETA))
 1080    CNTHRY=BCNA/BETA
 1090    CNA=CNTHRY*CNCNT     *SRSTAR     /(SW*RAD)
         CN(I) = CNA
 1100 END DO
      F1 = (CN(2)*BB(2)**2-CN(1)*BB(1)**2)/(BB(2)-BB(1))
      F2 = (CN(3)*BB(3)**2-CN(1)*BB(1)**2)/(BB(3)-BB(1))
      AA  = (F2-F1)/(BB(3)-BB(2))
      B  = F1-AA*(BB(2)+BB(1))
      C  = CN(2)*BB(2)**2 - AA*BB(2)**2 - B*BB(2)
      DCNA = -B*XM(2)/BB(2)**3 - 2.0*C*XM(2)/BB(2)**4
      CNA  = CN(2)
      RETURN
      END

      SUBROUTINE TRAPZ(F,N,Y,A,NTEST)
!
!***  TRAPEZOIDAL RULE INTEGRATION ROUTINE
!
!      F IS INTEGRAND - N IS NO. OF PTS. - Y IS INDEPENDENT VARIABLE
!      A IS ARRAY OF ANS AT EACH INTERVAL IF NTEST .NE. 1
!      A(1) IS INTEGRAL OVER ENTIRE INTERVAL IF NTEST = 1
!
      COMMON /CONSNT/ PI,deg,unused,rad,kand
      DIMENSION F(1),Y(1),A(1)
      A(1) = 0.
      DO 1020 I=2,N
         TEMP = .5 * (Y(I)-Y(I-1)) * (F(I) + F(I-1))
!
!   CALCULATE VOLUME IF .LT. 0
!
         IF(NTEST.LT.0)TEMP=PI/3.*(Y(I)-Y(I-1))*(F(I)**2+F(I-1)**2      &
     &                     +F(I)*F(I-1))
         IF(NTEST.LT.0)GO TO 1000
         IF(NTEST-1)1010,1000,1010
 1000    A(1) = A(1) + TEMP
         GO TO 1020
 1010    A(I) = A(I-1) + TEMP
 1020 END DO
      RETURN
      END

      SUBROUTINE TRAWBT(KDEODA,KQOQIN)
!
! ******COMPUTES TRANSONIC WING-BODY-TAIL DOWNWASH,
!       DYNAMIC PRESSURE RATIO AND LIFT CURVE SLOPE
!
      COMMON /OVERLY/ NLOG,NMACH,NZ,NALPHA
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /SYNTSS/ SYNA(19)
      COMMON /WINGD/  A(195), B(49)
      COMMON /HTDATA/ AHT(195)
      COMMON /SBETA/  STB(135),TRA(108),TRAH(108)
      COMMON /HTI/    HTIN(131)
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
      COMMON /WINGI/  WINGIN(77)
      COMMON /IDWASH/ PDWASH, DWASH(60)
      COMMON /IWING/  PWING, WING(400)
      COMMON /BDATA/  BD(762)
      COMMON /IBWH/   PBWH, BWH(380)
      COMMON /IBWHV/  PBWHV, BWHV(380)
      COMMON /IBW/    PBW, BW(380)
      COMMON /IHT/    PHT,HT(380)
      REAL K,MACH,MFB
      REAL MFB0
      DIMENSION ROUTID(2)
      DIMENSION           Q44155(2),Q44156(2),Q4157B(3)
      DIMENSION X155B1(3),X155B2(2),Y4155B(6)
      DIMENSION X156B2(9),X156B1(4),Y4156B(9,4)
      DIMENSION X156A2(13),X156A1(6),Y156A(13,6)
      DIMENSION X157B2(14),X157B1(4),Y4157B(14,4)
!
!     ----FIGURE 4.4.1-55 (A,B,C)
!
      DIMENSION X155A2(4),X155A1(4),Y4155A(16)
      DIMENSION X155C2(7),X155C1(2),Y4155C(14)
      DIMENSION Q34171(4),                                              &
     &    Q34172(4),Q3418A(3),Q34181(3),Q34182(3),Q3419B(3),Q3419C(3),  &
     &    Q3419A(3),Q15127(4),Q5129R(3),Q5129L(3),Q23124(3),Q23126(3)
      DIMENSION WTYPE(4),VAR(4),LGH(4)
      EQUIVALENCE (DEODA,DWASH(41))
      EQUIVALENCE (CDOH,TRAH(108))
      EQUIVALENCE (TRAH(72),CLABW), (TRAH(71),CLAWB)
      EQUIVALENCE (SWA4,SAC4)
      EQUIVALENCE (RL2,A(24)),(CBAR,A(16)),(CD0,WING(1)),(GAMMA,A(11))
      EQUIVALENCE (DQOQ,TRA(69)),(ZWC,TRA(2)),(ZC,TRA(11))              &
     &,(QOQINF,DWASH(1)),(CLA,TRA(73))                                  &
     &,(CLAWBT,BWHV(101)),(DJ,TRA(26))
      EQUIVALENCE (CLAM,WING(101)),(CLALS,B(48)),(HH,A(12))             &
     &,(ALIW,SYNA(4)),(ALCLM,A(127)),(ALP0,A(126))
      EQUIVALENCE (CLAWGB,BW(101))
      EQUIVALENCE (TOC,HTIN(16)),(ARSTAR,AHT(7)),(SWEPE2,AHT(71))       &
     &,(TANC2,AHT(74)),(SR,SREF),(SRSTAR,AHT(3)),(CLAMO,HTIN(69))
      EQUIVALENCE (SPAN,HTIN(4)),(SPANS,HTIN(3))
      DATA WTYPE / 4HSTRA, 4HDOUB, 4HCRAN, 4HCURV /
      DATA ROUTID/4HTRAW,4HBT  /
      DATA                              Q44155/4H4.4.,4H1-66/           &
     &, Q44156/4H4.4.,4H1-67/,Q4157B/4H4.4.,4H1-68,4HB   /
!
!     ----FIGURE 4.4.1-68B AVERAGE DOWNWASH ACTING ON AFT LIFTING
!     ----SURFACE-LOW SPEEDS
!
      DATA X157B1 /.0,.2,.6,1./
      DATA X157B2 /.2,.3,.4,.5,.6,.7,.8,.833,1.,1.1 ,1.2,1.3,1.4,1.5/
      DATA Y4157B /1.,1.03,1.068,1.11,1.176,1.26,1.36,1.34,1.20,1.11,1.0&
     &,.88,.74,.6  , .96,.96,.965,.976,.98,1.016,1.036,1.04,.946,.88,.8,&
     &.69,.58,.46  , .74,.73,.72,.71,.69,.67,.644,.638,.582,.56,.52,.48,&
     &.44,.4  ,   .5,.5,.5,.49,.476,.46,.448,.44,.4,.372,.352,.32,.3,.27&
     & /
      DATA X155A2 /.4,.55,.725,1./
      DATA X155A1/60.,45.,30.,0./
      DATA Y4155A/5.,4.,3.,1.25,2*5.,4.2,2.75,3*5.,4.,4*5./
      DATA X155C2/.41,.5,.58,.66,.75,.9,1./
      DATA X155C1/0.,1./
      DATA Y4155C /.56,.66,.725,.8,.86,.94,.99 , 3*.58,.675,.74,.9,.99/
      DATA X155B1 /0.,.5,1./
      DATA X155B2 /5.,.3/
      DATA Y4155B /1.,.3 , 1.,.425 , 1.,.525 /
      DATA X156B1/0.,30.,45.,60./
      DATA X156B2/1.,1.5,2.,2.5,3.,4.,6.,8.,10./
      DATA Y4156B /1.25,.92,.8,.72,.64,.52,.4,.33,.3  , 1.0,.88,.76,.68,&
     &.60,.49,.36,.296,.26  ,  .9,.76,.66,.572,.52,.432,.32,.252,.2  ,  &
     &  .8,.64,.52,.464,.4,.33,.24,.18,.16 /
      DATA X156A1/1.5,2.,3.,5.,7.,10./
      DATA X156A2/.2,.3,.4,.5,.6,.7,.8,.9,1.0,1.2,1.4,1.8,2.2/
      DATA Y156A/3.4,2.88,2.45,2.1,1.8,1.6,1.4,1.28,1.12,.9,.76,.58,    &
     &.45 , 3.2,2.8,2.35,1.93,1.65,1.46,1.26,1.12,1.0,.8,.64,.46,.35 ,  &
     & 2.75,2.33,1.95,1.6,1.34,1.2,1.0,.88,.75,.6,.47,.32,.26,          &
     & 2.25,1.85,1.46,1.2,.98,.8,.7,.6,.55,.4,.35,.25,.2 ,              &
     & 1.95,1.54,1.23,1.0,.8,.68,.58,.5,.42,.33,.26,.18,.18,            &
     & 1.55,1.2,.9,.74,.6,.5,.4,.35,.3,.22,.18,.1,.1 /
!
!  *** HORIZONTAL TAIL ALONE ***
!
      IF(HTIN(15).NE.WTYPE(1))RETURN
      IF(WINGIN(4).LT.1.5*HTIN(4))RETURN
!
!  ***TRANSONIC WING BODY TAIL DOWNWASH ANGLE***
!
      ARG1=ALIW-ALP0
      ARG2=ALCLM-ALP0
      ADOAD=ARG1/ARG2
      TL2OB=A(24)/WINGIN(4)
      SWA4=A(40)
      TRRT=A(118)
!
!              FIGURE 4.4.1-66
!
      CALL TLINEX(X155A1,X155A2,Y4155A,4,4,SWA4,ADOAD,TMP,              &
     &            0,1,2,0,Q44155,2,ROUTID)
      CALL TLINEX(X155B1,X155B2,Y4155B,3,2,TRRT,TMP,AEEFOA,             &
     &            0,0,0,0,Q44155,2,ROUTID)
      CALL TLINEX(X155C1,X155C2,Y4155C,2,7,TRRT,AEEFOA,BEFFOB,          &
     &            0,1,0,0,Q44155,2,ROUTID)
      AEFF=A(120)*AEEFOA
!
!              FIGURE 4.4.1-67
!
      CALL TLINEX(X156A1,X156A2,Y156A,6,13,AEFF,TL2OB,AN1,              &
     &            2,1,2,2,Q44156,2,ROUTID)
      CALL TLINEX(X156B1,X156B2,Y4156B,4,9,SAC4,AEFF,AN2,               &
     &            0,2,2,2,Q44156,2,ROUTID)
      Y=.8-(-AN1*AN2+AN1)/5.
      FANS=.8-Y+AN2
      BEFF=2.*WINGIN(4)*BEFFOB
      BEFFO2=BEFF/2.
      BDFF=WINGIN(4)-WINGIN(12)
      DIHD=BEFF*TAN(ABS(WINGIN(13)/RAD))
      IF(BEFFO2.GT.BDFF)DIHD=BDFF*TAN(WINGIN(13)/RAD)+(BEFFO2-BDFF)     &
     &                      *TAN(WINGIN(14)/RAD)
      AA=HH-DIHD/2.
      AOBVO2=ABS(2.*AA/BEFF)
      BHOBV=2.*HTIN(4)/BEFF
!
!              FIGURE 4.4.1-68B
!
      CALL TLINEX(X157B1,X157B2,Y4157B,4,14,AOBVO2,BHOBV,DEBODE,        &
     &           0,2,0,2,Q4157B,3,ROUTID)
      IF(KDEODA .EQ. 0) DEODA=DEBODE*FANS*CLAM/CLALS
!
!  ***TRANSONIC DYNAMIC PRESSURE AT THE TAIL***
!
      ARG=RL2/CBAR
      ZWC=0.68*SQRT(CD0*SREF/A(3)*(ARG+0.15))
      ZC=ARG*TAN(GAMMA)
      ARG1=2.42*SQRT(CD0*SREF/A(3))
      DQOQ=ARG1/(ARG+0.3)
      DJ=PI*ZC/(2.*ZWC)
      ARG=COS(DJ)**2
      IF(KQOQIN .EQ. 0) QOQINF=1.-DQOQ*ARG
      ARG1=(CLAWB+CLABW)*(1.-DEODA)*QOQINF
      CLAWBT=CLAWGB+ARG1
      CDOH=QOQINF*HT(1)
      IF(WINGIN(4)/HTIN(4) .LT. 1.5) GO TO 1000
!
!     CALCULATE (CM)ALPHA LINEARIZED ABOUT CL = 0
!
      BWHV(121) = -(SYNA(1)-SYNA(2)-TRA(105))/CBARR*CLAWGB              &
     &            -(SYNA(1)-SYNA(6)-AHT(161))/CBARR*ARG1
!
!     B-W-H SAME AS B-W-H-V, SET IOM TO SHOW THIS CORRESPONDENCE
!
      BWH(121) = BWHV(121)
 1000 CONTINUE
      RETURN
      END

      SUBROUTINE TRHTCM
!
!*** COMPUTES TRANSONIC H.T. AND H.T. BODY PITCHING MOMENT SLOPES
!
      DIMENSION ROUTID(2)
      DIMENSION Q225AD(3),Q222AF(3),Q14228(3)
      REAL MACH,MFB
      DIMENSION T428(14),D428(28),XM(6)
      DIMENSION VAR(4),LGH(4),VBAR(4),XMV(6),XACV(6),ZMT(8),XACP(8)
      DIMENSION D425AD(756)
      DIMENSION T425AD(30),DUMY1(63),DUMY2(63),DUMY3(63),DUMY4(63),DUMY5&
     &(63),DUMY6(63),DUMY7(63),DUMY8(63),DUMY9(63),DUMY10(63),DUMY11(63)
      DIMENSION DUMY12(63)
      DIMENSION DUMYA(72),DUMYB(72),DUMYC(72),DUMYD(72),DUMYE(72),DUMYF &
     &(72),DUMYG(72),DUMYH(72),DUMYI(72),DUMYJ(72),DUMYK(72),DUMYL(72)
      DIMENSION T422AF(18),SUBAF1(216),SUBAF2(216),SUPAF1(216)          &
     &,SUPAF2(216)
      COMMON /OVERLY/ NLOG,NMACH,NZ
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /HTI/    WINGIN(15),TOVC
      COMMON /SBETA/  STB(243),TRA(108)
      COMMON /SUPWBB/  SWB(61),SS(61)
      COMMON /WHWB/   FACT(182),WW(39),WB(39)
      COMMON /HTDATA/ A(195),B(49)
      COMMON /BDATA/  BD(762)
      COMMON /IBODY/  PBODY, BODY(400)
      COMMON /IHT/    PWING, WING(380)
      COMMON /IBH/    PBW, BW(380)
      COMMON /SYNTSS/ XCG,YY(4),XW
!
!     NOTE:  THIS ROUTINE IS THE SAME AS THE ROUTINE USED FOR WINGS.
!            THIS IS WHY THE VARIABLE XW IS IN THE PLACE OF XH IN THE
!            ABOVE COMMON SYNTSS. THIS ALLOWS XW IN THE ROUTINE TO NOT
!            HAVE TO BE CHANGED.  THIS IS DONE IN SEVERAL PLACES IN
!            THIS PROGRAM
!
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS
      EQUIVALENCE (XACBW4,SWB(8)),(XACBW6,WB(13)),(CLAWB,TRA(71)),      &
     &            (CLABW,TRA(72)),(CLAWBD,BW(101))
      EQUIVALENCE (SUBAF1(1),DUMYA(1)),(SUBAF1(73),DUMYB(1)),(SUBAF1(145&
     &),DUMYC(1)),(SUBAF2(1),DUMYD(1)),(SUBAF2(73),DUMYE(1)),(SUBAF2(145&
     &),DUMYF(1)),(SUPAF1(1),DUMYG(1)),(SUPAF1(73),DUMYH(1)),(SUPAF1(145&
     &),DUMYI(1)),(SUPAF2(1),DUMYJ(1)),(SUPAF2(73),DUMYK(1)),(SUPAF2(145&
     &),DUMYL(1))
      EQUIVALENCE (D425AD(1),DUMY1(1)),(D425AD(64),DUMY2(1)),(D425AD(127&
     &),DUMY3(1)),(D425AD(190),DUMY4(1)),(D425AD(253),DUMY5(1)),(D425AD(&
     &316),DUMY6(1)),(D425AD(379),DUMY7(1)),(D425AD(442),DUMY8(1)),(D425&
     &AD(505),DUMY9(1)),(D425AD(568),DUMY10(1)),(D425AD(631),DUMY11(1)),&
     &(D425AD(694),DUMY12(1))
      EQUIVALENCE (ARSTAR,A(7)),(TANLE,A(62)),(TAPR,A(27))              &
     &,(MACH,TRA(4)),(COSC2,A(73)),(MFB,TRA(6)),(CRSTAR,A(10))          &
     &,(DXCG,A(173)),(CLAW,WING(101)),(CMAB,BODY(121)),(CLAB,BODY(101))
      EQUIVALENCE(XMV(1),TRA(83)),(XACV(1),TRA(89)),                    &
     &(DELXAC,TRA(96)),(XACP(1),TRA(97)),(XAC,TRA(105)),(CMAW,WING(121) &
     &),(XACBW,TRA(106)),(XACWB,TRA(107)),(CMAWB,BW(121))               &
     &,(XACW,TRA(95))
      DATA ROUTID/4HTRHT,4HCM  /
      DATA Q225AD /4H4.1.,4H4.2-,4H30AD/, Q222AF /4H4.1.,4H4.2-,4H26AF/,&
     &     Q14228 /4H4.1.,4H4.2-,4H33  /
      DATA XM/0.5,0.7,0.6,1.3,1.5,1.4/
!
!           ****** FIGURE 4.1.4.2-26(A),(B),(C),(D),(E),(F) ******
!
      DATA T422AF/                                                      &
     &0.,.2,.4,.6,.8,1.,                                                &
     &1.,2.,3.,4.,5.,6.,                                                &
     &0.,.2,.25,.33,.5,1./
      DATA DUMYA/                                                       &
     &  .250,   .245,   .240,   .235,   .230,   .225,   .335,   .335,   &
     &  .335,   .335,   .335,   .335,   .420,   .430,   .435,   .445,   &
     &  .450,   .455,   .500,   .515,   .530,   .540,   .550,   .560,   &
     &  .580,   .600,   .630,   .645,   .660,   .680,   .680,   .695,   &
     &  .720,   .740,   .760,   .780,                                   &
     &  .285,   .275,   .270,   .265,   .260,   .255,   .400,   .410,   &
     &  .415,   .415,   .415,   .410,   .510,   .530,   .535,   .540,   &
     &  .545,   .550,   .640,   .650,   .660,   .675,   .685,   .690,   &
     &  .750,   .765,   .780,   .785,   .800,   .815,   .870,   .880,   &
     &  .895,   .905,   .920,   .930/
      DATA DUMYB/                                                       &
     &  .300,   .295,   .285,   .280,   .275,   .265,   .420,   .420,   &
     &  .425,   .425,   .425,   .430,   .545,   .550,   .560,   .565,   &
     &  .575,   .580,   .670,   .680,   .690,   .700,   .710,   .720,   &
     &  .795,   .805,   .815,   .830,   .840,   .850,   .925,   .945,   &
     &  .960,   .965,   .975,   .980,                                   &
     &  .325,   .320,   .315,   .305,   .300,   .290,   .460,   .460,   &
     &  .460,   .460,   .455,   .455,   .595,   .600,   .600,   .600,   &
     &  .610,   .620,   .735,   .740,   .750,   .760,   .765,   .775,   &
     &  .885,   .890,   .895,   .900,   .910,   .925,   1.045,  1.050,  &
     &  1.050,  1.060,  1.065,  1.075/
      DATA DUMYC/                                                       &
     &  .355,   .350,   .345,   .340,   .330,   .320,   .530,   .530,   &
     &  .525,   .525,   .520,   .520,   .700,   .700,   .700,   .705,   &
     &  .710,   .710,   .880,   .880,   .885,   .890,   .890,   .895,   &
     &  1.040,  1.045,  1.050,  1.055,  1.060,  1.065,  1.200,  1.205,  &
     &  1.210,  1.215,  1.225,  1.230,                                  &
     &  .510,   .490,   .480,   .470,   .460,   .450,   .750,   .750,   &
     &  .750,   .750,   .745,   .740,   1.000,  1.000,  1.000,  1.000,  &
     &  1.000,  1.000,  1.250,  1.250,  1.250,  1.250,  1.250,  1.250,  &
     &  1.500,  1.500,  1.500,  1.490,  1.490,  1.490,  1.740,  1.740,  &
     &  1.740,  1.730,  1.730,  1.730/
      DATA DUMYD/                                                       &
     &  .165,   .180,   .200,   .210,   .220,   .225,   .335,   .335,   &
     &  .335,   .335,   .335,   .335,   .500,   .480,   .465,   .460,   &
     &  .460,   .455,   .670,   .625,   .595,   .580,   .575,   .560,   &
     &  .830,   .750,   .730,   .705,   .695,   .680,   .990,   .860,   &
     &  .835,   .810,   .795,   .780,                                   &
     &  .200,   .215,   .230,   .240,   .250,   .255,   .400,   .400,   &
     &  .400,   .405,   .410,   .410,   .600,   .580,   .565,   .560,   &
     &  .555,   .550,   .795,   .760,   .735,   .715,   .700,   .690,   &
     &  .970,   .910,   .870,   .840,   .825,   .815,   1.150,  1.050,  &
     &  1.000,  .965,   .940,   .930/
      DATA DUMYE/                                                       &
     &  .230,   .240,   .245,   .250,   .260,   .265,   .415,   .420,   &
     &  .425,   .425,   .430,   .430,   .630,   .615,   .600,   .590,   &
     &  .585,   .580,   .830,   .785,   .760,   .740,   .730,   .720,   &
     &  1.030,  .950,   .905,   .880,   .865,   .850,   1.250,  1.090,  &
     &  1.050,  1.015,  .990,   .980,                                   &
     &  .220,   .240,   .250,   .265,   .280,   .290,   .440,   .445,   &
     &  .450,   .450,   .455,   .455,   .670,   .655,   .640,   .630,   &
     &  .625,   .620,   .880,   .830,   .805,   .790,   .780,   .775,   &
     &  1.070,  1.000,  .960,   .940,   .935,   .925,   1.270,  1.170,  &
     &  1.120,  1.100,  1.085,  1.075/
      DATA DUMYF/                                                       &
     &  .250,   .270,   .295,   .310,   .315,   .320,   .500,   .505,   &
     &  .510,   .515,   .520,   .520,   .750,   .740,   .730,   .720,   &
     &  .715,   .710,   .980,   .940,   .915,   .900,   .900,   .895,   &
     &  1.190,  1.120,  1.090,  1.080,  1.070,  1.065,  1.380,  1.300,  &
     &  1.270,  1.250,  1.240,  1.230,                                  &
     &  .340,   .380,   .410,   .430,   .440,   .450,   .680,   .700,   &
     &  .720,   .730,   .730,   .740,   .950,   .980,   1.000,  1.000,  &
     &  1.000,  1.000,  1.200,  1.230,  1.250,  1.250,  1.250,  1.250,  &
     &  1.440,  1.470,  1.480,  1.480,  1.490,  1.490,  1.680,  1.710,  &
     &  1.710,  1.720,  1.720,  1.730/
      DATA DUMYG/                                                       &
     &  .165,   .210,   .250,   .290,   .310,   .345,   .335,   .365,   &
     &  .390,   .415,   .445,   .470,   .500,   .540,   .560,   .560,   &
     &  .560,   .560,   .670,   .670,   .670,   .670,   .670,   .670,   &
     &  .830,   .775,   .775,   .775,   .775,   .775,   .990,   .930,   &
     &  .895,   .895,   .895,   .895,                                   &
     &  .200,   .230,   .280,   .305,   .335,   .360,   .400,   .445,   &
     &  .485,   .500,   .520,   .530,   .600,   .630,   .650,   .660,   &
     &  .665,   .665,   .795,   .800,   .800,   .805,   .810,   .815,   &
     &  .970,   .965,   .955,   .955,   .955,   .955,   1.150,  1.135,  &
     &  1.120,  1.100,  1.100,  1.105/
      DATA DUMYH/                                                       &
     &  .230,   .275,   .300,   .330,   .350,   .370,   .415,   .470,   &
     &  .500,   .530,   .545,   .550,   .630,   .670,   .680,   .685,   &
     &  .690,   .690,   .830,   .835,   .835,   .840,   .845,   .850,   &
     &  1.030,  1.015,  1.005,  1.000,  1.005,  1.010,  1.250,  1.225,  &
     &  1.200,  1.170,  1.165,  1.160,                                  &
     &  .220,   .280,   .315,   .345,   .375,   .390,   .440,   .500,   &
     &  .535,   .560,   .570,   .580,   .670,   .700,   .720,   .725,   &
     &  .740,   .740,   .880,   .885,   .895,   .900,   .900,   .900,   &
     &  1.070,  1.070,  1.075,  1.075,  1.080,  1.080,  1.270,  1.260,  &
     &  1.260,  1.255,  1.255,  1.255/
      DATA DUMYI/                                                       &
     &  .250,   .300,   .330,   .380,   .415,   .445,   .500,   .560,   &
     &  .600,   .620,   .635,   .640,   .750,   .780,   .800,   .820,   &
     &  .820,   .825,   .980,   .990,   1.000,  1.020,  1.020,  1.020,  &
     &  1.190,  1.200,  1.200,  1.210,  1.220,  1.225,  1.380,  1.390,  &
     &  1.400,  1.410,  1.420,  1.420,                                  &
     &  .340,   .380,   .410,   .460,   .500,   .540,   .680,   .700,   &
     &  .730,   .770,   .790,   .840,   .950,   .990,   1.010,  1.050,  &
     &  1.080,  1.120,  1.200,  1.240,  1.290,  1.330,  1.370,  1.420,  &
     &  1.440,  1.500,  1.550,  1.610,  1.670,  1.720,  1.680,  1.760,  &
     &  1.820,  1.890,  1.950,  2.020/
      DATA DUMYJ/                                                       &
     &  .415,   .410,   .400,   .385,   .370,   .345,   .500,   .500,   &
     &  .495,   .485,   .480,   .470,   .585,   .580,   .580,   .575,   &
     &  .570,   .560,   .670,   .670,   .670,   .670,   .670,   .670,   &
     &  .750,   .750,   .755,   .760,   .765,   .775,   .830,   .840,   &
     &  .845,   .855,   .870,   .895,                                   &
     &  .460,   .455,   .445,   .420,   .390,   .360,   .575,   .575,   &
     &  .570,   .560,   .545,   .530,   .695,   .695,   .690,   .685,   &
     &  .680,   .665,   .800,   .805,   .805,   .810,   .815,   .815,   &
     &  .920,   .930,   .935,   .945,   .970,   .955,   1.040,  1.045,  &
     &  1.050,  1.075,  1.110,  1.105/
      DATA DUMYK/                                                       &
     &  .475,   .465,   .450,   .430,   .400,   .370,   .600,   .600,   &
     &  .595,   .585,   .575,   .550,   .725,   .730,   .730,   .725,   &
     &  .715,   .690,   .850,   .850,   .855,   .865,   .870,   .850,   &
     &  .970,   .975,   .980,   1.000,  1.020,  1.010,  1.110,  1.110,  &
     &  1.110,  1.130,  1.180,  1.160,                                  &
     &  .500,   .490,   .470,   .450,   .425,   .390,   .640,   .635,   &
     &  .630,   .620,   .600,   .580,   .770,   .775,   .780,   .775,   &
     &  .765,   .740,   .920,   .915,   .920,   .930,   .935,   .900,   &
     &  1.050,  1.055,  1.060,  1.080,  1.105,  1.080,  1.195,  1.200,  &
     &  1.205,  1.225,  1.265,  1.255/
      DATA DUMYL/                                                       &
     &  .550,   .535,   .525,   .500,   .475,   .445,   .720,   .715,   &
     &  .710,   .690,   .670,   .640,   .890,   .890,   .890,   .885,   &
     &  .870,   .825,   1.060,  1.050,  1.050,  1.060,  1.065,  1.020,  &
     &  1.215,  1.215,  1.220,  1.245,  1.270,  1.225,  1.380,  1.380,  &
     &  1.395,  1.420,  1.470,  1.420,                                  &
     &  .760,   .730,   .700,   .650,   .600,   .540,   1.000,  1.000,  &
     &  .970,   .930,   .890,   .840,   1.240,  1.230,  1.230,  1.220,  &
     &  1.190,  1.120,  1.500,  1.480,  1.480,  1.490,  1.470,  1.420,  &
     &  1.750,  1.720,  1.730,  1.760,  1.780,  1.720,  2.000,  1.970,  &
     &  1.980,  2.020,  2.070,  2.020/
!
!           ****** FIGURE 4.1.4.2-30(A),(B),(C),(D) ******
!
      DATA T425AD/                                                      &
     &0.,.75,1.,1.25,2.,3.,6.,2*0.,                                     &
     &0.,1.,2.,3.,4.,5.,6.,10.,15.,                                     &
     &-2.0000001,-1.0,0.0,1.0000001,5*0.,                               &
     &0.,.2,.5/
      DATA DUMY1/                                                       &
     &  0.,     .100,   .125,   .140,   .160,   .173,   .210,   .175,   &
     &  .230,   .260,   .264,   .280,   .300,   .370,   .340,   .375,   &
     &  .390,   .392,   .400,   .412,   .450,   .496,   .504,   .509,   &
     &  .510,   .518,   .530,   .565,   .655,   .625,   .623,   .623,   &
     &  .625,   .627,   .630,   .810,   .735,   .735,   .732,   .729,   &
     &  .725,   .705,   .970,   .855,   .845,   .835,   .835,   .825,   &
     &  .805,   1.610,  1.280,  1.260,  1.245,  1.215,  1.170,  1.035,  &
     &  2.405,  1.800,  1.725,  1.705,  1.635,  1.555,  1.280/
      DATA DUMY2/                                                       &
     &  0.,     .090,   .115,   .140,   .168,   .200,   .290,   .173,   &
     &  .245,   .270,   .288,   .305,   .320,   .365,   .340,   .390,   &
     &  .405,   .425,   .435,   .445,   .490,   .500,   .525,   .530,   &
     &  .533,   .540,   .553,   .585,   .664,   .650,   .652,   .654,   &
     &  .660,   .667,   .685,   .815,   .780,   .776,   .776,   .778,   &
     &  .780,   .785,   .970,   .900,   .880,   .880,   .880,   .880,   &
     &  .880,   1.610,  1.400,  1.325,  1.270,  1.280,  1.290,  1.310,  &
     &  2.410,  1.980,  1.840,  1.720,  1.745,  1.765,  1.840/
      DATA DUMY3/                                                       &
     &  0.,     .110,   .150,   .199,   .199,   .199,   .199,   .180,   &
     &  .260,   .285,   .310,   .321,   .321,   .321,   .350,   .405,   &
     &  .427,   .440,   .445,   .445,   .445,   .500,   .533,   .543,   &
     &  .550,   .550,   .550,   .550,   .665,   .663,   .662,   .661,   &
     &  .660,   .660,   .660,   .818,   .793,   .788,   .780,   .780,   &
     &  .780,   .780,   .975,   .923,   .905,   .890,   .890,   .890,   &
     &  .890,   1.615,  1.430,  1.380,  1.320,  1.320,  1.320,  1.320,  &
     &  2.415,  2.080,  1.960,  1.845,  1.845,  1.845,  1.845/
      DATA DUMY4/                                                       &
     &  0.,     .120,   .165,   .200,   .200,   .200,   .200,   .175,   &
     &  .275,   .300,   .324,   .324,   .324,   .324,   .335,   .417,   &
     &  .445,   .445,   .445,   .445,   .445,   .500,   .548,   .548,   &
     &  .548,   .548,   .548,   .548,   .665,   .665,   .665,   .665,   &
     &  .665,   .665,   .665,   .815,   .775,   .775,   .775,   .775,   &
     &  .775,   .775,   .985,   .880,   .880,   .880,   .880,   .880,   &
     &  .880,   1.630,  1.280,  1.280,  1.280,  1.280,  1.280,  1.280,  &
     &  2.435,  1.730,  1.730,  1.730,  1.730,  1.730,  1.730/
      DATA DUMY5/                                                       &
     &  0.,     .120,   .135,   .150,   .168,   .186,   .240,   .200,   &
     &  .270,   .280,   .284,   .296,   .315,   .375,   .400,   .425,   &
     &  .426,   .430,   .440,   .450,   .483,   .600,   .575,   .575,   &
     &  .575,   .576,   .577,   .589,   .795,   .730,   .718,   .719,   &
     &  .720,   .721,   .725,   .980,   .860,   .837,   .835,   .830,   &
     &  .825,   .805,   1.175,  1.020,  .980,   .975,   .965,   .955,   &
     &  .910,   1.955,  1.590,  1.470,  1.405,  1.400,  1.390,  1.370,  &
     &  2.930,  2.360,  2.160,  1.960,  1.940,  1.910,  1.830/
      DATA DUMY6/                                                       &
     &  0.,     .085,   .120,   .145,   .186,   .215,   .295,   .205,   &
     &  .270,   .300,   .325,   .348,   .368,   .430,   .400,   .449,   &
     &  .470,   .485,   .495,   .510,   .530,   .600,   .610,   .614,   &
     &  .618,   .632,   .649,   .700,   .800,   .778,   .770,   .773,   &
     &  .780,   .794,   .830,   .978,   .935,   .915,   .916,   .919,   &
     &  .919,   .919,   1.165,  1.085,  1.060,  1.060,  1.055,  1.050,  &
     &  1.045,  1.940,  1.750,  1.695,  1.645,  1.620,  1.585,  1.480,  &
     &  2.905,  2.505,  2.485,  2.450,  2.380,  2.275,  1.965/
      DATA DUMY7/                                                       &
     &  0.,     .125,   .175,   .210,   .215,   .215,   .215,   .200,   &
     &  .290,   .320,   .355,   .360,   .360,   .360,   .400,   .465,   &
     &  .485,   .505,   .510,   .510,   .510,   .600,   .630,   .640,   &
     &  .648,   .650,   .650,   .650,   .800,   .795,   .794,   .793,   &
     &  .793,   .793,   .793,   .980,   .940,   .925,   .910,   .910,   &
     &  .910,   .910,   1.175,  1.070,  1.040,  1.040,  1.040,  1.040,  &
     &  1.040,  1.960,  1.610,  1.490,  1.490,  1.490,  1.490,  1.490,  &
     &  2.940,  2.240,  2.000,  2.000,  2.000,  2.000,  2.000/
      DATA DUMY8/                                                       &
     &  0.,     .150,   .200,   .237,   .237,   .237,   .237,   .200,   &
     &  .320,   .370,   .382,   .382,   .382,   .382,   .400,   .490,   &
     &  .523,   .523,   .523,   .523,   .523,   .600,   .640,   .650,   &
     &  .650,   .650,   .650,   .650,   .800,   .782,   .780,   .780,   &
     &  .780,   .780,   .780,   .980,   .895,   .888,   .888,   .888,   &
     &  .888,   .888,   1.175,  1.040,  1.000,  1.000,  1.000,  1.000,  &
     &  1.000,  1.960,  1.540,  1.420,  1.420,  1.420,  1.420,  1.420,  &
     &  2.940,  1.910,  1.910,  1.910,  1.910,  1.910,  1.910/
      DATA DUMY9/                                                       &
     &  0.,     .120,   .150,   .163,   .178,   .195,   .255,   .260,   &
     &  .335,   .350,   .351,   .365,   .385,   .430,   .500,   .530,   &
     &  .535,   .540,   .550,   .565,   .610,   .753,   .738,   .738,   &
     &  .738,   .735,   .735,   .725,   .975,   .912,   .908,   .904,   &
     &  .894,   .884,   .845,   1.220,  1.140,  1.110,  1.080,  1.060,  &
     &  1.040,  .960,   1.460,  1.330,  1.280,  1.240,  1.210,  1.180,  &
     &  1.090,  2.420,  2.070,  1.960,  1.840,  1.785,  1.725,  1.520,  &
     &  3.600,  3.180,  3.040,  2.900,  2.480,  2.365,  2.000/
      DATA DUMY10/                                                      &
     &  0.,     .095,   .140,   .173,   .230,   .278,   .420,   .260,   &
     &  .34,    .370,   .394,   .420,   .455,   .550,   .510,   .560,   &
     &  .585,   .593,   .610,   .634,   .705,   .750,   .775,   .780,   &
     &  .786,   .798,   .810,   .850,   .980,   .955,   .950,   .950,   &
     &  .948,   .945,   .935,   1.180,  1.105,  1.097,  1.094,  1.080,  &
     &  1.065,  1.015,  1.385,  1.270,  1.240,  1.230,  1.220,  1.205,  &
     &  1.170,  2.150,  1.860,  1.760,  1.650,  1.640,  1.620,  1.560,  &
     &  3.050,  2.500,  2.310,  2.140,  2.115,  2.085,  2.000/
      DATA DUMY11/                                                      &
     &  0.,     .150,   .200,   .260,   .275,   .275,   .275,   .260,   &
     &  .370,   .405,   .445,   .455,   .455,   .455,   .510,   .583,   &
     &  .605,   .630,   .634,   .634,   .634,   .755,   .788,   .800,   &
     &  .800,   .800,   .800,   .800,   .980,   .960,   .950,   .943,   &
     &  .943,   .943,   .943,   1.175,  1.110,  1.093,  1.064,  1.064,  &
     &  1.064,  1.064,  1.360,  1.240,  1.210,  1.163,  1.163,  1.163,  &
     &  1.163,  2.070,  1.750,  1.645,  1.540,  1.540,  1.540,  1.540,  &
     &  2.910,  2.320,  2.125,  1.940,  1.940,  1.940,  1.940/
      DATA DUMY12/                                                      &
     &  0.,     .165,   .245,   .280,   .280,   .280,   .280,   .260,   &
     &  .405,   .475,   .475,   .475,   .475,   .475,   .510,   .610,   &
     &  .650,   .650,   .650,   .650,   .650,   .755,   .800,   .820,   &
     &  .820,   .820,   .820,   .820,   .980,   .961,   .960,   .960,   &
     &  .960,   .960,   .960,   1.180,  6*1.08,                         &
     &                  1.370,  1.250,  1.250,  1.250,  1.250,  1.250,  &
     &  1.250,  2.090,  1.780,  1.780,  1.780,  1.780,  1.780,  1.780,  &
     &  2.910,  2.400,  2.400,  2.400,  2.400,  2.400,  2.400/
!
!           ****** FIGURE 4.1.4.2-33
!
      DATA T428/                                                        &
     &0.,6.6,10.,14.,3*0.,                                              &
     &0.,1.7,2.0,2.5,3.0,4.0,6.0/
      DATA D428/                                                        &
     &  0.,     0.,     0.,     0.,     0.,     0.,     0.,     0.,     &
     &  0.,   0.,   -.100,  -.220,   0.,   0.,  -.210,   -.450,         &
     &  0.,   0.,   -.305,  -.665,   0.,   0.,  -.475,   -1.040,        &
     &  0.,   0.,   -.650,  -1.410/
!
!  *** WING ALONE ***
!  *** TOVC .LE.0.07 ***
!              FIGURE 4.1.4.2-30A-D (XAC/CR)
!
      VAR(1)=ARSTAR*(TOVC)**0.3333
      VAR(2)=ARSTAR*TANLE
      VAR(4)=TAPR
      LGH(1)=7
      LGH(2)=9
      LGH(3)=4
      LGH(4)=3
      VBAR(1)=-2.
      VBAR(2)=-1.
      VBAR(3)=0.
      VBAR(4)=1.
      DO 1000 I=2,5
         XMV(I)=SQRT(1.+VBAR(I-1)*TOVC**.6666)
         VAR(3)=VBAR(I-1)
 1000 CALL TLIN4X(T425AD(10 ),T425AD(1  ),T425AD(19 ),T425AD(28 ),D425AD&
     &,LGH(2),LGH(1),LGH(3),LGH(4),VAR(2),VAR(1),VAR(3),VAR(4),XACV(I), &
     &0,0,0,0,2,1,0,1,Q225AD,3,ROUTID)
      IF(WGPL.AND.(.NOT.BO))DXCG=XCG-XW
      XMV(1)=0.60
      XMV(6)=1.40
!
!              FIGURE 4.1.4.2-26A-F
!
      LGH(1)=6
      LGH(2)=6
      LGH(3)=6
      VAR(3)=TAPR
      DO 1030 I=1,3
         ARG1=TANLE/SQRT(1.0-XM(I)**2)
         IF(ARG1.GT.1.)GO TO 1010
         VAR(1)=ARG1
         CALL INTERX(3,T422AF,VAR,LGH,SUBAF1,XACV(1),6,216,             &
     &               0,2,0,0,0,2,0,0,Q222AF,3,ROUTID)
         GO TO 1020
 1010    VAR(1)=1./ARG1
         CALL INTERX(3,T422AF,VAR,LGH,SUBAF2,XACV(1),6,216,             &
     &               0,2,0,0,0,2,0,0,Q222AF,3,ROUTID)
 1020    CONTINUE
         IF(I.EQ.1)DXAC1=XACV(1)
         IF(I.EQ.2)DXAC1=(XACV(1)-DXAC1)/0.2
 1030 END DO
!
      DO 1060 I=4,6
         ARG=SQRT(XM(I)**2-1.0)/TANLE
         IF(ARG.GT.1.)GO TO 1040
         VAR(1)=ARG
         CALL INTERX(3,T422AF,VAR,LGH,SUPAF1,XACV(6),6,216,             &
     &               0,2,0,0,0,2,0,0,Q222AF,3,ROUTID)
         GO TO 1050
 1040    VAR(1)=1./ARG
         CALL INTERX(3,T422AF,VAR,LGH,SUPAF2,XACV(6),6,216,             &
     &               0,2,0,0,0,2,0,0,Q222AF,3,ROUTID)
 1050    CONTINUE
         IF(I.EQ.4)DXAC2=XACV(6)
         IF(I.EQ.5)DXAC2=(XACV(6)-DXAC2)/0.2
 1060 END DO
      CALL TRANAC(6,XMV,XACV,DXAC1,DXAC2,0.0,MACH,XAC)
      IF(TOVC.LE.0.07)GO TO 1080
!
!  *** TOVC .GT.0.07 ***
!              FIGURE 4.1.4.2-33  DELTA XAC
!
      VAR(1)=TOVC*100.
      VAR(2)=ARSTAR*COSC2**2
      LGH(1)=4
      LGH(2)=7
      CALL INTERX(2,T428,VAR,LGH,D428,DELXAC,7,28,                      &
     &            0,-1,0,0,1,0,0,0,Q14228,3,ROUTID)
      ZMT(1)=0.60
      ZMT(2)=(MFB+.6)/2.
      ZMT(3)=MFB
      ZMT(4)=MFB+.03
      ZMT(5)=MFB+.07
      ZMT(6)=MFB+.14
      ZMT(7)=XMV(5)
      IF((ZMT(6)+0.01).GE.ZMT(7))ZMT(7)=(1.4+ZMT(6))/2.0
      ZMT(8)=1.4
      LGH(1) =6
      DO 1070 I=1,8
         CALL TRANAC(6,XMV,XACV,DXAC1,DXAC2,0.0,ZMT(I),XACP(I))
 1070 END DO
      CALL TRANAC(8,ZMT,XACP,DXAC1,DXAC2,DELXAC,MACH,XAC)
 1080 XACW=XAC*CRSTAR/CBARR
      CMAW=(DXCG/CBARR-XACW)*CLAW
      IF(.NOT.BO)RETURN
!
!  *** WING-BODY ***
!
      CALL HBTRAN(NZ)
      CALL WBCM1(A,WINGIN,BD,WB)
      ARG1= ABS(XACBW4-XACBW6)/0.80
      XACBW= XACBW6+ARG1*(MACH-0.60)
      CNOB=(-CMAB/CLAB*CBARR+DXCG)*CLAB/CBARR
      DNUM = CNOB+XACW*CLAWB+XACBW*CLABW
      DNOM= CLAB+CLAWB+CLABW
      XACWB=DNUM/DNOM
      CMAWB=(DXCG/CBARR-XACWB)*CLAWBD
      RETURN
      END

      SUBROUTINE TRIMR2
!
!***  SUBROUTINE TO TRIM THE VEHICLE WITH AN ALL MOVABLE TAIL
!
      REAL KBW,KWB,KKBW,KKWB,NTRIM
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
      COMMON /OVERLY/ NLOG,NMACH,IZ,NALPHA
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /IHT/    PHT, HT(380)
      COMMON /IVT/    PVT, VT(380)
      COMMON /POWR/   PW(293),TRM2(22)
      COMMON /IDWASH/ PDWASH, DWASH(60)
      COMMON /IBW/    PBW, BW(380)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /BDATA/  BD(762)
      COMMON /HTI/    HTIN(154)
      COMMON /HTDATA/ AHT(195),BHT(49)
      COMMON /WBHCAL/ WBT(155)
      COMMON /WHAERO/ XXX(157), DHT(55)
!
      DIMENSION ALPH(20),ALIHT(20),ALPH1(20),ALMEP(20)
      DIMENSION CLHTRM(20),CDHTRM(20),CMHTRM(20),HMTRM(20),HMUNT(20)    &
     &,CLWBT(20),CDWBT(20),CMWB(20),QOQI(20),ALPHA(20),EPSLON(20)       &
     &,CLH(20),CLBH(20),CDH(20),CC(6),ROUTID(2)
!
      EQUIVALENCE (ALIHT(1),HT(221)),(HINAX,SYNA(11)),(XCG,SYNA(1))     &
     &,(CMHTRM(1),HT(281)),(HMTRM(1),HT(301)),(HMUNT(1),HT(201))        &
     &,(CLWBT(1),VT(221)),(CDWBT(1),VT(201)),(CLHTRM(1),TRM2(1)),       &
     & (NTRIM,TRM2(21)),(TSTOP,TRM2(22)),(CDHTRM(1),HT(241))
      EQUIVALENCE (KWB,WBT(1)),(KBW,WBT(2)),(KKWB,WBT(150))             &
     &,(CMWB(1),BW(41)),(QOQI(1),DWASH(1)),(CLBH(1),WBT(130))           &
     &,(ALPHA(1),FLC(23)),(XBA,BD(63)),(ZBA,BD(64)),(AR,AHT(7))         &
     &,(E,DHT(30)),(EPSLON(1),DWASH(21)),(ALIH,SYNA(8)),(CLH(1),HT(21)) &
     &,(KKBW,WBT(151)),(SSPN,HTIN(4)),(SSPNE,HTIN(3)),(ACLMAX,BHT(43)), &
     & (CDOH,BHT(46)),(CMOH,BHT(47)),(AOH,BHT(49)),(CDOV,WBT(66))       &
     &,(CLAH,HT(101)),(CDH(1),HT(1))
!
      DATA ROUTID / 4HTRIM, 4HR2   /
!
      TSTOP=1.
      SRATIO=SREF/AHT(3)
      DO 1000 J=1,NALPHA
         ALMEP(J)=ALPHA(J)-EPSLON(J)
         ALPH(J)=ALPHA(J)-EPSLON(J)
 1000 ALPH1(J)=ALMEP(J)+ALIH
      NTRIM=NALPHA
      XBAR=XBA/CBARR
      ZBAR=ZBA/CBARR
      DO 1030 J=1,NALPHA
         JJ=J
         IF(ALMEP(J).GT.ACLMAX)GO TO 1040
         ARGL=-COS(ALMEP(J)/RAD)*XBAR+SIN(ALMEP(J)/RAD)*ZBAR
         ARGD=SIN(ALMEP(J)/RAD)*XBAR+COS(ALMEP(J)/RAD)*ZBAR
         CMWB(J)=BW(J+40)
      IF(CMWB(J).EQ.2.*UNUSED) GO TO 1050
!
!     CHECK TO SEE IF ALPHA IS IN DOWNWASH RANGE OF VALUES
!
         IF(ALPH1(J).GE.(-ACLMAX).AND.ALPH1(J).LE.ACLMAX) GO TO 1020
         ALIHT(J)=-1000.
         CLHTRM(J)=-1000.
         GO TO 1030
!
!     CALCULATE HORIZONTAL TAIL TRIM LIFT, DATCOM EQN. 4.5.3.2-E
!     TRIM LIFT IS RELATIVE TO LOCAL FLOW AT TAIL
!
 1020    CLHNUM=2.*((CMWB(J)+QOQI(J)*CMOH)/(ARGL*QOQI(J))+CDOH*ARGD     &
     &          /ARGL)
         CLHDEN=1.+SQRT((1.-4.*(ARGD/(ARGL*PI*AR*E)*SRATIO)*            &
     &          (CLHNUM/2.)))
         CLHTRM(J)=CLHNUM/CLHDEN
         CDHTRM(J)=CDOH+CLHTRM(J)**2/(PI*AR*E)*SRATIO
!
!     CALCULATE STABILIZER INCIDENCE TO TRIM AT ALPHA
!
         BRACKT=WBT(J+67)*WBT(J+45)*(SSPN-SSPNE)/SSPN
         IN=0
         CALL TBFUNX(ALPH(J),CLHP,CLAHP,NALPHA,BHT(23),CLH,CC,IN,MI,    &
     &               NG,1,1,4HCLH ,1,ROUTID)
         ALIHT(J)=(CLHTRM(J)-(KWB+KBW)*(CLHP+CLAHP*BRACKT*ALPH(J)))/    &
     &            ((KKWB+KKBW)*(CLAHP+BRACKT*CLAH))
!
!     CALCULATE TRIM LIFT AND DRAG RELATIVE TO BODY FREE STREAM FLOW
!
         EPS=EPSLON(J)/RAD
         ALP=ALPHA(J)/RAD
         DCLTRM=(CLHTRM(J)*COS(EPS)-CDHTRM(J)*SIN(EPS))*QOQI(J)
         DCDTRM=(CDHTRM(J)*COS(EPS)+CLHTRM(J)*SIN(EPS))*QOQI(J)
         CLHTRM(J)=DCLTRM
         CDHTRM(J)=DCDTRM
!
!     CALCULATE OTHER TRIM OUTPUT
!
         HT(J+260)=DCLTRM
         ARGL=COS(ALMEP(J)/RAD)*XBAR+SIN(ALMEP(J)/RAD)*ZBAR
         ARGD=COS(ALMEP(J)/RAD)*ZBAR-SIN(ALMEP(J)/RAD)*XBAR
         CMHTRM(J)=DCLTRM*ARGL+CDHTRM(J)*ARGD
!
!     TRIMMED AND UNTRIMMED HINGE MOMENTS
!
         ARG=(HINAX+XBA-XCG)/CBARR
         HMTRM(J)=(DCLTRM*COS(ALP)+DCDTRM*SIN(ALP))*ARG
         HMUNT(J)=(CLH(J)*COS(ALP)+CDH(J)*SIN(ALP))*ARG
!
!     WING-BODY-TAIL CL AND CD AT TRIM CONDITION
!
         CLWBT(J)=CLHTRM(J)+CLBH(J)+BW(J+20)
         CDWBT(J)=BW(J)+DCDTRM+CDOV
 1030 END DO
      RETURN
 1040 TSTOP=2.
      NTRIM=JJ-1
      RETURN
 1050 TSTOP=3.
      NTRIM=JJ-1
      RETURN
      END

      SUBROUTINE TRIMRT
!
!***  CALCULATES SUBSONIC TRIM WITH WING OR HORIZONTAL TAIL CONTROL
!
      COMMON /OVERLY/ NLOG,NMACH,IZ,NALPHA
      COMMON /FLAPIN/ F(69)
      COMMON /IHT/    PHT, HT(380)
      COMMON /IVT/    PVT, VT(380)
      COMMON /IDWASH/ PDWASH, DWASH(60)
      COMMON /IWING/  PWING, WING(400)
      COMMON /IBODY/  PBODY, BODY(400)
      COMMON /WINGD/  A(195),B(49)
      COMMON /HTDATA/ AHT(195),BHT(49)
      COMMON /POWR/   PW(293),TRM(22)
      COMMON /IBW/    PBW, BW(380)
      COMMON /IBWH/   PBWH, BWH(380)
      COMMON /IBWHV/  PBWHV, BWHV(380)
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      REAL NTRIM
      DIMENSION UTCL(20),UTCM(20),UTCD(20),ALPHA(20),DCM(10),DCL(10),   &
     &          DCLMAX(10),DCDMIN(10),CHD(10),CDI(200)
      DIMENSION DELTA(10)
      DIMENSION DCM2(10),DELT(10),ROUTID(2)
      DIMENSION C1(6),C2(6),C3(6),C4(6),C5(6)
      DIMENSION DELTAT(20),DCLT(20),CLMAXT(20),CDMINT(20),CHDT(20),     &
     &          CDIT(20)
      EQUIVALENCE (UTCL(1),HT(201)),(UTCM(1),HT(241)),(UTCD(1),HT(221)) &
     &         ,(ALPHA(1),TRM(1)),(DELTAT(1),VT(201)),(DCLT(1),VT(221)) &
     &       ,(CLMAXT(1),VT(241)),(CDMINT(1),VT(281)),(CHDT(1),VT(321)) &
     &       ,(CDIT(1),VT(261)),(NTRIM,TRM(21))
      EQUIVALENCE (TSTOP,TRM(22))
      EQUIVALENCE (DELTA(1),F(1))
      EQUIVALENCE (DCM(1),WING(211)),(DCL(1),WING(201))                 &
     &,(DCDMIN(1),WING(231)),(CHD(1),WING(261)),(CDI(1),BODY(201))      &
     &,(DCLMAX(1),WING(221))
      DATA ROUTID/4HTRIM,4HRT  /
!
      IN=0
      I1=0
      I2=0
      I3=0
      I4=0
!
!    -----TRIM HERE WITH CONTROL DEVICE ON WING OR TAIL
!
      NDELTA=F(16)+.5
      NDELTA = NDELTA - 1
      IF(WGPL.AND.HTPL)GO TO 1030
      IF(BO)GO TO 1010
!
!    -----HERE FOR WING ALONE TRIM
!
      DO 1000 J=1,NALPHA
         UTCL(J)=WING(J+20)
         UTCM(J)=WING(J+40)
 1000 UTCD(J)=WING(J)
      ACLMAX=B(43)
      GO TO 1050
!
!    -----HERE FOR WING-BODY TRIM
!
 1010 DO 1020 J=1,NALPHA
         UTCL(J)=BW(J+20)
         UTCM(J)=BW(J+40)
 1020 UTCD(J)=BW(J)
      ACLMAX=B(43)
      GO TO 1050
!
!    -----HERE FOR WING-BODY-TAIL TRIM
!
 1030 DO 1040 J=1,NALPHA
         UTCL(J)=BWH(J+20)
         UTCM(J)=BWH(J+40)
         UTCD(J)=BWH(J)
         IF(VTPL .OR. VFPL) UTCD(J)=BWHV(J)
 1040 END DO
      ACLMAX=BHT(43)
 1050 CONTINUE
      NTRIM=NALPHA
      IF(DCM(1).GT.DCM(NDELTA))GO TO 1070
      DO 1060 J=1,NDELTA
         DELT(J)=DELTA(J)
 1060 DCM2(J)=DCM(J)
      GO TO 1090
 1070 DO 1080 J=1,NDELTA
         N=NDELTA-J+1
         DELT(N)=DELTA(J)
 1080 DCM2(N)=DCM(J)
 1090 DO 1100 J=1,NALPHA
         ALPHA(J)=FLC(J+22)-DWASH(J+20)
 1100 END DO
      DO 1130 J=1,NALPHA
         IF(ALPHA(J).GT.ACLMAX)GO TO 1110
         ARG=-UTCM(J)
         IF(ARG.LT.DCM2(1).OR.ARG.GT.DCM2(NDELTA))GO TO 1120
         CALL TBFUNX(ARG,DELTAT(J),DYDX,NDELTA,DCM2,DELT,C1,IN,MI,NG    &
     &               ,0,0,4HDELT,1,ROUTID)
         CALL TBFUNX(DELTAT(J),DCLT(J),DYDX,NDELTA,DELTA,DCL,C2,I2,     &
     &               MI,NG,0,0,4HDCLT,1,ROUTID)
         IF(F(17).LE.5.)CALL TBFUNX(DELTAT(J),CLMAXT(J),DYDX,NDELTA,    &
     &                  DELTA,DCLMAX,C3,I3,MI,NG,0,0,4HCLMT,1,ROUTID)
         IF(F(17).LE.2.)CALL TBFUNX(DELTAT(J),CDMINT(J),DYDX,NDELTA,    &
     &                DELTA,DCDMIN,C4,I4,MI,NG,0,0,4HCDMT,1,ROUTID)
         IF(F(17).EQ.1.)CALL TBFUNX(DELTAT(J),CHDT(J),DYDX,NDELTA,DELTA,&
     &                  CHD,C5,I5,MI,NG,0,0,4HCHDT,1,ROUTID)
         IF(F(17).LE.6.)CALL TLINEX(DELTA,ALPHA,CDI,NDELTA,NALPHA       &
     &              ,DELTAT(J),ALPHA(J),CDIT(J),0,0,0,0,4HCDIT,1,ROUTID)
         GO TO 1130
 1110    NTRIM=J-1
         TSTOP=2.
         GO TO 1140
 1120    NTRIM=J-1
         TSTOP=1.
         GO TO 1140
 1130 END DO
 1140 CONTINUE
      RETURN
      END

      SUBROUTINE TRNHT(CNA, DCNA)
!
!*** COMPUTES THE LIFT CURVE SLOPE AT MACH=1.4 WHICH IS USED IN TRSONJ
!
      REAL MACH,KSHARP
      LOGICAL SUPLE
      DIMENSION DUMY1(184),DUMY2(184),DUMY3(184),DUMY5(184),            &
     &          DUMY6(184),DUMY4(184)
      DIMENSION T13246(52),D13246(1104),VAA(4),LGA(4),VAB(4),LGB(4),    &
     &          A1350(17), B1350(19),DA50(72),DB50(88),G13246(9),       &
     &          DG3246(9)
      DIMENSION WTYPE(4)
      DIMENSION ROUTID(2),Q3250A(3),Q3250B(3),Q3246A(3),Q3246G(3)
      DIMENSION XM(3), CN(3), BB(3)
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /HTDATA/ A(195)
      COMMON /HTI/    WINGIN(154)
      COMMON /OPTION/ SW
!
      EQUIVALENCE (SRSTAR,A(3))
      EQUIVALENCE (TAPEXP,A(27)),(TANLE,A(62)),(SWEPLE,A(58))
      EQUIVALENCE (AR,A(7)),(TRATIP,A(25)),(COSLE,A(61))
      EQUIVALENCE (DELTAY,WINGIN(17))
      EQUIVALENCE (TANLEO,A(86)),(TANLEI,A(62)),(KSHARP,WINGIN(71))
      EQUIVALENCE (D13246(1),DUMY1(1)),(D13246(185),DUMY2(1))
      EQUIVALENCE (D13246(369),DUMY3(1)),(D13246(553),DUMY4(1))
      EQUIVALENCE (D13246(737),DUMY5(1))
      EQUIVALENCE (D13246(921),DUMY6(1))
!
      DATA Q3250A /4H4.1.,4H3.2-,4H60A /, Q3246A /4H4.1.,4H3.2-,4H56A /,&
     &     Q3250B /4H4.1.,4H3.2-,4H60B /, Q3246G /4H4.1.,4H3.2-,4H56G /,&
     &     ROUTID/4HTRAN,4HWG  /
      DATA XM / 1.3, 1.4, 1.5 /
!
!              FIGURE 4.1.3.2-60A (CNA/CNA)T FOR SUBSONIC L.E.
!
      DATA A1350/                                                       &
     & 0.,     .3,     .4,     .5,     .6,     .7,     .8,     .9,      &
     & 1.0001 ,                                                         &
     & 0.,     .41,    .82,    1.24,   2.12,   3.18,   6.95,   16.1 /
      DATA DA50/                                                        &
     & 1.,     1.,     1.,     1.,     1.,     1.,     1.,     1.,      &
     &         1.,                                                      &
     & 1.05,   1.05,   1.05,   1.05,   .985,   .945,   .915,   .9,      &
     & .9,                                                              &
     & 1.04,   1.04,   1.04,   1.04,   .965,   .908,   .87,    .85,     &
     & .84,                                                             &
     & 1.12,   1.12,   1.12,   1.015,  .94,    .88,    .838,   .81,     &
     & .796,                                                            &
     & 1.11,   1.11,   1.11,   1.,     .903,   .84,    .795,   .765,    &
     & .75,                                                             &
     & 1.08,   1.08,   1.08,   .954,   .865,   .8,     .75,    .72,     &
     & .7,                                                              &
     & 1.2,    1.2,    1.043,  .907,   .817,   .75,    .707,   .675,    &
     & .66,                                                             &
     & 1.14,   1.14,   .975,    .857,  .772,   .717,   .675,   .65,     &
     & .632 /
!
!              FIGURE 4.1.3.2-60B (CNA/CNA)T FOR SUPERSONIC L.E.
!
      DATA B1350/                                                       &
     & 0.,     .1,     .2,      .3,    .4,     .5,     .6,     .7,      &
     & .8,     .9,     1.0001 ,                                         &
     & 0.,     4.,     8.,      12.,   20.,    30.,    50.,    70./
      DATA DB50/                                                        &
     & 1.,     1.,     1.,      1.,    1.,     1.,     1.,     1.,      &
     & 1.,     1.,     1.,                                              &
     & 1.15,   1.15,   1.15,    1.15,  1.095,  1.04,   .99,    .96,     &
     & .935,   .915,   .9,                                              &
     & 1.12,   1.12,   1.12,    1.12,  1.05,   .985,   .94,    .905,    &
     & .88,    .857,   .84,                                             &
     & 1.15,   1.15,   1.15,    1.08,  1.005,  .945,   .902,   .87,     &
     & .842,   .82,    .796,                                            &
     & 1.22,   1.14,   1.05,    .98,   .93,    .89,    .853,   .823,    &
     & .795,   .77,    .75,                                             &
     & 1.13,   1.05,   .98,    .925,   .88,    .845,   .81,    .782,    &
     & .752,   .73,    .7,                                              &
     & 1.02,   .942,   .895,   .855,   .82,    .79,    .76,    .735,    &
     & .71,    .685,   .66,                                             &
     & 1.,     .92,    .87,    .825,   .79,    .755,   .728,   .7,      &
     & .678,   .655,   .632 /
!
!              FIGURE 4.1.3.2-56G (CNA/A) FOR A*BETA LESS THAN 1.0
!
      DATA G13246/0.,.2,.4,.45,.5,.6,.8,.9,1.0/
      DATA DG3246/1.61,1.58,1.55,1.57,1.62,1.75,1.94,2.0,2.0/
!
!              FIGURE 4.1.3.2-56A-F (WING SUPERSONIC CNA)
!
      DATA T13246                                                       &
     &  / 0.,.1,.2,.3,.33,.4,.5,.6,.7,.8,.9,1.0,1.111,1.25,1.429,1.667, &
     &    2.0,2.5,2.941,4.167,7.143,14.286, 30. ,                       &
     &    .25,.5,1.,2.,3.,4.,5.,6. , 15*0.,                             &
     &    0.,.2,.25,.3333,.5,1.0/
!
!     FIG 4.1.3.2-56A
!
      DATA DUMY1                                                        &
     &  /  .39, .39, .39, .39, .39, .39, .39, .39, .39, .39, .39, .41,  &
     &     .44, .5 , .58, .65, .80,1.0 ,1.15,1.55,2.40,3.92,4.0 ,       &
     &     .77, .77, .78, .78, .79, .79, .80, .80, .80, .81, .82, .84,  &
     &     .92,1.0 ,1.18,1.32,1.60,1.9 ,2.18,2.80,3.84,3.92,4.0 ,       &
     &    1.55,1.56,1.57,1.57,1.59,1.59,1.60,1.63,1.66,1.68,1.70,1.75,  &
     &    1.88,2.09,2.30,2.6 ,2.94,3.35,3.70,3.80,3.98,3.98,4.0 ,       &
     &    3.15,3.15,3.15,3.15,3.15,3.15,3.17,3.19,3.23,3.27,3.33,3.4 ,  &
     &    3.46,3.54,3.60,3.7 ,3.75,3.8 ,3.86,3.91,4.0 ,4.0 ,4.0 ,       &
     &    4.71,4.74,4.83,5.09,5.25,5.05,4.80,4.55,4.30,4.09,3.90,3.72,  &
     &    3.78,3.8 ,3.83,3.88,3.90,3.94,3.92,3.96,4.0 ,4.0 ,4.0 ,       &
     &    6.29,6.2 ,5.99,5.72,5.61,5.42,5.18,4.9 ,4.64,4.42,4.2 ,4.0 ,  &
     &    4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,       &
     &    6.3 ,6.34,6.39,6.08,5.97,5.78,5.5 ,5.2 ,4.95,4.7 ,4.48,4.25,  &
     &    4.2 ,4.18,4.14,4.11,4.07,4.05,4.04,4.02,4.  ,4.  ,4.  ,       &
     &    6.32,6.4 ,6.4 ,6.34,6.32,6.13,5.82,5.51,5.25,4.99,4.73,4.5 ,  &
     &    4.4 ,4.32,4.27,4.2 ,4.13,4.11,4.07,4.04,4.  ,4.  ,4.  /
!
!     FIG 4.1.3.2-56B
!
      DATA DUMY2                                                        &
     &  /  .41, .41, .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .41,  &
     &     .41, .48, .56, .67, .84,1.08,1.29,1.83,2.80,3.8 ,4.0 ,       &
     &     .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .83, .85,  &
     &     .98,1.09,1.27,1.48,1.80,2.25,2.53,3.22,3.79,3.92,4.  ,       &
     &    1.57,1.59,1.6 ,1.6 ,1.6 ,1.61,1.63,1.65,1.69,1.73,1.77,1.8 ,  &
     &    2.  ,2.26,2.57,2.9 ,3.27,3.53,3.65,3.8 ,3.91,3.97,4.  ,       &
     &    3.17,3.17,3.22,3.4 ,3.5 ,3.6 ,3.7 ,3.67,3.58,3.49,3.37,3.23,  &
     &    3.38,3.52,3.62,3.71,3.80,3.88,3.9 ,3.95,3.97,3.99,4.0 ,       &
     &    4.72,5.  ,5.1 ,5.02,4.97,4.84,4.64,4.45,4.24,4.05,3.89,3.70,  &
     &    3.84,3.91,3.97,3.99,4.0 ,4.  ,4.  ,4.  ,3.99,4.  ,4.  ,       &
     &    5.57,5.6 ,5.62,5.61,5.6 ,5.42,5.15,4.91,4.7 ,4.48,4.25,4.08,  &
     &    4.13,4.18,4.16,4.11,4.09,4.05,4.02,4.01,4.  ,4.  ,4.  ,       &
     &    5.73,5.77,5.79,5.79,5.77,5.75,5.6 ,5.33,5.08,4.83,4.59,4.4 ,  &
     &    4.42,4.4 ,4.32,4.23,4.17,4.08,4.05,4.03,4.01,4.  ,4.  ,       &
     &    5.83,5.88,5.91,5.93,5.93,5.91,5.88,5.68,5.4 ,5.14,4.9 ,4.7 ,  &
     &    4.68,4.59,4.46,4.33,4.23,4.13,4.1 ,4.06,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56C
!
      DATA DUMY3                                                        &
     &  /  .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .42,  &
     &     .43, .5 , .6 , .71, .9 ,1.12,1.35,1.97,2.95,3.80,4.  ,       &
     &     .8 , .8 , .8 , .8 , .8 , .8 , .8 , .81, .82, .83, .83, .88,  &
     &     .95,1.06,1.23,1.46,1.83,2.3 ,2.65,3.32,3.76,3.92,4.  ,       &
     &    1.59,1.59,1.59,1.59,1.59,1.6 ,1.62,1.65,1.68,1.72,1.78,1.82,  &
     &    2.  ,2.29,2.65,3.  ,3.27,3.5 ,3.6 ,3.78,3.90,3.98,4.  ,       &
     &    3.14,3.2 ,3.41,3.62,3.68,3.75,3.7 ,3.62,3.51,3.42,3.3 ,3.18,  &
     &    3.34,3.5 ,3.6 ,3.7 ,3.8 ,3.85,3.88,3.93,3.98,4.0 ,4.  ,       &
     &    4.7 ,4.85,5.02,4.98,4.91,4.8 ,4.6 ,4.4 ,4.2 ,4.  ,3.82,3.68,  &
     &    3.8 ,3.9 ,3.98,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    5.4 ,5.44,5.45,5.45,5.42,5.35,5.12,4.9 ,4.69,4.48,4.22,4.02,  &
     &    4.12,4.18,4.17,4.15,4.1 ,4.05,4.04,4.01,4.  ,4.  ,4.  ,       &
     &    5.61,5.63,5.64,5.62,5.61,5.6 ,5.54,5.3 ,5.02,4.8 ,4.6 ,4.39,  &
     &    4.42,4.44,4.38,4.26,4.16,4.1 ,4.07,4.03,4.01,4.  ,4.  ,       &
     &    5.72,5.75,5.76,5.78,5.77,5.76,5.72,5.69,5.4 ,5.15,4.9 ,4.68,  &
     &    4.68,4.6 ,4.49,4.33,4.22,4.15,4.10,4.06,4.02,4.01,4.  /
!
!      FIG 4.1.3.2-56D
!
      DATA DUMY4                                                        &
     &  /  .41, .41, .41, .41, .41, .41, .41, .41, .41, .41, .41, .41,  &
     &     .43, .50, .6 , .71, .89,1.11,1.35,2.00,3.00,3.72,4.00,       &
     &     .82, .82, .81, .8 , .8 , .81, .82, .83, .84, .85, .87, .89,  &
     &     .98,1.1 ,1.3 ,1.5 ,1.82,2.23,2.68,3.3 ,3.7 ,3.91,4.  ,       &
     &    1.6 ,1.59,1.58,1.58,1.58,1.59,1.60,1.62,1.66,1.73,1.81,1.92,  &
     &    2.2 ,2.45,2.7 ,2.98,3.22,3.45,3.59,3.75,3.7 ,3.91,4.  ,       &
     &    3.13,3.18,3.32,3.6 ,3.64,3.72,3.70,3.64,3.54,3.45,3.3 ,3.14,  &
     &    3.32,3.48,3.6 ,3.7 ,3.79,3.87,3.9 ,3.95,3.99,4.  ,4.  ,       &
     &    4.71,4.76,4.8 ,4.83,4.84,4.7 ,4.53,4.34,4.18,4.  ,3.82,3.63,  &
     &    3.78,3.9 ,3.98,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    5.2 ,5.22,5.22,5.2 ,5.2 ,5.15,5.1 ,4.88,4.63,4.42,4.21,4.0 ,  &
     &    4.15,4.21,4.21,4.17,4.14,4.07,4.05,4.03,4.01,4.  ,4.  ,       &
     &    5.45,5.47,5.47,5.45,5.45,5.41,5.36,5.3 ,5.02,4.81,4.58,4.36,  &
     &    4.45,4.47,4.41,4.30,4.19,4.12,4.08,4.02,4.  ,4.  ,4.  ,       &
     &    5.58,5.59,5.59,5.59,5.59,5.58,5.57,5.53,5.41,5.14,4.91,4.65,  &
     &    4.7 ,4.65,4.53,4.4 ,4.27,4.16,4.12,4.05,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56E
!
      DATA DUMY5                                                        &
     & /   .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 ,  &
     &     .44, .52, .63, .78, .98,1.21,1.4 ,2.07,3.07,3.6 ,4.  ,       &
     &     .8 , .8 , .79, .79, .79, .79, .8 , .81, .83, .85, .88, .9 ,  &
     &    1.01,1.17,1.38,1.62,2.00,2.50,2.74,3.22,3.66,3.87,4.  ,       &
     &    1.58,1.59,1.62,1.71,1.76,1.77,1.8 ,1.85,1.88,1.91,1.92,1.93,  &
     &    2.13,2.4 ,2.6 ,2.88,3.12,3.39,3.51,3.71,3.87,3.99,4.  ,       &
     &    3.15,3.21,3.38,3.61,3.7 ,3.67,3.59,3.5 ,3.4 ,3.29,3.17,3.03,  &
     &    3.18,3.37,3.51,3.67,3.78,3.85,3.88,3.93,3.98,4.  ,4.  ,       &
     &    4.42,4.42,4.41,4.40,4.39,4.38,4.35,4.25,4.08,3.9 ,3.72,3.57,  &
     &    3.70,3.86,3.93,3.99,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    4.88,4.85,4.81,4.80,4.79,4.77,4.73,4.68,4.53,4.35,4.15,3.99,  &
     &    4.08,4.20,4.23,4.19,4.1 ,4.07,4.05,4.01,4.  ,4.  ,4.  ,       &
     &    5.08,5.09,5.08,5.08,5.07,5.06,5.03,4.99,4.92,4.74,4.53,4.3 ,  &
     &    4.43,4.48,4.43,4.32,4.20,4.12,4.08,4.03,4.01,4.  ,4.  ,       &
     &    5.19,5.21,5.22,5.23,5.23,5.23,5.23,5.21,5.19,5.09,4.88,4.6 ,  &
     &    4.72,4.69,4.58,4.41,4.28,4.18,4.12,4.07,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56F
!
      DATA DUMY6                                                        &
     & /   .4 , .4 , .4 , .4 , .4 , .41, .44, .49, .51, .54, .59, .61,  &
     &     .69, .75, .81, .9 ,1.01,1.26,1.53,2.1 ,2.9 ,3.42,4.  ,       &
     &     .81, .81, .81, .83, .84, .86, .88, .91, .99,1.02,1.1 ,1.19,  &
     &    1.3 ,1.42,1.58,1.75,2.  ,2.34,2.6 ,3.  ,3.46,3.71,4.   ,      &
     &    1.6 ,1.58,1.59,1.6 ,1.6 ,1.61,1.67,1.7 ,1.79,1.86,1.92,2.  ,  &
     &    2.13,2.32,2.51,2.75,2.97,3.2 ,3.35,3.58,3.8 ,3.9 ,4.  ,       &
     &    3.13,3.1 ,3.08,3.05,3.04,3.03,3.01,2.99,2.95,2.93,2.91,2.89,  &
     &    3.02,3.2 ,3.37,3.52,3.67,3.77,3.82,3.88,3.92,3.97,4.  ,       &
     &    3.79,3.84,3.86,3.8 ,3.79,3.72,3.63,3.58,3.5 ,3.47,3.43,3.41,  &
     &    3.57,3.75,3.89,3.98,4.  ,3.98,3.94,3.93,3.92,3.99,4.  ,       &
     &    4.12,4.2 ,4.19,4.09,4.06,4.03,3.99,3.95,3.92,3.9 ,3.88,3.87,  &
     &    4.01,4.1 ,4.21,4.21,4.12,4.05,4.  ,3.96,3.99,4.  ,4.  ,       &
     &    4.39,4.45,4.44,4.39,4.35,4.31,4.27,4.25,4.25,4.25,4.25,4.25,  &
     &    4.37,4.50,4.49,4.39,4.23,4.1 ,4.03,3.99,4.  ,4.  ,4.  ,       &
     &    4.6 ,4.68,4.65,4.59,4.57,4.54,4.5 ,4.45,4.48,4.53,4.59,4.61,  &
     &    4.71,4.75,4.69,4.5 ,4.31,4.18,4.08,4.01,4.  ,4.  ,4.  /
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
      IF(TANLEO.EQ.0.0)TANLEO=.00001
      IF(TANLEI.EQ.0.0)TANLEI=.00001
      DO 1100 I=1,3
         BETA = SQRT(XM(I)**2-1.0)
         BB(I) = BETA
!
!       **STRAIGHT TAPERED SUPERSONIC NORMAL FORCE SLOPE**
!
         BOVERT=BETA/TANLE
         CA=COSLE
         IF( BOVERT.GT.1.0)GO TO 1000
         SUPLE=.FALSE.
         GO TO 1010
 1000    SUPLE=.TRUE.
 1010    CONTINUE
!
!                   FIGURE 4.1.3.2-60A (CNA/CNA)T FOR SUBSONIC L.E.
!
         DELTYT=DELTAY/CA
 1020    IF(SUPLE)GO TO 1030
         VAB(1)=BOVERT
         VAB(2)=DELTYT
         LGB(1)=9
         LGB(2)=8
         CALL INTERX(2,A1350,VAB,LGB,DA50,CNCNT,9,72,                   &
     &               2,2,0,0,0,2,0,0,Q3250A,3,ROUTID)
         GO TO 1040
!
!                   FIGURE 4.1.3.2-60B (CNA/CNA)T FOR SUPERSONIC L.E.
!
 1030    CONTINUE
         ARG=DELTAY/(5.85*CA)
         DELTDT=ATAN(ARG)*RAD
         VAB(1)=1./BOVERT
         VAB(2)=DELTDT
         LGB(1)=11
         LGB(2)=8
         CALL INTERX(2,B1350,VAB,LGB,DB50,CNCNT,11,88,                  &
     &               2,2,0,0,0,2,0,0,Q3250B,3,ROUTID)
 1040    IF(TRATIP.EQ.1.0.AND.SWEPLE.EQ.0.0) GO TO 1060
!
!                   NON-RECTANGULAR WING ANALYSIS
!                   FIGURES 4.1.3.2-56A THROUGH F
!
 1050    VAA(1)=BOVERT
         VAA(2)=AR *TANLE
         VAA(3)=TAPEXP
         LGA(1)=23
         LGA(2)=8
         LGA(3)=6
         CALL INTERX(3,T13246,VAA,LGA,D13246,BCNA,23,1104,              &
     &               0,2,0,0,0,2,0,0,Q3246A,3,ROUTID)
         IF(SUPLE)GO TO 1080
         CNTHRY=BCNA/TANLE
         GO TO 1090
 1060    CONTINUE
!
!                        RECTANGULAR WING ANALYSIS
!
      IF(AR *BETA.GT.1.0)GO TO 1070
!
!                        FIGURE 4.1.3.2-56G(CNA/A)
!
         VAB(1)=AR *BETA
         LGB(1)=9
         CALL INTERX(1,G13246,VAB,LGB,DG3246,CNAA,9,9,                  &
     &               0,0,0,0,0,0,0,0,Q3246G,3,ROUTID)
         CNTHRY=CNAA*AR
         GO TO 1090
 1070    BCNA= 4.-2.*(1./(AR *BETA))
 1080    CNTHRY=BCNA/BETA
 1090    CNA=CNTHRY * CNCNT * SRSTAR /(SW*RAD)
         CN(I) = CNA
 1100 END DO
      F1 = (CN(2)*BB(2)**2-CN(1)*BB(1)**2)/(BB(2)-BB(1))
      F2 = (CN(3)*BB(3)**2-CN(1)*BB(1)**2)/(BB(3)-BB(1))
      AA  = (F2-F1)/(BB(3)-BB(2))
      B  = F1-AA*(BB(2)+BB(1))
      C  = CN(2)*BB(2)**2 - AA*BB(2)**2 - B*BB(2)
      DCNA = -B*XM(2)/BB(2)**3 - 2.0*C*XM(2)/BB(2)**4
      CNA  = CN(2)
      RETURN
      END

      SUBROUTINE TRNYRL
!
!  BEFORE CALLING TRNYRL, SET M=0.6 AND CALL LATFLP,GDELTA, AND LIFTFP.
!
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
      COMMON /FLAPIN/ F(69)
      COMMON /HTI/    HTIN(131)
      COMMON /IBODY/  PBODY, BODY(400)
      COMMON /IWING/  PWING, WING(400)
      COMMON /IHT/    PHT, HT(380)
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ AHT(195)
      COMMON /IDWASH/ PDWASH, DWASH(60)
      COMMON /SBETA/  STB(135),TRA(108),TRAH(108)
      COMMON /SUPDW/  DWA(35),TCD(58)
      COMMON /CONSNT/ PI,DR,UNUSED,RADS,kand
      COMMON /POWR/   PW(59),FLA(45),FLP(189),TRN(7)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS,                      &
     &                SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,                         &
     &        SUPERS,SUBSON,TRANSN,HYPERS,                              &
     &        SYMFP,ASYFP,TRIMC,TRIM
      LOGICAL TRANSL
      REAL MACH,KHB,KBH
      DIMENSION ROUTID(2)
      DIMENSION Q21222(3)
      DIMENSION Q212A1(4),Q212A2(4)
      DIMENSION DELCL6(10),DELCL(10)
      DIMENSION CFACT(10),CLALDL(10)
      DIMENSION CLAFS(10),C21222(6)
      DIMENSION DELTAL(10),DELTAR(10)
      DIMENSION BD(4)
      DIMENSION CNYM6(200),CNAFS(200)
      DIMENSION CLRLM6(10)
      DIMENSION CLROLT(10)
      DIMENSION X12A1(11),Y12A1(11),C12A1(6)
      DIMENSION X12A2(11),Y12A2(11),C12A2(6)
      DIMENSION X12222(6),Y21222(6)
      EQUIVALENCE (CNAFS(1),BODY(201)),(CLALDL(1),WING(241)),           &
     &            (CLAFS(1),HT(211))
      EQUIVALENCE (CLROLT(1),CLAFS(1)),(DELCL,WING(201)),               &
     &            (ENCEPE,TRN(1)),(YH,TRN(2))
      EQUIVALENCE (ETAQRS,TRN(3)),(CLDELC,TRN(4)),                      &
     &            (CLDALC,TRN(5))
      EQUIVALENCE (DELCL6(1),WING(201))
      EQUIVALENCE (CFACT(1),FLP(71))
      EQUIVALENCE (CLRLM6(1),HT(211))
      EQUIVALENCE (CNYM6(1),BODY(201))
      EQUIVALENCE (ASTRW,A(7)),(DEPSDA,DWASH(41)),(CLAH,HT(101))
      EQUIVALENCE (BD(1),TCD(43))
      EQUIVALENCE (SSPN,HTIN(4)),(SSPNE,HTIN(3))
      EQUIVALENCE (DELTAL(1),F(19)),(DELTAR(1),F(29))
      EQUIVALENCE (CNAH,CLAH)
      EQUIVALENCE (TRANSL,FLP(59))
      EQUIVALENCE (KBH,TRN(6)),(KHB,TRN(7))
      DATA IN1222/0/
!
!*********          FIGURE 4.3.1.2-12-A1
!
      DATA X12A1 /0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y12A1 /1.0,0.97,0.95,4*0.94,0.95,0.96,0.98,0.99/
      DATA I12A1 /0/
      DATA Q212A1/4H4.3.,4H1.2-,4H12-A,4H1   /
!
!*********          FIGURE 4.3.1.2-12-A2
!
      DATA X12A2 /0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y12A2 /0.0,0.11,0.21,0.31,0.41,0.51,0.60,0.70,0.80,0.90,1.0/
      DATA I12A2 /0/
      DATA Q212A2/4H4.3.,4H1.2-,4H12-A,4H2   /
      DATA ROUTID/4HTRNY,4HRL  /
!
!     FIGURE 6.2.1.2-22
!
      DATA X12222 /.165,.2,.25,.3,.35,.40/
      DATA Y21222 /.830,.818,.779,.738,.680,.615/
      DATA Q21222 /4H6.2.,4H1.2-,4H22  /
!
      TRANSL=.TRUE.
      IF(F(17).EQ.1 .OR. F(17).EQ.5 .OR. F(17).EQ.6) TRANSL=.FALSE.
      MACH=FLC(IM+2)
      NDELTA=F(16)+.5
      NCROL=NDELTA*NALPHA
      STYPE=F(18)
      CLAW=WING(101)
      CLAM6=TRA(70)
      SAVE=CLAW/CLAM6
      IF(ASYFP)GO TO 1030
      IF(HTPL)CLAW=CNAH
      IF(HTPL)SAVE=CLAW/TRAH(70)
!
!     TRANSONIC LIFT COEFFICIENT INCREMENT
!
      DO 1000 I=1,NDELTA
         DELCL(I)=DELCL6(I)*SAVE
 1000 END DO
!
!     WING LIFT CURVE SLOPE WITH TRANSLATING LEADING EDGE AND
!     TRAILING EDGE FLAPS AND SLATS
!
      IF(.NOT.TRANSL)GO TO 1020
      DO 1010 I=1,NDELTA
         CLALDL(I)=CLAW*(1.+CFACT(I))+CLAW
 1010 END DO
      RETURN
 1020 CONTINUE
      DO 1025 I=1,NDELTA
         CLALDL(I)=UNUSED
 1025 END DO
      RETURN
 1030 CONTINUE
      IF(STYPE.EQ.5.)GO TO 1060
!
!     TRANSONIC ROLLING MOMENT DUE TO DEFLECTION OF PLAIN FLAPS AND
!    SPOILERS ON WING
!
      DO 1040 I=1,NDELTA
         CLAFS(I)=CLRLM6(I)*SAVE
 1040 END DO
      IF(STYPE.NE.4.)RETURN
!
!     TRANSONIC YAWING MOMENT DUE TO DEFLECTION OF
!
!     PLAIN TRAILING EDGE FLAPS
      DO 1050 J=1,NCROL
         IF(CNYM6(J) .EQ. UNUSED) GO TO 1050
         CNAFS(J)=CNYM6(J)*SAVE
 1050 END DO
      RETURN
 1060 CONTINUE
!
!     TRANSONIC ROLLING MOMENT DUE TO DEFLECTION OF
!     ALL MOVING HORIZONTAL TAIL
!
      RAD=SSPN-SSPNE
      ENCEPE=(.352*BD(1)+.503*BD(2)+.344*BD(3)+.041*BD(4))/(.383*BD(1)+ &
     &       .707*BD(2)+.924*BD(3)+.5*BD(4))
      IF(MACH.GE.1.)GO TO 1080
      YH=ENCEPE*SSPNE+RAD
      DHBH=RAD/SSPN
      CALL TBFUNX(DHBH,ETAQRS,DYDX,4,X12222,Y21222 ,C21222,IN1222,MI1222&
     &           ,NG,1,2,Q21222,3,ROUTID)
      CLDELC=(.5*(1.-(PI*ASTRW/RADS)*DEPSDA)*ETAQRS*YH*CLAH)/BLREF
      DO 1070 I=1,NDELTA
         CLROLT(I)=CLDELC*(DELTAL(I)-DELTAR(I))
 1070 END DO
      GO TO 1120
 1080 YH=.4*SSPNE+RAD
      RATIO=(SSPN-SSPNE)/(2.*SSPN)
 1090 CALL TBFUNX(RATIO,KHB  ,DYDX,11,X12A1,Y12A1,C12A1,I12A1,MI,NG,    &
     &            0,0,Q212A1,4,ROUTID)
 1100 CALL TBFUNX(RATIO,KBH  ,DYDX,11,X12A2,Y12A2,C12A2,I12A2,MI,NG,    &
     &            0,0,Q212A2,4,ROUTID)
      CLDALC=.35*(KHB+KBH)*CNAH*YH/BLREF
      DO 1110 K=1,NDELTA
         CLROLT(K)=CLDALC*(DELTAL(K)-DELTAR(K))
 1110 END DO
 1120 CONTINUE
      RETURN
      END

      SUBROUTINE TRSONI(NZ)
!
!*** COMPUTES TRANSONIC WING LIFT SLOPE,CLMAX,ALPHA CLMAX,AND CD0
!***      BODY LIFT AND MOMENT SLOPES,DRAG AT ANGLE OF ATTACK
!  *** TRANSONIC LATERAL STABILITY CALCULATED IN SUBLAT ***
!
      DIMENSION ROUTID(2)
      DIMENSION Q3243A(3),Q3243B(3),Q3244B(3),Q3244A(3),Q3244C(3),Q34171&
     &  (4),Q34172(4),Q3418A(3),Q34181(3),Q34182(3),Q3419B(3),Q3419C(3),&
     &  Q3419A(3),Q15127(4),Q5129R(3),Q5129L(3),Q23124(3),Q23126(3)
      REAL K,MACH,MFB,MT(5)
      REAL MFB0
      DIMENSION T429L(15),D429L(56),T429R(14),D429R(35),T424(16),       &
     &          D424(39)
      DIMENSION WTYPE(4),C17(6) ,TR(11),DR(11)
      DIMENSION T426(16),D426(55)
      DIMENSION X(11),Y(11),C(6)
      DIMENSION T418A(10),D418A(10), T18B1(3),D18B1(20),C18B1(60),      &
     &          T18B2(10), D18B2(10) ,C18B2(100)
      DIMENSION T419A(22),D419A(77) ,T419B(13),D419B(13),T419C(26),     &
     &          D419C(130)
      DIMENSION T43A(15),D43A(56),T43B(13),D43B(40),T44A(13),D44A(42),  &
     &          T44B(13),D44B(42),T44C(6),D44C(6)
      DIMENSION XMTD(15),CDW1(15),CDW2(15),VAR(4),LGH(4)
      DIMENSION CLAMT(5),ALPHA(20) ,CDJB(20)
      DIMENSION X27M(4),X27I(4),C27(6)
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA,IG,NF
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /BDATA/  BD(762)
      COMMON /WINGD/  A(195),B(49)
      COMMON /WINGI/  WINGIN(77)
      COMMON /SUPBOD/ SBD(227)
      COMMON /SBETA/  STB(135),TRA(108)
      COMMON /IBODY/  PB, BODY(400)
      COMMON /IWING/  PW, WING(400)
      COMMON /IBW/    PBW, BW(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB
      EQUIVALENCE (TOC,WINGIN(16)),(ARSTAR,A(7)),(SWEPE2,A(71)),        &
     &            (COSLE,A(61)),(TAPR,A(27)),(CBAR,A(16)),(RNFS,A(129)),&
     &          (XOC,WINGIN(18)),(SRSTAR,A(3)),(COSC4,A(67)),(SS,BD(93))&
     &,           (DB,SBD(6)),(DMAX,SBD(120)),(XLB,SBD(2)),(SB,BD(57)), &
     &            (TANC2,A(74))
      EQUIVALENCE (CLA14,TRA(1)),(CLAMO,WINGIN(69)),(K,TRA(3))          &
     &  ,(MFB0,TRA(5)),(MFB,TRA(6)),(AOC,TRA(7)),(CFBCT,TRA(8)),(BETAFB,&
     &  TRA(9)),(CLAFBT,TRA(10)),(MACH,TRA(4)),(CLAFB,TRA(12)),(CLAA,TRA&
     &  (13)),(BOC,TRA(14)),(CLAB,TRA(15)),(MT(1),TRA(16)),(CLAMT(1),TRA&
     &(21)),(CLA,WING(101)),(C1,TRA(27)),(ARATIO,TRA(28)),(BU4,TRA(29)),&
     &   (CLMAX6,TRA(30)),(ACLBAS,TRA(31)),(DACMA6,TRA(32)),(C3,TRA(33))
      EQUIVALENCE (CLAB14,SBD(18)),(CMAB14,SBD(110)),(CD014,SBD(124)),  &
     &     (CMAB6,BODY(121)),(CFB6,BD(92)),(CD0B6,BD(61)),(CDBB6,BD(60))
      EQUIVALENCE (DALCM,TRA(34)),(DCLMAX,TRA(35)),(ALCLM6,TRA(36)),    &
     &        (ALCLMT,TRA(37)),(CLMAXT,TRA(38)),(RLCOFF,TRA(39)),       &
     &        (RNN,TRA(40)),(RL,TRA(41)),(CF,TRA(42)),(CDW2(1),TRA(43)),&
     &        (CDW,TRA(67)),(CDF,TRA(68)),(CD0W,WING(1)),(CLAW6,TRA(70))&
     &        ,(CLABM6,BODY(101)),(CLABD,BODY(101)),(CMAB,BODY(121)),   &
     &        (CDPB,TRA(80)),(CDBFIG,TRA(81)),(CDBB,TRA(76)),           &
     &        (CDWB,TRA(77)),(CD0B,TRA(78)),(CDJB(1),BODY(1)),          &
     &        (CD0WB,BW(1)),(CDFB,TRA(79)),(DCLA14,TRA(82))
      EQUIVALENCE (TANLE,A(62))
      LOGICAL LOWAR
      DATA ROUTID /4HTRSO,4HNI  /
      DATA Q3243A /4H4.1.,4H3.2-,4H53A /,Q3243B/4H4.1.,4H3.2-,4H53B /,  &
     &Q3244B/4H4.1.,4H3.2-,4H54B /,Q3244A/4H4.1.,4H3.2-,4H54A /,Q3244C/ &
     &4H4.1.,4H3.2-,4H54C /,QCLA/4HCLA /,Q34171/4H4.1.,4H3.4-,4H24B , 4H&
     &C1  /,Q34172/4H4.1.,4H3.4-,4H24B ,4HC2  /,Q3418A/4H4.1.,4H3.4-, 4H&
     &25A /,Q34181/4H4.1.,4H3.4-,4H25B1/,Q34182/4H4.1.,4H3.4-,4H25B2/,  &
     &Q3419B/4H4.1.,4H3.4-,4H26B /,Q3419C/4H4.1.,4H3.4-,4H26C /,Q3419A  &
     &/4H4.1.,4H3.4-,4H26A /,Q15127/4H4.1.,4H5.1-,4H27  ,4HCEPT/,Q5129R &
     &/4H4.1.,4H5.1-,4H29R /,Q5129L/4H4.1.,4H5.1-,4H29L /,QCDW/4HCDW /, &
     &Q23124/4H4.2.,4H3.1-,4H24  /,Q23126/4H4.2.,4H3.1-,4H26  /
!
!              FIGURE 4.1.5.1-27
!
      DATA X27I  /1.57780,1.67221,1.98509,2.28874/
      DATA X27M  /0.0,1.0,2.0,3.0/
      DATA I27   /0/
      DATA WTYPE /4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA I17,IN/0,0/
      DATA NP/11/
!
!              FIGURE 4.1.3.4-24B
!
      DATA TR/0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
      DATA DR/0.,.21,.5,.9,1.08,1.05,1.,.94,.9,.86,.85/
      DATA Y/0.,.225,.47,.496,.43,.32,.21,.125,.075,.0475,.0/
      DATA X/0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
!
!     ----4.1.3.4-25(A)
!
      DATA T418A /0.,.4,.8,1.2,1.6,2.0,2.4,2.8,3.2,3.6/
      DATA D418A/3*35.,32.,28.,25.,23.2,22.,21.5,21./
!
!     ----4.1.3.4-25(B)
!
      DATA T18B1/.2,.4,.6/
      DATA D18B1/4.5,5.,5.5,6.,6.5,7.,7.5,8.,8.5,9.,9.5,10.,10.5,11.,   &
     &           11.5,12.,12.5,13.,13.5,14./
      DATA C18B1/0.,.5,.9,1.4,1.9,2.5,3.3,4.,4.6,5.6,6.4,7.3,8.2,9.2,10.&
     &,11.,12.,13.,14.,15. , 0.,.2,.4,.7,1.2,1.7,2.4,3.,3.7,4.6,5.2,6., &
     &6.9,7.8,8.6,9.5,10.4,11.4,12.3,13.5 , 0.,0.,.1,.2,.5,.7,1.,1.3,1.6&
     &,2.,2.5,3.,3.6,4.3,4.9,5.5,6.2,7.,7.6,8.5/
      DATA T18B2/0.,2.,3.,4.,5.,6.,7.,8.,9.,30./
      DATA C18B2 /                                    10.,8.5,6.9,5.5,4.&
     &,2.6,1.5,.7,.1,0. , 8.7,7.3,5.3,4.2,2.6,1.4,0.5,-.2,-.5,0. , 7.5, &
     &5.9,4.2,2.5,1.2,0.,-.7,-1.1,-.8,0. , 5.5,3.4,1.6,0.,-1.3,-2.1,-2.5&
     &,-2.,-.8,0. , 3.,.7,-1.4,-3.3,-4.3,-4.3,-3.1,-2.,-.8,0. , .3,-2.5,&
     &-4.7,-5.8,-5.3,-4.3,-3.1,-2.,-.8,0. ,-2.2,-5.,-6.7,-6.3,-5.3,-4.3,&
     &-3.1,-2.,-0.8,0. , -3.3,-6.6,-7.2,-6.3,-5.3,-4.3,-3.1,-2.,-.8,0., &
     &  -4.2,-7.,-7.2,-6.3,-5.3,-4.3,-3.1,-2.,-.8,0. , -8.5,-7.9,-7.2,  &
     & -6.3,-5.3,-4.3,-3.1,-2.,-.8,0. /
      DATA D18B2  /.0,.5,1.,1.5,2.,2.5,3.,3.5,4.,4.5/
!
!              FIGURE 4.1.3.4-26B
!
      DATA T419B                                                        &
     & / 0., 4., 5., 6., 7., 8., 9., 10., 11., 12., 13., 14., 16. /
      DATA D419B                                                        &
     & / 1., 1., .93, .8, .55, .4, .3, .24, .2, .16, .14, .12, .12 /
!
!              FIGURE 4.1.3.2-53A
!
      DATA T43A/                                                        &
     & 0.,     2.,     4.,     6.,     8.,     10.,    12.,    14. ,    &
     & 0., 1., 2., 3., 4., 6., 8./
      DATA D43A                                                         &
     &/8*1.0,                                                           &
     & 6*1.0,.98,.9,                                                    &
     & 5*1.0,.983,.89,.855,                                             &
     & 4*1.0,.939,.888,.857,.835,                                       &
     & 2*1.0,.958,.904,.869,.842,.82,.802,                              &
     & 1.0,    .952,   .908,   .872,   .842,   .816,   .80,    .787,    &
     & 1.0,    .952,   .908,   .872,   .842,   .816,   .80,    .787 /
!
!              FIGURE 4.1.3.2-53B
!
      DATA T43B                                                         &
     &  / 0.0, 0.17453, 0.34907 , 0.52360, 0.69813,                     &
     &         1.04720, 1.22173 , 1.57080    ,                          &
     & .799,.85,.9,.95,1.000/
      DATA D43B/                                                        &
     & .8,     .807,   .82,    .841,   .867,   .918,   .945,   1.0,     &
     & .85,    .855,   .865,   .88,    .9,     .938,   .958,   1.0,     &
     & .90,    .903,   .91,    .92,    .932,   .958,   .974,   1.0,     &
     & .95,    .952,   .955,   .96,    .967,   .98,    .987,   1.0,     &
     &    1.0,  1.0,  1.0,  1.0,  1.0,  1.0,1.0,  1.0  /
!
!              FIGURE 4.1.3.2-54A
!
      DATA T44A/                                                        &
     & 0.,     2.,     4.,     6.,     8.,     12.,    14. ,            &
     & 1.,     2.,     3.,     4.,     6.,     8. /
      DATA D44A/                                                        &
     & 1.09,   1.088,  1.056,  1.008,  .962,   .872,   .828,            &
     & .98,    1.088,  1.1,    1.05,   .992,   .882,   .83,             &
     & .85,    1.,     1.075,  1.06,   1.005,  .89,    .835,            &
     & .74,    .9,     1.015,  1.07,   1.025,  .895,   .837,            &
     &4*1.15,1.07,.915,.915,                                            &
     &5*1.12,.94,.94/
!
!              FIGURE 4.1.3.2-54B
!
      DATA T44B/                                                        &
     & 0.,     4.,     6.,     8.,     10.,    12.,    14. ,            &
     & 1.,     2.,     3.,     4.,     6.,     8. /
      DATA D44B/                                                        &
     & -.14,   -.14,   -.14,   -.14,   -.14,   0.,     .44,             &
     & -.07,   -.07,   -.07,   -.07,   0.,     .31,    .64,             &
     & .05,    .05,    .05,    .06,    .23,    .49,    .75,             &
     & .06,    .06,    .06,    .15,    .35,    .58,    .79,             &
     & .08,    .08,    .14,    .29,    .48,    .66,    .84,             &
     & .09,    .15,    .24,    .39,    .555,   .72,    .89 /
!
!              FIGURE 4.1.3.2-54C
!
      DATA T44C                                                         &
     &/0.,     2.,     4.,     6.,     8.,     16. /
      DATA D44C                                                         &
     &  / -.04, .01, .075, .13, .15, .15 /
!
!              FIGURE 4.1.3.4-26A
!
      DATA T419A                                                        &
     & /          0.8, 1.0, 1.2, 1.6, 2.0, 2.4, 3.0, 4*0.,              &
     &   .6, .7, .8, .9, .95, 1.0, 1.05, 1.1, 1.15, 1.2, 1.4 /
      DATA D419A                                                        &
     & /              0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0 ,         &
     &               -.050,-.050,-.050,-.030,-.015,-.010, 0.0 ,         &
     &               -.115,-.100,-.083,-.047,-.018, 0.0 , .025,         &
     &               -.145,-.110,-.080,-.020, .022, .050, .097,         &
     &               -.120,-.080,-.030, .050, .100, .140, .204,         &
     &               -.060, 0.0 , .060, .150, .210, .250, .325,         &
     &                .090, .130, .180, .257, .310, .330, .360,         &
     &                .113, .165, .210, .280, .320, .345, .360,         &
     &                .108, .160, .205, .284, .320, .344, .360,         &
     &                .096, .145, .190, .273, .320, .343, .355,         &
     &                .020, .050, .100, .200, .300, .330, .340/
!
!              FIGURE 4.1.3.4-26C
!
      DATA T419C                                                        &
     & / 0.0, 0.4, 0.8, 1.0, 1.2, 1.6, 2.0, 2.4, 3.0, 5.0  ,3*0.,       &
     &   .6,.7,.75,.8,.85,.9,.95,1.0,1.05,1.1,1.15,1.2,1.4  /
      DATA D419C                                                        &
     & /   0.0, 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0,  0.0 , 0.0 ,   &
     &   -1.00,-1.00,-1.00,-1.00,-1.00,-1.00,-1.00,-1.00,-1.00,-1.00,   &
     &   -1.25,-1.22,-1.20,-1.20,-1.20,-1.10,-1.10,-1.00,-1.00,-0.85,   &
     &   -2.05,-1.75,-1.50,-1.40,-1.30,-1.20,-1.10,-1.00,-1.00,-0.95,   &
     &   -2.20,-1.90,-1.60,-1.50,-1.40,-1.20,-1.10,-1.00,-0.90,-0.63,   &
     &   -1.85,-1.60,-1.40,-1.30,-1.20,-1.00,-0.80,-0.70,-0.60,-0.40,   &
     &   -1.80,-1.38,-1.00,-0.90,-0.70,-0.50,-0.30,-0.10, 0.0 , 0.10,   &
     &   -0.60,-0.20, 0.20, 0.30, 0.50, 0.80, 1.00, 1.20, 1.40, 2.00,   &
     &    1.90, 2.40, 3.00, 3.20, 3.50, 3.90, 4.30, 4.60, 5.00, 6.20,   &
     &    2.40, 4.05, 5.50, 6.20, 7.00, 8.00, 8.90, 10.0, 10.9, 13.9,   &
     &    1.60, 4.04, 6.90, 8.00, 9.10, 10.6, 11.9, 13.0, 14.3, 18.2,   &
     &   -1.20, 3.90, 7.60, 8.90, 10.2, 12.1, 13.5, 14.7, 15.9, 18.8,   &
     &   -11.0,-0.60, 8.10, 10.5, 12.0, 14.4, 16.2, 17.5, 18.8, 21.3 /
!
!              FIGURE 4.1.5.1-29 LEFT SIDE (SUBSONIC)
!
      DATA T429L/                                                       &
     &0.0,0.4,0.6,0.8,1.0,1.2,1.4,1.475,                                &
     &0.,.5,1.0,1.5,2.0,3.0,4.0/
      DATA D429L/                                                       &
     &8*0.0,                                                            &
     &0.90,0.71,0.55,0.39,0.21,0.10,0.00,0.0,                           &
     &2.34,2.03,1.70,1.05,0.51,0.21,0.01,0.0,                           &
     &3.01,2.92,2.68,1.99,1.00,0.32,0.01,0.0,                           &
     &3.30,3.27,3.12,2.50,1.26,0.42,0.03,0.0,                           &
     &3.49,3.43,3.38,2.80,1.52,0.51,0.06,0.0,                           &
     &3.61,3.58,3.52,3.14,1.83,0.52,0.09,0.0/
!
!              FIGURE 4.1.5.1-29 RIGHT SIDE (SUPERSONIC)
!
      DATA T429R/                                                       &
     &0.0,.4,.8,1.2,1.4,0.0,0.0,                                        &
     &0.,.5,1.0,1.5,2.0,3.0,4.0/
      DATA D429R/                                                       &
     &5*0.0,                                                            &
     &0.90,1.08,1.18,1.28,1.31,                                         &
     &2.34,2.53,2.68,2.75,2.78,                                         &
     &3.01,3.08,3.10,3.12,3.12,                                         &
     &3.30,3.32,3.32,3.30,3.28,                                         &
     &3.49,3.49,3.48,3.42,3.39,                                         &
     &3.61,3.61,3.60,3.56,3.51/
!
!              FIGURE 4.2.3.1-24
!
      DATA T424/                                                        &
     &.75,.85,.90,.95,1.0,1.015,1.030,1.050,1.075,1.125,1.15,1.2,1.3,   &
     &.011,.067,.122/
      DATA D424/                                                        &
     &.011,.014,.018,.031,.069,.040,.020,6*0.0,                         &
     &.067,.071,.078,.092,.140,.150,.120,.086, .067, .050,.047,.045,.05,&
     &.122,.130,.139,.155,.204,.220,.236,.210, .168, .110, .101,.100,.1/
      DATA T426/                                                        &
     &6.0,7.0,8.0,10.,12.,14.,16.,18.,20.,24.,26.,                      &
     &1.0,1.025,1.05,1.1,1.2/
      DATA D426/                                                        &
     &.118,.084,.065,.041,.029,.020,.016,.012,.010,.007,.006,           &
     &.147,.110,.088,.061,.043,.033,.026,.022,.019,.015,.013,           &
     &.166,.120,.097,.068,.050,.039,.031,.026,.022,.015,.013,           &
     &.186,.138,.110,.076,.057,.044,.034,.028,.022,.015,.013,           &
     &.200,.152,.120,.080,.059,.046,.036,.028,.022,.015,.013/
!
!  *** WING ALONE ***
!      WING LIFT CURVE SLOPE
!
      MACH=FLC(NZ+2)
      IF(WINGIN(15).NE.WTYPE(1))GO TO 1100
      CALL TRANWG(CLA14, DCLA14)
      K=CLAMO*RAD/(2.0*PI)
      BETA6=0.80
!
!              FIGURE 4.1.3.2-53A FORCE BREAK MACH NUMBER=MFB ( 0 SWEEP)
!
      VAR(1)=TOC*100.
      VAR(2)=ARSTAR
      LGH(1)=8
      LGH(2)=7
      CALL INTERX(2,T43A,VAR,LGH,D43A,MFB0,8,56,                        &
     &            2,2,0,0,2,-1,0,0,Q3243A,3,ROUTID)
!
!              FIGURE 4.1.3.2-53B MFB0 CORRECTED FOR SWEEP
!
      VAR(1)=SWEPE2
      VAR(2)=MFB0
      LGH(1)=8
      LGH(2)=5
      CALL INTERX(2,T43B,VAR,LGH,D43B,MFB,8,40,                         &
     &            0,2,0,0,2,0,0,0,Q3243B,3,ROUTID)
      IF(NF .LT. 0) RETURN
!
!              FIGURE 4.1.3.2-54B (A/C)
!
      VAR(1)=TOC*100.
      VAR(2)=ARSTAR
      LGH(1)=7
      LGH(2)=6
      CALL INTERX(2,T44B,VAR,LGH,D44B,AOC,7,42,                         &
     &            0,2,0,0,1,2,0,0,Q3244B,3,ROUTID)
!
!              FIGURE 4.1.3.2-54A CORRECTION TO LIFT CURVE SLOPE
!
      CALL INTERX(2,T44A,VAR,LGH,D44A,CFBCT,7,42,                       &
     &            2,1,0,0,2,2,0,0,Q3244A,3,ROUTID)
!
      BETAFB = SQRT(1.0-MFB**2)
      IF(MFB .GT. 0.98) BETAFB = 0.0
      BB   = BETAFB
      ARG1 = 2.0*PI*ARSTAR/RAD
      ARG2=(ARSTAR/K)**2
      ARG3=BB**2+TANC2**2
      ARG4 = 2.0+SQRT(ARG2*ARG3+4.0)
      CLAFBT = ARG1/ARG4
!
      BB   = 0.8
      ARG2 = (BB*ARSTAR/K)**2
      ARG3 = 0.0
      IF(ARG2 .GT. 0.0) ARG3 = 1.0+(TANC2/BB)**2
      ARG4 = 2.0+SQRT(ARG2*ARG3+4.0)
      CLAW6 = ARG1*SRSTAR/(ARG4*SR)
!
      XM = 0.75
      IF(XM .GT. (MFB-0.1)) XM = MFB-0.1
      IF(XM .GT. MACH) XM=MACH
      BB   = SQRT(1.0-XM**2)
      ARG2=(ARSTAR/K)**2
      ARG3=BB**2+TANC2**2
      ARG4 = 2.0+SQRT(ARG2*ARG3+4.0)
      CLAW7 = ARG1*SRSTAR/(ARG4*SR)
      DCLA7 = XM*ARG1*ARG2*SRSTAR/SR
      DCLA7 = DCLA7/(ARG4**2*SQRT(ARG2*ARG3+4.0))
      CLAFB=CLAFBT*CFBCT *SRSTAR/SR
      CLAA=(1.-AOC)*CLAFB
!
!              FIGURE 4.1.3.2-54C (B/C)
!
      VAR(1)=TOC*100.
      LGH(1)=6
      CALL INTERX(1,T44C,VAR,LGH,D44C,BOC,6,6,                          &
     &            2,0,0,0,1,0,0,0,Q3244C,3,ROUTID)
      CLAB=(1.-BOC)*CLAFB
      MT(1)=XM
      MT(2)=MFB
      MT(3)=MFB+.07
      MT(4)=MFB+.14
      MT(5)=1.40
      CLAMT(1)=CLAW7
      CLAMT(2)=CLAFB
      CLAMT(3)=CLAA
      CLAMT(4)=CLAB
      CLAMT(5)=CLA14
      CALL TRANF(5, MT, CLAMT, DCLA7, DCLA14, MACH, CLA)
!
!  *** CLASSIFICATION OF ASPECT RATIO ***
!
      CALL TBFUNX(A(27), C1   ,DYDX,NP,X,Y,C,IN,MI,NG,                  &
     &            0,0,Q34171,4,ROUTID)
      ARG1=(C1+1.)*COSLE
      ARATIO=A(128)/ARG1
!
!              FIGURE 4.1.3.4-24B (C1) AND (C2)
!
      VAR(1)=TAPR
      LGH(1)=11
      CALL INTERX(1,TR,VAR,LGH,DR,C2,11,11,                             &
     &            0,0,0,0,0,0,0,0,Q34172,4,ROUTID)
      LOWAR=.FALSE.
      IF(ARSTAR.LT.ARATIO)LOWAR=.TRUE.
!
!  *** IF LOW ASPECT RATIO CALCULATE CLMAX AND (ALPHA)CLMAX ***
!
      IF(.NOT.LOWAR)GO TO 1070
      BU4=(C1+1.)*ARSTAR*COSLE/BETA6
      ARG=(C2+1.)*ARSTAR*TANLE
      A(160)=ARG
      CALL CLMXB1(BU4,CLMAX6,A,WINGIN)
!
!  *** CALCULATE (ALPHA)CLMAX AT MACH=0.60 ***
!              FIGURE 4.1.3.4-25A
!
      CALL TBFUNX(BU4,ACLBAS,DYDX,10,T418A,D418A,C17,I17,MI,NG,         &
     &            0,0,Q3418A,3,ROUTID)
      IF(ARG.LE.4.5)GO TO 1050
!
!              FIGURE 4.1.3.4-25B
!
      CALL TLINEX(T18B1,D18B1,C18B1,3,20,MT(1),ARG,DACMA6,              &
     &            0,0,2,1,Q34181,3,ROUTID)
      GO TO 1060
 1050 ARG1=ARSTAR*COSLE*(1.+4.*TAPR**2)
      CALL TLINEX(T18B2,D18B2,C18B2,10,10,ARG1,ARG,DACMA6,              &
     &            0,2,2,0,Q34182,3,ROUTID)
 1060 ALCLM6=ACLBAS+DACMA6
!
!  *** ADJUST PARAMETERS TO TRANSONIC MACH NUMBER ***
!              FIGURE 4.1.3.4-26B
!
      VAR(1)=ARG
      LGH(1)=13
      CALL INTERX(1,T419B,VAR,LGH,D419B,C3,13,13,                       &
     &            0,0,0,0,0,0,0,0,Q3419B,3,ROUTID)
!
!              FIGURE 4.1.3.4-26C  DELTA (ALPHA)CLMAX
!
      VAR(1)=BU4*BETA6
      VAR(2)=MACH
      LGH(1)=10
      LGH(2)=13
      CALL INTERX(2,T419C,VAR,LGH,D419C,DALCM ,13,130,                  &
     &            2,0,0,0,2,2,0,0,Q3419C,3,ROUTID)
!
!              FIGURE 4.1.3.4-26A DELTA CLMAX
!
      VAR(1)=C3*VAR(1)
      LGH(1)=7
      LGH(2)=11
      CALL INTERX(2,T419A,VAR,LGH,D419A,DCLMAX,11,77,                   &
     &            2,0,0,0,2,2,0,0,Q3419A,3,ROUTID)
      ALCLMT=ALCLM6+DALCM
      CLMAXT=CLMAX6+DCLMAX*(SRSTAR/SR)
 1070 CONTINUE
!
!  *** ZERO ANGLE OF ATTACK DRAG,CD0 ***
!              FIGURE 4.1.5.1-27 (EQUATION FOR RLCOFF)
!
      ARG=12.*CBAR/RUFF
      CALL TBFUNX(0.6,CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,              &
     &            0,0,Q15127,4,ROUTID)
      RLCOFF=ARG**1.0482*10.0**CEPT
      RNN=CBAR*RNFS
      IF(RLCOFF.LT.RNN)RNN=RLCOFF
      CALL FIG26(RNN,0.60,CF)
      RL=1.2
      IF(XOC.LT.0.30)RL=2.0
      CDF=CF*(1.+RL*TOC)*2.*SRSTAR/SR
      ARG=SQRT(COSC4)
      XMTD(1)=0.60/ARG
      XMTD(2)=0.65/ARG
      XMTD(3)=0.70/ARG
      XMTD(4)=0.75/ARG
      XMTD(5)=0.80/ARG
      XMTD(6)=0.85/ARG
      XMTD(7)=0.90/ARG
      XMTD(8)=0.925/ARG
      XMTD(9)=0.950/ARG
      XMTD(10)=0.975/ARG
      XMTD(11)=1.000/ARG
      XMTD(12)=1.050/ARG
      XMTD(13)=1.100/ARG
      XMTD(14)=1.200/ARG
      XMTD(15)=1.400/ARG
      ARG2=TOC**.3333
      VAR(2)=ARSTAR*ARG2
      ARG3=COSC4**2.5
      DO 1090 I=1,15
         ARG4=ABS((XMTD(I)*ARG)**2-1.)
         VAR(1)=SQRT(ARG4)/ARG2
!
!              FIGURE 4.1.5.1-29
!
         IF(XMTD(I)*ARG.LE.1.)GO TO 1080
         LGH(1)=5
         LGH(2)=7
         CALL INTERX(2,T429R,VAR,LGH,D429R,CDW1(I),7,35,                &
     &              0,0,0,0,0,2,0,0,Q5129R,3,ROUTID)
         GO TO 1090
 1080    LGH(1)=8
         LGH(2)=7
         CALL INTERX(2,T429L,VAR,LGH,D429L,CDW1(I),8,56,                &
     &               0,0,0,0,-1,2,0,0,Q5129L,3,ROUTID)
         CDW2(I)=CDW1(I)*TOC**1.666*ARG3*SRSTAR/SR
 1090 END DO
      CALL TRANF(15, XMTD, CDW2, 0.0, 0.0, MACH, CDW)
      CD0W=CDW+CDF
!
!  *** BODY ALONE ***
!
 1100 IF(.NOT.BO)RETURN
!
!  ***BODY LIFT AND MOMENT SLOPES ***
!
      ARG1=(MACH-.60)/.80
      CLABD=CLABM6+(CLAB14-CLABM6)*ARG1
      CMAB=CMAB6+(CMAB14-CMAB6)*ARG1
!
!  *** BODY DRAG ***
!
      CDFB=CFB6*SS/SR
      CDPB=CD0B6-CDBB6-CDFB
      IF(MACH.GE.1.0.AND.MACH.LE.1.2)CDPB=CDPB*(1.-(MACH-1.0)/.2)
      IF(MACH.GT.1.2)CDPB=0.0
      IF(DB.LT.0.3*DMAX)DB=0.3*DMAX
      ARG=(DB/DMAX)**2
!
!              FIGURE 4.2.3.1-24 (CDBT)
!
      VAR(1)=MACH
      VAR(2)=CDBB6/ARG*4.0*SR/(PI*DMAX**2)
      LGH(1)=13
      LGH(2)=3
      CALL INTERX(2,T424,VAR,LGH,D424,CDBFIG,13,39,                     &
     &            0,2,0,0,0,2,0,0,Q23124,3,ROUTID)
      CDBB=CDBFIG*ARG*PI*DMAX**2/(4.0*SR)
      IF(MACH.LT.1.0)GO TO 1110
      VAR(1)=XLB/DMAX
      VAR(2)=MACH
      LGH(1)= 11
      LGH(2)=5
      CALL INTERX(2,T426,VAR,LGH,D426,CDWB,11,55,                       &
     &            0,0,0,0,2,2,0,0,Q23126,3,ROUTID)
      CDWB=CDWB*PI*DMAX**2/(4.*SR)
      GO TO 1120
 1110 CDWB=0.0
 1120 CD0B=CDFB+CDPB+CDBB+CDWB
      IF(MACH.GT.1.2)GO TO 1130
      GO TO 1140
 1130 CD0B=CD0B+(CD014-CD0B)*(MACH-1.2)/0.2
!
!  *** BODY DRAG AT ANGLE OF ATTACK ***
!
 1140 DO 1150 J=1,NALPHA
         CDJB(J)=CD0B+(FLC(J+22)/RAD)**2*SB/SR
 1150 END DO
      CD0WB=CD0B+CD0W
      TRA(73)=CD0WB
      RETURN
      END

      SUBROUTINE TRSONJ(NZ)
!
!*** COMPUTES TRANSONIC H.T. LIFT SLOPE,CLMAX,ALPHA CLMAX,AND CD0
!***      BODY LIFT AND MOMENT SLOPES,DRAG AT ANGLE OF ATTACK
!
      DIMENSION ROUTID(2)
      DIMENSION Q3243A(3),Q3243B(3),Q3244B(3),Q3244A(3),Q3244C(3),Q34171&
     &  (4),Q34172(4),Q3418A(3),Q34181(3),Q34182(3),Q3419B(3),Q3419C(3),&
     &  Q3419A(3),Q15127(4),Q5129R(3),Q5129L(3),Q23124(3),Q23126(3)
      REAL K,MACH,MFB,MT(5)
      REAL MFB0
      DIMENSION T429L(15),D429L(56),T429R(14),D429R(35),T424(16),       &
     &          D424(39)
      DIMENSION WTYPE(4),C17(6) ,TR(11),DR(11)
      DIMENSION T426(16),D426(55)
      DIMENSION X(11),Y(11),C(6)
      DIMENSION T418A(10),D418A(10), T18B1(3),D18B1(20),C18B1(60),      &
     &          T18B2(10), D18B2(10) ,C18B2(100)
      DIMENSION T419A(22),D419A(77) ,T419B(13),D419B(13),T419C(26),     &
     &          D419C(130)
      DIMENSION T43A(15),D43A(56),T43B(13),D43B(40),T44A(13),D44A(42),  &
     &          T44B(13),D44B(42),T44C(6),D44C(6)
      DIMENSION XMTD(15),CDW1(15),CDW2(15),VAR(4),LGH(4)
      DIMENSION CLAMT(5),ALPHA(20) ,CDJB(20)
      DIMENSION X27M(4),X27I(4),C27(6)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA,IG,NF
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /BDATA/  BD(762)
      COMMON /HTDATA/ A(195),B(49)
      COMMON /HTI/    WINGIN(77)
      COMMON /SUPBOD/ SBD(227)
      COMMON /SBETA/  STB(243),TRA(108)
      COMMON /IBODY/  PB, BODY(400)
      COMMON /IHT/    PW, WING(380)
      COMMON /IBH/    PBW, BW(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JEQPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS
      LOGICAL         FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JEQPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS
      EQUIVALENCE (TOC,WINGIN(16)),(ARSTAR,A(7)),(SWEPE2,A(71))         &
     &,(COSLE,A(61)),(TAPR,A(27)),(CBAR,A(16)),(RNFS,A(129)),           &
     &(XOC,WINGIN(18)),(SRSTAR,A(3)),(COSC4,A(67)),(SS,BD(93))          &
     &,(DB,SBD(6)),(DMAX,SBD(120)),(XLB,SBD(2)),(SB,BD(57))             &
     &,(TANC2,A(74))
      EQUIVALENCE (CLA14,TRA(1)),(CLAMO,WINGIN(69)),(K,TRA(3))          &
     &,(MFB0,TRA(5)),(MFB,TRA(6)),(AOC,TRA(7)),(CFBCT,TRA(8)),(BETAFB,  &
     &TRA(9)),(CLAFBT,TRA(10)),(MACH,TRA(4)),(CLAFB,TRA(12)),(CLAA,TRA  &
     &(13)),(BOC,TRA(14)),(CLAB,TRA(15)),(MT(1),TRA(16)),(CLAMT(1),TRA  &
     &(21)),(CLA,WING(101)),(C1,TRA(27)),(ARATIO,TRA(28)),(BU4,TRA(29)),&
     &(CLMAX6,TRA(30)),(ACLBAS,TRA(31)),(DACMA6,TRA(32)),(C3,TRA(33))
      EQUIVALENCE (CLAB14,SBD(18)),(CMAB14,SBD(110)),(CD014,SBD(124)),  &
     &(CMAB6,BODY(121)),(CFB6,BD(92)),(CD0B6,BD(61)),(CDBB6,BD(60))
      EQUIVALENCE (DALCM,TRA(34)),(DCLMAX,TRA(35)),(ALCLM6,TRA(36)),    &
     &(ALCLMT,TRA(37)),(CLMAXT,TRA(38)),(RLCOFF,TRA(39)),(RNN,TRA(40)), &
     &(RL,TRA(41)),(CF,TRA(42)),(CDW2(1),TRA(43)),                      &
     &(CDW,TRA(67)),(CDF,TRA(68)),(CD0W,WING(1)),(CLAW6,TRA(70))        &
     &,(CLABM6,BODY(101)),(CLABD,BODY(101)),(CMAB,BODY(121))            &
     &,(CDPB,TRA(80)),(CDBFIG,TRA(81)),(CDBB,TRA(76)),(CDWB,TRA(77))    &
     &,(CD0B,TRA(78)),(CDJB(1),BODY(1)),(CD0WB,BW(1))                   &
     &,(CDFB,TRA(79)),(DCLA14,TRA(82))
      EQUIVALENCE (TANLE,A(62))
      LOGICAL LOWAR
      DATA ROUTID /4HTRSO,4HNI  /
      DATA Q3243A/4H4.1.,4H3.2-,4H53A /,Q3243B/4H4.1.,4H3.2-,4H53B /,   &
     &Q3244B/4H4.1.,4H3.2-,4H54B /,Q3244A/4H4.1.,4H3.2-,4H54A /,Q3244C/ &
     &4H4.1.,4H3.2-,4H54C /,QCLA/4HCLA /,Q34171/4H4.1.,4H3.4-,4H24B , 4H&
     &C1  /,Q34172/4H4.1.,4H3.4-,4H24B ,4HC2  /,Q3418A/4H4.1.,4H3.4-, 4H&
     &25A /,Q34181/4H4.1.,4H3.4-,4H25B1/,Q34182/4H4.1.,4H3.4-,4H25B2/,  &
     &Q3419B/4H4.1.,4H3.4-,4H26B /,Q3419C/4H4.1.,4H3.4-,4H26C /,Q3419A  &
     &/4H4.1.,4H3.4-,4H26A /,Q15127/4H4.1.,4H5.1-,4H27  ,4HCEPT/,Q5129R &
     &/4H4.1.,4H5.1-,4H29R /,Q5129L/4H4.1.,4H5.1-,4H29L /,QCDW/4HCDW /, &
     &Q23124/4H4.2.,4H3.1-,4H24  /,Q23126/4H4.2.,4H3.1-,4H26  /
!
!              FIGURE 4.1.5.1-27
!
      DATA X27I  /1.57780,1.67221,1.98509,2.28874/
      DATA X27M  /0.0,1.0,2.0,3.0/
      DATA I27   /0/
      DATA WTYPE /4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA I17,IN/0,0/
      DATA NP/11/
!
!              FIGURE 4.1.3.4-24B
!
      DATA TR /0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
      DATA DR /0.,.21,.5,.9,1.08,1.05,1.,.94,.9,.86,.85/
      DATA Y  /0.,.225,.47,.496,.43,.32,.21,.125,.075,.0475,.0/
      DATA X  /0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
!
!     ----4.1.3.4-25(A)
!
      DATA T418A /0.,.4,.8,1.2,1.6,2.0,2.4,2.8,3.2,3.6/
      DATA D418A /3*35.,32.,28.,25.,23.2,22.,21.5,21./
!
!     ----4.1.3.4-25(B)
!
      DATA T18B1/.2,.4,.6/
      DATA D18B1/4.5,5.,5.5,6.,6.5,7.,7.5,8.,8.5,9.,9.5,10.,10.5,11.,   &
     &11.5,12.,12.5,13.,13.5,14./
      DATA C18B1/0.,.5,.9,1.4,1.9,2.5,3.3,4.,4.6,5.6,6.4,7.3,8.2,9.2,10.&
     &,11.,12.,13.,14.,15. , 0.,.2,.4,.7,1.2,1.7,2.4,3.,3.7,4.6,5.2,6., &
     &6.9,7.8,8.6,9.5,10.4,11.4,12.3,13.5 , 0.,0.,.1,.2,.5,.7,1.,1.3,1.6&
     &,2.,2.5,3.,3.6,4.3,4.9,5.5,6.2,7.,7.6,8.5/
      DATA T18B2/0.,2.,3.,4.,5.,6.,7.,8.,9.,30./
      DATA C18B2 /                                    10.,8.5,6.9,5.5,4.&
     &,2.6,1.5,.7,.1,0. , 8.7,7.3,5.3,4.2,2.6,1.4,0.5,-.2,-.5,0. , 7.5, &
     &5.9,4.2,2.5,1.2,0.,-.7,-1.1,-.8,0. , 5.5,3.4,1.6,0.,-1.3,-2.1,-2.5&
     &,-2.,-.8,0. , 3.,.7,-1.4,-3.3,-4.3,-4.3,-3.1,-2.,-.8,0. , .3,-2.5,&
     &-4.7,-5.8,-5.3,-4.3,-3.1,-2.,-.8,0. ,-2.2,-5.,-6.7,-6.3,-5.3,-4.3,&
     &-3.1,-2.,-0.8,0. , -3.3,-6.6,-7.2,-6.3,-5.3,-4.3,-3.1,-2.,-.8,0., &
     &  -4.2,-7.,-7.2,-6.3,-5.3,-4.3,-3.1,-2.,-.8,0. , -8.5,-7.9,-7.2,  &
     & -6.3,-5.3,-4.3,-3.1,-2.,-.8,0. /
      DATA D18B2  /.0,.5,1.,1.5,2.,2.5,3.,3.5,4.,4.5/
!
!              FIGURE 4.1.3.4-26B
!
      DATA T419B                                                        &
     & / 0., 4., 5., 6., 7., 8., 9., 10., 11., 12., 13., 14., 16. /
      DATA D419B                                                        &
     & / 1., 1., .93, .8, .55, .4, .3, .24, .2, .16, .14, .12, .12 /
!
!              FIGURE 4.1.3.2-53A
!
      DATA T43A/                                                        &
     & 0.,     2.,     4.,     6.,     8.,     10.,    12.,    14. ,    &
     & 0., 1., 2., 3., 4., 6., 8./
      DATA D43A                                                         &
     &/8*1.0,                                                           &
     & 6*1.0,.98,.9,                                                    &
     & 5*1.0,.983,.89,.855,                                             &
     & 4*1.0,.939,.888,.857,.835,                                       &
     & 2*1.0,.958,.904,.869,.842,.82,.802,                              &
     & 1.0,    .952,   .908,   .872,   .842,   .816,   .80,    .787,    &
     & 1.0,    .952,   .908,   .872,   .842,   .816,   .80,    .787 /
!
!              FIGURE 4.1.3.2-53B
!
      DATA T43B                                                         &
     &  / 0.0, 0.17453, 0.34907 , 0.52360, 0.69813,                     &
     &         1.04720, 1.22173 , 1.57080    ,                          &
     & .799,.85,.9,.95,1.000/
      DATA D43B/                                                        &
     & .8,     .807,   .82,    .841,   .867,   .918,   .945,   1.0,     &
     & .85,    .855,   .865,   .88,    .9,     .938,   .958,   1.0,     &
     & .90,    .903,   .91,    .92,    .932,   .958,   .974,   1.0,     &
     & .95,    .952,   .955,   .96,    .967,   .98,    .987,   1.0,     &
     &    1.0,  1.0,  1.0,  1.0,  1.0,  1.0,1.0,  1.0  /
!
!              FIGURE 4.1.3.2-54A
!
      DATA T44A/                                                        &
     & 0.,     2.,     4.,     6.,     8.,     12.,    14. ,            &
     & 1.,     2.,     3.,     4.,     6.,     8. /
      DATA D44A/                                                        &
     & 1.09,   1.088,  1.056,  1.008,  .962,   .872,   .828,            &
     & .98,    1.088,  1.1,    1.05,   .992,   .882,   .83,             &
     & .85,    1.,     1.075,  1.06,   1.005,  .89,    .835,            &
     & .74,    .9,     1.015,  1.07,   1.025,  .895,   .837,            &
     &4*1.15,1.07,.915,.915,                                            &
     &5*1.12,.94,.94/
!
!              FIGURE 4.1.3.2-54B
!
      DATA T44B/                                                        &
     & 0.,     4.,     6.,     8.,     10.,    12.,    14. ,            &
     & 1.,     2.,     3.,     4.,     6.,     8. /
      DATA D44B/                                                        &
     & -.14,   -.14,   -.14,   -.14,   -.14,   0.,     .44,             &
     & -.07,   -.07,   -.07,   -.07,   0.,     .31,    .64,             &
     & .05,    .05,    .05,    .06,    .23,    .49,    .75,             &
     & .06,    .06,    .06,    .15,    .35,    .58,    .79,             &
     & .08,    .08,    .14,    .29,    .48,    .66,    .84,             &
     & .09,    .15,    .24,    .39,    .555,   .72,    .89 /
!
!              FIGURE 4.1.3.2-54C
!
      DATA T44C                                                         &
     &/0.,     2.,     4.,     6.,     8.,     16. /
      DATA D44C                                                         &
     &  / -.04, .01, .075, .13, .15, .15 /
!
!              FIGURE 4.1.3.4-26A
!
      DATA T419A                                                        &
     & /          0.8, 1.0, 1.2, 1.6, 2.0, 2.4, 3.0, 4*0.,              &
     &   .6, .7, .8, .9, .95, 1.0, 1.05, 1.1, 1.15, 1.2, 1.4 /
      DATA D419A                                                        &
     & /              0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0 ,         &
     &               -.050,-.050,-.050,-.030,-.015,-.010, 0.0 ,         &
     &               -.115,-.100,-.083,-.047,-.018, 0.0 , .025,         &
     &               -.145,-.110,-.080,-.020, .022, .050, .097,         &
     &               -.120,-.080,-.030, .050, .100, .140, .204,         &
     &               -.060, 0.0 , .060, .150, .210, .250, .325,         &
     &                .090, .130, .180, .257, .310, .330, .360,         &
     &                .113, .165, .210, .280, .320, .345, .360,         &
     &                .108, .160, .205, .284, .320, .344, .360,         &
     &                .096, .145, .190, .273, .320, .343, .355,         &
     &                .020, .050, .100, .200, .300, .330, .340/
!
!              FIGURE 4.1.3.4-26C
!
      DATA T419C                                                        &
     & / 0.0, 0.4, 0.8, 1.0, 1.2, 1.6, 2.0, 2.4, 3.0, 5.0  ,3*0.,       &
     &   .6,.7,.75,.8,.85,.9,.95,1.0,1.05,1.1,1.15,1.2,1.4  /
      DATA D419C                                                        &
     & /   0.0, 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0,  0.0 , 0.0 ,   &
     &   -1.00,-1.00,-1.00,-1.00,-1.00,-1.00,-1.00,-1.00,-1.00,-1.00,   &
     &   -1.25,-1.22,-1.20,-1.20,-1.20,-1.10,-1.10,-1.00,-1.00,-0.85,   &
     &   -2.05,-1.75,-1.50,-1.40,-1.30,-1.20,-1.10,-1.00,-1.00,-0.95,   &
     &   -2.20,-1.90,-1.60,-1.50,-1.40,-1.20,-1.10,-1.00,-0.90,-0.63,   &
     &   -1.85,-1.60,-1.40,-1.30,-1.20,-1.00,-0.80,-0.70,-0.60,-0.40,   &
     &   -1.80,-1.38,-1.00,-0.90,-0.70,-0.50,-0.30,-0.10, 0.0 , 0.10,   &
     &   -0.60,-0.20, 0.20, 0.30, 0.50, 0.80, 1.00, 1.20, 1.40, 2.00,   &
     &    1.90, 2.40, 3.00, 3.20, 3.50, 3.90, 4.30, 4.60, 5.00, 6.20,   &
     &    2.40, 4.05, 5.50, 6.20, 7.00, 8.00, 8.90, 10.0, 10.9, 13.9,   &
     &    1.60, 4.04, 6.90, 8.00, 9.10, 10.6, 11.9, 13.0, 14.3, 18.2,   &
     &   -1.20, 3.90, 7.60, 8.90, 10.2, 12.1, 13.5, 14.7, 15.9, 18.8,   &
     &   -11.0,-0.60, 8.10, 10.5, 12.0, 14.4, 16.2, 17.5, 18.8, 21.3 /
!
!              FIGURE 4.1.5.1-29 LEFT SIDE (SUBSONIC)
!
      DATA T429L/                                                       &
     &0.0,0.4,0.6,0.8,1.0,1.2,1.4,1.475,                                &
     &0.,.5,1.0,1.5,2.0,3.0,4.0/
      DATA D429L/                                                       &
     &8*0.0,                                                            &
     &0.90,0.71,0.55,0.39,0.21,0.10,0.00,0.0,                           &
     &2.34,2.03,1.70,1.05,0.51,0.21,0.01,0.0,                           &
     &3.01,2.92,2.68,1.99,1.00,0.32,0.01,0.0,                           &
     &3.30,3.27,3.12,2.50,1.26,0.42,0.03,0.0,                           &
     &3.49,3.43,3.38,2.80,1.52,0.51,0.06,0.0,                           &
     &3.61,3.58,3.52,3.14,1.83,0.52,0.09,0.0/
!
!              FIGURE 4.1.5.1-29 RIGHT SIDE (SUPERSONIC)
!
      DATA T429R/                                                       &
     &0.0,.4,.8,1.2,1.4,0.0,0.0,                                        &
     &0.,.5,1.0,1.5,2.0,3.0,4.0/
      DATA D429R/                                                       &
     &5*0.0,                                                            &
     &0.90,1.08,1.18,1.28,1.31,                                         &
     &2.34,2.53,2.68,2.75,2.78,                                         &
     &3.01,3.08,3.10,3.12,3.12,                                         &
     &3.30,3.32,3.32,3.30,3.28,                                         &
     &3.49,3.49,3.48,3.42,3.39,                                         &
     &3.61,3.61,3.60,3.56,3.51/
!
!              FIGURE 4.2.3.1-24
!
      DATA T424/                                                        &
     &.75,.85,.90,.95,1.0,1.015,1.030,1.050,1.075,1.125,1.15,1.2,1.3,   &
     &.011,.067,.122/
      DATA D424/                                                        &
     &.011,.014,.018,.031,.069,.040,.020,6*0.0,                         &
     &.067,.071,.078,.092,.140,.150,.120,.086, .067, .050,.047,.045,.05,&
     &.122,.130,.139,.155,.204,.220,.236,.210, .168, .110, .101,.100,.1/
      DATA T426/                                                        &
     &6.0,7.0,8.0,10.,12.,14.,16.,18.,20.,24.,26.,                      &
     &1.0,1.025,1.05,1.1,1.2/
      DATA D426/                                                        &
     &.118,.084,.065,.041,.029,.020,.016,.012,.010,.007,.006,           &
     &.147,.110,.088,.061,.043,.033,.026,.022,.019,.015,.013,           &
     &.166,.120,.097,.068,.050,.039,.031,.026,.022,.015,.013,           &
     &.186,.138,.110,.076,.057,.044,.034,.028,.022,.015,.013,           &
     &.200,.152,.120,.080,.059,.046,.036,.028,.022,.015,.013/
!
!  *** WING ALONE ***
! *** WING LIFT CURVE SLOPE ***
!
      MACH=FLC(NZ+2)
      IF(WINGIN(15).NE.WTYPE(1))GO TO 1100
      CALL TRNHT(CLA14, DCLA14)
      K=CLAMO*RAD/(2.0*PI)
      BETA6=0.80
!
!              FIGURE 4.1.3.2-53A FORCE BREAK MACH NUMBER=MFB ( 0 SWEEP)
!
      VAR(1)=TOC*100.
      VAR(2)=ARSTAR
      LGH(1)=8
      LGH(2)=7
      CALL INTERX(2,T43A,VAR,LGH,D43A,MFB0,8,56,                        &
     &            2,2,0,0,2,-1,0,0,Q3243A,3,ROUTID)
!
!              FIGURE 4.1.3.2-53B MFB0 CORRECTED FOR SWEEP
!
      VAR(1)=SWEPE2
      VAR(2)=MFB0
      LGH(1)=8
      LGH(2)=5
      CALL INTERX(2,T43B,VAR,LGH,D43B,MFB,8,40,                         &
     &            0,2,0,0,2,0,0,0,Q3243B,3,ROUTID)
      IF(NF .LT. 0) RETURN
!
!              FIGURE 4.1.3.2-54B (A/C)
!
      VAR(1)=TOC*100.
      VAR(2)=ARSTAR
      LGH(1)=7
      LGH(2)=6
      CALL INTERX(2,T44B,VAR,LGH,D44B,AOC,7,42,                         &
     &            0,2,0,0,1,2,0,0,Q3244B,3,ROUTID)
!
!              FIGURE 4.1.3.2-54A CORRECTION TO LIFT CURVE SLOPE
!
      CALL INTERX(2,T44A,VAR,LGH,D44A,CFBCT,7,42,                       &
     &            2,1,0,0,2,2,0,0,Q3244A,3,ROUTID)
!
!
!
      BETAFB = SQRT(1.0-MFB**2)
      IF(MFB .GT. 0.98) BETAFB = 0.0
      BB   = BETAFB
      ARG1 = 2.0*PI*ARSTAR/RAD
      ARG2=(ARSTAR/K)**2
      ARG3=BB**2+TANC2**2
      ARG4 = 2.0+SQRT(ARG2*ARG3+4.0)
      CLAFBT = ARG1/ARG4
!
      BB   = 0.8
      ARG2 = (BB*ARSTAR/K)**2
      ARG3 = 0.0
      IF(ARG2 .GT. 0.0) ARG3 = 1.0+(TANC2/BB)**2
      ARG4 = 2.0+SQRT(ARG2*ARG3+4.0)
      CLAW6 = ARG1*SRSTAR/(ARG4*SR)
!
      XM = 0.75
      IF(XM .GT. (MFB-0.1)) XM = MFB-0.1
      IF(XM .GT. MACH) XM=MACH
      BB   = SQRT(1.0-XM**2)
      ARG2=(ARSTAR/K)**2
      ARG3=BB**2+TANC2**2
      ARG4 = 2.0+SQRT(ARG2*ARG3+4.0)
      CLAW7 = ARG1*SRSTAR/(ARG4*SR)
      DCLA7 = XM*ARG1*ARG2*SRSTAR/SR
      DCLA7 = DCLA7/(ARG4**2*SQRT(ARG2*ARG3+4.0))
      CLAFB=CLAFBT*CFBCT *SRSTAR/SR
      CLAA=(1.-AOC)*CLAFB
!
!              FIGURE 4.1.3.2-54C (B/C)
!
      VAR(1)=TOC*100.
      LGH(1)=6
      CALL INTERX(1,T44C,VAR,LGH,D44C,BOC,6,6,                          &
     &            2,0,0,0,1,0,0,0,Q3244C,3,ROUTID)
      CLAB=(1.-BOC)*CLAFB
      MT(1)=XM
      MT(2)=MFB
      MT(3)=MFB+.07
      MT(4)=MFB+.14
      MT(5)=1.40
      CLAMT(1)=CLAW7
      CLAMT(2)=CLAFB
      CLAMT(3)=CLAA
      CLAMT(4)=CLAB
      CLAMT(5)=CLA14
      CALL TRANF(5, MT, CLAMT, DCLA7, DCLA14, MACH, CLA)
!
!  *** CLASSIFICATION OF ASPECT RATIO ***
!
      CALL TBFUNX(A(27), C1   ,DYDX,NP,X,Y,C,IN,MI,NG,                  &
     &            0,0,Q34171,4,ROUTID)
      ARG1=(C1+1.)*COSLE
      ARATIO=A(128)/ARG1
!
!              FIGURE 4.1.3.4-24B (C1) AND (C2)
!
      VAR(1)=TAPR
      LGH(1)=11
      CALL INTERX(1,TR,VAR,LGH,DR,C2,11,11,                             &
     &           0,0,0,0,0,0,0,0,Q34172,4,ROUTID)
      LOWAR=.FALSE.
      IF(ARSTAR.LT.ARATIO)LOWAR=.TRUE.
!
!  *** IF LOW ASPECT RATIO CALCULATE CLMAX AND (ALPHA)CLMAX ***
!
      IF(.NOT.LOWAR)GO TO 1070
      BU4=(C1+1.)*ARSTAR*COSLE/BETA6
      ARG=(C2+1.)*ARSTAR*TANLE
      A(160)=ARG
      CALL CLMXB1(BU4,CLMAX6,A,WINGIN)
!
!  *** CALCULATE (ALPHA)CLMAX AT MACH=0.60 ***
!              FIGURE 4.1.3.4-25A
!
      CALL TBFUNX(BU4,ACLBAS,DYDX,10,T418A,D418A,C17,I17,MI,NG,         &
     &            0,0,Q3418A,3,ROUTID)
      IF(ARG.LE.4.5)GO TO 1050
!
!              FIGURE 4.1.3.4-25B
!
      CALL TLINEX(T18B1,D18B1,C18B1,3,20,MT(1),ARG,DACMA6,              &
     &            0,0,2,1,Q34181,3,ROUTID)
      GO TO 1060
 1050 ARG1=ARSTAR*COSLE*(1.+4.*TAPR**2)
      CALL TLINEX(T18B2,D18B2,C18B2,10,10,ARG1,ARG,DACMA6,              &
     &            0,2,2,0,Q34182,3,ROUTID)
 1060 ALCLM6=ACLBAS+DACMA6
!
!  *** ADJUST PARAMETERS TO TRANSONIC MACH NUMBER ***
!              FIGURE 4.1.3.4-26B
!
      VAR(1)=ARG
      LGH(1)=13
      CALL INTERX(1,T419B,VAR,LGH,D419B,C3,13,13,                       &
     &            0,0,0,0,0,0,0,0,Q3419B,3,ROUTID)
!
!              FIGURE 4.1.3.4-26C  DELTA (ALPHA)CLMAX
!
      VAR(1)=BU4*BETA6
      VAR(2)=MACH
      LGH(1)=10
      LGH(2)=13
      CALL INTERX(2,T419C,VAR,LGH,D419C,DALCM ,13,130,                  &
     &            2,0,0,0,2,2,0,0,Q3419C,3,ROUTID)
!
!              FIGURE 4.1.3.4-26A DELTA CLMAX
!
      VAR(1)=C3*VAR(1)
      LGH(1)=7
      LGH(2)=11
      CALL INTERX(2,T419A,VAR,LGH,D419A,DCLMAX,11,77,                   &
     &            2,0,0,0,2,2,0,0,Q3419A,3,ROUTID)
      ALCLMT=ALCLM6+DALCM
      CLMAXT=CLMAX6+DCLMAX*(SRSTAR/SR)
 1070 CONTINUE
!
!  *** ZERO ANGLE OF ATTACK DRAG,CD0 ***
!              FIGURE 4.1.5.1-27 (EQUATION FOR RLCOFF)
!
      ARG=12.*CBAR/RUFF
      CALL TBFUNX(0.6,CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,              &
     &            0,0,Q15127,4,ROUTID)
      RLCOFF=ARG**1.0482*10.0**CEPT
      RNN=CBAR*RNFS
      IF(RLCOFF.LT.RNN)RNN=RLCOFF
      CALL FIG26(RNN,0.60,CF)
      RL=1.2
      IF(XOC.LT.0.30)RL=2.0
      CDF=CF*(1.+RL*TOC)*2.*SRSTAR/SR
      ARG=SQRT(COSC4)
      XMTD(1)=0.60/ARG
      XMTD(2)=0.65/ARG
      XMTD(3)=0.70/ARG
      XMTD(4)=0.75/ARG
      XMTD(5)=0.80/ARG
      XMTD(6)=0.85/ARG
      XMTD(7)=0.90/ARG
      XMTD(8)=0.925/ARG
      XMTD(9)=0.950/ARG
      XMTD(10)=0.975/ARG
      XMTD(11)=1.000/ARG
      XMTD(12)=1.050/ARG
      XMTD(13)=1.100/ARG
      XMTD(14)=1.200/ARG
      XMTD(15)=1.400/ARG
      ARG2=TOC**.3333
      VAR(2)=ARSTAR*ARG2
      ARG3=COSC4**2.5
      DO 1090 I=1,15
         ARG4=ABS((XMTD(I)*ARG)**2-1.)
         VAR(1)=SQRT(ARG4)/ARG2
!
!              FIGURE 4.1.5.1-29
!
         IF(XMTD(I)*ARG.LE.1.)GO TO 1080
         LGH(1)=5
         LGH(2)=7
         CALL INTERX(2,T429R,VAR,LGH,D429R,CDW1(I),7,35,                &
     &               0,0,0,0,0,2,0,0,Q5129R,3,ROUTID)
         GO TO 1090
 1080    LGH(1)=8
         LGH(2)=7
         CALL INTERX(2,T429L,VAR,LGH,D429L,CDW1(I),8,56,                &
     &               0,0,0,0,-1,2,0,0,Q5129L,3,ROUTID)
 1090 CDW2(I)=CDW1(I)*TOC**1.666*ARG3*SRSTAR/SR
      CALL TRANF(15, XMTD, CDW2, 0.0, 0.0, MACH, CDW)
      CD0W=CDW+CDF
!
!  *** BODY ALONE ***
!
 1100 IF(.NOT.BO)RETURN
!
!  ***BODY LIFT AND MOMENT SLOPES ***
!
      ARG1=(MACH-.60)/.80
      CLABD=CLABM6+(CLAB14-CLABM6)*ARG1
      CMAB=CMAB6+(CMAB14-CMAB6)*ARG1
!
!  *** BODY DRAG ***
!
      CDFB=CFB6*SS/SR
      CDPB=CD0B6-CDBB6-CDFB
      IF(MACH.GE.1.0.AND.MACH.LE.1.2)CDPB=CDPB*(1.-(MACH-1.0)/.2)
      IF(MACH.GT.1.2)CDPB=0.0
      IF(DB.LT.0.3*DMAX)DB=0.3*DMAX
      ARG=(DB/DMAX)**2
!
!              FIGURE 4.2.3.1-24 (CDBT)
!
      VAR(1)=MACH
      VAR(2)=CDBB6/ARG*4.0*SR/(PI*DMAX**2)
      LGH(1)=13
      LGH(2)=3
      CALL INTERX(2,T424,VAR,LGH,D424,CDBFIG,13,39,                     &
     &            0,2,0,0,0,2,0,0,Q23124,3,ROUTID)
      CDBB=CDBFIG*ARG*PI*DMAX**2/(4.0*SR)
      IF(MACH.LT.1.0)GO TO 1110
      VAR(1)=XLB/DMAX
      VAR(2)=MACH
      LGH(1)= 11
      LGH(2)=5
      CALL INTERX(2,T426,VAR,LGH,D426,CDWB,11,55,                       &
     &            0,0,0,0,2,2,0,0,Q23126,3,ROUTID)
      CDWB=CDWB*PI*DMAX**2/(4.*SR)
      GO TO 1120
 1110 CDWB=0.0
 1120 CD0B=CDFB+CDPB+CDBB+CDWB
      IF(MACH.GT.1.2)GO TO 1130
      GO TO 1140
 1130 CD0B=CD0B+(CD014-CD0B)*(MACH-1.2)/0.2
!
!  *** BODY DRAG AT ANGLE OF ATTACK ***
!
 1140 DO 1150 J=1,NALPHA
 1150 CDJB(J)=CD0B+(FLC(J+22)/RAD)**2*SB/SR
      CD0WB=CD0B+CD0W
      TRA(73)=CD0WB
      RETURN
      END
      SUBROUTINE VFCDO(I)
!
!***  CALCULATES VENTRAL FIN ZERO LIFT DRAG COEFFICIENT
!
      REAL MACH,LERBW,LERO,LERI,KSHARP
      DIMENSION ROUTID(2)
      DIMENSION Q15127(4)
      DIMENSION WTYPE(4),CN(20),CAV(20),CDJWB(20), CLJWB(20),CD(20)
      DIMENSION X27M(4),X27I(4),C27(6)
!
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /VTI/    VTIN(162),CT,SPANO,SPANS,SSPN,CB,CR,SAVSI,SAVSO,  &
     &                CHSTAT,SWAFP,TWISTA,SSPNDD,DHDADI,DHDADO,         &
     &                TYPE,                                             &
     &                TOVC,DELTAY,XOVC,CLI,ALPHAI,CLALPA(20),           &
     &                CLMAX(20),CMO,LERI,LERO,CAMBER,TOVCO,XOVCO,CMOT,  &
     &               CLMAXL,CLAMO,TCEFF,KSHARP,SVWB(20),SVB(20),SVHB(20)
      COMMON /WINGD/  A(195)
      COMMON /VTDATA/ AAA(195),AVT(195)
      COMMON /WBHCAL/ STP(156)
      COMMON /IBW/    PBW, BW(380)
      COMMON /IBWV/   PBWV, BWV(380)
      COMMON /FLGTCD/ FLC(160)
!
      EQUIVALENCE (CDO,STP(156)),(CD(1),BWV(1)),(CN(1),BWV(61)),        &
     &            (CAV(1),BWV(81))
      EQUIVALENCE (CBARI,AVT(15)),(RNFS,A(129)),(SRSTAR,AVT(3)),        &
     &            (CBARO,AVT(17)),(SISTAR,AVT(1)),(SOSTAR,AVT(2)),      &
     &            (TANLEO,AVT(86)),(COSLEO,AVT(85)),(TANLEI,AVT(62)),   &
     &            (COSLE,AVT(61)),(TANTEO,AVT(104)),(CDJWB(1),BW(1)),   &
     &            (CLJWB(1),BW(21))
!
      DATA ROUTID /4HVFCD,4HO   /
      DATA Q15127 /4H4.1.,4H5.1-,4H27  ,4HCEPT/
      DATA WTYPE  /4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA X27M   /0.0,1.0,2.0,3.0/
      DATA X27I   /1.57780,1.67221,1.98509,2.28874/
      DATA I27    /0/
!
      MACH=FLC(I+2 )
      BETA=SQRT(MACH**2-1.0)
!
!  ***WING SUPERSONIC ZERO-LIFT SKIN FRICTION DRAG,STRAIGHT TAPERED WING
!
      IF(TYPE.NE.WTYPE(1))GO TO 1020
      CBAR=CBARI
 1000 RNN=CBAR*RNFS
      IF(RUFF.EQ.0.0)GO TO 1010
      ARG=12.*CBAR/RUFF
!
!                   FIGURE 4.1.5.1-27 (EQUATION FOR RLCOFF)
!
      RACH = MACH
      IF(RACH.GT.3.0)RACH=3.0
      CALL TBFUNX(RACH,CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,             &
     &            0,0,Q15127,4,ROUTID)
      RLCOFF=ARG**1.0482*10.0**CEPT
      IF(RLCOFF.LT.RNN)RNN=RLCOFF
 1010 CALL FIG26(RNN,RACH,CF)
      IF(TYPE.NE.WTYPE(1))GO TO 1030
      CDF=CF*SRSTAR/SR*2.
      GO TO 1050
!
!  ***WING SUPERSONIC ZERO-LIFT SKIN FRICTION DRAG,NON-STRAIGHT WING***
!
 1020 CONTINUE
      CBAR=CBARI
      GO TO 1000
 1030 CONTINUE
      IF(CBAR.EQ.CBARO)GO TO 1040
      RNI=RNN
      CFI=CF
      CBAR=CBARO
      GO TO 1000
 1040 RNO=RNN
      CFO=CF
      CDF=(CFI*SISTAR+CFO*SOSTAR)/SR*2.
 1050 CONTINUE
!
!   ***SUPERSONIC WING ZERO-LIFT WAVE DRAG,SHARP L.E.,ALL PLANFORMS***
!
      IF(TYPE.EQ.WTYPE(1))GO TO 1060
      TA=TANLEO
      SPANIN=SPANS-SPANO
      CRBW=CB+SPANIN*(TANLEO-TANTEO)
      SBW=(CRBW+CT)*SPANS*0.50
      S=SBW
      CA=COSLEO
      LERBW=LERO*((CR+CT+2.*CB)/4.)
      GO TO 1070
 1060 TA=TANLEI
      IF(ABS(TA) .LT. UNUSED) TA = UNUSED
      S=(CR+CT)/2.*SSPN
      CA =COSLE
      LERBW=LERI*((CR+CT)/2.)
 1070 CONTINUE
      BOVERT=BETA/TA
      IF(KSHARP.EQ.UNUSED)GO TO 1080
      ARG=KSHARP*TCEFF**2*S  /SR
      CDW=ARG/BETA
      IF(BOVERT.LT.1.)CDW=ARG/TA
      GO TO 1090
 1080 CONTINUE
!
!  ***SUPERSONIC WING ZERO-LIFT WAVE DRAG,ROUND L.E.,ALL PLANFORMS***
!
      ARG1=1.28*MACH**3*CA    **6/(1.+MACH**3*CA    **3)
      ARG2=2.* LERBW * SPANS /(SR*CA)
      CDLE=ARG1*ARG2
      ARG=     16.*TCEFF**2*S  /(3.*SR)
      IF(BOVERT.GE.1.)CDW=CDLE+ARG/BETA
      IF(BOVERT.LT.1.)CDW=CDLE+ARG/TA
 1090 CONTINUE
      CDO=CDF+CDW
      IF(TYPE.NE.WTYPE(1))RETURN
      DO 1100 J=1,NALPHA
         CD(J)=CD(J)+CDO
         COSA=COS(FLC(J+22)/RAD)
         SINA=SIN(FLC(J+22)/RAD)
         CN(J)=CLJWB(J)*COSA+CD(J)*SINA
 1100 CAV(J)=CD(J)*COSA-CLJWB(J)*SINA
      RETURN
      END
      SUBROUTINE VFDRAG(I)
!
!***  COMPUTES VENTRAL FIN DRAG COEFFICIENT
!
      DIMENSION ROUTID(2)
      DIMENSION Q15127(3),Q5128B(3),Q128BD(5)
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /FLGTCD/ FLC(160)
      COMMON /WHAERO/ C2(51),D2(55),CHT2(51),DHT2(55),DVT2(55),DVT(55)
      COMMON /VTDATA/ AAA(195),AVT(195)
      COMMON /VTI/    VV(154),TVTIN(8),VT(154)
      DIMENSION D(55),A(195),B(93)
      EQUIVALENCE (A(1),AVT(1)),(D(1),DVT(1)),(B(1),FLC(1))
      DIMENSION WTYPE(4)
      DIMENSION X228BD(9),X128BD(4),Y28BD(36)
      DIMENSION X228B(11), X128B(4), Y28B(44)
      DIMENSION X27M(4),X27I(4),C27(6)
      DATA ROUTID/4HVTDR,4HAG  /
      DATA Q15127 /4H4.1.,4H5.1-,4H27  /,Q5128B/4H4.1.,4H5.1-,4H28-B/,  &
     &     Q128BD /4H4.1.,4H5.1-,4H28-B,4H(DAS,4HHED)/
      DATA X27M   /0.0,1.0,2.0,3.0/
      DATA X27I   /1.57780,1.67221,1.98509,2.28874/
      DATA I27    /0/
!
!---------          FIGURE 4.1.5.1-28B            ----
!----     X228B=COS(SWEEP ANGLE(T/C)MAX)   X128B= MACH NUMBER
!----     Y28B= (R)LS
!
      DATA WTYPE/ 4HSTRA ,4HDOUB ,4HCRAN ,4HCURV /
      DATA X228B/0.5,.55,.60,.65,.70,.75,.80,.85,.90,.95,1.0/
      DATA X128B/0.9,.80,.60,.25/
      DATA Y28B/ 1.1,1.13,1.17,1.20,1.24,1.27,1.3,1.33,1.34,1.35,1.36 , &
     &1.0,1.04,1.08,1.11,1.15,1.18,1.21,1.23,1.25,1.25,1.26 , 0.88, .92,&
     &.96,1.0,1.04,1.08,1.11,1.13,1.14,1.14,1.15 , 0.81,.85,.89,.925,   &
     &.96,1.0,1.03,1.05,1.06,1.06,1.07/
!
!---------          FIGURE 4.1.5.1-28B-DASHED     ---------
!----          X228BD= COS(T/C)MAX      X128BD= MACH NUMBER
!----          Y28BD= (R)LS
!
      DATA X228BD/0.45,.65,.70,.75,.80,.85,.90,.95,1.0/
      DATA X128BD/0.9,.80,.60,.25/
      DATA Y28BD/1.20,1.20,1.24,1.27,1.30,1.33,1.34,1.35,1.36 , 1.11,   &
     &1.11,1.15,1.18,1.21,1.23,1.25,1.25,1.26 , 1.0,1.0,1.04,1.08,1.11, &
     &1.13,1.14,1.14,1.15 , 0.925,0.925,.96,1.0,1.03,1.05,2*1.06,1.07/
!
      D(2)=12.0*A(16)/ROUGFC
!
!---------     DETERMINE WING CONFIGURATION       ----------------------
!              IF NOT STRAIGHT-TAPERED, GO TO PAGE 3-2
!
      IF(VT(15).NE.WTYPE(1)) GO TO 1010
!
!---------          PAGE 3-1 CALCULATIONS         ----------------------
!*********     FOR STRAIGHT-TAPER WING CONFIGURATION        ************
!
!---------     COMPUTE REYNOLDS NUMBER, (RN)
!
 1000 D(17)=A(16)*A(129)
!
!---------     COMPUTE RL FROM EQUATION FOR FIG.4.1.5.1-27
!*********          FIGURE 4.1.5.1-27 EQUATION
!
      CALL TBFUNX(B(I+2),CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,           &
     &            0,0,Q15127,3,ROUTID)
      D(14)=D(2)**1.0482*10.0**CEPT
!
!*********          FIGURE 4.1.5.1-26 EQUATIONS (SUBROUTINE FIG26 )
!
      IF( D(14).LT.D(17)) D(17)=D(14)
      CALL FIG26  (D(17),B(I+2),D(10) )
!
!*********          FIGURE 4.1.5.1-28-B
!
      CALL TLINEX(X128B,X228B,Y28B,4,11,B(I+2),A(178),D(13),            &
     &            0,2,0,2,Q5128B,3,ROUTID)
      CAPL=2.0
      IF(VT(18).GE.0.30) CAPL=1.20
      D(20)=D(10)*(1.+CAPL*VT(16)+100.*VT(16)**4)*D(13)*(2.*A(3)/SREF)
      GO TO 1030
!
!                  ***** INBOARD CALCUALTIONS *****
!
 1010 D(18)=A(15)*A(129)
!
!*********     FIGURE 4.1.5.1-27 EQUATION
!
      CALL TBFUNX(B(I+2),CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,           &
     &            0,0,Q15127,3,ROUTID)
      D(15)=D(2)**1.0482*10.0**CEPT
!
!*********     IF RLI.LT.RNI  SET RNI=RLI
!
      IF( D(15).LT.D(18) ) D(18)= D(15)
!
!*********     FIGURE 4.1.5.1-26 SUBROUTINE
!
      CALL FIG26 ( D(18),B(I+2),D(11) )
!
!---------          FIGURE 4.1.5.1-28-B (DASHED)
!
      CALL TLINEX(X128BD,X228BD,Y28BD,4,9,B(I+2),A(190),D(23),          &
     &            0,0,0,0,Q128BD,5,ROUTID)
!
!*********     IF XTI GREATER TAN 0.30, THEN CAPL= 2.0          *
!
 1020 CAPL= 1.20
      IF(VT(18).LT.0.30) CAPL=2.00
      D(21)=D(11)*(1.+CAPL*VT(16)+100.*VT(16)**4)*D(23)*(2.*A(1)/SREF)
!
!                   ***** OUTBOARD CALCULATIONS *****
!
      D(19)=A(17)*A(129)
!
!*********     FIGURE 4.1.5.1-27 EQUATION
!
      D(16)=D(15)
!
!*********   IF RLO .LT. RNO, SET RNO= RLO
!
      IF(D(16).LT.D(19)) D(19)=D(16)
!
!*********     FIGURE 4.1.5.1-26 SUBROUTINE
!
      CALL FIG26( D(19),B(I+2),D(12) )
!
!*********     FIGURE 4.1.5.1-28-B
!
      CALL TLINEX(X128B,X228B,Y28B,4,11,B(I+2),A(184),D(24),            &
     &            0,2,0,2,Q5128B,3,ROUTID)
!
!*********     IF XTO GREATER THAN 0.30, THEN CAPL= 2.0
!
      CAPL=1.20
      IF(VT(66).LT.0.30) CAPL=2.00
      D(22)=D(12)*(1.+CAPL*VT(65)+100.*VT(65)**4)*D(24)*(2.*A(2)/SREF)
!
!*********     COMPUTE CDO FROM PAGE 3-2
!
      D(20)=D(21)+D(22)
 1030 CONTINUE
      RETURN
      END
      SUBROUTINE VFLIFT
!
!***  COMPUTES VENTRAL FIN LIFT COEFFICIENT
!
      REAL MACH,KSHARP
      LOGICAL SUPLE,ROUND,GLOVE
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
      COMMON /VTDATA/ ZZZ(195),AVT(195)
      COMMON /SBETA/  YYY(31),SLA(31)
      COMMON /VTI/    XXX(162),VTIN(154)
      COMMON /FLGTCD/ FLC(160)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /WINGI/  WINGIN(101)
      DIMENSION ROUTID(2),Q3250A(3),Q3250B(3),Q3246A(3),Q3246G(3),      &
     &          Q246AF(4),Q13252(3),Q13253(3),Q13251(3)
      DIMENSION S13252(12),DSHP52(12),R13252(12),DRND52(12),T13253(24), &
     &          D13253(140),T13251(12),D13251(12)
      DIMENSION DUMY1(184),DUMY2(184),DUMY3(184),DUMY5(184),            &
     &          DUMY6(184),DUMY4(184)
      DIMENSION T13246(52),D13246(1104),VAA(4),LGA(4),VAB(4),LGB(4),    &
     & A1350(17), B1350(19),DA50(72),DB50(88),G13246(9),DG3246(9)
      DIMENSION WTYPE(4)
      EQUIVALENCE(CNA,SLA(31))
      EQUIVALENCE (MACH,SLA(1)),(BETA,SLA(2))
      EQUIVALENCE (SRSTAR,AVT(3))
      EQUIVALENCE (TAPEXP,AVT(27)),(TANLE,AVT(62)),(SWEPLE,AVT(58)),    &
     &(AR,AVT(7)),(TRATIP,AVT(25)),(COSLE,AVT(61)),(DELTAY,VTIN(17)),   &
     &(SPANO,VTIN(2)),(TANLEO,AVT(86)),(TANTEO,AVT(104))                &
     &,(CB,VTIN(5)),(CT,VTIN(1)),(SW,SREF),(TANLEI,AVT(62)),            &
     &(TANTEI,AVT(80)),(SWTEI,AVT(76)),(SWTEO,AVT(100)),(KSHARP,VTIN(71)&
     &),(SPANS,WINGIN(3))
      EQUIVALENCE (D13246(1),DUMY1(1)),(D13246(185),DUMY2(1)),(D13246(36&
     &9),DUMY3(1)),(D13246(553),DUMY4(1)),(D13246(737),DUMY5(1)) ,      &
     &(D13246(921),DUMY6(1))
      DATA Q3250A/4H4.1.,4H3.2-,4H60A /,Q3246A/4H4.1.,4H3.2-,4H56A /,   &
     &     Q3250B/4H4.1.,4H3.2-,4H60B /,Q3246G/4H4.1.,4H3.2-,4H56G /,   &
     &     Q246AF/4H4.1.,4H3.2-,4H56A-,4HF   /,ROUTID/4HVFLI,4HFT  /,   &
     &     Q13253/4H4.1.,4H3.2-,4H63  /,                                &
     &     Q13251/4H4.1.,4H3.2-,4H61  /,                                &
     &     Q13252/4H4.1.,4H3.2-,4H62  /
!
!              FIGURE 4.1.3.2-60A (CNA/CNA)T FOR SUBSONIC L.E.
!
      DATA A1350/                                                       &
     & 0.,     .3,     .4,     .5,     .6,     .7,     .8,     .9,      &
     & 1.0001 ,                                                         &
     & 0.,     .41,    .82,    1.24,   2.12,   3.18,   6.95,   16.1 /
      DATA DA50/                                                        &
     & 1.,     1.,     1.,     1.,     1.,     1.,     1.,     1.,      &
     &         1.,                                                      &
     & 1.05,   1.05,   1.05,   1.05,   .985,   .945,   .915,   .9,      &
     & .9,                                                              &
     & 1.04,   1.04,   1.04,   1.04,   .965,   .908,   .87,    .85,     &
     & .84,                                                             &
     & 1.12,   1.12,   1.12,   1.015,  .94,    .88,    .838,   .81,     &
     & .796,                                                            &
     & 1.11,   1.11,   1.11,   1.,     .903,   .84,    .795,   .765,    &
     & .75,                                                             &
     & 1.08,   1.08,   1.08,   .954,   .865,   .8,     .75,    .72,     &
     & .7,                                                              &
     & 1.2,    1.2,    1.043,  .907,   .817,   .75,    .707,   .675,    &
     & .66,                                                             &
     & 1.14,   1.14,   .975,    .857,  .772,   .717,   .675,   .65,     &
     & .632 /
!
!              FIGURE 4.1.3.2-60B (CNA/CNA)T FOR SUPERSONIC L.E.
!
      DATA B1350/                                                       &
     & 0.,     .1,     .2,      .3,    .4,     .5,     .6,     .7,      &
     & .8,     .9,     1.0001 ,                                         &
     & 0.,     4.,     8.,      12.,   20.,    30.,    50.,    70./
      DATA DB50/                                                        &
     & 1.,     1.,     1.,      1.,    1.,     1.,     1.,     1.,      &
     & 1.,     1.,     1.,                                              &
     & 1.15,   1.15,   1.15,    1.15,  1.095,  1.04,   .99,    .96,     &
     & .935,   .915,   .9,                                              &
     & 1.12,   1.12,   1.12,    1.12,  1.05,   .985,   .94,    .905,    &
     & .88,    .857,   .84,                                             &
     & 1.15,   1.15,   1.15,    1.08,  1.005,  .945,   .902,   .87,     &
     & .842,   .82,    .796,                                            &
     & 1.22,   1.14,   1.05,    .98,   .93,    .89,    .853,   .823,    &
     & .795,   .77,    .75,                                             &
     & 1.13,   1.05,   .98,    .925,   .88,    .845,   .81,    .782,    &
     & .752,   .73,    .7,                                              &
     & 1.02,   .942,   .895,   .855,   .82,    .79,    .76,    .735,    &
     & .71,    .685,   .66,                                             &
     & 1.,     .92,    .87,    .825,   .79,    .755,   .728,   .7,      &
     & .678,   .655,   .632 /
!
!              FIGURE 4.1.3.2-56G (CNA/A) FOR A*BETA LESS THAN 1.0
!
      DATA G13246/0.,.2,.4,.45,.5,.6,.8,.9,1.0/
      DATA DG3246/1.61,1.58,1.55,1.57,1.62,1.75,1.94,2.0,2.0/
!
!              FIGURE 4.1.3.2-56A-F (WING SUPERSONIC CNA)
!
      DATA T13246                                                       &
     &  / 0.,.1,.2,.3,.33,.4,.5,.6,.7,.8,.9,1.0,1.111,1.25,1.429,1.667, &
     &    2.0,2.5,2.941,4.167,7.143,14.286, 30. ,                       &
     &    .25,.5,1.,2.,3.,4.,5.,6. , 15*0.,                             &
     &    0.,.2,.25,.3333,.5,1.0/
!
!     FIG 4.1.3.2-56A
!
      DATA DUMY1                                                        &
     &  /  .39, .39, .39, .39, .39, .39, .39, .39, .39, .39, .39, .41,  &
     &     .44, .5 , .58, .65, .80,1.0 ,1.15,1.55,2.40,3.92,4.0 ,       &
     &     .77, .77, .78, .78, .79, .79, .80, .80, .80, .81, .82, .84,  &
     &     .92,1.0 ,1.18,1.32,1.60,1.9 ,2.18,2.80,3.84,3.92,4.0 ,       &
     &    1.55,1.56,1.57,1.57,1.59,1.59,1.60,1.63,1.66,1.68,1.70,1.75,  &
     &    1.88,2.09,2.30,2.6 ,2.94,3.35,3.70,3.80,3.98,3.98,4.0 ,       &
     &    3.15,3.15,3.15,3.15,3.15,3.15,3.17,3.19,3.23,3.27,3.33,3.4 ,  &
     &    3.46,3.54,3.60,3.7 ,3.75,3.8 ,3.86,3.91,4.0 ,4.0 ,4.0 ,       &
     &    4.71,4.74,4.83,5.09,5.25,5.05,4.80,4.55,4.30,4.09,3.90,3.72,  &
     &    3.78,3.8 ,3.83,3.88,3.90,3.94,3.92,3.96,4.0 ,4.0 ,4.0 ,       &
     &    6.29,6.2 ,5.99,5.72,5.61,5.42,5.18,4.9 ,4.64,4.42,4.2 ,4.0 ,  &
     &    4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,       &
     &    6.3 ,6.34,6.39,6.08,5.97,5.78,5.5 ,5.2 ,4.95,4.7 ,4.48,4.25,  &
     &    4.2 ,4.18,4.14,4.11,4.07,4.05,4.04,4.02,4.  ,4.  ,4.  ,       &
     &    6.32,6.4 ,6.4 ,6.34,6.32,6.13,5.82,5.51,5.25,4.99,4.73,4.5 ,  &
     &    4.4 ,4.32,4.27,4.2 ,4.13,4.11,4.07,4.04,4.  ,4.  ,4.  /
!
!     FIG 4.1.3.2-56B
!
      DATA DUMY2                                                        &
     &  /  .41, .41, .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .41,  &
     &     .41, .48, .56, .67, .84,1.08,1.29,1.83,2.80,3.8 ,4.0 ,       &
     &     .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .83, .85,  &
     &     .98,1.09,1.27,1.48,1.80,2.25,2.53,3.22,3.79,3.92,4.  ,       &
     &    1.57,1.59,1.6 ,1.6 ,1.6 ,1.61,1.63,1.65,1.69,1.73,1.77,1.8 ,  &
     &    2.  ,2.26,2.57,2.9 ,3.27,3.53,3.65,3.8 ,3.91,3.97,4.  ,       &
     &    3.17,3.17,3.22,3.4 ,3.5 ,3.6 ,3.7 ,3.67,3.58,3.49,3.37,3.23,  &
     &    3.38,3.52,3.62,3.71,3.80,3.88,3.9 ,3.95,3.97,3.99,4.0 ,       &
     &    4.72,5.  ,5.1 ,5.02,4.97,4.84,4.64,4.45,4.24,4.05,3.89,3.70,  &
     &    3.84,3.91,3.97,3.99,4.0 ,4.  ,4.  ,4.  ,3.99,4.  ,4.  ,       &
     &    5.57,5.6 ,5.62,5.61,5.6 ,5.42,5.15,4.91,4.7 ,4.48,4.25,4.08,  &
     &    4.13,4.18,4.16,4.11,4.09,4.05,4.02,4.01,4.  ,4.  ,4.  ,       &
     &    5.73,5.77,5.79,5.79,5.77,5.75,5.6 ,5.33,5.08,4.83,4.59,4.4 ,  &
     &    4.42,4.4 ,4.32,4.23,4.17,4.08,4.05,4.03,4.01,4.  ,4.  ,       &
     &    5.83,5.88,5.91,5.93,5.93,5.91,5.88,5.68,5.4 ,5.14,4.9 ,4.7 ,  &
     &    4.68,4.59,4.46,4.33,4.23,4.13,4.1 ,4.06,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56C
!
      DATA DUMY3                                                        &
     &  /  .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .42,  &
     &     .43, .5 , .6 , .71, .9 ,1.12,1.35,1.97,2.95,3.80,4.  ,       &
     &     .8 , .8 , .8 , .8 , .8 , .8 , .8 , .81, .82, .83, .83, .88,  &
     &     .95,1.06,1.23,1.46,1.83,2.3 ,2.65,3.32,3.76,3.92,4.  ,       &
     &    1.59,1.59,1.59,1.59,1.59,1.6 ,1.62,1.65,1.68,1.72,1.78,1.82,  &
     &    2.  ,2.29,2.65,3.  ,3.27,3.5 ,3.6 ,3.78,3.90,3.98,4.  ,       &
     &    3.14,3.2 ,3.41,3.62,3.68,3.75,3.7 ,3.62,3.51,3.42,3.3 ,3.18,  &
     &    3.34,3.5 ,3.6 ,3.7 ,3.8 ,3.85,3.88,3.93,3.98,4.0 ,4.  ,       &
     &    4.7 ,4.85,5.02,4.98,4.91,4.8 ,4.6 ,4.4 ,4.2 ,4.  ,3.82,3.68,  &
     &    3.8 ,3.9 ,3.98,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    5.4 ,5.44,5.45,5.45,5.42,5.35,5.12,4.9 ,4.69,4.48,4.22,4.02,  &
     &    4.12,4.18,4.17,4.15,4.1 ,4.05,4.04,4.01,4.  ,4.  ,4.  ,       &
     &    5.61,5.63,5.64,5.62,5.61,5.6 ,5.54,5.3 ,5.02,4.8 ,4.6 ,4.39,  &
     &    4.42,4.44,4.38,4.26,4.16,4.1 ,4.07,4.03,4.01,4.  ,4.  ,       &
     &    5.72,5.75,5.76,5.78,5.77,5.76,5.72,5.69,5.4 ,5.15,4.9 ,4.68,  &
     &    4.68,4.6 ,4.49,4.33,4.22,4.15,4.10,4.06,4.02,4.01,4.  /
!
!      FIG 4.1.3.2-56D
!
      DATA DUMY4                                                        &
     &  /  .41, .41, .41, .41, .41, .41, .41, .41, .41, .41, .41, .41,  &
     &     .43, .50, .6 , .71, .89,1.11,1.35,2.00,3.00,3.72,4.00,       &
     &     .82, .82, .81, .8 , .8 , .81, .82, .83, .84, .85, .87, .89,  &
     &     .98,1.1 ,1.3 ,1.5 ,1.82,2.23,2.68,3.3 ,3.7 ,3.91,4.  ,       &
     &    1.6 ,1.59,1.58,1.58,1.58,1.59,1.60,1.62,1.66,1.73,1.81,1.92,  &
     &    2.2 ,2.45,2.7 ,2.98,3.22,3.45,3.59,3.75,3.7 ,3.91,4.  ,       &
     &    3.13,3.18,3.32,3.6 ,3.64,3.72,3.70,3.64,3.54,3.45,3.3 ,3.14,  &
     &    3.32,3.48,3.6 ,3.7 ,3.79,3.87,3.9 ,3.95,3.99,4.  ,4.  ,       &
     &    4.71,4.76,4.8 ,4.83,4.84,4.7 ,4.53,4.34,4.18,4.  ,3.82,3.63,  &
     &    3.78,3.9 ,3.98,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    5.2 ,5.22,5.22,5.2 ,5.2 ,5.15,5.1 ,4.88,4.63,4.42,4.21,4.0 ,  &
     &    4.15,4.21,4.21,4.17,4.14,4.07,4.05,4.03,4.01,4.  ,4.  ,       &
     &    5.45,5.47,5.47,5.45,5.45,5.41,5.36,5.3 ,5.02,4.81,4.58,4.36,  &
     &    4.45,4.47,4.41,4.30,4.19,4.12,4.08,4.02,4.  ,4.  ,4.  ,       &
     &    5.58,5.59,5.59,5.59,5.59,5.58,5.57,5.53,5.41,5.14,4.91,4.65,  &
     &    4.7 ,4.65,4.53,4.4 ,4.27,4.16,4.12,4.05,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56E
!
      DATA DUMY5                                                        &
     & /   .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 ,  &
     &     .44, .52, .63, .78, .98,1.21,1.4 ,2.07,3.07,3.6 ,4.  ,       &
     &     .8 , .8 , .79, .79, .79, .79, .8 , .81, .83, .85, .88, .9 ,  &
     &    1.01,1.17,1.38,1.62,2.00,2.50,2.74,3.22,3.66,3.87,4.  ,       &
     &    1.58,1.59,1.62,1.71,1.76,1.77,1.8 ,1.85,1.88,1.91,1.92,1.93,  &
     &    2.13,2.4 ,2.6 ,2.88,3.12,3.39,3.51,3.71,3.87,3.99,4.  ,       &
     &    3.15,3.21,3.38,3.61,3.7 ,3.67,3.59,3.5 ,3.4 ,3.29,3.17,3.03,  &
     &    3.18,3.37,3.51,3.67,3.78,3.85,3.88,3.93,3.98,4.  ,4.  ,       &
     &    4.42,4.42,4.41,4.40,4.39,4.38,4.35,4.25,4.08,3.9 ,3.72,3.57,  &
     &    3.70,3.86,3.93,3.99,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    4.88,4.85,4.81,4.80,4.79,4.77,4.73,4.68,4.53,4.35,4.15,3.99,  &
     &    4.08,4.20,4.23,4.19,4.1 ,4.07,4.05,4.01,4.  ,4.  ,4.  ,       &
     &    5.08,5.09,5.08,5.08,5.07,5.06,5.03,4.99,4.92,4.74,4.53,4.3 ,  &
     &    4.43,4.48,4.43,4.32,4.20,4.12,4.08,4.03,4.01,4.  ,4.  ,       &
     &    5.19,5.21,5.22,5.23,5.23,5.23,5.23,5.21,5.19,5.09,4.88,4.6 ,  &
     &    4.72,4.69,4.58,4.41,4.28,4.18,4.12,4.07,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56F
!
      DATA DUMY6                                                        &
     & /   .4 , .4 , .4 , .4 , .4 , .41, .44, .49, .51, .54, .59, .61,  &
     &     .69, .75, .81, .9 ,1.01,1.26,1.53,2.1 ,2.9 ,3.42,4.  ,       &
     &     .81, .81, .81, .83, .84, .86, .88, .91, .99,1.02,1.1 ,1.19,  &
     &    1.3 ,1.42,1.58,1.75,2.  ,2.34,2.6 ,3.  ,3.46,3.71,4.   ,      &
     &    1.6 ,1.58,1.59,1.6 ,1.6 ,1.61,1.67,1.7 ,1.79,1.86,1.92,2.  ,  &
     &    2.13,2.32,2.51,2.75,2.97,3.2 ,3.35,3.58,3.8 ,3.9 ,4.  ,       &
     &    3.13,3.1 ,3.08,3.05,3.04,3.03,3.01,2.99,2.95,2.93,2.91,2.89,  &
     &    3.02,3.2 ,3.37,3.52,3.67,3.77,3.82,3.88,3.92,3.97,4.  ,       &
     &    3.79,3.84,3.86,3.8 ,3.79,3.72,3.63,3.58,3.5 ,3.47,3.43,3.41,  &
     &    3.57,3.75,3.89,3.98,4.  ,3.98,3.94,3.93,3.92,3.99,4.  ,       &
     &    4.12,4.2 ,4.19,4.09,4.06,4.03,3.99,3.95,3.92,3.9 ,3.88,3.87,  &
     &    4.01,4.1 ,4.21,4.21,4.12,4.05,4.  ,3.96,3.99,4.  ,4.  ,       &
     &    4.39,4.45,4.44,4.39,4.35,4.31,4.27,4.25,4.25,4.25,4.25,4.25,  &
     &    4.37,4.50,4.49,4.39,4.23,4.1 ,4.03,3.99,4.  ,4.  ,4.  ,       &
     &    4.6 ,4.68,4.65,4.59,4.57,4.54,4.5 ,4.45,4.48,4.53,4.59,4.61,  &
     &    4.71,4.75,4.69,4.5 ,4.31,4.18,4.08,4.01,4.  ,4.  ,4.  /
!
!              FIGURE 4.1.3.2-61 (KL)
!
      DATA T13251/.015,.03,.05,.075,.11,.16,.23,.45,.90,1.2,1.7,2.0/
      DATA D13251/.963,.94,.92,.90,.88,.86,.84,.80,.76,.74,.72,.709/
!
!              FIGURE 4.1.3.2-63 WING SUPERSONIC NORMAL-FORCE-CURVE
!              SLOPE, TAPER RATIO ZERO
!
      DATA T13253                                                       &
     &  / .0,.2,.4,.6,.8,1.,1.2,1.4,1.6,1.8,2.,2.4,2.8,3.2 ,            &
     &     -1.0, -0.8, -0.6, -0.4, -0.2, 0.0, 0.2, 0.4, 0.6, 0.8 /
      DATA D13253                                                       &
     &  / 1.57 ,1.69 ,1.752,1.78 ,1.774,1.7  ,1.472,1.288,1.15 ,1.034,  &
     &     .938, .795, .69 , .605,                                      &
     &    1.57 ,1.708,1.76 ,1.778,1.727,1.56 ,1.35 ,1.18 ,1.047, .947,  &
     &     .86 , .72 , .617, .543,                                      &
     &    1.57 ,1.708,1.77 ,1.737,1.575,1.418,1.233,1.07 , .94 , .842,  &
     &     .768, .646, .558, .49 ,                                      &
     &    1.57 ,1.708,1.763,1.618,1.442,1.278,1.104, .955, .845, .758,  &
     &     .68 , .57 , .49 , .428,                                      &
     &    1.57 ,1.708,1.548,1.41 ,1.275,1.133, .98 , .84 , .738, .66 ,  &
     &     .594, .495, .425, .37 ,                                      &
     &    1.57 ,1.49 ,1.367,1.245,1.12 , .995, .845, .725, .628, .555,  &
     &     .5  , .423, .363, .312,                                      &
     &    1.254,1.273,1.169,1.062, .958, .848, .7  , .59 , .518, .465,  &
     &     .415, .345, .29 , .253,                                      &
     &     .94 , .943, .948, .875, .788, .695, .55 , .465, .404, .36 ,  &
     &     .325, .268, .227, .196,                                      &
     &     .62 , .623, .63 , .648, .597, .537, .403, .335, .287, .25 ,  &
     &     .22 , .18 , .15 , .13 , .31 , .315, .327, .347, .391, .35 ,  &
     &     .23 , .177, .147, .129, .112, .09 , .073, .062 /
!
!              FIGURE 4.1.3.2-62 LEADING-EDGE-EFFECT FACTORS FOR NORMAL-
!                                FORCE-CURVE SLOPE AT SUPERSONIC SPEEDS
!              FIGURE 4.1.3.2-62 (ROUND LEADING EDGE)
!
      DATA R13252                                                       &
     & / 0., .5, .94, 1., 1.05, 1.5, 2., 2.5, 3., 3.5, 4., 20./
      DATA DRND52                                                       &
     & / 1.043, .97, .893, .89, .894, .987, 1.005, 1.02, 1.025, 1.03,   &
     & 1.034, 1.034 /
!
!              FIGURE 4.1.3.2-62 (SHARP LEADING EDGE)
!
      DATA S13252                                                       &
     & / 0., .5, .94, 1., 1.05, 1.5, 2., 2.5, 3., 3.5, 4., 20./
      DATA DSHP52                                                       &
     & / 1.08, 1.013, .94, .942, .948, 1.005, 1.03, 1.04, 1.048, 1.05,  &
     & 1.055, 1.055 /
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
      AR=2.*AR
      MACH=FLC(I+2)
      BETA=SQRT(MACH**2-1.)
      IF(TANLEO.EQ.0.0)TANLEO=.00001
      IF(TANLEI.EQ.0.0)TANLEI=.00001
      IF(VTIN(15).NE.WTYPE(1)) GO TO 1100
!
!       **STRAIGHT TAPERED SUPERSONIC NORMAL FORCE SLOPE**
!
      BOVERT=BETA/TANLE
      CA=COSLE
      IF( BOVERT.GT.1.0)GO TO 1000
      SUPLE=.FALSE.
      GO TO 1010
 1000 SUPLE=.TRUE.
 1010 CONTINUE
!
!                   FIGURE 4.1.3.2-60A (CNA/CNA)T FOR SUBSONIC L.E.
!
      DELTYT=DELTAY/CA
 1020 IF(SUPLE)GO TO 1030
      VAB(1)=BOVERT
      VAB(2)=DELTYT
      LGB(1)=9
      LGB(2)=8
      CALL INTERX(2,A1350,VAB,LGB,DA50,CNCNT,9,72,                      &
     &            2,2,0,0,0,2,0,0,Q3250A,3,ROUTID)
      GO TO 1040
!
!                   FIGURE 4.1.3.2-60B (CNA/CNA)T FOR SUPERSONIC L.E.
!
 1030 CONTINUE
      ARG=DELTAY/(5.85*CA)
      DELTDT=ATAN(ARG)*RAD
      VAB(1)=1./BOVERT
      VAB(2)=DELTDT
      LGB(1)=11
      LGB(2)=8
      CALL INTERX(2,B1350,VAB,LGB,DB50,CNCNT,11,88,                     &
     &            2,2,0,0,0,2,0,0,Q3250B,3,ROUTID)
 1040 IF(TRATIP.EQ.1.0.AND.SWEPLE.EQ.0.0) GO TO 1060
!
!                   NON-RECTANGULAR WING ANALYSIS
!                   FIGURES 4.1.3.2-56A THROUGH F
!
 1050 VAA(1)=BOVERT
      VAA(2)=AR *TANLE
      VAA(3)=TAPEXP
      LGA(1)=23
      LGA(2)=8
      LGA(3)=6
      CALL INTERX(3,T13246,VAA,LGA,D13246,BCNA,23,1104,                 &
     &            0,2,0,0,0,2,0,0,Q3246A,3,ROUTID)
      IF(SUPLE)GO TO 1080
      CNTHRY=BCNA/TANLE
      GO TO 1090
 1060 CONTINUE
!
!                        RECTANGULAR WING ANALYSIS
!
      IF(AR *BETA.GT.1.0)GO TO 1070
!
!                        FIGURE 4.1.3.2-56G(CNA/A)
!
      VAB(1)=AR *BETA
      LGB(1)=9
      CALL INTERX(1,G13246,VAB,LGB,DG3246,CNAA,9,9,                     &
     &            0,0,0,0,0,0,0,0,Q3246G,3,ROUTID)
      CNTHRY=CNAA*AR
      GO TO 1090
 1070 BCNA= 4.-2.*(1./(AR *BETA))
 1080 CNTHRY=BCNA/BETA
 1090 CNA=CNTHRY*CNCNT*SRSTAR/(SW*RAD)
      AR=AR/2.
      RETURN
!
!    ***SUPERSONIC NORMAL FORCE SLOPE,NON-STRAIGHT TAPERED WINGS***
!                    BASIC WING COMPONENT
!
 1100 CONTINUE
      SPANIN=SPANS-SPANO
      CRBW=CB+SPANIN*(TANLEO-TANTEO)
      SBW=(CRBW+CT)*SPANS
      ARBW=4.*SPANS**2/SBW
      TAPBW=CT/CRBW
      BOVERT=BETA/TANLEO
      SUPLE=.FALSE.
      IF(BOVERT.GT.1.)SUPLE=.TRUE.
!
!                   FIGURE 4.1.3.2-56A-F (CNABW)
!
      VAB(1)=BOVERT
      VAB(2)=ARBW*TANLEO
      VAB(3)=TAPBW
      GLOVE=.FALSE.
      TA=TANLEO
 1110 LGB(1)=23
      LGB(2)=8
      LGB(3)=6
      CALL INTERX(3,T13246,VAB,LGB,D13246,BCNA,23,1104,                 &
     &            0,2,0,0,0,2,0,0,Q246AF,4,ROUTID)
      CNTHRY=BCNA/TA
      IF(SUPLE)CNTHRY=BCNA/BETA
!
!                   LEADING-EDGE-EFFECT PARAMETERS
!              FIGURE 4.1.3.2-62 (CLE)BW
!
      ROUND=.FALSE.
      IF(KSHARP.EQ.UNUSED)ROUND=.TRUE.
      VAB(1)=BOVERT
      LGB(1)=12
!
!              SHARP LEADING EDGE
!
      IF(ROUND)GO TO 1120
      CALL INTERX(1,S13252,VAB,LGB,DSHP52,CLE  ,12,12,                  &
     &            0,0,0,0,0,0,0,0,Q13252,3,ROUTID)
      GO TO 1130
!
!              ROUND LEADING EDGE
!
 1120 CALL INTERX(1,R13252,VAB,LGB,DRND52,CLE  ,12,12,                  &
     &            0,0,0,0,0,0,0,0,Q13252,3,ROUTID)
 1130 IF(GLOVE)GO TO 1160
      CNTBW=CNTHRY
      CLEBW=CLE
      IF(TANLEO.GE.TANLEI)GO TO 1140
      CNABW=CNTBW*SBW/SW *CLEBW
      GO TO 1150
 1140 CONTINUE
      S2=SPANIN**2*TANLEO
      A2=4.*SPANIN**2/S2
      VAB(2)=A2*TANLEO
      VAB(3)=0.0
      CALL INTERX(3,T13246,VAB,LGB,D13246,BCNA,23,1104,                 &
     &            0,2,0,0,0,2,0,0,Q246AF,4,ROUTID)
      CNT2=BCNA/BETA
      IF(VAB(1).GT.1.)CNT2  =BCNA/TANLEO
      CNABW=(CNTHRY*SBW/SW-CNT2  *  S2/SW )*CLEBW
 1150 CONTINUE
!
!                        GLOVE COMPONENT
!
      CRGLV=TANLEI*SPANIN
      SGLV=CRGLV*SPANIN
      ARGLV=4.*SPANIN**2/SGLV
      VAB(1)=BETA/TANLEI
      VAB(2)=ARGLV*TANLEI
      VAB(3)=0.0
      GLOVE=.TRUE.
      BOVERT=VAB(1)
      SUPLE=.FALSE.
      TA=TANLEI
      IF(BOVERT.GT.1.)SUPLE=.TRUE.
      GO TO 1110
 1160 CONTINUE
      CLEGLV=CLE
      CNAGLV=CNTHRY*CLEGLV*SGLV/SW
!
!              FIGURE 4.1.3.2-63 (CN1=CNA/A)
!                        EXTENSION COMPONENT
!
      IF(ABS(SWTEI-SWTEO).LT.4.)GO TO 1170
      BE= 2.*SPANIN
      VAB(1)=BETA/TANLEI
      VAB(2)=TANTEI/TANLEI
      LGB(1)=14
      LGB(2)=10
      CALL INTERX(2,T13253,VAB,LGB,D13253,CN1,14,140,                   &
     &            2,2,0,0,2,2,0,0,Q13253,3,ROUTID)
      VAB(2)=TANTEO/TANLEI
      CALL INTERX(2,T13253,VAB,LGB,D13253,CN2,14,140,                   &
     &            2,2,0,0,2,2,0,0,Q13253,3,ROUTID)
      CNAE=(CN1-CN2)*BE**2/SW
      GO TO 1180
 1170 CNAE=0.0
!
!   **SUPERSONIC NORMAL FORCE SLOPE,NON-STRAIGHT TAPERED WINGS,TOTAL WIN
!
 1180 CONTINUE
!
!              FIGURE 4.1.3.2-61
!
      VAB(1)=CNAGLV/(CLEGLV*BETA)
      LGB(1)= 12
      CALL INTERX(1,T13251,VAB,LGB,D13251,RKL,12,12,                    &
     &            2,0,0,0,2,0,0,0,Q13251,3,ROUTID)
      CNA=RKL*(CNABW+CNAGLV+CNAE)/RAD
      AR=AR/2.
      RETURN
      END
      SUBROUTINE VNAME(KOL,L,LEN,NUM,NAMES,I,FOUND,ARRAY,               &
     &            NDMS,NF,NUMBER,BLANK,EQUAL)
      DIMENSION KOL(1), LEN(1), NAMES(1), NUMBER(1)
      INTEGER  PARL, PARR, EQUAL, BLANK
      LOGICAL FOUND, ARRAY, NMTEST, FLAG
      DATA PARL, PARR /4H(   ,4H)    /
!
!***  TEST FOR VARIABLE NAME
!
      J = 1
      DO 1010 I=1,NUM
      IF(.NOT. NMTEST(KOL(L),NAMES(J),LEN(I))) GO TO 1000
      K = L+LEN(I)
      FLAG = (KOL(K) .EQ. BLANK) .OR. (KOL(K) .EQ. EQUAL) .OR.          &
     &       (KOL(K) .EQ. PARL)
      IF(FLAG) GO TO 1020
 1000 J = J+LEN(I)
 1010 END DO
      FOUND = .FALSE.
      I = 0
      GO TO 1080
!
!***  DETERMINE IF NAME IS AN ARRAY, CHECK FOR ARRAY ELEMENT
!***  DESIGNATION, AND CHECK NAME DELIMITERS
!
 1020 CONTINUE
      FOUND = .TRUE.
      ARRAY = .FALSE.
      L = L+LEN(I)
      NDMS = 0
      IF(KOL(L) .NE. PARL) GO TO 1080
        ARRAY = .TRUE.
        L = L+1
 1030   DO 1040 J=1,10
        IF(L .GE. 79) GO TO 1065
        IF(KOL(L) .EQ. NUMBER(J)) GO TO 1060
        IF(KOL(L) .EQ. PARR)      GO TO 1070
 1040   CONTINUE
        NF = NF+1
 1050   L = L+1
        IF(KOL(L) .EQ. EQUAL) GO TO 1080
        GO TO 1050
 1060   NDMS = 10*NDMS+J-1
        L = L+1
        GO TO 1030
 1065   CONTINUE
        IF(KOL(L) .NE. PARR) NF = NF+1
 1070   CONTINUE
        L = L+1
        NDMS = NDMS-1
        IF(NDMS .GE. 0) GO TO 1080
        NF = NF+1
        NDMS = 0
 1080 CONTINUE
      RETURN
      END
      SUBROUTINE VRTCDO(I)
!
! *** CALCULATES SUPERSONIC VERTICAL TAIL ZERO LIFT DRAG COEFFICIENT
!
      REAL MACH,LERBW,LERO,LERI,KSHARP
      DIMENSION ROUTID(2)
      DIMENSION Q15127(4)
      DIMENSION WTYPE(4),CN(20),CAV(20),CDJWB(20), CLJWB(20),CD(20)
      DIMENSION X27M(4),X27I(4),C27(6)
!
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
      COMMON /VTI/    CT,SPANO,SPANS,SSPN,CB,CR,SAVSI,SAVSO,            &
     &                CHSTAT,SWAFP,TWISTA,SSPNDD,DHDADI,DHDADO,TYPE,    &
     &                TOVC,DELTAY,XOVC,CLI,ALPHAI,CLALPA(20),           &
     &                CLMAX(20),CMO,LERI,LERO,CAMBER,TOVCO,XOVCO,CMOT,  &
     &                CLMAXL,CLAMO,TCEFF,KSHARP,SVWB(20),SVB(20),       &
     &                SVHB(20),TVTIN(8)
      COMMON /WINGD/  A(195)
      COMMON /VTDATA/ AVT(195)
      COMMON /WBHCAL/ STP(156)
      COMMON /IBW/    PBW, BW(380)
      COMMON /IBWV/   PBWV, BWV(380)
      COMMON /FLGTCD/ FLC(160)
!
      EQUIVALENCE (CDO,STP(1)),(CD(1),BWV(1)),(CN(1),BWV(61))
      EQUIVALENCE (CAV(1),BWV(81))
      EQUIVALENCE (CBARI,AVT(15)),(RNFS,A(129)),(SRSTAR,AVT(3))
      EQUIVALENCE (CBARO,AVT(17)),(SISTAR,AVT(1)),(SOSTAR,AVT(2))
      EQUIVALENCE (TANLEO,AVT(86)),(COSLEO,AVT(85)),(TANLEI,AVT(62))
      EQUIVALENCE (COSLE,AVT(61)),(TANTEO,AVT(104)),(CDJWB(1),BW(1))
      EQUIVALENCE (CLJWB(1),BW(21))
!
      DATA ROUTID /4HVRTC,4HDO  /
      DATA Q15127 /4H4.1.,4H5.1-,4H27  ,4HCEPT/
      DATA WTYPE  /4HSTRA,4HDOUB,4HCRAN,4HCURV/
      DATA X27M   /0.0, 1.0, 2.0, 3.0/
      DATA X27I   /1.57780,1.67221,1.98509,2.28874/
      DATA I27    /0/
!
      MACH=FLC(I+2 )
      BETA=SQRT(MACH**2-1.0)
!
!  ***WING SUPERSONIC ZERO-LIFT SKIN FRICTION DRAG,STRAIGHT TAPERED WING
!
      IF(TYPE.NE.WTYPE(1))GO TO 1020
      CBAR=CBARI
 1000 RNN=CBAR*RNFS
      IF(RUFF.EQ.0.0)GO TO 1010
      ARG=12.*CBAR/RUFF
!
!                   FIGURE 4.1.5.1-27 (EQUATION FOR RLCOFF)
!
      RACH = MACH
      IF(RACH.GT.3.0)RACH=3.0
      CALL TBFUNX(RACH,CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,             &
     &            0,0,Q15127,4,ROUTID)
      RLCOFF=ARG**1.0482*10.0**CEPT
      IF(RLCOFF.LT.RNN)RNN=RLCOFF
 1010 CALL FIG26(RNN,RACH,CF)
      IF(TYPE.NE.WTYPE(1))GO TO 1030
      CDF=CF*SRSTAR/SR*2.
      GO TO 1050
!
!  ***WING SUPERSONIC ZERO-LIFT SKIN FRICTION DRAG,NON-STRAIGHT WING***
!
 1020 CONTINUE
      CBAR=CBARI
      GO TO 1000
 1030 CONTINUE
      IF(CBAR.EQ.CBARO)GO TO 1040
      RNI=RNN
      CFI=CF
      CBAR=CBARO
      GO TO 1000
 1040 RNO=RNN
      CFO=CF
      CDF=(CFI*SISTAR+CFO*SOSTAR)/SR*2.
 1050 CONTINUE
!
!   ***SUPERSONIC WING ZERO-LIFT WAVE DRAG,SHARP L.E.,ALL PLANFORMS***
!
      IF(TYPE.EQ.WTYPE(1))GO TO 1060
      TA=TANLEO
      SPANIN=SPANS-SPANO
      CRBW=CB+SPANIN*(TANLEO-TANTEO)
      SBW=(CRBW+CT)*SPANS*0.50
      S=SBW
      CA=COSLEO
      LERBW=LERO*((CR+CT+2.*CB)/4.)
      GO TO 1070
 1060 TA=TANLEI
      IF(ABS(TA) .LT. UNUSED) TA = UNUSED
      S=(CR+CT)/2.*SSPN
      CA =COSLE
      LERBW=LERI*((CR+CT)/2.)
 1070 CONTINUE
      BOVERT=BETA/TA
      IF(KSHARP.EQ.UNUSED)GO TO 1080
      ARG=KSHARP*TCEFF**2*S  /SR
      CDW=ARG/BETA
      IF(BOVERT.LT.1.)CDW=ARG/TA
      GO TO 1090
 1080 CONTINUE
!
!  ***SUPERSONIC WING ZERO-LIFT WAVE DRAG,ROUND L.E.,ALL PLANFORMS***
!
      ARG1=1.28*MACH**3*CA    **6/(1.+MACH**3*CA    **3)
      ARG2=2.* LERBW * SPANS /(SR*CA)
      CDLE=ARG1*ARG2
      ARG=     16.*TCEFF**2*S  /(3.*SR)
      IF(BOVERT.GE.1.)CDW=CDLE+ARG/BETA
      IF(BOVERT.LT.1.)CDW=CDLE+ARG/TA
 1090 CONTINUE
      CDO=CDF+CDW
      IF(TYPE.NE.WTYPE(1))RETURN
      DO 1100 J=1,NALPHA
         CD(J)=CD(J)+CDO
         COSA=COS(FLC(J+22)/RAD)
         SINA=SIN(FLC(J+22)/RAD)
         CN(J)=CLJWB(J)*COSA+CD(J)*SINA
 1100 CAV(J)=CD(J)*COSA-CLJWB(J)*SINA
      RETURN
      END
      SUBROUTINE VTAREA(VTIN,AVT,VERTUP,XV,ZV)
!
! *** EXECUTIVE TO COMPUTE VERTICAL TAIL AREA SHADOWED BY MACH LINES
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG
      COMMON /WINGD/  A(195)
      COMMON /HTDATA/ AHT(195)
      COMMON /WINGI/  WINGIN(100)
      COMMON /HTI/    HTIN(154)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(73), dumflgtcd(87)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
      LOGICAL EFFECT,VERTUP
      LOGICAL HTAIL,FLIP,ANGCHG
      DIMENSION XP(5),YP(5),XX(4),YY(4),AA(3),XI(4),YI(4),SVWB(2),      &
     &          SVHB(2),AREA(2),X(5),Y(5)
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC
      DIMENSION VTIN(154),AVT(195)
      DATA STRA/4HSTRA/
!
      HTAIL=.FALSE.
      ANGCHG=.FALSE.
      NCON=0
      SVWB(1)=0.
      SVWB(2)=0.
      SVHB(1)=0.
      SVHB(2)=0.
!
!     COORDINATES OF INBOARD VT PANEL
!
 1000 XP(1)=XV+(VTIN(4)-VTIN(3))*AVT(62)
      YP(1)=VTIN(4)-VTIN(3)+ZV
      IF(.NOT.VERTUP) YP(1)=VTIN(4)-VTIN(3)-ZV
      XP(2)=XV+AVT(21)*AVT(62)
      YP(2)=AVT(21)
      XP(3)=XP(2)+VTIN(5)
      YP(3)=AVT(21)
      XP(4)=XP(1)+AVT(10)
      YP(4)=YP(1)
      XP(5)=XP(1)
      YP(5)=YP(1)
      XMACH=FLC(I+2)
!
!     TEST FOR VT POSITION
!
      IF(VERTUP) GO TO 1020
      DO 1010 N=1,5
 1010 YP(N)=-YP(N)
      XMACH=-XMACH
 1020 AMUU=ATAN(1./SQRT(XMACH**2-1.))
!
!     CALCULATE LE AND TE MACH LINE INTERSECTIONS WITH VT PANEL
!
      DO 1220 J=1,2
         FLIP=.FALSE.
         IF(HTAIL) GO TO 1030
         AA(1)=SYNA(2)+(WINGIN(4)-WINGIN(3))*A(62)*COS(SYNA(4)/RAD)
         AA(2)=SYNA(3)-(AA(1)-SYNA(2))*SIN(SYNA(4)/RAD)/                &
     &         COS(SYNA(4)/RAD)
         AA(3)=SYNA(4)
         IF(J.EQ.1) GO TO 1050
         AA(1)=AA(1)+A(10)*COS(SYNA(4)/RAD)
         AA(2)=AA(2)-A(10)*SIN(SYNA(4)/RAD)
         GO TO 1050
 1030    IF(SYNA(4).EQ.SYNA(8).OR.ANGCHG) GO TO 1040
!
!     CALCULATE XH AND ZH FOR HT WITH INCIDINCE ANGLE EQUAL TO THAT OF
!     WING  (ROTATION ABOUT 1/4 MAC)
!
         HACLE=(HTIN(4)-HTIN(3))*AHT(62)+AHT(30)-AHT(16)/4.
         XHAC=SYNA(6)+HACLE*COS(SYNA(8)/RAD)
         ZHAC=SYNA(7)-HACLE*SIN(SYNA(8)/RAD)
         SYNA(6)=XHAC-HACLE*COS(SYNA(4)/RAD)
         SYNA(7)=ZHAC+HACLE*SIN(SYNA(4)/RAD)
         ANGCHG=.TRUE.
 1040    AA(1)=SYNA(6)+(HTIN(4)-HTIN(3))*AHT(62)*COS(SYNA(4)/RAD)
         AA(2)=SYNA(7)-(AA(1)-SYNA(6))*SIN(SYNA(4)/RAD)/                &
     &         COS(SYNA(4)/RAD)
         AA(3)=SYNA(4)
         IF(J.EQ.1) GO TO 1050
         AA(1)=AA(1)+AHT(10)*COS(SYNA(4)/RAD)
         AA(2)=AA(2)-AHT(10)*SIN(SYNA(4)/RAD)
 1050    CALL PTINT1(XP,YP,AA,AMUU,X,Y,XI,YI,NSUM,EFFECT,KK,J,NCON      &
     &              ,VERTUP)
!
!     CHECK FOR MACH LINE NOT INTERSECTING VT
!
         IF(J.NE.1) GO TO 1060
         IF(EFFECT) GO TO 1070
         GO TO 1230
 1060    IF(EFFECT) GO TO 1070
         AREA(J)=0.
         IF(KK.EQ.1) AREA(J)=AVT(1+NCON)-AREA(J)
         GO TO 1200
 1070    IF(NSUM.NE.0) GO TO 1080
         AREA(J)=0.
         IF(J.NE.1) FLIP=.TRUE.
         GO TO 1180
 1080    CONTINUE
         GO TO (1090,1100,1110,1120,1130,1150,1160) NSUM
 1090    CONTINUE
 1100    CONTINUE
!
!     HERE FOR MACH LINE INTERSECTING LE AND TIP CHORD
!
 1110    XX(1)=XI(1)
         XX(2)=X(2)
         XX(3)=XI(2)
         YY(1)=YI(1)
         YY(2)=Y(2)
         YY(3)=YI(2)
         GO TO 1170
!
!     HERE FOR MACH LINE INTERSECTING LE AND TE
!
 1120    XX(1)=XI(1)
         XX(2)=X(2)
         XX(3)=X(3)
         XX(4)=XI(3)
         YY(1)=YI(1)
         YY(2)=Y(2)
         YY(3)=Y(3)
         YY(4)=YI(3)
         IF(ABS(XI(1)).GT.ABS(XI(3))) FLIP=.TRUE.
         GO TO 1170
 1130    IF(KK.EQ.4) GO TO 1140
!
!     HERE FOR MACH LINE INTERSECTING TE AND TIP CHORD
!
         XX(1)=XI(2)
         XX(2)=X(3)
         XX(3)=XI(3)
         YY(1)=YI(2)
         YY(2)=Y(3)
         YY(3)=YI(3)
         FLIP=.TRUE.
         GO TO 1170
!
!     HERE FOR MACH LINE INTERSECTING ROOT CHORD AND LE
!
 1140    XX(1)=X(1)
         XX(2)=XI(1)
         XX(3)=XI(4)
         YY(1)=Y(1)
         YY(2)=YI(1)
         YY(3)=YI(4)
         GO TO 1170
!
!     HERE FOR MACH LINE INTERSECTING ROOT CHORD AND TIP CHORD
!
 1150    XX(1)=X(1)
         XX(2)=X(2)
         XX(3)=XI(2)
         XX(4)=XI(4)
         YY(1)=Y(1)
         YY(2)=Y(2)
         YY(3)=YI(2)
         YY(4)=YI(4)
         GO TO 1170
!
!     HERE FOR MACH LINE INTERSECTING ROOT CHORD AND TE
!
 1160    XX(1)=XI(3)
         XX(2)=X(4)
         XX(3)=XI(4)
         YY(1)=YI(3)
         YY(2)=Y(4)
         YY(3)=YI(4)
         FLIP=.TRUE.
 1170    CALL AREA1 (XX,YY,SAREA,NSUM)
         AREA(J)=SAREA
 1180    IF(J.NE.1) GO TO 1190
         IF(.NOT.FLIP) GO TO 1220
         AREA(1)=AVT(1+NCON)-AREA(1)
         GO TO 1220
 1190    IF(FLIP) GO TO 1200
         AREA(2)=AVT(1+NCON)-AREA(2)
 1200    IF(.NOT.HTAIL) GO TO 1210
         SVHB(1+NCON)=AVT(1+NCON)-(AREA(1)+AREA(2))
         GO TO 1220
 1210    SVWB(1+NCON)=AVT(1+NCON)-(AREA(1)+AREA(2))
 1220 END DO
      IF(NCON.EQ.1) GO TO 1230
      NCON=1
!
!     TEST FOR NON-STRAIGHT TAPERED VT
!
      IF(VTIN(15).EQ.STRA) GO TO 1230
!
!     COORDINATES OF OUTBOARD VT PANEL
!
      XP(1)=XP(2)
      YP(1)=YP(2)
      XP(2)=XP(2)+VTIN(2)*AVT(86)
      YP(2)=VTIN(4)
      XP(3)=XP(2)+VTIN(1)
      YP(3)=VTIN(4)
      XP(4)=XP(1)+VTIN(5)
      YP(4)=YP(1)
      XP(5)=XP(1)
      YP(5)=YP(1)
      GO TO 1020
 1230 IF(.NOT.HTAIL) GO TO 1240
      VTIN(134+I)=SVHB(1)+SVHB(2)
      GO TO 1250
 1240 VTIN(94+I)=SVWB(1)+SVWB(2)
 1250 CONTINUE
      IF(HTAIL) GO TO 1260
!
!     TEST FOR HT
!
      IF(.NOT.HTPL) GO TO 1260
      HTAIL=.TRUE.
      NCON=0
      GO TO 1000
 1260 VTIN(114+I)=AVT(3)-(VTIN(94+I)+VTIN(134+I))
      RETURN
      END
      SUBROUTINE VTDRAG(I)
!
! *** CALCULATES VERTICAL DRAG COEFFICIENT
!
      DIMENSION ROUTID(2)
      DIMENSION Q15127(3),Q5128B(3),Q128BD(5)
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /WHAERO/ C2(51),D2(55),CHT2(51),DHT2(55),DVT(55)
      COMMON /VTDATA/ AVT(195)
      COMMON /VTI/    VT(100)
      DIMENSION D(55),A(195),B(93)
      EQUIVALENCE (A(1),AVT(1)),(D(1),DVT(1)),(B(1),FLC(1))
      DIMENSION WTYPE(4)
      DIMENSION X228BD(9),X128BD(4),Y28BD(36)
      DIMENSION X228B(11), X128B(4), Y28B(44)
      DIMENSION X27M(4),X27I(4),C27(6)
      DATA ROUTID/4HVTDR,4HAG  /
      DATA Q15127/4H4.1.,4H5.1-,4H27  /,Q5128B/4H4.1.,4H5.1-,4H28-B/,   &
     &     Q128BD/4H4.1.,4H5.1-,4H28-B,4H(DAS,4HHED)/
      DATA X27M /0.0,1.0,2.0,3.0/
      DATA X27I /1.57780,1.67221,1.98509,2.28874/
      DATA I27  /0/
!
!---------          FIGURE 4.1.5.1-28B            ----
!----     X228B=COS(SWEEP ANGLE(T/C)MAX)   X128B= MACH NUMBER
!----     Y28B= (R)LS
!
      DATA WTYPE / 4HSTRA ,4HDOUB ,4HCRAN ,4HCURV /
      DATA X228B /0.5,.55,.60,.65,.70,.75,.80,.85,.90,.95,1.0/
      DATA X128B /0.9,.80,.60,.25/
      DATA Y28B/ 1.1,1.13,1.17,1.20,1.24,1.27,1.3,1.33,1.34,1.35,1.36 , &
     &1.0,1.04,1.08,1.11,1.15,1.18,1.21,1.23,1.25,1.25,1.26 , 0.88, .92,&
     &.96,1.0,1.04,1.08,1.11,1.13,1.14,1.14,1.15 , 0.81,.85,.89,.925,   &
     &.96,1.0,1.03,1.05,1.06,1.06,1.07/
!
!---------          FIGURE 4.1.5.1-28B-DASHED     ---------
!----          X228BD= COS(T/C)MAX      X128BD= MACH NUMBER
!----          Y28BD= (R)LS
!
      DATA X228BD /0.45,.65,.70,.75,.80,.85,.90,.95,1.0/
      DATA X128BD /0.9,.80,.60,.25/
      DATA Y28BD  /1.20,1.20,1.24,1.27,1.30,1.33,1.34,1.35,1.36 , 1.11, &
     &1.11,1.15,1.18,1.21,1.23,1.25,1.25,1.26 , 1.0,1.0,1.04,1.08,1.11, &
     &1.13,1.14,1.14,1.15 , 0.925,0.925,.96,1.0,1.03,1.05,2*1.06,1.07/
!
      D(2)=12.0*A(16)/ROUGFC
!
!---------     DETERMINE WING CONFIGURATION       ----------------------
!              IF NOT STRAIGHT-TAPERED, GO TO PAGE 3-2
!
      IF(VT(15).NE.WTYPE(1)) GO TO 1010
!
!---------          PAGE 3-1 CALCULATIONS         ----------------------
!*********     FOR STRAIGHT-TAPER WING CONFIGURATION        ************
!---------     COMPUTE REYNOLDS NUMBER, (RN)
!
 1000 D(17)=A(16)*A(129)
!
!---------     COMPUTE RL FROM EQUATION FOR FIG.4.1.5.1-27
!*********          FIGURE 4.1.5.1-27 EQUATION
!
      CALL TBFUNX(B(I+2),CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,           &
     &            0,0,Q15127,3,ROUTID)
      D(14)=D(2)**1.0482*10.0**CEPT
!
!*********          FIGURE 4.1.5.1-26 EQUATIONS (SUBROUTINE FIG26 )
!
      IF( D(14).LT.D(17)) D(17)=D(14)
      CALL FIG26  (D(17),B(I+2),D(10) )
!
!*********          FIGURE 4.1.5.1-28-B
!
      CALL TLINEX(X128B,X228B,Y28B,4,11,B(I+2),A(178),D(13),            &
     &            0,2,0,2,Q5128B,3,ROUTID)
      CAPL=2.0
      IF(VT(18).GE.0.30) CAPL=1.20
      D(20)=D(10)*(1.+CAPL*VT(16)+100.*VT(16)**4)*D(13)*(2.*A(3)/SREF)
      GO TO 1030
!
!                  ***** INBOARD CALCUALTIONS *****
!
 1010 D(18)=A(15)*A(129)
!
!*********     FIGURE 4.1.5.1-27 EQUATION
!
      CALL TBFUNX(B(I+2),CEPT,DYDX,4,X27M,X27I,C27,I27,MI,NG,           &
     &            0,0,Q15127,3,ROUTID)
      D(15)=D(2)**1.0482*10.0**CEPT
!
!*********     IF RLI.LT.RNI  SET RNI=RLI
!
      IF( D(15).LT.D(18) ) D(18)= D(15)
!
!*********     FIGURE 4.1.5.1-26 SUBROUTINE
!
      CALL FIG26 ( D(18),B(I+2),D(11) )
!
!---------          FIGURE 4.1.5.1-28-B (DASHED)
!
      CALL TLINEX(X128BD,X228BD,Y28BD,4,9,B(I+2),A(190),D(23),          &
     &            0,0,0,0,Q128BD,5,ROUTID)
!
!*********     IF XTI GREATER TAN 0.30, THEN CAPL= 2.0          *
!
 1020 CAPL= 1.20
      IF(VT(18).LT.0.30) CAPL=2.00
      D(21)=D(11)*(1.+CAPL*VT(16)+100.*VT(16)**4)*D(23)*(2.*A(1)/SREF)
!
!                   ***** OUTBOARD CALCULATIONS *****
!
      D(19)=A(17)*A(129)
!
!*********     FIGURE 4.1.5.1-27 EQUATION
!
      D(16)=D(15)
!
!*********   IF RLO .LT. RNO, SET RNO= RLO
!
      IF(D(16).LT.D(19)) D(19)=D(16)
!
!*********     FIGURE 4.1.5.1-26 SUBROUTINE
!
      CALL FIG26( D(19),B(I+2),D(12) )
!
!*********     FIGURE 4.1.5.1-28-B
!
      CALL TLINEX(X128B,X228B,Y28B,4,11,B(I+2),A(184),D(24),            &
     &            0,2,0,2,Q5128B,3,ROUTID)
!
!*********     IF XTO GREATER THAN 0.30, THEN CAPL= 2.0
!
      CAPL=1.20
      IF(VT(66).LT.0.30) CAPL=2.00
      D(22)=D(12)*(1.+CAPL*VT(65)+100.*VT(65)**4)*D(24)*(2.*A(2)/SREF)
!
!*********     COMPUTE CDO FROM PAGE 3-2
!
      D(20)=D(21)+D(22)
 1030 CONTINUE
      RETURN
      END
      SUBROUTINE VTLIFT
!
!***  COMPUTE SUPERSONIC VERTICAL TAIL CL
!
      REAL MACH,KSHARP
      LOGICAL SUPLE,ROUND,GLOVE
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /OPTION/ SREF,CBARR,RUFF,BLREF
      COMMON /VTDATA/ AVT(195)
      COMMON /SBETA/  SLA(31)
      COMMON /VTI/    VTIN(131)
      COMMON /FLGTCD/ FLC(160)
      COMMON /SYNTSS/ SYNA(19)
      COMMON /CONSNT/ PI,DR,UNUSED,RAD,kand
      COMMON /WINGI/  WINGIN(101)
      DIMENSION ROUTID(2),Q3250A(3),Q3250B(3),Q3246A(3),Q3246G(3),      &
     &          Q246AF(4),Q13252(3),Q13253(3),Q13251(3)
      DIMENSION S13252(12),DSHP52(12),R13252(12),DRND52(12),T13253(24), &
     &          D13253(140),T13251(12),D13251(12)
      DIMENSION DUMY1(184),DUMY2(184),DUMY3(184),DUMY5(184),            &
     &          DUMY6(184),DUMY4(184)
      DIMENSION T13246(52),D13246(1104),VAA(4),LGA(4),VAB(4),LGB(4),    &
     &          A1350(17), B1350(19),DA50(72),DB50(88),G13246(9),       &
     &          DG3246(9)
      DIMENSION WTYPE(4)
      EQUIVALENCE (CNA,SLA(31))
      EQUIVALENCE (MACH,SLA(1)),(BETA,SLA(2))
      EQUIVALENCE (SRSTAR,AVT(3))
      EQUIVALENCE (TAPEXP,AVT(27)),(TANLE,AVT(62)),(SWEPLE,AVT(58)),    &
     &            (AR,AVT(7)),(TRATIP,AVT(25)),(COSLE,AVT(61)),         &
     &            (DELTAY,VTIN(17)),(SPANO,VTIN(2)),(TANLEO,AVT(86)),   &
     &            (TANTEO,AVT(104)),(CB,VTIN(5)),(CT,VTIN(1)),          &
     &            (SW,SREF),(TANLEI,AVT(62)),(TANTEI,AVT(80)),          &
     &            (SWTEI,AVT(76)),(SWTEO,AVT(100)),(KSHARP,VTIN(71)),   &
     &            (SPANS,WINGIN(3))
      EQUIVALENCE (D13246(1),DUMY1(1)),(D13246(185),DUMY2(1)),          &
     &            (D13246(369),DUMY3(1)),(D13246(553),DUMY4(1)),        &
     &            (D13246(737),DUMY5(1)),(D13246(921),DUMY6(1))
      DATA Q3250A/4H4.1.,4H3.2-,4H60A /,Q3246A/4H4.1.,4H3.2-,4H56A /,   &
     &     Q3250B/4H4.1.,4H3.2-,4H60B /,Q3246G/4H4.1.,4H3.2-,4H56G /,   &
     &     Q246AF/4H4.1.,4H3.2-,4H56A-,4HF   /,ROUTID/4HVTLI,4HFT  /,   &
     &     Q13253/4H4.1.,4H3.2-,4H63  /,                                &
     &     Q13251/4H4.1.,4H3.2-,4H61  /,                                &
     &     Q13252/4H4.1.,4H3.2-,4H62  /
!
!              FIGURE 4.1.3.2-60A (CNA/CNA)T FOR SUBSONIC L.E.
!
      DATA A1350/                                                       &
     & 0.,     .3,     .4,     .5,     .6,     .7,     .8,     .9,      &
     & 1.0001 ,                                                         &
     & 0.,     .41,    .82,    1.24,   2.12,   3.18,   6.95,   16.1 /
      DATA DA50/                                                        &
     & 1.,     1.,     1.,     1.,     1.,     1.,     1.,     1.,      &
     &         1.,                                                      &
     & 1.05,   1.05,   1.05,   1.05,   .985,   .945,   .915,   .9,      &
     & .9,                                                              &
     & 1.04,   1.04,   1.04,   1.04,   .965,   .908,   .87,    .85,     &
     & .84,                                                             &
     & 1.12,   1.12,   1.12,   1.015,  .94,    .88,    .838,   .81,     &
     & .796,                                                            &
     & 1.11,   1.11,   1.11,   1.,     .903,   .84,    .795,   .765,    &
     & .75,                                                             &
     & 1.08,   1.08,   1.08,   .954,   .865,   .8,     .75,    .72,     &
     & .7,                                                              &
     & 1.2,    1.2,    1.043,  .907,   .817,   .75,    .707,   .675,    &
     & .66,                                                             &
     & 1.14,   1.14,   .975,    .857,  .772,   .717,   .675,   .65,     &
     & .632 /
!
!              FIGURE 4.1.3.2-60B (CNA/CNA)T FOR SUPERSONIC L.E.
!
      DATA B1350/                                                       &
     & 0.,     .1,     .2,      .3,    .4,     .5,     .6,     .7,      &
     & .8,     .9,     1.0001 ,                                         &
     & 0.,     4.,     8.,      12.,   20.,    30.,    50.,    70./
      DATA DB50/                                                        &
     & 1.,     1.,     1.,      1.,    1.,     1.,     1.,     1.,      &
     & 1.,     1.,     1.,                                              &
     & 1.15,   1.15,   1.15,    1.15,  1.095,  1.04,   .99,    .96,     &
     & .935,   .915,   .9,                                              &
     & 1.12,   1.12,   1.12,    1.12,  1.05,   .985,   .94,    .905,    &
     & .88,    .857,   .84,                                             &
     & 1.15,   1.15,   1.15,    1.08,  1.005,  .945,   .902,   .87,     &
     & .842,   .82,    .796,                                            &
     & 1.22,   1.14,   1.05,    .98,   .93,    .89,    .853,   .823,    &
     & .795,   .77,    .75,                                             &
     & 1.13,   1.05,   .98,    .925,   .88,    .845,   .81,    .782,    &
     & .752,   .73,    .7,                                              &
     & 1.02,   .942,   .895,   .855,   .82,    .79,    .76,    .735,    &
     & .71,    .685,   .66,                                             &
     & 1.,     .92,    .87,    .825,   .79,    .755,   .728,   .7,      &
     & .678,   .655,   .632 /
!
!              FIGURE 4.1.3.2-56G (CNA/A) FOR A*BETA LESS THAN 1.0
!
      DATA G13246/0.,.2,.4,.45,.5,.6,.8,.9,1.0/
      DATA DG3246/1.61,1.58,1.55,1.57,1.62,1.75,1.94,2.0,2.0/
!
!              FIGURE 4.1.3.2-56A-F (WING SUPERSONIC CNA)
!
      DATA T13246                                                       &
     &  / 0.,.1,.2,.3,.33,.4,.5,.6,.7,.8,.9,1.0,1.111,1.25,1.429,1.667, &
     &    2.0,2.5,2.941,4.167,7.143,14.286, 30. ,                       &
     &    .25,.5,1.,2.,3.,4.,5.,6. , 15*0.,                             &
     &    0.,.2,.25,.3333,.5,1.0/
!
!     FIG 4.1.3.2-56A
!
      DATA DUMY1                                                        &
     &  /  .39, .39, .39, .39, .39, .39, .39, .39, .39, .39, .39, .41,  &
     &     .44, .5 , .58, .65, .80,1.0 ,1.15,1.55,2.40,3.92,4.0 ,       &
     &     .77, .77, .78, .78, .79, .79, .80, .80, .80, .81, .82, .84,  &
     &     .92,1.0 ,1.18,1.32,1.60,1.9 ,2.18,2.80,3.84,3.92,4.0 ,       &
     &    1.55,1.56,1.57,1.57,1.59,1.59,1.60,1.63,1.66,1.68,1.70,1.75,  &
     &    1.88,2.09,2.30,2.6 ,2.94,3.35,3.70,3.80,3.98,3.98,4.0 ,       &
     &    3.15,3.15,3.15,3.15,3.15,3.15,3.17,3.19,3.23,3.27,3.33,3.4 ,  &
     &    3.46,3.54,3.60,3.7 ,3.75,3.8 ,3.86,3.91,4.0 ,4.0 ,4.0 ,       &
     &    4.71,4.74,4.83,5.09,5.25,5.05,4.80,4.55,4.30,4.09,3.90,3.72,  &
     &    3.78,3.8 ,3.83,3.88,3.90,3.94,3.92,3.96,4.0 ,4.0 ,4.0 ,       &
     &    6.29,6.2 ,5.99,5.72,5.61,5.42,5.18,4.9 ,4.64,4.42,4.2 ,4.0 ,  &
     &    4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,4.0 ,       &
     &    6.3 ,6.34,6.39,6.08,5.97,5.78,5.5 ,5.2 ,4.95,4.7 ,4.48,4.25,  &
     &    4.2 ,4.18,4.14,4.11,4.07,4.05,4.04,4.02,4.  ,4.  ,4.  ,       &
     &    6.32,6.4 ,6.4 ,6.34,6.32,6.13,5.82,5.51,5.25,4.99,4.73,4.5 ,  &
     &    4.4 ,4.32,4.27,4.2 ,4.13,4.11,4.07,4.04,4.  ,4.  ,4.  /
!
!     FIG 4.1.3.2-56B
!
      DATA DUMY2                                                        &
     &  /  .41, .41, .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .41,  &
     &     .41, .48, .56, .67, .84,1.08,1.29,1.83,2.80,3.8 ,4.0 ,       &
     &     .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .8 , .83, .85,  &
     &     .98,1.09,1.27,1.48,1.80,2.25,2.53,3.22,3.79,3.92,4.  ,       &
     &    1.57,1.59,1.6 ,1.6 ,1.6 ,1.61,1.63,1.65,1.69,1.73,1.77,1.8 ,  &
     &    2.  ,2.26,2.57,2.9 ,3.27,3.53,3.65,3.8 ,3.91,3.97,4.  ,       &
     &    3.17,3.17,3.22,3.4 ,3.5 ,3.6 ,3.7 ,3.67,3.58,3.49,3.37,3.23,  &
     &    3.38,3.52,3.62,3.71,3.80,3.88,3.9 ,3.95,3.97,3.99,4.0 ,       &
     &    4.72,5.  ,5.1 ,5.02,4.97,4.84,4.64,4.45,4.24,4.05,3.89,3.70,  &
     &    3.84,3.91,3.97,3.99,4.0 ,4.  ,4.  ,4.  ,3.99,4.  ,4.  ,       &
     &    5.57,5.6 ,5.62,5.61,5.6 ,5.42,5.15,4.91,4.7 ,4.48,4.25,4.08,  &
     &    4.13,4.18,4.16,4.11,4.09,4.05,4.02,4.01,4.  ,4.  ,4.  ,       &
     &    5.73,5.77,5.79,5.79,5.77,5.75,5.6 ,5.33,5.08,4.83,4.59,4.4 ,  &
     &    4.42,4.4 ,4.32,4.23,4.17,4.08,4.05,4.03,4.01,4.  ,4.  ,       &
     &    5.83,5.88,5.91,5.93,5.93,5.91,5.88,5.68,5.4 ,5.14,4.9 ,4.7 ,  &
     &    4.68,4.59,4.46,4.33,4.23,4.13,4.1 ,4.06,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56C
!
      DATA DUMY3                                                        &
     &  /  .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .42,  &
     &     .43, .5 , .6 , .71, .9 ,1.12,1.35,1.97,2.95,3.80,4.  ,       &
     &     .8 , .8 , .8 , .8 , .8 , .8 , .8 , .81, .82, .83, .83, .88,  &
     &     .95,1.06,1.23,1.46,1.83,2.3 ,2.65,3.32,3.76,3.92,4.  ,       &
     &    1.59,1.59,1.59,1.59,1.59,1.6 ,1.62,1.65,1.68,1.72,1.78,1.82,  &
     &    2.  ,2.29,2.65,3.  ,3.27,3.5 ,3.6 ,3.78,3.90,3.98,4.  ,       &
     &    3.14,3.2 ,3.41,3.62,3.68,3.75,3.7 ,3.62,3.51,3.42,3.3 ,3.18,  &
     &    3.34,3.5 ,3.6 ,3.7 ,3.8 ,3.85,3.88,3.93,3.98,4.0 ,4.  ,       &
     &    4.7 ,4.85,5.02,4.98,4.91,4.8 ,4.6 ,4.4 ,4.2 ,4.  ,3.82,3.68,  &
     &    3.8 ,3.9 ,3.98,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    5.4 ,5.44,5.45,5.45,5.42,5.35,5.12,4.9 ,4.69,4.48,4.22,4.02,  &
     &    4.12,4.18,4.17,4.15,4.1 ,4.05,4.04,4.01,4.  ,4.  ,4.  ,       &
     &    5.61,5.63,5.64,5.62,5.61,5.6 ,5.54,5.3 ,5.02,4.8 ,4.6 ,4.39,  &
     &    4.42,4.44,4.38,4.26,4.16,4.1 ,4.07,4.03,4.01,4.  ,4.  ,       &
     &    5.72,5.75,5.76,5.78,5.77,5.76,5.72,5.69,5.4 ,5.15,4.9 ,4.68,  &
     &    4.68,4.6 ,4.49,4.33,4.22,4.15,4.10,4.06,4.02,4.01,4.  /
!
!      FIG 4.1.3.2-56D
!
      DATA DUMY4                                                        &
     &  /  .41, .41, .41, .41, .41, .41, .41, .41, .41, .41, .41, .41,  &
     &     .43, .50, .6 , .71, .89,1.11,1.35,2.00,3.00,3.72,4.00,       &
     &     .82, .82, .81, .8 , .8 , .81, .82, .83, .84, .85, .87, .89,  &
     &     .98,1.1 ,1.3 ,1.5 ,1.82,2.23,2.68,3.3 ,3.7 ,3.91,4.  ,       &
     &    1.6 ,1.59,1.58,1.58,1.58,1.59,1.60,1.62,1.66,1.73,1.81,1.92,  &
     &    2.2 ,2.45,2.7 ,2.98,3.22,3.45,3.59,3.75,3.7 ,3.91,4.  ,       &
     &    3.13,3.18,3.32,3.6 ,3.64,3.72,3.70,3.64,3.54,3.45,3.3 ,3.14,  &
     &    3.32,3.48,3.6 ,3.7 ,3.79,3.87,3.9 ,3.95,3.99,4.  ,4.  ,       &
     &    4.71,4.76,4.8 ,4.83,4.84,4.7 ,4.53,4.34,4.18,4.  ,3.82,3.63,  &
     &    3.78,3.9 ,3.98,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    5.2 ,5.22,5.22,5.2 ,5.2 ,5.15,5.1 ,4.88,4.63,4.42,4.21,4.0 ,  &
     &    4.15,4.21,4.21,4.17,4.14,4.07,4.05,4.03,4.01,4.  ,4.  ,       &
     &    5.45,5.47,5.47,5.45,5.45,5.41,5.36,5.3 ,5.02,4.81,4.58,4.36,  &
     &    4.45,4.47,4.41,4.30,4.19,4.12,4.08,4.02,4.  ,4.  ,4.  ,       &
     &    5.58,5.59,5.59,5.59,5.59,5.58,5.57,5.53,5.41,5.14,4.91,4.65,  &
     &    4.7 ,4.65,4.53,4.4 ,4.27,4.16,4.12,4.05,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56E
!
      DATA DUMY5                                                        &
     & /   .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 , .4 ,  &
     &     .44, .52, .63, .78, .98,1.21,1.4 ,2.07,3.07,3.6 ,4.  ,       &
     &     .8 , .8 , .79, .79, .79, .79, .8 , .81, .83, .85, .88, .9 ,  &
     &    1.01,1.17,1.38,1.62,2.00,2.50,2.74,3.22,3.66,3.87,4.  ,       &
     &    1.58,1.59,1.62,1.71,1.76,1.77,1.8 ,1.85,1.88,1.91,1.92,1.93,  &
     &    2.13,2.4 ,2.6 ,2.88,3.12,3.39,3.51,3.71,3.87,3.99,4.  ,       &
     &    3.15,3.21,3.38,3.61,3.7 ,3.67,3.59,3.5 ,3.4 ,3.29,3.17,3.03,  &
     &    3.18,3.37,3.51,3.67,3.78,3.85,3.88,3.93,3.98,4.  ,4.  ,       &
     &    4.42,4.42,4.41,4.40,4.39,4.38,4.35,4.25,4.08,3.9 ,3.72,3.57,  &
     &    3.70,3.86,3.93,3.99,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,4.  ,       &
     &    4.88,4.85,4.81,4.80,4.79,4.77,4.73,4.68,4.53,4.35,4.15,3.99,  &
     &    4.08,4.20,4.23,4.19,4.1 ,4.07,4.05,4.01,4.  ,4.  ,4.  ,       &
     &    5.08,5.09,5.08,5.08,5.07,5.06,5.03,4.99,4.92,4.74,4.53,4.3 ,  &
     &    4.43,4.48,4.43,4.32,4.20,4.12,4.08,4.03,4.01,4.  ,4.  ,       &
     &    5.19,5.21,5.22,5.23,5.23,5.23,5.23,5.21,5.19,5.09,4.88,4.6 ,  &
     &    4.72,4.69,4.58,4.41,4.28,4.18,4.12,4.07,4.02,4.01,4.  /
!
!     FIG 4.1.3.2-56F
!
      DATA DUMY6                                                        &
     & /   .4 , .4 , .4 , .4 , .4 , .41, .44, .49, .51, .54, .59, .61,  &
     &     .69, .75, .81, .9 ,1.01,1.26,1.53,2.1 ,2.9 ,3.42,4.  ,       &
     &     .81, .81, .81, .83, .84, .86, .88, .91, .99,1.02,1.1 ,1.19,  &
     &    1.3 ,1.42,1.58,1.75,2.  ,2.34,2.6 ,3.  ,3.46,3.71,4.   ,      &
     &    1.6 ,1.58,1.59,1.6 ,1.6 ,1.61,1.67,1.7 ,1.79,1.86,1.92,2.  ,  &
     &    2.13,2.32,2.51,2.75,2.97,3.2 ,3.35,3.58,3.8 ,3.9 ,4.  ,       &
     &    3.13,3.1 ,3.08,3.05,3.04,3.03,3.01,2.99,2.95,2.93,2.91,2.89,  &
     &    3.02,3.2 ,3.37,3.52,3.67,3.77,3.82,3.88,3.92,3.97,4.  ,       &
     &    3.79,3.84,3.86,3.8 ,3.79,3.72,3.63,3.58,3.5 ,3.47,3.43,3.41,  &
     &    3.57,3.75,3.89,3.98,4.  ,3.98,3.94,3.93,3.92,3.99,4.  ,       &
     &    4.12,4.2 ,4.19,4.09,4.06,4.03,3.99,3.95,3.92,3.9 ,3.88,3.87,  &
     &    4.01,4.1 ,4.21,4.21,4.12,4.05,4.  ,3.96,3.99,4.  ,4.  ,       &
     &    4.39,4.45,4.44,4.39,4.35,4.31,4.27,4.25,4.25,4.25,4.25,4.25,  &
     &    4.37,4.50,4.49,4.39,4.23,4.1 ,4.03,3.99,4.  ,4.  ,4.  ,       &
     &    4.6 ,4.68,4.65,4.59,4.57,4.54,4.5 ,4.45,4.48,4.53,4.59,4.61,  &
     &    4.71,4.75,4.69,4.5 ,4.31,4.18,4.08,4.01,4.  ,4.  ,4.  /
!
!              FIGURE 4.1.3.2-61 (KL)
!
      DATA T13251/.015,.03,.05,.075,.11,.16,.23,.45,.90,1.2,1.7,2.0/
      DATA D13251/.963,.94,.92,.90,.88,.86,.84,.80,.76,.74,.72,.709/
!
!              FIGURE 4.1.3.2-63 WING SUPERSONIC NORMAL-FORCE-CURVE
!              SLOPE, TAPER RATIO ZERO
!
      DATA T13253                                                       &
     &  / .0,.2,.4,.6,.8,1.,1.2,1.4,1.6,1.8,2.,2.4,2.8,3.2 ,            &
     &     -1.0, -0.8, -0.6, -0.4, -0.2, 0.0, 0.2, 0.4, 0.6, 0.8 /
      DATA D13253                                                       &
     &  / 1.57 ,1.69 ,1.752,1.78 ,1.774,1.7  ,1.472,1.288,1.15 ,1.034,  &
     &     .938, .795, .69 , .605,                                      &
     &    1.57 ,1.708,1.76 ,1.778,1.727,1.56 ,1.35 ,1.18 ,1.047, .947,  &
     &     .86 , .72 , .617, .543,                                      &
     &    1.57 ,1.708,1.77 ,1.737,1.575,1.418,1.233,1.07 , .94 , .842,  &
     &     .768, .646, .558, .49 ,                                      &
     &    1.57 ,1.708,1.763,1.618,1.442,1.278,1.104, .955, .845, .758,  &
     &     .68 , .57 , .49 , .428,                                      &
     &    1.57 ,1.708,1.548,1.41 ,1.275,1.133, .98 , .84 , .738, .66 ,  &
     &     .594, .495, .425, .37 ,                                      &
     &    1.57 ,1.49 ,1.367,1.245,1.12 , .995, .845, .725, .628, .555,  &
     &     .5  , .423, .363, .312,                                      &
     &    1.254,1.273,1.169,1.062, .958, .848, .7  , .59 , .518, .465,  &
     &     .415, .345, .29 , .253,                                      &
     &     .94 , .943, .948, .875, .788, .695, .55 , .465, .404, .36 ,  &
     &     .325, .268, .227, .196,                                      &
     &     .62 , .623, .63 , .648, .597, .537, .403, .335, .287, .25 ,  &
     &     .22 , .18 , .15 , .13 , .31 , .315, .327, .347, .391, .35 ,  &
     &     .23 , .177, .147, .129, .112, .09 , .073, .062 /
!
!              FIGURE 4.1.3.2-62 LEADING-EDGE-EFFECT FACTORS FOR NORMAL-
!                                FORCE-CURVE SLOPE AT SUPERSONIC SPEEDS
!              FIGURE 4.1.3.2-62 (ROUND LEADING EDGE)
!
      DATA R13252                                                       &
     & / 0., .5, .94, 1., 1.05, 1.5, 2., 2.5, 3., 3.5, 4., 20./
      DATA DRND52                                                       &
     & / 1.043, .97, .893, .89, .894, .987, 1.005, 1.02, 1.025, 1.03,   &
     & 1.034, 1.034 /
!
!              FIGURE 4.1.3.2-62 (SHARP LEADING EDGE)
!
      DATA S13252                                                       &
     & / 0., .5, .94, 1., 1.05, 1.5, 2., 2.5, 3., 3.5, 4., 20./
      DATA DSHP52                                                       &
     & / 1.08, 1.013, .94, .942, .948, 1.005, 1.03, 1.04, 1.048, 1.05,  &
     & 1.055, 1.055 /
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
      AR=2.*AR
      MACH=FLC(I+2)
      BETA=SQRT(MACH**2-1.)
      IF(TANLEO.EQ.0.0)TANLEO=.00001
      IF(TANLEI.EQ.0.0)TANLEI=.00001
      IF(VTIN(15).NE.WTYPE(1)) GO TO 1100
!
!       **STRAIGHT TAPERED SUPERSONIC NORMAL FORCE SLOPE**
!
      BOVERT=BETA/TANLE
      CA=COSLE
      IF( BOVERT.GT.1.0)GO TO 1000
      SUPLE=.FALSE.
      GO TO 1010
 1000 SUPLE=.TRUE.
 1010 CONTINUE
!
!                   FIGURE 4.1.3.2-60A (CNA/CNA)T FOR SUBSONIC L.E.
!
      DELTYT=DELTAY/CA
 1020 IF(SUPLE)GO TO 1030
      VAB(1)=BOVERT
      VAB(2)=DELTYT
      LGB(1)=9
      LGB(2)=8
      CALL INTERX(2,A1350,VAB,LGB,DA50,CNCNT,9,72,                      &
     &            2,2,0,0,0,2,0,0,Q3250A,3,ROUTID)
      GO TO 1040
!
!                   FIGURE 4.1.3.2-60B (CNA/CNA)T FOR SUPERSONIC L.E.
!
 1030 CONTINUE
      ARG=DELTAY/(5.85*CA)
      DELTDT=ATAN(ARG)*RAD
      VAB(1)=1./BOVERT
      VAB(2)=DELTDT
      LGB(1)=11
      LGB(2)=8
      CALL INTERX(2,B1350,VAB,LGB,DB50,CNCNT,11,88,                     &
     &            2,2,0,0,0,2,0,0,Q3250B,3,ROUTID)
 1040 IF(TRATIP.EQ.1.0.AND.SWEPLE.EQ.0.0) GO TO 1060
!
!                   NON-RECTANGULAR WING ANALYSIS
!                   FIGURES 4.1.3.2-56A THROUGH F
!
 1050 VAA(1)=BOVERT
      VAA(2)=AR *TANLE
      VAA(3)=TAPEXP
      LGA(1)=23
      LGA(2)=8
      LGA(3)=6
      CALL INTERX(3,T13246,VAA,LGA,D13246,BCNA,23,1104,                 &
     &            0,2,0,0,0,2,0,0,Q3246A,3,ROUTID)
      IF(SUPLE)GO TO 1080
      CNTHRY=BCNA/TANLE
      GO TO 1090
 1060 CONTINUE
!
!                        RECTANGULAR WING ANALYSIS
!
      IF(AR *BETA.GT.1.0)GO TO 1070
!
!                        FIGURE 4.1.3.2-56G(CNA/A)
!
      VAB(1)=AR *BETA
      LGB(1)=9
      CALL INTERX(1,G13246,VAB,LGB,DG3246,CNAA,9,9,                     &
     &            0,0,0,0,0,0,0,0,Q3246G,3,ROUTID)
      CNTHRY=CNAA*AR
      GO TO 1090
 1070 BCNA= 4.-2.*(1./(AR *BETA))
 1080 CNTHRY=BCNA/BETA
 1090 CNA=CNTHRY*CNCNT*SRSTAR/(SW*RAD)
      AR=AR/2.
      RETURN
!
!    ***SUPERSONIC NORMAL FORCE SLOPE,NON-STRAIGHT TAPERED WINGS***
!                    BASIC WING COMPONENT
 1100 CONTINUE
      SPANIN=SPANS-SPANO
      CRBW=CB+SPANIN*(TANLEO-TANTEO)
      SBW=(CRBW+CT)*SPANS
      ARBW=4.*SPANS**2/SBW
      TAPBW=CT/CRBW
      BOVERT=BETA/TANLEO
      SUPLE=.FALSE.
      IF(BOVERT.GT.1.)SUPLE=.TRUE.
!
!                   FIGURE 4.1.3.2-56A-F (CNABW)
!
      VAB(1)=BOVERT
      VAB(2)=ARBW*TANLEO
      VAB(3)=TAPBW
      GLOVE=.FALSE.
      TA=TANLEO
 1110 LGB(1)=23
      LGB(2)=8
      LGB(3)=6
      CALL INTERX(3,T13246,VAB,LGB,D13246,BCNA,23,1104,                 &
     &            0,2,0,0,0,2,0,0,Q246AF,4,ROUTID)
      CNTHRY=BCNA/TA
      IF(SUPLE)CNTHRY=BCNA/BETA
!
!                   LEADING-EDGE-EFFECT PARAMETERS
!              FIGURE 4.1.3.2-62 (CLE)BW
!
      ROUND=.FALSE.
      IF(KSHARP.EQ.UNUSED)ROUND=.TRUE.
      VAB(1)=BOVERT
      LGB(1)=12
!
!              SHARP LEADING EDGE
!
      IF(ROUND)GO TO 1120
      CALL INTERX(1,S13252,VAB,LGB,DSHP52,CLE  ,12,12,                  &
     &            0,0,0,0,0,0,0,0,Q13252,3,ROUTID)
      GO TO 1130
!
!              ROUND LEADING EDGE
!
 1120 CALL INTERX(1,R13252,VAB,LGB,DRND52,CLE  ,12,12,                  &
     &            0,0,0,0,0,0,0,0,Q13252,3,ROUTID)
 1130 IF(GLOVE)GO TO 1160
      CNTBW=CNTHRY
      CLEBW=CLE
      IF(TANLEO.GE.TANLEI)GO TO 1140
      CNABW=CNTBW*SBW/SW *CLEBW
      GO TO 1150
 1140 CONTINUE
      S2=SPANIN**2*TANLEO
      A2=4.*SPANIN**2/S2
      VAB(2)=A2*TANLEO
      VAB(3)=0.0
      CALL INTERX(3,T13246,VAB,LGB,D13246,BCNA,23,1104,                 &
     &            0,2,0,0,0,2,0,0,Q246AF,4,ROUTID)
      CNT2=BCNA/BETA
      IF(VAB(1).GT.1.)CNT2  =BCNA/TANLEO
      CNABW=(CNTHRY*SBW/SW-CNT2  *  S2/SW )*CLEBW
 1150 CONTINUE
!
!     GLOVE COMPONENT
!
      CRGLV=TANLEI*SPANIN
      SGLV=CRGLV*SPANIN
      ARGLV=4.*SPANIN**2/SGLV
      VAB(1)=BETA/TANLEI
      VAB(2)=ARGLV*TANLEI
      VAB(3)=0.0
      GLOVE=.TRUE.
      BOVERT=VAB(1)
      SUPLE=.FALSE.
      TA=TANLEI
      IF(BOVERT.GT.1.)SUPLE=.TRUE.
      GO TO 1110
 1160 CONTINUE
      CLEGLV=CLE
      CNAGLV=CNTHRY*CLEGLV*SGLV/SW
!
!              FIGURE 4.1.3.2-63 (CN1=CNA/A)   EXTENSION COMPONENT
!
      IF(ABS(SWTEI-SWTEO).LT.4.)GO TO 1170
      BE= 2.*SPANIN
      VAB(1)=BETA/TANLEI
      VAB(2)=TANTEI/TANLEI
      LGB(1)=14
      LGB(2)=10
      CALL INTERX(2,T13253,VAB,LGB,D13253,CN1,14,140,                   &
     &            2,2,0,0,2,2,0,0,Q13253,3,ROUTID)
      VAB(2)=TANTEO/TANLEI
      CALL INTERX(2,T13253,VAB,LGB,D13253,CN2,14,140,                   &
     &            2,2,0,0,2,2,0,0,Q13253,3,ROUTID)
      CNAE=(CN1-CN2)*BE**2/SW
      GO TO 1180
 1170 CNAE=0.0
!
!   **SUPERSONIC NORMAL FORCE SLOPE,NON-STRAIGHT TAPERED WINGS,TOTAL WIN
!
 1180 CONTINUE
!
!              FIGURE 4.1.3.2-61
!
      VAB(1)=CNAGLV/(CLEGLV*BETA)
      LGB(1)= 12
      CALL INTERX(1,T13251,VAB,LGB,D13251,RKL,12,12,                    &
     &            2,0,0,0,2,0,0,0,Q13251,3,ROUTID)
      CNA=RKL*(CNABW+CNAGLV+CNAE)/RAD
      AR=AR/2.
      RETURN
      END
      SUBROUTINE WBAERO
!
! ***
!
      COMMON /IBODY/   PBODY,  BODY(400)
      COMMON /IWING/   PWING,  WING(400)
      COMMON /IHT/     PHT,    HT(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
!
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /WINGI/  WINGIN(101)
      COMMON /HTI/    HTIN(154)
      COMMON /WINGD/  A(195), B(49)
      COMMON /BDATA/  BD(762)
      COMMON /WHWB/   FACT(182), WB(39), HB(39)
      COMMON /HTDATA/ AHT(195), BHT(49)
      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55), DVF(55)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,L
      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,          &
     &                KBODY, KWING, KHT, KVT, KWB, KDWASH(3),           &
     &                ALPOW, ALPLW, ALPOH, ALPLH
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB
!
      LOGICAL  VERTUP,MDATA,KBODY,KWING,KHT,KVT,KWB,KDWASH
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB,FOUND
!
      DIMENSION CR(6), DR(6), ER(6), FR(6), ROUTID(2)
      DATA ROUTID / 4HM07O, 4H07   /
!
      IF(.NOT. WGPL) GO TO 1010
      DB=BD(87)
      AIW=BD(77)
      COSAIW=BD(79)
      CMOB=BD(62)
      BD(535)=WINGIN(4)-WINGIN(3)
      FACT(1)=BD(535)/WINGIN(4)
      CALL BODOWG(BD(255),BD(83),BD(535),WINGIN(4),A(27),FACT(2),       &
     &            FACT(22),NALPHA)
!
!     ----COMPUTE WING BODY LIFT,PITCHING MOMENTS AND DRAG.
!
      CALL WBDRAG(A,B,D,BD,WB,BW,BODY,WING,KBODY,KWING)
      CALL WBLIFT(A,B,DB,AIW,WB,BW,FACT,BODY,WING,WINGIN)
      CALL WBCM(A,B,C,DB,XCG,XW,COSAIW,CMOB,WB,BW,BODY,WINGIN,BD(70),   &
     &         WING(121),ALIW,BD(81),ZW,WING(41),FACT(1),ZCG)
!
!     CALCULATE CLA AND CMA
!
      CALL EXSUBT
      IN = 0
      IM = 0
      NLA=NALPHA
      FOUND=.FALSE.
      DO 900 J=1,NALPHA
         IF(BW(J+40) .NE. 2.*UNUSED .OR. FOUND) GO TO 900
         NLA=J-1
         FOUND=.TRUE.
  900 END DO
      DO 1000 J=1,NALPHA
         CALL TBFUNX(FLC(J+22),X,BW(J+100),NALPHA,FLC(23),BW(21),       &
     &               CR,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),X,BW(J+120),NLA,FLC(23),BW(41),          &
     &               DR,IM,MI,NG,0,0,4HCMA ,1,ROUTID)
         IF(J .GT. NLA) BW(J+120)=2.*UNUSED
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         BW(J+60) = BW(J+20)*CA + BW(J)*SA
         BW(J+80) = BW(J)*CA - BW(J+20)*SA
 1000 END DO
 1010 IF(.NOT. HTPL) GO TO 1030
      YEXP=HTIN(4)-HTIN(3)
      XC4=AHT(161) + XH
      FACT(142)=(HTIN(4)-HTIN(3))/HTIN(4)
      DB=2.*YEXP
      AIW=ALIH
      COSAIW=COS(ALIH/RAD)
      CMOB=BD(62)
      CMAHT=(BD(63)/CBARR)*HT(101)
      ZAC = ZH-XH*SIN(ALIH/RAD)/COSAIW-CHT(6)*AHT(10)*                  &
     &      SIN(ALIH/RAD)-ZCG
      CALL BODOWG(BD(255),XC4,YEXP,HTIN(4),AHT(27),FACT(143),           &
     &            FACT(163),NALPHA)
!
!     ----COMPUTE H.T. BODY LIFT,PITCHING MOMENTS AND DRAG.
!
      CALL WBDRAG(AHT,BHT,DHT,BD,HB,BH,BODY,HT,KBODY,KHT)
      CALL WBLIFT(AHT,BHT,DB,AIW,HB,BH,FACT(142),BODY,HT,HTIN)
      CALL WBCM(AHT,BHT,CHT,DB,XCG,XH,COSAIW,CMOB,HB,BH,BODY,HTIN,ZAC,  &
     &         CMAHT,ALIH,BD(81),ZH,HT(41),FACT(142),ZCG)
!
!     CALCULATE CLA AND CMA
!
      CALL EXSUBT
      IN = 0
      IM = 0
      DO 1020 J=1,NALPHA
         CALL TBFUNX(FLC(J+22),X,BH(J+100),NALPHA,FLC(23),BH(21),       &
     &               CR,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),X,BH(J+120),NALPHA,FLC(23),BH(41),       &
     &               DR,IM,MI,NG,0,0,4HCMA ,1,ROUTID)
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         BH(J+60) = BH(J+20)*CA + BH(J)*SA
         BH(J+80) = BH(J)*CA - BH(J+20)*SA
 1020 END DO
 1030 IF( .NOT. (BO .AND. VTPL)) GO TO 1070
!
!     B-V DATA
!
      DO 1050 J=1,NALPHA
         DO 1040 K=1,7
            KK=(K-1)*20
            BV(J+KK)=BODY(J+KK)
            IF(KK .EQ. 0) BV(J+KK)=BODY(J+KK)+DVT(20)+DVF(20)
 1040    CONTINUE
 1050 END DO
!
!     CALCULATE CN, CA, CLA, AND CMA
!
      IN = 0
      IM = 0
      DO 1060 J=1,NALPHA
         CA = COS(FLC(J+22)/RAD)
         SA = SIN(FLC(J+22)/RAD)
         BV(J+60) = BV(J+20)*CA + BV(J)*SA
         BV(J+80) = BV(J)*CA - BV(J+20)*SA
         IF(J .EQ. 1) GO TO 1060
         CALL TBFUNX(FLC(J+22),X,BV(J+100),NALPHA,FLC(23),BV(21),       &
     &               ER,IN,MI,NG,0,0,4HCLA ,1,ROUTID)
         CALL TBFUNX(FLC(J+22),X,BV(J+120),NALPHA,FLC(23),BV(41),       &
     &               FR,IM,MI,NG,0,0,4HCMA ,1,ROUTID)
 1060 END DO
 1070 CONTINUE
      RETURN
      END
      SUBROUTINE WBCD
!
! *** EXEC FOR WING-BODY AND HORIZONTAL TAIL-BODY CD
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /FLGTCD/ FLC(95), TR, dumflgtcd(64)
      COMMON /BDATA/  BD(762)
      COMMON /WINGD/  A(195)
      COMMON /WHWB/   FACT(182), WB(39), HB(39)
      COMMON /IHT/    PHT,HT(380)
      COMMON /HTI/    HTIN(131)
      COMMON /HTDATA/ AHT(195)
      COMMON /WINGI/  WINGIN(100)
      COMMON /IBH/    PBH,BH(380)
      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,         &
     &                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,       &
     &                PHIV, PHIF
      COMMON /IBW/    PBW, BW(380)
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST
      REAL LN, LA
      LOGICAL NA
      DIMENSION CDL(20)
      DATA STRA / 4HSTRA /
!
!***  WING-BODY DRAG
!
      IF(WINGIN(15) .NE. STRA .OR. .NOT. WGPL) GO TO 1020
      CD0 = WB(17)
      RN = FLC(I+42)*A(122)
      DB = 2.0*(WINGIN(4)-WINGIN(3))
      LN = (XW + 0.5*DB*A(38))/DB
      LA = (XW + WINGIN(6) + 0.5*DB*A(56))/DB
      IF(BD(2) .LT. (LN*DB)) LN = LN*DB/BD(85)
      IF(BD(2) .GT. (LA*DB)) LA = LA*DB/BD(85)
      LA = BD(1)/DB-LA
      CALL WBCDL(A(120), A(38), WINGIN(16), LN, LA, A(118),             &
     &          WINGIN(62), WINGIN(11), WINGIN(93), WINGIN(94), RN,     &
     &          TR, FLC(I+2), FLC(23), CDL, NA)
      IF(NA) GO TO 1020
        CALL EXSUBT
        DO 1010 J=1,NALPHA
           BW(J) = CD0 + CDL(J)
           CA = COS(FLC(J+22)/RAD)
           SA = SIN(FLC(J+22)/RAD)
           BW(J+60) = BW(J+20)*CA + BW(J)*SA
           BW(J+80) = BW(J)*CA - BW(J+20)*SA
           IF(CDL(J) .NE. UNUSED) GO TO 1010
           BW(J)    = -UNUSED
           BW(J+60) = -UNUSED
           BW(J+80) = -UNUSED
 1010   CONTINUE
 1020 CONTINUE
!
!***  H.T.-BODY DRAG
!
      IF(HTIN(15) .NE. STRA .OR. .NOT. HTPL) GO TO 1040
      CD0 = HB(17)
      RN = FLC(I+42)*AHT(122)
      DB = 2.0*(HTIN(4)-HTIN(3))
      LN = (XH + 0.5*DB*AHT(38))/DB
      LA = (XH + HTIN(6) + 0.5*DB*AHT(56))/DB
      IF(BD(2) .LT. (LN*DB)) LN = LN*DB/BD(85)
      IF(BD(2) .GT. (LA*DB)) LA = LA*DB/BD(85)
      LA = BD(1)/DB-LA
      CALL WBCDL(AHT(120), AHT(38), HTIN(16), LN, LA, AHT(118),         &
     &          HTIN(62), HTIN(11), HTIN(93), HTIN(94), RN,             &
     &          TR, FLC(I+2), FLC(23), CDL, NA)
      IF(NA) GO TO 1040
        CALL EXSUBT
        DO 1030 J=1,NALPHA
           BH(J) = CD0 + CDL(J)
           CA = COS(FLC(J+22)/RAD)
           SA = SIN(FLC(J+22)/RAD)
           BH(J+60) = BH(J+20)*CA + BH(J)*SA
           BH(J+80) = BH(J)*CA - BH(J+20)*SA
           IF(CDL(J) .NE. UNUSED) GO TO 1030
           BH(J)    = -UNUSED
           BH(J+60) = -UNUSED
           BH(J+80) = -UNUSED
 1030   CONTINUE
 1040 CONTINUE
      RETURN
      END
      SUBROUTINE WBCDL(AR,TANLE,TOVC,LN,LA,TAPR,LER,TWIST,YCM,CLD,RN,   &
     &      TR,MACH,ALPHA,CDL,NA)
!
! *** CALCULATES THE WING-BODY AND  HORIZONTAL TAIL-BODY CDL
!
      COMMON /OVERLY/ NLOG, NMACH, I, NALPHA
      COMMON /CONSNT/ PI, DEG, UNUSED, RAD,kand
!
      EQUIVALENCE (B(1),B0), (B(2),B1), (B(3),B2), (B(4),B3),           &
     &            (B(5),B4), (B(6),B5), (B(7),B6), (B(8),B7),           &
     &            (B(9),B8), (B(10),B9), (B(11),B10), (B(12),B11),      &
     &            (B(13),B12), (B(14),B13), (B(15),B14),                &
     &            (B(16),B15)
      DIMENSION ALPHA(20), CDL(20), B(16)
      REAL LA, LN, LER, MACH
      LOGICAL NA, NDM
!
      NA = .FALSE.
      IF(AR .LT. 1.6 .OR. AR .GT. 6.0)            GO TO 1020
      IF(TANLE .LT. 0.0 .OR. TANLE .GT. 2.74748)  GO TO 1020
      IF(TOVC .LT. 0.025 .OR. TOVC .GT. 0.100)    GO TO 1020
      IF(LN .LT. 2.2 .OR. LN .GT. 8.4)            GO TO 1020
      IF(LA .LT. 0.3 .OR. LA .GT. 5.6)            GO TO 1020
      IF(TAPR .LT. 0.0 .OR. TAPR .GT. 1.0)        GO TO 1020
      IF(LER .LT. 0.0 .OR. LER .GT. 0.015)        GO TO 1020
      IF(TWIST .LT. -9.4 .OR. TWIST .GT. UNUSED)  GO TO 1020
      IF(YCM .LT. 0.0 .OR. YCM .GT. 0.0263)       GO TO 1020
      IF(CLD .LT. 0.0 .OR. CLD .GT. 0.45)         GO TO 1020
        IF(RN .LT. 8.0E5) RN = 8.0E5
        IF(RN .GT. 8.0E6) RN = 8.0E6
        DO 1010 J=1,NALPHA
           CALL TABLES(B, MACH, ALPHA(J), NDM)
           CDL(J) = B0 + B1/AR + B2*AR + B3*SQRT(TANLE) + B4*TOVC       &
     &            + B5*LN + B6*LA + B7*TAPR + B8*TAPR**2 + B9*TAPR**3   &
     &            + B10*TR + B11*LER - B12*TWIST/RAD + B13*YCM          &
     &            + B14*CLD + B15*RN/1.E6
           IF(NDM) CDL(J) = UNUSED
           IF(NDM .AND. J .EQ. 1) NA = .TRUE.
 1010   CONTINUE
      GO TO 1030
 1020 CONTINUE
        NA = .TRUE.
 1030 CONTINUE
      RETURN
      END
      SUBROUTINE WBCLB(NALPHA,CLW,CLAW,CLB,CLAB,CDW,CDB,CLAWB,ALP,      &
     &    ALPB,WINGIN,XC,TAPR,ALIW,KWB,KBW,CLBN14,CNAM14,CLBLFB,        &
     &    CLAMFB,M,MFB,KKWB,KKBW,FACT,CLWB,CDWB,CLBB,CLBCL)
!
! *** CALCULATES TRANSONIC WING-BODY ROLLING MOMENT DUE TO YAW,CLB
!
      DIMENSION CLW(20),CLB(20),CDW(20),CDB(20),ALP(20),ALPB(20),       &
     &          WINGIN(100),CLWB(20),CDWB(20),CLBB(20),FACT(41)
      DIMENSION X12A(11),Y12A1(11),Y12A2(11),C12(6)
      DIMENSION ROUTID(2)
      REAL M,MFB,KWB,KBW,KKWB,KKBW
      LOGICAL FLAG, DRAG
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
!
      DATA X12A  /0., .1, .2, .3, .4, .5, .6, .7, .8, .9, 1./
      DATA Y12A1 /1., .97, .95, 4*.94, .95, .96, .98, .99/
      DATA Y12A2 /0., .11, .21, .31, .41, .51, .60, .70, .80, .90, 1.0/
      DATA ROUTID /4HWBCL, 4HB   /
!
!************ TRANSONIC WING-BODY CL AND CD
!
      YB = WINGIN(4)-WINGIN(3)
      CALL BODOWG(ALPB,XC,YB,WINGIN(4),TAPR,FACT(2),FACT(22),NALPHA)
      FACT(1) = YB/WINGIN(4)
      IN=0
      CALL TBFUNX(FACT(1),KKWB,DYDX,11,X12A,Y12A1,C12,IN,MI,NG,0,0,     &
     &           4HKKWB,1,ROUTID)
      IN=0
      CALL TBFUNX(FACT(1),KKBW,DYDX,11,X12A,Y12A2,C12,IN,MI,NG,0,0,     &
     &           4HKKBW,1,ROUTID)
      CLI = CLAW*ALIW
      DRAG = ABS(CDWB(2)) .NE. UNUSED
      DO 1010 J=1,NALPHA
         IF(ABS(CLWB(J)) .NE. UNUSED) GO TO 1000
           CLWB(J) = (CLAB+(KWB+KBW)*CLAW)*ALP(J)
           FLAG = ABS(CLB(J)) .NE. UNUSED .AND. ABS(CLW(J)) .NE. UNUSED
           IF(FLAG) CLWB(J) = CLB(J)+(KWB+KBW)*(CLW(J)-CLI)
           CLWB(J) = CLWB(J)+(KKWB+KKBW)*CLI
           IF(FACT(1) .LT. 1./3.) GO TO 1000
           CLWB(J) = CLWB(J)+FACT(1)*FACT(J+1)*FACT(J+21)*              &
     &               CLAW*(ALP(J)-ALIW)
 1000    CONTINUE
         IF(DRAG) GO TO 1010
           FLAG = ABS(CDW(J)) .NE. UNUSED .AND. ABS(CDB(J)) .NE. UNUSED
           IF(FLAG) CDWB(J) = CDB(J)+CDW(J)
 1010 END DO
!
!************ TRANSONIC WING-BODY CLB - DATCOM EQUATION 5.2.2.1-D
!
      CLBCL=((CLBN14/CNAM14**2-CLBLFB/CLAMFB**2)*(M-MFB)/(1.4-MFB) +    &
     &      CLBLFB/CLAMFB**2)*CLAWB**2
      DO 1020 I=1,NALPHA
         IF(CLWB(I).EQ.UNUSED)GO TO 1020
         IF(CLBB(I).EQ.UNUSED)CLBB(I)=CLBCL*CLWB(I)
 1020 END DO
      RETURN
      END
      SUBROUTINE WBCM (A,B,C,DB,XCG,XW,COSAIW,CMOB,WB,BW,BODY,          &
     &              WINGIN,ZAC,CMA,ALI,BAL0,ZW,WINGC,VORTEX,ZCG)
!
!*********          WING-BODY MOMENT CALCULATIONS      *****************
!
      COMMON /OVERLY/ NLOG,NMACH,II,NALPHA,IG
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /FLGTCD/ FLC(160)
      COMMON /BDATA/  BD(762)
!
      DIMENSION ROUTID(2),Q2136B(3),Q21C(1)
      DIMENSION A(195),B(49),C(51),WB(39),BW(21),BODY(121),WINGIN(101)
      DIMENSION C21C(6),X21C(13),Y21C(13)
      DIMENSION X38B(3),Y38B(3),C38B(6),VORTEX(41),WINGC(81)
      DIMENSION AL0(6),CL(21),CD(21),DXACWB(21),CDA(6)
!
      DATA INC,IND,INE / 0, 0, 0 /
      DATA QAL / 4HALWB /
      DATA QCD / 4HCD0  /, QAC / 4HWBAC /
      DATA ROUTID/4HWBCM,4H    /,Q2136B/4H4.3.,4H2.2-,4H36-B/,          &
     &     Q21C/4H21C /
!
! **          FIGURE 4.3.2.2-36-B
!
      DATA X38B  /0.0,1.0,1.0E06/
      DATA Y38B  /0.0,0.50,0.50/
      DATA I38B  /0/
      DATA IN21C /0/
      DATA X21C /0.0,.025,.050,.075,.10,.15,.20,.30,.40,.50,.60,.70,.80/
      DATA Y21C /0.0,.056,.101,.130,.152,.190,.22,.266,.301,.33,.348,   &
     &           .365,.375/
!
      SSPN=WINGIN(4)
      TEMP0= 0.25*A(7)*(1.+A(27))*A(38)
!
! ****     SELECT VALUE OF(X-PRIME)AC/(C)RE AT (BETA*A)= ZERO
!
      WB(15)= 0.50
      IF(TEMP0.GE.1.00) GO TO 1000
!
!             FIGURE 4.3.2.1-36-B
!
      CALL TBFUNX(TEMP0,WB(15),DYDX,3,X38B,Y38B,C38B,I38B,MI,NG,        &
     &            0,0,Q2136B,3,ROUTID)
!
! ***     COMPUTE VALUE OF (X-PRIME)AC/(C)RE AT (BETA*A)= 4.0
!
 1000 RATIO= DB/(2.*SSPN)
      CALL TBFUNX(RATIO,BRAC,DYDX,13,X21C,Y21C,C21C,IN21C,MI,NG,        &
     &            0,0,Q21C,1,ROUTID)
      TEMP4= 0.25+(2.*SSPN-DB)/(2.*A(10))*A(44)*BRAC
!
!*********     IF (BETA*A).GT.ZERO AND .LT.4.0  USE ELLIPSE CURVE FIT
!         REVISIONS TO WBCM SUBROUTINE
!
      ARG=B(2)*A(7)
      IF(ARG.LT.4.0) GO TO 1010
      WB(14)= TEMP4
      GO TO 1030
!
!*********     COMPUTE (X-PRIME)AC/(C)RE USING ELLIPSE CURVE FIT
!
 1010 X1= 4.0
      Y1= WB(15)
      Y= TEMP4
      P= 4.0
      Q= ABS(Y-Y1)
      BB= -2.0*Y1
      CC= (Y1*Y1-Q*Q+((Q/P)**2)*(ARG-X1)**2)
      IF((BB*BB-4.*CC).GT.0.0) GO TO 1020
      WRITE(6,1210  )
      CALL CloseFiles   ! changed 15 May 2004
      STOP
 1020 CONTINUE
!
!*********     SOLVE QUADRATIC EQUATION FOR WB(14), (NOTE, AA=1)
!
      YMAX= (-BB+SQRT(BB*BB-4.*CC))/2.0
      YMIN= (-BB-SQRT(BB*BB-4.*CC))/2.0
      WB(14)= YMAX
      IF(Y.LT.Y1) WB(14)= YMIN
 1030 WB(13)= WB(14)*A(10)/CBARR
      DXCG=XCG-(XW+.50*DB*A(62)*COSAIW)
      CLOWB=0.
      CALL TBFUNX(CLOWB,ALOWB,DYDX,NALPHA,BW(21),FLC(23),AL0,INE,MI,NG, &
     &            1,1,QAL,1,ROUTID)
      CMOWB=CMOB+B(47)+BODY(121)*(ALOWB-BAL0)+CMA*(ALOWB-B(49)+ALI)
!
      XLN = (XW+0.5*DB*A(38))/DB
      XLA = (XW+WINGIN(6)+0.5*DB*A(80))/DB
      XLA = BD(1)/DB-XLA
      RN  = FLC(II+42)*A(122)
      DBM = 2.*SQRT(BD(3)/PI)
      WL  = 0.5+ZW/DBM
      VT  = 0.0
      THETA=WINGIN(11)/RAD
      HD  = 0.5
      DOB = 0.5*DBM/WINGIN(4)
      CALL WBCM0(A(120),A(38),WINGIN(16),XLN,XLA,A(118),WINGIN(62),     &
     &            THETA,WINGIN(93),WINGIN(94),RN,FLC(96),WL,VT,         &
     &           HD,DOB,FLC(II+2),CMOWB)
      IF(ABS(CMOWB) .LE. UNUSED) CMOWB = 0.0
      WB(16) = CMOWB
!
      DO 1040   J=1,NALPHA
         XAC=-BODY(J+120)*CBARR/BODY(J+100)+DXCG
         ANUM=XAC*BODY(J+100)/CBARR+C(6)*WB(4)*A(10)/CBARR+WB(13)*WB(5)
         IF(J .EQ. 1) WB(12)=ANUM/(BODY(101)+WB(4)+WB(5))
         WB12=ANUM/(BODY(J+100)+WB(4)+WB(5))
         DXACWB(J)=DXCG/CBARR-WB12
         IF(CMOB .EQ. UNUSED) CMOB = 0.0
 1040 END DO
      DO 1190 J=1,NALPHA
!
!   CHECK FOR DENOMINATOR EQUAL TO ZERO
!
 1160    IF (WINGC(20+J).EQ.0.0) GO TO 1170
!
!   COMPUTE DELTA XCP WING-BODY
!
         DXCPWB=(WINGC(J)-B(47))/WINGC(J+20)
!
         GO TO 1180
 1170    DXCPWB=0.0
!
 1180    CONTINUE
!
!   COMPUTE DELTA XCP BODY-WING
!
         DXCPBW=A(173)/CBARR-WB(13)
!
!   COMPUTE DELTA CN VORTEX
!
         DCNV=VORTEX(1+J)*VORTEX(21+J)*VORTEX(1)*B(22+J)*WINGC(61)
!
!   COMPUTE BODY-WING CM
!
         BW(40+J)=BODY(40+J)                                            &
     &         +  B(47)                                                 &
     &         + (WINGC(20+J)-WINGC(61)*ALI)*WB(2)*DXCPWB               &
     &         + WINGC(61)*ALI*WB(7)*DXCPWB                             &
     &         + (WINGC(20+J)-WINGC(61)*ALI)*WB(3)*DXCPBW               &
     &         + WINGC(61)*ALI*WB(8)*DXCPBW                             &
     &         +  DCNV*DXCPWB                                           &
     &         +  WINGC(40+J)*(ZW-ZCG)/CBARR
         IF(WINGC(J) .EQ. 2.*UNUSED) BW(J+40)=2.*UNUSED
 1190 END DO
!
!*********                COMPUTE (CA)WB---BW(J+80)
!
      DO 1200  J=1,NALPHA
         BW(J+80)=BW(J)*COS(B(J+22)/RAD)-BW(J+20)*SIN(B(J+22)/RAD)
 1200 END DO
      RETURN
 1210 FORMAT (30X,45H ELLIPSE CURVE FIT IN ERROR, WBCM SUBROUTINE  )
      END
      SUBROUTINE WBCM0(AR,TANLE,TOVC,LN,LA,TAPR,LER,TWIST,YCM,CLD,RN,   &
     &                 TR,WL,VT,HD,DB,MACH,CM0)
!
! *** CALCULATES CM0 FOR WING-BODY USING REGRESSION METHOD
!
      COMMON /CONSNT/ PI, DEG, UNUSED, RAD,kand
!
      EQUIVALENCE (C(1),C0), (C(2),C1), (C(3),C2), (C(4),C3),           &
     &            (C(5),C4), (C(6),C5), (C(7),C6), (C(8),C7),           &
     &            (C(9),C8), (C(10),C9), (C(11),C10), (C(12),C11),      &
     &            (C(13),C12), (C(14),C13), (C(15),C14),                &
     &            (C(16),C15), (C(17),C16), (C(18),C17), (C(19),C18)
      DIMENSION C(19)
      REAL LA, LN, LER, MACH
!
      IF(MACH .GT. 2.5)                           GO TO 1010
      IF(AR .LT. 1.6 .OR. AR .GT. 6.0)            GO TO 1010
      IF(TANLE .LT. 0.0 .OR. TANLE .GT. 2.74748)  GO TO 1010
      IF(TOVC .LT. 0.025 .OR. TOVC .GT. 0.100)    GO TO 1010
      IF(LN .LT. 2.2 .OR. LN .GT. 8.4)            GO TO 1010
      IF(LA .LT. 0.3 .OR. LA .GT. 5.6)            GO TO 1010
      IF(TAPR .LT. 0.0 .OR. TAPR .GT. 1.0)        GO TO 1010
      IF(LER .LT. 0.0 .OR. LER .GT. 0.015)        GO TO 1010
      IF(TWIST .LT. -9.4 .OR. TWIST .GT. UNUSED)  GO TO 1010
      IF(YCM .LT. 0.0 .OR. YCM .GT. 0.0263)       GO TO 1010
      IF(CLD .LT. 0.0 .OR. CLD .GT. 0.45)         GO TO 1010
        IF(RN .LT. 8.0E5) RN = 8.0E5
        IF(RN .GT. 8.0E6) RN = 8.0E6
        CALL TABLEC(C,MACH)
        CM0 = C0 + C1/AR + C2*AR + C3*TANLE + C4*TOVC                   &
     &        + C5*LN + C6*LA + C7*TAPR + C8*TAPR**2 + C9*TR            &
     &        + C10*LER + C11*TWIST + C12*YCM + C13*CLD                 &
     &        + C14*WL + C15*VT + C16*HD + C17*DB + C18*RN/1.0E6
 1010 CONTINUE
      RETURN
      END
      SUBROUTINE WBCM1(A,WINGIN,BD,WB)
!
!*** COMPUTES (XAC/CBARR)B(W) FOR MACH=0.60
!
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      DIMENSION ROUTID(2),Q2136B(3),Q21C(3)
      DIMENSION A(195),WINGIN(4),WB(39),BD(87)
      DIMENSION C21C(6),X21C(13),Y21C(13)
      DIMENSION X38B(3),Y38B(3),C38B(6)
      DATA ROUTID/4HWBCM,4H1   /,Q2136B/4H4.3.,4H2.2-,4H36-B/,          &
     &     Q21C/4H4.2.,4H2.2-,4H35   /
!
!*********          PAGE 5-8 CALCULATIONS         **********************
!*********          FIGURE 4.3.2.2-36-B           **********************
!
      DATA X38B/0.0,1.0,1.0E06/
      DATA Y38B/0.0,0.50,0.50/
      DATA I38B/0/
!
!                  FIGURE 4.3.2.2-35
!
      DATA IN21C/0/
      DATA X21C/0.0,.025,.050,.075,.10,.15,.20,.30,.40,.50,.60,.70,.80/
      DATA Y21C/0.0,.056,.101,.130,.152,.190,.22,.266,.301,.33,.348,    &
     &.365,.375/
!
      SSPN = WINGIN(4)
      TEMP0= 0.25*A(7)*(1.+A(27))*A(38)
!
!*********     SELECT VALUE OF(X-PRIME)AC/(C)RE AT (BETA*A)= ZERO
!
      WB(15)= 0.50
      IF(TEMP0.GE.1.00) GO TO 1000
!
!*********          FIGURE 4.3.2.2-36-B
!
      CALL TBFUNX(TEMP0,WB(15),DYDX,3,X38B,Y38B,C38B,I38B,MI,NG,        &
     &            0,0,Q2136B,3,ROUTID)
!
!*********     COMPUTE VALUE OF (X-PRIME)AC/(C)RE AT (BETA*A)= 4.0
!
 1000 RATIO= BD(87)/(2.*SSPN)
      CALL TBFUNX(RATIO,BRAC,DYDX,13,X21C,Y21C,C21C,IN21C,MI,NG,        &
     &            0,0,Q21C,3,ROUTID)
      TEMP4= 0.25+(2.*SSPN-BD(87))/(2.*A(10))*A(44)*BRAC
!
!*********     IF (BETA*A).GT.ZERO AND .LT.4.0  USE ELLIPSE CURVE FIT
!         REVISIONS TO WBCM SUBROUTINE
!
      ARG=0.80*A(7)
      IF(ARG.LT.4.0) GO TO 1010
      WB(14)= TEMP4
      GO TO 1040
!
!*********     COMPUTE (X-PRIME)AC/(C)RE USING ELLIPSE CURVE FIT
!
 1010 X1= 4.0
      Y1= WB(15)
      Y= TEMP4
      P= 4.0
      Q= ABS(Y-Y1)
      BB= -2.0*Y1
      CC= (Y1*Y1-Q*Q+((Q/P)**2)*(ARG-X1)**2)
      IF((BB*BB-4.*CC).GT.0.0) GO TO 1030
 1020 FORMAT (30X,45H ELLIPSE CURVE FIT IN ERROR, WBCM SUBROUTINE  )
      WRITE(6,1020)
      RETURN
 1030 CONTINUE
!
!*********     SOLVE QUADRATIC EQUATION FOR WB(14), (NOTE, AA=1)
!
      YMAX= (-BB+SQRT(BB*BB-4.*CC))/2.0
      YMIN= (-BB-SQRT(BB*BB-4.*CC))/2.0
      WB(14)= YMAX
      IF(Y.LT.Y1) WB(14)= YMIN
 1040 WB(13)= WB(14)*A(10)/CBARR
      RETURN
      END
      SUBROUTINE WBDRAG (A,B,D,BD,WB,BW,BODY,WING,KBODY,KWING)
!
! *** CALCULATE SUBSONIC WING-BODY DRAG COEFFICIENT
!
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K
      DIMENSION ROUTID(2),Q33137(3)
      DIMENSION A(195),B(49),BD(59),WB(39),D(55),BW(21),BODY(2),WING(2)
      LOGICAL KBODY,KWING
!
!*********               WING-BODY DRAG CALCULATIONS             *******
! ***                       FIGURE 4.3.3.1-37
!         X237= R(L)FUS       X137= MACH NO.      Y37= R(WB)
!
      DIMENSION X237(19),X137(7),Y37(133)
      DATA X237/3.E06,5.E06,7.E06,1.E07,1.5E07,2.E07,2.5E07,3.E07,      &
     &3.5E07,4.E07,4.5E07,5.E07,6.E07,7.E07,8.E07,1.E08,1.5E08,2.E08,   &
     &7.E08/
      DATA X137/0.25,0.40,0.60,0.70,0.80,0.85,0.90/
      DATA Y37/1.063,1.070,1.073,1.076,1.072,1.066,1.057,1.045,1.025,   &
     &.9935,.9650,.9515,.9390,.9335,.9310,.9280,.9230,.9225,.9540 ,     &
     &1.020,1.023,1.028,1.036,1.050,2*1.058,1.050,1.032,1.018,1.008,    &
     &1.001,.9920,.9875,.9845,.9800,.9770,.9755,.9750 , .9800,.9840,    &
     &.9890,.9965,1.0080,1.0200,1.0325,1.0375,1.0350,1.0315,1.0280,     &
     &1.0230,1.0190,1.0155,5*1.0150 , .9550,.9600,.9647,.9725,.9830,    &
     &.9950,1.0085,1.0130,1.0140,1.0145,9*1.0150 , .9250,.9300,.9340,   &
     &.9420,.9530,.9655,.9775,.9885,.9965,1.0025,1.0080,1.0110,1.0145,  &
     &6*1.0150 , .9025,.9070,.9120,.9190,.9310,.9425,.9540,.9690,.9820, &
     &.9920,.9985,1.0035,1.0110,1.0140,5*1.015 , .8700,.8715,.8775,     &
     &.8840,.8960,.9090,.9225,.9400,.9570,.9725,.9865,.9935,1.0065,     &
     &1.0120,5*1.0150/
      DATA Q33137/4H4.3.,4H3.1-,4H37  /,ROUTID/4HWBDR,4HAG  /
!
!*********          WING-BODY ZERO LIFT DRAG           *****************
!
      WB(19)= A(129)*BD(1)
      CALL TLINEX(X137,X237,Y37,7,19,B(1),WB(19),WB(18),                &
     &            2,2,2,1,Q33137,3,ROUTID)
      WB(17)= (D(20)+BD(59))*WB(18)+BD(60)
      WB(6)=WB(17)
!
!*********          WING-BODY DRAG AT ANGLE-OF-ATTACK       ************
!
      DO 1000 J=1,NALPHA
         BW(J)= WB(17)+BD(J+214)+D(J+35)
         IF((KBODY .OR. KWING) .AND. (BODY(J) .NE. UNUSED .AND.         &
     &    WING(J) .NE. UNUSED)) BW(J) = BODY(J)+WING(J)
 1000 END DO
      RETURN
      END
      SUBROUTINE WBLIFT(A,B,DB,AIW,WB,BW,FACT,BODY,WING,WINGIN)
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG
      COMMON /CONSNT/ PI, DEG, UNUSED, RAD,kand
      COMMON /FLGTCD/ FLC(160)
      DIMENSION ROUTID(2),Q1210A(3),Q1210B(3),Q212A1(4),Q212A2(4),      &
     &          Q1212C(3),Q412B(3),Q412C(3)
      DIMENSION A(195),B(49),WB(39),BODY(101),WING(101),WINGIN(4)
      DIMENSION FACT(1),BW(1),ANG(20),CB(6),QCLINT(2)
      DIMENSION X10A(11),Y10A(11),C10A(6)
      DIMENSION X10B(11),Y10B(11),C10B(6)
      DIMENSION X12A1(11),Y12A1(11),C12A1(6)
      DIMENSION X12A2(11),Y12A2(11),C12A2(6)
      DIMENSION X12C(13),Y12C(13),C12C(6)
      DIMENSION XA12(5),XB12(7),Y412C(35),Y412B(35)
      DATA ROUTID /4HWBLI,4HFT  /
      DATA Q1210A /4H4.3.,4H1.2-,4H10-A/,                               &
     &     Q1210B /4H4.3.,4H1.2-,4H10-B/,                               &
     &     Q212A1 /4H4.3.,4H1.2-,4H12-A,4H1   /,                        &
     &     Q212A2 /4H4.3.,4H1.2-,4H12-A,4H2   /,                        &
     &     Q1212C /4H4.3.,4H1.2-,4H12-C/,                               &
     &     Q412B  /4H4.3., 4H1.4-, 4H12B  /,                            &
     &     Q412C  /4H4.3., 4H1.4-, 4H12C  /
!
!*********       KW(B) VS D/B  DATA FIGURE 4.3.1.2-10-A
!
      DATA X10A/0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y10A/1.0,1.08,1.16,1.26,1.36,1.46,1.56,1.67,1.78,1.89,2.0/
      DATA I10A/0/
!
! ****         KB(W) VS D/B  DATA  FIGURE 4.3.1.2-10-B
!
      DATA X10B/0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y10B/0.0,0.13,0.29,0.45,0.62,0.80,1.0,1.22,1.45,1.70,2.0/
      DATA I10B/0/
!
! ***          FIGURE 4.3.1.2-12-A1
!
      DATA X12A1/0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y12A1/1.0,0.97,0.95,4*0.94,0.95,0.96,0.98,0.99/
      DATA I12A1/0/
!
!*********          FIGURE 4.3.1.2-12-A2          **********************
!
      DATA X12A2/0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y12A2/0.0,0.11,0.21,0.31,0.41,0.51,0.60,0.70,0.80,0.90,1.0/
      DATA I12A2/0/
!
!*********          FIGURE 4.3.1.2-12-C           **********************
!
      DATA X12C/0.0,0.1,0.15,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.83,0.9,1.0/
      DATA Y12C/2*1.0,0.999,0.99,0.98,0.965,0.95,0.933,2*0.92,0.928,    &
     &0.95,1.0/
      DATA I12C/0/
!
!*********          FIGURE 4.3.1.4-12             **********************
!
      DATA XA12 /1., 2., 4., 6., 12. /
      DATA XB12 / 0., 0.05, 0.10, 0.15, 0.20, 0.25, 0.30 /
      DATA Y412B /                                                      &
     &    1.0, 0.998, 0.995, 0.989, 0.982, 0.968, 0.950,                &
     &    1.0, 0.995, 0.989, 0.978, 0.963, 0.937, 0.917,                &
     &    1.0, 0.992, 0.982, 0.965, 0.942, 0.900, 0.864,                &
     &    1.0, 0.967, 0.932, 0.911, 0.907, 0.945, 1.038,                &
     &    1.0, 0.983, 0.968, 0.962, 0.977, 1.027, 1.134 /
      DATA Y412C /                                                      &
     &    1.0, 1.013, 1.017, 1.013, 1.000, 0.982, 0.956,                &
     &    1.0, 1.003, 1.001, 0.992, 0.973, 0.937, 0.894,                &
     &    1.0, 0.989, 0.973, 0.944, 0.898, 0.822, 0.745,                &
     &    1.0, 0.980, 0.943, 0.879, 0.758, 0.648, 0.613,                &
     &    1.0, 0.942, 0.845, 0.688, 0.594, 0.552, 0.532 /
      DATA IY / 0 /, QCLINT / 4HCLIN, 4HT    /
!
!     COMPUTE BODY-DIAMETER-TO-WING-SPAN RATIO
!
      SSPN=WINGIN(4)
      RATIO= DB/(2.0*SSPN)
      AAA=1.0
      DO 1000 J=1,NALPHA
        ANG(J) = FLC(J+22)+AIW-B(49)
 1000 END DO
      DO 1040 J=1,NALPHA
         IF(RATIO.GT.0.80) GO TO 1020
!
!*********          FIGURE 4.3.1.2-10-A
!
         CALL TBFUNX(RATIO,WB(2),DYDX,11,X10A,Y10A,C10A,I10A,MI,NG,     &
     &                0,0,Q1210A,3,ROUTID)
!
!*********          FIGURE 4.3.1.2-10-B
!
         CALL TBFUNX(RATIO,WB(3),DYDX,11,X10B,Y10B,C10B,I10B,MI,NG,     &
     &               0,0,Q1210B,3,ROUTID)
         WB(4)= WB(2)*WING(101)*AAA
         WB(5)= WB(3)*WING(101)*AAA
         BW(101)= BODY(101)+WB(4)+WB(5)
         IF(AIW.NE.0.0) GO TO 1010
         GO TO 1030
!
!*********          FIGURE 4.3.1.2-12-A1
!
 1010    CALL TBFUNX(RATIO,WB(7),DYDX,11,X12A1,Y12A1,C12A1,I12A1,MI,NG, &
     &               0,0,Q212A1,4,ROUTID)
!
!*********          FIGURE 4.3.1.2-12-A2
!
         CALL TBFUNX(RATIO,WB(8),DYDX,11,X12A2,Y12A2,C12A2,I12A2,MI,NG, &
     &               0,0,Q212A2,4,ROUTID)
         WB(9)=WB(7)*WING(101)*AAA
         WB(10)=WB(8)*WING(101)*AAA
         WB(11)=WB(9)+WB(10)
         GO TO 1030
!
!****    CALCULATIONS WITH WING EXTENDING ENTIRE LENGTH OF BODY  *******
!****        (FOR LARGE BODY-DIAMETER-TO-WING-SPAN RATIOS)       *******
!****                                                            *******
!*********          FIGURE 4.3.1.2-12-C
!
 1020    CALL TBFUNX(RATIO,WB12,DYDX,13,X12C,Y12C,C12C,I12C,MI,NG,      &
     &               0,0,Q1212C,3,ROUTID)
         BW(101)= WB12*WING(101)*AAA
!
!*********          WING BODY LIFT IN NON-LINEAR            ************
!*********          ANGLE-OF-ATTACK RANGE                   ************
!
 1030    CONTINUE
!
!*********** LIFT COEFFICIENT (CL) CALCULATION *************************
!
         ALPEF=FLC(J+22)-B(49)+((WB(7)+WB(8))/(WB(2)+WB(3)))*AIW
         CALL TBFUNX(ALPEF,CLINT,DYDX,NALPHA,ANG,WING(21),              &
     &              CB,IY,MI,NG,1,1,QCLINT,2,ROUTID)
         BW(J+20)=BODY(J+20)+(WB(2)+WB(3))*CLINT
         BW(J+20)=BW(J+20)+FACT(J+1)*FACT(J+21)*B(J+22)*FACT(1)*        &
     &            WING(101)
!
!*********** NORMAL FORCE (CN) CALCULATION *****************************
!
         BW(J+60)=BW(J+20)*COS(B(J+22)/RAD)+BW(J)*SIN(B(J+22)/RAD)
!
!     ******* SEE SUBROUTINE WBCM FOR CA CALCULATION *******
!
 1040 END DO
      IF(RATIO .GT. 0.30) GO TO 1050
      CALL TLINEX(XA12,XB12,Y412B,5,7,A(160),RATIO,WB(20),              &
     &           0,0,0,0,Q412B,3,ROUTID)
      CALL TLINEX(XA12,XB12,Y412C,5,7,A(160),RATIO,WB(21),              &
     &           0,0,0,0,Q412C,3,ROUTID)
      WB(22) = WB(20)*B(44)
      WB(23) = WB(21)*B(43)
 1050 CONTINUE
      RETURN
      END
      SUBROUTINE WBTAIL
!
! *** CALCULATE SUBSONIC WING-BODY-TAIL AERO
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG
      COMMON /WINGI/  WINGIN(101)
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /BDATA/  BD(762)
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /WHWB/   FACT(182),WB(39)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /WBHCAL/ WBT(155)
      COMMON /WHAERO/ C(51),D(55),CHT(51),DHT(55),DVT(55),DVF(55)
      COMMON /IBW/    PBW,BW(380)
      COMMON /IBWH/   PBWH,BWH(380)
      COMMON /IWING/  PWING,WING(400)
      COMMON /IDWASH/ PDWASH,DWASH(60)
      COMMON /IBWHV/  PBWHV,BWHV(380)
      COMMON /WINGD/  A(195),B(49)
      COMMON /VTDATA/ AVT(195)
      COMMON /HTDATA/ AHT(195),BHT(49)
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /IHT/    PHT,HT(380)
      COMMON /HTI/    CHRDTP,SSPNOP,SSPNE,SSPN,CHRDBP,CHRDR,SAVSI,SAVSO,&
     &        CHSTAT,SWAFP,TWISTA,SSPNDD,DHDADI,DHDADO,TYPE,TOVC,DELTAY,&
     &       XOVC,CLII,ALPHAI,CLALPA(20),CLMAX(20),CMO,LERI,LERO,CAMBER,&
     &       TOVCO,XOVCO,CMOT,CLMAXL,CLMAO,TCEFF,KSHARP,XAC(20),RSVD(3),&
     &       RLPH(20),SHB(20),SEXT(20)
!
      LOGICAL CANARD
      DIMENSION CCDWB(6),CDH(20),CLH(20),CLAH(20)
      DIMENSION CC(6),CD(6),CE(6),CF(6),QCLHT(1),QCDHT(1),QCLAHT(1)
      DIMENSION X12A1(11),Y12A1(11),C12A1(6)
      DIMENSION X12A2(11),Y12A2(11),C12A2(6)
      DIMENSION ROUTID(2),Q1210A(3),Q1210B(3),Q212A1(4),Q212A2(4),      &
     &          QCDDER(4),QCDHTD(4),ANG(20)
      DIMENSION X10B(11),Y10B(11),C10B(6)
      DIMENSION X10A(11),Y10A(11),C10A(6),CB(6),QCLTB(1)
      EQUIVALENCE(AKHBI,WBT(150)),(AKBHI,WBT(151))
!
!*********     WING-BODY-TAIL DATA      (DATCOM METHOD)          *******
!
!*********          KH(B) VS D/B                  **********************
!*********          FIGURE 4.3.1.2-10-A           **********************
!
      DATA ROUTID/4HWBTA,4HIL  /,Q1210A/4H4.3.,4H1.2-,4H10-A/,          &
     & Q1210B/4H4.3.,4H1.2-,4H10-B/,Q212A1/4H4.3.,4H1.2-,4H12-A,4H1   /,&
     & Q212A2/4H4.3.,4H1.2-,4H12-A,4H2   /
      DATA QCDDER/4HCDWB,4H DER,4HIVAT,4HIVES/
      DATA QCDHTD/4HCDHT,4H DER,4HIVAT,4HIVES/
      DATA QCLHT /4HCLHT/,QCDHT/4HCDHT/,QCLAHT/4HCLAH/
      DATA X10A/0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y10A/1.0,1.08,1.16,1.26,1.36,1.46,1.56,1.67,1.78,1.89,2.0/
      DATA I10A/0/
!
!*********          KB(H) VS D/B                  **********************
!*********          FIGURE 4.3.1.2-10-B           **********************
!
      DATA X10B/0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y10B/0.0,0.13,0.29,0.45,0.62,0.80,1.0,1.22,1.45,1.70,2.0/
      DATA I10B/0/
      DATA X12A1/0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y12A1/1.0,0.97,0.95,4*0.94,0.95,0.96,0.98,0.99/
      DATA I12A1/0/
!
!*********          FIGURE 4.3.1.2-12-A2          **********************
!
      DATA X12A2/0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA Y12A2/0.0,0.11,0.21,0.31,0.41,0.51,0.60,0.70,0.80,0.90,1.0/
      DATA I12A2/0/
      DATA QCLTB / 4HCLTB /
!
!*********     ADDITIONAL TAIL GEOMETRY FOR WBT CALCULATIONS     *******
!
      CANARD = WINGIN(101) .GT. 2.5
      SINAI=0.
      COSAI=1.
      TANAI=0.
      BD(58)=(SSPN-SSPNE)*AHT(62)*COSAI
      BD(84)=XCG-(XH+BD(58))
      BD(762)=ZH-BD(58)*TANAI
      BD(761)=CHT(6)*AHT(10)
      BD(64)=BD(762)-BD(761)*SINAI-ZCG
      BD(63)=XCG-(BD(761)+BD(58)+XH)
      BD(31)=(BD(63)+BD(64)*TANAI)*COSAI
      BD(30)=BD(64)/COSAI-(BD(63)+BD(64)*TANAI)*SINAI
      BD(8)=XH-AHT(161)*COSAI
!
!*********    COMPUTE THE DERIVATIVES OF THE (CD) WB ARRAY        ******
!
      DO 990 J=1,NALPHA
  990 ANG(J) = BHT(J+22)-BHT(49)
      ICDWB=0
      DO 1000 J=1,NALPHA
         ALPAT=BHT(J+22)
         IF(.NOT. CANARD) ALPAT=BHT(J+22)-DWASH(J+20)-BHT(49)
         IY=0
         CALL TBFUNX(ALPAT,CLH(J),DYDX,NALPHA,ANG,HT(21),CD,IY,         &
     &               MI,NG,1,1,QCLHT,1,ROUTID)
         IZ=0
         CALL TBFUNX(ALPAT,CLAH(J),DYDX,NALPHA,ANG,HT(101),CE,IZ,       &
     &               MI,NG,1,1,QCLAHT,1,ROUTID)
         IA=0
         CALL TBFUNX(ALPAT,CDH(J),DYDX,NALPHA,ANG,HT(1),CF,IA,          &
     &               MI,NG,1,1,QCDHT,1,ROUTID)
 1000 CALL TBFUNX(FLC(J+22),YARG,BD(J+94),NALPHA,FLC(23),BW(1),CCDWB,   &
     &            ICDWB,MI,NG,0,0,QCDDER,4,ROUTID)
 1010 RATIO=(SSPN-SSPNE)/SSPN
!
!*********          FIGURE 4.3.1.2-12-A1
!
      CALL TBFUNX(RATIO,AKHBI,DYDX,11,X12A1,Y12A1,C12A1,I12A1,MI,NG,    &
     &            0,0,Q212A1,4,ROUTID)
!
!*********          FIGURE 4.3.1.2-12-A2
!
      CALL TBFUNX(RATIO,AKBHI,DYDX,11,X12A2,Y12A2,C12A2,I12A2,MI,NG,    &
     &            0,0,Q212A2,4,ROUTID)
!
!********      COMPUTE (CL-ALPHA)WBT     ( DATCOM )         ************
!
      CALL TBFUNX(RATIO,WBT(1),DYDX,11,X10A,Y10A,C10A,I10A,MI,NG,       &
     &            0,0,Q1210A,3,ROUTID)
      CALL TBFUNX(RATIO,WBT(2),DYDX,11,X10B,Y10B,C10B,I10B,MI,NG,       &
     &            0,0,Q1210B,3,ROUTID)
 1020 WBT(3)=WBT(1)*HT(101)
      WBT(4)=WBT(2)*HT(101)
!
!*********          COMPUTE ((CLALPHA)WBT)J1                     *******
!
      WBT(108)=SSPN-SSPNE
      WBT(109)=XH+AHT(161)
      DO 1110 J=1,NALPHA
         ALPAT=BHT(J+22)
         IF(.NOT. CANARD) ALPAT=BHT(J+22)-DWASH(J+20)
         BWH(J+100)=BW(101)+(WBT(3)+WBT(4))*(1.0-DWASH(J+40))*DWASH(J)
         IF(.NOT. CANARD) GO TO 1030
         ANUM=WING(101)*HT(101)*DWASH(J)*WB(2)*FACT(J+41)*SSPNE
         ADEN=2.0*PI*AHT(7)*(FACT(J+81)/2.0-WINGIN(4)+WINGIN(3))
         WBT(J+25)=(ANUM/ADEN)*RAD*SREF/AHT(3)
         BWH(J+100)=BW(101)+(WBT(3)+WBT(4))*DWASH(J)+WBT(J+25)
         FACT(J+121)=-WBT(J+25)/((WBT(3)+WBT(4))*DWASH(J))
 1030    CONTINUE
!
!************            CALCULATE (CL)WBT                    **********
!
         ALPEF=FLC(J+22)-BHT(49)+((AKHBI+AKBHI)/(WBT(1)+WBT(2)))*ALIH
         ALPAHT=BHT(J+22)-BHT(49)
         IF(.NOT. CANARD) ALPEF=ALPEF-DWASH(J+20)
         IF(.NOT.CANARD)ALPAHT=ALPAHT-DWASH(J+20)
         CALL BODOWG(FLC(23),WBT(109),WBT(108),SSPN,AHT(27),WBT(68),    &
     &               WBT(46),NALPHA)
         WBT(J+129)=WBT(J+67)*WBT(J+45)*WBT(108)*DWASH(J)*HT(101)*      &
     &              ALPAHT/SSPN
      ALPA=FLC(J+22)-DWASH(J+20)
      IY=0
      CALL TBFUNX(ALPEF,WBT(J+109),DYDX,NALPHA,ANG,HT(21),CB,IY,MI,NG,  &
     &            1,1,QCLTB,1,ROUTID)
      WBT(J+109)=WBT(J+109)*DWASH(J)*(WBT(1)+WBT(2))
      IF(.NOT. CANARD) GO TO 1060
      BWH(J+20)=BW(J+20)+WBT(J+109)+WBT(J+129)+WBT(J+25)*FLC(J+22)
      FACT(J+101)=0.0
      IF(ALPAHT .NE. 0.0) FACT(J+101) = (-WBT(J+25)*(B(J+22)-B(49)))/   &
     &                            (HT(101)*(WBT(1)+WBT(2))*DWASH(J))
      GO TO 1070
 1060 CONTINUE
      BWH(J+20)=BW(J+20)+WBT(J+109)+WBT(J+129)
 1070 CONTINUE
!
!************             CALCULATE (CM)ALPHA WBT             **********
!
      IF(CANARD) ALPA=FLC(J+22)
      SA=SIN(ALPA/RAD)
      CA=COS(ALPA/RAD)
      DXACWB=BW(121)/BW(101)
      APART=(DXACWB)*((-BW(J+20)/RAD+BD(J+94))*SIN(FLC(J+22)/RAD)+      &
     &      (BW(101)+BW(J)/RAD)*COS(FLC(J+22)/RAD))
      BPART=((BD(70))/CBARR)*((BW(101)+BW(J)/RAD)*SIN(FLC(J+22)         &
     &      /RAD)+(BW(J+20)/RAD-BD(J+94))*COS(FLC(J+22)/RAD))
      IK=0
      CALL TBFUNX(ALPAT,CDHT,DCDDA,NALPHA,BHT(23),HT(1),CC,IK,MI,NG,    &
     &            0,0,QCDHTD,4,ROUTID)
      CLHT=(BWH(J+20)-BW(J+20))/DWASH(J)
      DCLDA=WBT(3)+WBT(4)
      IF(.NOT. CANARD) GO TO 1080
      DCLDA=DCLDA+WBT(J+25)/DWASH(J)
 1080 CONTINUE
      CPART=(-CLHT/RAD+DCDDA)*SA
      DPART=(CLHT/RAD-DCDDA)*CA
      EPART=DWASH(J)*(1.0-DWASH(J+40))
      FPART=(DCLDA+CDHT/RAD)*SA
      GPART=(DCLDA+CDHT/RAD)*CA
      WBT(J+87)=(BD(63)/CBARR)*(CPART+GPART)*EPART-(BD(64)/             &
     &          CBARR)*(FPART+DPART)*EPART
      IF(.NOT. CANARD) GO TO 1090
      WBT(J+87)=WBT(J+87)/(1.0-DWASH(J+40))
 1090 BWH(J+120)=APART-BPART+WBT(J+87)
      IF(BW(J+40) .EQ. 2.*UNUSED) BWH(J+120)=2.*UNUSED
!
!************             CALCULATE (CM)WBT                *************
!
      DCLHT=(((BWH(J+20)-BW(J+20))/DWASH(J)+CDH(J)*SIN(DWASH(J+20)/RAD))&
     &   /COS(DWASH(J+20)/RAD))*DWASH(J)
      IF(CANARD)DCLHT=BWH(J+20)-BW(J+20)
      COSA=CA
      SINA=SA
      CDHQ=CDH(J)*DWASH(J)
      CMOHQ=BHT(47)*DWASH(J)
      BWH(J+40)=BW(J+40)+(BD(63)/CBARR)*(DCLHT*COSA+CDHQ*SINA)          &
     &        +(BD(64)/CBARR)*(CDHQ*COSA-DCLHT*SINA)+CMOHQ
      IF(BW(J+40) .EQ. 2.*UNUSED)BWH(J+40)=2.*UNUSED
!
!**** VERTICAL TAIL CDO FROM VT DRAG SUBROUTINE
!
      WBT(66)=DVT(20)+DVF(20)
!
!**** CALCULATE CD0 WING BODY HORIZONTAL AND VERTICAL TAIL *************
!
 1100 WBT(67)=WB(17)+BHT(46)+WBT(66)
!
!*********     COMPUTE (CD)WBT AT ANGLE-OF-ATTACK                *******
!*********     SINGLE VERTICAL TAIL (UPPER PANEL)                *******
!
      EPS=DWASH(J+20)
      IF(CANARD)EPS=0.
      BWHV(J)=BW(J)+WBT(66)+(CDH(J)*COS(EPS/RAD)+CLH(J)*                &
     &        SIN(EPS/RAD))*DWASH(J)
      BWH(J)=BWHV(J)-WBT(66)
 1110 END DO
      RETURN
      END
      SUBROUTINE WBTCDO
!
! *** CALCULATES TRANSONIC WING-BODY-TAIL ZERO LIFT DRAG
!
      COMMON /IBWHV/  PBWT, CDO
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /WINGI/  WINGIN(100)
      COMMON /BODYI/  BODYIN(126),ITYPE,dum2(2)
      COMMON /WINGD/  A(195)
      COMMON /LEVEL2/ SEC(10),CD6,CD7,CD11,CD14,SEC2(8),MD
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
!
      EQUIVALENCE (A(7),AR), (WINGIN(16),TOC), (A(27),TAPR),            &
     &            (A(40),SWEEP)
      REAL M,MD,ITYPE
      DIMENSION PARMA(16),PARMB(20),PARMC(6),PARMD(26),XUNIT(56),       &
     &   YUNIT(50),ZUNIT(9),TMD(39),Q4519(3),ROUT(2),LENG(4),VAR(4)
      DATA ROUT/4HWBTC,4HDO  /,Q4519/4H4.5.,4H3.1-,4H19  /
      DATA PARMA/0.,10.,20.,30.,40.,50.,60.,0.,.03,.04,.05,.06,.07,.08, &
     & .10,.12/
      DATA PARMB/2.,3.,4.,6.,8.,5*0.,0.,1.,2.,3.,4.,5.,6.,7.,8.,9./
      DATA PARMC/0.,.5,1.,0.,8.,16./
      DATA PARMD/1.,2.,3.,10*0.,0.,1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,  &
     &  12./
      DATA XUNIT/6.8,7.25,7.75,8.40,9.40,10.8,12.8,5.,5.45,6.05,6.8,7.8,&
     &9.25,11.15,4.25,4.75,5.3,6.1,7.1,8.7,10.6,3.55,3.9,4.45,5.3,6.5,  &
     &8.1,10.05,3.05,3.4,3.9,4.75,5.85,7.6,9.7,2.5,2.8,3.2,4.,5.2,6.95, &
     &9.25,1.5,1.8,2.45,3.25,4.5,6.3,8.75,.75,1.15,1.75,2.6,3.85,5.75,  &
     &8.20/
      DATA YUNIT/3.2,2.5,1.95,1.,.4,4.25,3.75,3.,2.1,1.5,5.4,4.8,4.,    &
     &3.25,2.7,6.5,5.9,5.1,4.4,3.8,7.6,7.,6.25,5.55,5.,8.6,8.,7.4,      &
     &6.9,6.3,9.55,9.1,8.7,8.25,7.7,10.45,10.15,9.9,9.65,9.25,5*11.15,  &
     &12.,12.2,12.7,13.,14.25/
      DATA ZUNIT/3*.13,7.78,8.18,8.53,15.43,16.23,16.93/
      DATA TMD/.755,.761,.77,.77,.78,.79,.788,.798,.81,.804,.815,.830,  &
     &.82,.83,.85,.836,.848,.87,.85,.864,.89,.865,.88,.905,.879,.898,   &
     &.925,.892,.912,.944,.905,.925,.96,.92,.942,.978,.932,.958,.992/
!
!**** TRANSONIC WING-BODY-TAIL CDO - DATCOM SECTION 4.5.3.1 ************
!**** COMPUTE THE DRAG DIVERGENCE MACH NUMBER, MD
!
!**** WORK ALONG FIGURE 4.5.3.1-19
!**** SWEEP VERSUS THICKNESS RATIO - PART A
!
      M=FLC(I+2)
      VAR(1)=SWEEP
      VAR(2)=TOC
      LENG(1)=7
      LENG(2)=8
      CALL INTERX(2,PARMA,VAR,LENG,XUNIT,X,8,56,1,2,0,0,1,2,0,0,        &
     &            Q4519,3,ROUT)
!
!**** GO INTO THE ASPECT RATIO PART OF THE FIGURE - PART B
!
      VAR(1)=AR
      VAR(2)=X
      LENG(1)=5
      LENG(2)=10
      CALL INTERX(2,PARMB,VAR,LENG,YUNIT,Y,10,50,1,1,0,0,1,1,0,0,       &
     &            Q4519,3,ROUT)
!
!**** NOW TAPER RATIO - PART C
!
      VAR(1)=TAPR
      VAR(2)=Y
      LENG(1)=3
      LENG(2)=3
      CALL INTERX(2,PARMC,VAR,LENG,ZUNIT,Z,3,9,1,1,0,0,1,1,0,0,         &
     &            Q4519,3,ROUT)
!
!**** TO THIS POINT THE SOLUTION IS INDEPENDENT OF GEOMETRY
!**** ITYPE IS THE TYPE OF GEOMETRY TO BE USED FOR THE FINAL SOLUTION
!
      VAR(1)=ITYPE
      VAR(2)=Z
      LENG(1)=3
      LENG(2)=13
      CALL INTERX(2,PARMD,VAR,LENG,TMD,MD,13,39,1,1,0,0,1,1,0,0,        &
     &            Q4519,3,ROUT)
!
!**** MD NOW CALCULATED, NEED TO CALCULATE CDO AT DESIRED MACH NUMBER
!**** TO COMPLETE THE CALCULATION ... FAIR A CURVE THROUGH THE TRANSONIC
!
      IF(CD11 .NE. UNUSED) GO TO 1000
        IF((CD14 .EQ. UNUSED) .AND. (M .GT. MD)) RETURN
        CD11 = 2.1381*CD14
 1000 CONTINUE
      DCD6=(CD7-CD6)/.1
      DCD11=(CD14-CD11)/.3
      A0=CD7+.002
      A1=0.10
      A2=-.002-.1*(.7-MD)
      IF(M.GT.MD)A2=CD11-A0-.1*(1.1-MD)
      EXPN=((DCD6-.1)*(.7-MD))/(CD7-A0-.1*(.7-MD))
      IF(M.GT.MD)EXPN=((DCD11-.1)*(1.1-MD))/(CD11-A0-.1*(1.1-MD))
      IF(M.LE.MD)CDO=A0+A1*(M-MD)+A2*((M-MD)/(0.7-MD))**(EXPN)
      IF(M.GT.MD)CDO=A0+A1*(M-MD)+A2*((M-MD)/(1.1-MD))**(EXPN)
      RETURN
      END
      SUBROUTINE WBTRA
!
! *** CALCULATES TRANSONIC WING-BODY CDL
!
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG
      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,          &
     &                KBODY, KWING, KHT, KVT, KWB,                      &
     &                KDWASH(3), ALPO, ALPL
      COMMON /CONSNT/ CONST(5)
      COMMON /IDWASH/ PDWASH,DWASH(60)
      COMMON /IWING/  PWING,WING(400)
      COMMON /IBODY/  PBODY,BODY(400)
      COMMON /IVT/    PVT,VT(380)
      COMMON /IVF/    PVF,VF(380)
      COMMON /IHT/    PHT,HT(380)
      COMMON /IBH/    PBH,BH(380)
      COMMON /IBW/    PBW,BW(380)
      COMMON /IBV/    PBV,BV(380)
      COMMON /IBWH/   PBWH,BWH(380)
      COMMON /IBWV/   PBWV,BWV(380)
      COMMON /IBWHV/  PBWHV,BWHV(380)
      DIMENSION KEY(3)
      LOGICAL KDWASH
      EQUIVALENCE (KEY(1),KQOQIN), (KEY(2),KEPSLN), (KEY(3),KDEODA)
      EQUIVALENCE(UNUSED,CONST(3))
!
      CALL EXSUBT
      DO 1000 J=1,3
         KEY(J) = 0
         IF(KDWASH(J)) KEY(J) = 1
 1000 END DO
      CALL TRAWBT(KDEODA,KQOQIN)
!
!     SET IOM FOR DOWNWASH RESULTS AND HT, VT, B-W, B-W-H, B-W-V,
!                      AND B-W-H-V CL-ALPHA
!
      DWASH(21) = 0.0
      BWH(101) = BWHV(101)
      VT(21)   = 0.0
      VT(41)   = 0.0
      VT(61)   = 0.0
      VT(101)  = 0.0
      VT(121)  = 0.0
      VF(21)   = 0.0
      VF(41)   = 0.0
      VF(61)   = 0.0
      VF(101)  = 0.0
      VF(121)  = 0.0
      BWV(101) = BW(101)
      BWV(121) = BW(121)
      BV(101) = BODY(101)
      BV(121) = BODY(121)
      DO 1010 J=2,NALPHA
         DWASH(J)    = -UNUSED
         DWASH(J+20) = -UNUSED
         DWASH(J+40) = -UNUSED
 1010 END DO
      DO 1040 II=1,9
         INDX = 20*(II-1)
         DO 1030 J=2,NALPHA
            WING(INDX+J) = -UNUSED
            HT(INDX+J)   = -UNUSED
            VT(INDX+J)   = -UNUSED
            VF(INDX+J)   = -UNUSED
            BV(INDX+J)   = -UNUSED
            BWH(INDX+J)  = -UNUSED
            IF(II .NE. 3) BWV(INDX+J)  = -UNUSED
            BWHV(INDX+J) = -UNUSED
            IF(II .EQ. 1) GO TO 1020
             BW(INDX+J) = -UNUSED
             BH(INDX+J) = -UNUSED
 1020       CONTINUE
            IF(II .NE. 1) GO TO 1030
            IF(BW(INDX+J) .EQ. UNUSED) BW(INDX+J) = -UNUSED
            IF(BH(INDX+J) .EQ. UNUSED) BH(INDX+J) = -UNUSED
 1030    CONTINUE
 1040 END DO
      CALL EXSUBT
      RETURN
      END
      SUBROUTINE WBTRAN(I)
!
!*** COMPUTES (XAC/CBARR)B(W) FOR MACH=1.40,TRANSONIC WING-BODY CLALPHA
!
      DIMENSION ROUTID(2),Q1211A(3),Q1211B(3),Q31210(3),Q2137A(3),      &
     &          Q2137B(3)
      REAL MACH,NXX,KWB,KBW,IVBW  ,KKBW,KKWB
      DIMENSION CDW(20),CDB(20),WTYPE(4),IVBW(20),GAMMA(20)
      DIMENSION T4337A(11),D4337A(24),T4337B(12),D4337B(20)
      DIMENSION T4311A(38),D4311A(285),DUMYA(150),DUMYB(135)
      DIMENSION TFIG10(11),DKWB10(11),DKBW10(11)
      DIMENSION T4311B(24),D4311B(135)
      DIMENSION LGH(4),VAR(4),CD(20),CN(20),CA(20),CL(20),CLB(20),      &
     &          CLW(20),ALPHAB(20)
      LOGICAL       FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,    &
     &              HEAD,PRPOWR,JEQPOW,LOASRT,TVTPAN,                   &
     &              SUPERS,SUBSON,TRANSN,HYPERS
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JEQPOW,LOASRT,TVTPAN,                 &
     &                SUPERS,SUBSON,TRANSN,HYPERS
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /FLGTCD/ FLC(93), dumflgtcd(67)
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      COMMON /BODYI/  NXX,XCOOR(20), dum2(108)
      COMMON /WINGI/  WINGIN(77)
      COMMON /WINGD/  A(195)
      COMMON /BDATA/  BD(762)
      COMMON /SUPBOD/ SBD(227)
      COMMON /SUPWBB/  SWB(61)
      COMMON /SBETA/  STB(135), TRA(108)
      COMMON /IBODY/  PB, BODY(400)
      COMMON /IWING/  PW, WING(400)
      COMMON /IBW/    PBW, BW(380)
      EQUIVALENCE (D4311A(1),DUMYA(1)),(D4311A(151),DUMYB(1))
      EQUIVALENCE (CA(1),BW(81)),(CR,WINGIN(6)),(CDW(1),WING(1))        &
     &,(KKWB,SWB(2)),(SPANS,WINGIN(3)),(ARSTAR,A(7))                    &
     &,(CD(1),BW(1)),(DD,SWB(5)),(CLB(1),BODY(21))                      &
     &,(SPAN,WINGIN(4)),(XACBW,SWB(8))
      EQUIVALENCE (CL(1),BW(21)),(KBW,SWB(11)),(TANL,A(62))             &
     &,(IVBW(1),SWB(12)),(RKBW,SWB(32)),(CRSTAR,A(10))                  &
     &,(TAPEXP,A(27)),(CN(1),BW(61)),(CDB(1),BODY(1))                   &
     &,(CLW(1),WING(21)),(KWB,SWB(35))                                  &
     &,(DN,SBD(4)),(D1,SBD(5)),(KKBW,SWB(37))
      EQUIVALENCE (XACA,SWB(39)),(GAMMA(1),SWB(40)),                    &
     &(TRINO,SWB(60)),(ALPHAB(1),BD(255))
      EQUIVALENCE (CLAB,BODY(101)),(CLAW,WING(101)),(CLA,BW(101))       &
     &,(CLABW,TRA(72)),(CLAWB,TRA(71))
      DATA Q1211A /4H4.3.,4H1.2-,4H11A /, Q2137A/4H4.3.,4H2.2-,4H37A /, &
     &     Q1211B /4H4.3.,4H1.2-,4H11B /, Q2137B/4H4.3.,4H2.2-,4H37B /, &
     &     Q31210 /4H4.3.,4H1.2-,4H10  /, ROUTID/4HWBTR,4HAN  /
      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
!
!                   FIGURE 4.3.1,2-10 KWB
!
      DATA TFIG10/0.0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.0/
      DATA DKWB10/1.0,1.08,1.16,1.26,1.36,1.46,1.56,1.67,1.78,1.89,2.0/
!
!                   FIGURE 4.3.1.2-10 KBW
!
      DATA DKBW10/0.0,.13,.29,.45,.62,.80,1.0,1.22,1.45,1.70,2.0/
!
!                   FIGURE 4.3.1.2-11A  KBW(WITH AFTERBODY)
!
      DATA T4311A/                                                      &
     &.0,.2,.4,.6,.8,1.,1.2,1.4,1.6,1.8,2.,2.4,2.8,3.2,4.,  4*0.,       &
     &0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.,1.2,1.6,2.,3.,4.,8.,10.,999999./
      DATA DUMYA/15*0,.75,.58,.47,.38,.33,.32,.3,.3,.29,                &
     & .28, .27, .25, .23, .21, .19,                                    &
     & 1.45, 1.2, 1., .87, .78, .75, .7, .68, .64, .6, .58, .55,        &
     &    .5,.48,.4,                                                    &
     & 1.95, 1.7, 1.48, 1.33, 1.2, 1.12, 1.07, 1., .97, .92,            &
     &    .88,.82,.75,.72,.64,                                          &
     & 2.5, 2.2, 1.93, 1.74, 1.58, 1.5, 1.42, 1.38, 1.3, 1.25,          &
     &    1.2,1.1,1.,.93,.8,                                            &
     & 2.95, 2.6, 2.25, 2.05, 1.89, 1.8, 1.7, 1.65, 1.57, 1.5,          &
     &    1.48,1.36,1.27,1.2,1.03,                                      &
     & 3.3,  2.92, 2.6, 2.35, 2.18, 2.04, 1.95, 1.86, 1.8,              &
     &    1.73,1.7,1.59,1.49,1.4,1.21,                                  &
     & 3.7, 3.32, 2.99, 2.7, 2.5, 2.33, 2.23, 2.12, 2.03,               &
     &    1.97,1.9,1.8,1.7,1.6,1.42,                                    &
     & 4.1, 3.64, 3.25, 2.97, 2.77, 2.6, 2.45, 2.32, 2.23,              &
     &    2.15,2.1,1.95,1.85,1.76,1.62,                                 &
     & 4.3, 3.83, 3.49, 3.2, 2.99, 2.8, 2.65, 2.5, 2.42, 2.33,          &
     &    2.29,2.14,2.,1.89,1.74/
      DATA DUMYB/4.6,4.08,3.69,3.35,3.14,2.95,2.8,                      &
     & 2.69, 2.6, 2.49, 2.4, 2.25, 2.16, 2.02, 1.85,                    &
     & 5., 4.37, 3.98, 3.64, 3.39, 3.19, 3.03, 2.89, 2.8,               &
     &    2.7, 2.61, 2.43, 2.33, 2.21, 2.,                              &
     & 5.45, 4.75, 4.29, 3.95, 3.7, 3.5, 3.34, 3.2, 3.1, 3.,            &
     &    2.91,2.75,2.6,2.48,2.28,                                      &
     & 5.9, 5.1, 4.63, 4.25, 4., 3.8, 3.65, 3.5, 3.33, 3.23,            &
     &    3.14,2.95,2.8,2.67,2.4,                                       &
     & 6.2, 5.5, 5., 4.65, 4.35, 4.15, 3.98, 3.8, 3.67,                 &
     &    3.53,3.4,3.24,3.1,2.92,2.68,                                  &
     & 6.6, 5.75, 5.25, 4.9, 4.6, 4.4, 4.22, 4.05, 3.91,                &
     &    3.78,3.68,3.45,3.26,3.1,2.83,                                 &
     & 7.05, 6.15, 5.6, 5.2, 4.95, 4.7, 4.49, 4.3, 4.13,                &
     &    4.,3.85,3.68,3.5,3.34,3.1,                                    &
     & 7.4, 6.35, 5.8, 5.4, 5.12, 4.85, 4.67, 4.49, 4.33,               &
     &    4.2,4.07,3.85,3.65,3.5,3.24,                                  &
     & 8., 6.73, 6.2, 5.8, 5.5, 5.25, 5., 4.82, 4.67,                   &
     &    4.5,4.35,4.12,3.9,3.8,3.59/
!
!                   FIGURE 4.3.1.2-11B  KBW(NO AFTERBODY)
!
      DATA T4311B/0.,.2,.4,.6,.8,1.,1.2,1.4,1.6,1.8,2.,2.4,2.8,3.2,4.,  &
     & 0.,.2,.4,.6,.8,1.,2.,4.,999999./
      DATA D4311B/15*0.,1.2,1.,.75,.58,.45,.37,.3,.28,.24,.2,.18,       &
     &    .15,.13,.11,.1,                                               &
     & 2.4, 1.85, 1.42, 1.1, .92, .77, .66, .6, .51, .48, .41,          &
     &    .31,.26,.22,.22,                                              &
     & 3.5, 2.6, 2., 1.58, 1.28, 1.07, .91, .78, .7, .6, .52,           &
     &    .42,.39,.33,.3,                                               &
     & 4.3, 3.1, 2.35, 1.8, 1.45, 1.2, 1.04, .92, .83, .75,             &
     &    .68,.55,.48,.4,.38,                                           &
     & 5., 3.65, 2.78, 2.22, 1.82, 1.5, 1.3, 1.15, 1., .92,             &
     &    .82,.69,.58,.5,.42,                                           &
     & 5.75, 4.55, 3.66, 2.9, 2.3, 1.92, 1.62, 1.42, 1.25, 1.1,         &
     &    .97,.82,.7,.63,.52,                                           &
     & 6.7, 5.25, 4.18, 3.32, 2.63, 2.2, 1.88, 1.62, 1.45,              &
     &    1.28,1.15,1.,.85,.75,.62,                                     &
     & 7.6, 6.2, 4.91, 3.95, 3.18, 2.6, 2.22, 1.91, 1.7, 1.5,           &
     &    1.35,1.12,.97,.85,.7/
!
!                   FIGURE 4.3.2.2.-37A
!
      DATA T4337A/0.0,.4,.8,1.2,1.6,2.,2.4,2.8,                         &
     &.1,1.0,999999./
      DATA D4337A/                                                      &
     &.5,.72,.900,1.08,1.24,1.39,1.53,1.68,                             &
     &.5,.72,.910,1.09,1.25,1.41,1.57,1.72,                             &
     &.5,.73,.920,1.11,1.27,1.43,1.59,1.74/
!
!                   FIGURE 4.3.2.2.-37B
!
      DATA T4337B/0.0,.1,.2,.3,.4,.5,.6,.8,1.0,2.8,                     &
     &            0.2,999999./
      DATA D4337B/                                                      &
     &0.5,.56,.595,.62,.64,.65,.66,.669,.669,.671,                      &
     &0.5,.54,.578,.60,.62,.638,.649,.66,.669,.671/
!
      NX=NXX+.5
      DCYL=(DN+D1)/2.
      MACH=FLC(I+2)
      RLB=XCOOR(NX)
      DD=2.0*(SPAN-SPANS)
      TANLE=TANL
      IF(TANLE.EQ.0.0)TANLE=.00001
      IF(MACH.EQ.1.)BETA=.0000001
      IF(MACH.EQ.1.)GO TO 1030
      IF(MACH.GT.1.)BETA=SQRT(MACH**2-1.)
      IF(MACH.LT.1.)BETA=SQRT(1.-MACH**2)
!
!   ***SUPERSONIC WING-BODY LIFT CURVE SLOPE,BODY IN PRESENCE OF WING***
!                         NON-TRIANGULAR WINGS
!
      IF(TAPEXP.EQ.0.0)GO TO 1050
      ARG1=BETA*ARSTAR*(1.0+TAPEXP)
      ARG2=1.+TANLE/BETA
      TRINO=ARG1*ARG2
      IF(TRINO.LE.4.)GO TO 1030
 1000 LGH(1)=15
      ARG=(XW+CR)/RLB
      VAR(1)=BETA* DD/CRSTAR
      VAR(2)=BETA/TANLE
      IF(ARG.GT.1.)GO TO 1010
      LGH(2)=19
!
!                   FIGURE 4.3.1.2-11A
!
      CALL INTERX(2,T4311A,VAR,LGH,D4311A,RKBW,19,285,                  &
     &            2,0,0,0,1,0,0,0,Q1211A,3,ROUTID)
      GO TO 1020
 1010 LGH(2)=9
!
!                   FIGURE 4.3.1.2-11B
!
      CALL INTERX(2,T4311B,VAR,LGH,D4311B,RKBW,15,135,                  &
     &            2,0,0,0,1,0,0,0,Q1211B,3,ROUTID)
 1020 KBW=RKBW/(RAD*BETA*(SREF/A(3))*CLAW*(TAPEXP+1.)*(2.*SPAN/DD-1.) )
      GO TO 1040
 1030 CONTINUE
      LGH(1)=11
      VAR(1)=DD/(2.*SPAN)
!
!                   FIGURE 4.3.1.2-10 KBW
!
      CALL INTERX(1,TFIG10,VAR,LGH,DKBW10,KBW,11,11,                    &
     &            0,0,0,0,0,0,0,0,Q31210,3,ROUTID)
 1040 CONTINUE
      GO TO 1060
!
!  ***SUPERSONIC WING-BODY LIFT CURVE SLOPE,BODY IN PRESENCE OF WING***
!                         TRIANGULAR WING
!
 1050 CONTINUE
      ARG=BETA*ARSTAR
      IF(ARG.GT.1.)GO TO 1000
      GO TO 1030
 1060 CONTINUE
!
!  ***SUPERSONIC WING-BODY LIFT CURVE SLOPE
!
      ALBO=BD(81)
      IF(BD(81).EQ.UNUSED)ALBO=0.0
      DO 1070 J=1,NALPHA
 1070 ALPHAB(J)=FLC(J+22)+ALBO
      VAR(1)=(SPAN-SPANS)/SPAN
      LGH(1)=11
!
!                   FIGURE 4.3.1.2-10 KWB
!
      CALL INTERX(1,TFIG10,VAR,LGH,DKWB10,KWB,11,11,                    &
     &            0,0,0,0,0,0,0,0,Q31210,3,ROUTID)
      CLAWB=CLAW*KWB
      CLABW=CLAW*KBW
      CLA=CLABW+CLAWB+CLAB
!
!  ***SUPERSONIC WING-LIFT CARRYOVER ON BODY***
!
      BETA=.98
      VAR(1)=BETA*DD/CRSTAR
      VAR(2)=BETA/TANLE
      ARG=(XW+CR)/RLB
      IF(ARG.GT.1.)GO TO 1080
!
!                   FIGURE 4.3.2.2.-37A(XAC)B(W)
!
      LGH(1)=8
      LGH(2)=3
      CALL INTERX(2,T4337A,VAR,LGH,D4337A,XACA,8,24,                    &
     &            0,0,0,0,1,0,0,0,Q2137A,3,ROUTID)
      GO TO 1090
!
!                   FIGURE 4.3.2.2.-37B(XAC)B(W)
!
 1080 LGH(1)=10
      LGH(2)=2
      CALL INTERX(2,T4337B,VAR,LGH,D4337B,XACA,10,20,                   &
     &            0,0,0,0,0,0,0,0,Q2137B,3,ROUTID)
 1090 XACBW=XACA*CRSTAR/CBARR
      RETURN
      END
      SUBROUTINE WGEOTL
!
! *** CALCULATES SUBSONIC VORTEX INTERFERENCE EFFECTS ON HORIZONTAL TAIL
!
      COMMON /OVERLY/ NLOG,NMACH,M,NALPHA,IG
      COMMON /WINGD/  A(195),B(49)
      COMMON /FLGTCD/ FLC(95), dumflgtcd(65)
      COMMON /WHWB/   FACT(182),WB(39)
      COMMON /HTDATA/ AHT(195),BHT(49)
      COMMON /CONSNT/ CONST(5)
      COMMON /HTI/    HTIN(154)
      COMMON/WINGI/ WINGIN(101)
      COMMON /SYNTSS/ XCG,XW,ZW,ALIW,ZCG,XH,ZH,ALIH,XV,VERTUP,HINAX,    &
     &                XVF,SCALE,ZV,ZVF,YV,YF,PHIV,PHIF
      DIMENSION ROUTID(2),Q60ABC(4)
      EQUIVALENCE(RAD,CONST(4))
!
!     ----FIG 4.4.1-71 A-B-C
!
      DIMENSION X41602(9),X41601(5),X41603(3),Y44160(9,5,3)
!
!  X41602=BETA*A  X41601=ATAN  X41603=TAPER RATIO
!
      DATA ROUTID /4HWGEO,4HTL  /,Q60ABC/4H4.4.,4H1-71,4HA-B-,4HC   /
      DATA X41602 /0.,1.,2.,3.,4.,5.,6.,7.,8./
      DATA X41601 /-4.0,-2.0,0.0,2.0,4.0/
      DATA X41603 /0.,.5,1./
      DATA  Y44160/ .785,.6014,.6010,.5992,.5964,.5932,.5898,           &
     & .5864,.5830 ,.7850,.6735,.6633,.6526,.6428,.6340,.6263,.6194,    &
     & .6133 ,.7850,.7532,.7254,.7039,.6868,.6728,.6612,.6513,.6427 ,   &
     & .7850,.7732,.7540,.7348,.7176,.7027,.6898,.6786,.6687 ,.7850,    &
     & .7722,.7613,.7485,.7353,.7226,.7109,.7002,.6904 ,.7850,.6610,    &
     & .6656,.6702,.6747,.6790,.6831,.6868,.6903 ,.7850,.7326,.7264,    &
     & .7241,.7240,.7251,.7267,.7283,.7299 ,.7850,.7795,.7754,.7739,    &
     & .7734,.7732,.7731,.7730,.7728 ,.7850,.8137,.8204,.8234,.8240,    &
     & .8232,.8217,.8199,.8180 ,.7850,.8922,.8876,.8840,.8803,.8764,    &
     & .8724,.8683,.8643 ,.7850,.6787,.6882,.6992,.7106,.7222,.7334,    &
     & .7441,.7542 ,.7850,.7470,.7464,.7524,.7615,.7718,.7822,          &
     & .7923,.8017 ,.7850,.7876,.7965,.8078,.8194,.8304,.8404,.8496,    &
     & .8579 ,.7850,.8495,.8665,.8809,.8926,.9022,.9102,.9170,.9229 ,   &
     & .7850,.9866,.9840,.9848,.9869,.9894,.9917,.9938,.9956/
      BA=A(120)*B(2)
!
      ATA=A(120)*A(38)
      CALL TLIN3X(X41601,X41602,X41603,Y44160,5,9,3,ATA,BA,A(118),YT,   &
     &            0,0,2,0,1,2,Q60ABC,4,ROUTID)
      DBWO2=WINGIN(4)-WINGIN(3)
      BVTO2=WINGIN(3)*YT+DBWO2
      Y0=BVTO2
      RCREO2=HTIN(4)-HTIN(3)
      DO 1000 J=1,NALPHA
         Z0=A(12)-(A(24)-A(80)*BVTO2)*TAN((FLC(J+22)+ALIW)/RAD)
         FACT(J+41)=ALI(Z0,Y0,HTIN(4),RCREO2,AHT(27))
      IF(WINGIN(101) .GT. 2.5) FACT(J+81)=2*BVTO2
 1000 END DO
      RETURN
      END
      SUBROUTINE WINGCL(NALPHA,ASCHED,ALPHAO,ALPHAS,ACLMAX,CLA,CLMAX,CL,&
     &   AMACH,TOC,OMEGA,TAPR,AR,CLBSB,CLBSS,CLA6,CLA14,CDLCL2,CD,CLBCL,&
     &   CLB)
!
! *** CALCULATES TRANSONIC WING CL
!
      DIMENSION ASCHED(20),CL(20),CD(20),CLB(20)
      DIMENSION C(6),XA(2),YA(2),Q455A(3),Q455B(3),Q455AB(4),ROUT(2),   &
     &          PARM(21),DEP55A(164),DEP55B(164),VAR(4),LENG(4)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      LOGICAL FLAG
      DATA Q455A/4H4.1.,4H5.2-,4H55A /,Q455B/4H4.1.,4H5.2-,4H55B /
!
!****------ DATA FOR FIGURE 4.1.5.2-55A AT  AR*TAN(L.E. SWEEP)=0.0 -----
!
      DATA ROUT /4HWING,4HCL  /, Q455AB /4H4.1.,4H5.2-,4H55A,,4HB   /
      DATA PARM/-4.,-3.,-2.,-1.,0.,1.,2.,.5,.75,1.,1.5,1.75,2.,0.,0.,   &
     & .2,.5,1.,3*0./
      DATA DEP55A/1.20,1.14,1.13,1.17,1.20,1.18,1.13,.94,2*.88,.9,.95,  &
     &.98,.97,.75,.7,.68,.71,.75,.78,.8,.4,.4,.4,.46,.54,.55,.53,.27,   &
     &.28,.3,.37,.49,.48,.46,.16,.17,.27,.43,.42,.40,1.05,1.04,1.04,    &
     &1.05,1.06,1.05,1.02,.8,.77,.76,.78,.8,.82,.82,.6,.58,.58,.58,.59, &
     &.62,.65,.36,.36,.37,.42,.47,.49,.50,.28,.27,.30,.36,.42,.44,.45,  &
     &.20,.24,.32,.39,.41,.42,1.02,1.03,1.02,1.,.97,.96,.97,.78,.76,.73,&
     &.7,.68,.68,.7,.58,.55,.54,.52,.52,.53,.56,.33,.34,.36,.39,.43,.45,&
     &.47,.28,.29,.31,.34,.39,.43,.45,.23,.27,.32,.38,.41,.43,.82,.84,  &
     &.88,.92,.98,1.02,1.02,.63,.63,.67,.75,.79,.82,.82,.51,.52,.56,.62,&
     &.68,.70,.71,.4,.4,.41,.52,.55,.62,.63,.37,.37,.37,.45,.54,.60,.62,&
     &.35,.35,.42,.50,.56,.58/
!
!****------ DATA FOR FIGURE 4.1.5.2-55B AT  AR*TAN(L.E. SWEEP)=3.0 -----
!
      DATA DEP55B/1.22,1.16,1.14,1.18,1.22,1.19,1.14,1.03,1.01,.98,.96, &
     &.95,.96,.98,.87,.84,.81,.79,.77,.78,.8,.57,.51,.49,.52,.55,.56,   &
     &.54,.31,.31,.31,.37,.49,.49,.45,.17,.21,.29,.43,.43,.40,1.11,1.10,&
     &1.09,1.08,1.07,1.05,1.03,.92,.88,.86,.84,.84,.82,.83,.75,.73,.71, &
     &.68,.66,.66,.67,.46,.42,.41,.45,.51,.52,.51,.28,.29,.3,.32,.44,   &
     &.46,.47,.2,.24,.32,.4,.43,.44,1.11,1.09,1.07,1.03,.99,.98,.99,.90,&
     &.88,.86,.83,.79,.78,.81,.70,.70,.68,.64,.60,.62,.66,.46,.46,.47,  &
     &.49,.50,.52,.52,.40,.39,.40,.42,.45,.47,.48,.37,.35,.38,.41,.44,  &
     &.44,.83,.87,.90,.94,.99,.92,.93,.70,.72,.74,.77,.80,.84,.87,.60,  &
     &.61,.63,.67,.73,.76,.78,.46,.46,.48,.52,.60,.64,.66,.40,.39,.40,  &
     &.47,.56,.61,.63,.37,.37,.43,.53,.58,.60/
!
!************ TRANSONIC WING CL - DATCOM SECTION 4.1.3.3 ***************
!
      IF(ALPHAO .EQ. UNUSED .OR. ALPHAS .EQ. UNUSED)GO TO 1040
      CLREF = (ALPHAS-ALPHAO)*CLA
      FLAG = ACLMAX .LT. ALPHAS .OR. CLMAX .LT. CLREF
      IF(FLAG) ACLMAX = ALPHAS
      IF(FLAG) CLMAX  = CLREF
      IF(ALPHAS.EQ.ACLMAX)GO TO 1000
!
!**** MODEL THE NON-LINEAR LIFT REGION WITH A POLYNOMIAL
!
      EXPN=CLA*(ALPHAS-ACLMAX)/(CLA*(ALPHAS-ALPHAO)-CLMAX)
      A2=CLA*(ALPHAS-ALPHAO)-CLMAX
      A1=0.0
      A0=CLMAX
!
!**** COMPUTE CL CURVE VERSUS ASCHED
!
 1000 DO 1030 I=1,NALPHA
         IF(ASCHED(I).GT.ACLMAX)GO TO 1040
         IF(ASCHED(I)-ALPHAS)1010,1010,1020
 1010    IF(CL(I).EQ.UNUSED)CL(I)=CLA*(ASCHED(I)-ALPHAO)
         GO TO 1030
 1020    IF(ABS(CL(I)).EQ.UNUSED)CL(I)=A0+A1*(ASCHED(I)-ACLMAX)         &
     &            +A2*((ASCHED(I)-ACLMAX)/(ALPHAS-ACLMAX))**(EXPN)
 1030 END DO
!
!************ TRANSONIC WING CDL - DATCOM SECTION 4.1.5.2 **************
!**** COMPUTE THE TRANSONIC SIMILARITY PARAMETERS
!
 1040 TC13=TOC**(1./3.)
      TC23=TOC**(2./3.)
      VAR(1)=(AMACH**2-1.)/TC23
      VAR(2)=AR*TC13
      VAR(3)=TAPR
      LENG(1)=7
      LENG(2)=6
      LENG(3)=4
!
!**** LOOKUP FOR FIGURE 4.1.5.2-55A
!
      CALL INTERX(3,PARM,VAR,LENG,DEP55A,CDLR1,7,164,1,1,1,0,1,1,1,0,   &
     &            Q455A,3,ROUT)
!
!**** LOOKUP FOR FIGURE 4.1.5.2-55B
!
      CALL INTERX(3,PARM,VAR,LENG,DEP55B,CDLR2,7,164,1,1,1,0,1,1,1,0,   &
     &            Q455B,3,ROUT)
!
!**** CDL/CL**2 CALCULATED FOR EACH FIGURE, CALCULATE FOR THIS CASE
!
      X=AR*TAN(OMEGA)
      XA(2)=3.0
      XA(1)=0.0
      YA(2)=CDLR2
      YA(1)=CDLR1
      CALL TBFUNX(X,Y,DYDX,2,XA,YA,C,0,0,NG,1,1,Q455AB,4,ROUT)
      CDLCL2=Y*TC13
      IF(ABS(CD(2)) .NE. UNUSED) GO TO 1060
      CDO = CD(1)
      DO 1050 I=1,NALPHA
         IF(ABS(CL(I)).EQ.UNUSED)GO TO 1050
         CD(I)=CDLCL2*CL(I)**2+CDO
 1050 END DO
 1060 CONTINUE
!
!************ TRANSONIC WING CLB - DATCOM EQUATION 5.1.2.1-C ***********
!
      CLBCL=((CLBSS/CLA14**2-CLBSB/CLA6**2)*(AMACH-.6)/.8+CLBSB/CLA6**2)&
     &      *CLA**2
      DO 1070 I=1,NALPHA
         IF(ABS(CL(I)).EQ.UNUSED)GO TO 1070
         IF(ABS(CLB(I)).EQ.UNUSED)CLB(I)=CLBCL*CL(I)
 1070 END DO
      RETURN
      END
      SUBROUTINE WINGYW
!
! *** MAIN LOGIC FOR WING YAW DAMPING DERIVATIVES
!
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON
      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,          &
     &        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      COMMON /IWING/  PWING,WING(400)
      COMMON /IBW/    PBW,BW(380)
!
      IF(.NOT. (SUBSON .OR. SUPERS)) GO TO 1040
      IF(SUBSON) CALL SUBRYW
      IF(SUPERS) CALL SUPRYW
!
!     METHODS SAME FOR WING OR WING-BODY, NO CNR SUPERSONIC METHODS
!
      DO 1030 J=1,NALPHA
         BW(J+300)=WING(J+300)
         BW(J+320)=WING(J+320)
         IF(J .GT. 1 .AND. SUPERS) GO TO 1010
         BW(J+280)=WING(J+280)
         IF(SUPERS) GO TO 1020
         BW(J+340)=WING(J+340)
         GO TO 1030
 1010    BW(J+280)= -UNUSED
         WING(J+280)= -UNUSED
 1020    BW(J+340)= UNUSED
         WING(J+340)= UNUSED
 1030 END DO
 1040 CONTINUE
      RETURN
      END
      SUBROUTINE WPLOT
!
! *** WRITES DATA TO UNIT 13 FOR DIGITAL DATCOM PLOT OPTION
! *** WRITES DATA TO UNIT 14 FOR MISSILE DATCOM PLOT OPTION
!
      COMMON /IBODY/   PBODY,  BODY(400)
      COMMON /IWING/   PWING,  WING(400)
      COMMON /IHT/     PHT,    HT(380)
      COMMON /IVT/     PVT,    VT(380)
      COMMON /IVF/     PVF,    VF(380)
      COMMON /IBW/     PBW,    BW(380)
      COMMON /IBH/     PBH,    BH(380)
      COMMON /IBV/     PBV,    BV(380)
      COMMON /IBWH/    PBWH,   BWH(380)
      COMMON /IBWV/    PBWV,   BWV(380)
      COMMON /IBWHV/   PBWHV,  BWHV(380)
      COMMON /IDWASH/  PDWASH, DWASH(60)
!
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),IDIM
      COMMON /FLGTCD/ FLC(160)
      COMMON /OPTION/ OPT(4), IRUN
      COMMON /SYNTSS/ SYNA(19)
      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K,NOVLY
      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
      COMMON /BDATA/  BD(762)
      COMMON /WHWB/   FACT(182), WB(39), HB(39)
      COMMON /WBHCAL/ WBT(156)
      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55), DVF(55)
      COMMON /SUPWBB/  SWB(61), SHB(61)
      COMMON /SUPWH/  SLG(141), STG(141)
      COMMON /SUPBOD/ SBD(229)
!
      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,  &
     &                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,   &
     &                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,        &
     &                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,             &
     &                VFPL,VFSC,CTAB,PLOT
!
      DIMENSION STP(156), CDO(11), LOG(34)
      DIMENSION DIM(4)
!
      EQUIVALENCE (STP(1),WBT(1)), (LOG(1),FLTC)
!
      LOGICAL  FLAG, LOG
      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,         &
     &         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,          &
     &         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,               &
     &         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,                    &
     &         VFPL,VFSC,CTAB,PLOT
      LOGICAL  PBODY, PWING, PHT, PVT, PVF, PBW, PBH, PBV, PBWH, PBWV,  &
     &         PBWHV, PPOWER, PDWASH
!
      DATA DIM / 1HF, 1HI, 1HM, 1HC /
!
!***  WRITE DATA FOR DIGITAL DATCOM PLOT MODULE
!
      FLAG = (I .EQ. 1) .AND. (K .EQ. 1)
      IF(.NOT. FLAG) GO TO 1010
        WRITE(13,1270) SYNA
        WRITE(13,1270) OPT
        WRITE(13,1280) LOG
 1010 CONTINUE
      WRITE(13,1270) (BODY(J),J=1,200)
      WRITE(13,1270) (WING(J),J=1,200)
      WRITE(13,1270) (HT(J),J=1,200)
      WRITE(13,1270) (VT(J),J=1,200)
      WRITE(13,1270) (VF(J),J=1,200)
      WRITE(13,1270) (BW(J),J=1,200)
      WRITE(13,1270) (BH(J),J=1,200)
      WRITE(13,1270) (BV(J),J=1,200)
      WRITE(13,1270) (BWH(J),J=1,200)
      WRITE(13,1270) (BWV(J),J=1,200)
      WRITE(13,1270) (BWHV(J),J=1,200)
      WRITE(13,1270) (DWASH(J),J=1,60)
      WRITE(13,1270) (FACT(J),J=102,141)
!
      CDO(4) = VT(1)
      CDO(5) = VF(1)
      IF(.NOT. SUBSON) GO TO 1020
        CDO(1)  = BD(10)
        CDO(2)  = D(20)
        CDO(3)  = DHT(20)
        CDO(6)  = WB(6)
        CDO(7)  = HB(6)
        CDO(8)  = BD(10)+VT(1)+VF(1)
        CDO(9)  = WBT(67)-WBT(66)
        CDO(10) = WB(6)+VT(1)+VF(1)
        CDO(11) = WBT(67)
 1020 CONTINUE
      IF(.NOT. TRANSN) GO TO 1030
        CDO(1)  = TRA(78)
        CDO(2) = TRA(67)+TRA(68)
        CDO(3)  = TRAH(108)
        CDO(6)  = TRA(73)
        CDO(7)  = TRAH(73)
        CDO(8)  = TRA(78)+VT(1)+VF(1)
        CDO(9)  = TRA(75)-VF(1)-VT(1)
        CDO(10) = TRA(73)+VT(1)+VF(1)
        CDO(11) = TRA(75)
 1030 CONTINUE
      IF(.NOT. SUPERS) GO TO 1040
        CDO(1)  = SBD(124)
        CDO(2)  = SLG(80)
        CDO(3)  = STG(80)
        CDO(6)  = SWB(4)
        CDO(7)  = SHB(4)
        CDO(8)  = SBD(124)+VT(1)+VF(1)
        CDO(9)  = STP(154)
        CDO(10) = SWB(4)+VT(1)+VF(1)
        CDO(11) = STP(155)
 1040 CONTINUE
      WRITE(13,1270) CDO
!
!***  WRITE DATA FOR MISSILE DATCOM PLOT MODULE
!
      IF(.NOT. PBODY) GO TO 1060
        IRUN = IRUN+1
        WRITE(14,1290) IRUN, NALPHA, DIM(IDIM)
        WRITE(14,1300) FLC(I+2), FLC(I+42)
        WRITE(14,1310) OPT(1), OPT(2), OPT(4), SYNA(1), YCG, SYNA(4)
        DO 1050 J=1,NALPHA
          WRITE(14,1310) FLC(J+22), BODY(J+60), BODY(J+40), BODY(J+80), &
     &                   BODY(J+140), BODY(J+160), BODY(J+180)
 1050   CONTINUE
        WRITE(14,1320)
 1060 CONTINUE
!
      IF(.NOT. PWING) GO TO 1080
        IRUN = IRUN+1
        WRITE(14,1330) IRUN, NALPHA, DIM(IDIM)
        WRITE(14,1300) FLC(I+2), FLC(I+42)
        WRITE(14,1310) OPT(1), OPT(2), OPT(4), SYNA(1), YCG, SYNA(4)
        DO 1070 J=1,NALPHA
          WRITE(14,1310) FLC(J+22), WING(J+60), WING(J+40), WING(J+80), &
     &                   WING(J+140), WING(J+160), WING(J+180)
 1070   CONTINUE
        WRITE(14,1320)
 1080 CONTINUE
!
      IF(.NOT. PHT) GO TO 1100
        IRUN = IRUN+1
        WRITE(14,1340) IRUN, NALPHA, DIM(IDIM)
        WRITE(14,1300) FLC(I+2), FLC(I+42)
        WRITE(14,1310) OPT(1), OPT(2), OPT(4), SYNA(1), YCG, SYNA(4)
        DO 1090 J=1,NALPHA
          WRITE(14,1310) FLC(J+22), HT(J+60), HT(J+40), HT(J+80),       &
     &                   HT(J+140), HT(J+160), HT(J+180)
 1090   CONTINUE
        WRITE(14,1320)
 1100 CONTINUE
!
      IF(.NOT. PVT) GO TO 1120
        IRUN = IRUN+1
        WRITE(14,1350) IRUN, NALPHA, DIM(IDIM)
        WRITE(14,1300) FLC(I+2), FLC(I+42)
        WRITE(14,1310) OPT(1), OPT(2), OPT(4), SYNA(1), YCG, SYNA(4)
        DO 1110 J=1,NALPHA
          WRITE(14,1310) FLC(J+22), VT(J+60), VT(J+40), VT(J+80),       &
     &                   VT(J+140), VT(J+160), VT(J+180)
 1110   CONTINUE
        WRITE(14,1320)
 1120 CONTINUE
!
      IF(.NOT. PVF) GO TO 1140
        IRUN = IRUN+1
        WRITE(14,1360) IRUN, NALPHA, DIM(IDIM)
        WRITE(14,1300) FLC(I+2), FLC(I+42)
        WRITE(14,1310) OPT(1), OPT(2), OPT(4), SYNA(1), YCG, SYNA(4)
        DO 1130 J=1,NALPHA
          WRITE(14,1310) FLC(J+22), VF(J+60), VF(J+40), VF(J+80),       &
     &                   VF(J+140), VF(J+160), VF(J+180)
 1130   CONTINUE
        WRITE(14,1320)
 1140 CONTINUE
!
      IF(.NOT. PBW) GO TO 1160
        IRUN = IRUN+1
        WRITE(14,1370) IRUN, NALPHA, DIM(IDIM)
        WRITE(14,1300) FLC(I+2), FLC(I+42)
        WRITE(14,1310) OPT(1), OPT(2), OPT(4), SYNA(1), YCG, SYNA(4)
        DO 1150 J=1,NALPHA
          WRITE(14,1310) FLC(J+22), BW(J+60), BW(J+40), BW(J+80),       &
     &                   BW(J+140), BW(J+160), BW(J+180)
 1150   CONTINUE
        WRITE(14,1320)
 1160 CONTINUE
!
      IF(.NOT. PBH) GO TO 1180
        IRUN = IRUN+1
        WRITE(14,1380) IRUN, NALPHA, DIM(IDIM)
        WRITE(14,1300) FLC(I+2), FLC(I+42)
        WRITE(14,1310) OPT(1), OPT(2), OPT(4), SYNA(1), YCG, SYNA(4)
        DO 1170 J=1,NALPHA
          WRITE(14,1310) FLC(J+22), BH(J+60), BH(J+40), BH(J+80),       &
     &                   BH(J+140), BH(J+160), BH(J+180)
 1170   CONTINUE
        WRITE(14,1320)
 1180 CONTINUE
!
      IF(.NOT. PBV) GO TO 1200
        IRUN = IRUN+1
        WRITE(14,1390) IRUN, NALPHA, DIM(IDIM)
        WRITE(14,1300) FLC(I+2), FLC(I+42)
        WRITE(14,1310) OPT(1), OPT(2), OPT(4), SYNA(1), YCG, SYNA(4)
        DO 1190 J=1,NALPHA
          WRITE(14,1310) FLC(J+22), BV(J+60), BV(J+40), BV(J+80),       &
     &                   BV(J+140), BV(J+160), BV(J+180)
 1190   CONTINUE
        WRITE(14,1320)
 1200 CONTINUE
!
      IF(.NOT. PBWH) GO TO 1220
        IRUN = IRUN+1
        WRITE(14,1400) IRUN, NALPHA, DIM(IDIM)
        WRITE(14,1300) FLC(I+2), FLC(I+42)
        WRITE(14,1310) OPT(1), OPT(2), OPT(4), SYNA(1), YCG, SYNA(4)
        DO 1210 J=1,NALPHA
          WRITE(14,1310) FLC(J+22), BWH(J+60), BWH(J+40), BWH(J+80),    &
     &                   BWH(J+140), BWH(J+160), BWH(J+180)
 1210   CONTINUE
        WRITE(14,1320)
 1220 CONTINUE
!
      IF(.NOT. PBWV) GO TO 1240
        IRUN = IRUN+1
        WRITE(14,1410) IRUN, NALPHA, DIM(IDIM)
        WRITE(14,1300) FLC(I+2), FLC(I+42)
        WRITE(14,1310) OPT(1), OPT(2), OPT(4), SYNA(1), YCG, SYNA(4)
        DO 1230 J=1,NALPHA
          WRITE(14,1310) FLC(J+22), BWV(J+60), BWV(J+40), BWV(J+80),    &
     &                   BWV(J+140), BWV(J+160), BWV(J+180)
 1230   CONTINUE
        WRITE(14,1320)
 1240 CONTINUE
!
      IF(.NOT. PBWHV) GO TO 1260
        IRUN = IRUN+1
        WRITE(14,1420) IRUN, NALPHA, DIM(IDIM)
        WRITE(14,1300) FLC(I+2), FLC(I+42)
        WRITE(14,1310) OPT(1), OPT(2), OPT(4), SYNA(1), YCG, SYNA(4)
        DO 1250 J=1,NALPHA
          WRITE(14,1310) FLC(J+22), BWHV(J+60), BWHV(J+40), BWHV(J+80), &
     &                   BWHV(J+140), BWHV(J+160), BWHV(J+180)
 1250   CONTINUE
        WRITE(14,1320)
 1260 CONTINUE
!
 1270 FORMAT(1P10E12.4)
 1280 FORMAT(34L3)
 1290 FORMAT(4HRUN ,2I3,2X,A1,' BODY ALONE')
 1300 FORMAT(F10.5,F10.0)
 1310 FORMAT(7F10.5)
 1320 FORMAT(1HR)
 1330 FORMAT(4HRUN ,2I3,2X,A1,1X,10HWING ALONE)
 1340 FORMAT(4HRUN ,2I3,2X,A1,1X,8HHT ALONE)
 1350 FORMAT(4HRUN ,2I3,2X,A1,1X,8HVT ALONE)
 1360 FORMAT(4HRUN ,2I3,2X,A1,1X,8HVF ALONE)
 1370 FORMAT(4HRUN ,2I3,2X,A1,1X,9HBODY-WING)
 1380 FORMAT(4HRUN ,2I3,2X,A1,1X,7HBODY-HT)
 1390 FORMAT(4HRUN ,2I3,2X,A1,1X,10HBODY-VT-VF)
 1400 FORMAT(4HRUN ,2I3,2X,A1,1X,12HBODY-WING-HT)
 1410 FORMAT(4HRUN ,2I3,2X,A1,1X,15HBODY-WING-VT-VF)
 1420 FORMAT(4HRUN ,2I3,2X,A1,1X,18HBODY-WING-HT-VT-VF)
!
      RETURN
      END
      SUBROUTINE WRITXM(IFIG,IPRT,JK,JJ,IOVM,ROUTL,I,MSSCLL)
!
! *** PRINTS SUMMARIZED EXTRAPOLATION MESSAGES
!
      INTEGER ROUT,ROUTL
      LOGICAL PAIRX
      COMMON /IBODY/   PB, AFIG01(121), AFIG02(121), dum1(158)
      COMMON /IWING/   PW, AFIG03(121), AFIG04(121), dum13(158)
      COMMON /IHT/    PHT, AFIG05(121), AFIG06(121), dum3(138)
      COMMON /IVT/    PVT, AFIG07(121), AFIG08(121), dum4(138)
      COMMON /IVF/    PVF, AFIG09(121), AFIG10(121), dum17(138)
      COMMON /IBW/    PBW, AFIG11(121), AFIG12(121), dum5(138)
      COMMON /IBH/    PBH, AFIG13(121), AFIG14(121), dum6(138)
      COMMON /IBV/    PBV, JFIG01(121), JFIG02(121), dum7(138)
      COMMON /IBWH/  PBWH, JFIG03(121), JFIG04(121), dum8(138)
      COMMON /IBWV/  PBWV, JFIG05(121), JFIG06(121), dum9(138)
      COMMON /IBWHV/PBWHV, JFIG07(121), JFIG08(121), dum12(138)
      COMMON /WINGD/       JFIG09(121)
      COMMON /SBETA/       JFIG10(121), JFIG11(121), JFIG12(121)
      COMMON /BDATA/       JFIG13(121), JFIG14(121), JFIG15(121),       &
     &                     JFIG16(121), JFIG17(121)
      COMMON /WHWB/        JFIG18(121)
      COMMON /WBHCAL/      JFIG19(121)
      COMMON /HTDATA/      JFIG20(121)
      COMMON /VTDATA/ LFIGN(121),LFIGO(121),IOVLY,IOVL,NSTQ,NSTP,FINALR,&
     &                NFIG,IFIGN
      COMMON /WHAERO/ LFIGS(121), IFIGST(20), IEXCD(4), MSSCL(2),       &
     &                ROUT(2), XLL(4), XUL(4), IEXTRL(4,2),             &
     &                IEXTRU(4,2), XVAL(4), LDUM(121), PAIRX
      DIMENSION IFIG(20,121)
      DATA IHAST,IHBL/4H ** ,4H    /
!
!  IF NEW OVERLAY OR DIFFERENT ROUTINES - PRINT NEW TITLES
!
      IF(IOVLY.NE.IOVL .OR. IPRT.EQ.6)GO TO 1010
      IF(NFIG.GE.119.AND.PAIRX)GO TO 1010
      DO 1000 K=1,20
         IF(IFIG(K,JJ).NE.IFIGST(K)) GO TO 1020
 1000 END DO
      IF(JFIG03(JJ).NE.ROUTL .OR. JFIG01(JJ).NE.MSSCLL)GO TO 1020
      GO TO 1040
 1010 CONTINUE
      PAIRX=.FALSE.
      IPRT=IPRT+2
      IF(JK.EQ.1)WRITE(6,1060)IOVM,(IFIG(L,JJ),L=1,20)                  &
     &           ,JFIG05(I),JFIG09(I),JFIG13(I),JFIG17(I)
      IF(JK.EQ.2)WRITE(6,1060)IOVM,(IFIG(L,JJ),L=1,20)                  &
     &          ,JFIG05(I),JFIG09(I),JFIG13(I),JFIG17(I)                &
     &          ,JFIG06(I),JFIG10(I),JFIG14(I),JFIG18(I)
      IF(JK.EQ.3)WRITE(6,1060)IOVM,(IFIG(L,JJ),L=1,20)                  &
     &           ,JFIG05(I),JFIG09(I),JFIG13(I),JFIG17(I)               &
     &           ,JFIG06(I),JFIG10(I),JFIG14(I),JFIG18(I)               &
     &           ,JFIG07(I),JFIG11(I),JFIG15(I),JFIG19(I)
      IF(JK.EQ.4)WRITE(6,1060)IOVM,(IFIG(L,JJ),L=1,20)                  &
     &          ,JFIG05(I),JFIG09(I),JFIG13(I),JFIG17(I)                &
     &          ,JFIG06(I),JFIG10(I),JFIG14(I),JFIG18(I)                &
     &          ,JFIG07(I),JFIG11(I),JFIG15(I),JFIG19(I)                &
     &          ,JFIG08(I),JFIG12(I),JFIG16(I),JFIG20(I)
      IOVL=IOVLY
      GO TO 1030
 1020 CONTINUE
      IPRT=IPRT+2
      IF(JK.EQ.1)WRITE(6,1070)(IFIG(L,JJ),L=1,20)                       &
     &          ,JFIG05(I),JFIG09(I),JFIG13(I),JFIG17(I)
      IF(JK.EQ.2)WRITE(6,1070)(IFIG(L,JJ),L=1,20)                       &
     &          ,JFIG05(I),JFIG09(I),JFIG13(I),JFIG17(I)                &
     &          ,JFIG06(I),JFIG10(I),JFIG14(I),JFIG18(I)
      IF(JK.EQ.3)WRITE(6,1070)(IFIG(L,JJ),L=1,20)                       &
     &          ,JFIG05(I),JFIG09(I),JFIG13(I),JFIG17(I)                &
     &          ,JFIG06(I),JFIG10(I),JFIG14(I),JFIG18(I)                &
     &          ,JFIG07(I),JFIG11(I),JFIG15(I),JFIG19(I)
      IF(JK.EQ.4)WRITE(6,1070)(IFIG(L,JJ),L=1,20)                       &
     &          ,JFIG05(I),JFIG09(I),JFIG13(I),JFIG17(I)                &
     &          ,JFIG06(I),JFIG10(I),JFIG14(I),JFIG18(I)                &
     &          ,JFIG07(I),JFIG11(I),JFIG15(I),JFIG19(I)                &
     &          ,JFIG08(I),JFIG12(I),JFIG16(I),JFIG20(I)
 1030 CONTINUE
      IPRT=IPRT+1
      IF(JK.EQ.1)WRITE(6,1080)JFIG01(I),JFIG02(I),JFIG03(I),JFIG04(I)   &
     &          ,AFIG06(I),AFIG10(I)
      IF(JK.EQ.2)WRITE(6,1080)JFIG01(I),JFIG02(I),JFIG03(I),JFIG04(I)   &
     &          ,AFIG06(I),AFIG10(I)                                    &
     &          ,AFIG07(I),AFIG11(I)
      IF(JK.EQ.3)WRITE(6,1080)JFIG01(I),JFIG02(I),JFIG03(I),JFIG04(I)   &
     &          ,AFIG06(I),AFIG10(I)                                    &
     &          ,AFIG07(I),AFIG11(I)                                    &
     &          ,AFIG08(I),AFIG12(I)
      IF(JK.EQ.4)WRITE(6,1080)JFIG01(I),JFIG02(I),JFIG03(I),JFIG04(I)   &
     &          ,AFIG06(I),AFIG10(I)                                    &
     &          ,AFIG07(I),AFIG11(I)                                    &
     &          ,AFIG08(I),AFIG12(I)                                    &
     &          ,AFIG09(I),AFIG13(I)
 1040 CONTINUE
      IPRT=IPRT+1
      DO 1050 L=1,4
         IEXCD(L)=IHBL
 1050 END DO
      IF(AFIG06(I).LE.AFIG10(I))AMIN=AFIG06(I)
      IF(AFIG10(I).LE.AFIG06(I))AMIN=AFIG10(I)
      IF(AFIG06(I).GT.AFIG10(I))AMAX=AFIG06(I)
      IF(AFIG10(I).GT.AFIG06(I))AMAX=AFIG10(I)
      IF(AFIG02(I).LT.AMIN.OR.AFIG02(I).GT.AMAX)                        &
     &           IEXCD(1)=IHAST
      IF(AFIG07(I).LE.AFIG11(I))AMIN=AFIG07(I)
      IF(AFIG11(I).LE.AFIG07(I))AMIN=AFIG11(I)
      IF(AFIG07(I).GT.AFIG11(I))AMAX=AFIG07(I)
      IF(AFIG11(I).GT.AFIG07(I))AMAX=AFIG11(I)
      IF(AFIG03(I).LT.AMIN.OR.AFIG03(I).GT.AMAX)                        &
     &           IEXCD(2)=IHAST
      IF(AFIG08(I).LE.AFIG12(I))AMIN=AFIG08(I)
      IF(AFIG12(I).LE.AFIG08(I))AMIN=AFIG12(I)
      IF(AFIG08(I).GT.AFIG12(I))AMAX=AFIG08(I)
      IF(AFIG12(I).GT.AFIG08(I))AMAX=AFIG12(I)
      IF(AFIG04(I).LT.AMIN.OR.AFIG04(I).GT.AMAX)                        &
     &           IEXCD(3)=IHAST
      IF(AFIG09(I).LE.AFIG13(I))AMIN=AFIG09(I)
      IF(AFIG13(I).LE.AFIG09(I))AMIN=AFIG13(I)
      IF(AFIG09(I).GT.AFIG13(I))AMAX=AFIG09(I)
      IF(AFIG13(I).GT.AFIG09(I))AMAX=AFIG13(I)
      IF(AFIG05(I).LT.AMIN.OR.AFIG05(I).GT.AMAX)                        &
     &           IEXCD(4)=IHAST
      IF(JK.EQ.1)WRITE(6,1090)AFIG14(I),AFIG02(I),IEXCD(1)
      IF(JK.EQ.2)WRITE(6,1090)AFIG14(I),AFIG02(I),IEXCD(1)              &
     &          ,AFIG03(I),IEXCD(2)
      IF(JK.EQ.3)WRITE(6,1090)AFIG14(I),AFIG02(I),IEXCD(1)              &
     &          ,AFIG03(I),IEXCD(2)                                     &
     &          ,AFIG04(I),IEXCD(3)
      IF(JK.EQ.4)WRITE(6,1090)AFIG14(I),AFIG02(I),IEXCD(1)              &
     &          ,AFIG03(I),IEXCD(2)                                     &
     &          ,AFIG04(I),IEXCD(3)                                     &
     &          ,AFIG05(I),IEXCD(4)
 1060 FORMAT(3H0  ,I2,5X,20A1,6X,8(2X,2A4))
 1070 FORMAT(1H0,9X,20A1,6X,8(2X,2A4))
 1080 FORMAT(10X,4A4,10X,1P,8E10.2)
 1090 FORMAT(24X,1P,E13.4,4(3X,E13.4,A4))
      RETURN
      END
      SUBROUTINE WTGEOM(A,AIN)
!
!     ----SUBROUTINE COMPUTES WING OR TAIL GEOMETRY
!
      DIMENSION A(195) , FN(4) , AIN(77)
      LOGICAL LOGSWT
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,kand
      DATA FN / 0.,.25,.50,1./
      EQ1(A1,A2) = 4.*(A1**2)/A2
      EQ2(A1,A2) = 4.*(1.-A1)/(A2*(1.+A1))
      EQ4(A1,A2) = 2.*A1*(1.+A2 + A2**2) /(3.*(1.+A2))
      LOGSWT = .FALSE.
      IF(AIN(2).LT.10.*UNUSED)LOGSWT=.TRUE.
      A(21)=AIN(4)-AIN(2)
      A(23)=AIN(3)-AIN(2)
      A(19)=A(23)/A(21)
      IF(LOGSWT)AIN(5)=AIN(1)
      A(25)=AIN(5)/AIN(6)
      A(10)=AIN(6)*(A(25)+(1.-A(25))*A(19))
      A(26)=AIN(5)/A(10)
      A(28) = 1.
      IF(AIN(5).NE.0.) A(28) = AIN(1)/AIN(5)
      A(27)=A(26)*A(28)
      A(118)=AIN(1)/AIN(6)
      A(1)=(A(10)+AIN(5))*A(23)
      A(2)=(AIN(5)+AIN(1))*AIN(2)
      A(3)=A(1)+A(2)
      A(119)= (AIN(6)+AIN(5))*A(21)
      A(4)=A(119)+A(2)
      A(5)=EQ1(A(23),A( 1))
      A(6)=1.
      IF(.NOT.LOGSWT)A(6)=EQ1(AIN(2),A(2))
      A(7)=EQ1(AIN(3),A(3))
      A(120)=EQ1(AIN(4),A(4))
      CI=EQ2(A(26),A(5))
      CO=0.
      IF(.NOT.LOGSWT) CO=EQ2(A(28),A(6))
!
!     ----SWEEPANGLE SECTION
!
      XOVCO = AIN(66)
      DO 1080 I=1,5
         IF(I.LT.5) GO TO 1000
!
!     ----HERE TO COMPUTE SWEEP ANGLES AT MAXIMUM THICKNESS
!
         INDXE = 175
         INDXI = 187
         INDXO = 181
         TMPI = AIN(9)-A(174)
         TMPO = AIN(9)-XOVCO
         GO TO 1010
 1000    INDXE = 34 + (I-1)*6
         INDXI = INDXE + 24
         INDXO = INDXI + 24
         TMPO = AIN(9)-FN(I)
         TMPI = TMPO
!
!     ----TEST FOR STATION = INPUT STATION
!
 1010    IF(ABS(TMPI).LT.1.E-6) GO TO 1060
         A(INDXI+4)=CI*TMPI+A(110)
         CALL ANGLES(5,A(INDXI))
         IF(LOGSWT) GO TO 1030
         A(INDXO+4)=CO*TMPO+A(116)
         CALL ANGLES(5,A(INDXO))
 1020    A(INDXE+3) = (A(1)*A(INDXI+3) + A(2)*A(INDXO+3))/ A(3)
         CALL ANGLES(4,A(INDXE))
         GO TO 1080
!
!     ----HERE IF NO OUTER PANEL
!
 1030    CALL ZERANG(A(INDXO))
 1040    DO 1050 J=1,6
 1050       A(INDXE+J-1) = A(INDXI+J-1)
         GO TO 1080
!
!     ----HAVE THIS STATION ALREADY
!
 1060    DO 1070 J=1,6
            A(INDXI+J-1) = A(J+105)
 1070    A(INDXO+J-1) = A(J+111)
         IF(LOGSWT)GO TO 1040
         GO TO 1020
 1080 END DO
      A(15) = 2.*A(10)*(1.+A(26)+A(26)**2)/(3.*(1.+A(26)))
      A(121)=2.*AIN(6)*(1.+A(25)+A(25)**2)/(3.*(1.+A(25)))
      A(17) = 2.*AIN(5) *(1.+A(28)+A(28)**2)/(3.*(1.+A(28)))
      A(16) = (A(1)*A(15) + A(2)*A(17))/A(3)
      A(122)=(A(119)*A(121)+A(2)*A(17))/A(4)
      A(32) = A(23)*(1.+2.*A(26))/(3.*(1.+A(26)))
      A(33) = AIN(2)*(1.+2.*A(28))/(3.*(1.+A(28)))+ A(23)
      A(31) = (A(1)*A(32) + A(2)*A(33))/A(3)
      A(30) = A(16)/2. + (A(1)*A(32)*A(62)+ A(2)*(A(23)*A(62)+(A(33)-   &
     &        A(23))*A(86))) / A(3)
      A(18) = (A(23)*A(62) + AIN(2)*A(86)) /A(10)
      A1=A(23)*A(62)
      A2=AIN(2)*A(86)+A1
      A3=A(23)*A(80)
      A4=AIN(2)*A(104)+A3
      A(29)=A(10)+AMAX1(0.,A4,A3)-AMIN1(0.,A2,A1)
      A(162)=A(23)/AIN(3)
      A(163)=4.*(A(21)**2)/A(119)
      A(164)=A(23)/2.
      A(165)=A(164)+AIN(2)
      IF(LOGSWT) GO TO 1090
!
!     ----HERE ONLY IF OUTBOARD SECTION
!
      A(166)=AIN(1)+A(165)*((AIN(5)-AIN(1))/AIN(2))
      A(167)=(A(166)+AIN(1))*A(165)
      A(168)= 4.*( A(165)**2)/A(167)
      A(169)=AIN(1)/A(166)
 1090 CONTINUE
      A(130)=A(21)*(1.+2.*A(25))/(3.*(1.+A(25)))
      A(133)=0.
      IF(.NOT.LOGSWT) A(133)=AIN(2)*(1.+2.*A(28))/(3.*(1.+A(28)))+A(21)
      A(136)=(A(119)*A(130)+A(2)*A(133))/A(4)
      A(195)=(A(119)*A(130)*A(62)+A(2)*(A(21)*A(62)+(A(133)-A(21))*     &
     &        A(86)))/A(4)
      A(161)=A(122)/4.+A(195)
      RETURN
      END
      SUBROUTINE WTLIFT(A,B,AIN,AOUT)
!
! *** CALCULATES WING OR TAIL LIFT CHARACTERISTICS
!
      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA,IG
      COMMON /CONSNT/ PI, DEG, UNUSED, RAD,kand
      DIMENSION ROUTID(2),Q3417B(3),Q13242(3),Q3418A(3),Q3418B(3)
      DIMENSION Q13415(3),Q3414A(3),Q3414B(3)
      DIMENSION AMACH(5) , DYA(6) , SALE4(4), DCLTB(5,6,4) , DCAR(120)
      
!      DIMENSION A(195),B(49),AOUT(101),AIN(101)
      DIMENSION A(*),B(*),AOUT(*),AIN(*)
! changed by RLC   2010Jan18

      DIMENSION DACLMX(13,4),DACLL(52)
      DIMENSION SALE(13) , DELTAY(7) ,CLOCL(13,7),CLL(91) , DY(4)
      DIMENSION TR(11),C2(11),C(6)
      DIMENSION C1ABCS(10),ACLMX(10),C17(6)
      DIMENSION DMN(3), C1TAB(20), DACL(60)
      DIMENSION ACLE(10),DACLO(100) , C1TABO(10)
      DIMENSION  BA(12),CLOVCL(12) , CBA(6)
      DIMENSION WTYPE(4)
!
      EQUIVALENCE (DCLTB(1,1,1),DCAR(1))
      EQUIVALENCE (CLOCL(1,1),CLL(1)) ,(DACLMX(1,1),DACLL(1))
!
      LOGICAL ITYPTT
      LOGICAL LOARAT
!
      DATA ROUTID /4HWTLI,4HFT  /
      DATA Q3417B /4H4.1.,4H3.4-,4H24B /,                               &
     &     Q13242 /4H4.1.,4H3.2-,4H52  /,                               &
     &     Q3418A /4H4.1.,4H3.4-,4H25A /,                               &
     &     Q3418B /4H4.1.,4H3.4-,4H25B /,                               &
     &     Q13415 /4H4.1.,4H3.4-,4H22  /,                               &
     &     Q3414A /4H4.1.,4H3.4-,4H21A /,                               &
     &     Q3414B /4H4.1.,4H3.4-,4H21B /
!
!     ----4.1.3.4-22
!
      DATA AMACH/.2,.3,.4,.5,.6/
      DATA DYA  /2.,2.25,2.5,3.,4.,4.5/
      DATA SALE4/0.,20.,40.,60./
      DATA DCAR/0.,2*-.02,2*0., 0.,-.13,-.19,-.2,-.19 , 0.,-.185,-.32,  &
     &-.4,-.445 , 0.,-.21,-.36,-.45,-.5 , 0.,-.24,-.42,-.545,-.64 ,     &
     &-0.,-.24,-.455,-.605,-.72 , 0.,-.04,-.045,-.02,0. , 0.,-.095,-.165&
     &,-.22,-.25 , 0.,-.105,-.19,-.26,-.29 , 0.,-.125,-.225,-.3,-.345 , &
     & 0.,-.15,-.265,-.37,-.45 , 0.,-.15,-.29,-.41,-.51 , 0.,-.04,-.07, &
     &-.095,-.1 , 0.,-.043,-.080,-.108,-.123 , 0.,-.045,-.085,-.12,-.145&
     & , 0.,-.05,-.095,-.14,-.19 , 0.,-.07,-.125,-.19,-.26 , 0.,-.07,   &
     &-.14,-.215,-.3,4*0.,-.02,4*0.,-.022,4*0.,-.03,3*0.,-.02,-.07,2*0.,&
     &-.02,-.055,-.085,0.,-.04,-.085,-.14,-.2/
!
!     ----4.1.3.4-21 A
!
      DATA SALE/0.,5.,10.,15.,20.,25.,30.,35.,40.,45.,50.,55.,60./
      DATA DELTAY/1.4,1.6,1.8,2.0,2.2,2.4,2.5/
      DATA CLL /.9,.915,.93,.95,.975,1.,1.03,1.07,1.1,1.15,1.19,1.25,1.3&
     & , .9,.91,.92,.94,.96,.98,1.,1.02,1.05,1.08,1.11,1.15,1.19 ,   .9,&
     & .91,.92,.93,.94,.95,.96,.965,.975,.99,1.,1.01,1.03 , 6*.9, 2*.89,&
     &.885,2*.88,.875,.87 , .9,.895,.89,.88,.87,.86,.85,.835,.82,.8,.78,&
     &.755,.73 , .9,.89,.88,.87,.85,.83,.81,.79,.76,.725,.695,.65,.59 , &
     & .9,.89,.87,.86,.84,.82,.795,.77,.73,.7,.65,.59,.52 /
!
!     ----4.1.3.4-21 B
!
      DATA DY/1.2,2.,3.,4./
      DATA DACLL/1.75,1.9,2.2,2.7,3.4,4.15,5.1,6.1,7.3,8.7,10.15,11.75, &
     &13.3 , .1,.5,1.05,1.65,2.3,3.1,3.9,4.7,5.7,6.7,7.7,8.75,9.8,      &
     &1.2,1.4,1.7,2.,2.4,2.85,3.35,3.7,4.25,4.7,5.3,5.9,6.65,           &
     &2.2,2.1,2*2.,2.1,2.15,2.3,2.4,2.55,2.7,2.9,3.05,3.3/
!
!     ----4.1.3.4-24(B)
!
      DATA IN/0/
      DATA TR/0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
      DATA C2/0.,.21,.5,.9,1.08,1.05,1.,.94,.9,.86,.85/
!
!     ----4.1.3.4-25(A)
!
      DATA C1ABCS/0.,.4,.8,1.2,1.6,2.0,2.4,2.8,3.2,3.6/
      DATA ACLMX/3*35.,32.,28.,25.,23.2,22.,21.5,21./
!
!     ----4.1.3.4-25(B)
!
      DATA I17/0/
      DATA DMN/ .2,.4,.6/
      DATA C1TAB/4.5,5.,5.5,6.,6.5,7.,7.5,8.,8.5,9.,9.5,10.,10.5,11.,   &
     &11.5,12.,12.5,13.,13.5,14./
      DATA DACL /0.,.5,.9,1.4,1.9,2.5,3.3,4.,4.6,5.6,6.4,7.3,8.2,9.2,10.&
     &,11.,12.,13.,14.,15. , 0.,.2,.4,.7,1.2,1.7,2.4,3.,3.7,4.6,5.2,6., &
     &6.9,7.8,8.6,9.5,10.4,11.4,12.3,13.5 , 0.,0.,.1,.2,.5,.7,1.,1.3,1.6&
     &,2.,2.5,3.,3.6,4.3,4.9,5.5,6.2,7.,7.6,8.5/
      DATA ACLE /0.,2.,3.,4.,5.,6.,7.,8.,9.,30./
      DATA DACLO /                                    10.,8.5,6.9,5.5,4.&
     &,2.6,1.5,.7,.1,0. , 8.7,7.3,5.3,4.2,2.6,1.4,0.5,-.2,-.5,0. , 7.5, &
     &5.9,4.2,2.5,1.2,0.,-.7,-1.1,-.8,0. , 5.5,3.4,1.6,0.,-1.3,-2.1,-2.5&
     &,-2.,-.8,0. , 3.,.7,-1.4,-3.3,-4.3,-4.3,-3.1,-2.,-.8,0. , .3,-2.5,&
     &-4.7,-5.8,-5.3,-4.3,-3.1,-2.,-.8,0. ,-2.2,-5.,-6.7,-6.3,-5.3,-4.3,&
     &-3.1,-2.,-0.8,0. , -3.3,-6.6,-7.2,-6.3,-5.3,-4.3,-3.1,-2.,-.8,0., &
     &  -4.2,-7.,-7.2,-6.3,-5.3,-4.3,-3.1,-2.,-.8,0. , -8.5,-7.9,-7.2,  &
     & -6.3,-5.3,-4.3,-3.1,-2.,-.8,0. /
      DATA C1TABO /.0,.5,1.,1.5,2.,2.5,3.,3.5,4.,4.5/
!
!     ----4.1.3.2-52
!
      DATA BA/1.15,1.4,2.,2.2,3.,3.6,4.,5.,6.,7.,8.,9./
      DATA CLOVCL /1.25,1.2,1.12,1.1,1.04,1.,.985,.96,.95,3*.94/
      DATA IN4132 /0/
      DATA WTYPE /4HSTRA ,4HDOUB ,4HCRAN ,4HCURV /
!
!     ----INITIALIZATION ENTRY
!
      ITYPTT = .TRUE.
      LOARAT = .FALSE.
      IF(A(7).LT.A(125)) LOARAT = .TRUE.
      TYPE = AIN(15)
!
!     ----COMPUTE CLA0 + CLAI FOR OTHER THAN STRAIGHT TAPERED
!
      IF(TYPE.EQ.WTYPE(1)) GO TO 1000
!
!     ----CLA0
!
      TEMP1 = 2.*PI*A(168)*DEG
      TEMP2 =(A(168)*DEG*2.*PI/A(131))**2
      TEMP3 = A(98)**2
      TEMP4=B(2)**2
      A(172)=TEMP1/(2.+SQRT(TEMP2*(1.+TEMP3/TEMP4)+4.))
!
!     ----CLAI
!
      TEMP1 = 2.*PI*A(5)*DEG
      TEMP2 = (A(5)*DEG*2.*PI/A(131))**2
      TEMP3 = A(74)**2
      A(171)=TEMP1/(2.+SQRT(TEMP2*(1.+TEMP3/TEMP4)+4.))
 1000 CONTINUE
!
!     ----CURVED WING TEST
!
      IF(TYPE.EQ.WTYPE(4)) GO TO 1070
      ITYPTT = .FALSE.
!
!     ----4.1.3.4-24(B)
!
      CALL TBFUNX(A(27),A(159),DCDT,11,TR,C2,C,IN,MI,NG,                &
     &            0,0,Q3417B,3,ROUTID)
      A(160) = (A(159)+1.)*A(38)*A(7)
!
!     ----COMPUTE BETA*S
!
      TEMP1 = 2.*PI*A(7)*DEG
      TEMP2=A(7)*DEG*2.*PI/A(131)
      TEMP2 = TEMP2**2
      TEMP3 = A(50)**2
      CALL TLINEX(DELTAY, SALE,CLL,7,13,AIN(17),A(34),A(145),           &
     &           -1,0,-1,2,Q3414A,3,ROUTID)
      CALL TLINEX(DY,SALE,DACLL,4,13,AIN(17),A(34),A(144),              &
     &           -1,0,-1,2,Q3414B,3,ROUTID)
 1010 IF(ITYPTT) GO TO 1070
      TEMP4 = B(2)**2
      AOUT(101)=(TEMP1/(2.+SQRT(TEMP2*(1.+TEMP3/TEMP4)+4.)))*A(3)/      &
     &          SREF
      IF(TYPE.NE.WTYPE(3)) GO TO 1020
!
!     ----HERE FOR CRANKED HIGH ASPECT RATIO WING-FINISH CLA COMPUTATION
!     ----FIGURE 4.1.3.2-52
!
      BAARG = A(7)* B(2)
      CALL TBFUNX(BAARG,CLRAT,DYDX,12,BA,CLOVCL,CBA ,IN4132,M4132,N4132,&
     &            2,0,Q13242,3,ROUTID)
      AOUT(101) = CLRAT * AOUT(101)
 1020 CONTINUE
      IF(LOARAT) GO TO 1030
      CALL TLIN3X(DYA,AMACH,SALE4,DCAR,6,5,4,AIN(17),B(1),A( 34),TEMP5  &
     &            ,0,-1,0,2,2,2,Q13415,3,ROUTID)
      A(146)=A(145)*A(132)
      B(44)=(A(145)*A(132)+TEMP5)*A(3)/SREF
      B(43) = B(44)/AOUT(101)+B(49)+A(144)
      GO TO 1060
!
!     ----HERE FOR LOW ASPECT RATIO
!
 1030 C1P1AC = A(7)*A(124)/B(2)
      CALL CLMXBS(C1P1AC,B(44),A,B,AIN)
!
!     ----4.1.3.4-25(A)
!
      CALL TBFUNX(C1P1AC,ACLBAS,DYDX,10,C1ABCS,ACLMX,C17,I17,MI,NG,     &
     &            0,0,Q3418A,3,ROUTID)
      IF(A(160).LE.4.5) GO TO 1040
      CALL TLINEX(DMN,C1TAB,DACL,3,20,B(1),A(160),DACMAX,               &
     &            -1,0,2,0,Q3418B,3,ROUTID)
      GO TO 1050
 1040 TMP=A(7)*A(37)*(1.+4.*A(27)**2)
      CALL TLINEX(ACLE,C1TABO,DACLO,10,10,TMP,A(160),DACMAX,            &
     &            0,0,2,0,Q3418B,3,ROUTID)
 1050 B(43)=ACLBAS+DACMAX
 1060 CONTINUE
      RETURN
 1070 WRITE(6,1080) TYPE,LOARAT
 1080 FORMAT(33H NO CLALPHA COMPUTATION- WING IS  ,A4,18H LOW ASPECT RAT&
     &IO= ,L1)
      RETURN
      END
      SUBROUTINE XNAM1(IOP)
!
!***  READ OR WRITE NAMELIST FLTCON
!
      COMMON /FLGTCD/ A2(160)
      COMMON /FLOLOG/ FLO(19)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER FLTCON
      LOGICAL EOF
!
      DIMENSION LEN2(18),LDM2(18),FLTCON(81),LOC2(18),A2A(161)
      DIMENSION NLNAME(6)
!
      DATA NLNAME / 4HF   ,4HL   ,4HT   ,4HC   ,4HO   ,4HN   /
      DATA LEN2 / 5,4,6,6,5,3*6,2,3,3*4,2,5,4,4,5 /
      DATA LDM2 / 1,20,1,20,20,-1,3*1,4*20,4*1,20 /
      DATA LOC2 / 1,3,2,23,43,161,94,95,96,97,74,117,137,157,158        &
     &            ,159,160,23 /
      DATA FLTCON /   4HN   ,4HM   ,4HA   ,4HC   ,4HH   ,4HM   ,        &
     &  4HA   ,4HC   ,4HH   ,4HN   ,4HA   ,4HL   ,4HP   ,4HH   ,        &
     &  4HA   ,4HA   ,4HL   ,4HS   ,4HC   ,4HH   ,4HD   ,4HR   ,        &
     &  4HN   ,4HN   ,4HU   ,4HB   ,4HH   ,4HY   ,4HP   ,4HE   ,        &
     &  4HR   ,4HS   ,4HS   ,4HT   ,4HM   ,4HA   ,4HC   ,4HH   ,        &
     &  4HT   ,4HS   ,4HM   ,4HA   ,4HC   ,4HH   ,4HT   ,4HR   ,        &
     &  4HA   ,4HL   ,4HT   ,4HP   ,4HI   ,4HN   ,4HF   ,4HT   ,        &
     &  4HI   ,4HN   ,4HF   ,4HV   ,4HI   ,4HN   ,4HF   ,4HW   ,        &
     &  4HT   ,4HG   ,4HA   ,4HM   ,4HM   ,4HA   ,4HN   ,4HA   ,        &
     &  4HL   ,4HT   ,4HL   ,4HO   ,4HO   ,4HP   ,4HA   ,4HL   ,        &
     &  4HP   ,4HH   ,4HA   /
!
      DO 1000 I=1,160
         A2A(I)=A2(I)
 1000 END DO
      A2A(161)=FLO(19)
!
!**   IF IOP EQUAL ZERO READ NAMELIST FLTCON
!**   IF IOP EQUAL ONE WRITE NAMELIST FLTCON
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,FLTCON,81,LEN2,18,LDM2,A2A,161,       &
     &            LOC2,EOF)
      IF(IOP .EQ. 1)                                                    &
     & CALL NAMEW(KAND,6,NLNAME,6,FLTCON,81,LEN2,18,LDM2,A2A,161,LOC2)
!
      DO 1010 I=1,160
         A2(I)=A2A(I)
 1010 END DO
      FLO(19)=A2A(161)
!
      RETURN
      END
      SUBROUTINE XNAM10(IOP)
!
!***  READ OR WRITE NAMELIST VTSCHR
!
      COMMON /VTI/ A9(162)
      COMMON /IBV/ A9B(363)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER SCHR
      LOGICAL EOF
!
      DIMENSION LENVTS(34),LDMVTS(34),SCHR(160),LOCVTS(34),VTS(314)
      DIMENSION NLNAME(6)
      DATA NLNAME / 4HV   ,4HT   ,4HS   ,4HC   ,4HH   ,4HR   /
      DATA LENVTS / 4,6,4,3,6,6,5,6,3,5,4,4,4,5,3,4,5,6,5,5,4,6,3*3,    &
     &            6,4,5,6,6,4,5,6,6 /
      DATA LDMVTS / 5*1,20,20,-1,16*1,20,1,1,5*50,1,1 /
      DATA LOCVTS / 16,17,18,19,20,21,41,64,61,66,67,62,63,65,61,       &
     &            67,70,71,69,69,92,68,155,155,72,314,163,              &
     &            164,214,264,214,264,10,10 /
      DATA SCHR /     4HT   ,4HO   ,4HV   ,4HC   ,4HD   ,4HE   ,        &
     & 4HL   ,4HT   ,4HA   ,4HY   ,4HX   ,4HO   ,4HV   ,4HC   ,         &
     & 4HC   ,4HL   ,4HI   ,4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,         &
     & 4HI   ,4HC   ,4HL   ,4HA   ,4HL   ,4HP   ,4HA   ,4HC   ,         &
     & 4HL   ,4HM   ,4HA   ,4HX   ,4HC   ,4HA   ,4HM   ,4HB   ,         &
     & 4HE   ,4HR   ,4HC   ,4HM   ,4H0   ,4HX   ,4HO   ,4HV   ,         &
     & 4HC   ,4HO   ,4HC   ,4HM   ,4H0   ,4HT   ,4HL   ,4HE   ,         &
     & 4HR   ,4HI   ,4HL   ,4HE   ,4HR   ,4HO   ,4HT   ,4HO   ,         &
     & 4HV   ,4HC   ,4HO   ,4HC   ,4HM   ,4HO   ,4HC   ,4HM   ,         &
     & 4HO   ,4HT   ,4HT   ,4HC   ,4HE   ,4HF   ,4HF   ,4HK   ,         &
     & 4HS   ,4HH   ,4HA   ,4HR   ,4HP   ,4HC   ,4HL   ,4HA   ,         &
     & 4HM   ,4H0   ,4HC   ,4HL   ,4HA   ,4HM   ,4HO   ,4HA   ,         &
     & 4HR   ,4HC   ,4HL   ,4HC   ,4HL   ,4HM   ,4HA   ,4HX   ,         &
     & 4HL   ,4HY   ,4HC   ,4HM   ,4HC   ,4HL   ,4HD   ,4HX   ,         &
     & 4HA   ,4HC   ,4HT   ,4HY   ,4HP   ,4HE   ,4HI   ,4HN   ,         &
     & 4HN   ,4HP   ,4HT   ,4HS   ,4HX   ,4HC   ,4HO   ,4HR   ,         &
     & 4HD   ,4HY   ,4HU   ,4HP   ,4HP   ,4HE   ,4HR   ,4HY   ,4HL   ,  &
     & 4HO   ,4HW   ,4HE   ,4HR   ,4HM   ,4HE   ,4HA   ,4HN   ,         &
     & 4HT   ,4HH   ,4HI   ,4HC   ,4HK   ,4HA   ,4HL   ,4HP   ,         &
     & 4HH   ,4HA   ,4HO   ,4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,4H0   /
!
      DO 1000 I=1,162
         VTS(I)=A9(I)
 1000 END DO
      VTS(314)=A9B(132)
      DO 1010 I=163,313
         VTS(I)=A9B(I+50)
 1010 END DO
!
!**   IOP EQUAL ZERO READ NAMELIST VTSCHR
!**   IOP EQUAL ONE WRITE NAMELIST VTSCHR
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,SCHR,160,LENVTS,34,LDMVTS,VTS,314,    &
     &            LOCVTS,EOF)
      IF(IOP .EQ. 1)                                                    &
     & CALL NAMEW(KAND,6,NLNAME,6,SCHR,160,LENVTS,34,LDMVTS,VTS,314,    &
     &            LOCVTS)
!
!     PUT THE VARIABLES IN THE APPROPRIATE COMMON BLOCK
!
      DO 1020 I=1,162
         IF(I .EQ. 155)GO TO 1020
         A9(I)=VTS(I)
 1020 END DO
      A9B(132)=VTS(314)
      DO 1030 I=163,313
         A9B(I+50)=VTS(I)
 1030 END DO
!
      RETURN
      END
      SUBROUTINE XNAM11(IOP)
!
      COMMON /POWER/  AC(50)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER PROPWR
      LOGICAL EOF
!
      DIMENSION LENC(14),LDMC(14),PROPWR(78),LOCC(14)
      DIMENSION NLNAME(6)
!
      DATA NLNAME / 4HP   ,4HR   ,4HO   ,4HP   ,4HW   ,4HR   /
      DATA LENC / 12*6,4,2 /
      DATA LDMC / 12*1,-1,1 /
      DATA LOCC / 1,2,3,4,5,6,7,8,9,10,11,12,29,28 /
      DATA PROPWR /   4HA   ,4HI   ,4HE   ,4HT   ,4HL   ,4HP   ,        &
     &  4HN   ,4HE   ,4HN   ,4HG   ,4HS   ,4HP   ,4HT   ,4HH   ,        &
     &  4HS   ,4HT   ,4HC   ,4HP   ,4HP   ,4HH   ,4HA   ,4HL   ,        &
     &  4HO   ,4HC   ,4HP   ,4HH   ,4HV   ,4HL   ,4HO   ,4HC   ,        &
     &  4HP   ,4HR   ,4HP   ,4HR   ,4HA   ,4HD   ,4HE   ,4HN   ,        &
     &  4HG   ,4HF   ,4HC   ,4HT   ,4HB   ,4HW   ,4HA   ,4HP   ,        &
     &  4HR   ,4H3   ,4HB   ,4HW   ,4HA   ,4HP   ,4HR   ,4H6   ,        &
     &  4HB   ,4HW   ,4HA   ,4HP   ,4HR   ,4H9   ,4HN   ,4HO   ,        &
     &  4HP   ,4HB   ,4HP   ,4HE   ,4HB   ,4HA   ,4HP   ,4HR   ,        &
     &  4H7   ,4H5   ,4HC   ,4HR   ,4HO   ,4HT   ,4HY   ,4HP   /
!
!**   IF IOP EQUAL ZERO READ NAMELISR PROPWR
!**   IF IOP EQUAL ONE WRITE NAMELIST PROPWR
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,PROPWR,78,LENC,14,LDMC,AC,50,LOCC,EOF)
      IF(IOP .EQ. 1)                                                    &
     & CALL NAMEW(KAND,6,NLNAME,6,PROPWR,78,LENC,14,LDMC,AC,50,LOCC)
!
      RETURN
      END
      SUBROUTINE XNAM12(IOP)
!
      COMMON /POWER/  AD(50)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      LOGICAL EOF
!
      DIMENSION LEND(15),LDMD(15),JETPWR(89),LOCD(15)
      DIMENSION NLNAME(6)
!
!***  NAMELIST JETPWR
!
      DATA NLNAME / 4HJ   ,4HE   ,4HT   ,4HP   ,4HW   ,4HR   /
      DATA LEND / 14*6,5 /
      DATA LDMD / 15*1 /
      DATA LOCD / 13,14,15,16,17,18,19,20,21,22,23,24,25,26,27 /
      DATA JETPWR /   4HA   ,4HI   ,4HE   ,4HT   ,4HL   ,4HJ   ,        &
     &  4HN   ,4HE   ,4HN   ,4HG   ,4HS   ,4HJ   ,4HT   ,4HH   ,        &
     &  4HS   ,4HT   ,4HC   ,4HJ   ,4HJ   ,4HI   ,4HA   ,4HL   ,        &
     &  4HO   ,4HC   ,4HJ   ,4HE   ,4HV   ,4HL   ,4HO   ,4HC   ,        &
     &  4HJ   ,4HE   ,4HA   ,4HL   ,4HO   ,4HC   ,4HJ   ,4HI   ,        &
     &  4HN   ,4HL   ,4HT   ,4HA   ,4HJ   ,4HE   ,4HA   ,4HN   ,        &
     &  4HG   ,4HL   ,4HJ   ,4HE   ,4HV   ,4HE   ,4HL   ,4HO   ,        &
     &  4HA   ,4HM   ,4HB   ,4HT   ,4HM   ,4HP   ,4HJ   ,4HE   ,        &
     &  4HS   ,4HT   ,4HM   ,4HP   ,4HJ   ,4HE   ,4HL   ,4HL   ,        &
     &  4HO   ,4HC   ,4HJ   ,4HE   ,4HT   ,4HO   ,4HT   ,4HP   ,        &
     &  4HA   ,4HM   ,4HB   ,4HS   ,4HT   ,4HP   ,4HJ   ,4HE   ,        &
     &  4HR   ,4HA   ,4HD   /
!
!**   IF IOP EQUAL ZERO READ NAMELIST JETPWR
!**   IF IOP EQUAL ONE WRITE NAMELIST JETPWR
!
      IF(IOP .EQ. 0)                                                    &
     &  CALL NAMER(KAND,9,NLNAME,6,JETPWR,89,LEND,15,LDMD,AD,50,        &
     &             LOCD,EOF)
      IF(IOP .EQ. 1)                                                    &
     &  CALL NAMEW(KAND,6,NLNAME,6,JETPWR,89,LEND,15,LDMD,AD,50,LOCD)
!
      RETURN
      END
      SUBROUTINE XNAM13(IOP)
!
      COMMON /POWER/  AE(50)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /OPTION/ SR,CBARR,ROUGFC,BLREF
!
      LOGICAL EOF
!
      DIMENSION LENE(21),LDME(21),LARWB(89),LOCE(21)
      DIMENSION NLNAME(5)
!
      DATA NLNAME / 4HL   ,4HA   ,4HR   ,4HW   ,4HB   /
      DATA LENE / 2,4,6,6,2,6,6,1,4,6,5,2,2,3,3,6,6,3,5,6,5 /
      DATA LDME / 13*1,-1,1,1,-1,4*1 /
      DATA LOCE / 30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,         &
     &            45,46,47,48,49,50 /
      DATA LARWB  /   4HZ   ,4HB   ,4HS   ,4HR   ,4HE   ,4HF   ,        &
     &  4HD   ,4HE   ,4HL   ,4HT   ,4HE   ,4HP   ,4HS   ,4HF   ,        &
     &  4HR   ,4HO   ,4HN   ,4HT   ,4HA   ,4HR   ,4HR   ,4H3   ,        &
     &  4HL   ,4HE   ,4HO   ,4HB   ,4HD   ,4HE   ,4HL   ,4HT   ,        &
     &  4HA   ,4HL   ,4HL   ,4HS   ,4HW   ,4HE   ,4HT   ,4HP   ,        &
     &  4HE   ,4HR   ,4HB   ,4HA   ,4HS   ,4HS   ,4HB   ,4HA   ,        &
     &  4HS   ,4HE   ,4HH   ,4HB   ,4HB   ,4HB   ,4HB   ,4HL   ,        &
     &  4HF   ,4HX   ,4HC   ,4HG   ,4HT   ,4HH   ,4HE   ,4HT   ,        &
     &  4HA   ,4HD   ,4HR   ,4HO   ,4HU   ,4HN   ,4HD   ,4HN   ,        &
     &  4HS   ,4HB   ,4HS   ,4HS   ,4HB   ,4HS   ,4HL   ,4HB   ,        &
     &  4HX   ,4HC   ,4HE   ,4HN   ,4HS   ,4HB   ,4HX   ,4HC   ,        &
     &  4HE   ,4HN   ,4HW   /
!
!**  IF IOP EQUAL ZERO READ NAMELIST LARWB
!**  IF IOP EQUAL ONE WRITE NAMELIST LARWB
!
      IF(IOP .EQ. 0)                                                    &
     &  CALL NAMER(KAND,9,NLNAME,5,LARWB,89,LENE,21,LDME,AE,50,LOCE,EOF)
      IF(IOP .EQ. 1)                                                    &
     &  CALL NAMEW(KAND,6,NLNAME,5,LARWB,89,LENE,21,LDME,AE,50,LOCE)
!
      SR=AE(31)
      CBARR=AE(37)
      RETURN
      END
      SUBROUTINE XNAM14(IOP)
!
      COMMON /FLGTCD/ AF(141), dumflgtcd(19)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER GRNDEF
      LOGICAL EOF
!
      DIMENSION LENF(2),LDMF(2),GRNDEF(8),LOCF(2)
      DIMENSION NLNAME(6)
!
      DATA NLNAME / 4HG   ,4HR   ,4HN   ,4HD   ,4HE   ,4HF   /
      DATA LENF / 3,5 /
      DATA LDMF / 1,10 /
      DATA LOCF / 63,64 /
      DATA GRNDEF /   4HN   ,4HG   ,4HH   ,4HG   ,4HR   ,4HD   ,        &
     &  4HH   ,4HT   /
!
!**   IF IOP EQUAL ZERO READ NAMELIST GRNDEF
!**   IF IOP EQUAL ONE WRITE NAMELIST GRNDEF
!
      IF(IOP .EQ. 0)                                                    &
     &   CALL NAMER(KAND,9,NLNAME,6,GRNDEF,8,LENF,2,LDMF,AF,141,        &
     &              LOCF,EOF)
      IF(IOP .EQ. 1)                                                    &
     &  CALL NAMEW(KAND,6,NLNAME,6,GRNDEF,8,LENF,2,LDMF,AF,141,LOCF)
!
      RETURN
      END
      SUBROUTINE XNAM15(IOP)
!
      COMMON /VTI/    AG(162)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER TVTPAN
      LOGICAL EOF
!
      DIMENSION LENG(8),LDMG(8),TVTPAN(23),LOCG(8)
      DIMENSION NLNAME(6)
!
      DATA NLNAME / 4HT   ,4HV   ,4HT   ,4HP   ,4HA   ,4HN   /
      DATA LENG / 3,2,3,2,2,6,3,2 /
      DATA LDMG / 8*1 /
      DATA LOCG / 155,156,157,158,159,160,161,162 /
      DATA TVTPAN /   4HB   ,4HV   ,4HP   ,4HB   ,4HV   ,4HB   ,        &
     &  4HD   ,4HV   ,4HB   ,4HH   ,4HS   ,4HV   ,4HV   ,4HP   ,        &
     &  4HH   ,4HI   ,4HT   ,4HE   ,4HV   ,4HL   ,4HP   ,4HZ   ,        &
     &  4HP   /
!
!**   IF IOP EQUAL ZERO READ NAMELIST TVTPAN
!**   IF IOP EQUAL ONE WRITE NAMELIST TVTPAN
!
      IF(IOP .EQ. 0)                                                    &
     &  CALL NAMER(KAND,9,NLNAME,6,TVTPAN,23,LENG,8,LDMG,AG,162,        &
     &             LOCG,EOF)
      IF(IOP .EQ. 1)                                                    &
     &  CALL NAMEW(KAND,6,NLNAME,6,TVTPAN,23,LENG,8,LDMG,AG,162,LOCG)
!
      RETURN
      END
      SUBROUTINE XNAM16(IOP)
!
      COMMON /FLAPIN/ AI(137)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER SYMFLP
      LOGICAL EOF
!
      DIMENSION LENI(27),LDMI(27),SYMFLP(139),LOCI(27),AIA(117)
      DIMENSION NLNAME(6)
!
      DATA NLNAME / 4HS   ,4HY   ,4HM   ,4HF   ,4HL   ,4HP   /
      DATA LENI / 6*6,3*5,4,2,2,4,5,6,6,4,4,3,8*6 /
      DATA LDMI / 13*1,5*9,1,9,1,4*9,2*1 /
      DATA LOCI / 12,13,14,15,16,61,11,17,62,18,59,60,18,1,39,          &
     &            49,19,29,63,64,74,75,85,95,105,115,116 /
      DATA SYMFLP /   4HC   ,4HH   ,4HR   ,4HD   ,4HF   ,4HI   ,        &
     &  4HC   ,4HH   ,4HR   ,4HD   ,4HF   ,4HO   ,4HS   ,4HP   ,        &
     &  4HA   ,4HN   ,4HF   ,4HI   ,4HS   ,4HP   ,4HA   ,4HN   ,        &
     &  4HF   ,4HO   ,4HN   ,4HD   ,4HE   ,4HL   ,4HT   ,4HA   ,        &
     &  4HP   ,4HH   ,4HE   ,4HT   ,4HE   ,4HP   ,4HP   ,4HH   ,        &
     &  4HE   ,4HT   ,4HE   ,4HF   ,4HT   ,4HY   ,4HP   ,4HE   ,        &
     &  4HN   ,4HT   ,4HY   ,4HP   ,4HE   ,4HS   ,4HC   ,4HH   ,        &
     &  4HA   ,4HC   ,4HB   ,4HT   ,4HC   ,4HS   ,4HC   ,4HH   ,        &
     &  4HD   ,4HD   ,4HE   ,4HL   ,4HT   ,4HA   ,4HC   ,4HP   ,        &
     &  4HR   ,4HM   ,4HE   ,4HI   ,4HC   ,4HP   ,4HR   ,4HM   ,        &
     &  4HE   ,4HO   ,4HS   ,4HC   ,4HL   ,4HD   ,4HS   ,4HC   ,        &
     &  4HM   ,4HD   ,4HC   ,4HM   ,4HU   ,4HD   ,4HE   ,4HL   ,        &
     &  4HJ   ,4HE   ,4HT   ,4HJ   ,4HE   ,4HT   ,4HF   ,4HL   ,        &
     &  4HP   ,4HE   ,4HF   ,4HF   ,4HJ   ,4HE   ,4HT   ,4HC   ,        &
     &  4HA   ,4HP   ,4HI   ,4HN   ,4HB   ,4HC   ,4HA   ,4HP   ,        &
     &  4HO   ,4HU   ,4HT   ,4HD   ,4HO   ,4HB   ,4HD   ,4HE   ,        &
     &  4HF   ,4HD   ,4HO   ,4HB   ,4HC   ,4HI   ,4HN   ,4HD   ,        &
     &  4HO   ,4HB   ,4HC   ,4HO   ,4HT   /
!
      DO 1000 I=1,116
         AIA(I)=AI(I)
 1000 END DO
!
!**   IF IOP EQUAL ZERO READ NAMELIST SYMFLP
!**   IF IOP EQUAL ONE WRITE NAMELIST SYMFLP
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,SYMFLP,139,LENI,27,LDMI,AIA,117,      &
     &            LOCI,EOF)
      IF(IOP .EQ. 1)                                                    &
     & CALL NAMEW(KAND,6,NLNAME,6,SYMFLP,139,LENI,27,LDMI,AIA,117,LOCI)
!
      DO 1010 I=1,116
         AI(I)=AIA(I)
 1010 END DO
!
      RETURN
      END
      SUBROUTINE XNAM17(IOP)
!
      COMMON /FLAPIN/ AJ(137)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER ASYFLP
      LOGICAL EOF
!
      DIMENSION LENJ(14),LDMJ(14),ASYFLP(78),LOCJ(14)
      DIMENSION NLNAME(6)
!
      DATA NLNAME / 4HA   ,4HS   ,4HY   ,4HF   ,4HL   ,4HP   /
      DATA LENJ / 4*6,4,4,5,6*6,5 /
      DATA LDMJ / 6*9,8*1 /
      DATA LOCJ / 19,29,1,39,49,60,18,59,16,12,13,14,15,11 /
      DATA ASYFLP /   4HD   ,4HE   ,4HL   ,4HT   ,4HA   ,4HL   ,        &
     &  4HD   ,4HE   ,4HL   ,4HT   ,4HA   ,4HR   ,4HD   ,4HE   ,        &
     &  4HL   ,4HT   ,4HA   ,4HD   ,4HD   ,4HE   ,4HL   ,4HT   ,        &
     &  4HA   ,4HS   ,4HX   ,4HS   ,4HO   ,4HC   ,4HH   ,4HS   ,        &
     &  4HO   ,4HC   ,4HS   ,4HT   ,4HY   ,4HP   ,4HE   ,4HX   ,        &
     &  4HS   ,4HP   ,4HR   ,4HM   ,4HE   ,4HN   ,4HD   ,4HE   ,        &
     &  4HL   ,4HT   ,4HA   ,4HC   ,4HH   ,4HR   ,4HD   ,4HF   ,        &
     &  4HI   ,4HC   ,4HH   ,4HR   ,4HD   ,4HF   ,4HO   ,4HS   ,        &
     &  4HP   ,4HA   ,4HN   ,4HF   ,4HI   ,4HS   ,4HP   ,4HA   ,        &
     &  4HN   ,4HF   ,4HO   ,4HP   ,4HH   ,4HE   ,4HT   ,4HE   /
!
!**   IF IOP EQUAL ZERO READ NAMELIST ASYFLP
!**   IF IOP EQUAL ONE WRITE NAMELIST ASYFLP
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,ASYFLP,78,LENJ,14,LDMJ,AJ,137,        &
     &            LOCJ,EOF)
      IF(IOP .EQ. 1)                                                    &
     & CALL NAMEW(KAND,6,NLNAME,6,ASYFLP,78,LENJ,14,LDMJ,AJ,137,LOCJ)
!
      RETURN
      END
      SUBROUTINE XNAM18(IOP)
!
      COMMON /FLAPIN/ AK(137)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER HYPEFF
      LOGICAL EOF
!
      DIMENSION LENK(7),LDMK(7),HYPEFF(32),LOCK(7)
      DIMENSION NLNAME(6)
!
      DATA NLNAME / 4HH   ,4HY   ,4HP   ,4HE   ,4HF   ,4HF   /
      DATA LENK / 5,3,5,2,5,6,6 /
      DATA LDMK / 4*1,-1,1,10 /
      DATA LOCK / 1,2,3,4,15,16,5 /
      DATA HYPEFF /   4HA   ,4HL   ,4HI   ,4HT   ,4HD   ,4HX   ,        &
     &  4HH   ,4HL   ,4HT   ,4HW   ,4HO   ,4HT   ,4HI   ,4HC   ,        &
     &  4HF   ,4HL   ,4HA   ,4HM   ,4HN   ,4HR   ,4HH   ,4HN   ,        &
     &  4HD   ,4HL   ,4HT   ,4HA   ,4HH   ,4HD   ,4HE   ,4HL   ,        &
     &  4HT   ,4HA   /
!
!**   IF IOP EQUAL ZERO READ NAMELIST HYPEFF
!**   IF IOP EQUAL ONE WRITE NAMELIST HYPEFF
!
      IF(IOP .EQ. 0)                                                    &
     &  CALL NAMER(KAND,9,NLNAME,6,HYPEFF,32,LENK,7,LDMK,AK,137,        &
     &             LOCK,EOF)
      IF(IOP .EQ. 1)                                                    &
     &  CALL NAMEW(KAND,6,NLNAME,6,HYPEFF,32,LENK,7,LDMK,AK,137,LOCK)
!
      RETURN
      END
      SUBROUTINE XNAM19(IOP)
!
      COMMON /FLAPIN/ AL(137)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER TRNJET
      LOGICAL EOF
!
      DIMENSION LENL(12),LDML(12),TRNJET(38),LOCL(12)
      DIMENSION NLNAME(6)
!
      DATA NLNAME / 4HT   ,4HR   ,4HN   ,4HJ   ,4HE   ,4HT   /
      DATA LENL / 4,2,5,6,2,2,3,4,3,2,2,3 /
      DATA LDML / 3*10,-10,8*1 /
      DATA LOCL / 1,12,22,39,11,32,33,34,35,36,37,38 /
      DATA TRNJET /   4HT   ,4HI   ,4HM   ,4HE   ,4HF   ,4HC   ,        &
     &  4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,4HL   ,4HA   ,4HM   ,        &
     &  4HN   ,4HR   ,4HJ   ,4HN   ,4HT   ,4HM   ,4HE   ,4HI   ,        &
     &  4HS   ,4HP   ,4HS   ,4HP   ,4HA   ,4HN   ,4HP   ,4HH   ,        &
     &  4HE   ,4HG   ,4HP   ,4HC   ,4HC   ,4HL   ,4HF   ,4HP   /
!
!**   IF IOP EQUAL ZERO READ NAMELIST TRNJET
!**   IF IOP EQUAL ONE WRITE NAMELIST TRNJET
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,TRNJET,38,LENL,12,LDML,AL,137,        &
     &            LOCL,EOF)
      IF(IOP .EQ. 1)                                                    &
     &  CALL NAMEW(KAND,6,NLNAME,6,TRNJET,38,LENL,12,LDML,AL,137,LOCL)
!
      RETURN
      END
      SUBROUTINE XNAM2(IOP)
!
!***  READ OR WRITE NAMELIST OPTINS
!
      COMMON /OPTION/ A3(4)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER OPTINS
      LOGICAL EOF
!
      DIMENSION LEN3(4),LDM3(4),OPTINS(20),LOC3(4)
      DIMENSION NLNAME(6)
!
      DATA NLNAME / 4HO   ,4HP   ,4HT   ,4HI   ,4HN   ,4HS   /
      DATA LEN3 / 4,5,6,5 /
      DATA LDM3 / 4*1 /
      DATA LOC3 / 1,2,3,4 /
      DATA OPTINS /   4HS   ,4HR   ,4HE   ,4HF   ,4HC   ,4HB   ,        &
     &  4HA   ,4HR   ,4HR   ,4HR   ,4HO   ,4HU   ,4HG   ,4HF   ,        &
     &  4HC   ,4HB   ,4HL   ,4HR   ,4HE   ,4HF   /
!
!**   IF IOP EQUAL ZERO READ NAMELIST OPTINS
!**   IF IOP EQUAL ONE WRITE NAMELIST OPTINS
!
      IF(IOP .EQ. 0)                                                    &
     &  CALL NAMER(KAND,9,NLNAME,6,OPTINS,20,LEN3,4,LDM3,A3,4,LOC3,EOF)
      IF(IOP .EQ. 1)                                                    &
     &  CALL NAMEW(KAND,6,NLNAME,6,OPTINS,20,LEN3,4,LDM3,A3,4,LOC3)
!
      RETURN
      END
      SUBROUTINE XNAM20(IOP)
!
!***  READ OR WRITE NAMELIST VFPLNF
!
      COMMON /VTI/    A5C(316)
      COMMON /VTDATA/ AVT(195),AVF(195)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      EQUIVALENCE (TYPE,A5C(177))
!
      INTEGER PLNF
      LOGICAL EOF
!
      DIMENSION NLNAME(6),XTYPE(4),VFP(75),IEQU(18)
      DIMENSION LENVFP(18),PLNF(92),LOCVFP(18),LDMVFP(18)
!
      DATA XTYPE /4HSTRA,4HDDUB,4HCRAN,4HCURV/
      DATA NLNAME /4HV   ,4HF   ,4HP   ,4HL   ,4HN   ,4HF   /
      DATA LENVFP / 6,6,5,4,6,5,5,6,5,4*6,4,5,4,3,4/
      DATA LDMVFP / 15*1,3*20 /
      DATA LOCVFP / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,36,56 /
      DATA IEQU / 163,164,165,166,167,168,169,171,172,173,174,175,      &
     &            176,177,170,257,277,297 /
      DATA PLNF /4HC   ,4HH   ,4HR   ,4HD   ,4HT   ,4HP   ,4HS   ,      &
     &    4HS   ,4HP   ,4HN   ,4HO   ,4HP   ,4HS   ,4HS   ,4HP   ,      &
     &    4HN   ,4HE   ,4HS   ,4HS   ,4HP   ,4HN   ,4HC   ,             &
     &    4HH   ,4HR   ,4HD   ,4HB   ,4HP   ,4HC   ,4HH   ,4HR   ,      &
     &    4HD   ,4HR   ,4HS   ,4HA   ,4HV   ,4HS   ,4HI   ,4HC   ,      &
     &    4HH   ,4HS   ,4HT   ,4HA   ,4HT   ,4HS   ,4HW   ,4HA   ,      &
     &    4HF   ,4HP   ,4HT   ,4HW   ,4HI   ,4HS   ,4HT   ,4HA   ,      &
     &    4HS   ,4HS   ,4HP   ,4HN   ,4HD   ,4HD   ,4HD   ,4HH   ,      &
     &    4HD   ,4HA   ,4HD   ,4HI   ,4HD   ,4HH   ,4HD   ,4HA   ,      &
     &    4HD   ,4HO   ,4HT   ,4HY   ,4HP   ,4HE   ,4HS   ,4HA   ,      &
     &    4HV   ,4HS   ,4HO   ,4HS   ,4HV   ,4HW   ,4HB   ,4HS   ,      &
     &    4HV   ,4HB   ,4HS   ,4HV   ,4HH   ,4HB   /
!
      DO 1000 I=1,15
         IE=IEQU(I)
         VFP(I)=A5C(IE)
 1000 END DO
      DO 1020 I=16,18
         IE=IEQU(I)
         IF(I .EQ. 16)K=-1
         IF(I .EQ. 17)K=18
         IF(I .EQ. 18)K=37
         DO 1010 J=1,20
            VFP(I+J+K)=A5C(IE+J-1)
 1010    CONTINUE
 1020 END DO
!
!**   IF IOP EQUAL ZERO READ NAMELIST VTPLNF
!**   IF IOP EQUAL ONE WRITE NAMELIST VTPLNF
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,PLNF,92,LENVFP,18,LDMVFP,VFP,75,      &
     &            LOCVFP,EOF)
      IF(IOP .EQ. 1)                                                    &
     & CALL NAMEW(KAND,6,NLNAME,6,PLNF,92,LENVFP,18,LDMVFP,VFP,         &
     &            75,LOCVFP)
!
      DO 1030 I=1,15
         IE=IEQU(I)
         IF(IE .EQ. 172)GO TO 1030
         A5C(IE)=VFP(I)
 1030 END DO
      DO 1050 I=16,18
         IE=IEQU(I)
         IF(I .EQ. 16)K=-1
         IF(I .EQ. 17)K=18
         IF(I .EQ. 18)K=37
         DO 1040 J=1,20
            A5C(IE+J-1)=VFP(I+J+K)
 1040    CONTINUE
 1050 END DO
!
      AVF(106)=A5C(7)
      AVF(112)=A5C(8)
      AVF(138)=0.0
! --- CHECK IF TYPE SET IN NAMELIST
      DO 1060 I=1,4
         IF(TYPE .EQ. XTYPE(I))TYPE=I
 1060 END DO
      IF(TYPE .LT. 5.)GO TO 1070
      WRITE(6,1080)TYPE
      TYPE=1.0
 1070 RETURN
 1080 FORMAT(42H ERROR TYPE CANNOT BE GREATER THAN 4 TYPE=,E12.5,       &
     &9H SET TO 1)
      END
      SUBROUTINE XNAM21(IOP)
!
!***  READ OR WRITE NAMELIST VFSCHR
!
      COMMON /VTI/ A9(316)
      COMMON /IVF/ A9B(363)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER SCHR
      LOGICAL EOF
!
      DIMENSION LENVFS(34),LDMVFS(34),SCHR(160),LOCVFS(34),VFS(476)
      DIMENSION NLNAME(6)
      DATA LENVFS / 4,6,4,3,6,6,5,6,3,5,4,4,4,5,3,4,5,6,5,5,4,6,3*3,    &
     &            6,4,5,6,6,4,5,6,6 /
      DATA LDMVFS / 5*1,20,20,-1,16*1,20,1,1,5*50,1,1 /
      DATA NLNAME / 4HV   ,4HF   ,4HS   ,4HC   ,4HH   ,4HR   /
!
      DATA LOCVFS / 178,179,180,181,182,183,203,226,223,228,229,224,    &
     &            225,227,223,229,232,233,231,231,254,230,0,0,234,476,  &
     &            325,326,376,426,376,426,10,10 /
      DATA SCHR /   4HT   ,4HO   ,4HV   ,4HC   ,4HD   ,4HE   ,          &
     &4HL   ,4HT   ,4HA   ,4HY   ,4HX   ,4HO   ,4HV   ,4HC   ,          &
     &4HC   ,4HL   ,4HI   ,4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,          &
     &4HI   ,4HC   ,4HL   ,4HA   ,4HL   ,4HP   ,4HA   ,4HC   ,          &
     &4HL   ,4HM   ,4HA   ,4HX   ,4HC   ,4HA   ,4HM   ,4HB   ,          &
     &4HE   ,4HR   ,4HC   ,4HM   ,4H0   ,4HX   ,4HO   ,4HV   ,          &
     &4HC   ,4HO   ,4HC   ,4HM   ,4H0   ,4HT   ,4HL   ,4HE   ,          &
     &4HR   ,4HI   ,4HL   ,4HE   ,4HR   ,4HO   ,4HT   ,4HO   ,          &
     &4HV   ,4HC   ,4HO   ,4HC   ,4HM   ,4HO   ,4HC   ,4HM   ,          &
     &4HO   ,4HT   ,4HT   ,4HC   ,4HE   ,4HF   ,4HF   ,4HK   ,          &
     &4HS   ,4HH   ,4HA   ,4HR   ,4HP   ,4HC   ,4HL   ,4HA   ,          &
     &4HM   ,4H0   ,4HC   ,4HL   ,4HA   ,4HM   ,4HO   ,4HA   ,          &
     &4HR   ,4HC   ,4HL   ,4HC   ,4HL   ,4HM   ,4HA   ,4HX   ,          &
     &4HL   ,4HY   ,4HC   ,4HM   ,4HC   ,4HL   ,4HD   ,4HX   ,          &
     &4HA   ,4HC   ,4HT   ,4HY   ,4HP   ,4HE   ,4HI   ,4HN   ,          &
     &4HN   ,4HP   ,4HT   ,4HS   ,4HX   ,4HC   ,4HO   ,4HR   ,          &
     &4HD   ,4HY   ,4HU   ,4HP   ,4HP   ,4HE   ,4HR   ,4HY   ,4HL   ,   &
     &4HO   ,4HW   ,4HE   ,4HR   ,4HM   ,4HE   ,4HA   ,4HN   ,          &
     &4HT   ,4HH   ,4HI   ,4HC   ,4HK   ,4HA   ,4HL   ,4HP   ,          &
     &4HH   ,4HA   ,4HO   ,4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,4H0   /
!
      DO 1000 I=1,324
         VFS(I)=A9(I)
 1000 END DO
      VFS(476)=A9B(132)
      DO 1010 I=325,475
         VFS(I)=A9B(I-112)
 1010 END DO
!
!**   IOP EQUAL ZERO READ NAMELIST VFSCHR
!**   IOP EQUAL ONE WRITE NAMELIST VFSCHR
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,SCHR,160,LENVFS,34,LDMVFS,VFS,476,    &
     &            LOCVFS,EOF)
      IF(IOP .EQ. 1)                                                    &
     & CALL NAMEW(KAND,6,NLNAME,6,SCHR,160,LENVFS,34,LDMVFS,VFS,476,    &
     &            LOCVFS)
!
!     PUT THE VARIABLES IN THE APPROPRIATE COMMON BLOCK
!
      DO 1020 I=1,324
         A9(I)=VFS(I)
 1020 END DO
      A9B(132)=VFS(476)
      DO 1030 I=325,475
         A9B(I-112)=VFS(I)
 1030 END DO
!
      RETURN
      END
      SUBROUTINE XNAM22(IOP)
!
      COMMON /FLAPIN/ AM(137)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER CONTAB
      LOGICAL EOF
!
      DIMENSION LENM(21),LDMM(21),CONTAB(71),LOCM(21)
      DIMENSION NLNAME(6)
!
      DATA NLNAME / 4HC   ,4HO   ,4HN   ,4HT   ,4HA   ,4HB   /
      DATA LENM / 5*5,4*4,7*2,5,2,2,3,4 /
      DATA LDMM / 21*1 /
      DATA LOCM / 117,118,119,122,123,120,121,124,125,126,127,          &
     &            128,129,130,131,132,133,134,135,136,137 /
      DATA CONTAB /   4HT   ,4HT   ,4HY   ,4HP   ,4HE   ,4HC   ,        &
     &  4HF   ,4HI   ,4HT   ,4HC   ,4HC   ,4HF   ,4HO   ,4HT   ,        &
     &  4HC   ,4HC   ,4HF   ,4HI   ,4HT   ,4HT   ,4HC   ,4HF   ,        &
     &  4HO   ,4HT   ,4HT   ,4HB   ,4HI   ,4HT   ,4HC   ,4HB   ,        &
     &  4HO   ,4HT   ,4HC   ,4HB   ,4HI   ,4HT   ,4HT   ,4HB   ,        &
     &  4HO   ,4HT   ,4HT   ,4HB   ,4H1   ,4HB   ,4H2   ,4HB   ,        &
     &  4H3   ,4HB   ,4H4   ,4HD   ,4H1   ,4HD   ,4H2   ,4HD   ,        &
     &  4H3   ,4HG   ,4HC   ,4HM   ,4HA   ,4HX   ,4HK   ,4HS   ,        &
     &  4HR   ,4HL   ,4HB   ,4HG   ,4HR   ,4HD   ,4HE   ,4HL   ,        &
     &  4HR   /
!
!**   IF IOP EQUAL ZERO READ NAMELIST CONTAB
!**   IF IOP EQUAL ONE WRITE NAMELIST CONTAB
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,CONTAB,71,LENM,21,LDMM,AM,137,        &
     &            LOCM,EOF)
      IF(IOP .EQ. 1)                                                    &
     & CALL NAMEW(KAND,6,NLNAME,6,CONTAB,71,LENM,21,LDMM,AM,137,LOCM)
!
      RETURN
      END
      SUBROUTINE XNAM23(IOP)
!
!***  SUBROUTINE TO READ OR WRITE NAMELIST EXPR
!
      COMMON /IBODY/  AHA(141), dum1(260)
      COMMON /IWING/  AHB(141), dum13(260)
      COMMON /IHT/    AHC(141), dum3(240)
      COMMON /IBW/    AHD(141), dum5(240)
      COMMON /IVT/    AHE(2), dum4(379)
      COMMON /IDWASH/ AHF(61)
      COMMON /EXPER/  AHG(116)
      COMMON /SBETA/  STB(135),TRA(108),TRAH(108)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER EXPR
      LOGICAL EOF
!
      DIMENSION LENH(32),LDMH(32),EXPR(131),LOCH(32),AH(469)
      DIMENSION NLNAME(4)
!
!***  NAMELIST EXPR
!
      DATA NLNAME / 4HE   ,4HX   ,4HP   ,4HR   /
      DATA LENH / 3*3,4,4,3*3,4,4,3*3,5*4,5,5,6,6,5,3,5*5,4,5,4 /
      DATA LDMH / 23*20,9*1 /
      DATA LOCH / 1,21,41,61,81,101,121,141,161,181,201,221,241,        &
     &            261,281,301,321,341,361,381,401,421,441,461,          &
     &            462,463,464,465,466,467,468,469 /
      DATA EXPR /     4HC   ,4HD   ,4HB   ,4HC   ,4HL   ,4HB   ,        &
     &  4HC   ,4HM   ,4HB   ,4HC   ,4HL   ,4HA   ,4HB   ,4HC   ,        &
     &  4HM   ,4HA   ,4HB   ,4HC   ,4HD   ,4HW   ,4HC   ,4HL   ,        &
     &  4HW   ,4HC   ,4HM   ,4HW   ,4HC   ,4HL   ,4HA   ,4HW   ,        &
     &  4HC   ,4HM   ,4HA   ,4HW   ,4HC   ,4HD   ,4HH   ,4HC   ,        &
     &  4HL   ,4HH   ,4HC   ,4HM   ,4HH   ,4HC   ,4HL   ,4HA   ,        &
     &  4HH   ,4HC   ,4HM   ,4HA   ,4HH   ,4HC   ,4HD   ,4HW   ,        &
     &  4HB   ,4HC   ,4HL   ,4HW   ,4HB   ,4HC   ,4HM   ,4HW   ,        &
     &  4HB   ,4HC   ,4HL   ,4HA   ,4HW   ,4HB   ,4HC   ,4HM   ,        &
     &  4HA   ,4HW   ,4HB   ,4HQ   ,4HO   ,4HQ   ,4HI   ,4HN   ,        &
     &  4HF   ,4HE   ,4HP   ,4HS   ,4HL   ,4HO   ,4HN   ,4HD   ,        &
     &  4HE   ,4HO   ,4HD   ,4HA   ,4HC   ,4HD   ,4HV   ,4HA   ,        &
     &  4HL   ,4HP   ,4HO   ,4HW   ,4HA   ,4HL   ,4HP   ,4HL   ,        &
     &  4HW   ,4HA   ,4HL   ,4HP   ,4HO   ,4HH   ,4HA   ,4HL   ,        &
     &  4HP   ,4HL   ,4HH   ,4HA   ,4HC   ,4HL   ,4HM   ,4HW   ,        &
     &  4HC   ,4HL   ,4HM   ,4HW   ,4HA   ,4HC   ,4HL   ,4HM   ,        &
     &  4HH   ,4HC   ,4HL   ,4HM   ,4HH   /
!
!**   LOOP TO FILL WORKING ARRAY
!     J PARAMETER IS TO PUT CLA AND CMA FROM COMMON INTO CORRECT POSITIO
!     IN THE WORKING ARRAY (SEE INSERT TO USERS MANUAL MARK UP COPY FOR
!     EXPLANATION OF IOM COMMON BLOCKS WHEN USING EXPERIMENTAL SUBSTIUTI
!
      J=1
      DO 1000 I=1,100
         J=J+1
         AH(I)=AHA(J)
         AH(I+100)=AHB(J)
         AH(I+200)=AHC(J)
         AH(I+300)=AHD(J)
         IF(I .EQ. 60)J=101
 1000 END DO
      DO 1010 I=1,60
         AH(I+400)=AHF(I+1)
 1010 END DO
      AH(461)=AHE(2)
      DO 1020 I=1,4
         AH(I+461)=AHG(I+112)
 1020 END DO
      AH(466)=TRA(37)
      AH(467)=TRA(38)
      AH(468)=TRAH(37)
      AH(469)=TRAH(38)
!
!***  IF IOP EQUAL 0 READ NAMELIST EXPR, IF IOP EQUAL 1 WRITE EXPR
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,10,NLNAME,4,EXPR,131,LENH,32,LDMH,AH,469,        &
     &            LOCH,EOF)
      IF(IOP .EQ. 1)                                                    &
     & CALL NAMEW(KAND,6,NLNAME,4,EXPR,131,LENH,32,LDMH,AH,469,LOCH)
!
!***  REPLACE DATA READ INTO APPROPRIATE COMMON BLOCKS
!
      J=1
      DO 1030 I=1,100
         J=J+1
         AHA(J)=AH(I)
         AHB(J)=AH(I+100)
         AHC(J)=AH(I+200)
         AHD(J)=AH(I+300)
         IF(I .EQ. 60)J=101
 1030 END DO
      DO 1040 I=1,60
         AHF(I+1)=AH(I+400)
 1040 END DO
      AHE(2)=AH(461)
      DO 1050 I=1,4
         AHG(I+112)=AH(I+461)
 1050 END DO
      TRA(37)=AH(466)
      TRA(38)=AH(467)
      TRAH(37)=AH(468)
      TRAH(38)=AH(469)
!
      RETURN
      END
      SUBROUTINE XNAM3(IOP)
!
!***  READ OR WRITE NAMELIST BODY
!
      COMMON /BODYI/  A4(129)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      EQUIVALENCE (TYPE,A4(127))
!
      INTEGER BODY
      LOGICAL EOF
!
      DIMENSION LEN4(15),LDM4(15),BODY(44),LOC4(15)
      DIMENSION NLNAME(4)
      DATA NLNAME / 4HB   ,4HO   ,4HD   ,4HY   /
      DATA LEN4 / 2,4*1,2,2,5,5,3,3,2,5,6,5 /
      DATA LDM4 / 1,6*20,8*1 /
      DATA LOC4 / 1,2,22,42,62,82,102,122,123,124,125,126,127,128,      &
     &            129 /
      DATA BODY /     4HN   ,4HX   ,4HX   ,4HS   ,4HP   ,4HR   ,        &
     &  4HZ   ,4HU   ,4HZ   ,4HL   ,4HB   ,4HN   ,4HO   ,4HS   ,        &
     &  4HE   ,4HB   ,4HT   ,4HA   ,4HI   ,4HL   ,4HB   ,4HL   ,        &
     &  4HN   ,4HB   ,4HL   ,4HA   ,4HD   ,4HS   ,4HI   ,4HT   ,        &
     &  4HY   ,4HP   ,4HE   ,4HM   ,4HE   ,4HT   ,4HH   ,4HO   ,        &
     &  4HD   ,4HE   ,4HL   ,4HL   ,4HI   ,4HP   /
!
!**   IF IOP EQUAL ZERO READ NAMELIST BODY
!**   IF IOP EQUAL ONE WRITE NAMELIST BODY
!
      IF(IOP .EQ. 0)                                                    &
     &  CALL NAMER(KAND,9,NLNAME,4,BODY,44,LEN4,15,LDM4,A4,129,         &
     &              LOC4,EOF)
      IF(IOP .EQ. 1)                                                    &
     &  CALL NAMEW (KAND,6,NLNAME,4,BODY,44,LEN4,15,LDM4,A4,129,LOC4)
!
!
!  BODY INPUTS ARE TO SET AFTER ALL BODY NAMELISTS HAVE
!  BEEN READ.  ONLY THREE TYPES OF INPUTS WILL BE
!  PERMITTED, AS FOLLOWS
!    (1) X AND R
!    (2) X AND S
!    (3) X, R, S AND P
!
!  THIS CHANGE IS MADE TO PREVENT USER PROBLEMS EVEN THOUGH
!  ONLY TWO OF R, S OR P ARE REQUIRED
!
      IF(TYPE .EQ. UNUSED) TYPE=2.0
      IF(TYPE .LT. 1.0) TYPE=1.0
      IF(TYPE .GT. 3.0) TYPE=3.0
      RETURN
      END
      SUBROUTINE XNAM4(IOP)
!
!***  READ OR WRITE NAMELIST WGPLNF
!
      COMMON /WINGI/  B(101)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /WINGD/  WNG(138)
!
      INTEGER PLNF
      LOGICAL EOF
!
      DIMENSION LEN5(15),LDM5(15),PLNF(81),LOC5(15),A(15),              &
     &          IEQU(15)
      DIMENSION NLNAME(6)
      DATA NLNAME / 4HW   ,4HG   ,4HP   ,4HL   ,4HN   ,4HF   /
      DATA LEN5 / 6,5,6,6,4,5,6,3*5,6,4,3*6/
      DATA LDM5 / 15*1/
      DATA LOC5 / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15/
      DATA PLNF /     4HC   ,4HH   ,4HR   ,4HD   ,4HB   ,4HP   ,        &
     &  4HC   ,4HH   ,4HR   ,4HD   ,4HR   ,4HC   ,4HH   ,4HR   ,        &
     &  4HD   ,4HT   ,4HP   ,4HC   ,4HH   ,4HS   ,4HT   ,4HA   ,        &
     &  4HT   ,4HS   ,4HS   ,4HP   ,4HN   ,4HS   ,4HS   ,4HP   ,        &
     &  4HN   ,4HE   ,4HS   ,4HS   ,4HP   ,4HN   ,4HO   ,4HP   ,        &
     &  4HS   ,4HA   ,4HV   ,4HS   ,4HI   ,4HS   ,4HA   ,4HV   ,        &
     &  4HS   ,4HO   ,4HS   ,4HW   ,4HA   ,4HF   ,4HP   ,4HT   ,        &
     &  4HW   ,4HI   ,4HS   ,4HT   ,4HA   ,4HT   ,4HY   ,4HP   ,        &
     &  4HE   ,4HS   ,4HS   ,4HP   ,4HN   ,4HD   ,4HD   ,4HD   ,        &
     &  4HH   ,4HD   ,4HA   ,4HD   ,4HI   ,4HD   ,4HH   ,4HD   ,        &
     &  4HA   ,4HD   ,4HO   /
      DATA IEQU / 5,6,1,9,4,3,2,7,8,10,11,15,12,13,14 /
!
      DO 1000 I=1,15
         IE=IEQU(I)
         A(I)=B(IE)
 1000 END DO
!
!**   IOP EQUAL ZERO READ NAMELIST WGPLNF
!**   IOP EQUAL ONE WRITE NAMELIST WGPLNF
!
      IF(IOP .EQ. 0)                                                    &
     &   CALL NAMER(KAND,9,NLNAME,6,PLNF,81,LEN5,15,LDM5,A,15,LOC5,EOF)
      IF(IOP .EQ. 1)                                                    &
     &   CALL NAMEW(KAND,6,NLNAME,6,PLNF,81,LEN5,15,LDM5,A,15,LOC5)
!
      DO 1010 I=1,15
         IE=IEQU(I)
!
!  THIS IF CHECK IS HERE BECAUSE VARIABLE TEN IS A "DUMB" VARIABLE. ELEM
!  TEN OF COMMON WINGI IS READ IN NAMELIST WGSCHR.
         IF(IE .EQ. 10)GO TO 1010
         B(IE)=A(I)
 1010 END DO
!
      WNG(106) = B(7)
      WNG(112) = B(8)
      WNG(138) = 0.0
      RETURN
      END
      SUBROUTINE XNAM5(IOP)
!
!***  READ OR WRITE NAMELIST WGSCHR
!
      COMMON /WINGI/  A6A(101)
      COMMON /IBW/    A6D(363), dum5(18)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER SCHR
      LOGICAL EOF
!
      DIMENSION LEN6(36),LDM6(36),SCHR(170),LOC6(36),A6(253)
      DIMENSION NLNAME(6)
      DATA NLNAME / 4HW   ,4HG   ,4HS   ,4HC   ,4HH   ,4HR   /
      DATA LEN6 / 4,6,4,3,6,6,5,6,3,5,4,4,4,5,3,4,5,6,6,5,5,5,4,        &
     &            3,5,3,3,6,4,5,6,6,4,5,6,6 /
      DATA LDM6 / 5*1,20,20,-1,11*1,6,3*1,20,5*1,5*50,1,1 /
      DATA LOC6 / 16,17,18,19,20,21,41,64,61,66,67,62,63,65,61,         &
     &            67,70,71,68,95,69,69,92,72,101,93,94,253,102,         &
     &            103,153,203,153,203,10,10 /
      DATA SCHR /   4HT   ,4HO   ,4HV   ,4HC   ,4HD   ,4HE   ,4HL   ,   &
     &4HT   ,4HA   ,4HY   ,4HX   ,4HO   ,4HV   ,4HC   ,4HC   ,4HL   ,   &
     &4HI   ,4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,4HI   ,4HC   ,4HL   ,   &
     &4HA   ,4HL   ,4HP   ,4HA   ,4HC   ,4HL   ,4HM   ,4HA   ,4HX   ,   &
     &4HC   ,4HA   ,4HM   ,4HB   ,4HE   ,4HR   ,4HC   ,4HM   ,4H0   ,   &
     &4HX   ,4HO   ,4HV   ,4HC   ,4HO   ,4HC   ,4HM   ,4H0   ,4HT   ,   &
     &4HL   ,4HE   ,4HR   ,4HI   ,4HL   ,4HE   ,4HR   ,4HO   ,4HT   ,   &
     &4HO   ,4HV   ,4HC   ,4HO   ,4HC   ,4HM   ,4HO   ,4HC   ,4HM   ,   &
     &4HO   ,4HT   ,4HT   ,4HC   ,4HE   ,4HF   ,4HF   ,4HK   ,4HS   ,   &
     &4HH   ,4HA   ,4HR   ,4HP   ,4HC   ,4HL   ,4HM   ,4HA   ,4HX   ,   &
     &4HL   ,4HS   ,4HL   ,4HO   ,4HP   ,4HE   ,4HC   ,4HL   ,4HA   ,   &
     &4HM   ,4HO   ,4HC   ,4HL   ,4HA   ,4HM   ,4H0   ,4HA   ,4HR   ,   &
     &4HC   ,4HL   ,4HX   ,4HA   ,4HC   ,4HD   ,4HW   ,4HA   ,4HS   ,   &
     &4HH   ,4HY   ,4HC   ,4HM   ,4HC   ,4HL   ,4HD   ,4HT   ,4HY   ,   &
     &4HP   ,4HE   ,4HI   ,4HN   ,4HN   ,4HP   ,4HT   ,4HS   ,4HX   ,   &
     &4HC   ,4HO   ,4HR   ,4HD   ,4HY   ,4HU   ,4HP   ,4HP   ,4HE   ,   &
     &4HR   ,4HY   ,4HL   ,4HO   ,4HW   ,4HE   ,4HR   ,4HM   ,4HE   ,   &
     &4HA   ,4HN   ,4HT   ,4HH   ,4HI   ,4HC   ,4HK   ,4HA   ,4HL   ,   &
     &4HP   ,4HH   ,4HA   ,4HO   ,4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,   &
     &4H0   /
!
!***  WRITE NAMELIST WGSCHR
!
      DO 1000 I=1,101
         A6(I)=A6A(I)
 1000 END DO
      A6(253)=A6D(132)
      DO 1010 I=102,252
         A6(I)=A6D(I+111)
 1010 END DO
!
!**   IOP EQUAL ZERO READ NAMELIST WGSCHR
!**   IOP EQUAL ONE WRITE NAMELIST WGSCHR
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,SCHR,170,LEN6,36,LDM6,A6,253,LOC6,EOF)
      IF(IOP .EQ. 1)                                                    &
     & CALL NAMEW(KAND,6,NLNAME,6,SCHR,170,LEN6,36,LDM6,A6,253,LOC6)
!
!     PUT THE VARIABLES IN THE APPROPRIATE COMMON BLOCK
!
      DO 1020 I=1,101
         A6A(I)=A6(I)
 1020 END DO
      A6D(132)=A6(253)
      DO 1030 I=102,252
         A6D(I+111)=A6(I)
 1030 END DO
!
      RETURN
      END
      SUBROUTINE XNAM6(IOP)
!
!***  READ OR WRITE NAMELIST SYNTHS
!
      COMMON /SYNTSS/ A7(19)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      COMMON /BDATA/ BD(82)
!
      INTEGER SYNTHS
      LOGICAL EOF
!
      DIMENSION LEN7(19),LDM7(19),SYNTHS(60),LOC7(19)
      DIMENSION NLNAME(6)
!
      DATA NLNAME / 4HS   ,4HY   ,4HN   ,4HT   ,4HH   ,4HS   /
      DATA LEN7 / 3,2,2,4,3,2,2,4,2,6,5,3,5,2,3,2,2,4,4 /
      DATA LDM7 / 9*1,-1,9*1 /
      DATA LOC7 / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19 /
      DATA SYNTHS /   4HX   ,4HC   ,4HG   ,4HX   ,4HW   ,4HZ   ,        &
     &  4HW   ,4HA   ,4HL   ,4HI   ,4HW   ,4HZ   ,4HC   ,4HG   ,        &
     &  4HX   ,4HH   ,4HZ   ,4HH   ,4HA   ,4HL   ,4HI   ,4HH   ,        &
     &  4HX   ,4HV   ,4HV   ,4HE   ,4HR   ,4HT   ,4HU   ,4HP   ,        &
     &  4HH   ,4HI   ,4HN   ,4HA   ,4HX   ,4HX   ,4HV   ,4HF   ,        &
     &  4HS   ,4HC   ,4HA   ,4HL   ,4HE   ,4HZ   ,4HV   ,4HZ   ,        &
     &  4HV   ,4HF   ,4HY   ,4HV   ,4HY   ,4HF   ,4HP   ,4HH   ,        &
     &  4HI   ,4HV   ,4HP   ,4HH   ,4HI   ,4HF   /
!
!**   IF IOP EQUAL ZERO READ NAMELIST SYNTHS
!**   IF IOP EQUAL ONE WRITE NAMELIST SYNTHS
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,SYNTHS,60,LEN7,19,LDM7,A7,19,LOC7,EOF)
      IF(IOP .EQ. 1)                                                    &
     &  CALL NAMEW(KAND,6,NLNAME,6,SYNTHS,60,LEN7,19,LDM7,A7,19,LOC7)
!
      BD(33)=A7(1)
      BD(65)=A7(2)
      BD(74)=A7(3)
      BD(77)=A7(4)
      BD(82)=A7(5)
      RETURN
      END
      SUBROUTINE XNAM7(IOP)
!
!***  READ OR WRITE NAMELIST HTPLNF
!
      COMMON /HTI/    A5B(154)
      COMMON /HTDATA/ AHT(195)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      EQUIVALENCE (TYPE,A5B(15))
!
      INTEGER PLNF
      LOGICAL EOF
!
      DIMENSION PLNF(92),LENHP(18),LDMHP(18),A(75)
      DIMENSION NLNAME(6),XTYPE(4),IEQU(18),LOCHP(18)
!
      DATA NLNAME /4HH   ,4HT   ,4HP   ,4HL   ,4HN   ,4HF   /
      DATA PLNF /4HC   ,4HH   ,4HR   ,4HD   ,4HB   ,4HP   ,             &
     &    4HC   ,4HH   ,4HR   ,4HD   ,4HR   ,4HC   ,4HH   ,             &
     &    4HR   ,4HD   ,4HT   ,4HP   ,4HC   ,4HH   ,4HS   ,             &
     &    4HT   ,4HA   ,4HT   ,4HS   ,4HS   ,4HP   ,4HN   ,             &
     &    4HS   ,4HS   ,4HP   ,4HN   ,4HE   ,4HS   ,4HS   ,             &
     &    4HP   ,4HN   ,4HO   ,4HP   ,4HS   ,4HA   ,4HV   ,             &
     &    4HS   ,4HI   ,4HS   ,4HA   ,4HV   ,4HS   ,4HO   ,             &
     &    4HS   ,4HW   ,4HA   ,4HF   ,4HP   ,4HT   ,4HW   ,             &
     &    4HI   ,4HS   ,4HT   ,4HA   ,4HT   ,4HY   ,4HP   ,             &
     &    4HE   ,4HS   ,4HS   ,4HP   ,4HN   ,4HD   ,4HD   ,             &
     &    4HD   ,4HH   ,4HD   ,4HA   ,4HD   ,4HI   ,4HD   ,             &
     &    4HH   ,4HD   ,4HA   ,4HD   ,4HO   ,4HR   ,4HL   ,             &
     &    4HP   ,4HH   ,4HS   ,4HH   ,4HB   ,4HS   ,4HE   ,             &
     &    4HX   ,4HT   /
      DATA LENHP /6,5,6,6,4,5,6,3*5,6,4,3*6,4,3,4/
      DATA LDMHP /15*1,3*20/
      DATA LOCHP /1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,36,56/
      DATA XTYPE / 4HSTRA,4HDDUB,4HCRAN,4HCURV /
      DATA IEQU /5,6,1,9,4,3,2,7,8,10,11,15,12,13,14,95,115,135/
!
      DO 1000 I=1,15
         IE=IEQU(I)
         A(I)=A5B(IE)
 1000 END DO
      DO 1020 I=16,18
         IE=IEQU(I)
         IF(I .EQ. 16)K=-1
         IF(I .EQ. 17)K=18
         IF(I .EQ. 18)K=37
         DO 1010 J=1,20
            A(I+J+K)=A5B(IE+J-1)
 1010    CONTINUE
 1020 END DO
!
!**   IOP EQUAL ZERO READ NAMELIST HTPLNF
!**   IOP EQUAL ONE WRITE NAMELIST HTPLNF
!
      IF(IOP .EQ. 0)                                                    &
     &    CALL NAMER(KAND,9,NLNAME,6,PLNF,92,LENHP,18,LDMHP,A,75,       &
     &              LOCHP,EOF)
      IF(IOP .EQ. 1)                                                    &
     &    CALL NAMEW(KAND,6,NLNAME,6,PLNF,92,LENHP,18,LDMHP,A,75,LOCHP)
!
      DO 1030 I=1,15
         IE=IEQU(I)
!
!  THIS IF CHECK IS BECAUSE VARIABLE 10 IS A DUMMY VARIBLE.  ELEMENT 10
!   READ IN NAMELIST HTSCHR
         IF(IE .EQ. 10)GO TO 1030
         A5B(IE)=A(I)
 1030 END DO
      DO 1050 I=16,18
         IE=IEQU(I)
         IF(I .EQ. 16)K=-1
         IF(I .EQ. 17)K=18
         IF(I .EQ. 18)K=37
         DO 1040 J=1,20
            A5B(IE+J-1)=A(I+J+K)
 1040    CONTINUE
 1050 END DO
!
      AHT(106)=A5B(7)
      AHT(112)=A5B(8)
      AHT(138)=0.0
!---  CHECK FOR TYPE SET IN NAMELIST
      DO 1060 I=1,4
         IF(TYPE .EQ. XTYPE(I))TYPE=I
 1060 END DO
      IF(TYPE .LT. 5.)GO TO 1070
      WRITE(6,1080)TYPE
      TYPE=1.0
 1070 RETURN
 1080 FORMAT(42H ERROR TYPE CANNOT BE GREATER THAN 4 TYPE=,E12.5,       &
     &9H SET TO 1)
      END
      SUBROUTINE XNAM8(IOP)
!
!***  READ OR WRITE NAMELIST HTSCHR
!
      COMMON /HTI/ A6A(154)
      COMMON /IBH/ A6D(363), dum6(18)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
!
      INTEGER SCHR
      LOGICAL EOF
!
      DIMENSION LENHS(34),LDMHS(34),SCHR(160),LOCHS(34),HS(306)
      DIMENSION NLNAME(6)
      DATA NLNAME / 4HH   ,4HT   ,4HS   ,4HC   ,4HH   ,4HR   /
      DATA LENHS / 4,6,4,3,6,6,5,6,3,5,4,4,4,5,3,4,5,6,5,5,4,6,3*3,     &
     &            6,4,5,6,6,4,5,6,6 /
      DATA LDMHS / 5*1,20,20,-1,16*1,20,1,1,5*50,1,1 /
      DATA LOCHS / 16,17,18,19,20,21,41,64,61,66,67,62,63,65,61,        &
     &            67,70,71,69,69,92,68,93,94,72,306,155,                &
     &            156,206,256,206,256,10,10 /
      DATA SCHR /   4HT   ,4HO   ,4HV   ,4HC   ,4HD   ,4HE   ,          &
     &4HL   ,4HT   ,4HA   ,4HY   ,4HX   ,4HO   ,4HV   ,4HC   ,          &
     &4HC   ,4HL   ,4HI   ,4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,          &
     &4HI   ,4HC   ,4HL   ,4HA   ,4HL   ,4HP   ,4HA   ,4HC   ,          &
     &4HL   ,4HM   ,4HA   ,4HX   ,4HC   ,4HA   ,4HM   ,4HB   ,          &
     &4HE   ,4HR   ,4HC   ,4HM   ,4H0   ,4HX   ,4HO   ,4HV   ,          &
     &4HC   ,4HO   ,4HC   ,4HM   ,4H0   ,4HT   ,4HL   ,4HE   ,          &
     &4HR   ,4HI   ,4HL   ,4HE   ,4HR   ,4HO   ,4HT   ,4HO   ,          &
     &4HV   ,4HC   ,4HO   ,4HC   ,4HM   ,4HO   ,4HC   ,4HM   ,          &
     &4HO   ,4HT   ,4HT   ,4HC   ,4HE   ,4HF   ,4HF   ,4HK   ,          &
     &4HS   ,4HH   ,4HA   ,4HR   ,4HP   ,4HC   ,4HL   ,4HA   ,          &
     &4HM   ,4H0   ,4HC   ,4HL   ,4HA   ,4HM   ,4HO   ,4HA   ,          &
     &4HR   ,4HC   ,4HL   ,4HC   ,4HL   ,4HM   ,4HA   ,4HX   ,          &
     &4HL   ,4HY   ,4HC   ,4HM   ,4HC   ,4HL   ,4HD   ,4HX   ,          &
     &4HA   ,4HC   ,4HT   ,4HY   ,4HP   ,4HE   ,4HI   ,4HN   ,          &
     &4HN   ,4HP   ,4HT   ,4HS   ,4HX   ,4HC   ,4HO   ,4HR   ,          &
     &4HD   ,4HY   ,4HU   ,4HP   ,4HP   ,4HE   ,4HR   ,4HY   ,4HL   ,   &
     &4HO   ,4HW   ,4HE   ,4HR   ,4HM   ,4HE   ,4HA   ,4HN   ,4HT   ,   &
     &4HH   ,4HI   ,4HC   ,4HK   ,4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,   &
     &4HO   ,4HA   ,4HL   ,4HP   ,4HH   ,4HA   ,4H0   /
!
      DO 1000 I=1,154
         HS(I)=A6A(I)
 1000 END DO
      HS(306)=A6D(132)
      DO 1010 I=155,305
         HS(I)=A6D(I+58)
 1010 END DO
!
!**   IOP EQUAL ZERO READ NAMELIST HTSCHR
!**   IOP EQUAL ONE WRITE NAMELIST HTSCHR
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,SCHR,160,LENHS,34,LDMHS,HS,306,LOCHS, &
     &            EOF)
      IF(IOP .EQ. 1)                                                    &
     & CALL NAMEW(KAND,6,NLNAME,6,SCHR,160,LENHS,34,LDMHS,HS,306,LOCHS)
!
!     PUT THE VARIABLES IN THE APPROPRIATE COMMON BLOCK
!
      DO 1020 I=1,154
         A6A(I)=HS(I)
 1020 END DO
      A6D(132)=HS(306)
      DO 1030 I=155,305
         A6D(I+58)=HS(I)
 1030 END DO
!
      RETURN
      END
      SUBROUTINE XNAM9(IOP)
!
!***  READ OR WRITE NAMELIST VTPLNF
!
      COMMON /VTI/    A9(162)
      COMMON /VTDATA/ AVT(195)
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      EQUIVALENCE (TYPE,A9(15))
!
      INTEGER PLNF
      LOGICAL EOF
!
      DIMENSION NLNAME(6),XTYPE(4),VT(75),IEQU(18)
      DIMENSION LENVP(18),PLNF(92),LOCVP(18),LDMVP(18)
!
      DATA XTYPE /4HSTRA,4HDDUB,4HCRAN,4HCURV/
      DATA NLNAME /4HV   ,4HT   ,4HP   ,4HL   ,4HN   ,4HF   /
      DATA LENVP / 6,6,5,4,6,5,5,6,5,4*6,4,5,4,3,4/
      DATA LDMVP / 15*1,3*20 /
      DATA LOCVP / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,36,56 /
      DATA IEQU / 1,2,3,4,5,6,7,9,10,11,12,13,14,15,8,95,115,135 /
      DATA PLNF /4HC   ,4HH   ,4HR   ,4HD   ,4HT   ,4HP   ,4HS   ,      &
     &    4HS   ,4HP   ,4HN   ,4HO   ,4HP   ,4HS   ,4HS   ,4HP   ,      &
     &    4HN   ,4HE   ,4HS   ,4HS   ,4HP   ,4HN   ,4HC   ,             &
     &    4HH   ,4HR   ,4HD   ,4HB   ,4HP   ,4HC   ,4HH   ,4HR   ,      &
     &    4HD   ,4HR   ,4HS   ,4HA   ,4HV   ,4HS   ,4HI   ,4HC   ,      &
     &    4HH   ,4HS   ,4HT   ,4HA   ,4HT   ,4HS   ,4HW   ,4HA   ,      &
     &    4HF   ,4HP   ,4HT   ,4HW   ,4HI   ,4HS   ,4HT   ,4HA   ,      &
     &    4HS   ,4HS   ,4HP   ,4HN   ,4HD   ,4HD   ,4HD   ,4HH   ,      &
     &    4HD   ,4HA   ,4HD   ,4HI   ,4HD   ,4HH   ,4HD   ,4HA   ,      &
     &    4HD   ,4HO   ,4HT   ,4HY   ,4HP   ,4HE   ,4HS   ,4HA   ,      &
     &    4HV   ,4HS   ,4HO   ,4HS   ,4HV   ,4HW   ,4HB   ,4HS   ,      &
     &    4HV   ,4HB   ,4HS   ,4HV   ,4HH   ,4HB   /
!
      DO 1000 I=1,15
         IE=IEQU(I)
         VT(I)=A9(IE)
 1000 END DO
      DO 1020 I=16,18
         IE=IEQU(I)
         IF(I .EQ. 16)K=-1
         IF(I .EQ. 17)K=18
         IF(I .EQ. 18)K=37
         DO 1010 J=1,20
            VT(I+J+K)=A9(IE+J-1)
 1010    CONTINUE
 1020 END DO
!
!**   IF IOP EQUAL ZERO READ NAMELIST VTPLNF
!**   IF IOP EQUAL ONE WRITE NAMELIST VTPLNF
!
      IF(IOP .EQ. 0)                                                    &
     & CALL NAMER(KAND,9,NLNAME,6,PLNF,92,LENVP,18,LDMVP,VT,75,         &
     &            LOCVP,EOF)
      IF(IOP .EQ. 1)                                                    &
     & CALL NAMEW(KAND,6,NLNAME,6,PLNF,92,LENVP,18,LDMVP,VT,75,LOCVP)
!
      DO 1030 I=1,15
         IE=IEQU(I)
!
!  THIS IF CHECK IS BECAUSE VARIABLE 10 IS A DUMMY VARIABLE.
!
         IF(IE .EQ. 10)GO TO 1030
         A9(IE)=VT(I)
 1030 END DO
      DO 1050 I=16,18
         IE=IEQU(I)
         IF(I .EQ. 16)K=-1
         IF(I .EQ. 17)K=18
         IF(I .EQ. 18)K=37
         DO 1040 J=1,20
            A9(IE+J-1)=VT(I+J+K)
 1040    CONTINUE
 1050 END DO
!
      AVT(106)=A9(7)
      AVT(112)=A9(8)
      AVT(138)=0.0
! --- CHECK IF TYPE SET IN NAMELIST
      DO 1060 I=1,4
         IF(TYPE .EQ. XTYPE(I))TYPE=I
 1060 END DO
      IF(TYPE .LT. 5.)GO TO 1070
      WRITE(6,1080)TYPE
      TYPE=1.0
 1070 RETURN
 1080 FORMAT(42H ERROR TYPE CANNOT BE GREATER THAN 4 TYPE=,E12.5,       &
     &9H SET TO 1)
      END
      SUBROUTINE XPERNM
!
!     DEFINE THE NUMBER OF CARDS IN EACH EXPERIMENTAL DATA NAMELIST
!
      COMMON /EXPER/ KLIST, NLIST(100), NNAMES, IMACH, MDATA,           &
     &               KBODY, KWING, KHT, KVT, KWB, KDWASH(3),            &
     &               ALPOW, ALPLW, ALPOH, ALPLH
      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
      LOGICAL FIRST, TEST
      DIMENSION KOL(80), KEXP(4)
      DATA KEXP / 1HE, 1HX, 1HP, 1HR /
      REWIND 8
      K = 0
      N = 0
      IER = 0
      NCARDS = 0
      FIRST = .TRUE.
 1000 CONTINUE
!
!***  THE FOLLOWING TWO CARDS ARE FOR FORTRAN-IV
!
!     READ(8,1060) (KOL(I), I=1,80)
!     IF(EOF(8)) 1040,1010
!
!***  THE FOLLOWING CARD IS FOR FORTRAN-V
!
      READ(8,1060,END=1040) (KOL(I), I=1,80)
!
!     SET THE NUMBER OF CARDS IN NLIST
!
 1010 CONTINUE
      IF(KOL(2) .NE. KAND) GO TO 1030
      IF(.NOT. TEST(KOL(3),KEXP,4)) GO TO 1030
          IF(FIRST .OR. (IER .GT. 0)) GO TO 1020
          IF(NLIST(K) .LT. 1000) NLIST(K) = NLIST(K)+1000*NCARDS
 1020     CONTINUE
          K = K+1
          NCARDS = 0
          FIRST = .FALSE.
          IF(K .GT. 100) IER = 1
 1030 CONTINUE
      NCARDS = NCARDS+1
      GO TO 1000
!
!     END OF FILE ENCOUNTERED ON TAPE-8
!
 1040 CONTINUE
      IF((NLIST(K) .LT. 1000) .AND. (IER .LE. 0))                       &
     &  NLIST(K) = NLIST(K) + 1000*NCARDS
      KLIST = K
      IF(IER .EQ. 0) GO TO 1050
          WRITE(6,1070) KLIST
          KLIST = 100
 1050 CONTINUE
 1060 FORMAT(80A1)
 1070 FORMAT(23H0 **WARNING** THERE ARE,I4,18H EXPERIMENTAL DATA,       &
     &      44H NAMELISTS FOR THIS CASE, THE MAXIMUM IS 100 /           &
     &      14X,26HTHE FIRST 100 WILL BE USED //)
      RETURN
      END
      SUBROUTINE XYCORD(IVAL,INT)
!
!  CALCULATE MEAN LINE AND THICKNESS DISTRIBUTION FROM X,Y COORDINATES
!
      COMMON /IBODY/ PB,NACA(80), dum1(320)
      COMMON /IWING/ PW, X(60), dum13(340)
      COMMON / IHT / PHT, XU(60),XL(60),YU(60),YL(60), dum3(140)
      COMMON / IBW / PBW, N, dum5(379)
      COMMON / IVT / PVT, YUN(60),YLN(60), dum4(260)
      COMMON / IBH / PBH, THN(60),CAM(60), dum6(260)
      COMMON /IBWHV/ PBWHV, RHO,TMAX
      DIMENSION ROUT(2),C(6)
      REAL NACA
      DATA ROUT /4HXYCO, 4HRD  /
      DATA A4W,A4H,A4V,A4F/4HW   ,4HH   ,4HV   ,4HF   /
      IF(IVAL.NE.0) GO TO 1010
      DO 1000 I=1,N
         THN(I)=0.5*(YU(I)-YL(I))
         CAM(I)=0.5*(YU(I)+YL(I))
 1000 END DO
 1010 THN(1)=0.0
      THN(N)=0.0
      CAM(1)=0.0
      CAM(N)=0.0
      IN=0
      DO 1020 I=1,N
         CALL TBFUNX(X(I),Y,DYDX,N,X,CAM,C,IN,MI,NG,0,0,4HDCAM,1,ROUT)
         THETA=ATAN(DYDX)
         SA=SIN(THETA)
         CA=COS(THETA)
         XU(I)=X(I)-THN(I)*SA
         XL(I)=X(I)+THN(I)*SA
         YUN(I)=CAM(I)+THN(I)*CA
         YLN(I)=CAM(I)-THN(I)*CA
 1020 END DO
      XU(1)=0.0
      XL(1)=0.0
      XU(N)=1.0
      XL(N)=1.0
      YUN(1)=0.0
      YUN(N)=0.0
      YLN(1)=0.0
      YLN(N)=0.0
      IF(INT.EQ.0)RETURN
!
!  DOUBLE THICKNESS TO REFLECT USER INPUTS
!
      DO 1030 I=1,N
 1030 THN(I)=2.*THN(I)
      WRITE(6,1050)
      IF(INT.EQ.1)WRITE(6,1060)
      IF(INT.EQ.2)WRITE(6,1061)
      IF(INT.EQ.3)WRITE(6,1062)
      IF(INT.EQ.4)WRITE(6,1063)
      IF(INT.EQ.1)NACA(6)=A4W
      IF(INT.EQ.2)NACA(6)=A4H
      IF(INT.EQ.3)NACA(6)=A4V
      IF(INT.EQ.4)NACA(6)=A4F
      WRITE(6,1070)
      WRITE(6,1080)(XU(M),YUN(M),XL(M),YLN(M),X(M),CAM(M),THN(M),       &
     &              M=1,N)
!
!  NOW HALVE THICKNESS FOR PROGRAM COMPUTATIONS
!
      DO 1040 I=1,N
 1040 THN(I)=.5*THN(I)
 1050 FORMAT(1H1,29X,75HAUTOMATED STABILITY AND CONTROL METHODS PER APRI&
     &L 1976 VERSION OF DATCOM     )
 1060 FORMAT(1H ,55X,25HUSER DEFINED WING SECTION)
 1061 FORMAT(1H ,50X,36HUSER DEFINED HORIZONTAL TAIL SECTION)
 1062 FORMAT(1H ,50X,35HUSER DEFINED VERTICAL TAIL SECTION )
 1063 FORMAT(1H ,51X,34HUSER DEFINED VENTRAL FIN SECTION  )
 1070 FORMAT(1H ,3X,15H UPPER ABSCISSA,4X,15H UPPER ORDINATE,4X,        &
     &              15H LOWER ABSCISSA,4X,15H LOWER ORDINATE,6X,        &
     &              16HX-FRACTION CHORD,4X,9HMEAN LINE,4X,9HTHICKNESS)
 1080 FORMAT(8X,F8.5,11X,F8.5,10X,F8.5,10X,F8.5,13X,F8.5,10X,           &
     &       F8.5,6X,F8.5)
      RETURN
      END
      FUNCTION YUP(I,M,NY)
!
!     ----FUNCTION TO LOCATE AND UNPACK Y(I,J,K,L)
!     ----M CONTAINS NX2,NX1,NX3,NX4,I1,I3,I4 IN THAT ORDER.
!     ----ROUTINE UNPACKS 2 FLOATING POINT NUMBERS WITH 3 SIGNIFICANT
!     ----DIGITS EACH.
!
      LOGICAL FIRST
      DIMENSION M(7),NY(1)
      LRAW=I
      IF(M(1).GT.0)GO TO 1000
      M1=IABS(M(1))
      M12=M1*M(2)
      M123=M12*M(3)
      IF(M(2).NE.0)LRAW=LRAW+M1*(M(5)-1)
      IF(M(3).NE.0)LRAW=LRAW+M12*(M(6)-1)
      IF(M(4).NE.0)LRAW=LRAW+M123*(M(7)-1)
 1000 LT=LRAW/2
      IF(LRAW.NE.2*LT)GO TO 1010
!
!     ----KEEP LAST NUMBER IN PACKED WORD.
!
      FIRST=.FALSE.
      GO TO 1020
 1010 LT=LT+1
!
!     ----KEEP FIRST NUMBER IN PACKED WORD.
!
      FIRST=.TRUE.
 1020 N=NY(LT)
!
!     ----UNPACK
!
      NS1=1
      IF(N.LT.0)NS1=-1
      N=IABS(N)
      NOT3=N/1000
      ND2=N-1000*NOT3
      NOT6=NOT3/1000
      ND1=NOT3-1000*NOT6
      NOT7=NOT6/10
      NP2=NOT6-10*NOT7
      NOT8=NOT7/10
      NP1=NOT7-10*NOT8
      NOT9=NOT8/10
      NSPS=NOT8-10*NOT9
      NOT10=NOT9/10
      NS2=NOT9-10*NOT10
!
!     ----INTERPRET.
!
      D1=ND1
      IF(NS1.LT.0)D1=-D1
      D2=ND2
      IF(NS2.EQ.1)D2=-D2
      IF(NSPS.EQ.0)GO TO 1060
      IF(NSPS.EQ.1)GO TO 1030
      GO TO 1050
 1030 NP1=-NP1
 1040 NP2=-NP2
      GO TO 1060
 1050 IF(NSPS.EQ.2)GO TO 1040
      NP1=-NP1
 1060 D2=D2*10.**NP2
      D1=D1*10.**NP1
      IF(FIRST)GO TO 1070
      YA=D2
      GO TO 1080
 1070 YA=D1
 1080 YUP=YA
      RETURN
      END
      SUBROUTINE ZERANG(ARG)
!
!     ----SUBROUTINE ZERANG USED TO INITIALIZE ANGLES FOR ANGLES ROUTINE
!
      DIMENSION ARG(6)
      DO 1000 I=1,6
         ARG(I)=0.
 1000 END DO
      ARG(4)=1.
      RETURN
      END
