c ************ missile datcom source code ****************
c ***********************************************************
c *************************************
c *************************************
c *************************************
       PROGRAM MISDAT
C
C  MISSILE DATCOM CODE CREATED BY S.R. VUKELICH, MCDONNELL DOUGLAS
C  ALL SUBROUTINES WRITTEN BY S.R. VUKELICH UNLESS OTHERWISE STATED
C  THIS ROUTINE MODIFIED BY B. HEATH, W. BLAKE, WL/FIGC 
C
C***  THE FOLLOWING CARDS ARE REQUIRED FOR CDC/CYBER
C
C     PROGRAM MISDAT(INPUT,OUTPUT,TAPE5=INPUT,TAPE6=OUTPUT,
C    1 TAPE8=100,TAPE2=100,TAPE3=100,TAPE4=100,TAPE7=100)
C
C   ***********************************************************
C   * THE USAF STABILITY AND CONTROL AUTOMATED MISSILE DATCOM *
C   ***********************************************************
C
C    *********************************************************
C    *********************************************************
C    **                                                     **
C    ** UNPUBLISHED COPYRIGHT (C) BY MCDONNELL DOUGLAS CORP **
C    **     ALL RIGHTS RESERVED UNDER THE COPYRIGHT ACT     **
C    **                                                     **
C    **    THIS MATERIAL MAY BE REPRODUCED BY OR FOR THE    **
C    **      U.S. GOVERNMENT PURSUANT TO THE COPYRIGHT      **
C    ** LICENSE UNDER THE CLAUSE AT DFARS 52.227-7013 1987  **
C    **                                                     **
C    *********************************************************
C    *********************************************************
C
C********************************************************************
C***              --- FORTRAN LANGUAGE CONVERSION ---             ***
C***  FOR FORTRAN IV TO FORTRAN V CONVERSIONS, THE FOLLOWING      ***
C***  ROUTINES MUST BE MODIFIED --                                ***
C***     MISDAT, CONERR, READIN, EXTRAP, SAVEF, AND READCD        ***
C***  THE CHANGE DEALS WITH END-OF-FILE CHECKS ON READ STATEMENTS ***
C********************************************************************
C***              --- SYSTEM REQUIREMENTS ---                     ***
C***  MISSILE DATCOM REQUIRES THE FOLLOWING SYSTEM CONFIGURATION  ***
C***     SEVEN SCRATCH I/O TAPE UNITS, NUMBERED 1 TO 9            ***
C***     VIRTUAL MEMORY OR CAPABILITIES FOR OVERLAY               ***
C***  PROGRAM CONSTANTS ARE SET IN THE BLOCK DATA ROUTINE         ***
C********************************************************************
C
C***  THIS ROUTINE IS THE TOP MOST LEVEL OF THE EXECUTIVE AND CONTROLS
C***  EXECUTION OF THE SYSTEM
C
C***  THE FOLOWING SETS UP THE NAMED BLOCK DATA
C
       EXTERNAL BLOCKD
       EXTERNAL CKDAT
C
C***  FOLLOWING ARE THE GLOBAL SYSTEM COMMON BLOCKS
C
       COMMON /ABODIN/ BDIN(881)
       COMMON /BDWORK/ BDW(241)
       COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),CASE,NOEXTR,NOLAT,
     1                IR,IPAGE
       COMMON /DBODY/  EBODY(406)
       COMMON /DB1/    EB1(400)
       COMMON /DB12/   EB12(400)
       COMMON /DB123/  EB123(400)
       COMMON /DB1234/ EB1234(400)
       COMMON /DESIG/  NNACA(80,4)
       COMMON /DDFIN1/  EFIN1(80)
       COMMON /DDFIN2/  EFIN2(80)
       COMMON /DDFIN3/  EFIN3(80)
       COMMON /DDFIN4/  EFIN4(80)
       COMMON /DFLAGS/ LDELF(12)
       COMMON /DUMPF/  LDUMPF(37)
       COMMON /FFINDL/ FFNDL(36)
       COMMON /FLC/    FLTC(144)
       COMMON /FSET1/  FDATA1(399)
       COMMON /FSET2/  FDATA2(399)
       COMMON /FSET3/  FDATA3(399)
       COMMON /FSET4/  FDATA4(399)
       COMMON /F1WORK/ F1WK(290)
       COMMON /F2WORK/ F2WK(290)
       COMMON /F3WORK/ F3WK(290)
       COMMON /F4WORK/ F4WK(290)
       COMMON /GEOBOD/ BDGEO(47)
       COMMON /GEOFC/  GFINC(21)
       COMMON /GEOFS1/ GFIN1(188)
       COMMON /GEOFS2/ GFIN2(188)
       COMMON /GEOFS3/ GFIN3(188)
       COMMON /GEOFS4/ GFIN4(188)
       COMMON /INC/    COREC(150)
       COMMON /INCID/  DELTAS(40)
       COMMON /INLETN/ INLTS(64)
       COMMON /INLTD/  DINLET(120)
       COMMON /LOGIC/  LFLAGS(28)
       COMMON /PAERO/  PAER(4024)
       COMMON /PARTF/  PARTS(19)
       COMMON /REFQN/  REFS(9)
       COMMON /SBODY/  CBODY(220)
       COMMON /SB1/    CB1(220)
       COMMON /SB12/   CB12(220)
       COMMON /SB123/  CB123(220)
       COMMON /SB1234/ CB1234(220)
       COMMON /SFIN1/  CFIN1(220)
       COMMON /SFIN2/  CFIN2(220)
       COMMON /SFIN3/  CFIN3(220)
       COMMON /SFIN4/  CFIN4(220)
       COMMON /TRIMD/  TTRIM(120)
       COMMON /TRIMIN/ DTRIM(19)
       COMMON /TOTALC/ ATOTAL(80)
       COMMON /THERY/  LSOSE,PRESUR,LHYBRD,LHYPER
        COMMON /XRBLNT/ BLNT(104)
C
       CHARACTER*4 IDCASE
C
C  MISSILE DATCOM WAS ORIGINALLY WRITTEN WITH A COMMON BLOCK
C  STRUCTURE WHICH REQUIRED MULTIPLE USAGE OF THE SAME COMMON
C  BLOCK TO CONSERVE CORE MEMORY REQUIREMENTS.  THE FOLLOWING
C  CALCULATIONS WERE INVOLVED:  VAN DYKE HYBRID METHOD, AIRFOIL
C  SECTION MODULE, CONFIGURATION TRIM, AND DYNAMIC DERIVATIVES.
C
C  ALL COMMON BLOCKS INVOLVED HAVE BEEN MODIFIED SO THAT EACH
C  COMMON BLOCK IS USED FOR ONLY ONE FUNCTION.  THE FOLLOWING
C  COMMON BLOCKS WERE CREATED AS A RESULT.
C
       COMMON /VDARY/ XB(220),RB(220),RBP(220),C(220),C1(220),RB1(220),
     1  RBP1(220),B(220),PSI(220),ZE0X(220),PSIR(220),PHIX(220)
       COMMON /VANVAR/ PHIR(220),ZE1(220),ZE1X(220),ZE1R(220),
     1  T(100),AK(100),AE(100),C3
       COMMON /SECVAR/ DATAX(315)
       COMMON /ASMVAR/ TDATA(523)
       COMMON /UTRIMD/ CNT(200),CMT(200),CAT(200),CYT(200),
     1                CLNT(200),CLLT(200)
C
       LOGICAL GO,NOEXEC,SAVE,IEND,LFLAGS,LDUMPF,LDELF,ITERM,LSOSE,
     1        PRESUR,LHYBRD,LHYPER,NOEXTR,NOLAT,PARTS,PARTC
C
       REAL INLTS
       INTEGER CASE
C
       DIMENSION IROUT(2),PARTC(19)
C
C      DATA IDCASE /74*4H    /
C      DATA NOEXTR /.TRUE./
C      DATA NOLAT  /.FALSE./
       DATA SAVE   /.FALSE./
       DATA IEND   /.FALSE./
       DATA ITERM  /.FALSE./
       DATA PARTC  /.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     1             .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     2             .FALSE.,.FALSE.,.FALSE.,.FALSE.,.TRUE.,.TRUE.,
     3             .TRUE./
C
C***  OPEN STATEMENTS FOR VAX OR FORTRAN-77
C
       OPEN(UNIT=2, FILE='for002.dat', STATUS='UNKNOWN')
       OPEN(UNIT=3, FILE='for003.dat', STATUS='UNKNOWN')
       OPEN(UNIT=4, FILE='for004.dat', STATUS='UNKNOWN')
       OPEN(UNIT=5, FILE='for005.dat', STATUS='OLD')
        OPEN(UNIT=6, FILE='for006.dat', STATUS='UNKNOWN')
        OPEN(UNIT=7, FILE='for007.dat', STATUS='UNKNOWN')
        OPEN(UNIT=8, FILE='for008.dat', STATUS='UNKNOWN')
       OPEN(UNIT=9, FILE='for009.dat', STATUS='UNKNOWN')
        OPEN(UNIT=10, FILE='for010.dat', STATUS='UNKNOWN')
        OPEN(UNIT=11, FILE='for011.dat', STATUS='UNKNOWN')
        OPEN(UNIT=12, FILE='for012.dat', STATUS='UNKNOWN')
       LSOSE = .FALSE.
C
C*** HEADER FOR TECPLOT PLOT FILES
C
        WRITE(3,1100)
        WRITE(9,1110)
        WRITE(10,1120)
        WRITE(11,1130)
        WRITE(12,1140)
C
       DO 1000 I=1,19
          PARTS(I)=PARTC(I)
 1000 CONTINUE
       DO 1005 I=1,100
          NAMSV(I)=0
 1005 CONTINUE
C
       KOUNT=0
       CASE=0
       IR=0
       NOEXTR=.TRUE.
       NOLAT=.FALSE.
       DO 1001 I=1,74
         IDCASE(I)='    '
 1001 CONTINUE
C
C ... PRE-PROCESS INPUTS THROUGH ERROR CHECKING
C
C     ASSUME ERROR CHECKING IS SUCCESSFUL
       GO=.TRUE.
       NOEXEC=.FALSE.
C
       CALL CONERR(GO,NOEXEC)
C
C   * IF THE CASE CANNOT RUN THEN STOP
       IF(.NOT. GO)GO TO 1030
C   * ENDIF
C
C ... LOOP UNTIL ALL CASES HAVE BEEN PROCESSED
C
 1010 CONTINUE
C
C  ...  ASSUME CASE WILL BE PROPERLY PROCESSED
C
         GO=.TRUE.
C
C  ...  UPDATE CASE NUMBER
C
         CASE=CASE+1
         IPAGE=0
C
C  ...  INITIALIZE INFORMATION FOR THE CASE
C
         CALL INITZ(CASE,SAVE)
C
         DO 1020 I=1,16
            PARTS(I)=PARTC(I)
 1020   CONTINUE
C
C  ...  READ A SET OF CASE DATA
C
         CALL READIN(GO,SAVE,IEND,ITERM)
C
C     * IF NO MORE DATA READ, TERMINATE EXECUTION
         IF(ITERM)GO TO 1030
C     * ENDIF
C
         IF(GO .AND. NOEXEC)WRITE(6,1040)
C
C     * IF A CASE CAN NOT BE EXECUTED
C     . THEN READ NEXT CASE DATA
         IF(.NOT.GO)GO TO 1010
C     . ELSE COMPUTE GEOMETRY AND AERODYNAMICS
C     * ENDIF
C
C ...   DO NOT EXECUTE IF USER HAS SPECIFIED NOGO
C
         IF(NOEXEC)GO TO 1010
C
C  ...  CALCULATE GEOMETRIC VARIABLES REQUIRED
C
         CALL GEOM
C
C  ...  CALCULATE AERODYNAMICS
C
         CALL AERO
C
C  ...  OUTPUT EXTRAPOLATION MESSAGES (IF ANY) GENERATED
C
C         CALL EXTRAP
C
C  ...  BEGIN NEXT CASE
C
         GO TO 1010
C
C  ...  TERMINATE EXECUTION
C
 1030   CONTINUE
 1040  FORMAT(4X,'THE NOGO CONTROL CARD HAS BEEN USED.',/,
     1         4X,'EXECUTION OF THIS CASE WILL NOT BE ATTEMPTED.'/)
 1100  FORMAT('VARIABLES=ALPHA,CN,CM,CA,CY,CLN,CLL,DELTA,CL,CD')
 1110  FORMAT('VARIABLES=X,R')
 1120  FORMAT('VARIABLES=X/D,CP(0),CP(30),CP(60),CP(90),CP(120),',
     1        'CP(150),CP(180)')
 1130  FORMAT('VARIABLES=Y/(B/2),X/C,CP')
 1140  FORMAT('VARIABLES=X/D,CP,MACH')
C
       CLOSE(2,STATUS='DELETE')
       CLOSE(3,STATUS='KEEP')
       CLOSE(4,STATUS='KEEP')
       CLOSE(5,STATUS='KEEP')
        CLOSE(6,STATUS='KEEP')
       CLOSE(7,STATUS='DELETE')
       CLOSE(8,STATUS='DELETE')
       CLOSE(9,STATUS='KEEP')
       CLOSE(10,STATUS='KEEP')
       CLOSE(11,STATUS='KEEP')
       CLOSE(12,STATUS='KEEP')
       STOP
       END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ADDZCG(ZCG,LREF,FORCE,MOMENT)
C
C***  CHANGE PITCHING MOMENT COEFFICIENT OR ROLLING MOMENT
C***  COEFFICENT DUE TO A CHANGE IN THE VERTICAL CENTER OF
C***  GRAVITY LOCATION.  ZCG IS POSITIVE UP.
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL LREF,MOMENT
C
      IF(FORCE.EQ.UNUSED .OR. MOMENT.EQ.UNUSED)GO TO 1000
C
      MOMENT=MOMENT-FORCE*ZCG/LREF
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDPART(IM,CN1,CN2,CN3,CN4,CN5,CN6,CN7,CN8)
C
C***  PRINT BODY ALONE PARTIAL OUTPUT DATA
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /FLC/   NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1               ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
C
      REAL NALPHA,NMACH,MACH
C
      COMMON /ABODIN/ BDATA(236),DEXIT,BASE,ADUM1(61),PROTUB,ADUM2(581)
      COMMON /BDWORK/ CNP(20),CMP(20),CNV(20),CMV(20),CAPR(20),
     1                CAF(20),CAB(20),ETA,CDC(20),CAPROT(20),
     2                BOTDCA(20),BOTDCN(20),BOTDCM(20)
C
      COMMON /SBODY/ CN(20),CM(20),CA(20),CY(20),CLN(20),CLL(20),
     1               CNA(20),CMA(20),CYB(20),CNB(20),CLB(20)
C
      LOGICAL NMF,NAF,NDUM,BASE,PROTUB
C
      CALL HEADR9
C
      WRITE(6,1030)
C
      CALL PRFLC9(IM,NDUM,NMF,NAF)
C
      WRITE(6,1120)
C
      NALP=NALPHA+0.5
C
      DO 1000 I=1,NALP
        IF(DEXIT .EQ. UNUSED) THEN
          CAALP=CA(I)-CAPR(I)-CAF(I)-CAPROT(I)-BOTDCA(I)
        ELSE
          CAALP=CA(I)-CAB(I)-CAPR(I)-CAF(I)-CAPROT(I)-BOTDCA(I)
        ENDIF
        IF (PROTUB.AND.BASE.AND.(MACH(IM).GT.1.2)) THEN
            WRITE(6,1130) ALPHA(I),CAF(I),CAPR(I),
     &               CAB(I),CAPROT(I),BOTDCA(I),CAALP
        ELSEIF (PROTUB) THEN
            WRITE(6,1140) ALPHA(I),CAF(I),CAPR(I),
     &               CAB(I),CAPROT(I),CAALP
        ELSEIF (BASE.AND.(MACH(IM).GT.1.2)) THEN
            WRITE(6,1150) ALPHA(I),CAF(I),CAPR(I),
     &               CAB(I),BOTDCA(I),CAALP
        ELSE
            WRITE(6,1160) ALPHA(I),CAF(I),CAPR(I),
     &               CAB(I),CAALP
        ENDIF
 1000 CONTINUE
C
      IF(DEXIT .EQ. UNUSED)WRITE(6,1080)
C
      WRITE(6,1090)ETA
C
      WRITE(6,1170)
      DO 1010 I=1,NALP
        IF (BASE.AND.(MACH(IM).GT.1.2)) THEN
          WRITE(6,1180) ALPHA(I),CNP(I),CNV(I),BOTDCN(I),
     &                 CMP(I),CMV(I),BOTDCM(I),CDC(I)
        ELSE
          WRITE(6,1190) ALPHA(I),CNP(I),CNV(I),CMP(I),CMV(I),CDC(I)
        ENDIF
 1010 CONTINUE
C
      IF(CN1 .EQ. 1. .AND. CN2 .EQ. 1. .AND. CN3 .EQ. 1. .AND.
     1   CN4 .EQ. 1. .AND. CN5 .EQ. 1. .AND. CN6 .EQ. 1. .AND.
     2   CN7 .EQ. 1. .AND. CN8 .EQ. 1.)GO TO 1020
C
      WRITE(6,1100)CN1,CN2,CN3,CN4,CN5,CN6,CN7,CN8
C
 1020 CONTINUE
C
 1030 FORMAT(4X,25X,'BODY ALONE PARTIAL OUTPUT',/)
 1080 FORMAT(4X,'NOTE - BASE DRAG IS NOT INCLUDED',
     1 ' IN THE AXIAL FORCE CALCULATIONS',/)
 1090 FORMAT(/,4X,17X,'CROSS FLOW DRAG PROPORTIONALITY FACTOR =',F8.5,/)
 1100 FORMAT(/,4X,20X,'ELLIPTICAL BODY CORRECTION FACTORS',/
     1  4X,21X,'*** IN THE HORIZONTAL PLANE ***',/
     2  4X,'CN/CNO SLENDER BODY THEORY=',F8.3, 
     3  4X,'CN/CNO NEWTONIAN THEORY   =',F8.3,/
     4  4X,'CM/CMO SLENDER BODY THEORY=',F8.3, 
     5  4X,'CM/CMO NEWTONIAN THEORY   =',F8.3,/
     6       4X,21X,'*** IN THE VERTICAL PLANE ***',/
     7  4X,'CN/CNO SLENDER BODY THEORY=',F8.3, 
     8  4X,'CN/CNO NEWTONIAN THEORY   =',F8.3,/
     9  4X,'CM/CMO SLENDER BODY THEORY=',F8.3, 
     A  4X,'CM/CMO NEWTONIAN THEORY   =',F8.3,/)
 1120 FORMAT(4X,2X,'ALPHA',4X,'CA-FRIC',2X,'CA-PRES/WAVE',1X,
     1 'CA-BASE',4X,'CA-PROT',5X,'CA-SEP',5X,'CA-ALP')
 1130 FORMAT(4X,F7.2,6F11.4)
 1140 FORMAT(4X,F7.2,4F11.4,11X,F11.4)
 1150 FORMAT(4X,F7.2,3F11.4,11X,2F11.4)
 1160 FORMAT(4X,F7.2,3F11.4,11X,11X,F11.4)
 1170 FORMAT(4X,2X,'ALPHA',4X,'CN-POTEN',2X,'CN-VISC',3X,
     1 'CN-SEP',4X,'CM-POTEN',2X,'CM-VISC',
     2  3X,'CM-SEP',4X,'CDC')
 1180 FORMAT(4X,F7.2,6F10.3,F8.3)
 1190 FORMAT(4X,F7.2,2F10.3,10X,2F10.3,10X,F8.3)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CLVR(M,CDC,BLUNT,RN,ETA,XOR,RL,AR,S,TAPER,DIH,
     1 ALPHA,VLR)
C
C***  SUBROUTINE TO COMPUTE THE PANEL LIFT INCREMENT DUE TO BODY
C***  VORTICES AS A FRACTION OF THEORETICAL PANEL LIFT USING THE
C***  METHOD FROM NWC TP-5761.
C
C  *** INPUTS ***
C
C     M - FREESTREAM MACH NUMBER
C    CDC - CROSS FLOW DRAG COEFFICIENT
C BLUNT - NOSE RADIUS TO BODY RADIUS (BLUNTNESS RATIO)
C    RN - RADIUS OF NOSE AT NOSE/CENTERBODY JUNCTURE
C   ETA - NOSE SEMI-APEX ANGLE, DEG.
C   XOR - DISTANCE FROM NOSE APEX TO FIN ROOT EXPOSED L.E.
C    RL - BODY RADIUS AT FIN
C    AR - ASPECT RATIO OF TWO FIN PANELS (SIDE-TO-SIDE AT ROOT)
C     S - FIN SEMI-SPAN (FROM BODY CENTERLINE)
C TAPER - FIN EXPOSED TAPER RATIO
C   DIH - FIN PANEL DIHEDRAL ANGLE, DEG.
C ALPHA - BODY ANGLE OF ATTACK, DEG.
C
C *** OUTPUT ***
C
C   VLR - VORTEX LIFT RATIO
C
      REAL M
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION IROUT(2),XMXS(11),YVRSUB(11),YVRSUP(11),
     1  ZVR(11),GAMSUB(11),GAMSUP(11)
C
      DATA XMXS / 0.,1.,2.,3.,4.,5.,6.,7.,8.,9.,10. /
      DATA YVRSUB / .405,.430,.450,.480,.495,.505,.525,
     1              .550,.565,.590,.595 /
      DATA YVRSUP / .600,.605,.615,.650,.680,.695,.700,.705,
     1              .725,.730,.730 /
      DATA ZVR / 1.0,1.17,1.29,1.44,1.58,1.70,1.83,1.97,2.05,
     1           2.15,2.20 /
      DATA GAMSUB / .31,.31,.33,.40,.46,.60,.80,.90,1.0,1.1,1.15 /
      DATA GAMSUP / .58,.60,.62,.79,.88,1.05,1.25,1.35,1.50,1.55,1.60 /
C
C***  ANGLES IN RADIANS
C
      CDIH=COS(DIH/RAD)
      SDIH=SIN(DIH/RAD)
      SALP=SIN(ALPHA/RAD)
C
C***  NO NOSE VORTEX IF ALPHA .LE. 4 DEGREES
C
      IF(ALPHA.LE.4.)GO TO 1070
C
C***  FOR NOSE BLUNTNESS, USE EQUATION 5
C
      IF(BLUNT.GT..2 .OR. ETA.GT.30.)GO TO 1000
C
C***  IF ALPHA .GT. SEMI-APEX ANGLE, SEPARATION AT NOSE TIP
C
      IF(ALPHA.LT.ETA)GO TO 1010
      XSOR=0.
      GO TO 1020
C
C***  CORRELATION OF SEPARATION USING EQUATION 2
C
 1000 XSOR=(2.+10./(ALPHA-4.))*RL
      GO TO 1020
C
C***  CORRELATION OF SEPARATION USING EQUATION 1
C
 1010 XSOR=(32.*(1.-SQRT((ALPHA-4.)/(ETA-4.))))*RL
C
C***  SEPARATION DISTANCE
C
 1020 C1=(XOR-XSOR)*SALP/RL
C
C***  DETERMINE IF SEPARATION POINT AHEAD OF FIN, IF SO SET TO ZERO
C
      IF(C1.LE.0.)GO TO 1070
C
C***  FIGURE 4B (VERTICAL VORTEX POSITION)
C
      CALL LNTRP(XMXS,ZVR,11,C1,ZOR)
      ZOR=ZOR*RN
C
      IF(M.GE.2.)GO TO 1030
C
C***  FIGURE 4A, SUBSONIC (HORIZONTAL VORTEX POSITION)
C
      CALL LNTRP(XMXS,YVRSUB,11,C1,YOR)
      YOR=YOR*RN
C
C***  FIGURE 5, SUBSONIC
C
      CALL LNTRP(XMXS,GAMSUB,11,C1,TAU)
      TAU=TAU*RL/S
      IF(M.LE.1.)GO TO 1050
C
C***  FIGURES 4 AND 5, SUPERSONIC
C
C***  (HORIZONTAL VORTEX POSITION)
C
 1030 CALL LNTRP(XMXS,YVRSUP,11,C1,YORS)
      YORS=YORS*RN
C
C***  (NOSE VORTEX STRENGTH)
C
      CALL LNTRP(XMXS,GAMSUP,11,C1,TAUS)
      TAUS=TAUS*RL/S
C
      IF(M.LT.2.)GO TO 1040
C
      YOR=YORS
      TAU=TAUS
      GO TO 1050
C
C***  USE EQUATION 5
C
 1040 YOR=(YORS-YOR)*(M-1.)+YOR
      TAU=(TAUS-TAU)*(M-1.)+TAU
C
 1050 CONTINUE
C
C***  CHECK IF CAN USE VORTEX IMPULSE THEOREM
C
      IF(C1 .GE. 4.0) GO TO 1060
C
C***  VORTEX IMPULSE THEOREM APPLICABLE
C
      SC=(XOR-XSOR)*(RN+RL)
      TAU=CDC*SC*SALP/(8.*PI*S*YOR*(1.-(RN**2/(YOR**2+ZOR**2))))
C
C***  COMPUTE THE VORTEX INTERFERENCE FACTORS
C
 1060 CALL SVRINT(YOR,ZOR,CDIH,SDIH,S,RL,TAPER,VRINT)
C
      VLR=VRINT*TAU
C
C***  LIMIT TO +1 TO -1 FOR ARC-SINE FUNCTION
C
      IF(VLR.LT.-1.)VLR=-1.
      IF(VLR.GT.1.)VLR=1.
      VLR=ASIN(VLR*SALP)
C
      GO TO 1080
C
 1070 VLR=0.
C
 1080 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CYPDIV(BETAD,CYD,CYDXCP)
C***********************************************************************
C
C     THIS SUBROUTINE CALCULATES INLET NORMAL FORCE COEFFICIENT AND
C     CENTER OF PRESSURE FOR A TWO DIMENSIONAL DIVERTER IN THE INLET
C     COORDINATE SYSTEM.  THIS SUBROUTINE CALCULATES AERODYNAMICS FOR
C     ONE SET OF FLIGHT CONDITIONS.
C
C***********************************************************************
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      DIMENSION DCYB(2),DCY(2),DCLN(2),CYB(3)
      DIMENSION BETAD(20),CYD(20),CLND(20),CYDXCP(20)
C
      NUMI=NIN+0.5
      DO 10 J=1,NUMI
C
C***      CALCULATE CY-BETA AT CROSS SECTION
        DO 20 I=1,3
          CYB(I)=0.0
          IF(WD(I).NE.0.) THEN
            CYB(I)=(PI/1.8*AREAD(I)/WD(I)**2+2./PI)*AREAD(I)/SREF
          ENDIF
   20   CONTINUE
C
C***    FIND FORCES AND MOMENTS FOR EACH SECTION
        CYD(J)=0.0
        CLND(J)=0.0
        DO 30 I=1,2
C
C***      CY-BETA OF SECTION
          DCYB(I)=CYB(I+1)-CYB(I)
C
C***      DON'T INCLUDE BOATTAIL SECTION IN CY-BETA CALCULATIONS
          IF (DCYB(I).LT.0.0) DCYB(I)=0.0
C
C***      CY OF SECTION
          DCY(I)=-DCYB(I)*(BETAD(J)/RAD)
C
C***      INCREMENT DIVERTER CY
          CYD(J)=CYD(J)+DCY(I)
C
C***      CALCULATE SECTION CENTER OF PRESSURE
          XCP=XD(I)+1./3.*DLEN(I)*(2.*HD(I+1)+HD(I))/(HD(I+1)+HD(I))
C
C***      SECTION CLN
          DCLN(I)=-DCY(I)*XCP/BREF
C
C***      INCREMENT DIVERTER CLN
          CLND(J)=CLND(J)+DCLN(I)
   30   CONTINUE
C
C***    CALCULATE DIVERTER CENTER OF PRESSURE
        IF (ABS(CYD(J)).LT.0.00001) THEN
          CYDXCP(J)=0.0
        ELSE
          CYDXCP(J)=ABS(CLND(J)*BREF/CYD(J))
        ENDIF
   10 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FALCP(MACH,AR,SWEPLE,TAPER,XACOCR)
C
C***  CALCULATE FIN ALONE AERODYNAMIC CENTER USING THE CHARTS
C***  OF DATCOM, SECTION 4.1.4.2, FIGURES 26(A)-26(F)
C
C*** INPUTS
C
C   MACH - MACH NUMBER
C     AR - ASPECT RATIO FOR THE PANEL
C SWEPLE - PANEL L.E. SWEEP, DEGREES
C  TAPER - PANEL TAPER RATIO
C
C***  OUTPUT
C
C XACOCR - X A.C. / CR
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL MACH
      DIMENSION ARGX(6),ATANLE(6),TAPR(6)
      DIMENSION TABLA(72),TABLB(72),TABLC(72)
      DIMENSION TABLD(72),TABLE(72),TABLF(72)
      DIMENSION TABLG(72),TABLH(72),TABLI(72)
      DIMENSION TABLJ(72),TABLK(72),TABLL(72)
      DIMENSION SUBAF1(216),SUBAF2(216),SUPAF1(216),SUPAF2(216)
      EQUIVALENCE (SUBAF1(1),TABLA(1))
      EQUIVALENCE (SUBAF1(73),TABLB(1)),(SUBAF1(145),TABLC(1))
      EQUIVALENCE (SUBAF2(1),TABLD(1))
      EQUIVALENCE (SUBAF2(73),TABLE(1)),(SUBAF2(145),TABLF(1))
      EQUIVALENCE (SUPAF1(1),TABLG(1))
      EQUIVALENCE (SUPAF1(73),TABLH(1)),(SUPAF1(145),TABLI(1))
      EQUIVALENCE (SUPAF2(1),TABLJ(1))
      EQUIVALENCE (SUPAF2(73),TABLK(1)),(SUPAF2(145),TABLL(1))
C
C***  DATCOM FIGURE 4.1.4.2-26
C
C ... TAN L.E.S. / BETA (OR ITS INVERSE) TABLE
C
      DATA ARGX / 0.,.2,.4,.6,.8,1. /
C
C ... ASPECT RATIO*TAN L.E.S. TABLE
C
      DATA ATANLE / 1.,2.,3.,4.,5.,6. /
C
C ... TAPER RATIO TABLE
C
      DATA TAPR / 0.,.2,.25,.33,.5,1. /
C
C ...  STRUCTURE OF ARRAY SUBAF1 (TYPICAL FOR SUBAF2,SUPAF1,SUPAF2)
C ...
C ... ELEMENTS  1- 6, VARY ARGX AT ATANLE(1),TAPR(1)
C ... ELEMENTS  7-12, VARY ARGX AT ATANLE(2),TAPR(1)
C ...   .     .      .     .     .    .    .    .    .
C ... ELEMENTS 30-36, VARY ARGX AT ATANLE(6),TAPR(1)
C ... ELEMENTS 37-42, VARY ARGX AT ATANLE(1),TAPR(2)
C ... ELEMENTS 43-48, VARY ARGX AT ATANLE(2),TAPR(2)
C ...   .     .      .     .     .    .    .    .    .
C ... ELEMENTS 67-72, VARY ARGX AT ATANLE(6),TAPR(2)
C ...
C ... THIS REPEATS THRU 3 DATA TABLE TO FILL IN ALL TAPR VALUES
C
      DATA TABLA/
     1  .250,   .245,   .240,   .235,   .230,   .225,   .335,   .335,
     2  .335,   .335,   .335,   .335,   .420,   .430,   .435,   .445,
     3  .450,   .455,   .500,   .515,   .530,   .540,   .550,   .560,
     4  .580,   .600,   .630,   .645,   .660,   .680,   .680,   .695,
     5  .720,   .740,   .760,   .780,
     6  .285,   .275,   .270,   .265,   .260,   .255,   .400,   .410,
     7  .415,   .415,   .415,   .410,   .510,   .530,   .535,   .540,
     8  .545,   .550,   .640,   .650,   .660,   .675,   .685,   .690,
     9  .750,   .765,   .780,   .785,   .800,   .815,   .870,   .880,
     A  .895,   .905,   .920,   .930/
      DATA TABLB/
     1  .300,   .295,   .285,   .280,   .275,   .265,   .420,   .420,
     2  .425,   .425,   .425,   .430,   .545,   .550,   .560,   .565,
     3  .575,   .580,   .670,   .680,   .690,   .700,   .710,   .720,
     4  .795,   .805,   .815,   .830,   .840,   .850,   .925,   .945,
     5  .960,   .965,   .975,   .980,
     6  .325,   .320,   .315,   .305,   .300,   .290,   .460,   .460,
     7  .460,   .460,   .455,   .455,   .595,   .600,   .600,   .600,
     8  .610,   .620,   .735,   .740,   .750,   .760,   .765,   .775,
     9  .885,   .890,   .895,   .900,   .910,   .925,   1.045,  1.050,
     A  1.050,  1.060,  1.065,  1.075/
      DATA TABLC/
     1  .355,   .350,   .345,   .340,   .330,   .320,   .530,   .530,
     2  .525,   .525,   .520,   .520,   .700,   .700,   .700,   .705,
     3  .710,   .710,   .880,   .880,   .885,   .890,   .890,   .895,
     4  1.040,  1.045,  1.050,  1.055,  1.060,  1.065,  1.200,  1.205,
     5  1.210,  1.215,  1.225,  1.230,
     6  .510,   .490,   .480,   .470,   .460,   .450,   .750,   .750,
     7  .750,   .750,   .745,   .740,   1.000,  1.000,  1.000,  1.000,
     8  1.000,  1.000,  1.250,  1.250,  1.250,  1.250,  1.250,  1.250,
     9  1.500,  1.500,  1.500,  1.490,  1.490,  1.490,  1.740,  1.740,
     A  1.740,  1.730,  1.730,  1.730/
      DATA TABLD/
     1  .165,   .180,   .200,   .210,   .220,   .225,   .335,   .335,
     2  .335,   .335,   .335,   .335,   .500,   .480,   .465,   .460,
     3  .460,   .455,   .670,   .625,   .595,   .580,   .575,   .560,
     4  .830,   .750,   .730,   .705,   .695,   .680,   .990,   .860,
     5  .835,   .810,   .795,   .780,
     6  .200,   .215,   .230,   .240,   .250,   .255,   .400,   .400,
     7  .400,   .405,   .410,   .410,   .600,   .580,   .565,   .560,
     8  .555,   .550,   .795,   .760,   .735,   .715,   .700,   .690,
     9  .970,   .910,   .870,   .840,   .825,   .815,   1.150,  1.050,
     A  1.000,  .965,   .940,   .930/
      DATA TABLE/
     1  .230,   .240,   .245,   .250,   .260,   .265,   .415,   .420,
     2  .425,   .425,   .430,   .430,   .630,   .615,   .600,   .590,
     3  .585,   .580,   .830,   .785,   .760,   .740,   .730,   .720,
     4  1.030,  .950,   .905,   .880,   .865,   .850,   1.250,  1.090,
     5  1.050,  1.015,  .990,   .980,
     6  .220,   .240,   .250,   .265,   .280,   .290,   .440,   .445,
     7  .450,   .450,   .455,   .455,   .670,   .655,   .640,   .630,
     8  .625,   .620,   .880,   .830,   .805,   .790,   .780,   .775,
     9  1.070,  1.000,  .960,   .940,   .935,   .925,   1.270,  1.170,
     A  1.120,  1.100,  1.085,  1.075/
      DATA TABLF/
     1  .250,   .270,   .295,   .310,   .315,   .320,   .500,   .505,
     2  .510,   .515,   .520,   .520,   .750,   .740,   .730,   .720,
     3  .715,   .710,   .980,   .940,   .915,   .900,   .900,   .895,
     4  1.190,  1.120,  1.090,  1.080,  1.070,  1.065,  1.380,  1.300,
     5  1.270,  1.250,  1.240,  1.230,
     6  .340,   .380,   .410,   .430,   .440,   .450,   .680,   .700,
     7  .720,   .730,   .730,   .740,   .950,   .980,   1.000,  1.000,
     8  1.000,  1.000,  1.200,  1.230,  1.250,  1.250,  1.250,  1.250,
     9  1.440,  1.470,  1.480,  1.480,  1.490,  1.490,  1.680,  1.710,
     A  1.710,  1.720,  1.720,  1.730/
      DATA TABLG/
     1  .165,   .210,   .250,   .290,   .310,   .345,   .335,   .365,
     2  .390,   .415,   .445,   .470,   .500,   .540,   .560,   .560,
     3  .560,   .560,   .670,   .670,   .670,   .670,   .670,   .670,
     4  .830,   .775,   .775,   .775,   .775,   .775,   .990,   .930,
     5  .895,   .895,   .895,   .895,
     6  .200,   .230,   .280,   .305,   .335,   .360,   .400,   .445,
     7  .485,   .500,   .520,   .530,   .600,   .630,   .650,   .660,
     8  .665,   .665,   .795,   .800,   .800,   .805,   .810,   .815,
     9  .970,   .965,   .955,   .955,   .955,   .955,   1.150,  1.135,
     A  1.120,  1.100,  1.100,  1.105/
      DATA TABLH/
     1  .230,   .275,   .300,   .330,   .350,   .370,   .415,   .470,
     2  .500,   .530,   .545,   .550,   .630,   .670,   .680,   .685,
     3  .690,   .690,   .830,   .835,   .835,   .840,   .845,   .850,
     4  1.030,  1.015,  1.005,  1.000,  1.005,  1.010,  1.250,  1.225,
     5  1.200,  1.170,  1.165,  1.160,
     6  .220,   .280,   .315,   .345,   .375,   .390,   .440,   .500,
     7  .535,   .560,   .570,   .580,   .670,   .700,   .720,   .725,
     8  .740,   .740,   .880,   .885,   .895,   .900,   .900,   .900,
     9  1.070,  1.070,  1.075,  1.075,  1.080,  1.080,  1.270,  1.260,
     A  1.260,  1.255,  1.255,  1.255/
      DATA TABLI/
     1  .250,   .300,   .330,   .380,   .415,   .445,   .500,   .560,
     2  .600,   .620,   .635,   .640,   .750,   .780,   .800,   .820,
     3  .820,   .825,   .980,   .990,   1.000,  1.020,  1.020,  1.020,
     4  1.190,  1.200,  1.200,  1.210,  1.220,  1.225,  1.380,  1.390,
     5  1.400,  1.410,  1.420,  1.420,
     6  .340,   .380,   .410,   .460,   .500,   .540,   .680,   .700,
     7  .730,   .770,   .790,   .840,   .950,   .990,   1.010,  1.050,
     8  1.080,  1.120,  1.200,  1.240,  1.290,  1.330,  1.370,  1.420,
     9  1.440,  1.500,  1.550,  1.610,  1.670,  1.720,  1.680,  1.760,
     A  1.820,  1.890,  1.950,  2.020/
      DATA TABLJ/
     1  .415,   .410,   .400,   .385,   .370,   .345,   .500,   .500,
     2  .495,   .485,   .480,   .470,   .585,   .580,   .580,   .575,
     3  .570,   .560,   .670,   .670,   .670,   .670,   .670,   .670,
     4  .750,   .750,   .755,   .760,   .765,   .775,   .830,   .840,
     5  .845,   .855,   .870,   .895,
     6  .460,   .455,   .445,   .420,   .390,   .360,   .575,   .575,
     7  .570,   .560,   .545,   .530,   .695,   .695,   .690,   .685,
     8  .680,   .665,   .800,   .805,   .805,   .810,   .815,   .815,
     9  .920,   .930,   .935,   .945,   .970,   .955,   1.040,  1.045,
     A  1.050,  1.075,  1.110,  1.105/
      DATA TABLK/
     1  .475,   .465,   .450,   .430,   .400,   .370,   .600,   .600,
     2  .595,   .585,   .575,   .550,   .725,   .730,   .730,   .725,
     3  .715,   .690,   .850,   .850,   .855,   .865,   .870,   .850,
     4  .970,   .975,   .980,   1.000,  1.020,  1.010,  1.110,  1.110,
     5  1.110,  1.130,  1.180,  1.160,
     6  .500,   .490,   .470,   .450,   .425,   .390,   .640,   .635,
     7  .630,   .620,   .600,   .580,   .770,   .775,   .780,   .775,
     8  .765,   .740,   .920,   .915,   .920,   .930,   .935,   .900,
     9  1.050,  1.055,  1.060,  1.080,  1.105,  1.080,  1.195,  1.200,
     A  1.205,  1.225,  1.265,  1.255/
      DATA TABLL/
     1  .550,   .535,   .525,   .500,   .475,   .445,   .720,   .715,
     2  .710,   .690,   .670,   .640,   .890,   .890,   .890,   .885,
     3  .870,   .825,   1.060,  1.050,  1.050,  1.060,  1.065,  1.020,
     4  1.215,  1.215,  1.220,  1.245,  1.270,  1.225,  1.380,  1.380,
     5  1.395,  1.420,  1.470,  1.420,
     6  .760,   .730,   .700,   .650,   .600,   .540,   1.000,  1.000,
     7  .970,   .930,   .890,   .840,   1.240,  1.230,  1.230,  1.220,
     8  1.190,  1.120,  1.500,  1.480,  1.480,  1.490,  1.470,  1.420,
     9  1.750,  1.720,  1.730,  1.760,  1.780,  1.720,  2.000,  1.970,
     A  1.980,  2.020,  2.070,  2.020/
C
      BETA=SQRT(ABS(MACH**2-1.))
      IF(BETA .EQ. 0.)BETA=UNUSED
      TANBET=TAN(SWEPLE/RAD)/BETA
      ATANLS=AR*TAN(SWEPLE/RAD)
C
      IF(MACH .GT. 1.)GO TO 1010
C
C***  SUBSONIC SPEEDS (MACH .LE. 1.)
C
      IF(TANBET .GT. 1.)GO TO 1000
C
C ... TAN(LES)/BETA .LE. 1.
C
      CALL MVLOOK(6,6,6,216,TAPR,ATANLE,ARGX,SUBAF1,TANBET,ATANLS,
     1            TAPER,XACOCR)
C
      GO TO 1030
C
C ... TAN(LES)/BETA .GT. 1.
C
 1000 CALL MVLOOK(6,6,6,216,TAPR,ATANLE,ARGX,SUBAF2,1./TANBET,ATANLS,
     1            TAPER,XACOCR)
C
      GO TO 1030
C
C***  SUPERSONIC SPEEDS (MACH .GT. 1.)
C
 1010 IF(TANBET .LE. 1.)GO TO 1020
C
C ... TAN(LES)/BETA .GT. 1.
C
      CALL MVLOOK(6,6,6,216,TAPR,ATANLE,ARGX,SUPAF1,1./TANBET,ATANLS,
     1            TAPER,XACOCR)
C
      GO TO 1030
C
C ... TAN(LES)/BETA .LE. 1.
C
 1020 CALL MVLOOK(6,6,6,216,TAPR,ATANLE,ARGX,SUPAF2,TANBET,ATANLS,
     1            TAPER,XACOCR)
C
 1030 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION FIT(A,Y,Z,NROW,NCOL)
C
C***  SOLVE THE POLYNOMIAL EXPANSION OF THE FORM
C***   FIT=A(1)+A(2)*Y+A(3)*Y**2+A(4)*Y**3+A(NCOL)*Y**(NCOL-1)
C***           .   .   .   .   .   .   .   .   .   .   .
C***
C***   +(A(NCOL*(NROW-1)+1)+ ... +A(NCOL*NROW)*Y**(NCOL-1))*Z**(NROW-1)
C
C***  INPUTS
C
C    A -- ARRAY OF TERMS FOR THE POLYNOMIAL EXPANSION
C    Y -- FIRST INDEPENDENT VARIABLE
C    Z -- SECOND INDEPENDENT VARIABLE
C NROW -- NUMBER OF ROWS IN THE EXPANSION (NO LIMIT)
C NCOL -- NUMBER OF COLUMNS IN THE EXPANSION (MAXIMUM IS 8)
C
      DIMENSION A(1),YT(8)
C
      DO 1000 I=2,NCOL
        YT(I)=Y**(I-1)
 1000 CONTINUE
C
      YT(1)=1.
C
      DO 1030 IROW=1,NROW
         NCOUNT=NCOL*(IROW-1)
         S=0.
         DO 1010 ICOL=1,NCOL
            S=S+A(ICOL+NCOUNT)*YT(ICOL)
 1010    CONTINUE
         IF(IROW .EQ. 1)GO TO 1020
         FIT=S*Z**(IROW-1)+FIT
         GO TO 1030
 1020    FIT=S
 1030 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE IAD2D(MACH,DELTA,L,H,W,MFR,SREF,CXADD,MFRM) 
C 
C  THIS ROUTINE CALCULATES THE ADDITIVE DRAG FOR 2-D
C  INLETS OPERATING AT OFF DESIGN CONDITIONS
C
C  WRITTEN BY W. BLAKE, WL/FIGC
C 
C  METHOD TAKEN FROM NEAR TR 396, VOL II
C 
C  INPUTS:  
C      MACH  - FREE-STREAM MACH NUMBER
C      DELTA - INLET RAMP ANGLE 
C      L     - LENGTH FROM RAMP APEX TO INLET LIP 
C      H     - INLET HEIGHT 
C      W     - INLET WIDTH
C      MFR   - INLET MASS FLOW RATIO
C      SREF  - REFERENCE AREA 
C 
C  OUTPUT:  
C      CXADD - ADDITIVE DRAG AT REFERENCE CONDITION 
C 
C  INTERMEDIATE RESULTS:  
C      CXSTG - ADDITIVE DRAG AT FULLY BLOCKED CONDITIONS (MFR=0)
C      MFRM  - MAXIMUM MASS FLOW RATIO POSSIBLE AT SPECIFIED CONDITION
C      CXBLK - ADDITIVE DRAG AT MFR = MFRM
C 
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      DIMENSION TGR(7), TCU(4), TX(5)
      DIMENSION CXS(140), MFM(140), CXB1(140), CXB2(140)
      REAL L,LH,MACH,MFR,MFRM,MFM 
C 
      DATA TGR / 1.0, 1.25, 1.5, 2.0, 3.0, 4.0, 5.0 / 
      DATA TCU / 1.5, 2.5, 3.5, 4.5 / 
      DATA TX  / 0., 3., 6., 9., 12. /
C 
C  THE DATA ARE STACKED AS FOLLOWS: 
C 
C  MACH = 1.0 ARE LINES A & B,   MACH =1.25 ARE LINES C & D 
C  MACH = 1.5 ARE LINES E & F,   MACH = 2.0 ARE LINES G & H 
C  MACH = 3.0 ARE LINES I & J,   MACH = 4.0 ARE LINES K & L 
C  MACH = 5.0 ARE LINES M & N 
C 
C  FOR EACH MACH NUMBER, THERE ARE 4 CURVES CORRESPONDING TO THE
C  4 INLET LENGTHS.  THE INLET LENGTHS ARE 1.5,2.5,3.5 AND 4.5
C  FOR EACH LENGTH, THERE ARE 5 POINTS CORRESPONDING TO THE RAMP
C  ANGLE.  THE RAMP ANGLES ARE 0,3,6,9, AND 12 DEG
C 
C  CXBLK TABLES (WIDTH/HEIGHT = 2.0)
      DATA CXB2 / 
     A  0.000,0.158,0.296,0.407,0.508,0.000,0.220,0.341,0.389,0.422,
     B  0.000,0.225,0.251,0.229,0.244,0.000,0.180,0.148,0.143,0.190,
     C  0.000,0.080,0.232,0.331,0.421,0.000,0.127,0.282,0.339,0.370,
     D  0.000,0.139,0.233,0.226,0.222,0.000,0.130,0.154,0.132,0.199,
     E  0.000,0.034,0.098,0.198,0.366,0.001,0.078,0.169,0.262,0.349,
     F  0.001,0.093,0.164,0.201,0.221,0.002,0.093,0.128,0.131,0.207,
     G  0.000,0.000,0.009,0.044,0.110,0.000,0.034,0.090,0.165,0.255,
     H  0.001,0.054,0.117,0.176,0.243,0.001,0.061,0.107,0.146,0.250,
     I  0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.014,0.054,0.128,
     J  0.000,0.018,0.058,0.119,0.204,0.000,0.030,0.076,0.133,0.236,
     K  0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.044,
     L  0.000,0.002,0.022,0.072,0.160,0.000,0.013,0.049,0.110,0.216,
     M  0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.000,
     N  0.0  ,0.0  ,0.000,0.037,0.123,0.000,0.003,0.028,0.087,0.197/
C
C   CXBLK TABLES (WIDTH/HEIGHT = 1.0) 
      DATA CXB1 / 
     A  0.000,0.074,0.126,0.162,0.184,0.000,0.089,0.109,0.100,0.091,
     B  0.000,0.071,0.057,0.045,0.047,0.000,0.044,0.029,0.026,0.037,
     C  0.000,0.039,0.105,0.137,0.162,0.000,0.057,0.100,0.099,0.093,
     D  0.000,0.055,0.059,0.045,0.044,0.000,0.042,0.029,0.024,0.040,
     E  0.000,0.017,0.047,0.090,0.147,0.001,0.036,0.070,0.088,0.093,
     F  0.001,0.040,0.054,0.049,0.044,0.001,0.035,0.033,0.025,0.042,
     G  0.000,0.000,0.004,0.022,0.053,0.000,0.016,0.040,0.066,0.087,
     H  0.000,0.024,0.043,0.051,0.056,0.001,0.025,0.032,0.031,0.054,
     I  0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.007,0.026,0.056,
     J  0.000,0.009,0.025,0.045,0.064,0.000,0.013,0.027,0.037,0.068,
     K  0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.022,
     L  0.0  ,0.001,0.011,0.032,0.061,0.0  ,0.006,0.020,0.037,0.073,
     M  0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,
     N  0.0  ,0.0  ,0.0  ,0.018,0.052,0.0  ,0.002,0.013,0.034,0.072/
C 
C  MFRM TABLES
      DATA MFM /
     A  1.0 , .930, .858, .784, .708, 1.0 , .877, .751, .621, .487, 
     B  1.0 , .824, .644, .458, .266, 1.0 , .771, .537, .296, .045, 
     C  1.0 , .951, .875, .808, .737, 1.0 , .897, .766, .640, .507, 
     D  1.0 , .843, .657, .472, .277, 1.0 , .789, .547, .304, .047, 
     E  1.0 , .972, .926, .860, .759, 1.0 , .917, .810, .681, .522, 
     F  1.0 , .861, .695, .502, .285, 1.0 , .806, .579, .324, .048, 
     G  1.0 , 1.0 , .990, .954, .896, 1.0 , .947, .866, .756, .616, 
     H  1.0 , .890, .743, .558, .337, 1.0 , .833, .619, .360, .057, 
     I  1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , .966, .886, .755, 
     J  1.0 , .941, .828, .653, .413, 1.0 , .881, .691, .421, .070, 
     K  1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , .893, 
     L  1.00,0.992,0.914,0.749,0.488,1.000,0.928,0.762,0.483,0.083, 
     M  1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.00, 
     N  1.0 , 1.0 , 1.00,0.848,0.564, 1.0 ,0.976,0.836,0.547,0.096/ 
C 
C  CXSTAG TABLES
      DATA CXS /
     A  1.275,1.171,1.067,0.961,0.853,1.275,1.102,0.927,0.751,0.571,
     B  1.275,1.032,0.788,0.541,0.289,1.275,0.963,0.649,0.331,0.007,
     C  1.420,1.324,1.264,1.184,1.102,1.420,1.258,1.158,1.024,0.887,
     D  1.419,1.192,1.052,0.864,0.673,1.422,1.126,0.946,0.704,0.458,
     E  1.530,1.420,1.325,1.254,1.239,1.530,1.344,1.187,1.069,1.044,
     F  1.530,1.270,1.049,0.884,0.849,1.530,1.195,0.911,0.699,0.654,
     G  1.654,1.654,1.418,1.316,1.230,1.654,1.449,1.258,1.089,0.945,
     H  1.652,1.365,1.098,0.862,0.660,1.651,1.282,0.939,0.634,0.376,
     I  1.750,1.750,1.750,1.750,1.750,1.750,1.750,1.318,1.118,0.936,
     J  1.750,1.441,1.143,0.864,0.608,1.750,1.351,0.967,0.609,0.280,
     K  1.790,1.790,1.790,1.790,1.790,1.790,1.790,1.790,1.790,0.932,
     L  1.790,1.469,1.158,0.863,0.588,1.790,1.376,0.977,0.598,0.244,
     M  1.776,1.776,1.776,1.776,1.776,1.776,1.776,1.776,1.776,1.776,
     N  1.776,1.776,1.776,0.862,0.577,1.776,1.388,0.981,0.591,0.225/
C 
      LH=L/H
C 
C  CALCULATE CXSTG
      CALL MVLOOK(7,4,5,140,TGR,TCU,TX,CXS,DELTA,LH,MACH,CXSTG) 
C 
C  CALCULATE MFRM 
      CALL MVLOOK(7,4,5,140,TGR,TCU,TX,MFM,DELTA,LH,MACH,MFRM)
C 
C  CALCULATE CXBLK FOR WIDTH/HEIGHT = 1.0 
      CALL MVLOOK(7,4,5,140,TGR,TCU,TX,CXB1,DELTA,LH,MACH,CXBLK1) 
C 
C  CALCULATE CXBLK FOR WIDTH/HEIGHT = 2.0 
      CALL MVLOOK(7,4,5,140,TGR,TCU,TX,CXB2,DELTA,LH,MACH,CXBLK2) 
C 
C  SCALE CXBLK AND CXSTAG TO USER HEIGHT/WIDTH RATIO
      CXBLK=CXBLK2+(2.-W/H)*(CXBLK1-CXBLK2) 
      CXSTG=CXSTG*W/H 
C 
C  CALCULATE CXADD
      CXADD=(1.-MFR/MFRM)*(CXSTG-CXBLK)+CXBLK 
      IF(CXADD.LT.0.) CXADD=0.
C
C  CORRECT TO USER REFERENCE AREA
      SCOR=H*W/SREF 
      CXADD=CXADD*SCOR
      RETURN
      END 
c *************************************
c *************************************
c *************************************
      SUBROUTINE LUGSHO(MACH,DEL,K,NM,HPROT,WPROT,LPROT,OPROT,CDLAUN)
C
C  WRITTEN BY K. DETERS, MCDONNELL DOUGLAS
C
      REAL MACH,HPROT(100),WPROT(100),LPROT(100),OPROT(100)
      CDTOT=0.0
      DO 10 I=1,NM
      K=K+1
      IF (HPROT(K) .LT. .0001 .OR. WPROT(K) .LT. .0001) GOTO 10
      CALL FLAT(MACH,DEL,HPROT(K),WPROT(K),LPROT(K),OPROT(K),CDSUM)
      CDTOT=CDTOT+CDSUM
 10   CONTINUE
      CDLAUN=CDTOT
      RETURN
      END

c *************************************
c *************************************
c *************************************
      SUBROUTINE PRIF3
C
C***  SUBROUTINE TO PRINT THE RESULTS FOR FIN SET 3
C
      COMMON /FSET3/  FDATA(399)
C
      COMMON /GEOFS3/ GFIN(188)
C
      DIMENSION SSPAN(10),LMAXU(10),LFLATU(10),LMAXL(10),
     1          LFLATL(10),CHORD(10),THICKU(10),THICKL(10),
     2          SWEEP(10),STA(10),XLE(10),
     3          XCORD(50),MEAN(50),THICK(50),YUPPER(50),
     4          YLOWER(50),LER(10)
C
      REAL LER,LMAXU,LMAXL,LFLATU,LFLATL,NPANEL,MEAN
C
      EQUIVALENCE (FDATA(1),SECTYP),(FDATA(2),SSPAN(1)),
     1            (FDATA(12),LMAXU(1)),(FDATA(22),LFLATU(1)),
     2            (FDATA(32),LMAXL(1)),(FDATA(42),LFLATL(1)),
     3            (FDATA(52),CHORD(1)),(FDATA(62),THICKU(1)),
     4            (FDATA(72),THICKL(1)),(FDATA(82),SWEEP(1)),
     5            (FDATA(92),STA(1)),(FDATA(102),XLE(1)),
     6            (FDATA(112),NPANEL),(FDATA(113),XCORD(1)),
     7            (FDATA(163),MEAN(1)),(FDATA(213),THICK(1)),
     8            (FDATA(263),YUPPER(1)),(FDATA(313),YLOWER(1)),
     9            (FDATA(363),FINPHI),(FDATA(364),LER(1))
C
      DIMENSION SPLANF(10),CBAR(10),SWEPLE(10),SWEP25(10),
     1          SWEP50(10),SWEP75(10),SWEPTE(10),
     2          XMGCLE(10),XMGC25(10),
     3          XMGC50(10),XMGC75(10),XMGCTE(10),YMEANC(10),
     4          ASPCT(10),TAPER(10),TOVERC(10),XCENT(10)
C
      EQUIVALENCE (GFIN(1),SPLANF(1)),(GFIN(11),CBAR(1)),
     1            (GFIN(21),SWEPLE(1)),(GFIN(31),SWEP25(1)),
     2            (GFIN(41),SWEP50(1)),(GFIN(51),SWEP75(1)),
     3            (GFIN(61),SWEPTE(1)),(GFIN(71),XMGCLE(1)),
     4            (GFIN(81),XMGC25(1)),(GFIN(91),XMGC50(1)),
     5            (GFIN(101),XMGC75(1)),(GFIN(111),XMGCTE(1)),
     6            (GFIN(121),YMEANC(1)),(GFIN(131),ASPCT(1)),
     7            (GFIN(141),TAPER(1)),(GFIN(151),TOVERC(1)),
     8            (GFIN(161),XCENT(1)),(GFIN(171),FINAR),
     9            (GFIN(172),FINTPR),(GFIN(173),FINSPN),
     A            (GFIN(174),FINSP),(GFIN(175),FINWET),
     B            (GFIN(176),TCEFF),(GFIN(177),FINXGC),
     C            (GFIN(178),FINYGC),(GFIN(179),SWAVLE),
     D            (GFIN(180),SWAV25),(GFIN(181),SWAV50),
     E            (GFIN(182),SWAV75),(GFIN(183),SWAVTE),
     F            (GFIN(184),FINCBR),(GFIN(185),DELTAY),
     G            (GFIN(186),DELTAD),(GFIN(187),XCENF),(GFIN(188),XOVC)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      CHARACTER*4 IFT,ICM,IM,IIN,IUNIT
C
      DATA IFT/'  FT'/
      DATA ICM/'  CM'/
      DATA IM /'   M'/
      DATA IIN/'  IN'/
C
      IUNIT=IFT
      IF(LDIMCM)IUNIT=ICM
      IF(LDIMM)IUNIT=IM
      IF(LDIMIN)IUNIT=IIN
C
      ISET=3
C
      WRITE(6,1030)ISET
      WRITE(6,1040)
      WRITE(6,1050)
      WRITE(6,1060)
      IF(LDIMFT) WRITE(6,1082) IUNIT
      IF(LDIMIN) WRITE(6,1084)
      IF(LDIMM)  WRITE(6,1086)
      IF(LDIMCM) WRITE(6,1088)
C
      NSEG=1
C
C***  FIND LAST SPAN STATION
C
      DO 1000 I=2,10
          IF(SSPAN(I) .EQ. UNUSED .OR. SSPAN(I) .EQ. 0.)GO TO 1010
          NSEG=I-1
 1000 CONTINUE
C
 1010 CONTINUE
C
C***  PRINT RESULTS FOR EACH FIN SEGMENT
C
      DO 1020 ISEG=1,NSEG
         WRITE(6,1090)ISEG,SPLANF(ISEG),ASPCT(ISEG),TAPER(ISEG),
     1   SWEPLE(ISEG),SWEPTE(ISEG),CBAR(ISEG),TOVERC(ISEG)
 1020 CONTINUE
C
      WRITE(6,1100)FINSP,FINAR,FINTPR,SWAVLE,SWAVTE,FINCBR,TCEFF
C
 1030 FORMAT(29X,'FIN SET NUMBER ',I2)
 1040 FORMAT(26X,'(DATA FOR ONE PANEL ONLY)',/)
 1050 FORMAT(4X,'SEGMENT',3X,'PLAN',8X,'ASPECT',4X,'TAPER',5X,
     1 'L.E.',5X,'T.E.',4X,'M.A.C.',4X,'T/C')
 1060 FORMAT(4X,'NUMBER',4X,'AREA',8X,'RATIO',5X,'RATIO',4X,'SWEEP',
     1 4X,'SWEEP',4X,'CHORD',4X,'RATIO')
 1082 FORMAT(4X,A4,6X,'FT**2',27X,'DEG',6X,'DEG',7X,'FT')
 1084 FORMAT(4X,A4,6X,'IN**2',27X,'DEG',6X,'DEG',7X,'IN')
 1086 FORMAT(4X,A4,6X,' M**2',27X,'DEG',6X,'DEG',7X,' M')
 1088 FORMAT(4X,A4,6X,'CM**2',27X,'DEG',6X,'DEG',7X,'CM')
 1090 FORMAT(4X,1X,I2,2X,F10.4,4X,6F9.3)
 1100 FORMAT(4X, 'TOTAL',F10.4,4X,6F9.3)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SLEQ(A,X,B,N,M)
C
C****  THIS ROUTINE SOLVES N SIMULTANEOUS EQUATIONS WITH CONSTANTS
C****  MATRIX A(I,J) IS USED AS I=ROW AND J=COLUMN
C
      DIMENSION A(N,M),X(N),B(N)
      NP1=N+1
      IND=0
      NM1=N-1
      DO 1000 K=1,N
      A(K,NP1)=B(K)
 1000 CONTINUE
 1010 DO 1040 K=1,N
      KP1=K+1
C
C  CHECK FOR A ZERO ON THE DIAGONAL
C
      IF(A(K,K).EQ.0.) GO TO 1060
      DO 1020 J=KP1,NP1
      A(K,J)=A(K,J)/A(K,K)
 1020 CONTINUE
      A(K,K)=1.
      DO 1045 I=1,N
      IF(I.EQ.K) GO TO 1045
      DO 1030 J=KP1,NP1
      A(I,J)=A(I,J)-A(I,K)*A(K,J)
 1030 CONTINUE
      A(I,K)=0.0
 1045 CONTINUE
 1040 CONTINUE
C
C  GET THE RESULTS AND STORE IN X
C
      DO 1050 L=1,N
      X(L)=A(L,NP1)
 1050 CONTINUE
      GO TO 1090
C
C  HERE FOR ZERO ON THE DIAGONAL
C  INTERCHANGE THE ROWS AND TRY NEW SOLUTION
C
 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
      A(N-J+1,I)=A(N-J,I)
 1070 CONTINUE
      A(1,I)=TEMP
 1080 CONTINUE
      GO TO 1010
 1090 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE TOLOG( ALPHA, LANS, IERR)
C
C***  CONVERT AN ALPHANUMERIC STRING INTO A LOGICAL CONSTANT
C
C***  INPUTS
C
C  ALPHA - ALPHANUMERIC STRING (MUST BE INTEGER)
C
C***  OUTPUTS
C
C   LANS - LOGICAL RESULT
C   IERR - ERROR CODE, 0=NO ERROR OR 1=CONSTANT NOT CORRECT TYPE
C
      CHARACTER*4 LTRUE,LFALSE,POINT,BLANK,ALPHA
C
      DIMENSION ALPHA(80),LTRUE(4),LFALSE(5)
C
      LOGICAL LANS
C
      DATA LTRUE  / 'T   ','R   ','U   ','E   '/
      DATA LFALSE / 'F   ','A   ','L   ','S   ','E   '/
      DATA POINT  / '.   ' /
      DATA BLANK  / '    ' /
C
      IERR=1
      LANS=.FALSE.
C
C***  SKIP LEADING BLANKS
C
      ICOL=1
      CALL SKIPBL(ALPHA, ICOL)
C
      IF(ICOL .LT. 81)GO TO 1000
C
      GO TO 1060
C
C***  FIRST CHARACTER MUST BE POINT
C
 1000 IF(ALPHA(ICOL) .NE. POINT)GO TO 1060
C
C***  LOOK FOR TRUE
C
C ... TEST FOR .T.
C
      IF(ALPHA(ICOL) .EQ. POINT .AND. ALPHA(ICOL+1) .EQ. LTRUE(1)
     1   .AND. ALPHA(ICOL+2) .EQ. POINT)GO TO 1020
C
C ... TEST FOR .TRUE.
C
      IFIR=ICOL+1
      IMAX=IFIR+3
C
      DO 1010 I=IFIR,IMAX
         II=I
         IF(ALPHA(I) .NE. LTRUE(I-IFIR+1))GO TO 1030
 1010 CONTINUE
C
      II=II+1
      IF(ALPHA(II) .NE. POINT)GO TO 1060
C
 1020 LANS=.TRUE.
      IERR=0
C
      GO TO 1060
C
C***  LOOK FOR FALSE
C
C ... TEST FOR .F.
C
 1030 IF(ALPHA(ICOL) .EQ. POINT .AND. ALPHA(ICOL+1) .EQ. LFALSE(1)
     1   .AND. ALPHA(ICOL+2) .EQ. POINT)GO TO 1050
C
C ... TEST FOR .FALSE.
C
      IFIR=ICOL+1
      IMAX=IFIR+4
C
      DO 1040 I=IFIR,IMAX
         II=I
         IF(ALPHA(I) .NE. LFALSE(I-IFIR+1))GO TO 1060
 1040 CONTINUE
C
      II=II+1
      IF(ALPHA(II) .NE. POINT)GO TO 1060
C
 1050 LANS=.FALSE.
      IERR=0
C
 1060 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE AERO
C      
C***  TOP LEVEL EXECUTIVE ROUTINE FOR CALCULATING AERODYNAMICS
C      
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
      COMMON /SECVAR/ XU(50),XL(50),YU(50),YL(50),YUU(50),YLL(50),
     1                L,I,J,K,II,JJ,KK,III,JJJ,KKK,LLL,
     2                ALPHAI,ALPHAO,AII,XOVC
      COMMON /TOTALC/ TOTC(80)
      COMMON /ABODIN/ BDIN(299),PROTUB,B1DUM(581)
      COMMON /BDWORK/ GBOD(100),CAFB(20),B2DUM(121)
      COMMON /GEOBOD/ HBOD(25),SWET,B3DUM(21)
      COMMON /SBODY/ BCN(20),BCM(20),BCA(20),BCY(20),BCLN(20),BCLL(20),
     1                BCNA(20),BCMA(20),BCYB(20),BCLNB(20),BCLLB(20)
      COMMON /SFIN1/  F1CN(20),F1CM(20),F1CA(20),F1CY(20),F1CLN(20),
     1                F1CLL(20),DU1(40),F1CYB(20),F1CLNB(20),F1CLLB(20)
      COMMON /SFIN2/  F2CN(20),F2CM(20),F2CA(20),F2CY(20),F2CLN(20),
     1                F2CLL(20),DU2(40),F2CYB(20),F2CLNB(20),F2CLLB(20)
      COMMON /SFIN3/  F3CN(20),F3CM(20),F3CA(20),F3CY(20),F3CLN(20),
     1                F3CLL(20),DU3(40),F3CYB(20),F3CLNB(20),F3CLLB(20)
      COMMON /SFIN4/  F4CN(20),F4CM(20),F4CA(20),F4CY(20),F4CLN(20),
     1                F4CLL(20),DU4(40),F4CYB(20),F4CLNB(20),F4CLLB(20)
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /CASEID/ DUMMEE(175),ICASE,NOEXTR,NOLAT,IR,IPAGE
      COMMON /INC/ COREC(129),ALP1(20),NAP
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
C  EFFECTIVE FULL FIN DEFLECTIONS
      COMMON /FFINDL/DSYN1(8),DSYN2(8),DSYN3(8),DSYN4(8),CLD(4)
C
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD,PROTUB
C
      DIMENSION BBCN(20,5),BBCM(20,5),BBCA(20,5),BBCY(20,5),BBCSN(20,5)
     1          ,BBCSL(20,5),IFOUND(6)
      DIMENSION CBODY(120),CFIN1(120),CFIN2(120),CFIN3(120),CFIN4(120)
C
      REAL NALPHA,NMACH,MACH
C      
      REAL NAP
C      
      LOGICAL TTRIM,LBODY
C      
      EQUIVALENCE (CBODY(1),BCN(1)),(CFIN1(1),F1CN(1)),
     1            (CFIN2(1),F2CN(1)),(CFIN3(1),F3CN(1)),
     2            (CFIN4(1),F4CN(1))
C
C  $DEFLCT DEFLECTIONS REQUIRED
      COMMON /INCID/  DEL1(8),DEL2(8),DEL3(8),DEL4(8),XHINGE(4),
     1                SKEW(4)
C
C  $FINSETn DATA REQUIRED
      COMMON /FSET1/  FIN1(399)
      COMMON /FSET2/  FIN2(399)
      COMMON /FSET3/  FIN3(399)
      COMMON /FSET4/  FIN4(399)
C
C  FINSET AERODYNAMIC DATA REQUIRED
      COMMON /F1WORK/ F1WK(290)
      COMMON /F2WORK/ F2WK(290)
      COMMON /F3WORK/ F3WK(290)
      COMMON /F4WORK/ F4WK(290)
C
C  FINSET GEOMETRIC DATA REQUIRED
      COMMON /GEOFS1/ GFIN1(188)
      COMMON /GEOFS2/ GFIN2(188)
      COMMON /GEOFS3/ GFIN3(188)
      COMMON /GEOFS4/ GFIN4(188)
C
C  DIMENSION STATION SEMI-SPANS
      DIMENSION SSPAN1(10), SSPAN2(10), SSPAN3(10), SSPAN4(10)
C
C  DIMENSION FIN CHORDS
      DIMENSION CHORDS1(10), CHORDS2(10), CHORDS3(10), CHORDS4(10)
C
C  DIMENSION YUPPER
      DIMENSION YUPER1(50), YUPER2(50), YUPER3(50), YUPER4(50)
C
C  DIMENSION (FLAP CHORD/FIN CHORD)station i ARRAYS
      DIMENSION CFOC1(10), CFOC2(10), CFOC3(10), CFOC4(10)
C
C  DEFINE NORMAL FORCE CURVE SLOPE
      EQUIVALENCE (F1WK(64),CNALP1),(F2WK(64),CNALP2),
     1            (F3WK(64),CNALP3),(F4WK(64),CNALP4)
C
C  DEFINE ZERO ALPHA AXIAL FORCE FOR PANELS
      EQUIVALENCE (F1WK(207),CAZRO1),(F2WK(207),CAZRO2),
     1            (F3WK(207),CAZRO3),(F4WK(207),CAZRO4)
C
C  DEFINE STATION SEMI-SPANS
      EQUIVALENCE (FIN1(2),SSPAN1(1)),(FIN2(2),SSPAN2(1)),
     1            (FIN3(2),SSPAN3(1)),(FIN4(2),SSPAN4(1))
C
C  DEFINE FIN CHORDS
      EQUIVALENCE (FIN1(52),CHORDS1(1)),(FIN2(52),CHORDS2(1)),
     1            (FIN3(52),CHORDS3(1)),(FIN4(52),CHORDS4(1))
C
C  DEFINE YUPPER
      EQUIVALENCE (FIN1(263),YUPER1(1)),(FIN2(263),YUPER2(1)),
     1            (FIN3(263),YUPER3(1)),(FIN4(263),YUPER4(1))
C
C  DEFINE (FLAP CHORD/FIN CHORD)station i
      EQUIVALENCE (FIN1(390),CFOC1(1)),(FIN2(390),CFOC2(1)),
     1            (FIN3(390),CFOC3(1)),(FIN4(390),CFOC4(1))
C
C  DEFINE LIFT CURVE SLOPE VARIABLES
      EQUIVALENCE (F1WK(64),CNALF1),(F2WK(64),CNALF2),
     1            (F3WK(64),CNALF3),(F4WK(64),CNALF4)
C
C  DEFINE (t/c)eff VARIABLES
      EQUIVALENCE (GFIN1(176),TCEFF1),(GFIN2(176),TCEFF2),
     1            (GFIN3(176),TCEFF3),(GFIN4(176),TCEFF4)
C
C  DEFINE EFFECTIVE LEADING EDGE SWEEP ANGLE
      EQUIVALENCE (GFIN1(179),XLAM1),(GFIN2(179),XLAM2),
     1            (GFIN3(179),XLAM3),(GFIN4(179),XLAM4)
C
C  DEFINE EFFECTIVE TRAILING EDGE SWEEP ANGLE
      EQUIVALENCE (GFIN1(183),XLMTE1),(GFIN2(183),XLMTE2),
     1            (GFIN3(183),XLMTE3),(GFIN4(183),XLMTE4)
C      
C  DEFINE EFFECTIVE FULL FIN DEFLECTIONS
      DO 500 K=1,8
         DSYN1(K)=DEL1(K)
         DSYN2(K)=DEL2(K)
         DSYN3(K)=DEL3(K)
         DSYN4(K)=DEL4(K)
  500 CONTINUE
C
      NALP=NALPHA+.5
C      
      NM=NMACH+0.5
      IF(NM .LE. 0)NM=1
      DO 1000 I=1,6
         IFOUND(I)=0
 1000 CONTINUE
C      
C     SAVE ALPHA ARRAY FROM FIRST CASE IN ARRAY ALP1 TO BE USED IN
C          CONFIGURATION INCREMENTING
C      
      IF(ICASE .EQ. 1)NAP = NALPHA
      DO 1010 I=1,NALP
         IF(ICASE .EQ. 1)ALP1(I)=ALPHA(I)
 1010 CONTINUE
C      
C***  SET SURFACE ROUGHNESS FOR THE RUN
C      
      IF(ROUGH .LE. UNUSED)ROUGH=0.
      IF(RHR .GT. UNUSED .AND. ROUGH .LE. UNUSED)ROUGH=3.E-6*RHR
C      
C***  COMPUTE FLIGHT CONDITIONS
C      
      CALL FLTCDS
C      
C***  COMPUTE AIRFOIL SECTION AERODYNAMICS AT SUBSONIC/TRANSONIC SPEEDS
C      
      IF(MACH(1) .LE. 1.4)CALL ASECT
C      
      LBODY=LAXIS .OR. LELLB .OR. LARBOD
C      
C***  MAJOR MACH LOOP
C      
      DO 1100 IM=1,NM
C      
C***     INITIALIZE
C      
         CALL INZIOM
C      
C***     BODY ALONE
C      
         IF(LARBOD) PROTUB=.TRUE.
         LARBOD=.FALSE.
         IF(LBODY)CALL BODY(IM)
C      
C        STORE BODY THEORETICAL COEFFICIENTS IN AN ARRAY FOR POSSIBLE
C        USE IN CONFIGURATION INCREMENTING
C      
         DO 1020 I=1,20
            BBCN(I,5)=BCN(I)
            BBCM(I,5)=BCM(I)
            BBCA(I,5)=BCA(I)
            BBCY(I,5)=BCY(I)
            BBCSN(I,5)=BCLN(I)
            BBCSL(I,5)=BCLL(I)
 1020    CONTINUE
C      
C***     BODY ALONE EXPERIMENTAL DATA SUBSTITUTION
C      
         IF(LBODY)CALL SUBEXP(IFOUND,MACH(IM),1,CBODY)
C      
C        IF RUNNING BODY ALONE AND INCRMT CARD IS TRUE
C           CALL CONFIGURATION INCREMENTING
C      
C        SET BPHI TO GREATER THAN ZERO IF PHI OR BETA ARE INPUT
C        TO TRIP FLAGS IN CONFIGURATION INCREMENTING
         IF (PHI .NE. 0. .OR. BETA .NE. 0.)BPHI=1.
         IF(.NOT. LICRMT)GO TO 1030
         IF(LFIN1 .OR. LFIN2 .OR. LFIN3 .OR. LFIN4)GO TO 1030
C      
C        IF EXPERIMENTAL DATA HAS BEEN INPUT OR INCREMENTALS HAVE
C           BEEN CALCULATED FOR A COEFFICIENTS DO INCREMENTING
C      
         IF( IFOUND(1) .EQ. 1 .OR. COREC(2) .NE. UNUSED)
     1      CALL CNINC(ICASE,BBCN,1,CBODY,BPHI)
         IF(IFOUND(2) .EQ. 1 .OR. COREC(24) .NE. UNUSED)
     1      CALL CMINC(ICASE,BBCM,1,CBODY,BPHI)
         IF(IFOUND(3) .EQ. 1 .OR. COREC(45) .NE. UNUSED)
     1      CALL CAINC(ICASE,BBCA,1,CBODY)
         IF(IFOUND(4) .EQ. 1 .OR. COREC(66) .NE. UNUSED)
     1      CALL CYINC(ICASE,BBCY,BBCN,1,CBODY,BPHI)
         IF(IFOUND(5) .EQ. 1 .OR. COREC(88) .NE. UNUSED)
     1      CALL CSNINC(ICASE,BBCSN,BBCM,1,CBODY,BPHI)
         IF(IFOUND(6) .EQ. 1 .OR. COREC(109) .NE. UNUSED)
     1      CALL CSLINC(ICASE,BBCSL,1,CBODY)
C      
C        IF CY,CSN,CSL HAVE BEEN EXPERIMENTALY INPUT OR HAVE
C           INCREMENTED BLANK OUT THE LATERAL DIRECTIONAL
C           DERIVATIVES
C      
 1030    DO 1040 I=1,NALP
            IF(IFOUND(4) .EQ. 1 .OR. COREC(66) .NE. UNUSED)
     1        CBODY(I+160)=-UNUSED
            IF(IFOUND(5) .EQ. 1 .OR. COREC(88) .NE. UNUSED)
     1        CBODY(I+180)=-UNUSED
            IF(IFOUND(6) .EQ. 1 .OR. COREC(109) .NE. UNUSED)
     1        CBODY(I+200)=-UNUSED
 1040    CONTINUE
C      
C***     INLET INCREMENTS
C      
         IF(LINLET)CALL ILTARO(IM,BCN,BCM,BCA,BCY,BCLN,BCLL)
C
C        UPDATE BODY ALONE CNA AND/OR CMA
C      
         DO 1050 I=1,NALP
            CALL POLINT(ALPHA,BCN,NALP,ALPHA(I),CNFINT,BCNA(I))
            CALL POLINT(ALPHA,BCM,NALP,ALPHA(I),CMFINT,BCMA(I))
 1050    CONTINUE
C      
C***     FIN SET 1 ALONE
C      
         IF(LFIN1)CALL FINS(IM,1)
C      
C***     FIN ALONE EXPERIMENTAL DATA SUBSTITUTION
C      
         IF(LFIN1)CALL SUBEXP(IFOUND,MACH(IM),2,CFIN1)
C      
C***     FIN SET 2 ALONE
C      
         IF(LFIN2)CALL FINS(IM,2)
C      
C***     FIN ALONE EXPERIMENTAL DATA SUBSTITUTION
C      
         IF(LFIN2)CALL SUBEXP(IFOUND,MACH(IM),3,CFIN2)
C      
C***     FIN SET 3 ALONE
C      
         IF(LFIN3)CALL FINS(IM,3)
C      
C***     FIN ALONE EXPERIMENTAL DATA SUBSTITUTION
C      
         IF(LFIN3)CALL SUBEXP(IFOUND,MACH(IM),4,CFIN3)
C      
C***     FIN SET 4 ALONE
C      
         IF(LFIN4)CALL FINS(IM,4)
C      
C***     FIN ALONE EXPERIMENTAL DATA SUBSTITUTION
C      
         IF(LFIN4)CALL SUBEXP(IFOUND,MACH(IM),5,CFIN4)

C  FOR THOSE FINSETS EMPLOYING FLAPS COMPUTE THE EFFECTIVE FULL FIN 
C  DEFLECTIONS OF EACH PANEL
C
C  EFFECTIVE FULL FIN DEFLECTION FINSET 1
C
         IF(LFIN1.AND.(CFOC1(1).LT.1.))THEN
C  FIN1(112), NUMBER OF PANELS IN FINSET 1
            NF1=FIN1(112)
           DO 1051 KPANL=1,NF1
               IF(ABS(DSYN1(KPANL)) .GT. UNUSED)THEN
                 CALL FLAPS(MACH(IM),CFOC1,TCEFF1,DEL1(KPANL),
     1                    CHORDS1,XLAM1,XLMTE1,YUPER1,SSPAN1,
     2                    CNALP1,CAZRO1,SREF,DSYN1(KPANL),CLDEL)
                 CLD(1)=CLDEL
               ENDIF
 1051       CONTINUE
          ENDIF
C
C  EFFECTIVE FULL FIN DEFLECTION FINSET 2
C
         IF(LFIN2.AND.(CFOC2(1).LT.1.))THEN
C  FIN2(112), NUMBER OF PANELS IN FINSET 2
            NF2=FIN2(112)
           DO 1052 KPANL=1,NF2
               IF(ABS(DSYN2(KPANL)) .GT. UNUSED)THEN
                 CALL FLAPS(MACH(IM),CFOC2,TCEFF2,
     1               DEL2(KPANL),CHORDS2,XLAM2,XLMTE2,YUPER2,
     2               SSPAN2,CNALP2,CAZRO2,SREF,DSYN2(KPANL),CLDEL)
                 CLD(2)=CLDEL
               ENDIF
1052       CONTINUE
          ENDIF
C
C  EFFECTIVE FULL FIN DEFLECTION FINSET 3
C
         IF(LFIN3.AND.(CFOC3(1).LT.1.))THEN
C  FIN3(112), NUMBER OF PANELS IN FINSET 3
            NF3=FIN3(112)
           DO 1053 KPANL=1,NF3
               IF(ABS(DSYN3(KPANL)) .GT. UNUSED)THEN
                 CALL FLAPS(MACH(IM),CFOC3,TCEFF3,
     1                 DEL3(KPANL),CHORDS3,XLAM3,XLMTE3,YUPER3,
     2                 SSPAN3,CNALP3,CAZRO3,SREF,DSYN3(KPANL),CLDEL)
                 CLD(3)=CLDEL
               ENDIF
 1053       CONTINUE
          ENDIF
C
C  EFFECTIVE FULL FIN DEFLECTION FINSET 4
C
         IF(LFIN4.AND.(CFOC4(1).LT.1.))THEN
C  FIN4(112), NUMBER OF PANELS IN FINSET 4
            NF4=FIN4(112)
           DO 1054 KPANL=1,NF4
               IF(ABS(DSYN4(KPANL)) .GT. UNUSED)THEN
                      CALL FLAPS(MACH(IM),CFOC4,TCEFF4,
     1                 DEL4(KPANL),CHORDS4,XLAM4,XLMTE4,YUPER4,
     2                 SSPAN4,CNALP4,CAZRO4,SREF,DSYN4(KPANL),CLDEL)
                 CLD(4)=CLDEL
               ENDIF
 1054       CONTINUE
          ENDIF
C      
C***     DESIRE TRIM
C      
         IF(.NOT. LTRIM)GO TO 1060
C      
         TTRIM=LBODY .AND. (LFIN1 .OR. LFIN2 .OR. LFIN3 .OR. LFIN4)
         IF(.NOT. TTRIM)GO TO 1060
C      
         CALL TRIMIT(IM,TOTC)
C      
         GO TO 1090
C      
 1060    CONTINUE
C      

C***     BODY-FIN 1 THROUGH FIN 4 SYNTHESIS
C***     AND COMPUTE BETA DERIVATIVES
C      
         IF(LBODY .AND. (LFIN1 .OR. LFIN2 .OR. LFIN3 .OR. LFIN4))
     1     CALL BETADR(IM,TOTC)
C
C***     COMPUTE DYNAMIC DERIVATIVES IF DAMP IS INPUT
C
         IF(LDAMP) CALL DAMP2(IM,TOTC)
C     
C***     CHANGE ZCG FOR BODY AND FINS
C
         IF(ABS(ZCG) .LE. UNUSED)GO TO 1080
C     
         DO 1070 I=1,NALP
           IF(LFIN1.OR.LFIN2.OR.LFIN3.OR.LFIN4)THEN
               CALL ADDZCG(ZCG,LREF,F1CA(I),F1CM(I))
               CALL ADDZCG(ZCG,LATREF,F1CY(I),F1CLL(I))
               CALL ADDZCG(ZCG,LREF,F2CA(I),F2CM(I))
               CALL ADDZCG(ZCG,LATREF,F2CY(I),F2CLL(I))
               CALL ADDZCG(ZCG,LREF,F3CA(I),F3CM(I))
               CALL ADDZCG(ZCG,LATREF,F3CY(I),F3CLL(I))
               CALL ADDZCG(ZCG,LREF,F4CA(I),F4CM(I))
               CALL ADDZCG(ZCG,LATREF,F4CY(I),F4CLL(I))
           ELSE
C
C   REV 3/99 CORRECTION FOR BODY ALONE ADDED
C     
               CALL ADDZCG(ZCG,LREF,BCA(I),BCM(I))
               CALL ADDZCG(ZCG,LATREF,BCY(I),BCLL(I))
           ENDIF
C
 1070    CONTINUE
C      
 1080    CONTINUE
C      
C***     PRINT RESULTS
C      
C ... DUMP INTERNAL ARRAYS IF REQUIRED
C      
         CALL DUMPRT
C      
C ...  PRINT OUTPUTS
C      
         CALL PRINT(IM)
C      
 1090    CONTINUE
C      
 1100 CONTINUE
C      
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDXCPB(LTOTAL,LAFT,VOLAFT,DAFT,SMAX,XCPB)
C
C***  SUBROUTINE TO LOCATE THE AFT BODY CENTER OF PRESSURE
C***  SLENDER-BODY THEORY METHOD (REFERENCE NSWC-TR-80-346, P.41)
C
C***  INPUTS
C
C LTOTAL -- OVERALL BODY LENGTH, FEET
C   LAFT -- AFT BODY LENGTH, FEET
C VOLAFT -- AFT BODY VOLUME, FEET CUBED
C   DAFT -- BASE DIAMETER OF AFTERBODY, FEET
C   SMAX -- MAXIMUM CROSS SECTIONAL AREA OF AFTERBODY, FEET SQUARED
C
C***  OUTPUT
C
C   XCPB -- AFT CENTER OF PRESSURE FROM BODY NOSE, CALIBERS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL LTOTAL,LAFT
C
      DREF=SQRT(4.*SMAX/PI)
C
      XCPB=LTOTAL/DREF
C
      IF(DREF .EQ. DAFT)GO TO 1000
C
      XCPB=XCPB-(LAFT*SMAX-VOLAFT)/(DREF*(SMAX-PI*DAFT**2/4.))
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CMINC(ICASE,CMS,ICON,DUMMY,PHI)
C      
C         SUBROUTINE TO CALCULATE CM INCREMENTALS AND TO COMPUTE
C      NEW CM VALUES WITH THOSE INCREMENTALS.  IF AERODYNAMIC ROLL
C      ANGLE IS ZERO, THERE ARE CORRECTION TERMS COMPUTED FOR THE 
C      POTENTIAL AND VISCOUS TERMS.  IF AERODYNAMIC ROLL ANGLE IS 
C      NOT ZERO, A TABLE OF MULTIPLIERS IS USED AS THE CORRECTION
C      FACTOR.
C      
C***  INPUTS
C      
C     ICASE = RUN CASE NUMBER
C     CMS   = ARRAY FROM SYNTHS CONTAINING CONFIGURATION CM VALUES
C     DUMMY = ARRAY THAT CONTAINS EXPERIMENTAL COEFFICIENTS AND WILL
C             CONTAIN UPDATED COEFFICIENTS CM = DUMMY 21-40
C     ICON  = CONFIGURATION TO BE INCREMETED
C             ICON = 1    BODY
C             ICON = 2    BODY + 1 FIN SET
C             ICON = 3    BODY + 2 FIN SETS
C             ICON = 4    BODY + 3 FIN SETS
C             ICON = 5    BODY + 4 FIN SETS
C     PHI   = BODY AXIS AERODYNAMIC ROLL ANGLE
C      
C***  OUTPUT
C      
C     CM = UPDATED CM VALUES EQUIVALENT TO DUMMY 21-40
C          NOTE: ON THE FIRST TIME THROUGH DUMMY COMES IN WITH THE 
C                EXPERIMENTAL VALUES AND LEAVES WITH INCREMENTED VALUES
C      
      COMMON /FLC   / NA,ALPHA(20),FLDUM(123)
      COMMON /INC   / DUM(22),C1,C2(20),DCM0,DIP(84),ZIP,ALP(20),NAP
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      DIMENSION CM(20),CMEXP(20),CMTH(20),CMATH(20),Z(20),
     1          CMPTH(20),CMVTH(20),CMPEXP(20),DUMMY(120),CMS(20,5)
      REAL NA,NAP
C
C **  INITIALIZE WORKING ARRAYS
C      
      DO 1000 I=1,20
         CM(I)=UNUSED
         CMEXP(I)=UNUSED
         CMPTH(I)=UNUSED
         CMVTH(I)=UNUSED
         CMTH(I)=UNUSED
         CMPEXP(I)=UNUSED
 1000 CONTINUE
C      
      NAP1= NAP + .5
      NALPHA = NA + .5
C      
C       USE APPROPRIATE IOM COMMON BLOCK TO FILL THE WORKING ARRAYS
C      
      DO 1010 I=1,NALPHA
         IF(ICON .EQ. 1)CMTH(I)=CMS(I,5)
         IF(ICON .GT. 1)CMTH(I)=CMS(I,ICON-1)
 1010 CONTINUE
C
C     ZIP=0  FIRST TIME THROUGH FROM BETADR SO PHI IS AS INPUT
C     ZIP=1 SECOND TIME THROUGH FROM BETADR SO PHI HAS BEEN INCREASED BY 1
C
      IF(ZIP .EQ. 0. .AND. PHI .NE. 0.)GO TO 1030
C      
C    COMPUTE THEORETICAL CMA
C      
      CALL CALIB(4,NALPHA,ALPHA,CMEXP,NALPHA,ALPHA,CMTH,SLOPE)
      CMATH(1)=SLOPE*RAD
 1030 IF(ICASE .NE. 1 .OR. ZIP .EQ. 1)GO TO 1070
C
C     FOR FIRST CASE FIRST TIME TROUGH PUT EXPERIMENTAL VALUES FROM DUMMY
C        INTO WORKING ARRAY
C
      DO 1040 I=1,NALPHA
         CMEXP(I)= DUMMY(I+20)
 1040 CONTINUE
      IF(PHI .NE. 0.)GO TO 1110
C      
C       DETERMINE THE DIFFERENCE BETWEEN CM EXPERIMENTAL AND CM
C          THEORETICAL AT ALPHA = 0
C      
      CALL LNTRP(ALPHA,CMEXP,NALPHA,0.,CMEXP0)
      CALL LNTRP(ALPHA,CMTH,NALPHA,0.,CMTH0)
      DCM0= CMEXP0 - CMTH0
C
C     SUBTRACT DCM0 FROM THE EXPERIMENTAL CM TO BRING DOWN TO CM 
C          THEORETICAL CURVE (WILL BE ADDED IN AT END)
C
      DO 1060 I=1,NALPHA
         CMEXP(I) = CMEXP(I) - DCM0
 1060 CONTINUE
C      
C***  USE CALIB TO DETERMINE THE POTENTIAL INCREMENTAL C1, A SCALAR 
C          MULTIPLIER AT ALPHA=0 
C      
       CALL CALIB(-3,NALPHA,ALPHA,CMEXP,NALPHA,ALPHA,CMTH,Z)
       C1=Z(1)
C      
C      CALCULATE THE THEORETICAL POTENTIAL CM AND VISCOUS CM FROM TOTAL CM
C      
 1070 IF(PHI .NE. 0.)GO TO 1120
      DO 1080 I=1,NALPHA
         CMPTH(I)=.5*CMATH(1)*SIN(2.*ALPHA(I))*COS(ALPHA(I)/2.)
         CMVTH(I)=CMTH(I) - CMPTH(I)
 1080 CONTINUE
C      
C        USE THE INCREMENTAL FACTOR C1 TO DETERMINE THE CORRECTED
C          POTENTIAL CM WHICH IS THE EXPERIMENTAL CM POTENTIAL
C      
      DO 1090 I=1,NALPHA
         CMPEXP(I)=C1*CMPTH(I)
 1090 CONTINUE
C
C*    ONLY ON FIRST CASE AND FIRST TIME THROUGH IS CM VISCOUS NEEDED
C       TO DETERMINE VISCOUS CORRECTION TERMS
C
      IF (ICASE .NE. 1 .OR. ZIP .EQ. 1)GO TO 1140
C      
C***  DETERMINE THE VISCOUS INCREMENTAL BY TAKING THE RATIO OF
C       EXPERIMENTAL CM VISCOUS TO THEROTICAL CM VISCOUS
C      
      DO 1100 I=1,NALPHA
         IF(CMVTH(I) .EQ. 0.)C2(I)=1.
         IF(CMVTH(I) .EQ. 0.)GO TO 1100
         C2(I)=(CMEXP(I) - CMPEXP(I))/ CMVTH(I)
 1100 CONTINUE
      GO TO 1140
C
C***  HERE FOR AERODYNAMIC ROLL ANGLE NOT ZERO
C     USE CALIB TO DETERMINE A TABLE OF MULTIPLIERS
C
 1110 CALL CALIB(2,NALPHA,ALPHA,CMEXP,NALPHA,ALPHA,CMTH,C2)
C
C***  USE TABLE OF MULTIPLIERS DETERMINED AT FIRST CASE ALPHA'S TO 
C     INCREMENT CM AT ALPHA OF INTEREST
C
 1120 DO 1130 I=1,NALPHA
         CALL LNTRP(ALP,C2,NAP1,ALPHA(I),C2I)
         CM(I)=CMTH(I)*C2I
 1130 CONTINUE
      GO TO 1160
C      
C       COMPUTE THE INCREMENTED CM FOR AERODYNAMIC ROLL = 0
C      
 1140 DO 1150 I=1,NALPHA
         CALL LNTRP(ALP,C2,NAP1,ALPHA(I),C2I)
         CM(I)=CMPEXP(I) + C2I*CMVTH(I) + DCM0
 1150 CONTINUE
C
C**   PUT INCREMENTED CM INTO ARRAY DUMMY
C
 1160 DO 1170 I=1,NALPHA
         DUMMY(I+20)=CM(I)
 1170 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CYPTWO(BETAI,CYI,CYIXCP)
C***********************************************************************
C
C     THIS SUBROUTINE CALCULATES INLET NORMAL FORCE COEFFICIENT AND
C     CENTER OF PRESSURE FOR A TWO DIMENSIONAL INLET IN THE INLET
C     COORDINATE SYSTEM.  THIS SUBROUTINE CALCULATES AERODYNAMICS FOR
C     ONE SET OF FLIGHT CONDITIONS.
C
C***********************************************************************
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      DIMENSION DCYB(4),DCY(4),DCLN(4),CYB(5)
      DIMENSION BETAI(20),CYI(20),CLNI(20),CYIXCP(20)
C
      NUMI=NIN+0.5
      DO 10 J=1,NUMI
        DO 20 I=1,5
          A=HI(I)
          B=WI(I)
C
C***      CALCULATE CY-BETA AT CROSS SECTION
          IF (A*B.EQ.0.0) THEN
            CYB(I)=0.0
          ELSE
            CYB(I)=(PI/1.8*A/B+2./PI)*A*B/SREF
          ENDIF
   20   CONTINUE
C
C***    FIND FORCES AND MOMENTS FOR EACH SECTION
        CYI(J)=0.0
        CLNI(J)=0.0
        DO 30 I=1,4
C
C***      CY-BETA OF SECTION
          DCYB(I)=CYB(I+1)-CYB(I)
C
C***      DON'T INCLUDE BOATTAIL SECTION IN CY-BETA CALCULATIONS
          IF (DCYB(I).LT.0.0) DCYB(I)=0.0
C
C***      CY OF SECTION
          DCY(I)=-DCYB(I)*(BETAI(J)/RAD)
C
C***      INCREMENT INLET CY
          CYI(J)=CYI(J)+DCY(I)
C
C***      CALCULATE SECTION CENTER OF PRESSURE
          XCP=XI(I)+1./3.*LENGTH(I)*(2.*HI(I+1)+HI(I))/(HI(I+1)+HI(I))
C
C***      SECTION CLN
          DCLN(I)=-DCY(I)*XCP/BREF
C
C***      INCREMENT INLET CLN
          CLNI(J)=CLNI(J)+DCLN(I)
   30   CONTINUE
C
C***    CALCULATE INLET CENTER OF PRESSURE
        IF (ABS(CYI(J)).LT.0.00001) THEN
          CYIXCP(J)=0.0
        ELSE
          CYIXCP(J)=ABS(CLNI(J)*BREF/CYI(J))
        ENDIF
   10 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FAPART(IM,NSET,NFINS,CAF,CAPR,CAWT,CAWS,CALE,
     1 CATE,CAO,CANL,CATOT)
C
C***  WRITE PARTIAL OUTPUT FOR FIN AXIAL FORCE
C
C   INPUTS
C
C     IM - CURRENT MACH NUMBER INDEX
C   NSET - FIN SET NUMBER
C  NFINS - NUMBER OF FINS IN THE FIN SET
C    CAF - SKIN FRICTION INCREMENT (1 FIN)
C   CAPR - SUBSONIC PRESSURE DRAG INCREMENT (1 FIN)
C   CAWT - TRANSONIC WAVE DRAG INCREMENT (1 FIN)
C   CAWS - SUPERSONIC WAVE DRAG INCREMENT (1 FIN)
C   CALE - LEADING EDGE DRAG INCREMENT (1 FIN)
C   CATE - TRAILING EDGE DRAG INCREMENT (1 FIN)
C    CAO - TOTAL ZERO-LIFT DRAG COEFFICIENT (1 FIN)
C   CANL - NON-LINEAR VARIATION OF CA (1 FIN)
C  CATOT - TOTAL FIN SET AXIAL FORCE COEFFICIENT (N FINS)
C
      COMMON /FLC/  NALPHA,ALPHA(20),FLDUM(123)
C
      REAL NALPHA
C
      LOGICAL NDUM,NMF,NAF
C
      DIMENSION CANL(20),CATOT(20)
C
      CALL HEADR9
      WRITE(6,1010)NSET
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      WRITE(6,1020)
      WRITE(6,1030)CAF
      WRITE(6,1040)CAPR
      WRITE(6,1050)CAWT
      WRITE(6,1060)CAWS
      WRITE(6,1070)CALE
      WRITE(6,1080)CATE
      WRITE(6,1090)CAO
      WRITE(6,1100)
      WRITE(6,1110)NFINS
      NALP=NALPHA+0.5
      DO 1000 I=1,NALP
         WRITE(6,1120)ALPHA(I),CANL(I),CATOT(I)
 1000 CONTINUE
C
 1010 FORMAT(24X,'FIN SET',I2, ' CA PARTIAL OUTPUT',/)
 1020 FORMAT(4X,'SINGLE FIN PANEL ZERO-LIFT AXIAL FORCE COMPONENTS',/)
 1030 FORMAT(4X,'SKIN FRICTION     ',F9.4)
 1040 FORMAT(4X,'SUBSONIC PRESSURE ',F9.4)
 1050 FORMAT(4X,'TRANSONIC WAVE    ',F9.4)
 1060 FORMAT(4X,'SUPERSONIC WAVE   ',F9.4)
 1070 FORMAT(4X,'LEADING EDGE      ',F9.4)
 1080 FORMAT(4X,'TRAILING EDGE     ',F9.4)
 1090 FORMAT(4X,'TOTAL CAO         ',F9.4,/)
 1100 FORMAT(4X,'FIN AXIAL FORCE DUE TO ANGLE OF ATTACK',/)
 1110 FORMAT(4X,'ALPHA',6X,'CA DUE TO LIFT (SINGLE PANEL)',3X,
     1 'CA-TOTAL (',I1,' FINS)',/)
 1120 FORMAT(4X,F7.2,11X,F9.4,19X,F9.4)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FLAP2(CFOC,TANPHE,ADEL)
C
C  THIS ROUTINE CALCULATES THE TWO-DIMENSIONAL FLAP 
C  EFFECTIVENESS OF A PLAIN TRAILING EDGE FLAP
C
C  WRITTEN BY W. BLAKE, WL/FIGC
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      DIMENSION XTAB(6),CTAB(16),YTAB(96)
C
C                   FIGURE 6.1.1.1-39B
C
      DATA XTAB
     1  / 0.05,  0.10,  0.15,  0.20,  0.25,  0.50 /
      DATA CTAB
     1  / 0.70,  0.72,  0.74,  0.76,  0.78,  0.80,  0.82,  0.84,  0.86,
     2    0.88,  0.90,  0.92,  0.94,  0.96,  0.98,  1.00 /
      DATA YTAB
     1 /  .356,    .382,    .409,    .431,    .452,    .548,
     2    .399,    .426,    .452,    .477,    .498,    .583,
     3    .442,    .471,    .499,    .523,    .543,    .619,
     4    .485,    .521,    .548,    .569,    .589,    .659,
     5    .530,    .569,    .594,    .613,    .630,    .693,
     6    .578,    .614,    .639,    .657,    .671,    .729,
     7    .619,    .655,    .678,    .692,    .709,    .761,
     8    .659,    .696,    .713,    .733,    .746,    .793,
     9    .700,    .734,    .750,    .765,    .778,    .819,
     A    .742,    .771,    .789,    .800,    .810,    .850,
     B    .784,    .809,    .824,    .838,    .843,    .875,
     C    .826,    .843,    .860,    .865,    .873,    .900,
     D    .865,    .885,    .895,    .900,    .903,    .921,
     E    .910,    .921,    .928,    .931,    .933,    .938,
     F    .951,    .962,    .964,    .966,    .967,    .968,
     G   1.000,   1.000,   1.000,   1.000,   1.000,   1.000/
C
C  THEORETICAL 2-D EFFECTIVENESS - DATCOM FIG. 6.1.4.1-14 (INSET)
C
      ADELT=(ACOS(2.*CFOC-1.)-SQRT(1.-(2.*CFOC-1.)**2))/PI - 1.
C
C  EMPIRICAL CORRECTION - DATCOM FIG. 6.1.1.1-39B
C
      CLARAT=.9-.15/.14*TANPHE
      CALL MVLOOK(1,16,6,96,1,CTAB,XTAB,YTAB,CFOC,CLARAT,1,ANS)
      ADEL=ADELT*ANS
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE IADAXI(MACH,DELTA,L,R,MFR,SREF,CXADD,MFRM)
C 
C  THIS ROUTINE CALCULATES THE ADDITIVE DRAG FOR AXISYMMETRIC 
C  INLETS OPERATING AT OFF DESIGN CONDITIONS
C
C  WRITTEN BY W. BLAKE, WL/FIGC
C 
C  METHOD TAKEN FROM NEAR TR 396, VOL II
C 
C  INPUTS:  
C      MACH  - FREE-STREAM MACH NUMBER
C      DELTA - INLET CONE HALF ANGLE
C      L     - LENGTH FROM CONE APEX TO INLET LIP 
C      R     - RADIUS OF INLET AT LIP 
C      MFR   - INLET MASS FLOW RATIO
C      SREF  - REFERENCE AREA 
C 
C  OUTPUT:  
C      CXADD - ADDITIVE DRAG AT REFERENCE CONDITION 
C 
C  INTERMEDIATE RESULTS:  
C      CXSTG - ADDITIVE DRAG AT FULLY BLOCKED CONDITIONS (MFR=0)
C      MFRM  - MAXIMUM MASS FLOW RATIO POSSIBLE AT SPECIFIED CONDITION
C      CXBLK - ADDITIVE DRAG AT MFR = MFRM
C 
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      DIMENSION TGR(7), TCU(4), TX(5)
      DIMENSION CXS(140), MFM(140), CXB(140)
      REAL L,LR,MACH,MFR,MFRM,MFM 
C 
      DATA TGR / 1.0, 1.25, 1.5, 2.0, 3.0, 4.0, 5.0 / 
      DATA TCU / 1., 2., 3., 4. /
      DATA TX  / 6., 10., 14., 18., 22. /
C 
C  THE DATA ARE STACKED AS FOLLOWS: 
C 
C  MACH = 1.0 ARE LINES A & B,   MACH =1.25 ARE LINES C & D 
C  MACH = 1.5 ARE LINES E & F,   MACH = 2.0 ARE LINES G & H 
C  MACH = 3.0 ARE LINES I & J,   MACH = 4.0 ARE LINES K & L 
C  MACH = 5.0 ARE LINES M & N 
C 
C  FOR EACH MACH NUMBER, THERE ARE 4 CURVES CORRESPONDING TO THE
C  4 INLET LENGTHS.  THE INLET LENGTHS ARE 1,2,3 AND 4. 
C  FOR EACH LENGTH, THERE ARE 5 POINTS CORRESPONDING TO THE CONE
C  HALF ANGLES.  THE HALF ANGLES ARE 6,10,14,18, AND 22 DEG 
C 
C  CXBLK TABLES 
      DATA CXB /
     A  0.108,0.115,0.246,0.439,0.694,0.358,0.380,0.707,1.096,1.527,
     B  0.563,0.588,0.926,1.368,1.422,0.604,0.616,0.997,0.997,0.997,
     C  0.006,0.023,0.065,0.177,0.512,0.062,0.179,0.383,0.714,1.298,
     D  0.125,0.321,0.590,0.990,1.043,0.172,0.382,0.679,0.679,0.679,
     E  0.0  ,0.0  ,0.0  ,0.020,0.113,0.032,0.100,0.240,0.489,0.872,
     F  0.081,0.226,0.457,0.809,0.859,0.122,0.299,0.572,0.572,0.572,
     G  0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.005,0.023,0.089,0.264,0.608,
     H  0.037,0.126,0.319,0.655,0.702,0.072,0.212,0.468,0.468,0.468,
     I  0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.002,0.002,0.002,0.041,0.338,
     J  0.003,0.032,0.174,0.527,0.580,0.025,0.120,0.377,0.377,0.377,
     K  0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.176,
     L  0.0  ,0.0  ,0.095,0.469,0.0  ,0.005,0.071,0.336,0.336,0.336,
     M  0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.0  ,0.074,
     N  0.0  ,0.0  ,0.041,0.436,0.500,0.0  ,0.042,0.313,0.316,0.316/
C 
C  MFRM TABLES
      DATA MFM /
     A  .970, .968, .931, .875, .798, .882, .874, .741, .556, .320, 
     B  .735, .718, .432, .047, 0.0 , .531, .500, .005, 0.0 , 0.0 , 
     C  .997, .991, .975, .935, .837, .968, .904, .789, .604, .338, 
     D  .914, .747, .463, .052, 0.0 , .837, .522, .006, 0.0 , 0.0 , 
     E  1.0 , 1.0 , 1.0 , .990, .950, .978, .930, .833, .661, .397, 
     F  .927, .713, .493, .057, 0.0 , .850, .542, .006, 0.0 , 0.0 , 
     G  1.0 , 1.0 , 1.0 , 1.0 , 1.0 , .995, .977, .914, .763, .479, 
     H  .951, .828, .553, .066, 0.0 , .876, .585, .007, 0.0 , 0.0 , 
     I  1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , .998, .951, .641, 
     J  .993, .934, .677, .085, 0.0 , .932, .678, .008, 0.0 , 0.0 , 
     K  1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , .792, 
     L  1.0 , 1.0 , .794, .102, 0.0 , .982, .769, .010, 0.0 , 0.0 , 
     M  1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , 1.0 , .908, 
     N  1.0 , 1.0 , .902, .117, 0.0 , 1.0 , .848, .011, 0.0 , 0.0 / 
C 
C  CXSTAG TABLES
      DATA CXS /
     A  3.911,3.906,3.804,3.661,3.473,3.624,3.600,3.193,2.623,1.868,
     B  3.146,3.090,2.174,0.894,0.894,2.475,2.377,0.748,0.748,0.748,
     C  4.424,4.347,4.244,4.131,4.076,4.283,3.973,3.561,3.110,2.891,
     D  4.047,3.349,2.423,1.408,1.408,3.716,2.476,0.831,0.831,0.831,
     E  4.522,4.522,4.522,4.412,4.264,4.608,4.264,3.784,3.211,2.615,
     F  4.352,3.578,2.498,1.207,1.207,3.993,2.617,0.696,0.696,0.696,
     G  5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,4.983,4.600,4.054,3.373,2.589,
     H  4.703,3.842,2.614,1.082,1.082,4.311,2.780,0.598,0.598,0.598,
     I  5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,3.500,2.603,
     J  4.979,4.050,2.703,0.978,0.978,4.562,2.910,0.515,0.515,0.515,
     K  5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,3.500,2.609,
     L  5.0  ,4.050,2.733,0.953,0.953,4.653,2.954,0.483,0.483,0.483,
     M  5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,5.0  ,3.500,2.608,
     N  5.0  ,4.050,2.743,0.926,0.926,3.762,2.973,0.457,0.457,0.457/
C 
      LR=L/R
C 
C  CALCULATE CXSTG
      CALL MVLOOK(7,4,5,140,TGR,TCU,TX,CXS,DELTA,LR,MACH,CXSTG) 
C 
C  CALCULATE MFRM 
      CALL MVLOOK(7,4,5,140,TGR,TCU,TX,MFM,DELTA,LR,MACH,MFRM)
C 
C  CALCULATE CXBLK
      CALL MVLOOK(7,4,5,140,TGR,TCU,TX,CXB,DELTA,LR,MACH,CXBLK) 
C 
C  CALCULATE CXADD
      CXSTG=CXSTG/PI
      CXBLK=CXBLK/PI
      CXADD=(1.-MFR/MFRM)*(CXSTG-CXBLK)+CXBLK 
      IF(CXADD.LT.0.) CXADD=0.
C
      SCOR=PI*R**2/SREF 
      CXADD=CXADD*SCOR
      RETURN
      END 
c *************************************
c *************************************
c *************************************
      SUBROUTINE LVALUE(KOL,L,NDML,NF,BLANK,COMMA,NUMBER)
C
C***  SUBROUTINE TO TEST FOR LOGICAL VARIABLES AND SYNTAX
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      DIMENSION KOL(80), NUMBER(15), TRUE(6), FALSE(7)
      LOGICAL STAR, NMTEST
C
      CHARACTER*4 TRUE,FALSE,KOL,BLANK,COMMA,NUMBER,KAND
C
      DATA TRUE  / '.   ','T   ','R   ','U   ','E   ','.   '/
      DATA FALSE / '.   ','F   ','A   ','L   ','S   ','E   ','.   '/
C
 1000 CONTINUE
      MULT = 0
      STAR = .FALSE.
      IF(L .GE. 81) GO TO 1080
      IF(KOL(L) .NE. BLANK) GO TO 1010
        L = L+1
        GO TO 1000
 1010 CONTINUE
C
C***  TEST FOR MULTIPLICATION FACTOR
C
      DO 1020 J=1,14
        IF(J .GE. 11 .AND. J .LE. 13) GO TO 1020
        IF(KOL(L) .EQ. NUMBER(J)) GO TO 1030
        IF(L .GE. 80) GO TO 1040
 1020 CONTINUE
      GO TO 1040
 1030 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 1010
 1040 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
C
C***  TEST FOR LOGICAL CONSTANTS
C
      NCHR = 6
      IF(NMTEST(KOL(L),TRUE,NCHR))  GO TO 1050
      NCHR = 7
      IF(NMTEST(KOL(L),FALSE,NCHR)) GO TO 1050
      GO TO 1080
 1050 CONTINUE
      L = L+NCHR
 1060 CONTINUE
      IF(L .GE. 80) GO TO 1070
      IF(KOL(L) .NE. BLANK) GO TO 1070
        NF = NF+1
        L = L+1
        GO TO 1060
 1070 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 1000
C
C***  END OF CARD OR NON-LOGICAL VARIABLE FOUND
C
 1080 CONTINUE
      IF(NDML .EQ. 0) NF = NF+1
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PRIF4
C
C***  SUBROUTINE TO PRINT THE RESULTS FOR FIN SET 4
C
      COMMON /FSET4/  FDATA(399)
C
      COMMON /GEOFS4/ GFIN(188)
C
      DIMENSION SSPAN(10),LMAXU(10),LFLATU(10),LMAXL(10),
     1          LFLATL(10),CHORD(10),THICKU(10),THICKL(10),
     2          SWEEP(10),STA(10),XLE(10),
     3          XCORD(50),MEAN(50),THICK(50),YUPPER(50),
     4          YLOWER(50),LER(10)
C
      REAL LER,LMAXU,LMAXL,LFLATU,LFLATL,NPANEL,MEAN
C
      EQUIVALENCE (FDATA(1),SECTYP),(FDATA(2),SSPAN(1)),
     1            (FDATA(12),LMAXU(1)),(FDATA(22),LFLATU(1)),
     2            (FDATA(32),LMAXL(1)),(FDATA(42),LFLATL(1)),
     3            (FDATA(52),CHORD(1)),(FDATA(62),THICKU(1)),
     4            (FDATA(72),THICKL(1)),(FDATA(82),SWEEP(1)),
     5            (FDATA(92),STA(1)),(FDATA(102),XLE(1)),
     6            (FDATA(112),NPANEL),(FDATA(113),XCORD(1)),
     7            (FDATA(163),MEAN(1)),(FDATA(213),THICK(1)),
     8            (FDATA(263),YUPPER(1)),(FDATA(313),YLOWER(1)),
     9            (FDATA(363),FINPHI),(FDATA(364),LER(1))
C
      DIMENSION SPLANF(10),CBAR(10),SWEPLE(10),SWEP25(10),
     1          SWEP50(10),SWEP75(10),SWEPTE(10),
     2          XMGCLE(10),XMGC25(10),
     3          XMGC50(10),XMGC75(10),XMGCTE(10),YMEANC(10),
     4          ASPCT(10),TAPER(10),TOVERC(10),XCENT(10)
C
      EQUIVALENCE (GFIN(1),SPLANF(1)),(GFIN(11),CBAR(1)),
     1            (GFIN(21),SWEPLE(1)),(GFIN(31),SWEP25(1)),
     2            (GFIN(41),SWEP50(1)),(GFIN(51),SWEP75(1)),
     3            (GFIN(61),SWEPTE(1)),(GFIN(71),XMGCLE(1)),
     4            (GFIN(81),XMGC25(1)),(GFIN(91),XMGC50(1)),
     5            (GFIN(101),XMGC75(1)),(GFIN(111),XMGCTE(1)),
     6            (GFIN(121),YMEANC(1)),(GFIN(131),ASPCT(1)),
     7            (GFIN(141),TAPER(1)),(GFIN(151),TOVERC(1)),
     8            (GFIN(161),XCENT(1)),(GFIN(171),FINAR),
     9            (GFIN(172),FINTPR),(GFIN(173),FINSPN),
     A            (GFIN(174),FINSP),(GFIN(175),FINWET),
     B            (GFIN(176),TCEFF),(GFIN(177),FINXGC),
     C            (GFIN(178),FINYGC),(GFIN(179),SWAVLE),
     D            (GFIN(180),SWAV25),(GFIN(181),SWAV50),
     E            (GFIN(182),SWAV75),(GFIN(183),SWAVTE),
     F            (GFIN(184),FINCBR),(GFIN(185),DELTAY),
     G            (GFIN(186),DELTAD),(GFIN(187),XCENF),(GFIN(188),XOVC)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      CHARACTER*4 IFT,ICM,IM,IIN,IUNIT
C
      DATA IFT/'  FT'/
      DATA ICM/'  CM'/
      DATA IM /'   M'/
      DATA IIN/'  IN'/
C
      IUNIT=IFT
      IF(LDIMCM)IUNIT=ICM
      IF(LDIMM)IUNIT=IM
      IF(LDIMIN)IUNIT=IIN
C
      ISET=4
C
      WRITE(6,1030)ISET
      WRITE(6,1040)
      WRITE(6,1050)
      WRITE(6,1060)
      IF(LDIMFT) WRITE(6,1082) IUNIT
      IF(LDIMIN) WRITE(6,1084)
      IF(LDIMM)  WRITE(6,1086)
      IF(LDIMCM) WRITE(6,1088)
C
      NSEG=1
C
C***  FIND LAST SPAN STATION
C
      DO 1000 I=2,10
          IF(SSPAN(I) .EQ. UNUSED .OR. SSPAN(I) .EQ. 0.)GO TO 1010
          NSEG=I-1
 1000 CONTINUE
C
 1010 CONTINUE
C
C***  PRINT RESULTS FOR EACH FIN SEGMENT
C
      DO 1020 ISEG=1,NSEG
         WRITE(6,1090)ISEG,SPLANF(ISEG),ASPCT(ISEG),TAPER(ISEG),
     1   SWEPLE(ISEG),SWEPTE(ISEG),CBAR(ISEG),TOVERC(ISEG)
 1020 CONTINUE
C
      WRITE(6,1100)FINSP,FINAR,FINTPR,SWAVLE,SWAVTE,FINCBR,TCEFF
C
 1030 FORMAT(29X,'FIN SET NUMBER ',I2)
 1040 FORMAT(26X,'(DATA FOR ONE PANEL ONLY)',/)
 1050 FORMAT(4X,'SEGMENT',3X,'PLAN',8X,'ASPECT',4X,'TAPER',5X,
     1 'L.E.',5X,'T.E.',4X,'M.A.C.',4X,'T/C')
 1060 FORMAT(4X,'NUMBER',4X,'AREA',8X,'RATIO',5X,'RATIO',4X,'SWEEP',
     1 4X,'SWEEP',4X,'CHORD',4X,'RATIO')
 1082 FORMAT(4X,A4,6X,'FT**2',27X,'DEG',6X,'DEG',7X,'FT')
 1084 FORMAT(4X,A4,6X,'IN**2',27X,'DEG',6X,'DEG',7X,'IN')
 1086 FORMAT(4X,A4,6X,' M**2',27X,'DEG',6X,'DEG',7X,' M')
 1088 FORMAT(4X,A4,6X,'CM**2',27X,'DEG',6X,'DEG',7X,'CM')
 1090 FORMAT(4X,1X,I2,2X,F10.4,4X,6F9.3)
 1100 FORMAT(4X, 'TOTAL',F10.4,4X,6F9.3)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SLOPE(RHO,MACH,CLALPA,RENN,XACM,CMCO4)
C
C***  CALCULATE THE SECTION LIFT CURVE SLOPE AND AERODYNAMIC
C***  CENTER AT THE DESIRED MACH/REYNOLDS NUMBER.  THE METHOD
C***  INCLUDES A CORRECTION DUE TO COMPRESSIBILITY.
C
C  ROUTINE ADAPTED FROM DIGITAL DATCOM
C  ORIGINAL ROUTINE WRITTEN BY D. KINSEY, D. BOWERS, AFFDL
C  MODIFIED BY S.R. VUKELICH, MCDONNELL DOUGLAS
C
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /ASMVAR/ CBAR,A0,XC,MCC,CLCC,AI,ALO,CLI,ASEP,CLA0,
     1                M,ZTNU(32),ZCNU(32),ST1NU(32),ST2NU(32),
     2                ST3NU(32),ST4NU(32),ST5NU(32),X(32),THNU(32),
     3                THMU(32),VXOVU(32),VXOVL(32),CPUM(32),
     4                CPLM(32),BO(32),CPI(32)
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      DIMENSION CL(2),ALPHA(2),CM(2),XI(32),STNU(32),IROUT(2)
C
C***  WEBER PRESSURE DISTRIBUTION AND CL-ALPHA
C***  METHOD INCLUDES COMPRESSIBILITY
C
      REAL LX,MACH,MCC
C
      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)/RAD)
      SINA=SIN(ALPHA(I)/RAD)
      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 (1.+ST3NU(L)/BO(L))*SQRT((1.-X(L))/X(L)))/SQRT(1.+((ST2NU(L)+
     2 ST5NU(L))/BO(L))**2)
      VXOVL(L)=(COSA*(1.+ST1NU(L)/BO(L)-ST4NU(L)/BETA)-SINA/BETA*
     1 (1.+ST3NU(L)/BO(L))*SQRT((1.-X(L))/X(L)))/SQRT(1.+((ST2NU(L)-
     2 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
C
C***  PRESSURE COEFFICIENT AT THE LEADING EDGE
C
      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)
C
C***  INTEGRATE THE CP CURVE AT THIS ALPHA
C
      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)
C
C***  PITCHING MOMENT COEFFICIENT
C
      SUMCM=0.0
      DO 1040 L=1,NM1
      LX=CPUM(L)-CPLM(L)
      DCM=LX*(X(L)-.25)*SIN(THNU(L))/2.
      SUMCM=SUMCM+DCM
 1040 CONTINUE
      CM(I)=SUMCM*PI/XN
 1050 CONTINUE
      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
C
C***  GET CORRECTION FACTOR FOR VISCOUS AFFECTS
C
      REN=1.E6
      IF(RENN.GE.1.E6.AND.MCC.NE.0..AND.MACH.NE.0.) REN=RENN
      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)
C
C***  GET LIFT CURVE SLOPE FROM THESE TWO ANGLES OF ATTACK
C
      CLALPA=(CL(2)-CL(1))*CON*1.05
C
C***  GET PITCHING MOMENT SLOPE
C
      CMALPA=CM(2)-CM(1)
      CMCO4=CM(1)
C
C***  NOW THE AERODYNAMIC CENTER
C
      XACM=0.25-CMALPA/CLALPA
 1070 CONTINUE
      GO TO 1090
 1080 CONTINUE
C
C***  ANALYSIS FAILING -- PRINT INFORMATIVE DIAGNOSTIC
C
      IF(PARTS(18))WRITE(6,1160)
 1090 CONTINUE
      IF(MACH .NE. 0.) GO TO 1150
C
C***  CALCULATE THE CREST CRITICAL CONDITIONS FOR THIS AIRFOIL
C
      CLM=CLALPA
      J=N-1
      DO 1100 I=1,NM1
      XI(I)=X(J)
      STNU(I)=ST2NU(J)+ST5NU(J)
      J=J-1
 1100 CONTINUE
      STC=SINA/COSA
      DO 1110 I=1,NM1
      II=I
      IF(STC .GT. STNU(I)) GO TO 1120
 1110 CONTINUE
 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 CONTINUE
 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
      IF(PARTS(18) .AND. MCC .GT. 1.)WRITE(6,1170)MCC
      IF(MCC .GT. 1.)MCC=0.99
      BCC=SQRT(1.-MCC**2)
      CLCC=(ABS(CLM)/(BCC-(MCC**2/(1.+BCC))*ABS(CLM)/2.))*CON
 1150 CONTINUE
C
 1160 FORMAT(4X,'*** CALCULATIONS IN SUBROUTINE SLOPE HAVE FAILED.',/
     1 4X,'*** ANALYSIS FOR THIS AIRFOIL IMPOSSIBLE.')
 1170 FORMAT(4X,'*** SQUARE ROOT OF A NEGATIVE NUMBER IN SUBROUTINE',/
     1 ' SLOPE.  CREST CRITICAL MACH NUMBER ADJUSTED FROM',
     2   F10.4, 'TO 0.99')
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE TRIMIT(IM,TOTC)
C
C***  CONFIGURATION TRIM ROUTINE
C
C  MODIFIED BY K. BURNS, MCDONNELL DOUGLAS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /REFQN/ SREF,REFQ(8)
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),CASE,NOEXTR,NOLAT,
     1                IR,IPAGE
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      COMMON /FSET1/  FS1(381),PHIF1(8),CFOC1(10)
      COMMON /FSET2/  FS2(381),PHIF2(8),CFOC2(10)
      COMMON /FSET3/  FS3(381),PHIF3(8),CFOC3(10)
      COMMON /FSET4/  FS4(381),PHIF4(8),CFOC4(10)
C
      COMMON /GEOFS1/ GFIN1(188)
      COMMON /GEOFS2/ GFIN2(188)
      COMMON /GEOFS3/ GFIN3(188)
      COMMON /GEOFS4/ GFIN4(188)
C
      COMMON /F1WORK/ F1WK(290)
      COMMON /F2WORK/ F2WK(290)
      COMMON /F3WORK/ F3WK(290)
      COMMON /F4WORK/ F4WK(290)
C
C FIX TO PASS CORRECT DELTAS TO SYNTHS
C
      COMMON /FFINDL/ DELTA1(8),DELTA2(8),DELTA3(8),DELTA4(8),CLD(4)
C
      COMMON /INCID/  DTEMP(32),XHINGE(4),SKEW(4)
      COMMON /TRIMIN/ SET,PANL1,PANL2,PANL3,PANL4,PANL5,PANL6,PANL7,
     1                PANL8,DELMIN,DELMAX,ASY(8)
      COMMON /UTRIMD/ CNT(200),CMT(200),CAT(200),CYT(200),
     1                CLNT(200),CLLT(200)
      COMMON /TRIMD/  DELTRM(20),CNTRM(20),CATRM(20),
     1                CYTRM(20),CLNTRM(20),CLLTRM(20)
      COMMON /SB1/    CB1(220)
      COMMON /SB12/   CB12(220)
      COMMON /SB123/  CB123(220)
      COMMON /SB1234/ CB1234(220)
      COMMON /PARTF/  PARTS(19)
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      REAL NALPHA,NMACH,MACH
      LOGICAL PANL1,PANL2,PANL3,PANL4,PANL5,PANL6,PANL7,PANL8,
     1        LPARTS,ASY,NOEXTR,NOLAT,NOLATS,PANLL,PARTS,PARTSS
C
      DIMENSION DELTAS(8,4),IROUT(2),DELTAB(10),CMUT(10),COEF(10)
      DIMENSION CMTRM(20),PANLL(8),PARTSS(16),IDUM(3,4),TOTC(80)
C
      EQUIVALENCE (PANL1,PANLL(1)),(PANL2,PANLL(2)),(PANL3,PANLL(3))
      EQUIVALENCE (PANL4,PANLL(4)),(PANL5,PANLL(5)),(PANL6,PANLL(6))
      EQUIVALENCE (PANL7,PANLL(7)),(PANL8,PANLL(8))
C
C***  TURN OFF PART AND NOLAT FLAGS
C
      LPARTS=LPART
      DO 1000 I=1,16
         PARTSS(I)=PARTS(I)
         PARTS(I)=.FALSE.
 1000 CONTINUE
      LPART=.FALSE.
      NOLATS=NOLAT
      NOLAT=.TRUE.
C
C***  IF DEFLECTIONS ARE NOT INPUT, SET TO ZERO
C
      DO 1010 I=1,8
         IF(DELTA1(I) .EQ. UNUSED)DELTA1(I)=0.
         IF(DELTA2(I) .EQ. UNUSED)DELTA2(I)=0.
         IF(DELTA3(I) .EQ. UNUSED)DELTA3(I)=0.
         IF(DELTA4(I) .EQ. UNUSED)DELTA4(I)=0.
 1010 CONTINUE
C
      NALP=NALPHA+0.5
C
C***  DETERMINE TRIM RANGE OF DEFLECTIONS
C
      DELLO=AMIN1(DELMIN,DELMAX)
      DELHI=AMAX1(DELMIN,DELMAX)
C
C ... IF RANGE NOT INPUT OR IDENTICAL, SET DEFAULTS
C
      IF(DELLO .EQ. UNUSED)DELLO=0.
      IF(DELHI .EQ. UNUSED)DELHI=0.
      IF(DELLO .NE. DELHI)GO TO 1020
      DELLO=-25.
      DELHI=20.
C
 1020 CONTINUE
C
C***  WANT 10 DEFLECTION ANGLES
C
      DDELTA=(DELHI-DELLO)/9.
C
C***  SAVE INPUT DEFLECTION ANGLES
C
      DO 1030 I=1,8
         DELTAS(I,1)=DELTA1(I)
         DELTAS(I,2)=DELTA2(I)
         DELTAS(I,3)=DELTA3(I)
         DELTAS(I,4)=DELTA4(I)
 1030 CONTINUE
C
C***  DETERMINE CONFIGURATION
C
      NSETS=0
      IF(LFIN1)NSETS=NSETS+1
      IF(LFIN1.AND.LFIN2)NSETS=NSETS+1
      IF(LFIN1.AND.LFIN2.AND.LFIN3)NSETS=NSETS+1
      IF(LFIN1.AND.LFIN2.AND.LFIN3.AND.LFIN4)NSETS=NSETS+1
C
C***  SET FOR TRIMMING
C
      NSET=SET+0.5
      IF(NSET .LE. 0 .OR. NSET .GT. 4)NSET=1
C
C ... DEFAULT PANELS TO DEFLECT
C
      IF(PANL1 .OR. PANL2 .OR. PANL3 .OR. PANL4 .OR. PANL5
     1   .OR. PANL6 .OR. PANL7 .OR. PANL8)GO TO 1040
      PANL2=.TRUE.
      PANL4=.TRUE.
C
 1040 CONTINUE
C
C***  LOOP FOR EACH DEFLECTION ANGLE
C
      DO 1110 L=1,10
         DELT=(L-1)*DDELTA+DELLO
         DELTAB(L)=DELT
C
         GO TO (1050,1060,1070,1080),NSET
C
 1050    DO 1052 II=1,8
            IF(PANLL(II) .AND. PHIF1(II).LE.180.)DELTA1(II)=DELT
            IF(PANLL(II) .AND. PHIF1(II).GT.180.)DELTA1(II)=-DELT
      IF(CFOC1(1).LT.1. .AND. DELTA1(II).NE.0.) THEN
         CALL FLAPS(MACH(IM),CFOC1,GFIN1(176),DELTA1(II),
     1              FS1(52),GFIN1(179),GFIN1(183),FS1(263),
     2              FS1(2),F1WK(64),F1WK(207),SREF,ANS,TEMP)
         DELTA1(II)=ANS
      ENDIF
            IF(ASY(II))DELTA1(II)=-DELTA1(II)
 1052    CONTINUE
C
         GO TO 1090
C
 1060    DO 1062 II=1,8
            IF(PANLL(II) .AND. PHIF2(II).LE.180.)DELTA2(II)=DELT
            IF(PANLL(II) .AND. PHIF2(II).GT.180.)DELTA2(II)=-DELT
      IF(CFOC2(1).LT.1. .AND. DELTA2(II).NE.0.) THEN
         CALL FLAPS(MACH(IM),CFOC2,GFIN2(176),DELTA2(II),
     1              FS2(52),GFIN2(179),GFIN2(183),FS2(263),
     2              FS2(2),F2WK(64),F2WK(207),SREF,ANS,TEMP)
         DELTA2(II)=ANS
      ENDIF
            IF(ASY(II))DELTA2(II)=-DELTA2(II)
 1062    CONTINUE
C
         GO TO 1090
C
 1070    DO 1072 II=1,8
            IF(PANLL(II) .AND. PHIF3(II).LE.180.)DELTA3(II)=DELT
            IF(PANLL(II) .AND. PHIF3(II).GT.180.)DELTA3(II)=-DELT
      IF(CFOC3(1).LT.1. .AND. DELTA3(II).NE.0.) THEN
         CALL FLAPS(MACH(IM),CFOC3,GFIN3(176),DELTA3(II),
     1              FS3(52),GFIN3(179),GFIN3(183),FS3(263),
     2              FS3(2),F3WK(64),F3WK(207),SREF,ANS,TEMP)
         DELTA3(II)=ANS
      ENDIF
            IF(ASY(II))DELTA3(II)=-DELTA3(II)
 1072    CONTINUE
C
         GO TO 1090
C
 1080    DO 1082 II=1,8
            IF(PANLL(II) .AND. PHIF4(II).LE.180.)DELTA4(II)=DELT
            IF(PANLL(II) .AND. PHIF4(II).GT.180.)DELTA4(II)=-DELT
      IF(CFOC4(1).LT.1. .AND. DELTA4(II).NE.0.) THEN
         CALL FLAPS(MACH(IM),CFOC4,GFIN4(176),DELTA4(II),
     1              FS4(52),GFIN4(179),GFIN4(183),FS4(263),
     2              FS4(2),F4WK(64),F4WK(207),SREF,ANS,TEMP)
         DELTA4(II)=ANS
      ENDIF
            IF(ASY(II))DELTA4(II)=-DELTA4(II)
 1082    CONTINUE
C
 1090    CONTINUE
C
C***  SYNTHESIS THE CONFIGURATION
C
         CALL SYNTHS(IM,TOTC,IDUM,0.)
         CALL BLKLDD(IDUM)
C
C***     SAVE CALCULATIONS IN UTRIMD ARRAY
C
         DO 1100 I=1,NALP
            INDX=(L-1)*20+I
            IF(NSETS .EQ. 4)CNT(INDX)=CB1234(I)
            IF(NSETS .EQ. 4)CMT(INDX)=CB1234(I+20)
            IF(NSETS .EQ. 4)CAT(INDX)=CB1234(I+40)
            IF(NSETS .EQ. 4)CYT(INDX)=CB1234(I+60)
            IF(NSETS .EQ. 4)CLNT(INDX)=CB1234(I+80)
            IF(NSETS .EQ. 4)CLLT(INDX)=CB1234(I+100)
            IF(NSETS .EQ. 3)CNT(INDX)=CB123(I)
            IF(NSETS .EQ. 3)CMT(INDX)=CB123(I+20)
            IF(NSETS .EQ. 3)CAT(INDX)=CB123(I+40)
            IF(NSETS .EQ. 3)CYT(INDX)=CB123(I+60)
            IF(NSETS .EQ. 3)CLNT(INDX)=CB123(I+80)
            IF(NSETS .EQ. 3)CLLT(INDX)=CB123(I+100)
            IF(NSETS .EQ. 2)CNT(INDX)=CB12(I)
            IF(NSETS .EQ. 2)CMT(INDX)=CB12(I+20)
            IF(NSETS .EQ. 2)CAT(INDX)=CB12(I+40)
            IF(NSETS .EQ. 2)CYT(INDX)=CB12(I+60)
            IF(NSETS .EQ. 2)CLNT(INDX)=CB12(I+80)
            IF(NSETS .EQ. 2)CLLT(INDX)=CB12(I+100)
            IF(NSETS .EQ. 1)CNT(INDX)=CB1(I)
            IF(NSETS .EQ. 1)CMT(INDX)=CB1(I+20)
            IF(NSETS .EQ. 1)CAT(INDX)=CB1(I+40)
            IF(NSETS .EQ. 1)CYT(INDX)=CB1(I+60)
            IF(NSETS .EQ. 1)CLNT(INDX)=CB1(I+80)
            IF(NSETS .EQ. 1)CLLT(INDX)=CB1(I+100)
 1100    CONTINUE
C
 1110 CONTINUE
C
C***  FIND CM=0. AT EACH ANGLE OF ATTACK
C
      DO 1170 IALP=1,NALP
C
C***  EXTRACT CM DATA AT EACH DEFLECTION
C
         DO 1120 IDEF=1,10
            INDX=(IDEF-1)*20+IALP
            CMUT(IDEF)=CMT(INDX)
 1120    CONTINUE
C
C***  CHECK FOR SIGN FLIP ON CM DATA
C
      IF(CMUT(1) .EQ. 0.)GO TO 1140
C
         DO 1130 I=2,10
            II=I
            IF(CMUT(I) .EQ. 0.)GO TO 1140
            IF(CMUT(I)/ABS(CMUT(I)) .NE. CMUT(I-1)/ABS(CMUT(I-1)))
     1         GO TO 1140
 1130    CONTINUE
C
C ...    SIGN FLIP NOT PRESENT, CANNOT TRIM
C
         DELTRM(IALP)=UNUSED
         CNTRM(IALP)=UNUSED
         CMTRM(IALP)=UNUSED
         CATRM(IALP)=UNUSED
         CYTRM(IALP)=UNUSED
         CLNTRM(IALP)=UNUSED
         CLLTRM(IALP)=UNUSED
         GO TO 1170
C
 1140    CONTINUE
         IF(CMUT(II) .EQ. 0.)DELTRM(IALP)=DELTAB(II)
C
C***     LINEARILY COMPUTE DELTA TRIM AT THIS ANGLE OF ATTACK
C
         IF(CMUT(II) .NE. 0.)
     1     DELTRM(IALP)=(DELTAB(II-1)-DELTAB(II))/(CMUT(II)-CMUT(II-1))
     2                  *CMUT(II-1)+DELTAB(II-1)
         CMTRM(IALP)=0.
C
         DTRM=DELTRM(IALP)
C
C***  INTERPOLATE AT TRIM DEFLECTION FOR ALL COEFFICIENTS
C
         DO 1160 ICOEF=1,6
C
            IF(ICOEF .EQ. 2)GO TO 1160
C
            DO 1150 IDEF=1,10
               INDX=(IDEF-1)*20+IALP
               IF(ICOEF .EQ. 1)COEF(IDEF)=CNT(INDX)
               IF(ICOEF .EQ. 3)COEF(IDEF)=CAT(INDX)
               IF(ICOEF .EQ. 4)COEF(IDEF)=CYT(INDX)
               IF(ICOEF .EQ. 5)COEF(IDEF)=CLNT(INDX)
               IF(ICOEF .EQ. 6)COEF(IDEF)=CLLT(INDX)
 1150       CONTINUE
C
            IF(ICOEF .EQ. 1)
     1      CALL LNTRP(DELTAB,COEF,10,DTRM,CNTRM(IALP))
            IF(ICOEF .EQ. 3)
     1      CALL LNTRP(DELTAB,COEF,10,DTRM,CATRM(IALP))
            IF(ICOEF .EQ. 4)
     1      CALL LNTRP(DELTAB,COEF,10,DTRM,CYTRM(IALP))
            IF(ICOEF .EQ. 5)
     1      CALL LNTRP(DELTAB,COEF,10,DTRM,CLNTRM(IALP))
            IF(ICOEF .EQ. 6)
     1      CALL LNTRP(DELTAB,COEF,10,DTRM,CLLTRM(IALP))
C
 1160    CONTINUE
C
 1170 CONTINUE
C
C***  RESTORE INPUT DATA AND FLAGS
C
      LPART=LPARTS
      DO 1180 I=1,16
         PARTS(I)=PARTSS(I)
 1180 CONTINUE
      NOLAT=NOLATS
      DO 1190 I=1,8
         DELTA1(I)=DELTAS(I,1)
         DELTA2(I)=DELTAS(I,2)
         DELTA3(I)=DELTAS(I,3)
         DELTA4(I)=DELTAS(I,4)
 1190 CONTINUE
C
C***  DUMP UNTRIMMED DATA IF REQUIRED
C
      CALL DUMPRT
C
      IF(PARTS(12))CALL PLTUT9(IM,DELTAB,DELTA1,DELTA2,DELTA3,DELTA4,
     1 NSET,PANL1,PANL2,PANL3,PANL4)
C
      IF(LPLOT)CALL PLTTRM(IM)
C
C***  PRINT TRIMMED RESULTS
C
      CALL PRITRM(IM,NSET,DELTAB,PANL1,PANL2,PANL3,PANL4,PANL5,PANL6,
     1  PANL7,PANL8,DELTRM,CNTRM,CMTRM,CATRM,CYTRM,CLNTRM,CLLTRM)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE AFTCAP(L, YP, XLE, B, XM, XW, CS, CP, DCA, FAIL)
C      
C     CALCULATE CP AND DCA/DY OF AN AFT SEGMENT OF NOSE CAP
C      
C     INPUT VARIABLES
C          L - NUMBER OF POINTS ARROUND NOSE CAP
C         YP - Y-POSITION ON FIN
C        XLE - L.E. LOCATION AT YP
C          B - SPAN OF TWO PANELS ALONE
C         XM - MACH NUMBER
C         CS - COSINE OF LE SWEEP
C      
C     INPUT VARIABLES FROM COMMON
C         XO - ROOT LOCATIONS OF SOSL
C         XT - TIP LOCATIONS OF SOSL
C      DZDXO - SURFACE SLOPE AT XO
C      DZDXT - SURFACE SLOPE AT XT
C        CPO - MAX. PRESSURE COEFFICIENT
C      
C     OUTPUT VARIABLES
C         XW - LOCATIONS OF PRESSURES
C         CP - CP AT XW AND YP
C        DCA - D(CA)/DY FOR AFT NOSE CAP
C      
C     OUTPUT VARIABLES TO COMMON
C       DZDX - SURFACE SLOPES AT XW AND YP
C      
      DIMENSION XW(60), CP(60), CPN(60)
C      
      LOGICAL FAIL
C      
      COMMON /CAFD/  XO(60), XT(60), DZDXO(60), DZDXT(60), TGA(60),
     1               ETA(60), DZDX(60), NS, CPO
C     ...
C     ... CALCULATE NEWTONIAN AND POTENTIAL CP AT EACH XW
C     ...
      N1 = L+1
      AJ = YP/(B/2.0)
      DO 1000 I=1,N1
        XW(I) = XO(I)+AJ*(XT(I)-XO(I))
        XP = XW(I)
        IF(I .EQ. N1) XP = XP-0.00001
        DELT  = ATAN(DZDX(I+1))
        SIND  = SIN(DELT)
        CPN(I)= CPO*SIND*SIND*CS*CS
        CALL CP3DW(XP, YP, B, XM, CP(I),FAIL)
 1000 CONTINUE
      ICASE = 2
      IF(CP(2) .LE. CPN(2)) GO TO 1040
C     ...
C     ... CASE 1 - CP(2) .GT. CPN(2)
C     ...
        ICASE = 1
        DO 1010 I=3,L
          IF(CP(I) .LT. CPN(I)) GO TO 1020
 1010   CONTINUE
C       ...
C       ... CASE 1A - USE POTENTIAL CP AT ALL XW
C       ...
        GO TO 1040
 1020   CONTINUE
C       ...
C       ... CASE 1B - USE CPN UP TO XW(KLL)
C       ...
        KLL = I-1
        DO 1030 I=2,KLL
          CP(I) = CPN(I)
 1030   CONTINUE
 1040 CONTINUE
      IF(CP(2) .GT. CPN(2)) GO TO 1090
      IF(ICASE .EQ. 1) GO TO 1090
C       ...
C       ... CASE 2 - CP(2) .LE. CPN(2)
C       ...
        DO 1050 I=3,L
          IF(CP(I) .GT. CPN(I)) GO TO 1070
          IF(CP(I) .LT. 0.0) GO TO 1060
 1050   CONTINUE
 1060   CONTINUE
C       ...
C       ... CASE 2A - USE POTENTIAL CP AT ALL XW
C       ...
        GO TO 1090
 1070   CONTINUE
C       ...
C       ... CASE 2B AND 2C - USE CPN UP TO XW(KLL)
C       ...
        KLL = I-1
        DO 1080 I=2,KLL
          CP(I) = CPN(I)
 1080   CONTINUE
 1090 CONTINUE
C     ...
C     ... INTEGRATE FOR DCA USING TRAPAZOIDAL RULE FOR
C     ... POINTS 2 TO L+1
C     ...
      DCA = 0.0
      DD1 = CP(2)*DZDX(2)
      DO 1100 I=2,L
        DD2 = CP(I+1)*DZDX(I+1)
        DX  = XW(I+1)-XW(I)
        DCA = DCA+(DD1+DD2)*DX/2.0
        DD1 = DD2
 1100 CONTINUE
C      
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDXCPF(DFWD,DAFT,FOREL,FLAREL,XCPFLR)
C
C  COMPUTE THE SUBSONIC/TRANSONIC FLARE CENTER OF PRESSURE
C
C  METHOD FROM AMC PAMPHLET AMCP 706-280, JULY 1968
C
C***  INPUTS
C
C   DFWD - DIAMETER OF FORWARD END OF THE FLARE
C   DAFT - DIAMETER OF THE AFT END OF THE FLARE
C  FOREL - LENGTH OF BODY FORWARD OF FLARE
C FLAREL - LENGTH OF THE FLARE
C
C***  OUTPUT
C
C XCPFLR - FLARE CENTER OF PREESURE AFT OF FORWARD DIAMETER,
C            BASED ON DFWD (POSITIVE AFT OF FORWARD DIAMETER LOC.)
C
      XCPFLR=0.
C
      IF(DFWD .EQ. DAFT .OR. DAFT .EQ. 0.)GO TO 1000
C
      XCPFLR=-(DFWD/DAFT*(DFWD/DAFT+1.)-2.)/3./(1.-(DFWD/DAFT)**2)
     1       *FLAREL/DFWD+FOREL/DFWD
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CNINC(ICASE,CNS,ICON,DUMMY,PHI)
C      
C        SUBROUTINE TO CALCULATE CN INCREMENTALS AND TO COMPUTE
C     NEW CN VALUES WITH THOSE INCREMENTALS.  IF AERODYNAMIC ROLL
C     ANGLE IS ZERO, INCREMENTALS ARE DETERMINED FOR THE POTENTIAL
C     TERM AND THE VISCOUS TERM.  IF AERODYNAMIC ROLL ANGLE IS NOT 
C     ZERO, A TABLE IF INCREMENTAL MULTIPLIERS IS CALCULATED.
C      
C***  INPUTS
C      
C     ICASE = RUN CASE NUMBER
C     CNS   = ARRAY FROM SYNTHS CONTAINING CN VALUES
C     DUMMY = ARRAY THAT CONTAINS EXPERIMENTAL COEFFICIENTS AND WILL
C             CONTAIN UPDATED COEFFICIENTS CN = DUMMY 1-20
C     ICON  = CONFIGURATION TO BE INCREMETED
C             ICON = 1    BODY
C             ICON = 2    BODY + 1 FIN SET
C             ICON = 3    BODY + 2 FIN SETS
C             ICON = 4    BODY + 3 FIN SETS
C             ICON = 5    BODY + 4 FIN SETS
C     PHI   = BODY AXIS AERODYNAMIC ROLL ANGLE
C      
C***  OUTPUT
C      
C     CN = UPDATED CN VALUES EQUIVALENT TO DUMMY 1-20
C          NOTE: ARRAY DUMMY IN THE FIRST CASE COMES IN WITH THE EXPERIMENTAL
C                DATA AND RETURNS WITH INCREMENTED CN
C      
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /FLC   / NA,ALPHA(20),FLDUM(123)
      COMMON /INC   / C1,C2(20),DCN0,DIP(106),ZIP,ALP(20),NAP
      DIMENSION CN(20),CNEXP(20),CNTH(20),CNATH(20),
     1          CNPTH(20),CNVTH(20),CNPEXP(20),DUMMY(120),Z(20),
     2          CNS(20,5)
C      
C       USE APPROPRIATE IOM COMMON BLOCK TO FILL THE WORKING ARRAYS
C      
      REAL NA,NAP
C
C **  INITIALIZE WORKING ARRAYS
C      
      DO 1000 I=1,20
         CNTH(I)=UNUSED
         CNEXP(I)=UNUSED
         CNPEXP(I)=UNUSED
         CNPTH(I)=UNUSED
         CNVTH(I)=UNUSED
 1000 CONTINUE
C      
      NAP1=NAP+.5
      NALPHA = NA +.5
      DO 1010 I=1,NALPHA
         IF(ICON .EQ. 1)CNTH(I)=CNS(I,5)
         IF(ICON .GT. 1)CNTH(I)=CNS(I,ICON-1)
 1010 CONTINUE
C
C     ZIP=0 FOR THE FIRST TIME THROUGH BETADR AND PHI IS AS INPUT
C     ZIP=1 FOR THE SECOND TIME THROUGH AND PHI HAS BEEN INCREASED BY 1
C
      IF(ZIP .EQ. 0. .AND. PHI .NE. 0.)GO TO 1030
C      
C      COMPUTE THEORETICAL CNA
C      
      CALL CALIB(4,NALPHA,ALPHA,CNEXP,NALPHA,ALPHA,CNTH,SLOPE)
      CNATH(1)=SLOPE*RAD
 1030 IF(ICASE .NE. 1 .OR. ZIP .EQ. 1)GO TO 1070
      DO 1040 I=1,NALPHA
         CNEXP(I)= DUMMY(I)
 1040 CONTINUE
      IF(PHI .NE. 0.)GO TO 1110
C      
C       DETERMINE THE DIFFERENCE BETWEEN CN EXPERIMENTAL AND CN
C          THEORETICAL AT ALPHA = 0
C      
      CALL LNTRP(ALPHA,CNEXP,NALPHA,0.,CNEXP0)
      CALL LNTRP(ALPHA,CNTH,NALPHA,0.,CNTH0)
      DCN0= CNEXP0 - CNTH0
C
C**   SUBTRACT DCN0 FROM CN EXPERIMENTAL TO BRING IT DOWN TO THE THEORETICAL
C     CN CURVE
C
      DO 1060 I=1,NALPHA
         CNEXP(I)=CNEXP(I) - DCN0
 1060 CONTINUE
C      
C     USE CALIB TO DETERMINE THE POTENTIAL INCREMENTAL C1, A SCALAR MULTIPLIER
C      
       CALL CALIB(-3,NALPHA,ALPHA,CNEXP,NALPHA,ALPHA,CNTH,Z)
       C1=Z(1)
C      
C         CALCULATE THE THEORETICAL POTENTIAL CN AND VISCOUS CN
C         FROM TOTAL CN WHICH IS THE EXPERIMENTAL CN POTENTIAL
C      
 1070 IF(PHI .NE. 0.)GO TO 1120
      DO 1080 I=1,NALPHA
         CNPTH(I)=.5*CNATH(1)*SIN(2.*ALPHA(I))*COS(ALPHA(I)/2.)
         CNVTH(I)=CNTH(I) - CNPTH(I)
 1080 CONTINUE
C      
C        USE THE INCREMENTAL FACTOR C1 TO DETERMINE THE CORRECTED
C          POTENTIAL CN
C      
      DO 1090 I=1,NALPHA
         CNPEXP(I)=C1*CNPTH(I)
 1090 CONTINUE
C
C     ONLY NEED TO DETERMINE CN VISCOUS ON THE FIRST TIME THROUGH THE FIRST
C     CASE
C
      IF (ICASE .NE. 1 .OR. ZIP .EQ. 1)GO TO 1140
C      
C       DETERMINE THE VISCOUS INCREMENTAL BY TAKING THE RATIO OF
C         EXPERIMENTAL CN VISCOUS TO THEORETICAL CN VISCOUS
C      
      DO 1100 I=1,NALPHA
         IF(ABS(CNTH(I)-CNPTH(I)) .LT. UNUSED)C2(I)=1.
         IF(ABS(CNTH(I)-CNPTH(I)) .LT. UNUSED)GO TO 1100
         C2(I)=(CNEXP(I) - CNPEXP(I))/CNVTH(I)
 1100 CONTINUE
      GO TO 1140
C
C***  HERE FOR AERODYNAMIC ROLL NOT ZERO
C     USE CALIB TO DETERMINE TABLE OF INCREMENTAL MULTIPLIERS
C
 1110 CALL CALIB(2,NALPHA,ALPHA,CNEXP,NALPHA,ALPHA,CNTH,C2)
C
C     USE LINEAR INTERPOLATION ON INCREMENTAL TABLE AT ALPHA OF INTEREST
C       BECAUSE INCRMENTALS ARE CALCULATED AT FIRST CASE ALPHA'S
C
 1120 DO 1130 I=1,NALPHA
         CALL LNTRP(ALP,C2,NAP1,ALPHA(I),C2I)
         CN(I)=CNTH(I)*C2I
 1130 CONTINUE
      GO TO 1160
C      
C***  COMPUTE THE INCREMENTED CN FOR AERODYNAMIC ROLL = 0
C      
 1140 DO 1150 I=1,NALPHA
         CALL LNTRP(ALP,C2,NAP1,ALPHA(I),C2I)
         CN(I)=CNPEXP(I) + C2I*CNVTH(I) + DCN0
 1150 CONTINUE
C
C     PUT INCREMENTED CN INTO ARRAY DUMMY
C
 1160 DO 1170 I=1,NALPHA
         DUMMY(I)=CN(I)
 1170 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE DAMP2(IM,TOTC)
C      
C  REV 1/96 UPDATE - NEW SUBROUTINE
C
C***  EXECUTIVE ROUTINE FOR CALCULATING THE DYNAMIC AERODYNAMICS
C***  FOR ALL COMPONENTS OF THE CONFIGURATION.  THE DERIVATIVES
C***  ARE CALCULATED IN THE SEQUENCE PITCH, YAW, ROLL.
C***  THE EQUIVALENT ANGLE OF ATTACK IS MODIFIED FOR EACH
C***  AXIS AND THE RESULTS ARE DIFFERENCED FROM THE STATIC RESULTS.
C
C  WRITTEN BY W. BLAKE, WL/FIGC
C
C***  A REDUCED FREQUENCY OF 0.02 IS ASSUMED (RATE*LENGTH/2.*VELOCITY)
C***  UNITS ARE RADIANS.  LREF IS THE REF. LENGTH FOR THE PITCH AXIS,
C***  LATREF IS THE REF. LENGTH FOR THE ROLL AND YAW AXES.
C 
      COMMON /CASEID/ CC(177),NOLAT,IR,IPAGE
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /FLC/    NALPHA,FLDUM(143)
C
      COMMON /SBODY/  CBODY(220)
      COMMON /SFIN1/  CFIN1(220)
      COMMON /SFIN2/  CFIN2(220)
      COMMON /SFIN3/  CFIN3(220)
      COMMON /SFIN4/  CFIN4(220)
      COMMON /SB1/    CB1(220)
      COMMON /SB12/   CB2(220)
      COMMON /SB123/  CB3(220)
      COMMON /SB1234/ CB4(220)
C
      COMMON /DBODY/ BCNQ(20),BCMQ(20),BCAQ(20),BCYQ(20),
     1  BCLNQ(20),BCLLQ(20),BCNR(20),BCMR(20),BCAR(20),
     2  BCYR(20),BCLNR(20),BCLLR(20),BCNP(20),BCMP(20),
     3  BCAP(20),BCYP(20),BCLNP(20),BCLLP(20),
     4  BCNAD(20),BCMAD(20),CLLP,CYP,CNP1,CNP3,CNP5,CNPY5
C
      COMMON /DB1/ D1CNQ(20),D1CMQ(20),D1CAQ(20),D1CYQ(20),
     1  D1CLNQ(20),D1CLLQ(20),D1CNR(20),D1CMR(20),D1CAR(20),
     2  D1CYR(20),D1CLNR(20),D1CLLR(20),D1CNP(20),D1CMP(20),
     3  D1CAP(20),D1CYP(20),D1CLNP(20),D1CLLP(20),
     4  D1CNAD(20),D1CMAD(20)
C
      COMMON /DB12/ D2CNQ(20),D2CMQ(20),D2CAQ(20),D2CYQ(20),
     1  D2CLNQ(20),D2CLLQ(20),D2CNR(20),D2CMR(20),D2CAR(20),
     2  D2CYR(20),D2CLNR(20),D2CLLR(20),D2CNP(20),D2CMP(20),
     3  D2CAP(20),D2CYP(20),D2CLNP(20),D2CLLP(20),
     4  D2CNAD(20),D2CMAD(20)
C
      COMMON /DB123/ D3CNQ(20),D3CMQ(20),D3CAQ(20),D3CYQ(20),
     1  D3CLNQ(20),D3CLLQ(20),D3CNR(20),D3CMR(20),D3CAR(20),
     2  D3CYR(20),D3CLNR(20),D3CLLR(20),D3CNP(20),D3CMP(20),
     3  D3CAP(20),D3CYP(20),D3CLNP(20),D3CLLP(20),
     4  D3CNAD(20),D3CMAD(20)
C
      COMMON /DB1234/ D4CNQ(20),D4CMQ(20),D4CAQ(20),D4CYQ(20),
     1  D4CLNQ(20),D4CLLQ(20),D4CNR(20),D4CMR(20),D4CAR(20),
     2  D4CYR(20),D4CLNR(20),D4CLLR(20),D4CNP(20),D4CMP(20),
     3  D4CAP(20),D4CYP(20),D4CLNP(20),D4CLLP(20),
     4  D4CNAD(20),D4CMAD(20)
C
      COMMON /PARTF/  PARTS(19)
      DIMENSION PARTSS(16)
      REAL NALPHA
      LOGICAL PARTS,PARTSS,LPARTS,NOLAT
C      
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      DIMENSION TOTC(80),TTOTC(80),TB1(220),TB2(220),TB3(220),
     1 TB4(220)
      DIMENSION TBODY(220),IFLAGA(3,4)
C
      NALP=NALPHA+.5
C      
C   CALCULATE BODY ALONE DYNAMIC DERIVATIVES
C
      CALL BDAMP(IM)
C
C   CALCULATE FIN ALPHA-DOT DERIVATIVES
C
      CALL FDAMP(IM)
C      
C     SET FLAGS FOR BLANKING LAT-DIR DERIV. TO ZERO
C      
      DO 1100 J=1,4
         DO 1150 I=1,3
            IFLAGA(I,J)=0
 1150    CONTINUE
 1100 CONTINUE
      RATE=0.02
C      
C***  SAVE PRESENT CALCULATIONS (STATIC RESULTS)
C***  TURN OFF PART FLAG FOR DERIVATIVE CALCULATIONS
C      
      LPARTS=LPART
      LPART=.FALSE.
      DO 1200 I=1,16
         PARTSS(I)=PARTS(I)
         PARTS(I)=.FALSE.
 1200 CONTINUE
C
      DO 1300 I=1,220
         TB1(I)=CB1(I)
         TB2(I)=CB2(I)
         TB3(I)=CB3(I)
         TB4(I)=CB4(I)
         CB1(I)=UNUSED
         CB2(I)=UNUSED
         CB3(I)=UNUSED
         CB4(I)=UNUSED
 1300 CONTINUE
C
C***  PITCH RESULTS
C
      CALL SYNTHS(IM,TOTC,IFLAGA,1.)
C
C***  CALCULATE PITCH DERIVATIVES
C
      QFACT=1./RATE
      DO 1400 I=1,NALP
         D1CNQ(I)=BCNQ(I)+QFACT*(CB1(I)-TB1(I))
         D1CMQ(I)=BCMQ(I)+QFACT*(CB1(I+20)-TB1(I+20))
         D1CAQ(I)=BCAQ(I)+QFACT*(CB1(I+40)-TB1(I+40))
         D1CYQ(I)=BCYQ(I)+QFACT*(CB1(I+60)-TB1(I+60))
         D1CLNQ(I)=BCLNQ(I)+QFACT*(CB1(I+80)-TB1(I+80))
         D1CLLQ(I)=BCLLQ(I)+QFACT*(CB1(I+100)-TB1(I+100))
C
         D2CNQ(I)=BCNQ(I)+QFACT*(CB2(I)-TB2(I))
         D2CMQ(I)=BCMQ(I)+QFACT*(CB2(I+20)-TB2(I+20))
         D2CAQ(I)=BCAQ(I)+QFACT*(CB2(I+40)-TB2(I+40))
         D2CYQ(I)=BCYQ(I)+QFACT*(CB2(I+60)-TB2(I+60))
         D2CLNQ(I)=BCLNQ(I)+QFACT*(CB2(I+80)-TB2(I+80))
         D2CLLQ(I)=BCLLQ(I)+QFACT*(CB2(I+100)-TB2(I+100))
C
         D3CNQ(I)=BCNQ(I)+QFACT*(CB3(I)-TB3(I))
         D3CMQ(I)=BCMQ(I)+QFACT*(CB3(I+20)-TB3(I+20))
         D3CAQ(I)=BCAQ(I)+QFACT*(CB3(I+40)-TB3(I+40))
         D3CYQ(I)=BCYQ(I)+QFACT*(CB3(I+60)-TB3(I+60))
         D3CLNQ(I)=BCLNQ(I)+QFACT*(CB3(I+80)-TB3(I+80))
         D3CLLQ(I)=BCLLQ(I)+QFACT*(CB3(I+100)-TB3(I+100))
C
         D4CNQ(I)=BCNQ(I)+QFACT*(CB4(I)-TB4(I))
         D4CMQ(I)=BCMQ(I)+QFACT*(CB4(I+20)-TB4(I+20))
         D4CAQ(I)=BCAQ(I)+QFACT*(CB4(I+40)-TB4(I+40))
         D4CYQ(I)=BCYQ(I)+QFACT*(CB4(I+60)-TB4(I+60))
         D4CLNQ(I)=BCLNQ(I)+QFACT*(CB4(I+80)-TB4(I+80))
         D4CLLQ(I)=BCLLQ(I)+QFACT*(CB4(I+100)-TB4(I+100))
 1400 CONTINUE
C
      DO 1500 I=1,220
         CB1(I)=UNUSED
         CB2(I)=UNUSED
         CB3(I)=UNUSED
         CB4(I)=UNUSED
 1500 CONTINUE
C
C  SKIP YAW AND ROLL CALCULATIONS IF NOLAT PRESENT
C
      IF(NOLAT) GO TO 1950
C
C***  YAW RESULTS
C
      CALL SYNTHS(IM,TOTC,IFLAGA,2.)
C
C***  CALCULATE YAW DERIVATIVES
C
      RFACT=1./RATE
      DO 1600 I=1,NALP
         D1CNR(I)=BCNR(I)+RFACT*(CB1(I)-TB1(I))
         D1CMR(I)=BCMR(I)+RFACT*(CB1(I+20)-TB1(I+20))
         D1CAR(I)=BCAR(I)+RFACT*(CB1(I+40)-TB1(I+40))
         D1CYR(I)=BCYR(I)+RFACT*(CB1(I+60)-TB1(I+60))
         D1CLNR(I)=BCLNR(I)+RFACT*(CB1(I+80)-TB1(I+80))
         D1CLLR(I)=BCLLR(I)+RFACT*(CB1(I+100)-TB1(I+100))
C
         D2CNR(I)=BCNR(I)+RFACT*(CB2(I)-TB2(I))
         D2CMR(I)=BCMR(I)+RFACT*(CB2(I+20)-TB2(I+20))
         D2CAR(I)=BCAR(I)+RFACT*(CB2(I+40)-TB2(I+40))
         D2CYR(I)=BCYR(I)+RFACT*(CB2(I+60)-TB2(I+60))
         D2CLNR(I)=BCLNR(I)+RFACT*(CB2(I+80)-TB2(I+80))
         D2CLLR(I)=BCLLR(I)+RFACT*(CB2(I+100)-TB2(I+100))
C
         D3CNR(I)=BCNR(I)+RFACT*(CB3(I)-TB3(I))
         D3CMR(I)=BCMR(I)+RFACT*(CB3(I+20)-TB3(I+20))
         D3CAR(I)=BCAR(I)+RFACT*(CB3(I+40)-TB3(I+40))
         D3CYR(I)=BCYR(I)+RFACT*(CB3(I+60)-TB3(I+60))
         D3CLNR(I)=BCLNR(I)+RFACT*(CB3(I+80)-TB3(I+80))
         D3CLLR(I)=BCLLR(I)+RFACT*(CB3(I+100)-TB3(I+100))
C
         D4CNR(I)=BCNR(I)+RFACT*(CB4(I)-TB4(I))
         D4CMR(I)=BCMR(I)+RFACT*(CB4(I+20)-TB4(I+20))
         D4CAR(I)=BCAR(I)+RFACT*(CB4(I+40)-TB4(I+40))
         D4CYR(I)=BCYR(I)+RFACT*(CB4(I+60)-TB4(I+60))
         D4CLNR(I)=BCLNR(I)+RFACT*(CB4(I+80)-TB4(I+80))
         D4CLLR(I)=BCLLR(I)+RFACT*(CB4(I+100)-TB4(I+100))
 1600 CONTINUE
C
      DO 1700 I=1,220
         CB1(I)=UNUSED
         CB2(I)=UNUSED
         CB3(I)=UNUSED
         CB4(I)=UNUSED
 1700 CONTINUE
C
C***  ROLL RESULTS
C
      CALL SYNTHS(IM,TOTC,IFLAGA,3.)
C
C***  CALCULATE ROLL DERIVATIVES
C
      PFACT=1./RATE
      DO 1800 I=1,NALP
         D1CNP(I)=BCNP(I)+PFACT*(CB1(I)-TB1(I))
         D1CMP(I)=BCMP(I)+PFACT*(CB1(I+20)-TB1(I+20))
         D1CAP(I)=BCAP(I)+PFACT*(CB1(I+40)-TB1(I+40))
         D1CYP(I)=BCYP(I)+PFACT*(CB1(I+60)-TB1(I+60))
         D1CLNP(I)=BCLNP(I)+PFACT*(CB1(I+80)-TB1(I+80))
         D1CLLP(I)=BCLLP(I)+PFACT*(CB1(I+100)-TB1(I+100))
C
         D2CNP(I)=BCNP(I)+PFACT*(CB2(I)-TB2(I))
         D2CMP(I)=BCMP(I)+PFACT*(CB2(I+20)-TB2(I+20))
         D2CAP(I)=BCAP(I)+PFACT*(CB2(I+40)-TB2(I+40))
         D2CYP(I)=BCYP(I)+PFACT*(CB2(I+60)-TB2(I+60))
         D2CLNP(I)=BCLNP(I)+PFACT*(CB2(I+80)-TB2(I+80))
         D2CLLP(I)=BCLLP(I)+PFACT*(CB2(I+100)-TB2(I+100))
C
         D3CNP(I)=BCNP(I)+PFACT*(CB3(I)-TB3(I))
         D3CMP(I)=BCMP(I)+PFACT*(CB3(I+20)-TB3(I+20))
         D3CAP(I)=BCAP(I)+PFACT*(CB3(I+40)-TB3(I+40))
         D3CYP(I)=BCYP(I)+PFACT*(CB3(I+60)-TB3(I+60))
         D3CLNP(I)=BCLNP(I)+PFACT*(CB3(I+80)-TB3(I+80))
         D3CLLP(I)=BCLLP(I)+PFACT*(CB3(I+100)-TB3(I+100))
C
         D4CNP(I)=BCNP(I)+PFACT*(CB4(I)-TB4(I))
         D4CMP(I)=BCMP(I)+PFACT*(CB4(I+20)-TB4(I+20))
         D4CAP(I)=BCAP(I)+PFACT*(CB4(I+40)-TB4(I+40))
         D4CYP(I)=BCYP(I)+PFACT*(CB4(I+60)-TB4(I+60))
         D4CLNP(I)=BCLNP(I)+PFACT*(CB4(I+80)-TB4(I+80))
         D4CLLP(I)=BCLLP(I)+PFACT*(CB4(I+100)-TB4(I+100))
 1800 CONTINUE
C
 1950 CONTINUE
C      
C***  RESTORE FIRST SYNTHESIS RESULTS (STATIC CALCULATION)
C      
      DO 1900 I=1,220
         CB1(I)=TB1(I)
         CB2(I)=TB2(I)
         CB3(I)=TB3(I)
         CB4(I)=TB4(I)
 1900 CONTINUE
C      
      LPART=LPARTS
      DO 2000 I=1,16
         PARTS(I)=PARTSS(I)
 2000 CONTINUE
C      
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCALE(MACH,SWEP00,LER,SSPAN,SREF,CALE)
C
C***  COMPUTE THE DRAG INCREMENT DUE TO FIN LEADING EDGE BLUNTNESS
C***  METHOD FROM DATCOM, SECTION 4.1.5.1
C
C***  INPUTS
C
C   MACH -- MACH NUMBER
C SWEP00 -- LEADING EDGE SWEEP ANGLE, DEG.
C    LER -- FIN LEADING EDGE RADIUS
C  SSPAN -- FIN PANEL SPAN (SEMI-SPAN OF TWO EXPOSED PANELS)
C   SREF -- REFERENCE AREA
C
C***  OUTPUT
C
C   CALE -- AXIAL FORCE INCREMENT DUE TO FIN L.E. BLUNTNESS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL MACH,LER
C
C ... MACH NUMBER SHOULD BE IN THE RANGE 0.5 TO 20.
C
      XMACH = MACH
      IF(MACH .LT. 1.05) XMACH = 1.05
C
      CALE=1.28*XMACH**3*COS(SWEP00/RAD)**6*2.*LER*SSPAN/
     1 (1.+XMACH**3*COS(SWEP00/RAD)**3)/(SREF*COS(SWEP00/RAD))
C
      IF(MACH .LT. 1.05) CALE = CALE*(1.0-4.0*(1.05-MACH))
      IF(MACH .LT. 0.80) CALE = 0.0
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FLAPS(XMACH,CFOC,TC,DELTA,CHORDS,XLAMLE,
     1           XLAMTE,YU,SSPAN,CNALPA,CAZERO,SREF,DELFF,CLD)
C      
C   THIS IS A SUBROUTINE TO DETERMINE THE EQUIVALENT ALL MOVING FIN DELTA
C   PER FLAP DEFLECTION.  THE APPROACH IS BASED ON THE DATCOM HANDBOOK
C   FOR PLAIN TRAILING EDGE, FULL SPAN FLAPS AT SUBSONIC AND SUPERSONIC
C   SPEEDS.  THE EQUIVALENT ALL MOVING FIN DEFLECTION IS THEN INCLUDED IN THE 
C   EQUIVALENT ANGLE OF ATTACK FORMULATION CURRENTLY IN MISSILE DATCOM.
C
C  WRITTEN BY K. BURNS, MCDONNELL DOUGLAS
C  MODIFIED BY W. BLAKE, WL/FIGC
C      
C *** INPUTS
C         XMACH  - MACH NUMBER
C       CFOC   - (FLAP CHORD/FIN CHORD)station i
C       TC     - EFFECTIVE THICKNESS TO CHORD RATIO
C         SSPAN  - (SEMI-SPAN)station i
C       DELTA  - $DEFLCT FLAP DEFLECTION, DEGREES
C       CHORDS - FIN (CHORD)station i
C       XLAMLE - EFFECTIVE LEADING EDGE SWEEP, DEGREES
C       XLAMTE - EFFECTIVE TRAILING EDGE SWEEP, DEGREES
C       CNALPA - NORMAL FORCE CURVE SLOPE, PER DEG (SINGLE PANEL)
C       CAZERO - PANEL ZERO ALPHA AXIAL FORCE
C       SREF   - MISSILE REFERENCE AREA
C      
C *** OUTPUT
C         DELFF - EFFECTIVE ALL MOVING FIN DEFLECTION ANGLE WHICH CORRESPONDS
C                  INPUT FLAP DEFLECTION, DEGREES
C       CLDEL - FLAP EFFECTIVENESS DERIVATIVE, CL-DELTA
C      
      COMMON /CONST/ PIE,RAD,UNUSED,KAND
C      
C * DATCOM FIGURE 6.1.4.1-14
C      
      DIMENSION X11418(10),X21418(10),Y61418(100)
C      
C * DATCOM FIGURE 6.1.4.1-15
C      
      DIMENSION X11419(3),X21419(12),Y61419(36)
C
C * DATCOM FIGURE 6.1.1.1-40 CFOC=.25
C
      DIMENSION X11140(14),Y11140(14)
C      
C * MISC ARRAY DIMENSIONS
C      
      DIMENSION CFOC(10)   ,ALPHAD(10) ,ALDAVG(9),
     1          ADCADS(9)  ,DKB(10)    ,CHORDS(10),
     2          YU(50)     ,SSPAN(10)  ,LAMDA(10) ,RKB(10)
C      
C * REALS
C      
      REAL LAMDA ,LAMDAF, MU
C      
C * LOGICALS
C      
      LOGICAL LTRANS
C      
C * DATCOM FIGURE 6.1.4.1-14A
C      
      DATA X21418/
     1 0.0,    0.25,   0.50,   1.0,    2.0,    3.0,    4.0,    5.0,
     2 6.0,    8.0/
      DATA X11418/
     1 -1.0,   -.9,    -.8,    -.7,    -.6,    -.5,    -.4,    -.3,
     2 -.2,    -.1/
      DATA Y61418/10*1.,
     1 1.11,   1.075,  1.06,   1.049,  1.03,   1.019,  1.011,  1.01,
     2 1.009,  1.007,
     3 1.2,    1.15,   1.125,  1.095,  1.06,   1.04,   1.03,   1.02,
     4 1.019,  1.015,
     5 1.365,  1.245,  1.20,   1.145,  1.095,  1.065,  1.05,   1.04,
     6 1.032,  1.025,
     7 1.5,    1.35,   1.285,  1.205,  1.132,  1.095,  1.072,  1.06,
     8 1.05,   1.039,
     9 1.7,    1.5,    1.4,    1.29,   1.185,  1.135,  1.10,   1.085,
     A 1.071,  1.055,
     B 2.0,    1.63,   1.53,   1.39,   1.25,   1.185,  1.145,  1.118,
     C 1.1,    1.079,
     D 2.4,    1.90,   1.70,   1.52,   1.35,   1.26,   1.20,   1.165,
     E 1.142,  1.11,
     F 2.73,   2.43,   2.10,   1.73,   1.49,   1.375,  1.30,   1.24,
     G 1.2,    1.16,
     H 3.08,   2.85,   2.55,   2.18,   1.79,   1.58,   1.46,   1.385,
     I 1.325,  1.245/
C      
C * DATCOM FIGURE 6.1.4.1-15
C      
      DATA X21419/
     1 0.0,    0.1,    0.2,    0.3,    0.4,    0.5,    0.6,    0.7,
     2 0.8,    0.85,   0.9,    1.0/
      DATA X11419/
     1 0.0,    0.5,    1.0/
      DATA Y61419/
     1 0.0,    0.160,  0.305,  0.440,  0.560,  0.670,  0.772,  0.860,
     2 .930,   .96,    .981,   1.0,
     3 0.0,    0.140,  0.270,  0.400,  0.515,  0.630,  0.735,  0.830,
     4 0.912,  0.947,  0.972,  1.0,
     5 0.,     .125,   .255,   .37,    .49,    .6,     .705,   .8,
     6 0.885,  0.921,  0.955,  1.0/
C
C * DATCOM FIGURE 6.1.1.1-40 CFOC=.25
C
      DATA X11140/
     1 0.,    10.,   12.,   14.,   16.,   18.,   20.,
     2 23.,   27.,   30.,   35.,   40.,   50.,   60./
      DATA Y11140/
     1 1.000, 1.000, 0.994, 0.989, 0.965, 0.935, 0.850,
     2 0.740, 0.677, 0.644, 0.600, 0.569, 0.518, 0.480/
C      
C *** TAKING CARE OF BUSINESS
C      
      DELFF = 0.0
      LTRANS= .FALSE.
      XLE   = XLAMLE/RAD
      TANPHE = (YU(45) - YU(49))/2./0.09
      ICNTR = 0
C      
C     DETERMINE THE NUMBER OF SPAN STATIONS INPUT
C      
      DO 1000 I=1,10
        IF(SSPAN(I) .NE. UNUSED)NSTA = I
 1000 CONTINUE
      BOVER2 = SSPAN(NSTA) - SSPAN(1)
C      
C     DETERMINE THE NUMBER OF CONTROL SURFACE SEGMENTS(NSEG),
C     THE STARTING AND ENDING SPAN STATION INDEX FOR THE FLAP
C     (IBEGIN AND IEND)
C      
      NSEG   = 0
      IBEGIN = 0
      IEND   = 0
      DO 1010 I=1,NSTA
        IF(CFOC(I) .GT. UNUSED)NSEG = NSEG + 1
        IF(CFOC(I) .GT. UNUSED .AND. IBEGIN .EQ. 0)IBEGIN=I
        IF(CFOC(I) .GT. UNUSED .AND. IBEGIN .NE. 0)IEND = I
        LAMDA(I) = CHORDS(I)/CHORDS(1)
 1010 CONTINUE
      NSEG = NSEG - 1
C
C     DETERMINE SINGLE PANEL PLANFORM AREA
C
      SFIN = 0.0
      DO 1015 ISTA=2,NSTA
        SFIN = SFIN + 0.5*(CHORDS(ISTA) + CHORDS(ISTA-1))
     1         *(SSPAN(ISTA) - SSPAN(ISTA-1))
 1015 CONTINUE
      AW = 2.0*BOVER2**2/SFIN
C      
C     CALCULATE FLAP AREA
C      
      IBP1 = IBEGIN +1
      SF = 0.0
      DO 1020 ISTA=IBP1,IEND
        CROOT = CHORDS(ISTA-1)*CFOC(ISTA-1)
        CTIP  = CHORDS(ISTA)*CFOC(ISTA)
        DSPAN = SSPAN(ISTA) - SSPAN(ISTA-1)
        SF = SF + 0.5*(CROOT + CTIP)*DSPAN
 1020 CONTINUE
C      
C *** TRANSONIC FLAG
C     TRANSONIC DEFINED TO BE .GT. MACH 0.8 BUT .LT. MACH 1.4
C      
      IF(XMACH .GT. 0.8 .AND. XMACH .LT. 1.4)THEN
         LTRANS=.TRUE.
C      
C   STORE TRANSONIC MACH NUMBER
C      
         XTRANS = XMACH
      ENDIF
C      
C   TRANSONIC "LOOP" - DETERMINE SUBSONIC AND SUPERSONIC VALUE THAT DEFINE
C   TRANSONIC CUBIC SPLINE
C      
 1030 IF(LTRANS)THEN
         ICNTR=ICNTR+1
C      
C   CALCULATE EFFECTIVE FULL FIN DEFLECTION AT MACH 0.79, 0.80, 1.40, 1.41
C      
         IF(ICNTR.EQ.1)XMACH=0.79
         IF(ICNTR.EQ.2)THEN
            X1    = XMACH
            Y1    = DELFF
            DELFF = 0.0
            XMACH = 0.8
         ENDIF
         IF(ICNTR.EQ.3)THEN
            X2    = XMACH
            Y2    = DELFF
            DELFF = 0.0
            XMACH = 1.4
         ENDIF
         IF(ICNTR.EQ.4)THEN
            X3    = XMACH
            Y3    = DELFF
            DELFF = 0.0
            XMACH = 1.41
         ENDIF
      ENDIF
C      
C *** SUBSONIC CALCULATIONS
C      
      IF(XMACH.LE.0.8)THEN
C      
C        CALCULATE ALPHA PER DELTA
C  NOTE: THE SPAN FACTOR ETA MUST BE MEASURED RELATIVE TO SSPAN(1)=0
C        HOWEVER IF A BODY IS PRESENT SSPAN(1)=BODY WIDTH.  SUBTRACT
C        SSPAN(1) FROM SPAN DIMENSION
C      
         ETA = (SSPAN(IBEGIN) - SSPAN(1))/BOVER2
         CALL MVLOOK(1,3,12,36,1.0,X11419,X21419,Y61419,
     1                ETA,LAMDA(IBEGIN),1.0,RKB(1))
C
C  DATCOM FIGURES 6.1.4.1-14 (INSET ONLY) AND 6.1.1.1-39B
C
         CALL FLAP2(CFOC(IBEGIN),TANPHE,ALPHAD(1))
C      
C        FOR EACH SPAN STATION DEFINED DETERMINE THE 2-D ALPHA PER DELTA
C        AND USE AVERAGE AT EACH END OF A FLAP SEGMENT AS ALPHA PER DELTA
C        FOR THAT SEGMENT. INDICES IN THE FOLLOWING LOOP INDICATE:
C        ISTA = FIN SPAN STATION INDEX, FOR THE FIRST FLAP CHORD ISTA=IBEGIN
C        ISEG = THE FLAP SEGMENT INDEX
C        K    = FLAP CHORD INDEX
C        N    = PREVIOUS FLAP CHORD STATION
C      
         ISTA = IBEGIN
         ISEG = 0
         NSEGP1 = NSEG + 1
         CDF = 0.0
         DO 1040 K=2,NSEGP1
           ISTA = ISTA + 1
           ISEG = ISEG + 1
           N    = K - 1
           IF(CHORDS(ISTA) .EQ. 0.0)THEN
             CFC = 0.0
           ELSE
             CFC = CFOC(ISTA)
           ENDIF
C
C  DATCOM FIGURES 6.1.4.1-14 (INSET ONLY) AND 6.1.1.1-39B
C
           CALL FLAP2(CFC,TANPHE,ALPHAD(K))
C
           ALDAVG(ISEG) = 0.50*(ALPHAD(K)+ALPHAD(N))
           ETA          = (SSPAN(ISTA) - SSPAN(1))/BOVER2
C      
C          DATCOM FIGURE 6.1.4.1-15 (KB)
C      
           CALL MVLOOK(1,3,12,36,1.0,X11419,X21419,Y61419,
     1                ETA,LAMDA(ISTA),1.0,RKB(K))
C      
           DKB(ISEG)=RKB(K)-RKB(N)
 1040    CONTINUE
C      
C        DATCOM FIGURE 6.1.4.1-14
C        TABLE LOOKUP FOR ALPHA_DELTA_CL/ALPHA_DELTA_Cl, ADCADS(N)
C        ADCADS(N) = THREE DIMENSIONAL FLAP EFFECTIVENESS PARAMETER TO
C                    THE TWO DIMENSIONAL FLAP EFFECTIVENESS PARAMETER
C                    RATIO FOR EACH SEGMENT OF THE FLAP
C        ADR       = THE WEIGHTED AVERAGE OF EFFECTIVE DEFLECTION/FLAP
C                    DEFLECTION ANGLE
C      
         ADR = 0.0
         DO 1050 ISEG=1,NSEG
            CALL MVLOOK(1,10,10,100,1.,X11418,X21418,Y61418,
     1                  AW,ALDAVG(ISEG),1.0,ADCADS(ISEG))
            ADR = ADR + ALDAVG(ISEG)*ADCADS(ISEG)*DKB(ISEG)
 1050    CONTINUE
C      
C        CALCULATE DELTA_ALPHA_TOTAL, DELFF
C        DELFF = TOTAL EQUIVALENT FULL FIN DEFLECTION REQUIRED TO 
C                GENERATE THE SAME ADDITIONAL LIFT GENERATED BY THE 
C                DEFLECTION OF THE INDIVIDUAL FLAP SEGMENTS
C      
         DELFF = -DELTA*ADR
         CLD=-ADR*(CNALPA*RAD-CAZERO)*SREF/(2.*SFIN)
      ENDIF
C
C   CORRECT DELTA FOR NON-LINEAR EFFECTS OF LARGE FLAP DEFLECTION
C
      ADEL=ABS(DELTA)
C     CALL MVLOOK(1,1,14,14,1.0,1.0,X11140,11140,ADEL,1.,1.,DELR)
      CALL LNTRP(X11140,Y11140,14,ADEL,DELR)
      DELFF=DELFF*DELR
C      
C *** END SUBSONIC CALCULATIONS
C      
C***********************************************************************
C      
C   *** BEGIN SUPERSONIC CALCULATIONS (REFERENCE NACA TR 1041) ***
C      
C***********************************************************************
C      
      IF(XMACH.GE.1.4)THEN
         SRI   = 0.0
         SRIA  = 0.0
         SRIB  = 0.0
         SRII  = 0.0
         SRIII = 0.0
         SRO   = 0.0
         BETA=SQRT(XMACH*XMACH-1.)
C      
C        CALCULATE HINGE LINE SWEEP ANGLE
C      
         XLAMHL = SSPAN(IEND)*TAN(XLE)+CHORDS(IEND)*(1.-CFOC(IEND)) -
     1       (SSPAN(IBEGIN)*TAN(XLE)+CHORDS(IBEGIN)*(1.-CFOC(IBEGIN)))
         XLAMHL=XLAMHL/(SSPAN(IEND) - SSPAN(IBEGIN))
         XLAMHL=ATAN(XLAMHL)
C      
C        LEADING, TRAILING AND HINGE LINE SWEEP ANGLES MUST BE SUPERSONIC.
C        THEREFORE DETERMINE THE SWEEP REQUIRED FOR A SONIC LEADING EDGE SWEEP.
C        IF THE SWEEP IS GREATER THAN THE SWEEP OF THE MACH LINE, SET THE
C        SWEEP TO THE MACH LINE SWEEP MINUS 1 DEGREE.
C        NOTE: MACH LINE SWEEP, MU=ATAN(1/BETA), IS MEASURED FROM CENTERLINE
C        AND LEADING EDGE SWEEP IS MEASURED FROM Y-AXIS
C      
         MU = ATAN(1/BETA)
         SWMAX = PIE/2. - MU
C
C  REV 1/96  INCORRECT TEST REMOVED
C            ONE DEGREE OFFSETS ADDED TO MODIFIED T.E. AND H.L. SWEEP
C
C        IF(XLE .GT. SWMAX)XLE = SWMAX
         XTE = XLAMTE/RAD
         IF(XTE .GE. SWMAX)XTE = SWMAX - PIE/180.
         IF(XLAMHL .GE. SWMAX)XLAMHL = SWMAX - PIE/180.
C      
C        CALCULATE "RAY" A, THE RAY EXTENDS FROM THE ORIGIN OF THE SUPERSONIC
C        FLAP COORDINATE SYSTEM
C      
         A=TAN(XLAMHL)/BETA
C      
C        CALCULATE "RAY" D, THE RAY EXTENDS FROM THE ORIGIN OF THE SUPERSONIC
C        FLAP COORDINATE SYSTEM
C      
         D=TAN(XTE)/BETA
C      
C        CALCULATE FLAP TAPER RATIO (USES FLAP AREA AND ROOT CHORD TO DETERMINE
C        AN EFFECTIVE FLAP TAPER RATIO SINCE TRAILING EDGE MAY BE CRANKED)
C      
         CFROOT = CHORDS(IBEGIN)*CFOC(IBEGIN)
         SPANF  = SSPAN(IEND) - SSPAN(IBEGIN)
         LAMDAF = 2.*SF/CFROOT/SPANF - 1.
C      
C        CALCULATE THICKNESS CORRECTION FACTOR
C        REFERENCE DATCOM EQUATION 6.1.4.1-f
C      
         TANPHE = (YU(45) - YU(49))/2./0.09
         PHITE = 2.*ATAN(TANPHE)
         C1=2./SQRT(XMACH*XMACH-1.)
         C2=(1.4+1.)*XMACH**4-4.*(XMACH*XMACH-1.)
         C2=C2/(2.*(XMACH*XMACH-1.)**2)
         CORR=1. - C2/C1*PHITE
C      
C        CALCULATE TWO-DIMENSIONAL PRESSURE COEFFICIENT
C      
         CPO=2.*DELTA/(RAD*BETA*SQRT(ABS(1.-A*A)))
C            
C *** HERE FOR FLAPS WITH TAPER RATIO .LT. 1 AND .GT. 0
C      
         IF(LAMDAF.LT.1.0 .AND. LAMDAF.GT.0.0)THEN
C      
C           CALCULATE AREA RATIO FOR REGION I
C
            SRI=2.*(A-D)/((1.-LAMDAF**2)*(1-D**2))
C      
C           CALCULATE AREA RATIO FOR REGION IA
C      
C           NOTE: FOR ALL AREA RATIO CALCULATIONS IN REGION IA AND IB,
C                 SET THE AREA=0 IF THE IT IS NEGATIVE.  A NEGATIVE AREA 
C                 RATIO INDICATES THAT THE REGION DOES NOT EXIST ON THIS 
C                 FLAP GEOMETRY.  ALSO WHEN AREA RATIO IS ZERO, BYPASS 
C                 PRESSURE RATIO CALCULATIONS FOR THAT REGION
C      
            SRIA=(LAMDAF*(1.-D)-(1.-A))/((1.-LAMDAF**2)*(1.-D))
            IF(SRIA .LT. UNUSED)SRIA=0.0
C      
C           CALCULATE AREA RATIO FOR REGION IB
C      
            SRIB=(LAMDAF*(1.-D)-(1.-A))/((1.+LAMDAF)*(A-D))
            IF(SRIB .LT. UNUSED)SRIB=0.0
C      
C           CALCULATE AREA RATIO FOR REGION II
C      
            SRII=2.*LAMDAF**2*(A-D)/((1.-LAMDAF**2)*(1.-D**2))
C      
C           CALCULATE AREA RATIO FOR REGION III
C      
            SRIII=(LAMDAF**2*(A-D))/((1.-LAMDAF**2)*(1.+D))
C      
C           CALCULATE AREA RATIO FOR TWO-DIMENSIONAL REGION
C      
            SRO=(1.-A)/(1.-D)-LAMDAF**2*(1.+A)/(1.+D)
            SRO=SRO/(1.-LAMDAF**2)
C      
C           CALCULATE AVERAGE PRESSURE RATIO IN REGION I
C      
            PI=SQRT((1-A**2)*(1.-D**2))-(1.-A)*(1+D)
            PI=PI/(2.*(A-D))
C      
C           CALCULATE AVERAGE PRESSURE RATIO IN REGION IA
C      
            IF(SRIA .GT. 0.0)THEN
              T1=(1.-D)/(LAMDAF*(1.-D)-(1.-A))
              T2=LAMDAF/PIE
              T3=((1.-A**2)-LAMDAF*(1.-A*D))/(LAMDAF*(A-D))
              T4=1./PIE*SQRT((1.-A**2)/(1.-D**2))
              T5=((1.-A*D)-LAMDAF*(1.-D**2))/(A-D)
              PIA=T1*(T2*ACOS(T3)-T4*ACOS(T5))
            ELSE
              PIA=0.0
            ENDIF
C      
C           CALCULATE AVERAGE PRESSURE RATIO IN REGION IB
C      
            IF(SRIB .GT. 0.0)THEN
               T1=1./(LAMDAF*(1.-D)-(1.-A))
               T2=T2*(A-D)
               T3=T3
               T4=(1.-LAMDAF)*SQRT(1.-A**2)/PIE
               IF((A-D).LT.0.)THEN
                  T5=(A-LAMDAF*D)+SQRT(2.*LAMDAF*(1.-A*D)-LAMDAF**2*
     1               (1.-D**2)-(1.-A*2.))
                  T5=T5/(1.-LAMDAF)
               ELSE
                  T5=(A-LAMDAF*D)-SQRT(2.*LAMDAF*(1.-A*D)-LAMDAF**2*
     1               (1.-D**2)-(1.-A*2.))
                  T5=T5/(1.-LAMDAF)
               ENDIF
               T6=LOG(ABS(T5))
               PIB=T1*(T2*ACOS(T3)+T4*T6)
            ELSE
               PIB=0.0
            ENDIF
C      
C           CALCULATE AVERAGE PRESSURE RATIO IN REGION II
C      
            PII=(SQRT((1.-A**2)*(1.-D**2)) - (1.+A)*(1.-D))/
     1          (2.*(D-A))
C      
C           CALCULATE AVERAGE PRESSURE RATIO IN REGION III
C      
            PIII=((1.+A)-SQRT((1.+A)*(1.+D)))/(A-D)
C      
C *** HERE IF FLAP IS UNTAPERED
C      
         ELSEIF(LAMDAF.GE.1.)THEN
C      
C           CALCULATE BETA*(ASPECT RATIO) OF UNTAPERED FLAP
C      
            AF=((SSPAN(IEND) - SSPAN(IBEGIN))**2)/SF*BETA
C      
C           CALCULATE AREA RATIO FOR REGION I
C      
            SRI=1./(AF*(1.-A*A))
C      
C           CALCULATE AREA RATIO FOR REGION IA
C      
            SRIA=(1.-AF*(1.-A))/(2.*AF*(1.-A))
            IF(SRIA .LT. UNUSED)SRIA = 0.0
C      
C           CALCULATE AREA RATIO FOR REGION IB
C      
            SRIB=(1.-AF*(1.-A))/2.
            IF(SRIB .LT. UNUSED)SRIB = 0.0
C      
C           CALCULATE AREA RATIO FOR REGION II
C      
            SRII=1./(AF*(1.-A**2))
C      
C           CALCULATE AREA RATIO FOR REGION III
C      
            SRIII=1./(2.*AF*(1.+A))
C      
C           CALCULATE AREA RATIO FOR TWO-DIMENSIONAL REGION
C      
            SRO=(AF*(1.-A*A)-1)/(AF*(1.-A*A))
C      
C           CALCULATE AVERAGE PRESSURE RATIO IN REGION I
C      
            PI=0.5
C      
C           CALCULATE AVERAGE PRESSURE RATIO IN REGION IA
C      
            IF(SRIA .GT. 0.0)THEN
              T1=1./((1.+A)*(1.-(1.-A)*AF))
              T2=SQRT((1.-A*A)*(1.+2.*A*AF-(1.-A*A)*AF*AF))/PIE
              T3=((1.-A*A)*AF-A)/PIE
              T4=(1.-A*A)*AF-A
              PIA=T1*(T2-T3*ACOS(T4))
            ELSE
              PIA=0.0
            ENDIF
C      
C           CALCULATE AVERAGE PRESSURE RATIO IN REGION IB
C      
            IF(SRIB .GT. 0.0)THEN
              T1=1./(1.-(1.-A)*AF)
              T2=AF*SQRT(1.-A*A)/PIE
              T3=1.+A*AF-SQRT(1.+2.*A*AF-(1.-A*A)*AF*AF)
              PIB=T1*(ACOS((1.-A*A)*AF-A)/PIE+T2*LOG(ABS(T3)))
            ELSE
              PIB=0.0
            ENDIF
C      
C          CALCULATE AVERAGE PRESSURE RATIO IN REGION II
C      
            PII=0.5
C      
C          CALCULATE AVERAGE PRESSURE RATIO IN REGION III
C      
            PIII=0.5
C      
C *** HERE FOR FLAP TAPER RATIO ZERO
C      
         ELSEIF(LAMDAF.EQ.0.)THEN
C      
C           CALCULATE AREA RATIO FOR TWO-DIMENSIONAL REGION
C      
            SRO=(1.-A)/(1.-D)-LAMDAF**2*(1.+A)/(1.+D)
            SRO=SRO/(1.-LAMDAF**2)
C      
C           CALCULATE AREA RATIO FOR REGION I
C      
            SRI=2.*(A-D)/((1.-LAMDAF**2)*(1-D**2))
C      
C           NOTE THAT THE AREA RATIO IS ZERO FOR REGION II
C           NO CONTRIBUTION FROM REGION II
C      
            SRII=0.0
C      
C           CALCULATE AVERAGE PRESSURE RATIO IN REGION I
C      
            PI=SQRT((1-A**2)*(1.-D**2))-(1.-A)*(1+D)
            PI=PI/(2.*(A-D))
C      
            PIA=0.
            PIB=0.
            PIII=0.
C      
         ENDIF
C      
C *** END TAPER LOGIC
C      
C *** CALCULATE THE LIFT COEFFICIENT PER DEGREE OF ELEVATOR DEFLECTION
C     IF IEND=NSTA THE CONTROL GOES TO THE FIN TIP
C     OTHERWISE USE METHOD FOR FLAP INBOARD OF FIN TIP
C      
         IF(IEND .EQ. NSTA)THEN
           PART = SRO + PI*SRI + PIA*SRIA - PIB*SRIB + PIII*SRIII
         ELSE
           PART = SRO + PI*SRI + PII*SRII
         ENDIF
         CLDEL = 2.*CPO*PART/DELTA
C      
C        CORRECT FOR FLAP THICKNESS, REFERENCE AREAS
C      
         CLDEL=CLDEL*CORR*SF/SREF
C      
C *** CALCULATE THE EFFECTIVE FULL FIN DEFLECTION ANGLE
C     CNALPA = NORMAL FORCE CURVE SLOPE (INPUT PER DEG.,SINGLE PANEL)
C     CAZERO = ZERO LIFT AXIAL FORCE
C     CL_ALPHA, LIFT CURVE SLOPE = CNALPA - CAZERO
C      
         DELFF=CLDEL*DELTA/(CNALPA*RAD-CAZERO)
         CLD=CLDEL
C      
         DELFF=DELFF*RAD
C      
C *** END SUPERSONIC CALCULATIONS
C      
      ENDIF
C      
C *** TRANSONIC LOOP
C      
      IF(LTRANS .AND. ICNTR.LT.4)GOTO 1030
C      
C   TRANSONIC CUBIC SLPINE - ESTIMATE THE EFFECTIVE FULL FIN DEFLECTION
C   THE SPECIFIED TRANSONIC MACH NUMBER
C      
      IF(LTRANS)THEN
          X4=XMACH
          Y4=DELFF
C      
C   ESTIMATE DERIVATIVES AT ENDPOINTS
C   BACKWARDS FINITE DIFFERENCE LENGTH IS 0.1, DELTA X
C      
          DY1=(Y2-Y1)/0.1
C      
C  FORWARDS FINITE DIFFERENCE LENGTH IS 0.1, DELTA X
C      
          DY2=(Y4-Y3)/0.1
C      
C   CALL SUBROUTINE CUBIC TO FAIR BETWEEN MACH 0.8 AND MACH 1.4 USING A
C   CUBIC SPLINE
C      
          CALL CUBIC(XTRANS,X2,X3,Y2,Y3,DY1,DY2,DELFF)
C      
          XMACH=XTRANS
      ENDIF
C      
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE IDEAL(NACA,RHO,X0,THN,CAM)
C
C***  CALCULATE THE SECTION IDEAL AERODYNAMIC PARAMETERS
C
C  ROUTINE ADAPTED FROM DIGITAL DATCOM
C  ORIGINAL ROUTINE WRITTEN BY D. KINSEY, D. BOWERS, AFFDL
C  MODIFIED BY S.R. VUKELICH, MCDONNELL DOUGLAS
C
      COMMON /ASMVAR/ CBAR,A0,XC,MCC,CLCC,AI,ALO,CLI,ASEP,CLA0,
     1                M,ZTNU(32),ZCNU(32),ST1NU(32),ST2NU(32),
     2                ST3NU(32),ST4NU(32),ST5NU(32),X(32),THNU(32),
     3                THMU(32),VXOVU(32),VXOVL(32),CPUM(32),
     4                CPLM(32),BO(32),CPI(32)
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      CHARACTER*4 A4HS,NACA
      DIMENSION NACA(80),X0(50),THN(50),CAM(50)
      DATA A4HS/'S   '/
C
      XN=32.
      N=XN
      L=N-1
      DO 1000 J=1,L
      XMU=J
      THMU(J)=XMU*PI/XN
 1000 CONTINUE
      DO 1010 I=1,N
      XNU=I
      THNU(I)=XNU*PI/XN
      X(I)=.5*(COS(THNU(I))+1.)
 1010 CONTINUE
      A0=SQRT(2.*RHO)
C
C***  OBTAIN THICKNESS AT CALCULATED X(I) FOR WEBER ANALYSIS
C
      IF(NACA(8).EQ.A4HS)GO TO 1030
      DO 1020 I=1,N
      CALL POLINT(X0,THN,M,X(I),ZTNU(I),DYDX)
 1020 CONTINUE
      GO TO 1050
 1030 CONTINUE
C
C***  HERE FOR SUPERSONIC AIRFOILS
C
      IN=0
      MI=0
      NG=0
      DO 1040 I=1,N
      CALL LNTRP(X0,THN,M,X(I),ZTNU(I))
 1040 CONTINUE
 1050 CONTINUE
C
C***  DEFINE THE WEBER TERMS FOR THIS AIRFOIL
C
C***    ST1NU DEFINES THE SOURCE DISTRIBUTION IN PARALLEL FLOW
C***    ST2NU DEFINES THE SLOPE OF THE THICKNESS DISTRIBUTION
C
      DO 1080 I=1,N
      ST1NU(I)=0.0
      ST2NU(I)=0.0
      DO 1082 J=1,L
      IF(I.EQ.J)GO TO 1060
      S1=((-1.)**(J-I)-1.)/XN*2.*SIN(THMU(J))/
     1  (COS(THMU(J))-COS(THNU(I)))**2
      S2=-2.*(-1.)**(J-I)*SIN(THMU(J))/(SIN(THNU(I))*
     1  (COS(THMU(J))-COS(THNU(I))))
      GO TO 1070
 1060 S1=XN/SIN(THNU(I))
      S2=COS(THNU(I))/(SIN(THNU(I)))**2
 1070 YS1=S1*ZTNU(J)
      YS2=S2*ZTNU(J)
      ST2NU(I)=ST2NU(I)+YS2
      ST1NU(I)=ST1NU(I)+YS1
 1082 CONTINUE
 1080 CONTINUE
      ST1NU(N)=ST1NU(N)+XN*A0
C
C***    ST3NU DEFINES THE VORTEX DISTRIBUTION IN NORMAL FLOW
C
      DO 1110 I=1,N
      ST3NU(I)=0.0
      DO 1112 J=1,L
      IF(I.EQ.J) GO TO 1090
      S3=((-1.)**(J-I)-1.)/XN*2.*SIN(THMU(J))/
     1   (COS(THMU(J))-COS(THNU(I)))**2+2./XN*
     2   (1.-(-1.)**(J-I))/(SIN(THMU(J))*
     3   (COS(THMU(J))-COS(THNU(I))))
      GO TO 1100
 1090 S3=XN/SIN(THNU(I))
 1100 YS3=S3*ZTNU(J)
      ST3NU(I)=ST3NU(I)+YS3
 1112 CONTINUE
 1110 CONTINUE
      DO 1140 I=1,N
      IF(I.EQ.N)GO TO 1120
      S3=((-1.)**I-1.)/(XN*(1.+COS(THNU(I))))
      GO TO 1130
 1120 S3=0.0
 1130 Y=S3*SQRT(RHO/2.)
      IF(I.NE.N) GO TO 1140
      Y=XN/2.*A0
      ST3NU(I)=ST3NU(I)+Y
 1140 CONTINUE
C
C*** OBTAIN MEAN LINE DISTRIBUTION AT CALCULATED X(I) FOR WEBER ANALYSIS
C
      DO 1150 I=1,N
      CALL POLINT(X0,CAM,M,X(I),ZCNU(I),DYDX)
 1150 CONTINUE
C
C***    ST4NU DEFINES THE VORTEX DISTRIBUTION DUE TO CAMBER
C***    ST5NU DEFINES THE SLOPE OF THE MEAN LINE
C
      DO 1180 I=1,N
      ST4NU(I)=0.0
      ST5NU(I)=0.0
      DO 1182 J=1,L
      IF(I.EQ.J)GO TO 1160
      S4=2.*((-1.)**(J-I)-1.)/(XN*SIN(THNU(I)))*(1.-COS(THMU(J))*
     1  COS(THNU(I)))/(COS(THNU(I))-COS(THMU(J)))**2-2.*((-1.)**J-1.)/
     2  (XN*SIN(THNU(I))*(1.-COS(THMU(J))))
      S5=-2.*(-1.)**(J-I)/(COS(THMU(J))-COS(THNU(I)))
      GO TO 1170
 1160 S4=XN/SIN(THNU(I))-2.*((-1.)**J-1.)/(XN*SIN(THNU(I))*
     1  (1.-COS(THNU(I))))
      S5=-COS(THNU(I))/(SIN(THNU(I)))**2
 1170 YS4=S4*ZCNU(J)
      YS5=S5*ZCNU(J)
      ST4NU(I)=ST4NU(I)+YS4
      ST5NU(I)=ST5NU(I)+YS5
 1182 CONTINUE
 1180 CONTINUE
C
C***  GET PLANFORM IDEAL PARAMETERS
C
      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*
     1  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 1200 I=5,L
      IF(I .GT. NM5) GO TO 1190
      T3=-ZCNU(I)*COS(THNU(I))/(SIN(THNU(I))/2.)**2
      SUMAI=SUMAI+T3
 1190 T4=ZCNU(I)/(1.-COS(THNU(I)))
      SUMAL=SUMAL+T4
 1200 CONTINUE
C
C***  IDEAL ANGLE OF ATTACK
C
      DAI=.5/XN*(T1+SUMAI)
      AI=RAD*(DAI05+DAI+DAI95)
C
C***  ANGLE OF ATTACK FOR ZERO LIFT
C
      DALO=-2./XN*(T2+SUMAL)
      ALO=RAD*(DA95+DALO)
C
C***  IDEAL LIFT COEFFICIENT
C
      CLI=2.*PI/RAD*(AI-ALO)
 1210 CONTINUE
C
C***  PITCHING MOMENT ABOUT THE QUARTER CHORD
C
      SUMCM=0.0
      DO 1220 I=1,L
      T5=ZCNU(I)*COS(THNU(I))
      SUMCM=SUMCM+T5
 1220 CONTINUE
      XMUO=SUMCM*(-PI/XN)
      CMCO4=2.*XMUO+PI/2.*ALO/RAD
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE MAJERR(GO,IWARN)
C      
C***  SUBROUTINE TO DETERMINE IF ANY MAJOR ERRORS CAN BE DETECTED
C***  BY LOOKING AT THE NAMELISTS READ
C      
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C      
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C      
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      REAL NALPHA,NMACH,MACH
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     1                TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,
     2                POWER,DISCON(20),ELLIP(50),H(50),
     3                ENOSE,ECENTR,EAFT,DEXIT,BASE,BETAN,JMACH(20),
     4                PRAT(20),TRAT(20),PROTUB,NPROT,PTYPE(20),
     5                XPROT(20),NLOC(20),BLDMEM(20),BLDTYP(100),
     6                LPROT(100),WPROT(100),HPROT(100),OPROT(100)
      REAL NX,LNOSE,LCENTR,LAFT,JMACH,NPROT,NLOC,LPROT
C      
      LOGICAL TRUNC,BASE,PROTUB
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHIROL(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IADD,MFR(20)
C      
      REAL NIN,INTYPE,LDIV,MFR
      LOGICAL ICOVER,IADD
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /FSET1/  F1IN(399)
      COMMON /FSET2/  F2IN(399)
      COMMON /FSET3/  F3IN(399)
      COMMON /FSET4/  F4IN(399)
C      
      DIMENSION TMACH(20),TREN(20),TTINF(20),TPINF(20),IORDER(20),
     1 TALT(20),TVINF(20),TJMACH(20),TPRAT(20),TTRAT(20),TMFR(20)
C      
      LOGICAL GO,IWARN,LMACH,LVINF,LBODY
C      
C***  SORT ALPHA ARRAY IN ASCENDING ORDER
C***  SORT  REN, TINF AND PINF IN ASCENDING MACH/VINF ORDER
C      
      NM=NMACH+0.5
      NA=NALPHA+0.5
      LMACH=.FALSE.
      LVINF=.FALSE.
C      
      IF(NA .GT. 0)CALL SORT(NA,ALPHA,IORDER)
C      
      DO 1000 I=1,NM
         IF(MACH(I) .NE. UNUSED)LMACH=.TRUE.
         IF(VINF(I) .NE. UNUSED)LVINF=.TRUE.
         TMACH(I)=MACH(I)
         TREN(I)=REN(I)
         TVINF(I)=VINF(I)
         TTINF(I)=TINF(I)
         TPINF(I)=PINF(I)
         TJMACH(I)=JMACH(I)
         TPRAT(I)=PRAT(I)
         TTRAT(I)=TRAT(I)
         TMFR(I)=MFR(I)
         TALT(I)=ALT(I)
 1000 CONTINUE
C      
C***  IF BOTH MACH AND VINF INPUT, DO NOT SORT
C      
      IF(NM .LE. 1)GO TO 1020
      IF(LMACH .AND. LVINF)GO TO 1020
      IF(.NOT.(LMACH .OR. LVINF))GO TO 1020
C      
      IF(LMACH)CALL SORT(NM,MACH,IORDER)
      IF(LVINF)CALL SORT(NM,VINF,IORDER)
C      
      DO 1010 J=1,NM
         I=IORDER(J)
         REN(J)=TREN(I)
         TINF(J)=TTINF(I)
         PINF(J)=TPINF(I)
         JMACH(J)=TJMACH(I)
         PRAT(J)=TPRAT(I)
         TRAT(J)=TTRAT(I)
         MFR(J)=TMFR(I)
         ALT(J)=TALT(I)
 1010 CONTINUE
C      
C***  CHECK FOR FLIGHT CONDITION INPUTS
C      
 1020 IF(.NOT.LFLT .AND. PARTS(18))WRITE(6,1160)
      IF(.NOT.LFLT)GO=.FALSE.
      IF(PHI .EQ. UNUSED)PHI=0.
      IF(BETA .EQ. UNUSED)BETA=0.
C      
C***  VERIFY XO DEFINITION
C      
      IF(XO .EQ. UNUSED)XO=0.
      IF(NX .GT. 1. .AND. XO .EQ. UNUSED)XO=X(1)
C      
C***  VERIFY C. G. DEFINITION
C      
      IF(XCG .EQ. UNUSED)XCG=0.
      IF(ZCG .EQ. UNUSED)ZCG=0.
C      
C***  FATAL ERROR IF NMACH .LE. UNUSED OR NALPHA .LE. 1.
C***  OR MACH .LE. 0.0 AND VINF .LE. 0.0
C      
      IF(LFLT .AND. NMACH .LE. UNUSED .AND. PARTS(18))WRITE(6,1190)
      IF(LFLT .AND. NMACH .LE. UNUSED)GO=.FALSE.
      IF(LFLT .AND. NALPHA .LE. 1. .AND. PARTS(18))WRITE(6,1200)
      IF(LFLT .AND. NALPHA .LE. UNUSED)ALPHA(1)=0.
      IF(LFLT .AND. NALPHA .LE. UNUSED)ALPHA(2)=1.
      IF(LFLT .AND. NALPHA .LE. UNUSED)NALPHA=2.
      IF(LFLT .AND. NALPHA .EQ. 1.)ALPHA(2)=ALPHA(1)+1.
      IF(LFLT .AND. NALPHA .EQ. 1.)NALPHA=2.
      IF(NM .LT. 1)NM=1
      DO 1030 I=1,NM
C      
C***  CHECK FOR INPUT SPEED REFERENCE
C      
      IF(LFLT .AND. MACH(I) .LE. UNUSED .AND. VINF(I) .LE. UNUSED
     1 .AND. PARTS(18))WRITE(6,1210)I
      IF(LFLT .AND. MACH(I) .LE. UNUSED .AND. VINF(I) .LE. UNUSED)
     1 GO=.FALSE.
C      
C***  IF NEED REYNOLDS NUMBER, SET ALT=0.0
C      
      IF(LFLT .AND. ALT(I) .EQ. UNUSED .AND. PINF(I) .EQ. UNUSED
     1   .AND. REN(I) .EQ. UNUSED .AND. PARTS(18))WRITE(6,1250)I
      IF(LFLT .AND. ALT(I) .EQ. UNUSED .AND. PINF(I) .EQ. UNUSED
     1   .AND. REN(I) .EQ. UNUSED) ALT(I)=0.0
C      
 1030 CONTINUE
C      
C***  CHECK FOR REFERENCE QUANTITIES INPUT, PRINT ERROR IF ABSENT
C      
      IF(.NOT.LREFQ .AND. PARTS(18))WRITE(6,1170)
      IF(SREF .GE. 0. .AND. SREF .LE. UNUSED .AND. LREFQ
     1   .AND. PARTS(18))WRITE(6,1220)
      IF(LREF .GE. 0. .AND. LREF .LE. UNUSED .AND. LREFQ
     1   .AND. PARTS(18))WRITE(6,1230)
      IF(SCALE .LE. UNUSED)SCALE=1.
C      
C***  CHECK FOR BODY AND/OR FINS INPUT
C      
      LBODY=LAXIS .OR. LELLB .OR. LARBOD
C      
      IF(.NOT.LBODY.AND..NOT.(LFIN1.OR.LFIN2.OR.LFIN3.OR.LFIN4)
     1 .AND. PARTS(18))WRITE(6,1180)
      IF(.NOT.LBODY.AND..NOT.(LFIN1.OR.LFIN2.OR.LFIN3.OR.LFIN4))
     1 GO=.FALSE.
C      
C***  CHECK FOR PROPER INPUTS FOR FIN PARAMETERS
C      
C .. NUMBER OF FIN PANELS MUST BE FROM 1 TO 4
C      
      NPANEL=F1IN(112)+.5
      NSET=1
      IF(LFIN1.AND.NPANEL.LT.1)F1IN(112)=4.
      IF(LFIN1.AND.NPANEL.LT.1 .AND. PARTS(18))
     1   WRITE(6,1400)NSET,F1IN(112)
      IF(LFIN1.AND.NPANEL.GT.8)F1IN(112)=8.
      IF(LFIN1.AND.NPANEL.GT.8 .AND. PARTS(18))
     1   WRITE(6,1400)NSET,F1IN(112)
      NPANEL=F2IN(112)+.5
      NSET=2
      IF(LFIN2.AND.NPANEL.LT.1)F2IN(112)=4.
      IF(LFIN2.AND.NPANEL.LT.1 .AND. PARTS(18))
     1   WRITE(6,1400)NSET,F2IN(112)
      IF(LFIN2.AND.NPANEL.GT.8)F2IN(112)=8.
      IF(LFIN2.AND.NPANEL.GT.8 .AND. PARTS(18))
     1   WRITE(6,1400)NSET,F2IN(112)
      NPANEL=F3IN(112)+.5
      NSET=3
      IF(LFIN3.AND.NPANEL.LT.1)F3IN(112)=4.
      IF(LFIN3.AND.NPANEL.LT.1 .AND. PARTS(18))
     1   WRITE(6,1400)NSET,F3IN(112)
      IF(LFIN3.AND.NPANEL.GT.8)F3IN(112)=8.
      IF(LFIN3.AND.NPANEL.GT.8 .AND. PARTS(18))
     1   WRITE(6,1400)NSET,F3IN(112)
      NPANEL=F4IN(112)+.5
      NSET=4
      IF(LFIN4.AND.NPANEL.LT.1)F4IN(112)=4.
      IF(LFIN4.AND.NPANEL.LT.1 .AND. PARTS(18))
     1   WRITE(6,1400)NSET,F4IN(112)
      IF(LFIN4.AND.NPANEL.GT.8)F4IN(112)=8.
      IF(LFIN4.AND.NPANEL.GT.8 .AND. PARTS(18))
     1   WRITE(6,1400)NSET,F4IN(112)
      DO 1050 I=1,10
         IF(F1IN(I+11).LT.0. .OR. F1IN(I+11).GT.1.)GO TO 1040
         IF(F1IN(I+21).LT.0. .OR. F1IN(I+21).GT.1.)GO TO 1040
         IF(F1IN(I+31).LT.0. .OR. F1IN(I+31).GT.1.)GO TO 1040
         IF(F1IN(I+41).LT.0. .OR. F1IN(I+41).GT.1.)GO TO 1040
         IF(F1IN(I+61).LT.0. .OR. F1IN(I+61).GT.1.)GO TO 1040
         IF(F1IN(I+71).LT.0. .OR. F1IN(I+71).GT.1.)GO TO 1040
         IF(F2IN(I+11).LT.0. .OR. F2IN(I+11).GT.1.)GO TO 1040
         IF(F2IN(I+21).LT.0. .OR. F2IN(I+21).GT.1.)GO TO 1040
         IF(F2IN(I+31).LT.0. .OR. F2IN(I+31).GT.1.)GO TO 1040
         IF(F2IN(I+41).LT.0. .OR. F2IN(I+41).GT.1.)GO TO 1040
         IF(F2IN(I+61).LT.0. .OR. F2IN(I+61).GT.1.)GO TO 1040
         IF(F2IN(I+71).LT.0. .OR. F2IN(I+71).GT.1.)GO TO 1040
         IF(F3IN(I+11).LT.0. .OR. F3IN(I+11).GT.1.)GO TO 1040
         IF(F3IN(I+21).LT.0. .OR. F3IN(I+21).GT.1.)GO TO 1040
         IF(F3IN(I+31).LT.0. .OR. F3IN(I+31).GT.1.)GO TO 1040
         IF(F3IN(I+41).LT.0. .OR. F3IN(I+41).GT.1.)GO TO 1040
         IF(F3IN(I+61).LT.0. .OR. F3IN(I+61).GT.1.)GO TO 1040
         IF(F3IN(I+71).LT.0. .OR. F3IN(I+71).GT.1.)GO TO 1040
         IF(F4IN(I+11).LT.0. .OR. F4IN(I+11).GT.1.)GO TO 1040
         IF(F4IN(I+21).LT.0. .OR. F4IN(I+21).GT.1.)GO TO 1040
         IF(F4IN(I+31).LT.0. .OR. F4IN(I+31).GT.1.)GO TO 1040
         IF(F4IN(I+41).LT.0. .OR. F4IN(I+41).GT.1.)GO TO 1040
         IF(F4IN(I+61).LT.0. .OR. F4IN(I+61).GT.1.)GO TO 1040
         IF(F4IN(I+71).LT.0. .OR. F4IN(I+71).GT.1.)GO TO 1040
C      
         GO TO 1050
C      
 1040    CONTINUE
C      
         IF(PARTS(18))WRITE(6,1390)
         GO=.FALSE.
         GO TO 1060
C      
 1050 CONTINUE
C      
 1060 CONTINUE
C      
      IF((NX .EQ. 1. .OR. NX .LE. 0.) .AND. PARTS(18))WRITE(6,1240)
      IF(NX .EQ. UNUSED)GO TO 1080
C      
C***  CHECK FOR CONFLICT IN BODY INPUTS
C      
      LL=2
      LU=(NX-1.)+.5
      DO 1070 L=LL,LU
      IF(NX .GT. 1. .AND. (X(L) .EQ. UNUSED .OR. R(L) .EQ. UNUSED)
     1 .AND. PARTS(18))WRITE(6,1380)
      IF(NX .GT. 1. .AND. (X(L) .EQ. UNUSED .OR. R(L) .EQ. UNUSED))
     1 GO=.FALSE.
      IF(.NOT. GO)GO TO 1080
 1070 CONTINUE
C      
C ... CHECK FOR BODY SECTIONS DEFINED BUT DIAMETERS ARE NOT
C      
 1080 IF(LNOSE .GT. UNUSED .AND. DNOSE .LE. UNUSED .AND. PARTS(18))
     1 WRITE(6,1340)
      IF(LNOSE .GT. UNUSED .AND. DNOSE .LE. UNUSED)DNOSE=1.
      IF(BNOSE .LE. UNUSED .AND. LNOSE .EQ. DNOSE/2. .AND. PARTS(18))
     1 WRITE(6,1370)
      IF(BNOSE .LE. UNUSED .AND. LNOSE .EQ. DNOSE/2.)BNOSE=LNOSE
      IF(LCENTR .GT. UNUSED .AND. DCENTR .EQ. UNUSED .AND. PARTS(18))
     1 WRITE(6,1350)
      IF(LCENTR .GT. UNUSED .AND. DCENTR .EQ. UNUSED)DCENTR=DNOSE
C      
C  NUMBER OF POINTS MUST NOT BE GREATER THAN 50
C      
      IF(NX .GT. 50. .AND. PARTS(18))WRITE(6,1310)
      IF(NX .GT. 50.)NX=50.
C      
C***  WARNING MESSAGE IF SUBSONIC/TRANSONIC AND BASE-JET PLUME
C***         CALCULATIONS DESIRED
C
      IF(BASE.AND.(MACH(1).LT.1.2).AND.PARTS(18))WRITE(6,1410)
C
C***  WARNING MESSAGE IF INLET ADDITIVE DRAG CALCULATIONS
C***          DESIRED AND MACH NUMBERS ARE LESS THAN 1.0
      IF(LINLET.AND.IADD.AND.(MACH(1).LT.1.0))WRITE(6,1450)
C      
C*** PART CONTROL CARD TURNS ON ALL PARTIAL OUTPUT
C      
      IF(.NOT. LPART)GO TO 1110
      DO 1100 I=1,16
         PARTS(I)=.TRUE.
 1100 CONTINUE
C      
 1110 CONTINUE
C      
C***  WRITE WARNING MESSAGE IF DIMENSIONAL UNITS ARE CHANGED
C      
      IF(IWARN .AND. PARTS(18))WRITE(6,1260)
C      
      IF(BLAYER .LT. 1.)BLAYER=0.
      IF(BLAYER .GE. 1.)BLAYER=1.
      IF(BLAYER .EQ. 0. .AND. PARTS(18))WRITE(6,1320)
      IF(BLAYER .NE. 0. .AND. PARTS(18))WRITE(6,1330)
C      
      IF(LDIMIN .AND. PARTS(18))WRITE(6,1270)SCALE
      IF(LDIMCM .AND. PARTS(18))WRITE(6,1280)SCALE
      IF(LDIMM  .AND. PARTS(18))WRITE(6,1290)SCALE
      IF(.NOT.(LDIMIN .OR. LDIMCM .OR. LDIMM) .AND. PARTS(18))
     1 WRITE(6,1300)SCALE
      IF(SCALE .NE. UNUSED .AND. SCALE .NE. 1. .AND. PARTS(18))
     1 WRITE(6,1360)
C      
      IF(LFIN1 .AND. F1IN(102).EQ.UNUSED)F1IN(102)=0.
      IF(LFIN2 .AND. F2IN(102).EQ.UNUSED)F2IN(102)=0.
      IF(LFIN3 .AND. F3IN(102).EQ.UNUSED)F3IN(102)=0.
      IF(LFIN4 .AND. F4IN(102).EQ.UNUSED)F4IN(102)=0.

C      
      DO 1130 I=1,4
         DELPH1=360./F1IN(112)
         DELPH2=360./F2IN(112)
         DELPH3=360./F3IN(112)
         DELPH4=360./F4IN(112)
         DO 1120 J=1,8
            IF(LFIN1 .AND. F1IN(J+381) .EQ. UNUSED
     1         .AND. FLOAT(J) .LE. F1IN(112)+.1)
     2         F1IN(J+381)=FLOAT(J-1)*DELPH1
            IF(LFIN2 .AND. F2IN(J+381) .EQ. UNUSED
     1         .AND. FLOAT(J) .LE. F2IN(112)+.1)
     2         F2IN(J+381)=FLOAT(J-1)*DELPH2
            IF(LFIN3 .AND. F3IN(J+381) .EQ. UNUSED
     1         .AND. FLOAT(J) .LE. F3IN(112)+.1)
     2         F3IN(J+381)=FLOAT(J-1)*DELPH3
            IF(LFIN4 .AND. F4IN(J+381) .EQ. UNUSED
     1         .AND. FLOAT(J) .LE. F4IN(112)+.1)
     2         F4IN(J+381)=FLOAT(J-1)*DELPH4
 1120    CONTINUE
 1130 CONTINUE
C      
 1160 FORMAT(4X,'* FATAL ERROR * FLIGHT CONDITION INPUTS FROM NAMELIST',
     1 ' FLTCON MISSING')
 1170 FORMAT(4X,'* WARNING * REFERENCE QUANTITIES FROM NAMELIST',
     1 ' REFQ MISSING')
 1180 FORMAT(4X,'* FATAL ERROR * NEITHER A BODY NOR A SET OF',
     1 ' FINS HAVE BEEN DEFINED')
 1190 FORMAT(4X,'* FATAL ERROR * THE NUMBER OF MACH NUMBERS IS LESS',
     1 ' THAN ONE')
 1200 FORMAT(4X,'* WARNING * THE NUMBER OF ANGLES OF ATTACK IS LESS',
     1 ' THAN TWO')
 1210 FORMAT(4X,'* FATAL ERROR * THE SPEED SPECIFIED IS TOO SMALL',
     1 ' FOR INPUT MACH ',I2)
 1220 FORMAT(4X,'* WARNING * THE REFERENCE AREA IS UNSPECIFIED,',
     1 ' DEFAULT VALUE ASSUMED')
 1230 FORMAT(4X,'* WARNING * THE REFERENCE LENGTH IS UNSPECIFIED,',
     1 ' DEFAULT VALUE ASSUMED')
 1240 FORMAT(4X,'* WARNING * THE NUMBER OF BODY INPUT STATIONS,',
     1 ' (NX), IS LESS THAN TWO')
 1250 FORMAT(4X,'* WARNING * THE REYNOLDS NUMBER IS NOT DEFINED,',
     1 ' FOR INPUT SPEED',I3,/,4X,
     2 12X,'SEA LEVEL ALTITUDE ASSUMED')
 1260 FORMAT(4X,'* WARNING * THIS IS A SAVE CASE AND THE UNITS,',
     1 ' ARE BEING REDEFINED')
 1270 FORMAT(4X,'THE INPUT UNITS ARE IN INCHES, THE SCALE FACTOR IS ',
     1 F8.4)
 1280 FORMAT(4X,'THE INPUT UNITS ARE IN CENTIMETERS, ',
     1 'THE SCALE FACTOR IS ',F8.4)
 1290 FORMAT(4X,'THE INPUT UNITS ARE IN METERS, THE SCALE FACTOR IS ',
     1 F8.4)
 1300 FORMAT(4X,'THE INPUT UNITS ARE IN FEET, THE SCALE FACTOR IS ',
     1 F8.4)
 1310 FORMAT(4X,'* WARNING * THE NUMBER OF INPUT POINTS IN NAMELIST',
     1 ' AXIBOD IS GREATER THAN 50')
 1320 FORMAT(4X,'THE BOUNDARY LAYER IS ASSUMED TO BE TURBULENT')
 1330 FORMAT(4X,'THE BOUNDARY LAYER IS ASSUMED TO DEVELOP NATURALLY')
 1340 FORMAT(4X,'* WARNING * NOSE SECTION DEFINED BUT BASE',
     1 ' DIAMETER ZERO OR NOT INPUT',/,4X,12X,'VALUE OF 1.0 ASSUMED')
 1350 FORMAT(4X,'* WARNING * CENTER SECTION DEFINED BUT BASE',
     1 ' DIAMETER NOT INPUT',/,4X,12X,'CYLINDRICAL SECTION ASSUMED')
 1360 FORMAT(4X,'ALL GEOMETRIC INPUTS',
     1 ' WILL BE MULTIPLIED BY THE SCALE FACTOR')
 1370 FORMAT(4X,'* WARNING * NOSE LENGTH EQUALS BASE RADIUS,',
     1       ' SPHERICAL NOSE BLUNTNESS ASSUMED')
 1380 FORMAT(4X,'* FATAL ERROR * BODY GEOMETRY INPUT CONFLICT')
 1390 FORMAT(4X,'* FATAL ERROR * FIN GEOMETRY INPUTS NOT CONSISTENT')
 1400 FORMAT(4X,'* WARNING * NUMBER OF PANELS IN FIN SET ',I2,
     1 ' CHANGED TO',F3.0)
 1410 FORMAT(4X,'* WARNING * BASE-JET PLUME EFFECTS WILL NOT BE ',/,
     1     12X,'CALCULATED FOR SUBSONIC/TRANSONIC SPEEDS')
 1450 FORMAT(4X,'* WARNING * INLET ADDITIVE DRAG WILL NOT BE ',/,
     1     12X,'CALCULATED FOR MACH NUMBERS LESS THAN 1.0')
      RETURN 
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PRIFIN
C
C***  SUBROUTINE TO CONTROL THE PRINTING OF FIN RESULTS FROM THE
C***  GEOMETRIC CALCULATIONS
C
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      IF(.NOT.(PARTS(2).OR.PARTS(3).OR.PARTS(4).OR.PARTS(5)))GO TO 1020
C
      CALL HEADR9
C
      WRITE(6,1000)
C
C***  CONVERT DATA TO USER UNITS IF NEEDED
C
      IF(LDIMIN .OR. LDIMCM .OR. LDIMM)CALL CVRTFT
C
      IF(LFIN1.AND.PARTS(2))CALL PRIF1
C
      WRITE(6,1010)
      IF(LFIN2.AND.PARTS(3))CALL PRIF2
C
      WRITE(6,1010)
      IF(LFIN3.AND.PARTS(4))CALL PRIF3
C
      WRITE(6,1010)
      IF(LFIN4.AND.PARTS(5))CALL PRIF4
C
C***  CONVERT DATA TO INTERNAL UNITS IF NEEDED
C
      IF(LDIMIN .OR. LDIMCM .OR. LDIMM)CALL CVRTUS
C
 1000 FORMAT(22X,'GEOMETRIC RESULTS FOR FIN SETS',/)
 1010 FORMAT(' ')
C
 1020 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SORT(N,X,IORDER)
C
C***  SORT FIRST N ELEMENTS OF ARRAY X IN ASCENDING ORDER
C***  IORDER IS THE SORTING ORDER
C
      DIMENSION X(N),IORDER(N)
C
      IF(N .LE. 1)GO TO 1030
C
      DO 1000 I=1,N
         IORDER(I)=I
 1000 CONTINUE
C
      NM1=N-1
      DO 1020 IP=1,NM1
         NMIP=N-IP
         DO 1010 I=1,NMIP
            IF(X(I) .LE. X(I+1))GO TO 1010
            TEMP=X(I+1)
            X(I+1)=X(I)
            X(I)=TEMP
            ITEMP=IORDER(I+1)
            IORDER(I+1)=IORDER(I)
            IORDER(I)=ITEMP
 1010    CONTINUE
 1020 CONTINUE
C
 1030 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE USEFOL(IFIN,X,YUN,YLN,THN,CAM,RHO,T,DELTAY,
     1    KSHARP)
C
C***  FOLLOWING ARE THE DEFINITIONS OF EACH VARIABLE USED
C
C      X -- X/C STATIONS ALONG AIRFOIL CHORD
C     XU -- X/C STATION OF UPPER SURFACE
C     XL -- X/C STATION OF LOWER SURFACE
C    YUN -- Y/C OF SECTION AT XU
C    YLN -- Y/C OF SECTION AT XL
C    YUU -- Y/C OF SUPERSONIC AIRFOILS, UPPER SURFACE
C    YLL -- Y/C OF SUPERSONIC AIRFOILS, LOWER SURFACE
C    THN -- THICKNESS/C AT X
C    CAM -- CAMBER/C AT X
C    RHO -- LEADING EDGE RADIUS
C      T -- MAXIMUM AIRFOIL THICKNESS, FROM NACA DESIGNATION
C KSHARP -- SHAPE FACTOR FOR SUPERSONIC AIRFOILS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION X(50),YUN(50),YLN(50),THN(50),CAM(50)
C
      NP=0
C
C***  NUMBER OF INPUT POINTS
C
      DO 1000 I=2,50
         IF(X(I) .LE. X(I-1))GO TO 1010
         NP=I
 1000 CONTINUE
C
 1010 CONTINUE
C
      IF(NP .LE. 1)GO TO 1080
C
C***  DETERMINE INPUT TYPE
C
      IF(YUN(1).NE.UNUSED .AND. YLN(1).NE.UNUSED .AND.
     1   YUN(NP).NE.UNUSED .AND. YLN(NP).NE.UNUSED)GO TO 1030
C
C ... MEAN LINE AND THICKNESS DISTRIBUTION
C
      IF(THN(1).EQ.UNUSED .OR. THN(NP).EQ.UNUSED .OR.
     1   CAM(1).EQ.UNUSED .OR. CAM(NP).EQ.UNUSED)GO TO 1080
C
C ... COMPUTE YUN AND YLN FOR THN AND CAM
C
      YUN(1)=0.
      YLN(I)=0.
      DO 1020 I=2,NP
         CALL POLINT(X,CAM,NP,X(I),YY,DYDX)
         THETA=ATAN(DYDX)
         YUN(I)=CAM(I)+THN(I)/2.*COS(THETA)
         YLN(I)=CAM(I)-THN(I)/2.*COS(THETA)
 1020 CONTINUE
      GO TO 1060
C
C ... COMPUTE THN AND CAM FROM YUN AND YLN
C
 1030 CONTINUE
C
      CAM(1)=0.
      DO 1040 I=2,NP
         CAM(I)=(YUN(I)+YLN(I))/2.
 1040 CONTINUE
C
      THN(I)=0.
      DO 1050 I=2,NP
         CALL POLINT(X,CAM,NP,X(I),YY,DYDX)
         THETA=ATAN(DYDX)
         THN(I)=(YUN(I)-CAM(I))*2./COS(THETA)
 1050 CONTINUE
C
 1060 CONTINUE
C
      IF(RHO .EQ. UNUSED)RHO=0.
      IF(KSHARP .EQ. UNUSED)KSHARP=0.
C
C ... COMPUTE MAX THICKNESS
C
      DO 1070 I=2,NP
         IF(THN(I) .GT. THN(I-1))T=THN(I)
 1070 CONTINUE
C
C ... COMPUTE DELTA-Y
C
      CALL LNTRP(X,THN,NP,.0015,YU15)
      CALL LNTRP(X,THN,NP,.0600,YU60)
      DELTAY=(YU60-YU15)*100.
C
 1080 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE AIRFOL(IFIN,NACA,X,YUN,YLN,THN,CAM,CBAR,RHO,T,DELTAY,
     1    KSHARP,ALPI,ALPO,CLIDL)
C
C***  CALCULATE NACA DESIGNATED AIRFOIL COORDINATES
C
C***  FOLLOWING ARE THE DEFINITIONS OF EACH VARIABLE USED
C
C   NACA -- NACA AIRFOIL CONTROL CARD AS INPUT BY THE USER
C           NACA-X-Y-N
C               X=FIN NUMBER
C               Y=NACA SERIES (1, 4, 5, 6, OR S)
C               N=DESIGNATION
C      X -- X/C STATIONS ALONG AIRFOIL CHORD
C     XU -- X/C STATION OF UPPER SURFACE
C     XL -- X/C STATION OF LOWER SURFACE
C    YUN -- Y/C OF SECTION AT XU
C    YLN -- Y/C OF SECTION AT XL
C    YUU -- Y/C OF SUPERSONIC AIRFOILS, UPPER SURFACE
C    YLL -- Y/C OF SUPERSONIC AIRFOILS, LOWER SURFACE
C    THN -- THICKNESS/C AT X
C    CAM -- CAMBER/C AT X
C      L -- NUMBER OF AIRFOIL POINTS
C  I-LLL -- DECODED AIRFOIL DESIGNATION
C ALPHAI -- IDEAL ANGLE OF ATTACK
C ALPHAO -- ZERO-LIFT ANGLE OF ATTACK
C    AII -- IDEAL LIFT COEFFICIENT, FROM NACA DESIGNATION
C   CBAR -- MEAN GEOMETRIC CHORD OF PANEL
C    RHO -- LEADING EDGE RADIUS
C      T -- MAXIMUM AIRFOIL THICKNESS, FROM NACA DESIGNATION
C KSHARP -- SHAPE FACTOR FOR SUPERSONIC AIRFOILS
C   XOVC -- MAXIMUM THICKNESS CHORD STATION
C
      COMMON /SECVAR/ XU(50),XL(50),YU(50),YL(50),YUU(50),YLL(50),
     1                L,I,J,K,II,JJ,KK,III,JJJ,KKK,LLL,
     2                ALPHAI,ALPHAO,AII,XOVC
      COMMON /PARTF/  PARTS(19)
      LOGICAL PARTS,PARTT
      DIMENSION THN2(50),NACA(80),IUM(10),X(50),YUN(50),YLN(50),
     1 THN(50),CAM(50)
      REAL KSHARP
      CHARACTER*4 NACA
      EQUIVALENCE (IUM(1),I)
C
      PARTT=PARTS(IFIN+1)
      KSHARP=16./3.
      ALPHAI=0.
      ALPHAO=0.
      AII=0.
      IF(PARTT)CALL HEADR9
      IF(PARTT)WRITE(6,1230)IFIN
C
C  DECODE THE USERS INPUT NACA DESIGNATION
C
      CALL DECODE(NACA,NA,X,L,IUM)
C
C  CALCULATE THE AIRFOIL COORDINATES
C
      IF(NA .LT. 1 .OR. NA .GT. 7)WRITE(6,1240)IFIN,(NACA(I),I=1,80)
      IF(NA .LT. 1 .OR. NA .GT. 7)STOP
C
      GO TO (1000,1010,1020,1030,1040,1050,1060), NA
C
C NACA 4 SERIES
C
 1000 IF(PARTT)WRITE(6,1100)I,J,K,II
      CALL COORD4(X,XU,XL,YUN,YLN,L,I,J,K,II,JJ,KK,III,JJJ,
     1 THN,CAM,RHO,T)
      GO TO 1080
C
C NACA 4 MODIFIED SERIES
C
 1010 IF(PARTT)WRITE(6,1110)I,J,K,II,KK,III
      CALL CORD4M(X,XU,XL,YUN,YLN,L,I,J,K,II,JJ,KK,III,JJJ,
     1 THN,CAM,RHO,T)
      GO TO 1080
C
C NACA 5 SERIES
C
 1020 IF(PARTT)WRITE(6,1120)I,J,K,II,JJ
      CALL COORD5(X,XU,XL,YUN,YLN,L,I,J,K,II,JJ,KK,III,JJJ,
     1 THN,CAM,RHO,T)
      GO TO 1080
C
C NACA 5 MODIFIED SERIES
C
 1030 IF(PARTT)WRITE(6,1130)I,J,K,II,JJ,III,JJJ
      CALL CORD5M(X,XU,XL,YUN,YLN,L,I,J,K,II,JJ,KK,III,JJJ,
     1 THN,CAM,RHO,T)
      GO TO 1080
C
C NACA 1 SERIES
C
 1040 IF(PARTT)WRITE(6,1140)I,J,II,JJ,KK
      CALL COORD1(X,XU,XL,YUN,YLN,L,I,J,K,II,JJ,KK,III,JJJ,
     1 THN,CAM,ALPHAI,ALPHAO,AII,RHO,T)
      GO TO 1080
C
C NACA 6 SERIES
C
 1050 IF(K.EQ.0.AND.II.EQ.0.AND.PARTT)WRITE(6,1150)I,J,JJ,KK,III
      IF(K.NE.0.AND.II.EQ.0.AND.PARTT)WRITE(6,1160)I,J,K,JJ,KK,III
      IF(K.EQ.0.AND.II.NE.0.AND.PARTT)WRITE(6,1170)I,J,JJ,KK,III
      IF(K.NE.0.AND.II.NE.0.AND.PARTT)WRITE(6,1180)I,J,K,JJ,KK,III
      IF(JJJ.GE.1.AND.PARTT)WRITE(6,1190)JJJ
      CALL COORD6(X,XU,XL,YUN,YLN,L,I,J,K,II,JJ,KK,III,JJJ,
     1 THN,CAM,ALPHAI,ALPHAO,AII,RHO,T)
      GO TO 1080
C
C SUPERSONIC SERIES
C
 1060 IF(I.NE.2)GO TO 1070
      J=5
      K=0
      II=0
 1070 IF(PARTT)WRITE(6,1220)I,J,K,II,JJ,KK,III,JJJ,KKK,LLL
      CALL CORDSP(X,XU,XL,YUU,YLL,YU,YL,L,I,J,K,II,JJ,KK,III,JJJ,
     1 KKK,LLL,T,XOVC,KSHARP)
      CALL SUPXY(THN,CAM,X,XU,XL,YU,YL,YUN,YLN,L)
 1080 ALPI=ALPHAI
      ALPO=ALPHAO
      CLIDL=AII
      IF(PARTT)WRITE(6,1200)
C
C SET TOTAL AIRFOIL THICKNESS FOR OUTPUT
C
      DO 1090 M=1,L
      THN2(M)=2.*THN(M)
 1090 CONTINUE
C
C PRINT AIRFOIL COORDINATES
C
      IF(PARTT)WRITE(6,1210)(X(M),XU(M),YUN(M),XL(M),YLN(M),CAM(M),
     1 THN2(M),M=1,L)
C
C***  COMPUTE DELTA-Y
C
      CALL LNTRP(X,THN,L,.0015,YU15)
      CALL LNTRP(X,THN,L,.0600,YU60)
      DELTAY=(YU60-YU15)*100.
C
      RHO=RHO*CBAR
C
 1100 FORMAT(34X,'NACA ',4I1)
 1110 FORMAT(34X,'NACA ',4I1,' - ',2I1)
 1120 FORMAT(34X,'NACA ',5I1)
 1130 FORMAT(34X,'NACA ',5I1,' - ',2I1)
 1140 FORMAT(34X,'NACA ',2I1,' - ',3I1)
 1150 FORMAT(34X,'NACA ',2I1,'-',3I1)
 1160 FORMAT(34X,'NACA ',2I1,',',I1,'-',3I1)
 1170 FORMAT(34X,'NACA ',2I1,'A',3I1)
 1180 FORMAT(34X,'NACA ',2I1,',',I1,'A',3I1)
 1190 FORMAT(34X,'A=0.',I1)
 1200 FORMAT(/,4X,5X,'X/C',5X,'X-UPPER',3X,'Y-UPPER',3X,
     1  'X-LOWER',3X,'Y-LOWER',2X,'MEAN LINE',2X,'THICKNESS',/)
 1210 FORMAT(4X,7F10.5)
 1220 FORMAT(34X,'NACA S-',I1,'-',2I1,'.',I1,'-',2I1,'.',I1,
     1 '-',2I1,'.',I1)
 1230 FORMAT(4X,21X,'FIN SET NUMBER',I2,' AIRFOIL SECTION',/)
 1240 FORMAT(4X,'LIFTING SURFACE DESIGNATION INCORRECT',
     1 ' FOR FIN',I2,'.   EXECUTION ABORTED.',/,
     2 4X,'DESIGNATION IS ',80A1)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDXCPN(TNOSE,MACH,FNOSE,FCENTR,XCP)
C
C***  SUBROUTINE TO INTERPOLATE THE LONGITUDINAL CENTER OF PRESSURE
C***  DATA FOR CONE-CYLINDERS OR OGIVE-CYLINDERS IN THE TRANSONIC
C***  MACH REGIME
C
C***  DATA FROM MBB REPORT TN WE 2 - 97/69 AND WE 12 - 88/70
C
C***  VALID RANGES - MACH NUMBER 0.8 TO 1.2 (0.8 DATA USED AT LOWER M)
C***                 FNOSE         0. TO 2.5 (CONES)
C***                               .5 TO 3.5 (OGIVES)
C***                 FCENTR        6. TO 15. (CONES)
C***                               6. TO 18./20. (OGIVES)
C***  NOTE - SPHERICAL NOSE BLUNTNESS ASSUMED NEGLIGIBLE
C
C***  INPUTS
C
C  TNOSE -- NOSE TYPE, 0=CONICAL, 1=OGIVAL
C   MACH -- FREESTREAM MACH NUMBER
C  FNOSE -- NOSE THEORETICAL FINENESS RATIO (LENGTH/DMAX)
C  FCENTR-- CYLINDRICAL SECTION FINENESS RATIO
C
C***  OUTPUT
C
C    XCP -- LONGITUDINAL CENTER OF PRESSURE, CALIBERS FROM NOSE
C
      REAL MACH
C
      DIMENSION CONE00(15),CONE05(27),CONE15(18),CONE25(27)
      DIMENSION OGIV05(36),OGIV15(36),OGIV25(36),OGIV35(36)
      DIMENSION TMACH(9),TFA1(3),TFA2(4),TFA3(4)
      DIMENSION IROUT(2),XX(5),YY(5)
C
      DATA TMACH / 0.80,0.85,0.90,0.95,1.00,1.05,1.10,1.15,1.20 /
      DATA TFA1 / 6., 10., 15. /
      DATA TFA2 / 6., 10., 15., 20. /
      DATA TFA3 / 6., 10., 15., 18. /
C
C***  FOLLOWING DATA IS XCP+.4*FCENTR
C
      DATA CONE00 /
     * 5.80000, 6.00000, 6.20000, 5.65000, 4.95000, 8.50000, 8.95000,
     * 9.30000, 8.80000, 7.90000,11.65000,11.80000,11.90000,11.80000,
     *11.50000
     * /
      DATA CONE05 /
     * 5.08381, 5.69442, 5.49078, 3.85589, 3.23294, 3.27590, 3.61509,
     * 3.28823, 2.78896, 7.73856, 8.25078, 8.36790, 7.27584, 6.48003,
     * 6.54796, 6.59137, 6.75799, 6.65320,11.05799,11.42155,11.43998,
     *10.59482,10.76145,10.60731, 9.29288, 9.18824, 9.33004
     * /
      DATA CONE15 /
     * 4.42222, 4.41278, 4.32894, 4.26954, 4.23457, 4.27435, 6.97637,
     * 6.91696, 6.90715, 7.02023, 7.18510, 7.19936,10.20515,10.12022,
     *10.23440,10.67057,11.23072,11.24644
     * /
      DATA CONE25 /
     * 4.89600, 4.94857, 4.92601, 5.00366, 5.00613, 5.00865, 4.96101,
     * 4.83844, 4.66557, 7.45217, 7.50462, 7.58227, 7.83494, 7.98747,
     * 8.11528, 8.21770, 8.49558, 8.59794,10.83477,10.88733,11.03986,
     *11.56770,12.12068,12.09825,11.50028,10.95241,10.45459
     * /
      DATA OGIV05 /
     * 3.81484, 3.69015, 3.49175, 3.39155, 3.26686, 3.26480, 3.48356,
     * 3.28531, 2.94005, 6.26525, 6.14051, 5.96680, 6.03830, 6.23247,
     * 6.32865, 5.98314, 5.41686, 5.09603, 9.89237,10.18484,10.06005,
     *10.05809,10.27685,10.17669,10.05200, 9.68191, 9.21382,13.24970,
     *13.07594,13.02490,13.53819,14.14943,14.17190,13.60552,13.28444,
     *13.20897
     * /
      DATA OGIV15 /
     * 3.96916, 3.97383, 4.02784, 4.05729, 4.01239, 3.86904, 3.97228,
     * 3.90316, 3.63578, 6.32006, 6.39874, 6.47741, 6.70399, 6.80734,
     * 6.61465, 6.74244, 6.74722, 6.55431,10.07928,10.20719,10.38431,
     *10.70969,11.01050,10.96572,10.87182,10.40766, 9.79558,13.73960,
     *13.81839,13.99541,14.34545,14.94242,15.09533,14.48326,14.09299,
     *13.94918
     * /
      DATA OGIV25 /
     * 4.50461, 4.57200, 4.61425, 4.73118, 4.67396, 4.34200, 4.35929,
     * 4.37657, 4.26981, 6.98875, 7.08110, 7.22355, 7.46547, 7.63270,
     * 7.47546, 7.31802, 6.96092, 6.50473,10.29355,10.38608,10.72765,
     *11.19458,11.53614,11.37890,10.89719,10.36537, 9.85869,12.40629,
     *12.67316,13.13990,13.58187,13.82341,13.74086,13.78310,14.07494,
     *13.91788
     * /
      DATA OGIV35 /
     * 4.80873, 4.81294, 4.99310, 5.34867, 5.45341, 5.10604, 5.00994,
     * 4.88862, 4.71678, 7.57702, 7.58123, 7.63555, 7.94112, 8.27180,
     * 7.97475, 8.02907, 8.00828, 7.76134,11.12525,11.25478,11.45993,
     *12.01667,12.57340,12.37677,12.23045,12.23445,12.06282,13.28955,
     *13.29366,13.37318,13.80407,14.83790,15.31911,15.49906,15.75474,
     *15.35685
     * /
C
      AMACH=MACH
      IF(MACH .LT. 0.8)AMACH=0.8
C
C***  DETERMINE NOSE TYPE
C
      IF(TNOSE .NE. 0.)GO TO 1000
C
C***  HERE FOR CONICAL NOSES
C
C***  INTERPOLATE AT EACH NOSE FINENESS RATIO
C
      CALL MVLOOK(1,3,5,15,0.0,TFA1,TMACH,CONE00,AMACH,FCENTR,0.0,XCP00)
      CALL MVLOOK(1,3,9,27,0.5,TFA1,TMACH,CONE05,AMACH,FCENTR,0.5,XCP05)
      CALL MVLOOK(1,3,6,18,1.5,TFA1,TMACH,CONE15,AMACH,FCENTR,1.5,XCP15)
      CALL MVLOOK(1,3,9,27,2.5,TFA1,TMACH,CONE25,AMACH,FCENTR,2.5,XCP25)
C
C***  NOW LINEARILY INTERPOLATE AT FNOSE
C
      XX(1)=0.0
      XX(2)=0.5
      XX(3)=1.5
      XX(4)=2.5
C
C ... REMOVE .4*FCENTR FROM DATA
C
      YY(1)=XCP00-.4*FCENTR
      YY(2)=XCP05-.4*FCENTR
      YY(3)=XCP15-.4*FCENTR
      YY(4)=XCP25-.4*FCENTR
      CALL LNTRP(XX,YY,4,FNOSE,XCP)
C
      GO TO 1010
 1000 CONTINUE
C
C***  OGIVAL (AND OTHER) SHAPES
C
C***  INTERPOLATE AT EACH NOSE FINENESS RATIO
C
      CALL MVLOOK(1,3,5,15,0.0,TFA1,TMACH,CONE00,AMACH,FCENTR,0.0,XCP00)
      CALL MVLOOK(1,4,9,36,0.5,TFA2,TMACH,OGIV05,AMACH,FCENTR,0.5,XCP05)
      CALL MVLOOK(1,4,9,36,1.5,TFA2,TMACH,OGIV15,AMACH,FCENTR,1.5,XCP15)
      CALL MVLOOK(1,4,9,36,2.5,TFA3,TMACH,OGIV25,AMACH,FCENTR,2.5,XCP25)
      CALL MVLOOK(1,4,9,36,3.5,TFA3,TMACH,OGIV35,AMACH,FCENTR,3.5,XCP35)
C
C***  NOW LINEARILY INTERPOLATE AT FNOSE
C
      XX(1)=0.0
      XX(2)=0.5
      XX(3)=1.5
      XX(4)=2.5
      XX(5)=3.5
C
C ... REMOVE .4*FCENTR FROM DATA
C
      YY(1)=XCP00-.4*FCENTR
      YY(2)=XCP05-.4*FCENTR
      YY(3)=XCP15-.4*FCENTR
      YY(4)=XCP25-.4*FCENTR
      YY(5)=XCP35-.4*FCENTR
      CALL LNTRP(XX,YY,5,FNOSE,XCP)
C
 1010 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CNNEWT(A,B,PHI,CNCNO)
C
C ** NEWTONIAN CORRECTION FACTOR FOR ELLIPTICAL BODY
C ** CORRECTION DUE TO EXPERIMENT BASED UPON NACA TN D-7228, TABLE 1
C
C ** INPUTS
C
C       A -- MAJOR AXIS
C       B -- MINOR AXIS
C     PHI -- BODY ROLL ANGLE, DEGREES
C            PHI= 0 IF MAJOR AXIS PERPENDICULAR TO CROSS FLOW
C            PHI=90 IF MINOR AXIS PERPENDICULAR TO CROSS FLOW
C
C ** OUTPUT
C
C   CNCNO -- CORRECTION FACTOR FOR ELLIPTICAL SEGMENT
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION ABTAB(7),RATIO(7),IROUT(2)
C
      DATA ABTAB / 0.,.5,1.,2.,4.,10.,20. /
      DATA RATIO / 1.11,1.08,1.00,.82,.682,.60,.60 /
C
      CNCNO=1.
      CNX=UNUSED
      CNY=UNUSED
      IF(A .EQ. 0. .OR. B .EQ. 0.)GO TO 1010
      IF(A .EQ. B)GO TO 1010
C
      AOB=A/B
      BOA=B/A
C
      CALL LNTRP(ABTAB,RATIO,7,AOB,CORR1)
      CALL LNTRP(ABTAB,RATIO,7,BOA,CORR2)
C
      IF(BOA .GT. 1.)GO TO 1000
C
C***  MAJOR AXIS PERPENDICULAR TO CROSS FLOW
C
      CNCNO=CORR1*1.5*SQRT(AOB)*(-BOA**2/(1.-BOA**2)**1.5*
     1 ALOG(AOB*(1.+SQRT(1.-BOA**2)))+1./(1.-BOA**2))
      CNX=CNCNO
C
C***  MINOR AXIS PERPENDICULAR TO CROSS FLOW
C
 1000 IF(AOB .LT. 1.)GO TO 1010
      CNCNO=CORR2*1.5*SQRT(BOA)*(AOB**2/(AOB**2-1.)**1.5*
     1 ATAN(SQRT(AOB**2-1.))-1./(AOB**2-1.))
      CNY=CNCNO
C
C***  VARY BETWEEN TWO CASES DEPENDING ON PHI
C
      IF(CNX .NE. UNUSED .AND. CNY .NE. UNUSED)
     1   CNCNO=CNX*COS(PHI/RAD)**2+CNY*SIN(PHI/RAD)**2
C
 1010 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE DDCVRT
C      
C  WRITTEN BY W. BLAKE, WL/FIGC
C
C***    SUBROUTINE TO CONVERT DYNAMIC DERIVATIVES
C***    TO DEGREES IF REQUESTED
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /DBODY/  BD(406)
      COMMON /DB1/    D1(400)
      COMMON /DB12/   D12(400)
      COMMON /DB123/  D123(400)
      COMMON /DB1234/ D1234(400)
C      
      DO 1000 I=1,400
         BD(I)=BD(I)/RAD
         D1(I)=D1(I)/RAD
         D12(I)=D12(I)/RAD
         D123(I)=D123(I)/RAD
         D1234(I)=D1234(I)/RAD
 1000 CONTINUE
C
      DO 1050 I=1,6
         BD(400+I)=BD(400+I)/RAD
 1050 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCALP(NALP,ALPHA,CN,CAO,SW,NPAN,AR,SREF,
     1   MACH,REN,RLE,SWEEPI,TAPER,ALPI,CADL)
C
C***  SUBROUTINE TO COMPUTE FIN ALONE AXIAL FORCE AT ANGLE OF ATTACK
C
C  MODIFIED BY W. BLAKE, WL/FIGC
C
C     CADL IS CALCULATED FROM THE RELATION
C        CA = (CADL+CAO) = (CAO+CDL)*COS(ALPHA)-CL*SIN(ALPHA)
C
C     THE CAO*COS(ALPHA) TERM IS ADDED IN ROUTINE FINXCA
C        WHERE "ALPHA" IS THE BODY TOTAL ANGLE OF ATTACK.
C
C     THIS ROUTINE CALCULATES A TABLE OF VALUES FOR OBTAINING
C     THE CDL*COS(ALPHA)-CL*SIN(ALPHA) TERM
C        THIS IS APPLIED IN ROUTINE FINXCA AT THE WHERE "ALPHA"
C        IS THE FIN EQUIVALENT ANGLE OF ATTACK
C
C  THE FOLLOWING METHODS ARE USED FOR CDL:
C     FOR SHARP LEADING EDGES AT M < 1 AND ALL SECTIONS AT M > 1
C        CDL = CL*TAN(ALPHA) 
C     FOR ROUND LEADING EDGES AT SUBSONIC SPEEDS
C        CDL = CL**2/(PI*AR*E)   ALPHA < 8
C        CUBIC FAIRING       8 < ALPHA < 16  
C        CDL = CL*TAN(ALPHA)     ALPHA > 16
C
C***  INPUTS
C
C   NALP -- NUMBER OF ANGLES AF ATTACK IN FIN CN TABLE
C  ALPHA -- ANGLES OF ATTACK, DEGREES
C     CN -- NORMAL FORCE COEFFICIENTS
C    CAO -- AXIAL FORCE COEFFICIENT AT ZERO NORMAL FORCE
C     SW -- WING AREA
C   NPAN -- NUMBER OF PANELS IN SET
C     AR -- FIN ASPECT RATIO
C   SREF -- REFERENCE AREA
C   MACH -- FREESTREAM MACH NUMBER
C    REN -- FREESTREAM REYNOLDS NUMBER/FT
C    RLE -- LEADING EDGE RADIUS
C SWEEPI -- LEADING EDGE SWEEP, DEG.
C  TAPER -- TAPER RATIO
C   ALPI -- ANGLE OF ATTACK OF INTEREST, DEGREES
C
C***  OUTPUT
C
C   CADL -- AXIAL FORCE AT ANGLE OF ATTACK (EXCLUDING CAO)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL MACH,NPAN
C
      DIMENSION IROUT(2),ALPHA(20),CN(20)
      DIMENSION RLETAB(9),RTAB(9)
C
      DATA RLETAB/0.,1.1E3,1.E4,2.E4,4.E4,6.E4,8.E4,1.E5,1.E9/
      DATA RTAB/0.,0.,0.6,0.73,0.81,0.84,0.85,0.865,0.865/
C
C   USE TOTAL PANEL RESULTS REFERENCED TO PANEL AREA
C
      CAOT=2.*CAO*SREF/SW
      CALL LNTRP(ALPHA,CN,NALP,ALPI,CNH)
      CNTP=CNH*SREF/SW
      CADL=0.
      IF(MACH.GE.1.0 .OR. RLE.LE.UNUSED) GO TO 1050
C
C***  ROUND NOSE AIRFOIL CALCULATIONS, DATCOM SEC. 4.1.5.2
C
      SWEEP=ABS(SWEEPI)
      FACT=0.
      IF(SWEEP .NE. 0. .AND. MACH .LE. .8 .AND. RLE .NE. UNUSED)
     1 FACT=REN*RLE/TAN(SWEEP/RAD)*SQRT(1.-MACH**2*COS(SWEEP/RAD)**2)
      IF(SWEEP .EQ. 0. .AND. MACH .LE. .8 .AND. RLE .NE. UNUSED)
     1 FACT=1.E9
      CALL LNTRP(RLETAB,RTAB,9,FACT,RLS)
      FACT1=AR*TAPER/COS(SWEEP/RAD)
      ADD=.011*FACT1
      IF(ADD .GT. .11)ADD=.11
      IF(FACT .GE. 1.E3)RLS=RLS+ADD
C
      CALL LNTRP(ALPHA,CN,NALP,0.,CNA0)
      CALL LNTRP(ALPHA,CN,NALP,1.,CNA1)
      CLA=(CNA1-CNA0)*SREF/SW*RAD-CAOT
      E=1.1*CLA/AR/(RLS*CLA/AR+(1.-RLS)*PI)
C
C*** CALCULATE CL FROM CN AND CAO
C
      IF(ABS(ALPI).LT.0.01.OR.ABS(ALPI).GT.45.) THEN
         CL=CNTP
      ELSE
         TERM1=PI*E*AR/(2.*TAN(ALPI/RAD))
         TERM2=(CNTP/COS(ALPI/RAD)-CAOT*TAN(ALPI/RAD))
         CL=TERM1*(-1.+SQRT(1.+2./TERM1*TERM2))
      ENDIF
C
      CADLS=CL**2*COS(ALPI/RAD)/(PI*AR*E)-CL*SIN(ALPI/RAD)
      ATEM=ABS(ALPI)-8.
      IF(ATEM.GT.0. .AND. ATEM.LT.8.)
     1   CADLS=CADLS*(ATEM**3-12.*ATEM**2+256.)/256.
      IF(ATEM.GE.8.)  CADLS=0.
C
C   FINAL RESULT, REFERENCE TO SREF
C
      CADL=CADLS
 1050 CONTINUE
      CADL=CADL*SW/SREF
C
      RETURN
      END

c *************************************
c *************************************
c *************************************
      SUBROUTINE FLAT(MACH,DEL,H,W,L,OFF,CDFPL)
      REAL L,MACH,MSUB,MSUP
C
C  WRITTEN BY K. DETERS, MCDONNELL DOUGLAS
C
      MSUB=.6
      MSUP=1.
      G=1.4
      S=W*H
      HTOT=H+OFF
      TMACH=0.0
      IF(MACH.GT.MSUB) GO TO 115
C
C*** SUBSONIC DRAG CALCULATION
 110    IF (W .LE. H) THEN
        WH=W/H
        CHK=L/W
        ELSE
        WH=H/W
        CHK=L/H
        ENDIF
      CALL PLATE(WH,CDPL)
        IF (CHK .LT. 1.4) THEN
        CD=CDPL
        ELSE IF (CHK .GT. 3.) THEN 
        CD=.45*CDPL
        ELSE
        CD=(((4.74-1.1*CHK)/1.6)/2.)*CDPL
        ENDIF
      CD=CD/(SQRT(1.0-MACH**2))
      IF(TMACH.EQ.0.) GO TO 145
      GO TO 120
 115  IF(MACH.LT.MSUP) GO TO 125
C
C*** SUPERSONIC DRAG CALCULATION
 130  RMACH=5.
      EQ1=(((G+1.))**2*RMACH**2)/((4.0*G*RMACH**2)-2.0*(G-1.0))
      EQ2=(1.0-G+(2.0*G*RMACH**2))/(G+1.0)
      CPMAX=(2.0/(G*RMACH**2))*((EQ1**(G/(G-1.0)))*EQ2-1.0)
      CD=CPMAX
      CALL CROSS(MACH,CDT)
      CD=CD*(CDT/1.2)
      IF(TMACH.EQ.0.) GO TO 145
      GO TO 140
 125  CONTINUE
C
C*** TRANSONIC DRAG CALCULATION 
      TMACH=MACH
      MACH=MSUB
      GO TO 110
 120  CDSUB=CD
      SUBM=CD*1.172
      MACH=MSUP
      GO TO 130
 140  CDSUP=CD
      SUPM=0.
      CALL CUBIC(TMACH,MSUB,MSUP,CDSUB,CDSUP,SUBM,SUPM,CDTR)
      MACH=TMACH
      CD=CDTR 
 145  CONTINUE
C
C*** FINAL CALCULATION OF DRAG COEEFICIENT
        IF (OFF .EQ. 0.) THEN
          IF (H .GT. DEL) THEN
          CD=CD*(1.0-.25*(DEL/H))
          ELSE
          CD=CD*(.75*((H/DEL)**(1./3.)))
          ENDIF
        ELSE
          IF (OFF .GE. DEL) THEN
          CD=CD
          ELSE
            IF (HTOT .LE. DEL) THEN
            HAVG1=(HTOT+OFF)/2.
            CD=CD*((HAVG1/DEL)**(1./3.))
            ELSE
            HAVG2=(DEL+OFF)/2.
            CD=CD*(((HTOT-DEL)/H)+((DEL-OFF)/H)*((HAVG2/DEL)**(1./3.)))
            ENDIF
          ENDIF
        ENDIF
      CDFPL=CD*S
      RETURN
      END        

c *************************************
c *************************************
c *************************************
      SUBROUTINE ILTANG
C**********************************************************************
C
C     THIS SUBROUTINE IS USED TO CALCULATE THE RELATIVE IMPACT ANGLES
C     (THETAI) OF INLETS.  THESE ANGLES ARE THEN USED BY THE NETONIAN
C     ROUTINE TO CALCULATE THE PRESSURE COEFFICIENT FOR A PANEL.
C
C**********************************************************************
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      NUMI=NIN+0.5
      DO 10 INLET=1,NUMI
        IF (PHI(INLET).GE.360.) PHI(INLET)=PHI(INLET)-360.0
        THETAI(1,INLET)=PHI(INLET)/RAD+3*PI/2.
        THETAI(2,INLET)=PHI(INLET)/RAD
        THETAI(3,INLET)=PHI(INLET)/RAD+PI/2.
        THETAI(4,INLET)=PHI(INLET)/RAD+PI
        THETAD(1,INLET)=PHI(INLET)/RAD+3.*PI/2.
        THETAD(2,INLET)=0.0
        THETAD(3,INLET)=PHI(INLET)/RAD+PI/2.
        THETAD(4,INLET)=0.0
   10 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PRIIOM(IC,IM,CN,CM,CA,CY,CLN,CLL,CNA,CMA,CYB,CNB,CLB)
C
C***  SUBROUTINE TO PRINT THE STATIC COEFFICIENTS USING SUBROUTINE SWRIT
C
C***  THE FINAL VALUES ARE OBTAINED FROM THE IOM
C
C***  INPUTS
C
C     IM -- CURRENT VALUE OF MACH NUMBER (INTEGER VALUE)
C     CN -- ARRAY OF NORMAL FORCE DATA
C     CM -- ARRAY OF PITCHING MOMENT DATA
C     CA -- ARRAY OF AXIAL FORCE DATA
C     CY -- ARRAY OF SIDE FORCE DATA
C    CLN -- ARRAY OF YAWING MOMENT DATA
C    CLL -- ARRAY OF ROLLING MOMENT DATA
C    CNA -- ARRAY OF NORMAL FORCE SLOPE DATA
C    CMA -- ARRAY OF PITCHING MOMENT SLOPE DATA
C    CYB -- ARRAY OF SIDE FORCE SLOPE DATA
C    CNB -- ARRAY OF YAW MOMENT SLOPE DATA
C    CLB -- ARRAY OF ROLL MOMENT SLOPE DATA
C
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      COMMON /REFQN/ SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,
     4               LELLB,LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      COMMON /INCID/ DELTA1(8),DELTA2(8),DELTA3(8),DELTA4(8),XHINGE(4),
     1               SKEW(4)
      COMMON /UDATA/ UCN(20,20,20),UCM(20,20,20),UCA(20,20,20),
     1               DEL(20,20)
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),CASE,NOEXTR,NOLAT,
     1               IR,IP
      COMMON /FSET1/ DATA1(381),PHIF1(8),CFOC1(10)
      COMMON /FSET2/ DATA2(381),PHIF2(8),CFOC2(10)
      COMMON /FSET3/ DATA3(381),PHIF3(8),CFOC3(10)
      COMMON /FSET4/ DATA4(381),PHIF4(8),CFOC4(10)
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM
C
      LOGICAL NMF,NAF,NDUM,NOLAT,NOEXTR
      INTEGER CASE
      CHARACTER*4 FOR1,NDM,NA,NDD
      REAL NALPHA,NMACH,MACH,LREF,LATREF
C
      DIMENSION CN(20),CM(20),CA(20),CY(20),CLN(20),CLL(20),
     1 CNA(20),CMA(20),CYB(20),CNB(20),CLB(20)
      DIMENSION CLARY(20),CDARY(20),CLCD(20),XCP(20)
      DIMENSION FOR1(49)
      DIMENSION JCONT(12)
C
      NALP=NALPHA+0.5
C
      NDUM=.FALSE.
      NMF=.FALSE.
      NAF=.FALSE.
C
C  CONVERT ALL DERIVATIVES TO PER RADIAN IF REQUIRED
C
      IF(.NOT. LDERRD)GO TO 1010
      DO 1000 I=1,20
         IF(ABS(CNA(I)) .NE. UNUSED)CNA(I)=CNA(I)*RAD
         IF(ABS(CMA(I)) .NE. UNUSED)CMA(I)=CMA(I)*RAD
         IF(ABS(CYB(I)) .NE. UNUSED)CYB(I)=CYB(I)*RAD
         IF(ABS(CNB(I)) .NE. UNUSED)CNB(I)=CNB(I)*RAD
         IF(ABS(CLB(I)) .NE. UNUSED)CLB(I)=CLB(I)*RAD
 1000 CONTINUE
C
 1010 CONTINUE
C
C  SKIP BODY AND BODY+FIN PRINTOUT FOR FIN ALONE
C
      IF(IC.GE.2.AND.IC.LE.5) GO TO 2000
C
C   WRITE COEFFICIENTS FOR BODY ALONE OR BODY PLUS FINS
C
      CALL HEADR9
      IF(IC.EQ.1) WRITE(6,1300)
      IF(IC.EQ.6) WRITE(6,1310)
      IF(IC.EQ.7) WRITE(6,1320)
      IF(IC.EQ.8) WRITE(6,1330)
      IF(IC.EQ.9) WRITE(6,1340)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      WRITE(6,1060)
C
      WRITE(6,1070)
      WRITE(6,1075)(ALPHA(I),CN(I),CM(I),CA(I),
     1   CY(I),CLN(I),CLL(I),I=1,NALP)
C
C  COMPUTE CL/CD AND XCP
C
      DO 1020 I=1,NALP
         CALL CLOCD(ALPHA(I),CN(I),CA(I),CLARY(I),CDARY(I),CLCD(I))
         IF(CN(I) .NE. 0.)XCP(I)=CM(I)/CN(I)
         IF(CN(I) .EQ. UNUSED)XCP(I)=1./UNUSED
         IF(CN(I) .EQ. 0. .AND. CNA(I) .EQ. 0.)XCP(I)=1./UNUSED
         IF(CN(I) .EQ. 0. .AND. CNA(I) .NE. 0.)XCP(I)=CMA(I)/CNA(I)
 1020 CONTINUE
C
      WRITE(6,1120)
      WRITE(6,1130)(ALPHA(I),CLARY(I),CDARY(I),CLCD(I),XCP(I),I=1,NALP)
      WRITE(6,1400)
C
C  WRITE DERIVATIVES FOR BODY ALONE OR BODY PLUS FINS
C
      CALL HEADR9
      IF(IC.EQ.1) WRITE(6,1300)
      IF(IC.EQ.6) WRITE(6,1310)
      IF(IC.EQ.7) WRITE(6,1320)
      IF(IC.EQ.8) WRITE(6,1330)
      IF(IC.EQ.9) WRITE(6,1340)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      IF(LDERRD) WRITE(6,1062)
      IF(.NOT.LDERRD) WRITE(6,1064)
C
      WRITE(6,1080)
      IF(.NOT.NOLAT) WRITE(6,1085)(ALPHA(I),CNA(I),CMA(I), 
     1              CYB(I),CNB(I),CLB(I),I=1,NALP)
      IF(NOLAT) WRITE(6,1087)(ALPHA(I),CNA(I),CMA(I),I=1,NALP)
      GO TO 2200
 2000 CONTINUE
C
C  WRITE COEFFICIENTS AND DERIVATIVES FOR FIN ALONE
C
      CALL HEADR9
      IF(IC.EQ.2) WRITE(6,1210)
      IF(IC.EQ.3) WRITE(6,1220)
      IF(IC.EQ.4) WRITE(6,1230)
      IF(IC.EQ.5) WRITE(6,1240)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      IF(LDERRD) WRITE(6,1066)
      IF(.NOT.LDERRD) WRITE(6,1068)
C
      WRITE(6,1090)
      WRITE(6,1095) (ALPHA(I),CN(I),CM(I),CA(I),CNA(I),CMA(I),I=1,NALP)
C
C  COMPUTE CL/CD AND XCP
C
      DO 1025 I=1,NALP
         CALL CLOCD(ALPHA(I),CN(I),CA(I),CLARY(I),CDARY(I),CLCD(I))
         IF(CN(I) .NE. 0.)XCP(I)=CM(I)/CN(I)
         IF(CN(I) .EQ. UNUSED)XCP(I)=1./UNUSED
         IF(CN(I) .EQ. 0. .AND. CNA(I) .EQ. 0.)XCP(I)=1./UNUSED
         IF(CN(I) .EQ. 0. .AND. CNA(I) .NE. 0.)XCP(I)=CMA(I)/CNA(I)
 1025 CONTINUE
C
      WRITE(6,1120)
      WRITE(6,1130)(ALPHA(I),CLARY(I),CDARY(I),CLCD(I),XCP(I),I=1,NALP)
      WRITE(6,1400)
C
 2200 CONTINUE
C
C  CONVERT ALL DERIVATIVES TO PER DEGREE IF REQUIRED
C
      IF(.NOT. LDERRD)GO TO 1040
      DO 1030 I=1,20
         IF(CNA(I) .NE. UNUSED)CNA(I)=CNA(I)/RAD
         IF(CMA(I) .NE. UNUSED)CMA(I)=CMA(I)/RAD
         IF(CYB(I) .NE. UNUSED)CYB(I)=CYB(I)/RAD
         IF(CNB(I) .NE. UNUSED)CNB(I)=CNB(I)/RAD
         IF(CLB(I) .NE. UNUSED)CLB(I)=CLB(I)/RAD
 1030 CONTINUE
C
 1040 CONTINUE
C
C***  WRITE PLOT DATA IF REQUESTED
C
      IF(LPLOT)CALL PLOT3(IC,IM,CN,CM,CA,CY,CLN,CLL)
C
C     SAVE DATA FOR THE CASE
C
      NC = CASE
      IF(.NOT. LDEFL) DEL(NC,IM) = 0.0
      IF (LDEFL) THEN
        IF (LFIN1) THEN
          DO 1600 I = 1, 4
            IF (PHIF1(I) .LT. 180. ) DEL(NC,IM) = DELTA1(I)
            IF (DEL(NC,IM) .NE. 0.0) GOTO 1950
 1600     CONTINUE
        ENDIF
        IF (LFIN2) THEN
          DO 1700 I = 1, 4
            IF (PHIF2(I) .LT. 180. ) DEL(NC,IM) = DELTA2(I)
            IF (DEL(NC,IM) .NE. 0.0) GOTO 1950
 1700     CONTINUE
        ENDIF
        IF (LFIN3) THEN
          DO 1800 I = 1, 4
            IF (PHIF3(I) .LT. 180. ) DEL(NC,IM) = DELTA3(I)
            IF (DEL(NC,IM) .NE. 0.0) GOTO 1950
 1800     CONTINUE
        ENDIF
        IF (LFIN4) THEN
          DO 1900 I = 1, 4
            IF (PHIF4(I) .LT. 180. ) DEL(NC,IM) = DELTA4(I)
            IF (DEL(NC,IM) .NE. 0.0) GOTO 1950
 1900     CONTINUE
        ENDIF
      ENDIF
 1950 DO 1500 I = 1,NALP
        UCN(I,NC,IM) = CN(I)
        UCM(I,NC,IM) = CM(I)
        UCA(I,NC,IM) = CA(I)
 1500 CONTINUE
C
 1060 FORMAT(4X,15X,'----- LONGITUDINAL -----',5X,
     1             '-- LATERAL DIRECTIONAL --')
 1062 FORMAT(4X,15X,'---------- DERIVATIVES (PER RADIAN) ----------')
 1064 FORMAT(4X,15X,'---------- DERIVATIVES (PER DEGREE) ----------')
 1066 FORMAT(4X,15X,'----- LONGITUDINAL -----',5X,
     1             '   DERIVATIVES (PER RADIAN)')
 1068 FORMAT(4X,15X,'----- LONGITUDINAL -----',5X,
     1             '   DERIVATIVES (PER DEGREE)')
 1070 FORMAT(4X,5X,'ALPHA',7X,'CN',8X,'CM',8X,'CA',8X,'CY',7X,
     1             'CLN',7X,'CLL',/)
 1075 FORMAT(4X,F10.2,6F10.3)
 1080 FORMAT(4X,5X,'ALPHA',7X,'CNA',9X,'CMA',9X,'CYB',9X,
     1             'CLNB',8X,'CLLB')
 1085 FORMAT(4X,F10.2,5F12.4)
 1087 FORMAT(4X,F10.2,2F12.4)
 1090 FORMAT(4X,5X,'ALPHA',7X,'CN',8X,'CM',8X,'CA',8X,4X,
     1             'CNA',9X,'CMA',/)
 1095 FORMAT(4X,F10.2,3F10.3,4X,2F12.4)
 1120 FORMAT(/,4X,5X,'ALPHA',7X,'CL',8X,'CD',6X,'CL/CD',5X,'X-C.P.',/)
 1130 FORMAT(4X,F10.2,4F10.3)
 1210 FORMAT(15X,'FIN 1 ALONE STATIC AERODYNAMIC CHARACTERISTICS'/)
 1220 FORMAT(15X,'FIN 2 ALONE STATIC AERODYNAMIC CHARACTERISTICS'/)
 1230 FORMAT(15X,'FIN 3 ALONE STATIC AERODYNAMIC CHARACTERISTICS'/)
 1240 FORMAT(15X,'FIN 4 ALONE STATIC AERODYNAMIC CHARACTERISTICS'/)
 1300 FORMAT(21X,'STATIC AERODYNAMICS FOR BODY ALONE',/)
 1310 FORMAT(19X,'STATIC AERODYNAMICS FOR BODY-FIN SET 1',/)
 1320 FORMAT(16X,'STATIC AERODYNAMICS FOR BODY-FIN SET 1 AND 2',/)
 1330 FORMAT(14X,'STATIC AERODYNAMICS FOR BODY-FIN SET 1, 2, AND 3',/)
 1340 FORMAT(12X,
     1  'STATIC AERODYNAMICS FOR BODY-FIN SET 1, 2, 3, AND 4',/)
 1400 FORMAT(/,4X,'X-C.P. MEAS. FROM MOMENT CENTER IN REF. LENGTHS,',
     2    ' NEG. AFT OF MOMENT CENTER')
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SOSE(AL,AM,X,Y,NPTS,NNN,IPRINT,NBLUNT,MNO,
     1 CAP,XCP,CNALP,CMALP,CAAA,DMAX)
C
C   BODY ALONE PROGRAM, FOR M .GT. 1.2, AND ALPHA .LT. 15 DEG
C   FOR BLUNTED,TRUNCATED, OR POINTED BODIES OF REVOLUTION.
C   PRESSURES BY MODIFIED NEWTONIAN AND IMPROVED 2ND ORDER SHOCK
C   EXPANSION OF DEJARNETTE (AIAA J. SPACECRAFT, NOV-DEC 1980, P.529)
C
C  NOTE -- THE BODY IS TREATED WITH THE X STATIONS AND RADII IN CALIBERS
C
C X(1) MUST BE ZERO FOR SHARP OR TRUNCATED BODIES
C X(1) MUST BE NON-ZERO FOR BLUNTED BODIES (PGM WILL FAIR TO X(1)=0)
C
C
C  INPUTS
C
C     AL -- ANGLE OF ATTACK, DEGREES
C     AM -- FREESTREAM MACH NUMBER
C      X -- ARRAY OF X COORDINATES
C      Y -- ARRAY OF BODY RADII AT EACH INPUT X STATION
C   NPTS -- NUMBER OF BODY INPUT POINTS
C    NNN -- ARRAY WHICH DEFINES THE NUMBER OF POINTS BEFORE THE
C           SURFACE DISCONTINUITY FOR EACH BODY SEGMENT
C IPRINT -- PRINT FLAG
C           0=NO PRINT-OUT
C           1=PRINT PRESSURE DISTRIBUTION
C           2=PRINT BODY COORDINATES TO TAPE UNIT 3
C NBLUNT -- BLUNTNESS FLAG
C           0=SHARP NOSE
C           1=BLUNTED NOSE
C           2=TRUNCATED NOSE
C    MNO -- TOTAL NUMBER OF SEGMENTS OF BODY DEFINED
C
C  OUTPUTS
C
C    CAP -- AXIAL FORCE INCREMENT DUE TO PRESSURE DRAG
C    XCP -- LOCATION OF CENTER OF PRESSURE, CALIBERS FROM NOSE
C  CNALP -- NORMAL FORCE DERIVATIVE WITH ANGLE OF ATTACK, /RADIAN
C  CMALP -- PITCHING MOMENT DERIVATIVE WITH ANGLE OF ATTACK, /RADIAN
C   CAAA -- SECOND DERIVATIVE OF AXIAL FORCE WITH ANGLE OF ATTACK,
C           /RADIAN SQUARED
C
C  ROUTINES CALLED -- GEO,CONEP,MATCHX,EQN44,SHOCK,LOADF,EXPAND,CPDIST
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      DIMENSION CPP(7),X(50),Y(50),Z(50),XT(50),YT(50),ZT(50),
     1 NN(20),NNN(20),SLL(20),SLR(20),NC(50),ACAI(301),ACNI(301),
     2 ACMI(301),ACAAI(301)
      REAL LAMDA,LAMDA1,LAMDA2
      DATA GAM /1.400/
      DO 990 I=1,20
      NN(I)=NNN(I)
  990 CONTINUE
C
C  FOLLOWING CARD REMOVED FOR TECPLOT FORMAT
C
C     IF(IPRINT.EQ.2) WRITE(9,1300)
C
C  SET-UP GEOMETRY
C
      M=MNO
C
      XB=0.
      CALL SETGEO(NN,M,XB,NBLUNT,X,Y,Z,NPTS,B,RO,XT,YT,ZT,SLL,SLR)
      ALPD=AL/RAD
      ALP=ALPD
      SALP=SIN(ALP)
      CALP=COS(ALP)
      AMS=AM**2
C
C  FIND MAXIMUM DEFLECTION ANGLE AT THIS MACH TO GET A
C  DETACHED SHOCK.  THIS IS THE MATCHING CONDITION
C  FOR THE BLUNTED NOSE
C
C
C  NACA 1135 EQN. 100
C
      PT=((GAM+1.)*AMS/2.)**(GAM/(GAM-1.))*((GAM+1.)
     1   /(2.*GAM*AMS-(GAM-1.)))**(1./(GAM-1.))
      CPSTG=(PT-1.)/(GAM/2.)/AMS
      AMM=1.1
      AX2=AMM**2
C
C  NACA 1135 EQN. 44
C
      POP=(1.+AX2*(GAM-1.)/2.)**(-GAM/(GAM-1.))
      PST=POP*PT
      CPM=(PST-1.)/(GAM/2.)/AMS
C
C  NOW COMPUTE THE MAXIMUM DEFLECTION ANGLE
C
      DELM=ASIN(SQRT(CPM/CPSTG))
C
C  BLUNTED NOSE STAGNATION PRESSURE COEFFICIENT
C
      CPN=CPSTG*(1.0-SALP**2)
C
C  INITIALIZE
C
      NCMAX=300
      NC(1)=40
      XINC=0.05
      DO 1000 I=2,M
        NC(I)=X(NPTS)/XINC+0.5
        IF (NC(I).GT.NCMAX) NC(I)=NCMAX
 1000 CONTINUE
      B1=2.-1./SQRT(AMS-1.)
      IF(B1.LT.1.)B1=1.
      B2=6.-2.*B1
      CAI=0.0
      CAAAI=0.0
      CNI=0.0
      CMI=0.0
      L=0
      TH=0.0
C
C  START SOLUTION JUST BEHIND NOSE TIP
C
      P=PT
      XB=.003*RO
      XNC=NC(1)
      DX=(X(1)-XB)/XNC
C     IF(IPRINT.EQ.1.AND.ALP.EQ.0.)CALL HEADR9
C     IF(IPRINT.EQ.1.AND.ALP.EQ.0.)WRITE(6,1190)AM,AL
C     IF(IPRINT.EQ.1.AND.ALP.EQ.0.)WRITE(6,1200)
      IF(NBLUNT .EQ. 2)GO TO 1020
      IF(DX.EQ.0.)GO TO 1010
C
C  HERE FOR BLUNTED NOSE
C
      XPT=0.
      R=0.
C     IF(IPRINT.EQ.1.AND.ALP.NE.0.)WRITE(10,1210)XPT,CPN,CPN,CPN,CPN,
C    1                                          CPN,CPN,CPN
      IF(IPRINT.EQ.1)WRITE(10,1210)XPT,CPN,CPN,CPN,CPN,
     1                                          CPN,CPN,CPN
C     IF(IPRINT.EQ.1.AND.ALP.EQ.0.)WRITE(6,1220)XPT,CPN
      CALL GEO(X,Y,Z,SLL,SLR,RO,B,NN,XB,R,RX,RXX,DEL,SD,CD,1)
      CAI=CPSTG*R**2/2.0
      CNI=CPSTG*(R*CD)**2/4.0
      GO TO 1020
 1010 CAI=4.*CPSTG*0.9*Y(1)**2
 1020 CONTINUE
C
C  LOOP FOR EACH BODY SEGMENT
C
      DO 1170 J=1,M
C
C  J=1 IS THE FIRST BODY SEGMENT (THE SPHERICAL NOSE CAP)
C  J=2 ... M IS THE REST OF THE BODY SEGMENTS
C
         IF(J.EQ.1)GO TO 1030
C
C  ARRAY NN IS THE NUMBER OF POINTS IN EACH SEGMENT
C  ARRAY NC IS THE NUMBER OF POINTS TO BE USED IN THE SOLUTION
C
            NNJ1=NN(J-1)
            NNJ=NN(J)
            XNC=NC(J)
            XB=X(NNJ1)
            DX=(X(NNJ)-XB)/XNC
 1030    IMX=NC(J)+1
C
C  SKIP THE PRESSURE CALCULATIONS IF THE NOSE IS NOT BLUNTED
C  ON THE FIRST PASS
C
         IF(DX.EQ.0.0)GO TO 1170
C
C  TRANSVERSE THIS BODY SEGMENT AT AN INCREMENT OF DX
C
         DO 1160 I=1,IMX
            XXI=I-1
            XPT=XB+XXI*DX
C
C  INTERPOLATE FOR RADIUS (R), DR/DX, D2R/DX2, BODY SLOPE,
C  SIN(DELTA), AND COS(DELTA)
C
            CALL GEO(X,Y,Z,SLL,SLR,RO,B,NN,XPT,R,RX,RXX,DEL,SD,CD,J)
         IF(L.NE.0)GO TO 1080
            L=0
            RXL=RX
            RXXL=RXX
            DELL=DEL
C
C  GET CONE PRESSURE USING RASMUSSEN EQUATION
C
            CALL CONEP(GAM,AM,SD,PC)
C
C  IF X(1)=0., HAVE A SHARP OR TRUNCATED BODY
C
         IF(X(1).EQ.0.0)GO TO 1050
C
C  HERE FOR SPHERICALLY BLUNTED NOSE
C
            CP=CPSTG*SD**2
            P=1.+CP*(GAM/2.)*AMS
C
C  SEE DEJARNETTE FOR THE EXACT DEFINITION OF THESE LOADING TERMS
C    LAMDA = D (P)/D(ALPHA)  AT PHI=ALPHA=0
C    GAMMA = D2(P)/D(ALPHA)2 AT PHI=ALPHA=0
C    DELTA = D2(P)/D(ALPHA)2 AT PHI=90. DEG, ALPHA=0
C
            LAMDA=CPSTG*SD*CD
            GAMMA=2.0*CPSTG*(CD**2-SD**2)
            DELTA=-2.0*CPSTG*SD**2
         IF(P.LT.PST)GO TO 1040
            PL=P
            XL=XPT
         GO TO 1150
 1040    L=1
         IF(I.EQ.1)GO TO 1050
C
C  COMPUTE THE X MATCHING POINT
C
            CALL MATCHX(J,RO,B,DELM,XL,PST,PL,XPT,P,XST)
C
C  GET GEOMETRIC CHARACTERISTICS AT THE MATCH POINT
C
            CALL GEO(X,Y,Z,SLL,SLR,RO,B,NN,XST,RL,RXL,RXXL,
     1                  DELL,SDL,CDL,J)
C
C  COMPUTE RADIUS OF CURVATURE AT THIS POINT
C
            CURV=-RXXL/(1.+RXL**2)**1.5
C
C  GET CONICAL PRESSURE FROM METHOD OF RASMUSSEN
C
            CALL CONEP(GAM,AM,SDL,PC)
C
            CP=CPSTG*SDL**2
            P=1.+(GAM/2.)*CP*AMS
            CP=(P-1.)/(GAM/2.)/AMS
C
C  COMPUTE MACH NUMBER
C
            CALL EQN44(GAM,PT,P,AMX)
            DPSS=(1.0-PT)*2.0*CURV*SDL*CDL
            AX2=AMX**2
C
C  COMPUTE SMALL LAMBDA*CURVATURE, LEFT SIDE OF EQUATION 3
C  OF DEJARNETTE
C
            SLAM=GAM*P*AX2/SQRT(AX2-1.)*CURV
            DPS2=DPSS+SLAM
            PM=PC-P
            P2=P
C
C  SET UP MATCHING PARAMETERS
C
            LAMDA=CPSTG*SDL*CDL
            LAMDA2=LAMDA
            GAMMA=2.0*CPSTG*(1.0-2.0*SDL**2)
            GAMMA2=GAMMA
            DELTA=-2.0*CPSTG*SDL**2
            DELTA2=DELTA
            BTL=XST*RXL-RL
            XXL=XST
            XX=XXL
            BT=BTL
C
C  COMPUTE CHANGE IN ANGLE BETWEEN STATIONS
C
            TH=DELL-DEL
         IF(ABS(TH).LT.1.E-3)GO TO 1150
         GO TO 1090
C
C  HERE FOR SHARP NOSE OR COMPRESSION SURFACE
C
 1050    CONTINUE
C
C ...    USE WEDGE PRESSURE AT TRUNCATED NOSE, ELSE USE CONE
C
         IF(NBLUNT .EQ. 2 .AND. XPT .EQ. 0.)
     1      CALL WEDGE(AM,ASIN(SD)*RAD,THE,CPW)
         IF(NBLUNT .EQ. 2 .AND. XPT .EQ. 0.)
     1      PC=1.+.7*CPW*AM**2
         P=PC
         IF(P.GE.PT)GO TO 1070
            P2=P
            DPS2=0.
            LAMDA=2.0*CD*SD
            LAMDA2=LAMDA
            GAMMA=2.0*B1*(1.0-2.0*SD**2)
            GAMMA2=GAMMA
            DELTA=GAMMA-2.0*B2*CD**2
            DELTA2=DELTA
            XX=XPT
            BT=XPT*RX-R
            RR=R
         IF(XPT.GT.0.0.OR.R.GT.0.0)GO TO 1060
C
C  HERE AT SHARP NOSE TIP
C
            SD2=SD**2
C
C  GET SHOCK ANGLE AND PROPERTIES BEHIND THE SHOCK
C
            CALL SHOCK(GAM,AM,SD2,P2,PC,AMX,PT)
C
C  COMPUTE THE MACH NUMBER
C
 1060    CALL EQN44(GAM,PT,P,AMX)
            L=0
         IF(AMX.LT.1.1)GO TO 1150
            L=1
         GO TO 1120
 1070    P=PT
            LAMDA=0.0
            GAMMA=0.0
            DELTA=0.0
         GO TO 1150
C
C  COMPUTE CHANGE IN ANGLE BETWEEN STATIONS
C
 1080    TH=DELL-DEL
         IF(ABS(TH).LT.1.E-03)GO TO 1130
 1090    BT=XPT*RX-R
C
C   XX AND RR ARE COORDINATES AT JUNCTURE OF TANGENT CONES
C
            XX=(BT-BTL)/(RX-RXL)
            RR=R-(XPT-XX)*RX
         IF(ABS(PM).LT.1.E-3)GO TO 1100
C
C  EQUATION 2 OF DEJARNETTE
C
            ETA=DPS2*(XX-XXL)/PM/CDL
         IF(ETA.LE.0.0)GO TO 1100
            EXETA=EXP(-ETA)
C
C  EQUATION 1 OF DEJARNETTE
C
            P1=PC-PM*EXETA
            DPS1=DPS2*(PC-P1)/PM
C
C  EQUATION 29 OF DEJARNETTE (LOADING FUNCTIONS)
C
            CALL LOADF(AMS,EXETA,SDL,CDL,LAMDA2,GAMMA2,DELTA2,
     1                 LAMDA1,GAMMA1,DELTA1,F2MF1)
         GO TO 1110
 1100    P1=PC
            DPS1=0.0
C
C  COMPUTE LOADING FUNCTIONS BEFORE EXPANSION
C
            LAMDA1=2.0*CDL*SDL
            F2MF1=2.0*B1*(1.0-2.0*SDL**2)
            GAMMA1=F2MF1
            DELTA1=F2MF1-2.0*B2*CDL**2
C
C  GET CONICAL PRESSURE FROM METHOD OF RASMUSSEN
C
 1110    CALL CONEP(GAM,AM,SD,PC)
C
C   PRANDTL MEYER EXPANSION
C
C
C  COMPUTE MACH NUMBER BEFORE EXPANSION
C
            CALL EQN44(GAM,PT,P1,AM1)
         IF(AM1.LT.1.0001)GO TO 1050
C
C  EXPAND THE FLOW AROUND THE CORNER, GET AM2 AND P2
C
            CALL EXPAND(GAM,TH,AM1,P1,AM2,P2,ICOMP)
C
         IF(ICOMP.EQ.1)GO TO 1050
C
C  COMPUTE COS(MU), MU IS THE MACH ANGLE
C
            CM1=SQRT(AM1**2-1.0)/AM1
            CM2=SQRT(AM2**2-1.0)/AM2
C
C  COMPUTE OMEGA*MACH (EQUATION 6 OF DEJARNETTE)
C
            OM1=(1.0+(GAM-1.)/2.*AM1**2)**3
            OM2=(1.0+(GAM-1.)/2.*AM2**2)**3
C
C  COMPUTE LAMBDA (EQUATION 5 OF DEJARNETTE)
C
            ALM1=GAM*P1*AM1/CM1
            ALM2=GAM*P2*AM2/CM2
C
C  EQUATION 19 OF DEJARNETTE D(G)/D(C1)
C
            DG1=2.0*CM1*DPS1/ALM1+SDL/RR/AM1
C
C  EQUATION 20 OF DEJARNETTE, RATIO BY STREAM TUBE AREA AROUND CORNER
C
            DG2=DG1*OM1/OM2
C
C  SOLVE EQUATION 19 BACKWARDS FOR (DP/DS)2
C
            DPS2=(DG2-SD/RR/AM2)*ALM2/CM2/2.0
C
C  EQUATION 31 OF DEJARNETTE, AFTER EXPANSION LOADING
C
            LAMDA2=ALM2/ALM1*LAMDA1
C
C  SOLVE FOR F1 AND F2 USING EQUATION 34 OF DEJARNETTE
C
            F1=((GAM+1.)/2.*AM1**4-2.0*AM1**2+2.0)/(AM1*CM1)**3
            F2=((GAM+1.)/2.*AM2**4-2.0*AM2**2+2.0)/(AM2*CM2)**3
            F2MF1=F2-F1
C
C  EQUATION 33 OF DEJARNETTE
C
            GAMMA2=ALM2/ALM1*(GAMMA1+2.*GAM*AMS*LAMDA1**2/ALM1*F2MF1)
C
C  EQUATION 32 OF DEJARNETTE
C
            DELTA2=ALM2/ALM1*DELTA1
C
C  SET THIS STATION AS THE LAST STATION FOR NEXT PASS
C
 1120    DELL=DEL
            BTL=BT
            RXL=RX
            XXL=XX
            CDL=CD
            SDL=SD
            PM=PC-P2
 1130    IF(DPS2.EQ.0.0.AND.ABS(TH).LT.0.001)GO TO 1150
         IF(ABS(PM).LT.1.E-3)GO TO 1140
         IF((DPS2/PM).LE.0.0)GO TO 1140
C
C  EQUATION 2 OF DEJARNETTE
C
            ETA=DPS2*(XPT-XX)/PM/CDL
            EXETA=EXP(-ETA)
C
C  EQUATION 1 OF DEJARNETTE
C
            P=PC-PM*EXETA
C
C  LOADING FUNCTIONS
C
            CALL LOADF(AMS,EXETA,SD,CD,LAMDA2,GAMMA2,DELTA2,
     1                 LAMDA,GAMMA,DELTA,F2MF1)
         GO TO 1150
 1140    DPS2=0.
            P=PC
            IF(TH.LT.-0.001)P=P2
            PM=0.0
C
C  LOADING FUNCTIONS
C
            LAMDA=2.0*CD*SD
            GAMMA=2.0*B1*(1.0-2.0*SD**2)
            DELTA=GAMMA-2.0*B2*CD**2
C
C  COMPUTE MACH NUMBER
C
 1150    CALL EQN44(GAM,PT,P,AMX)
            CP =(P-1.)/(GAM/2.)/AMS
C
C  COMPUTE INCREMENTAL AERODYNAMICS FOR THIS STATION
C
            ACAI(I)=8.*CP*R*RX
            ACAAI(I)=2.*(GAMMA+DELTA)*R*RX
            ACNI(I)=8.*LAMDA*R
            ACMI(I)=-ACNI(I)*(XPT+R*RX)
C
         IF(IPRINT.EQ.0)GO TO 1160
C
C  HERE TO PRINT RESULTS IF REQUIRED
C
C  COMPUTE THE PRESSURES AROUND THE BODY
C
            CALL CPDIST(SALP,CALP,LAMDA,GAMMA,DELTA,CP,CPP)
C
C  WRITE PRESSURE DISTRIBUTION ABOUT THE BODY TO UNITS 10,12 
C
C         IF(IPRINT.EQ.1.AND.ALP.NE.0.)WRITE(10,1210)XPT,(CPP(K),K=1,7)
          IF(IPRINT.EQ.1) WRITE(10,1210)XPT,(CPP(K),K=1,7)
          IF(IPRINT.EQ.1.AND.ALP.EQ.0.)WRITE(12,1350)XPT,CPP(1),AMX
C         IF(IPRINT.EQ.1.AND.ALP.EQ.0.)WRITE(6,1220)XPT,CPP(1),AMX
C
C  PRINT BODY COORDINATES USED BY SOSE TO TAPE UNIT 9
C
         IF(IPRINT.EQ.2.AND.ALP.EQ.0.) 
     1           WRITE(9,1310) XPT*DMAX,R*DMAX
C
 1160    CONTINUE
C        IF(IPRINT.EQ.1 .AND. ALP.NE.0.)WRITE(6,1230)
C        IF(IPRINT.EQ.1 .AND. J.NE.M.AND.ALP.EQ.0.)CALL HEADR9
C        IF(IPRINT.EQ.1 .AND. J.NE.M.AND.ALP.EQ.0.)WRITE(6,1190)AM,AL
C        IF(IPRINT.EQ.1 .AND. J.NE.M .AND. ALP.NE.0.)WRITE(6,1180)
C        IF(IPRINT.EQ.1 .AND. J.NE.M .AND. ALP.EQ.0.)WRITE(6,1200)
C
C  INTEGRATE FOR INCREMENTAL AERODYNAMICS ON THIS SECTION
C
         CALL QUAD1(ACAI,IMX,DX,DCAI)
         CALL QUAD1(ACAAI,IMX,DX,DCAAI)
         CALL QUAD1(ACNI,IMX,DX,DCNI)
         CALL QUAD1(ACMI,IMX,DX,DCMI)
         CAI=CAI+DCAI
         CAAAI=CAAAI+DCAAI
         CNI=CNI+DCNI
         CMI=CMI+DCMI
C
 1170 CONTINUE
C
C  COMPUTE FINAL AERODYNAMICS
C
      CAP=CAI
      CNALP=CNI
      CMALP=CMI
      CAAA=CAAAI
      XCP=-CMALP/CNALP
C
C1180 FORMAT(//,52X,21HPRESSURE COEFFICIENTS,//,7X,10H  X/DMAX  ,9X,
C    15HPHI=0,8X,6HPHI=30,8X,6HPHI=60,8X,6HPHI=90,8X,7HPHI=120,7X,
C    27HPHI=150,7X,7HPHI=180)
 1190 FORMAT(25X,'BODY ALONE PRESSURE OUTPUT',//
     1 20X,'MACH =',F5.2,' ANGLE OF ATTACK =',F7.2,' DEG.')
 1200 FORMAT(//,22X,'PRESSURE COEFFICIENTS',//,4X,'X/DMAX',
     1 10X,'CP',9X,'M-LOCAL')
 1210 FORMAT(F14.6,7F10.5)
 1220 FORMAT(4X,4F14.6)
C1230 FORMAT(49H0 NOTE - PHI=  0 IS TOP VERTICAL CENTER (LEEWARD) /
C    1       53H         PHI=180 IS BOTTOM VERTICAL CENTER (WINDWARD) )
C
C BODY COORDINATE COMMENT CARD COMMENTED OUT FOR TECPLOT FORMAT
C
C1300 FORMAT(3X,31HSOSE BODY COORDINATES (IN FEET))
 1310 FORMAT(4X,2F14.6)
 1350 FORMAT(4X,3F14.6)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE USEREL(REQ)
C
C***  SUBROUTINE TO COMPUTE GEOMETRY CHARACTERISTICS FOR USER
C***  DEFINED SHAPES OF ELLIPTIC CROSS SECTION
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /ABODIN/ NX,XO,X(50),WIDTH(50),TNOSE,LNOSE,WNOSE,BNOSE,
     1                TRUNC,LCENTR,WCENTR,TAFT,LAFT,WAFT,
     2                POWER,DISCON(20),ELLIP(50),HEIGHT(50),ENOSE,
     3                ECENTR,EAFT,ADUM(645)
      COMMON /XRBLNT/ XTEMP(50),RTEMP(50),NXTEMP,VNTEMP,SWTEMP,ITYPE
      REAL NXTEMP
      REAL NX,LNOSE,LCENTR,LAFT,LTOTAL
C
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     1  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     2  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     3  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     4                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,
     5  BPNOSE,BCPNOS,BPCENT,BCPCEN,BPAFT,BCPAFT,BPLAN,
     6  BCENTP,ECSPN,ECSPC,ECSPA,ECSPT
C
      COMMON /THERY/ LSOSE,PRESUR,LHYBRD,LHYPER
C
      LOGICAL LSOSE,TRUNC
C
      DIMENSION REQ(50),DUM(8),DUMMY(20)
C
      LSOSE=.TRUE.
C
      NNX=NX+0.5
C
      DO 1000 I=1,NNX
         X(I)=X(I)-XO
         REQ(I)=SQRT(WIDTH(I)*HEIGHT(I))
 1000 CONTINUE
C
      LTOTAL=X(NNX)
C
      SPLAN=DSPLAN(NNX,X,WIDTH)
      BPLAN=DSPLAN(NNX,X,HEIGHT)
      ECSPT=DSPLAN(NNX,X,REQ)
      SWET=DSWETE(NNX,X,WIDTH,HEIGHT)
      VOL=DVOLE(NNX,X,WIDTH,HEIGHT)
      XCENTV=DXCNVE(NNX,X,WIDTH,HEIGHT)
      XCENTP=DXCENP(NNX,X,WIDTH)
      BCENTP=DXCENP(NNX,X,HEIGHT)
C
C  CHECK IF BODY LENGTHS ARE DEFINED
C
      INOSE=NNX
      ICENTR=NNX
      IF(LNOSE .EQ. UNUSED)GO TO 1020
      INOSE=1
      ICENTR=NNX
      DO 1010 I=2,NNX
         IF(LNOSE .EQ. X(I))INOSE=I-1
         IF(LCENTR .EQ. X(I))ICENTR=I-1
 1010 CONTINUE
C
      IF(LNOSE .GT. UNUSED)GO TO 1040
C
C  DEFINE NOSE LENGTH
C
 1020 INOSE=1
      DO 1030 I=2,NNX
         IF(REQ(I) .LE. REQ(I-1))GO TO 1040
         INOSE=I
 1030 CONTINUE
C
 1040 CONTINUE
C
      IF(INOSE .LE. 1)GO TO 1050
      LNOSE=X(INOSE)
      WNOSE=2.*WIDTH(INOSE)
      HNOSE=2.*HEIGHT(INOSE)
C
      IF(INOSE .EQ. NNX)GO TO 1090
C
C  DEFINE CENTER-BODY
C
 1050 INP1=INOSE+1
      ICENTR=INOSE
      IF(LCENTR .GT. UNUSED)GO TO 1070
      ICENTR=NNX
      IF(ABS(REQ(NNX)-REQ(INP1))/REQ(INP1) .LE. 0.01)GO TO 1070
      ICENTR=INOSE
      DO 1060 I=INP1,NNX
         IF(ABS(REQ(I)-REQ(I-1))/REQ(I) .GT. 0.01)GO TO 1070
         ICENTR=I
 1060 CONTINUE
C
 1070 CONTINUE
C
      IF(ICENTR .EQ. INOSE)GO TO 1080
      LCENTR=X(ICENTR)-X(INOSE)
      WCENTR=2.*WIDTH(ICENTR)
      HCENTR=2.*HEIGHT(ICENTR)
C
      IF(ICENTR .EQ. NNX)GO TO 1090
C
C  DEFINE AFT BODY
C
 1080 LAFT=X(NNX)-LNOSE-LCENTR
      WAFT=2.*WIDTH(NNX)
      HAFT=2.*HEIGHT(NNX)
C
 1090 IF(LNOSE .LE. UNUSED)GO TO 1100
      IF (INOSE.LE.1) GO TO 1100
C
C***  DEFINE THE GEOMETRY FOR AN EQUIVALENT CIRCULAR BODY
C***  WITH A SHARP NOSE TO BE USED IN THE TRANSONIC
C***  WAVE DRAG CALCULATION. THIS DATA IS STORED IN
C***  XRBLNT COMMON BLOCK.
      IF (BNOSE.GT.UNUSED) THEN
        NXTEMP=UNUSED
        CALL CONIC(DUM,NXTEMP,XTEMP,RTEMP,UNUSED,.FALSE.,
     &             LNOSE,REQ(INOSE),DUMMY)
        VNTEMP=DUM(3)
        DO 1095 I=INOSE+1,NNX
          NXTEMP=NXTEMP+1.0
          NTMP=NXTEMP+0.5
          XTEMP(NTMP)=X(I)
          RTEMP(NTMP)=REQ(I)
 1095   CONTINUE
C
C***    TOTAL WETTED AREA FOR SHARP NOSE
        SWTEMP=DSWET(NTMP,XTEMP,RTEMP)
      ENDIF
C
      SPNOSE=DSPLAN(INOSE,X,WIDTH)
      BPNOSE=DSPLAN(INOSE,X,HEIGHT)
      ECSPN=DSPLAN(INOSE,X,REQ)
      SWNOSE=DSWETE(INOSE,X,WIDTH,HEIGHT)
      VOLNOS=DVOLE(INOSE,X,WIDTH,HEIGHT)
      XCVNOS=DXCNVE(INOSE,X,WIDTH,HEIGHT)
      XCPNOS=DXCENP(INOSE,X,WIDTH)
      BCPNOS=DXCENP(INOSE,X,HEIGHT)
      THEOLN=LNOSE
C
 1100 IF(LCENTR .LE. UNUSED)GO TO 1110
C
      SPCENT=DSPLAN(ICENTR,X,WIDTH)-SPNOSE
      BPCENT=DSPLAN(ICENTR,X,HEIGHT)-BPNOSE
      ECSPC=DSPLAN(ICENTR,X,REQ)-ECSPN
      SWCENT=DSWETE(ICENTR,X,WIDTH,HEIGHT)-SWNOSE
      VOLCEN=DVOLE(ICENTR,X,WIDTH,HEIGHT)-VOLNOS
      XCVCEN=DXCNVE(ICENTR,X,WIDTH,HEIGHT)-XCVNOS
      XCPCEN=DXCENP(ICENTR,X,WIDTH)-XCPNOS
      BCPCEN=DXCENP(ICENTR,X,HEIGHT)-BCPNOS
      THEOLC=LCENTR
C
 1110 IF(LAFT .LE. UNUSED)GO TO 1120
C
      SPAFT=DSPLAN(NNX,X,WIDTH)-SPNOSE-SPCENT
      BPAFT=DSPLAN(NNX,X,HEIGHT)-BPNOSE-BPCENT
      ECSPA=DSPLAN(NNX,X,REQ)-ECSPN-ECSPC
      SWAFT=DSWETE(NNX,X,WIDTH,HEIGHT)-SWNOSE-SWCENT
      VOLAFT=DVOLE(NNX,X,WIDTH,HEIGHT)-VOLNOS-VOLCEN
      XCVAFT=DXCNVE(NNX,X,WIDTH,HEIGHT)-XCVNOS-XCVCEN
      XCPAFT=DXCENP(NNX,X,WIDTH)-XCPNOS-XCPCEN
      BCPAFT=DXCENP(NNX,X,HEIGHT)-BCPNOS-BCPCEN
      THEOLA=LAFT
C
 1120 CONTINUE
C
      DO 1130 I=1,NNX
         X(I)=X(I)+XO
 1130 CONTINUE
C
      DO 1140 I=1,20
         II=I
         IF(DISCON(I) .LE. UNUSED)GO TO 1150
 1140 CONTINUE
C
 1150 IF(II .GT. 1 .AND. DISCON(II-1) .NE. NX)DISCON(II)=NX
      IF(II .EQ. 1)DISCON(II)=NX
C
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. UNUSED)TNOSE=1.
      IF(LNOSE .GT. UNUSED .AND. TNOSE .GT. 4.)TNOSE=0.
      IF(TAFT .EQ. UNUSED .AND. LAFT .GT. UNUSED)TAFT=0.
      IF(TAFT .GT. 1. .AND. LAFT .GT. UNUSED)TAFT=0.
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ALPBET(ALPHA,ALPTOT,BETA,PHI)
C
C***  COMPUTE TOTAL ANGLE OF ATTACK AND AERODYNAMIC ROLL IF
C***  ANGLE OF ATTACK AND SIDESLIP ANGLE DEFINED
C
C***  COMPUTE ANGLE OF ATTACK AND SIDESLIP ANGLE IF TOTAL ANGLE
C***  OF ATTACK AND AERODYNAMIC ROLL DEFINED
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      IF(ABS(PHI) .GT. UNUSED)GO TO 1000
C
C***  PHI NOT DEFINED OR ZERO, ASSUME ALPHA/BETA INPUT
C
      ALPTOT=ATAN(SQRT((TAN(ALPHA/RAD))**2+(TAN(BETA/RAD))**2))*RAD
C
C***  EVALUATION OF AERODYNAMIC ROLL DEPENDENT UPON ALPHA AND BETA
C
      IF(ALPHA.EQ.0. .AND. BETA.EQ.0.) PHI=0.
      IF(ALPHA.NE.0. .AND. BETA.NE.0.) PHI=ATAN(TAN(BETA/RAD)/
     1                                     TAN(ALPHA/RAD))*RAD
      IF(ALPHA.EQ.0. .AND. BETA.NE.0.) PHI=90.*BETA/ABS(BETA)
C
      IF(ALPHA .GE. 0.)GO TO 1010
C
      IF(BETA.GE.0.) PHI=PHI+180
      IF(BETA .LT. 0.) PHI=PHI-180.
C
      GO TO 1010
C
 1000 CONTINUE
C
C***  PHI DEFINED, ASSUME TOTAL ANGLE OF ATTACK INPUT
C
      ALPHA = ATAN(TAN(ALPTOT/RAD)*COS(PHI/RAD))*RAD
      BETA  = -ATAN(TAN(ALPTOT/RAD)*SIN(PHI/RAD))*RAD
C
 1010 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BETADR(IM,TOTC)
C      
C***  EXECUTIVE ROUTINE FOR CALCULATING THE STATIC AERODYNAMICS
C***  FOR ALL COMPONENTS OF THE CONFIGURATION.  THE FIRST EXECUTION
C***  PORTION IS AT THE INPUT CONDITIONS.  THE SECOND PORTION IS FOR
C***  A BETA PERTURBATION OF ONE DEGREE TO GET THE BETA DERIVATIVES.
C      
      COMMON /CASEID/ CC(177),NOLAT,IR,IPAGE
      LOGICAL NOLAT
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /FLC/    NALPHA,FLDUM(143)
      REAL NALPHA
      COMMON /SBODY/  CBODY(220)
      COMMON /SFIN1/  CFIN1(220)
      COMMON /SFIN2/  CFIN2(220)
      COMMON /SFIN3/  CFIN3(220)
      COMMON /SFIN4/  CFIN4(220)
      COMMON /SB1/    CB1(220)
      COMMON /SB12/   CB12(220)
      COMMON /SB123/  CB123(220)
      COMMON /SB1234/ CB1234(220)
      COMMON /PARTF/  PARTS(19)
      DIMENSION PARTSS(16)
      LOGICAL PARTS,PARTSS,LPARTS
C      
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      DIMENSION TOTC(80),TTOTC(80),TB1(220),TB12(220),TB123(220),
     1 TB1234(220)
      DIMENSION TBODY(220),IFLAGA(3,4)
C      
C     SET FLAGS FOR BLANKING LAT-DIR DERIV. TO ZERO
C      
      DO 1010 J=1,4
         DO 1000 I=1,3
            IFLAGA(I,J)=0
 1000    CONTINUE
 1010 CONTINUE
      NALP=NALPHA+.5
C      
C***  COMPUTE STATIC AERODYNAMICS AT INPUT CONDITIONS
C      
      CALL SYNTHS(IM,TOTC,IFLAGA,0.)
      CALL BLKLDD(IFLAGA)
C      
C***  IF NOLAT IS TRUE THEN DO NOT COMPUTE BETA DERIVATIVES
C***  BLANK OUT DERIVATIVE FIELDS
C      
      IF(.NOT. NOLAT)GO TO 1030
C      
      DO 1020 I=161,220
         CB1(I)=-UNUSED
         CB12(I)=-UNUSED
         CB123(I)=-UNUSED
         CB1234(I)=-UNUSED
 1020 CONTINUE
      GO TO 1130
C      
C***  SAVE PRESENT CALCULATIONS
C***  TURN OFF PART FLAG FOR DERIVATIVE CALCULATIONS
C      
 1030 LPARTS=LPART
      LPART=.FALSE.
      DO 1040 I=1,16
         PARTSS(I)=PARTS(I)
         PARTS(I)=.FALSE.
 1040 CONTINUE
      DO 1050 I=1,220
         IF(I .LE. 80)TTOTC(I)=TOTC(I)
         TBODY(I)=CBODY(I)
         TB1(I)=CB1(I)
         TB12(I)=CB12(I)
         TB123(I)=CB123(I)
         TB1234(I)=CB1234(I)
         CB1(I)=UNUSED
         CB12(I)=UNUSED
         CB123(I)=UNUSED
         CB1234(I)=UNUSED
 1050 CONTINUE
C      
C***  PERTURB BETA BY ONE DEGREE AND COMPUTE NEW FLIGHT CONDITIONS
C      
      DO 1060 I=21,40
         TTOTC(I)=TTOTC(I)+1.
 1060 CONTINUE
C      
      DO 1070 I=1,NALP
         TTOTC(I+40)=UNUSED
         TTOTC(I+60)=UNUSED
         CALL ALPBET(TTOTC(I),TTOTC(I+60),TTOTC(I+20),TTOTC(I+40))
 1070 CONTINUE
C      
C*** FOR BETA PERTURBED, COMPUTE BODY ALONE DATA
C      
      DO 1080 I=1,NALP
         CBODY(I+60)=CBODY(I+60)+CBODY(I+160)
         CBODY(I+80)=CBODY(I+80)+CBODY(I+180)
         CBODY(I+100)=CBODY(I+100)+CBODY(I+200)
 1080 CONTINUE
C      
C***  SYNTHESIZE (RESULTS STORED IN I.O.M.)
C      
      CALL SYNTHS(IM,TTOTC,IFLAGA,0.)
C      
C***  DIFFERENCE PRESENT SYNTHESIS RESULTS WITH PRIOR TO GET
C***  BETA DERIVATIVES
C      
      DO 1090 I=1,220
         CB1(I)=CB1(I)-TB1(I)
         CB12(I)=CB12(I)-TB12(I)
         CB123(I)=CB123(I)-TB123(I)
         CB1234(I)=CB1234(I)-TB1234(I)
 1090 CONTINUE
C      
C ... DESIRE ONLY CY, CLN AND CLL DERIVATIVES
C      
      DO 1100 I=161,220
         CB1(I)=CB1(I-100)
         CB12(I)=CB12(I-100)
         CB123(I)=CB123(I-100)
         CB1234(I)=CB1234(I-100)
 1100 CONTINUE
      CALL BLKLDD(IFLAGA)
C      
C***  RESTORE FIRST SYNTHESIS RESULTS
C      
      DO 1110 I=1,220
         CBODY(I)=TBODY(I)
         IF(I .GT. 160)GO TO 1110
         CB1(I)=TB1(I)
         CB12(I)=TB12(I)
         CB123(I)=TB123(I)
         CB1234(I)=TB1234(I)
 1110 CONTINUE
C      
      LPART=LPARTS
      DO 1120 I=1,16
         PARTS(I)=PARTSS(I)
 1120 CONTINUE
C      
 1130 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CNPAXI(ALP,CNI,CMI)
C
C***********************************************************************
C
C     THIS SUBROUTINE CALCULATES INLET NORMAL FORCE COEFFICIENT AND
C     CENTER OF PRESSURE IN THE INLET COORDINATE SYSTEM FOR AN AXISYM-
C     METRIC INLET.  THIS SUBROUTINE CALCULATES AERODYNAMICS AT ONE
C     SET OF FLIGHT CONDITIONS.
C
C***********************************************************************
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      DIMENSION DCNI(4),DCMI(4)
C
      IF (.NOT.ICOVER) THEN
        WII=2.*LENGTH(1)*TAN(RAMANG/RAD)
        DCNI(1)=(PI*ALP)/(2.*RAD*SREF)*(WII)**2
        DCMI(1)=-((PI*ALP)/(6.*RAD*LREF*SREF))*(2.*WII**2)*LENGTH(1)
      ELSE
        DCNI(1)=((PI*ALP)/(2.*RAD*SREF))*(DEQI(2)**2-DEQI(1)**2)
        DCMI(1)=-((PI*ALP)/(6.*RAD*LREF*SREF))*(2.*DEQI(2)**2
     &          -DEQI(2)*DEQI(1)-DEQI(1)**2)*LENGTH(1)
      ENDIF
      DO 10 J=2,4
        DCNI(J)=((PI*ALP)/(2.*RAD*SREF))*(DEQI(J+1)**2-DEQI(J)**2)
        TCMI=-((PI*ALP)/(6.*RAD*LREF*SREF))*(2.*DEQI(J+1)**2
     &       -DEQI(J+1)*DEQI(J)-DEQI(J)**2)*LENGTH(J)
        IF(DCNI(J).LT.0.00001)THEN
          DCNI(J)=0.0
          DCMI(J)=0.0
        ELSE
          TCNICP=TCMI*LREF/DCNI(J)
          DCNICP=-XI(J)+TCNICP
          DCMI(J)=DCNI(J)*DCNICP/LREF
        ENDIF
   10   CONTINUE
      CNI=0.0
      CMI=0.0
      DO 20 J=1,4
        CNI=CNI+DCNI(J)
        CMI=CMI+DCMI(J)
   20 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE DDECOD(A,N,NUM1,NUM2)
C
C***  DECODE CONTROL CARD WRITE
C***  TO WRITE SELECTED PROGRAM ARRAYS TO TAPE UNIT 3
C
C***  INPUT
C
C    A -- COLUMNS 7-80 OF THE WRITE CONTROL CARD
C
C***  OUTPUTS
C
C    N -- NUMBER OF CHARACTERS IN BLOCK NAME
C NUM1 -- FIRST ARRAY ELEMENT TO BE DUMPED
C NUM2 -- LAST ARRAY ELEMENT TO BE DUMPED
C
      CHARACTER*4 A,AJ,COMMA,BLANK
      DIMENSION A(74),AJ(10),NN(2)
C
      DATA AJ/'0   ','1   ','2   ','3   ','4   ','5   ','6   ',
     1        '7   ','8   ','9   '/
      DATA COMMA/',   '/
      DATA BLANK/'    '/
C
      LOOP=1
      MM=0
      NN(1)=0
      NN(2)=0
C
      DO 1000 I=1,10
         II=I
         IF(A(II).EQ.COMMA) GO TO 1010
         IF(A(II).EQ.BLANK) GO TO 1010
 1000 CONTINUE
C
 1010 N=II-1
C
 1020 DO 1070 J=1,74
C
        IF(LOOP .GT. 2)GO TO 1080
C
        II=II+1
        IF(MM.EQ.1.AND.A(II).EQ.BLANK) GO TO 1030
        GO TO 1040
C
 1030   LOOP=LOOP+1
        MM=0
C
 1040   IF(A(II).EQ.COMMA.AND.MM.EQ.1) LOOP=LOOP+1
C
        DO 1060 K=1,10
           IF(A(II).EQ.AJ(K)) GO TO 1050
           GO TO 1060
C
 1050      NN(LOOP)=NN(LOOP)*10+(K-1)
           MM=1
        GO TO 1070
C
 1060   CONTINUE
C
 1070 CONTINUE
C
 1080 NUM1=NN(1)
      NUM2=NN(2)
      IF(NN(2).EQ.0) NUM2=NN(1)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCAWPF(CR, CT, B, CR1, CR2, CT1, CT2, RLER, RLET,
     1                 RTER, RTET, TRC, TTC, SWEEP, MACH, SREF, SECTYP,
     2                 PRINT, IFIN, CAF, CAFC, FAIL)
C
C     THIS SUBROUTINE CALCULATES THE FIN ALONE WAVE/PRESSURE DRAG AT
C     ZERO ANGLE-OF-ATTACK USING FIRST ORDER LINEAR POTENTIAL THEORY.
C     THE METHOD IS TAKEN FROM NWL-TR-3018, PAGES 6 THRU 19, AND IS
C     VALID AT LOW SUPERSONIC MACH NUMBERS. THE LOW MACH LIMIT IS 1.05
C     AND THE UPPER LIMIT IS ASSUMED TO BE THE SAME AS FOR THE VAN DYKE
C     BODY ALONE METHOD.
C
C     THE FIN MUST BE THIN WITH A HEX OR CIRCULAR ARC AIRFOIL SECTION.
C     THE AIRFOIL MAY HAVE BLUNT LEADING AND/OR TRAILING EDGES.
C     NEWTONIAN THEORY IS USED ON THE BLUNT LEADING EDGE WITH
C     POTENTIAL THEORY STARTED AT THE POINT ON THE LEADING EDGE WHERE
C     THE LOCAL SLOPE IS 15 DEGREES. IT IS ASSUMED THAT THE BLUNTING
C     IS CIRCULAR IN A PLANE NORMAL TO THE LEADING OR TRAILING EDGE.
C
C     THE AXIAL FORCE IS CALCULATED ON THE UPPER SURFACE OF THE FIN
C     AND MULTIPLIED BY 2.0 FOR THE SYMMETRICAL AIRFOIL AXIAL FORCE.
C     THE AXIAL FORCE COEFFICIENT IS BASED ON SREF FOR ONE PANEL.
C
C     INPUT VARIABLES -
C           CR     - ROOT CHORD
C           CT     - TIP CHORD
C           B      - SPAN OF TWO PANELS ALONE
C           CR1    - ROOT CHORD OF FWD WEDGE FOR HEX AIRFOILS
C           CR2    - ROOT CHORD OF AFT WEDGE FOR HEX AIRFOILS
C           CT1    - TIP CHORD OF FWD WEDGE FOR HEX AIRFOILS
C           CT2    - TIP CHORD OF AFT WEDGE FOR HEX AIRFOILS
C           RLER   - ROOT LEADING EDGE RADIUS
C           RLET   - TIP LEADING EDGE RADIUS
C           RTER   - ROOT TRAILING EDGE RADIUS
C           RTET   - TIP TRAILING EDGE RADIUS
C           TRC    - ROOT THICKNESS TO CHORD RATIO
C           TTC    - TIP THICKNESS TO CHORD RATIO
C           SWEEP  - LEADING EDGE SWEEP, DEG
C           MACH   - MACH NUMBER
C           SREF   - REFERENCE AREA
C           SECTYP - AIRFOIL SECTION TYPE
C                    = 0.0  HEX
C                    = 2.0  ARC
C           PRINT  - PRESSURE DISTRIBUTION PRINT FLAG
C                    = .TRUE.  PRINT PRESSURE DISTRIBUTIONS
C                    = .FALSE. DO NOT PRINT
C           IFIN   - FIN SET NUMBER
C
C     OUTPUT VARIABLES -
C           CAF    - FIN WAVE DRAG
C           CAFC   - FIN WAVE DRAG DUE TO THE LEADING EDGE
C
C  THE FLAG FAIL IS SET TO TRUE IF THE ANALYSIS FAILS
C
C
      LOGICAL PRINT,FAIL
C
      REAL MACH
C
      DIMENSION XMA(2), ZMA(2), XUA(2), ZUA(2)
      DIMENSION Y(9), X(9), DUM(9), XW(60), CP(60), DCA(9), RCA(9)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /CAFD/  XO(60), XT(60), DZDXO(60), DZDXT(60), TGA(60),
     1               ETA(60), DZDX(60), NS, CPO
C
      DATA DUM / 9*1.0 /
C
C     SET CONSTANTS FOR CALCULATIONS
C
      DO 10 I=1,60
         XO(I)=0.
         XT(I)=0.
         DZDXO(I)=0.
         DZDXT(I)=0.
         TGA(I)=0.
         ETA(I)=0.
         DZDX(I)=0.
         XW(I)=0.
         CP(I)=0.
         IF(I .GT. 9)GO TO 10
         Y(I)=0.
         X(I)=0.
         DCA(I)=0.
         RCA(I)=0.
   10 CONTINUE
      NS=0
      CPO  = (1.2*MACH*MACH)**3.5 * (6.0/(7.0*MACH*MACH-1.0))**2.5
      CPO  = (CPO-1.0)/(0.7*MACH*MACH)
      THM  = 15.0
      ISEC = SECTYP+0.1
      TR   = TRC*CR
      TT   = TTC*CT
      CS   = COS(SWEEP/RAD)
C
C     CONSTRUCT ROOT AND TIP LOCATIONS OF SOSL AND ASSOCIATED GEOM.
C     CALC - XO, XT, DZDX0, DZDXT, TGA, ETA, XMA, ZMA, XUA, ZUA,
C            AND INDICIES L, AND NP
C     L  = NUMBER OF POINTS AROUND BLUNT LE WITH A SLOPE .LE. 15 DEG.
C
      IF(ISEC .EQ. 0) CALL HSOSL(CR, CT, B, TR, TT, RLER, RLET, RTER,
     1                           RTET, SWEEP, CR1, CR2, CT1, CT2, MACH,
     2                           XMA, ZMA, XUA, ZUA, L, FAIL)
C
      IF(FAIL) GO TO 120
C
      IF(ISEC .EQ. 2) CALL ASOSL(CR, CT, B, TR, TT, RLER, RLET, RTER,
     1                           RTET, SWEEP, MACH,
     2                           XMA, ZMA, XUA, ZUA, L, FAIL)
C
      IF(FAIL) GO TO 120
C
C***  CHECK FOR NEGATIVE SOURCE OR SINK LINE SLOPES
C
      DO 15 I=1,60
         IF(TGA(I) .LT. 0. .AND. TGA(I) .GE. -1./RAD)TGA(I)=0.
         IF(TGA(I) .LT. 0.)FAIL=.TRUE.
C        IF(FAIL .AND. PARTS(18)) WRITE(6,150)
         IF(FAIL) GO TO 120
   15 CONTINUE
C
C     CALCULATE DCA/DY AT 9 SPAN STATIONS, J = SPAN STATION INDEX
C     AT EACH SPAN STATION INTEGRATE PRESSURES ARROUND AIRFOIL,
C     K = CHORD STATION INDEX
C
      DO 110 J=1,9
        Y(J) = (J-1)*(B/2.0)/8.0
        YP   = Y(J)
        IF(J .EQ. 1) YP = 0.0001
        IF(J .EQ. 9) YP = (B/2.0) - 0.0001
        YY     = 2.0*YP/B
        X(J)   = YP*TAN(SWEEP/RAD)
        DCA(J) = 0.0
C       ...
C       ... AIRFOIL GEOM AT SPAN STA YP
C       ...
        AJ  = 2.0*YP/B
        RLE = RLER - AJ*(RLER-RLET)
        RTE = RTER - AJ*(RTER-RTET)
        XU  = XUA(1) - AJ*(XUA(1)-XUA(2))
        ZU  = ZUA(1) - AJ*(ZUA(1)-ZUA(2))
        XM  = XMA(1) - AJ*(XMA(1)-XMA(2))
        ZM  = ZMA(1) - AJ*(ZMA(1)-ZMA(2))
        C   = CR - AJ*(CR-CT)
        T   = TR - AJ*(TR-TT)
        IF(ISEC .EQ. 0) C1 = CR1 - AJ*(CR1-CT1)
        IF(ISEC .EQ. 0) C2 = CR2 - AJ*(CR2-CT2)
        DO 20 K=1,60
          DZDX(K) = DZDXO(K) - AJ*(DZDXO(K)-DZDXT(K))
   20   CONTINUE
        IF(PRINT) WRITE(11,130) IFIN, MACH
C       ...
C       ... PRESSURE AND CA ON NOSE CAP - SUM INTO DCA
C       ...
        IF(RLE .LE. 0.00001) GO TO 50
          THU    = (90.0-THM)/RAD
          DCA(J) = CPO*CS*CS*RLE*(SIN(THU)-SIN(THU)**3/3.0)
          RCA(J)=DCA(J)
          IF(.NOT. PRINT) GO TO 40
            DO 30 I=1,8
              THET = (90.0-10.0*(I-1))/RAD
              CPNC = CPO*CS*CS*SIN(THET)**2
              XX   = RLE*(1.0-SIN(THET))
              XX   = XX/C
              WRITE(11,140) YY, XX, CPNC
   30       CONTINUE
   40     CONTINUE
   50   CONTINUE
C       ...
C       ... PRESSURE AND CA ON AFT SECTION OF NOSE CAP - SUM INTO DCA
C       ...
        IF(RLE .LE. 0.00001) GO TO 80
          CALL AFTCAP(L, YP, X(J), B, MACH, XW, CS, CP, DDCAC, FAIL)
C         IF(PARTS(18) .AND. FAIL)WRITE(6,170)
          IF(FAIL)GO TO 120
          DCA(J) = DCA(J)+DDCAC
          IF(.NOT. PRINT) GO TO 70
            N1 = L+1
            DO 60 I=2,N1
              XX = (XW(I)-X(J))/C
              WRITE(11,140) YY, XX, CP(I)
   60       CONTINUE
   70     CONTINUE
   80   CONTINUE
C       ...
C       ... INTEGRATE PRESSURES AROUND AIRFOIL
C       ...
        IF(ISEC .EQ. 0) CALL HEXCA(L, YP, B, MACH, XW, CP, NF, DDCAC,
     1                  FAIL)
        IF(ISEC .EQ. 2) CALL ARCCA(L, YP, B, MACH, XW, CP, NF, DDCAC,
     1                  FAIL)
C       IF(FAIL .AND. PARTS(18)) WRITE(6,160)
        IF(FAIL) GO TO 120
        DCA(J) = DCA(J)+DDCAC
        IF(.NOT. PRINT) GO TO 100
          N1 = L+2
          DO 90 I=N1,NF
            XX = (XW(I)-X(J))/C
            WRITE(11,140) YY, XX, CP(I)
   90     CONTINUE
  100   CONTINUE
  110 CONTINUE
C     ...
C     ... INTEGRATE DCA FOR CAF
C     ...
      CAF = 0.0
      CAFC= 0.0
      DY  = B/16.0
      CALL SIMPW(DCA, DUM, DY, 1, 9, CAF)
      CALL SIMPW(RCA, DUM, DY, 1, 9, CAFC)
      CAF = 2.0*CAF/SREF
      CAFC= 2.0*CAFC/SREF
C
  120 CONTINUE
C     ...
C     ... FORMAT STATEMENTS
C     ...
  130 FORMAT('ZONE T="FIN SET ',I2,' CP, MACH=',F6.2,'"')
  140 FORMAT(3F10.5)
C 150 FORMAT(4X,'FIN POTENTIAL FLOW METHOD FAILING.  SOURCE OR',
C    1 ' SINK LINE SWEPT FORWARD.')
C 160 FORMAT(4X,'FIN POTENTIAL FLOW METHOD FAILING.  NEGATIVE',
C    1 ' SQUARE ROOT IN CP CALCULATION.')
C 170 FORMAT(4X,'FIN POTENTIAL FLOW METHOD FAILING.  ROUTINE',
C    1 ' AFTCAP CP CALCULATION ERROR.')
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FLTCDS
C
C***  TOP LEVEL ROUTINE TO COMPUTE THE REQUIRED FLIGHT CONDITIONS
C
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      COMMON /TOTALC/ BALPHA(20),BBETA(20),BPHI(20),ALPTOT(20)
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C
      REAL NALPHA,NMACH,MACH
C
      DIMENSION ARRAY(9)
C
      DATA RCON/1716.0/
      DATA GAMMA/1.400/
      DATA RNCON/1.2527E6/
C
C***  COMPUTE FLIGHT CONDITIONS FOR ALL MACH NUMBERS
C
      NNMACH=NMACH+0.5
C
      DO 1030 I=1,NNMACH
C
C***  CHECK FOR MACH AND REYNOLDS NUMBER INPUTS, SKIP IF PRESENT
C
         IF(MACH(I).NE.UNUSED .AND. REN(I).NE.UNUSED)GO TO 1030
C
C  IS ALTITUDE INPUT
C
         IF(ALT(I) .EQ. UNUSED)GO TO 1010
C
C  ALTITUDE INPUT, IS MACH NUMBER
C
         IF(MACH(I) .EQ. UNUSED)GO TO 1000
C
C***  BOTH ALTITUDE AND MACH NUMBER INPUT
C
         CALL ATMOS(ALT(I),ARRAY)
         IF(TINF(I) .EQ. UNUSED)TINF(I)=ARRAY(8)
         IF(PINF(I) .EQ. UNUSED)PINF(I)=ARRAY(4)
         VINF(I)=MACH(I)*SQRT(GAMMA*RCON*TINF(I))
         REN(I)=RNCON*PINF(I)*MACH(I)*(TINF(I)+198.6)/TINF(I)**2
      GO TO 1030
C
 1000 CONTINUE
C
C  IS VELOCITY INPUT
C
         IF(VINF(I) .EQ. UNUSED)GO TO 1030
C
C***  BOTH VELOCITY AND ALTITUDE INPUT
C
         CALL ATMOS(ALT(I),ARRAY)
         IF(TINF(I) .EQ. UNUSED)TINF(I)=ARRAY(8)
         IF(PINF(I) .EQ. UNUSED)PINF(I)=ARRAY(4)
         MACH(I)=VINF(I)/SQRT(GAMMA*RCON*TINF(I))
         REN(I)=RNCON*PINF(I)*MACH(I)*(TINF(I)+198.6)/TINF(I)**2
      GO TO 1030
C
 1010 CONTINUE
C
C  ALTITUDE NOT INPUT, IS FREESTREAM PRESSURE AND TEMPERATURE
C
         IF(PINF(I) .EQ. UNUSED .OR. TINF(I) .EQ. UNUSED)GO TO 1030
C
C  IS MACH NUMBER INPUT
C
         IF(MACH(I) .EQ. UNUSED)GO TO 1020
C
C***  MACH NUMBER, TEMPERATURE AND PRESSURE INPUT
C
         VINF(I)=MACH(I)*SQRT(GAMMA*RCON*TINF(I))
         REN(I)=RNCON*PINF(I)*MACH(I)*(TINF(I)+198.6)/TINF(I)**2
      GO TO 1030
C
 1020 CONTINUE
C
C  IS FREESTREAM VELOCITY INPUT
C
         IF(VINF(I) .EQ. UNUSED)GO TO 1030
C
C***  VELOCITY, TEMPERATURE AND PRESSURE INPUT
C
         MACH(I)=VINF(I)/SQRT(GAMMA*RCON*TINF(I))
 1030 CONTINUE
C
C***  COMPUTE TOTAL ANGLE OF ATTACK, OR ALPHA/BETA
C
      NALP=NALPHA+0.5
      DO 1040 I=1,NALP
         BALPHA(I)=ALPHA(I)
         ALPTOT(I)=ALPHA(I)
         BBETA(I)=BETA
         BPHI(I)=PHI
 1040 CONTINUE
C
      IF(ABS(BETA).LE.UNUSED .AND. ABS(PHI).LE.UNUSED)GO TO 1060
      DO 1050 I=1,NALP
         IF(ABS(PHI) .GT. UNUSED)CALL ALPBET(BALPHA(I),ALPHA(I),
     1      BBETA(I),PHI)
         IF(ABS(PHI) .LE. UNUSED)CALL ALPBET(ALPHA(I),ALPTOT(I),BETA,
     1           BPHI(I))
 1050 CONTINUE
C
 1060 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ILTARO(IM,BCN,BCM,BCA,BCY,BCLN,BCLL)
C**********************************************************************
C
C     THIS PROGRAM CALCULATES AERODYNAMICS FOR INLETS AT SUBSONIC 
C     AND SUPERSONIC SPEEDS.  THE CODE CALCULATES CONTRIBUTIONS TO 
C     NORMAL FORCE AND SIDE FORCE AERODYNAMICS USING A COMBINATION OF 
C     POTENTIAL FLOW AND VISCOUS CROSS FLOW THEORIES.  THE CONTRIBUTION 
C     TO AXIAL FORCE IS CALCULATED USING A COMBINATION OF THE WAVE 
C     DRAG AREA RULE AND CLASSICAL SKIN FRICTION METHODS.
C
C***********************************************************************
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C  MODIFIED BY K. BURNS, MCDONNELL DOUGLAS
C  FURTHER MODIFIED BY W. BLAKE, WL/FIGC
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IADD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
      COMMON /GEOBOD/ GDUM(32),DMAX,SMAX,LBOD,GDUM1(12)
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH,MFR,MFRM
      LOGICAL ICOVER,IADD
      COMMON /ABODIN/ DUM,XO,DUM2(879)
      COMMON /PARTF/ PARTS(19)
      COMMON /INLTD/ CNINLT(20),CMINLT(20),CAINLT(20),
     1               CYINLT(20),CLNILT(20),CLLILT(20)
C
      LOGICAL PARTS
      DIMENSION X(50),R(50),CMMOM(20),CLNMOM(20)
      DIMENSION BCN(20),BCM(20),BCA(20),BCY(20),BCLN(20),BCLL(20)
C
      REAL LINLET,LNOSE,NX
C
      NUMFLT=NALPHA+0.5
      NUMMCH=NMACH+0.5
      NUMIN=NIN+0.5
C
      ALPHA1 = 1.0
      BETA1  = 1.0
      IF(INTYPE.EQ.1.)THEN
        CALL POTAR1(ALPHA1,BETA1,CNP1,CYP1,CMP1,CLNP1)
      ELSEIF(INTYPE.EQ.2.)THEN
        CALL POTAR2(ALPHA1,BETA1,CNP1,CYP1,CMP1,CLNP1)
      ELSEIF(INTYPE.EQ.3.)THEN
        CALL POTAR3(ALPHA1,BETA1,CNP1,CYP1,CMP1,CLNP1)
      ENDIF
      CNA = CNP1*RAD
      CMA = CMP1*RAD
      CYB = CYP1*RAD
      CLNB= CLNP1*RAD
      BETAR  = BETA/RAD
      DO 10 IFLT = 1, NUMFLT
        ALPHAR = ALPHA(IFLT)/RAD
        CNP(IFLT)=CNA*COS(ALPHAR)*SIN(ALPHAR)
        CMP(IFLT)=CMA*COS(ALPHAR)*SIN(ALPHAR)
        IF(ABS(CNP(IFLT)).GT.0.00001)THEN
          XXCPA=ABS(CMP(IFLT)/CNP(IFLT)*LREF)+XINLT
          CMP(IFLT)=CNP(IFLT)*((XCG-XO)-XXCPA)/LREF
        ENDIF
        CYP(IFLT)=CYB*COS(BETAR)*SIN(BETAR)
        CLNP(IFLT)=CLNB*COS(BETAR)*SIN(BETAR)
        IF(ABS(CYP(IFLT)).GT.0.00001)THEN
          XXCPB=ABS(CLNP(IFLT)/CYP(IFLT)*BREF)+XINLT
          CLNP(IFLT)=CYP(IFLT)*((XCG-XO)-XXCPB)/BREF
        ENDIF
C
   10 CONTINUE
C
C     CALCULATION OF FORCE INCREMENT DUE TO FLOW TURNING
      DO 20 IFLT = 1, NUMFLT
        IF (ICOVER) THEN
          CNMOM(IFLT)=0.0
          CYMOM(IFLT)=0.0
          CMMOM(IFLT)=0.0
          CLNMOM(IFLT)=0.0
        ELSE
          ALPHAR = ALPHA(IFLT)/RAD
          CALL MOMFOR(ALPHAR,BETAR,CNMOM(IFLT),CYMOM(IFLT))
          CMMOM(IFLT)=CNMOM(IFLT)*((XCG-XO)-XINLT)/LREF
          CLNMOM(IFLT)=CYMOM(IFLT)*((XCG-XO)-XINLT)/BREF
        ENDIF
   20 CONTINUE    
C
C     CALCULATION OF LINEAR AERODYNAMICS BASED ON PLANFORM ASPECT
C     RATIO
      CALL LINFOR(CNALIN,CYBLIN)
C
      CALL LINXCP(IM,XCPA,XCPB)
      DO 30 IFLT = 1, NUMFLT
        ALPHAR = ALPHA(IFLT)/RAD
        CNLIN(IFLT) = CNALIN * COS(ALPHAR) * SIN(ALPHAR)
        XXCPA = XCPA + XINLT
        CMLIN(IFLT) = CNLIN(IFLT)*((XCG-XO)-XXCPA)/LREF
        CYLIN(IFLT) = -CYBLIN * COS(BETAR) * SIN(BETAR)
        XXCPB = XCPB + XINLT
        CLNLIN(IFLT) = CYLIN(IFLT)*((XCG-XO)-XXCPB)/BREF
   30 CONTINUE
C
C     CALL VISCOUS CROSS FLOW CALCULATIONS
      CALL ILTVIS(IM)
C
      DO 50 IFLT = 1, NUMFLT
        IF(ABS(CNCF(IFLT)).GT.0.00001)THEN
          XXCPA=ABS(CMCF(IFLT)/CNCF(IFLT)*LREF)+XINLT
          CMCF(IFLT)=CNCF(IFLT)*((XCG-XO)-XXCPA)/LREF
        ENDIF
        IF(ABS(CYCF(IFLT)).GT.0.00001)THEN
          XXCPB=ABS(CLNCF(IFLT)/CYCF(IFLT)*BREF)+XINLT
          CLNCF(IFLT)=CYCF(IFLT)*((XCG-XO)-XXCPB)/BREF
        ENDIF
   50 CONTINUE
C
      DO 70 IFLT = 1, NUMFLT
        CNINLT(IFLT) = CNP(IFLT) + 0.*CNLIN(IFLT)
     1                        + CNCF(IFLT) + CNMOM(IFLT)
        CMINLT(IFLT) = CMP(IFLT) + 0.*CMLIN(IFLT)
     1                        + CMCF(IFLT) + CMMOM(IFLT)
        CYINLT(IFLT) = CYP(IFLT) + 0.*CYLIN(IFLT)
     1                        + CYCF(IFLT) + CYMOM(IFLT)
        CLNILT(IFLT) = CLNP(IFLT) + 0.*CLNLIN(IFLT)
     1                        + CLNCF(IFLT) + CLNMOM(IFLT)
   70 CONTINUE
C
C     AXIAL FORCE CALCULATIONS
C
      CALL ILTRVX(NSTEP,X,R)
      CALL ILTSWT(SWET)
C
C     FIND MAXIMUM DIAMETER OF EQUIVALENT RADIUS
      RMAX=R(1)
      INDEX=1
      DO 80 I=2,NSTEP
        IF (R(I).LE.RMAX) THEN
C
C         SPECIFY LENGTH, FINENESS RATIO, AND VOLUME OF THE NOSE
          LNOSE=X(INDEX)
          FRNOSE=LNOSE/(2.*RMAX)
          VOLNOS=DVOL(INDEX,X,R)
          GOTO 90
        ENDIF
        RMAX=R(I)
        INDEX=I
   80 CONTINUE
   90 CONTINUE
C
      LINLET = XI(5)
      FR=LINLET/(2.*RMAX)
      NX=FLOAT(NSTEP)
C
C***  CHECK TO SEE IF CRITICAL MACH NUMBER HAS BEEN REACHED
      CALL MDIV(FRNOSE,NX,R,X,LNOSE,CRMACH)
      IF (MACH(IM).LE.CRMACH) THEN
C
C***    SUBSONIC SKIN FRICTION DRAG
        CALL CAFRIC(0.,MACH(IM),REN(IM),LINLET,ROUGH,
     &            BLAYER,SWET,SREF,1.1547,1.022,CAF)
C
C***    SUBSONIC PRESSURE DRAG 
        CALL BDCAPR(FR,CAF,CAPR)
C
C***    CORRECT FOR COMPRESSIBILITY EFFECTS
        IF (MACH(IM) .LT. 1.) CAPR=CAPR/SQRT(1.-MACH(IM)**2)
C
      ELSE
C
C***    SUPERSONIC SKIN FRICTION DRAG
        CALL SKINF(MACH(IM),REN(IM),LINLET,ROUGH,BLAYER,SWET,SREF,
     &                     1.0,1.1547,1.022,CAF)
C
C***    CALCULATE SUBSONIC PRESSURE DRAG FOR WAVE DRAG CALCULATIONS
        CALL CAFRIC(0.,CRMACH,REN(IM),LINLET,ROUGH,BLAYER,SWET,
     &         SREF,1.1547,1.022,CAFO)
        CALL BDCAPR(FR,CAFO,CDPO)
C
C***    CALCULATE TRANSONIC/SUPERSONIC WAVE DRAG
        IF(MACH(IM).GT.1.2) THEN
          CALL CDPRES(NX,X,R,SREF,1.2,FRNOSE,
     $              VOLNOS,LNOSE,CRMACH,CDPO,CAPR12)
          CAPR=CAPR12*.66332/SQRT(MACH(IM)**2-1.)
        ELSE
          CALL CDPRES(NX,X,R,SREF,MACH(IM),FRNOSE,
     &              VOLNOS,LNOSE,CRMACH,CDPO,CAPR)
        ENDIF
      ENDIF
C
        CA=NIN*(CAF+CAPR)
C
C***  CALCULATE INLET ADDITIVE DRAG
      CXADD=0.0
      IF ((IADD).AND.(.NOT.ICOVER).AND.(MACH(IM).GE.1.0)) THEN
        IF (INTYPE.EQ.3.) THEN
          CALL IADAXI(MACH(IM),RAMANG,XI(2),DEQI(2)/2.,
     &                MFR(IM),SREF,CXADD,MFRM)
        ELSE
          CALL IAD2D(MACH(IM),RAMANG,XI(2),HI(2),WI(2),
     &               MFR(IM),SREF,CXADD,MFRM)
        ENDIF
        CXADD=CXADD*NIN
      ENDIF
C
C  REV 1/96 UPDATE
C
C*** CALCULATE ROLLING MOMENT DUE TO INLETS
C*** CALCULATE AXIAL FORCE CONTRIBUTION TO PITCHING AND YAWING MOMENT
C
        IF(INTYPE.LT.1.5) ARM=DMAX/2.+HDIV+HI(3)*4./(3.*PI)
        IF(INTYPE.GT.1.5) ARM=DMAX/2.+HDIV+WI(3)*4./(3.*PI)
        DO 92 I=1,NUMFLT
          CLLILT(I)=0.
          DO 95 J=1,NUMIN
            TCN=CNINLT(I)/NIN*(ARM/BREF)
            TCY=CYINLT(I)/NIN*(ARM/BREF)
            TCA=(CA+CXADD)/NIN*(ARM/BREF)
            CLLILT(I)=CLLILT(I)-TCN*SIN(PHI(J)/RAD)+TCY*COS(PHI(J)/RAD)
            CMINLT(I)=CMINLT(I)+TCA*COS(PHI(J)/RAD)*BREF/LREF
            CLNILT(I)=CLNILT(I)+TCA*SIN(PHI(J)/RAD)
   95     CONTINUE
   92   CONTINUE
C
C***  ADD INLET INCREMENTS TO BODY ALONE COEFFICIENTS
      DO 100 I=1,NUMFLT
        BCN(I)=CNINLT(I)+BCN(I)
        BCM(I)=CMINLT(I)+BCM(I)
        BCA(I)=CA+CXADD+BCA(I)
        CAINLT(I)=CA
        BCY(I)=CYINLT(I)+BCY(I)
        BCLN(I)=CLNILT(I)+BCLN(I)
        BCLL(I)=BCLL(I)+CLLILT(I)
  100 CONTINUE
C
C***  PRINT INLET AERODYNAMICS
      IF (PARTS(16)) CALL INLETA(IM,CXADD,MFRM)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PRINT(IM)
C
C***  PRINT THE RESULTS COMPUTED
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LDUM2(26)
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS,LDMPCS,LDAMP
C
C ** PRINT AUXILIARY DATA IF REQUIRED
C
      CALL SAVEF
C
C ** PRINT/PLOT AERODYNAMIC OUTPUT (STATICS)
C
      IF(PARTS(19))CALL PRINTS(IM)
C
C ** PRINT DYNAMIC DERIVATIVES IF CALCULATED
C
      IF(LDAMP)CALL DWRIT2(IM)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SPHERE(AA,NX,X,R,DIAM)
C
C***  CALCULATE THE CHARACTERISTICS OF A SPHERICAL NOSE CAP
C
C***  INPUTS
C
C     NX -- NUMBER OF INPUT POINTS
C      X -- X COORDINATES
C      R -- RADII AT EACH X STATION
C   DIAM -- DIAMETER OF SPHERE
C
C***  OUTPUT
C
C     AA -- ARRAY OF CHARACTERISTICS TO BE COMPUTED
C           AA(1)=PLANFORM AREA
C           AA(2)=WETTED AREA
C           AA(3)=VOLUME
C           AA(4)=VOLUME CENTROID
C           AA(5)=PLANFORM CENTROID
C           AA(6)=FINENESS RATIO
C           AA(7)=THEORETICAL LENGTH
C           AA(8)=THEORETICAL FINENESS RATIO
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION X(50),R(50),AA(8)
C
      REAL NX
C
      NPTS=11
C
      FR=0.5
      THEOL=DIAM/2.
      FF=0.5
C
      SP=0.5*PI*DIAM**2/4.
C
      SW=0.5*PI*DIAM**2
C
      VOL=0.5*PI*DIAM**3/6.
C
      XCENV=DIAM/2.-3.*DIAM/16.
C
      XCENP=DIAM/2.-4.*(DIAM/2.)/(3.*PI)
C
      DO 1000 I=1,NPTS
         X(I)=FLOAT(I-1)*DIAM/(2.*FLOAT(NPTS-1))
         R(I)=SQRT((DIAM/2.)**2-(X(I)-DIAM/2.)**2)
 1000 CONTINUE
C
      NX=NX+FLOAT(NPTS)
C
      AA(1)=SP
      AA(2)=SW
      AA(3)=VOL
      AA(4)=XCENV
      AA(5)=XCENP
      AA(6)=FR
      AA(7)=THEOL
      AA(8)=FF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE USERS
C
C***  SUBROUTINE TO COMPUTE GEOMETRY CHARACTERISTICS FOR USER
C***  DEFINED SHAPES
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     1                TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,
     2                POWER,DISCON(20),ADUM(748)
      COMMON /XRBLNT/ XTEMP(50),RTEMP(50),NXTEMP,VNTEMP,SWTEMP,ITYPE
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     1  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     2  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     3  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     4                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,GDUM(12)
      COMMON /THERY/ LSOSE,PRESUR,LHYBRD,LHYPER
C
      DIMENSION XX(50),RR(50),DUM(8),DUMMY(20),IROUT(2)
      REAL NXTEMP
      REAL NX,LNOSE,LCENTR,LAFT,LTOTAL
      LOGICAL LSOSE,TRUNC
C
      LSOSE=.TRUE.
C
      NNX=NX+0.5
      DO 1000 I=1,NNX
         X(I)=X(I)-XO
         XX(I)=X(I)
         RR(I)=R(I)
 1000 CONTINUE
C
C***  TOTAL BODY GEOMETRY CHARACTERISTICS
C
      LTOTAL=X(NNX)
C
      SPLAN=DSPLAN(NNX,X,R)
      SWET=DSWET(NNX,X,R)
      VOL=DVOL(NNX,X,R)
      XCENTV=DXCENV(NNX,X,R)
      XCENTP=DXCENP(NNX,X,R)
C
      INOSE=0
      ICENTR=0
      IAFT=0
C
C***  INSERT COORDINATES IF REQUIRED
C
      IF(LNOSE .LE. UNUSED)GO TO 1050
C
      CALL LNTRP(XX,RR,NNX,LNOSE,RNOSE)
C
      INSERT=0
      DO 1010 I=1,NNX
         IF(ABS(LNOSE - XX(I)) .LT. 0.00001)INOSE=I
         IF(ABS(LNOSE - XX(I)) .LT. 0.00001)GO TO 1050
         IF(LNOSE .LT. XX(I))INSERT=I
         IF(LNOSE .LT. XX(I))GO TO 1020
 1010 CONTINUE
C
      IF(INSERT .EQ. 0)GO TO 1050
C
 1020 INOSE=INSERT
      DO 1030 I=INSERT,NNX
         XX(NNX+1-I+INSERT)=XX(NNX-I+INSERT)
         RR(NNX+1-I+INSERT)=RR(NNX-I+INSERT)
 1030 CONTINUE
      XX(INSERT)=LNOSE
      RR(INSERT)=RNOSE
      IF(DNOSE .LE. UNUSED)DNOSE=2.*RNOSE
      NNX=NNX+1
      DO 1040 I=1,20
         IF(DISCON(I) .GE. FLOAT(INSERT))DISCON(I)=DISCON(I)+1.
 1040 CONTINUE
C
 1050 CONTINUE
      IF(INOSE .EQ. NNX)GO TO 1110
C
      IF(LCENTR .LE. UNUSED)GO TO 1100
C
      CALL LNTRP(XX,RR,NNX,LNOSE+LCENTR,RCENTR)
C
      INSERT=0
      DO 1060 I=1,NNX
         IF(ABS(LCENTR - (XX(I)-XX(INOSE))) .LT. 0.00001)ICENTR=I
         IF(ABS(LCENTR - (XX(I)-XX(INOSE))) .LT. 0.00001)GO TO 1100
         IF(LCENTR .LT. (XX(I)-XX(INOSE)))INSERT=I
         IF(LCENTR .LT. (XX(I)-XX(INOSE)))GO TO 1070
 1060 CONTINUE
C
      IF(INSERT .EQ. 0)GO TO 1100
C
 1070 ICENTR=INSERT
      DO 1080 I=INSERT,NNX
         XX(NNX+1-I+INSERT)=XX(NNX-I+INSERT)
         RR(NNX+1-I+INSERT)=RR(NNX-I+INSERT)
 1080 CONTINUE
      XX(INSERT)=LNOSE+LCENTR
      RR(INSERT)=RCENTR
      IF(DCENTR .LE. UNUSED)DCENTR=2.*RCENTR
      NNX=NNX+1
      DO 1090 I=1,20
         IF(DISCON(I) .GE. FLOAT(INSERT))DISCON(I)=DISCON(I)+1.
 1090 CONTINUE
C
 1100 CONTINUE
      IF((INOSE+ICENTR) .EQ. NNX)GO TO 1110
C
      IAFT=NNX
C
 1110 CONTINUE
C
      DO 1120 I=1,NNX
         X(I)=XX(I)
         R(I)=RR(I)
 1120 CONTINUE
C
      NX=FLOAT(NNX)
C
      IF(LNOSE .GT. UNUSED)GO TO 1150
C
C***  DEFINE NOSE
C
      DO 1130 I=2,NNX
         IF(R(I) .LE. R(I-1))GO TO 1140
         INOSE=I
 1130 CONTINUE
C
 1140 IF(INOSE .LT. 1)GO TO 1150
      LNOSE=X(INOSE)
      DNOSE=2.*R(INOSE)
C
C***  DEFINE CENTERBODY
C
 1150 IF(LCENTR .GT. UNUSED)GO TO 1180
      INP1=INOSE+1
      IF(INP1 .LE. 1)INP1=2
      DO 1160 I=INP1,NNX
         IF(R(I) .NE. R(I-1))GO TO 1170
         ICENTR=I
 1160 CONTINUE
C
 1170 IF(ICENTR .LT. 1)GO TO 1180
      LCENTR=X(ICENTR)
      IF(INOSE .GT. 0)LCENTR=X(ICENTR)-X(INOSE)
      DCENTR=2.*R(ICENTR)
C
C***  DEFINE AFT BODY
C
 1180 IF(LAFT .GT. UNUSED)GO TO 1190
      IF(LNOSE .EQ. LTOTAL .OR. (LNOSE+LCENTR) .EQ. LTOTAL)
     1   GO TO 1190
      IAFT=NNX
      LAFT=LTOTAL-LNOSE-LCENTR
      DAFT=2.*R(NNX)
C
 1190 IF(LNOSE .LE. UNUSED)GO TO 1200
      IF(INOSE .LE. 1)GO TO 1200
C
C***  DEFINE GEOMETRY FOR A SHARP NOSE TO BE USED 
C***  IN TRANSONIC WAVE DRAG CALCULATIONS.
C***  THIS DATA IS STORED IN XRBLNT COMMON BLOCK
      IF (BNOSE.GT.UNUSED) THEN
        NXTEMP=UNUSED
        CALL CONIC(DUM,NXTEMP,XTEMP,RTEMP,UNUSED,.FALSE.,
     &             LNOSE,DNOSE,DUMMY)
        VNTEMP=DUM(3)
        DO 1195 I=INOSE+1,NNX
          NXTEMP=NXTEMP+1.0
          NTMP=NXTEMP+0.5
          XTEMP(NTMP)=X(I)
          RTEMP(NTMP)=R(I)
 1195   CONTINUE
C
C***    TOTAL WETTED AREA FOR SHARP NOSE
        SWTEMP=DSWET(NTMP,XTEMP,RTEMP)
      ENDIF
C
      SPNOSE=DSPLAN(INOSE,X,R)
      SWNOSE=DSWET(INOSE,X,R)
      VOLNOS=DVOL(INOSE,X,R)
      XCVNOS=DXCENV(INOSE,X,R)
      XCPNOS=DXCENP(INOSE,X,R)
      FRNOSE=LNOSE/DNOSE
      THEOLN=LNOSE
      THEOFN=FRNOSE
C
 1200 IF(LCENTR .LE. UNUSED)GO TO 1210
      NPTCEN=ICENTR
      IF(INOSE .GT. 1)NPTCEN=ICENTR-INOSE+1
      IF(NPTCEN .LE. 1)GO TO 1210
C
      SPCENT=DSPLAN(NPTCEN,X(INOSE),R(INOSE))
      SWCENT=DSWET(NPTCEN,X(INOSE),R(INOSE))
      VOLCEN=DVOL(NPTCEN,X(INOSE),R(INOSE))
      XCVCEN=DXCENV(NPTCEN,X(INOSE),R(INOSE))
      XCPCEN=DXCENP(NPTCEN,X(INOSE),R(INOSE))
      FRCENT=LCENTR/DCENTR
      THEOLC=LCENTR
      THEOFC=FRCENT
C
 1210 IF(LAFT .LE. UNUSED)GO TO 1220
      IFWD=ICENTR
      IF(IFWD .LE. 1)IFWD=INOSE
      NPTAFT=NNX-IFWD+1
      IF(IFWD .EQ. 0)NPTAFT=NNX
      IF(NPTAFT .LE. 1)GO TO 1220
C
      SPAFT=DSPLAN(NPTAFT,X(IFWD),R(IFWD))
      SWAFT=DSWET(NPTAFT,X(IFWD),R(IFWD))
      VOLAFT=DVOL(NPTAFT,X(IFWD),R(IFWD))
      XCVAFT=DXCENV(NPTAFT,X(IFWD),R(IFWD))
      XCPAFT=DXCENP(NPTAFT,X(IFWD),R(IFWD))
      IF(DAFT .GT. DCENTR)FRAFT=LAFT/DAFT
      THEOLA=LAFT
      IF(DAFT .LT. DCENTR)
     1 THEOLA=X(IFWD+NPTAFT-1)-R(IFWD+NPTAFT-1)*
     2 (X(IFWD)-X(IFWD+NPTAFT-1))/(R(IFWD)-R(IFWD+NPTAFT-1))
      IF(DAFT .LE. DCENTR)FRAFT=LAFT/DCENTR
      IF(DAFT .LT. DCENTR)THEOFA=THEOLA/DCENTR
C
 1220 CONTINUE
C
      DO 1230 I=1,NNX
         X(I)=X(I)+XO
 1230 CONTINUE
C
      DO 1240 I=1,20
         II=I
         IF(DISCON(I) .LE. UNUSED)GO TO 1250
 1240 CONTINUE
C
 1250 IF(II .GT. 1 .AND. DISCON(II-1) .NE. NX)DISCON(II)=NX
      IF(II .EQ. 1)DISCON(II)=NX
C
      DMAX=R(1)*2.
      DO 1260 I=2,NNX
         IF(R(I) .GT. R(I-1))DMAX=R(I)*2.
 1260 CONTINUE
C
      SMAX=PI*DMAX**2/4.
C
      DBASE=2.*R(NNX)
C
      SBASE=PI*DBASE**2/4.
C
      FR=LTOTAL/DMAX
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ALPEQ(DOB,ALPBOD,AR,PHI,IFIN,DELT,MACH,DAQVW,
     1 LODN,RN,XW,RW,TAPER,ISURF,A14,A24,A34,A44,L12,L24,AEQ,
     2 KW,KKW,CDC,BLUNT,SWEEP0,AREA,ALO,KSET,DFLAG)
C
C SUBROUTINE TO COMPUTE THE EQUIVALENT ANGLE OF ATTACK OF
C A FIN PANEL WHICH IS PART OF A PLANAR OR CRUCIFORM SET OF FINS
C FOR ANY ARBITRARY ATTITUDE/ROLL ORIENTATION
C
C  MODIFIED BY W. BLAKE, WL/FIGC
C
C METHOD SUMMARIZED IN AIAA JOURNAL OF SPACECRAFT AND ROCKETS
C                      VOL. 20, PP. 356-362, JULY-AUG 1983
C
C *** INPUTS ***
C
C    DOB - BODY DIAMETER TO FIN SPAN RATIO (FIN SPAN INCLUDES BODY)
C ALPBOD - BODY TOTAL ANGLE OF ATTACK, DEG.
C     AR - EXPOSED ASPECT RATIO OF TWO FIN PANELS (SIDE-TO-SIDE AT ROOT)
C    PHI - FIN ROLL ANGLE
C   IFIN - FIN NUMBER BEING EVALUATED
C   DELT - DEFLECTION ANGLE FOR FINS 1 TO 4
C   MACH - FREESTREAM MACH NUMBER
C  DAQVW - DELTA ALPHA EQUIV DUE TO VORTICES
C   LODN - OGIVE NOSE FINENESS RATIO
C     RN - BODY RADIUS AT NOSE/CENTERBODY JUNCTURE
C     XW - DISTANCE FROM NOSE APEX TO FIN EXPOSED ROOT L.E.
C     RW - BODY RADIUS AT FIN
C  TAPER - FIN EXPOSED TAPER RATIO
C  ISURF - TYPE OF SURFACES: 1=PLANAR, 2=CRUCIFORM
C    ANN - PANEL DEFLECTION INFLUENCE COEFFICIENTS
C     KW - WING DUE TO BODY CARRY OVER INTERFERENCE FACTOR (ALPHA)
C    CDC - CROSS FLOW DRAG COEFFICIENT
C  BLUNT - BODY NOSE TIP RADIUS TO BODY RADIUS (BLUNTNESS RATIO)
C SWEEP0 - L.E. SWEEP ANGLE OF PANEL, DEGREES
C   AREA - SINGLE FIN PANEL PLANFORM AREA
C   KSET - INDEX OF FIN SET BEING EVALUATED
C  DFLAG - INDEX FOR ROTATION AXIS (0.=STATIC, 1.=PITCH,
C                                   2.=YAW,    3.=ROLL)
C
C *** OUTPUT ***
C
C    AEQ - EQUIVALENT ANGLE OF ATTACK, DEG.
C
C *** OTHER TERMS USED ***
C
C   KPHI - FIN-BODY INTERFERENCE FACTOR DUE TO BANK ANGLE
C DALPEQ - EQUIVALENT ANGLE OF ATTACK DUE TO BODY VORTICES, DEG.
C
      REAL KW,KPHI,MACH,LODN,L12,L24,LREF,LATREF
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /REFQN/  REFQ(9)
      COMMON /PAERO/  AKBW(4),AKWB(4),AKKBW(4),AKKWB(4),XCPBW(4),
     1                XCPWB(4),TEMP(4000)
C
      DIMENSION DELT(4), IIN(4), DELX(4)
      EQUIVALENCE (IIN(1),IIM1), (IIN(2),II), (IIN(3),IIP1),
     1            (IIN(4),IIP2)
C
      DIMENSION TDB(11),TKPHIC(11),TKPHIP(11)
      DATA TDB/0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA TKPHIC/0.382,0.447,0.490,0.508,0.502,0.471,0.417,0.342,
     1           0.244,0.127,0.000/
      DATA TKPHIP/0.637,0.687,0.681,0.649,0.597,0.529,0.447,0.352,
     1            0.246,0.128,0./
C
C***  PANEL CORRECTION FACTOR FOR SLENDER BODY THEORY CARRYOVER
C
      IF(DOB .NE. 0.)TANS=(TAN(SWEEP0/RAD)*RW*(1./DOB-1.))**2/(2.*AREA)
      IF(DOB .EQ. 0.)TANS=TAN(SWEEP0/RAD)
C      
C*** RETRIEVE GEOMETRY PARAMETERS FROM APPROPRIATE COMMON BLOCK
C
      LREF=REFQ(2)
      LATREF=REFQ(3)
      DO 500 I=1,4
         DELX(I)=XCPWB(I)*LREF
  500 CONTINUE
C
C***  CONVERT INPUT ANGLES TO RADIANS AND IDENTIFY ADJACENT PANELS
C
      IIN(1)=IFIN-1
      DO 1000 I=2,4
         IIN(I)=IIN(I-1)+1
 1000 CONTINUE
      DO 1010 I=1,4
        IF(IIN(I) .LE. 0) IIN(I)=IIN(I)+4
        IF(IIN(I) .GT. 4) IIN(I)=IIN(I)-4
 1010 CONTINUE
      DELI=(DELT(II)-DELT(IIP2))/2.0
      DELO=(DELT(IIM1)-DELT(IIP1))/2.0
      IF(ISURF .NE. 2) DELO=0.0
      ALPR=ALPBOD/RAD
C
C***  PANEL DIHEDRAL
C
      PHIR=PHI/RAD
      CALL DIHED(PHI,GAMMA)
C
C***  COMPUTE NOSE APEX HALF-ANGLE
C
      ROGIVE=LODN**2+.25
      CTHETA=SQRT(1.-LODN**2/ROGIVE**2)
      THETA=ACOS(CTHETA)*RAD
      BO2=RW/DOB
C
C***  COMPUTE THE FRACTION OF LIFT GENERATED BY BODY VORTICES, THIS IS
C***  DELTA-ALPHA-EQUIVALENT DUE TO VORTICES  (DALPEQ)
C
      IF(ALPBOD.LT.0.) GAMMA=-GAMMA
      CALL CLVR(MACH,CDC,BLUNT,RN,THETA,XW,RW,AR,BO2,TAPER,GAMMA,
     1   ABS(ALPBOD),DAQ)
      IF(ALPBOD.LT.0.) DAQ=-DAQ
      IF(PHI .LT. 0. .OR. PHI .GE. 180.)DAQ=-DAQ
      DAQ=DAQ+DAQVW/RAD
C
C***  SPLINE SLENDER BODY COEFFICIENT TABLES AND INTERPOLATE AT D/B
C
      IF(ISURF.EQ.2)CALL SPLINE(TDB,TKPHIC,11,2,2,0.,0.,DOB,1,KPHI,DUM)
      IF(ISURF.NE.2)CALL SPLINE(TDB,TKPHIP,11,2,2,0.,0.,DOB,1,KPHI,DUM)
C
C***   CALCULATE ALPHA EQUIVALENT FOR THE UNDEFLECTED PANEL
C
C  REV 3/99 MODIFIED TO GIVE CORRECT RESULT FOR AOA>90 OR AOA<-90
C  ABS(COS(ALPR)) ADDED
C
      TAEQ0=(KW*SIN(ALPR)*SIN(PHIR)-TANS*KPHI*((SIN(ALPR))**2)*
     1 SIN(PHIR)*COS(PHIR))/ABS(COS(ALPR)) + TAN(DAQ)
C
C  REV 1/96 UPDATE  -  DYNAMIC DERIVATIVES
C*** CALCULATE ALPHA EQUIVALENT FOR DYNAMIC DERIVATIVES 
C
      IF(DFLAG.GE.1.) THEN
         RATE=2.*0.02
C
C*** PITCH ROTATION
C
         IF(DFLAG.EQ.1.) THEN
         DXX=DELX(KSET)/LREF
         TAEQ0=(KW*(SIN(PHIR)*SIN(ALPR)+SIN(PHIR)*RATE*DXX)
     1     -TANS*KPHI*((SIN(ALPR))**2+RATE**2*DXX**2)
     2     *SIN(PHIR)*COS(PHIR))/ABS(COS(ALPR)) + TAN(DAQ)
C
C*** YAW ROTATION
C
         ELSEIF(DFLAG.EQ.2.) THEN
         DXX=DELX(KSET)/LATREF
         TAEQ0=(KW*(SIN(PHIR)*SIN(ALPR)-COS(PHIR)*RATE*DXX)
     1     -TANS*KPHI*((SIN(ALPR))**2+RATE**2*DXX**2)
     2     *SIN(PHIR)*COS(PHIR))/ABS(COS(ALPR)) + TAN(DAQ)
C
C*** ROLL ROTATION
C
         ELSEIF(DFLAG.EQ.3.) THEN
         CALL YCP(AR,TAPER,MACH,0.126,YCB)
         YC=YCB*(BO2-RW)+RW
         TAEQR=RATE*YC/LATREF
         TAEQ0=(KW*SIN(ALPR)*SIN(PHIR)-TANS*KPHI*((SIN(ALPR))**2)*
     1   SIN(PHIR)*COS(PHIR))/ABS(COS(ALPR)) + TAN(DAQ) + TAEQR
         ENDIF
      ENDIF
C
      AEQ0=ATAN(TAEQ0)*RAD
C 
      TOL=0.05
      IF(ABS(ABS(ALPBOD)-90.).LE.TOL.AND.ABS(PHI-180.).LE.TOL) AEQ0=0.
C
C***   PANEL DEFLECTION AND ADJACENT PANEL INTERFERENCE CORRECTION
C
C  REV 3/99 L12 AND L24 INCLUDED IN ADJACENT FIN DEFLECTION TERMS
C
      AEQD=L12*A14*DELT(IIM1)+L24*A24*DELT(IIP2)+L12*A34*DELT(IIP1)
     1   +A44*DELT(II)
C
C***   FINAL EQUIVALENT ANGLE OF ATTACK
C
      AEQ=AEQ0+AEQD
C
C***  CORRECT AEQ ZERO LIFT ANGLE OF ATTACK FOR SUBSONIC MACH #'S
C     AND FIN POSTION AROUND THE BODY, REVERSING THE SENSE OF ALO
C     FOR PHI'S IN THE 3RD AND 4TH QUADRANTS
C
      IF (MACH .GT. 0.8) GO TO 1030
      IF (PHI .LT. 0.0  .OR.  PHI .GT. 180.0) GO TO 1020
       AEQ=AEQ-ALO
      GO TO 1030
C
 1020 CONTINUE
       AEQ=AEQ+ALO
C
 1030 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BETAU(CR,R,C,SM,TAPR,ISURF,B)
C
C***  DETERMINE THE REGION OF INFLUENCE OF A PANEL IN PROXIMITY
C***  TO ANOTHER.  METHOD FROM REPORT ONR-CR215-226-4F, APPENDIX D.
C
C***  INPUTS
C
C    CR - ROOT CHORD
C     R - BODY RADIUS AT FIN
C     C - A CONSTANT (PI/2-1)
C    SM - EXPOSED PANEL SPAN
C  TAPR - EXPOSED PANEL TAPER RATIO
C ISURF - TYPE OF SURFACES (1=PLANAR, 2=CRUCIFORM)
C
C***  OUTPUT
C
C     B - TERM BETA-U (USED TO CALCULATE M-U, SEE PAGE 202)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      B = CR/(PI*R)
      IF(ISURF .LE. 1) GO TO 1010
C
      B = (CR/(2.0*R))/(1.0+SQRT((SM/R-1.0)**2+C*C))
      IF(TAPR .GE. 0.50) GO TO 1010
        G = B
        DO 1000 I=1,25
          B = (B+G)/2.0
          G = 1.0-(B*R*(SM/R-1.0)/(CR*(1.0-TAPR)))**2
          F = (1.0+SQRT(1.0-(1.0-C*C)*G))/G
          G = CR/(2.0*F*R)
          IF(ABS(B-G) .LT. 1.E-6) GO TO 1010
 1000   CONTINUE
 1010 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CNPTWO(ALPI,CNI,CNIXCP)
C***********************************************************************
C
C     THIS SUBROUTINE CALCULATES INLET NORMAL FORCE COEFFICIENT AND
C     CENTER OF PRESSURE FOR A TWO DIMENSIONAL INLET IN THE INLET
C     COORDINATE SYSTEM.  THIS SUBROUTINE CALCULATES AERODYNAMICS FOR
C     ONE SET OF FLIGHT CONDITIONS.
C
C***********************************************************************
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      DIMENSION DCNA(4),DCN(4),DCM(4),CNA(5)
      DIMENSION ALPI(20),CNI(20),CMI(20),CNIXCP(20)
C
      NUMI=NIN+0.5
      DO 10 J=1,NUMI
        DO 20 I=1,5
C
C***      IF INLET IS OPEN CALCULATE CN-ALPHA ON RAMP
          IF ((.NOT.ICOVER).AND.(I.EQ.2)) THEN
            A=XI(I)*TAN(RAMANG/RAD)
            B=WI(I)
          ELSE
            A=HI(I)
            B=WI(I)
          ENDIF
C
C***      CALCULATE CN-ALPHA AT CROSS SECTION
          IF (A*B.EQ.0.0) THEN
            CNA(I)=0.0
          ELSE
            CNA(I)=(PI/1.8*B/A+2./PI)*A*B/SREF
          ENDIF
   20   CONTINUE
C
C***    FIND FORCES AND MOMENTS FOR EACH SECTION
        CNI(J)=0.0
        CMI(J)=0.0
        DO 30 I=1,4
C
C***      CN-ALPHA OF SECTION
          DCNA(I)=CNA(I+1)-CNA(I)
C
C***      DON'T INCLUDE BOATTAIL SECTION IN CN-ALPHA CALCULATIONS
          IF (DCNA(I).LT.0.0) DCNA(I)=0.0
C
C***      CN OF SECTION
          DCN(I)=DCNA(I)*(ALPI(J)/RAD)
C
C***      INCREMENT INLET CN
          CNI(J)=CNI(J)+DCN(I)
C
C***      CALCULATE SECTION CENTER OF PRESSURE
          XCP=XI(I)+1./3.*LENGTH(I)*(2.*WI(I+1)+WI(I))/(WI(I+1)+WI(I))
C
C***      SECTION CM
          DCM(I)=-DCN(I)*XCP/LREF
C
C***      INCREMENT INLET CM
          CMI(J)=CMI(J)+DCM(I)
   30   CONTINUE
C
C***    CALCULATE INLET CENTER OF PRESSURE
        IF (ABS(CNI(J)).LT.0.00001) THEN
          CNIXCP(J)=0.0
        ELSE
          CNIXCP(J)=ABS(CMI(J)*LREF/CNI(J))
        ENDIF
   10 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE DECODE(NACA,NA,X,LLL,IUM)
C
C****  READ USER INPUT NACA DESIGNATION AND DECODE
C
      LOGICAL IEQL,IPOINT
      CHARACTER*4 LET,NUM,A4H1,A4H4,A4H5,A4H6,A4HS
      CHARACTER*4 NACA
      DIMENSION X(50),IUM(10)
      DIMENSION NACA(80),LET(6),IVAL(10),NUM(10)
      DATA LET / '    ', 'A   ', '-   ', '=   ', '.   ', ',   '/
      DATA NUM / '1   ', '2   ', '3   ', '4   ', '5   ',
     1           '6   ', '7   ', '8   ', '9   ', '0   '/
      DATA IVAL/1,2,3,4,5,6,7,8,9,0/
      DATA A4H1,A4H4,A4H5,A4H6,A4HS/'1   ','4   ','5   ','6   ','S   '/
C
      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
      IUM(L)=IVAL(10)
 1000 CONTINUE
      IF(NA.EQ.6) GO TO 1030
      IF(NA.EQ.7)GO TO 1060
C
C ... DECODE NACA 1,4 AND 5 SERIES
C
      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 CONTINUE
      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 CONTINUE
      GO TO 1120
C
C ... DECODE NACA 6 SERIES
C
 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 CONTINUE
      GO TO 1120
C
C ... DECODE SUPERSONIC SERIES
C
 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 CONTINUE
C
 1120 CONTINUE
C
C  GET X-COORDINATES WHERE AIRFOIL COORDINATES ARE TO BE CALCULATED
C    X SPACING IS CLOSEST IN THE NEIGHBORHOOD OF THE L.E.
C
      DELX=0.00100
      X(1)=0.0
      DO 1130 LI=2,50
      LLL=LI
      X(LI)=X(LI-1)+DELX
      IF(X(LI) .GE. .0059) DELX=.002
      IF(X(LI) .GT. .009) DELX=.010
      IF(X(LI) .GT. .059) DELX=.020
      IF(X(LI) .GT. .419) DELX=.030
      IF(X(LI) .GT. .449) DELX=.050
      IF(X(LI) .GT. .799) DELX=.020
      IF(X(LI) .GE. 1.00) GO TO 1140
 1130 CONTINUE
 1140 CONTINUE
      X(LLL)=1.0
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCAWS(MACH,KSHARP,TOCEFF,SPLAN,SREF,SWEP00,CAW)
C
C***  SUPERSONIC FIN WAVE DRAG INCREMENT TO AXIAL FORCE
C***  METHOD FROM DATCOM, SECTION 4.1.5.1
C
C***  INPUTS
C
C   MACH -- MACH NUMBER
C KSHARP -- FIN SHAPE FACTOR
C TOCEFF -- EFFECTIVE THICKNESS TO CHORD RATIO
C  SPLAN -- PLANFORM AREA FOR ONE PANEL
C   SREF -- REFERENCE AREA
C SWEP00 -- LEADING EDGE SWEEP ANGLE OF PANEL, DEG.
C
C***  OUTPUT
C
C    CAW -- WAVE DRAG INCREMENT TO AXIAL FORCE
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL MACH,KSHARP
C
      IF(MACH .LE. 1.)CAW=0.
      IF(MACH .LE. 1.)GO TO 1000
C
      BETA=SQRT(MACH**2-1.)
C
C***  SUPERSONIC LEADING EDGE
C
      CAW=KSHARP/BETA*TOCEFF**2*SPLAN/SREF
      IF(SWEP00 .EQ. 0.)GO TO 1000
C
C***  SUBSONIC LEADING EDGE
C
      IF(ABS(BETA/TAN(SWEP00/RAD)) .LT. 1.) CAW=KSHARP/
     1   ABS(TAN(SWEP00/RAD))*TOCEFF**2*SPLAN/SREF
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FOIL(IFIN,SECTYP,YMGC,SSPAN,LMAXU,LFLATU,THICKU,
     1   LER,RHO,LNACA,NACA)
C
C***  ROUTINE TO COMPUTE THE AIRFOIL SECTION DESIGNATION OF A USER INPUT
C***  SECTION
C
C***  INPUTS
C
C    IFIN -- FIN SET NUMBER
C  SECTYP -- SECTION TYPE
C            (0=HEX, 1=NACA, 2=ARC, 3=USER)
C    YMGC -- SPAN STATION OF MEAN GEOMETRIC CHORD
C   SSPAN -- ARRAY OF SEMI-SPAN STATIONS
C   LMAXU -- ARRAY OF DISTANCES FROM L.E. TO MAX. THICKNESS, FRAC. C
C  LFLATU -- ARRAY OF LENGTH OF CONSTANT THICKNESS, FRAC. C
C  THICKU -- ARRAY OF THICKNESS, FRAC. C
C
C***  OUTPUTS
C
C     LER -- ARRAY OF L.E. RADII FOR PANEL
C     RHO -- INTERPOLATE L.E. RADIUS AT M.G.C.
C   LNACA -- .TRUE. IF NACA CARD HAS BEEN GENERATED
C    NACA -- NACA DESIGNATION COMPUTED AT Y-M.G.C.
C
C***  NOTE - AIRFOIL IS ASSUMED TO BE SYMMETRIC ABOUT CHORD LINE
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      CHARACTER*4 ICARD,NACA,IDUMMY
C
      REAL LER,LMAXU,LFLATU
      LOGICAL LNACA
C
      DIMENSION SSPAN(10),LMAXU(10),LFLATU(10),THICKU(10),LER(10)
      DIMENSION NACA(80),ICARD(80),IDUMMY(4),IROUT(2)
C
      DATA ICARD / 'N   ','A   ','C   ','A   ','-   ','1   ',
     1             '-   ','S   ','-   ','1   ','-   ','5   ',
     2             '0   ','.   ','0   ','-   ','1   ','0   ',
     3             '.   ','0   ','-   ','0   ','0   ','.   ',
     4             '0   ',55*'    ' /
C
C***  SKIP IF USER DEFINED COORDINATES OR NACA EXISTS
C
      IF(SECTYP .EQ. 1. OR. SECTYP .EQ. 3.)GO TO 1050
C
      DO 1000 I=1,4
         IF(NACA(I) .NE. ICARD(I))GO TO 1010
 1000 CONTINUE
      GO TO 1050
C
 1010 CONTINUE
C
C***  GEOMETRY IS HEXAGONAL OR CIRCULAR ARC
C
C ... FIND NUMBER OF SPAN STATIONS INPUT
C
      NSTA=0
      DO 1020 I=1,10
         IF(SSPAN(I) .EQ. UNUSED)GO TO 1030
         NSTA=NSTA+1
 1020 CONTINUE
C
 1030 CONTINUE
C
C ... FILL NACA ARRAY WITH PRESET NACA CARD
C
      DO 1040 I=1,80
         NACA(I)=ICARD(I)
 1040 CONTINUE
C
C ... INTERPOLATE AT Y-M.G.C. FOR AIRFOIL SHAPE
C
      CALL LNTRP(SSPAN,LMAXU,NSTA,YMGC,UPMAX)
      CALL LNTRP(SSPAN,LFLATU,NSTA,YMGC,UPFLAT)
      CALL LNTRP(SSPAN,THICKU,NSTA,YMGC,UPTHK)
      CALL LNTRP(SSPAN,LER,NSTA,YMGC,RHO)
C
      IF(UPFLAT .LE. UNUSED)UPFLAT=0.
C
C ... CONVERT VALUES IN PERCENT TO HOLLERITH AND INSERT IN NACA
C
      CALL TOHOLL(100.*UPMAX,1,4,NACA(12))
      CALL TOHOLL(100.*UPFLAT,1,4,NACA(22))
      CALL TOHOLL(200.*UPTHK,1,4,NACA(17))
C
C ... NOW FIN NUMBER AND SECTION SHAPE
C
      IF(SECTYP .EQ. 0. .AND. UPFLAT .EQ. 0.)SECT=1.
      IF(SECTYP .EQ. 0. .AND. UPFLAT .NE. 0.)SECT=3.
      IF(SECTYP .EQ. 2.)SECT=2.
      CALL TOHOLL(SECT,1,4,IDUMMY)
      NACA(10)=IDUMMY(2)
      CALL TOHOLL(FLOAT(IFIN),1,4,IDUMMY)
      NACA(6)=IDUMMY(2)
C
C ... NACA ARRAY CONTAINS NACA CARD AT M.G.C.
C
      LNACA=.TRUE.
C
 1050 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ILTCDC(CANGLE,XMACH,FR,CDCCYL)
C
C     THIS SUBROUTINE DETERMINES THE CROSSFLOW DRAG COEFFICIENT
C     ON AN INFINITE CIRCULAR CYLINDER AS A FUNCTION OF THE
C     CROSSFLOW MACH NUMBER.  THE DRAG COEFFICIENT IS THEN
C     CORRECTED FOR THE EFFECT OF A FINITE LENGTH BODY.
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
C                  *********************
C                  * INPUT/OUTPUT LIST *
C                  *********************
C
C
C     ***** INPUTS *****          ***** OUTPUTS *****
C
C           XMACH                        CDCCYL
C           CANGLE
C
C
C     SUBROUTINES USED: NONE
C
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      PARAMETER (NVAL = 8)
C
      REAL MC(NVAL), CDC(NVAL)
C
C     DATA STATEMENTS FOR CROSSFLOW DRAG VS. MACH
      DATA MC  /0.2,  0.4,  0.6,  0.8,  1.0,  1.2,  1.4,  1.6/
      DATA CDC /1.20, 1.25, 1.43, 1.49, 1.36, 1.26, 1.22, 1.20/
C
C     DATA STATEMENT FOR ETA CURVE FIT
      DATA C0, C1, C2, C3 /0.5182, 2.22742E-2, -6.8227E-4,
     1                     7.52648E-6/
C
C     COMPUTE THE CROSSFLOW MACH NUMBER
      CMACH = XMACH * ABS(SIN(CANGLE))
C
C     COMPUTE THE CROSSFLOW DRAG COEFFICIENT FOR AN INFINITE CYLINDER
      IF (CMACH .LE. 0.2 .OR. CMACH .GE. 1.6) THEN
C
C        CONSTANT VALUE OUTSIDE OF DRAG RISE
         CDCINF = 1.2
C
      ELSE
C
C        INTERPOLATE FOR VALUE ON DRAG RISE
         DO 100 I = 2, NVAL
            IF (CMACH .GE. MC(I-1) .AND. CMACH .LE. MC(I)) THEN
               TEMP1 = CMACH  - MC(I-1)
               TEMP2 = MC(I)  - MC(I-1)
               TEMP3 = CDC(I) - CDC(I-1)
               CDCINF = CDC(I-1) + TEMP1 / TEMP2 * TEMP3
               GOTO 110
            END IF
  100    CONTINUE
  110    CONTINUE
C
      END IF
C
C     COMPUTE CORRECTION FOR FINENESS RATIO
      ETA = C0 + C1 * FR + C2 * FR**2 + C3 * FR**3
C
C     APPLY LINEAR TRANSONIC FARING FOR ETA
      IF (XMACH .GT. 0.9 .AND. XMACH .LT. 1.2) THEN
         ETA = ETA + (1.0 - ETA) * (XMACH - 0.9) / (1.2 - 0.9)
      ELSE IF (XMACH .GE. 1.2) THEN
         ETA = 1.0
      END IF
C
C     CORRECT CROSS FLOW DRAG COEFFICIENT FOR FINITE LENGTH BODY
      CDCCYL = CDCINF * ETA
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE MATCHX(J,RN,B,DELM,XL,PST,PL,X,P,XST)
C
C  COMPUTE THE X MATCHING POINT FOR A SPHERICAL NOSE CAP
C
C  INPUTS
C      J -- INTEGER STATION NUMBER (1=NOSE)
C     RN -- NOSE RADIUS
C      B -- NOSE BLUNTNESS FACTOR
C   DELM -- MAXIMUM DEFLECTION ANGLE TO SUPPORT A SHOCK (RADIANS)
C     XL -- X POSITION ON FIRST FRUSTRUM
C    PST -- STATIC PRESSURE
C     PL -- LOCAL PRESSURE
C      X -- X STATION
C      P -- PRESSURE
C
C  OUTPUT
C
C    XST -- X STATION FOR MATCHING
C
C  SUBROUTINES CALLED -- NONE
C
C  MATCH POINT ON SPHERICAL CAP
C
      IF(J.EQ.1)XST=-RN/B*(1.-SQRT(1.-1./(1.-TAN(DELM)**2/B)))
C
C  MATCH POINT ON BODY FRUSTRUMS
C
      IF(J.NE.1)XST=XL+(PST-PL)*(X-XL)/(P-PL)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PRINTS(IM)
C
C***  SUBROUTINE TO PRINT THE AERODYNAMIC DATA FROM THE IOM
C***  (STATIC DATA)
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
C
C  EFFECTIVE FULL FIN DEFLECTIONS
C
      COMMON /FFINDL/DSYN1(8),DSYN2(8),DSYN3(8),DSYN4(8),CLD(4)
C
      REAL NALPHA,NMACH,MACH
C
      COMMON /THERY/  LSOSE,PRESUR,LHYBRD,LHYPER
      LOGICAL LSOSE,PRESUR,LHYBRD,LHYPER
      COMMON /SBODY/ CN(20),CM(20),CA(20),CY(20),CLN(20),CLL(20),
     1               CNA(20),CMA(20),CYB(20),CNB(20),CLB(20)
C
      DIMENSION CBOD(220)
      EQUIVALENCE (CBOD(1),CN(1))
C
      COMMON /FSET1/ F1IN(399)
      COMMON /FSET2/ F2IN(399)
      COMMON /FSET3/ F3IN(399)
      COMMON /FSET4/ F4IN(399)
      COMMON /SFIN1/ CFIN1(220)
      COMMON /SFIN2/ CFIN2(220)
      COMMON /SFIN3/ CFIN3(220)
      COMMON /SFIN4/ CFIN4(220)
      COMMON /SB1/   CB1(220)
      COMMON /SB12/  CB12(220)
      COMMON /SB123/ CB123(220)
      COMMON /SB1234/CB1234(220)
      COMMON /INCID/ DELTA1(8),DELTA2(8),DELTA3(8),DELTA4(8),XHINGE(4),
     1               SKEW(4)
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      LOGICAL LBODY,LPANEL,LSYN1,LSYN2,LSYN3,LSYN4
C
      DATA IF1,IF2,IF3,IF4 / 1, 2, 3, 4 /
      DATA IC1,IC2,IC3,IC4,IC5,IC6,IC7,IC8,IC9 /1,2,3,4,5,6,7,8,9/
C
      NFIN1=F1IN(112)+.5
      NFIN2=F2IN(112)+.5
      NFIN3=F3IN(112)+.5
      NFIN4=F4IN(112)+.5
      DO 1000 I=1,8
         IF(ABS(DELTA1(I)) .LE. UNUSED)DELTA1(I)=0.
         IF(ABS(DELTA2(I)) .LE. UNUSED)DELTA2(I)=0.
         IF(ABS(DELTA3(I)) .LE. UNUSED)DELTA3(I)=0.
         IF(ABS(DELTA4(I)) .LE. UNUSED)DELTA4(I)=0.
C
         IF(ABS(DSYN1(I)) .LE. UNUSED)DSYN1(I)=0.
         IF(ABS(DSYN2(I)) .LE. UNUSED)DSYN2(I)=0.
         IF(ABS(DSYN3(I)) .LE. UNUSED)DSYN3(I)=0.
         IF(ABS(DSYN4(I)) .LE. UNUSED)DSYN4(I)=0.
 1000 CONTINUE
      LSYN1=.FALSE.
      LSYN2=.FALSE.
      LSYN3=.FALSE.
      LSYN4=.FALSE.
C
C  CHECK STATUS OF EFFECTIVE FULL FIN DEFLECTIONS
C
      DO 5 K=1,8
        IF(DSYN1(K).NE.DELTA1(K) .AND. ABS(DELTA1(K)).GT.UNUSED)
     1        LSYN1=.TRUE.
        IF(DSYN2(K).NE.DELTA2(K) .AND. ABS(DELTA2(K)).GT.UNUSED)
     2        LSYN2=.TRUE.
        IF(DSYN3(K).NE.DELTA3(K) .AND. ABS(DELTA3(K)).GT.UNUSED)
     3        LSYN3=.TRUE.
        IF(DSYN4(K).NE.DELTA4(K) .AND. ABS(DELTA4(K)).GT.UNUSED)
     4        LSYN4=.TRUE.
 5     CONTINUE
      IF(.NOT.LSYN1 .OR. .NOT.LSYN2 .OR. .NOT.LSYN3 .OR. .NOT.LSYN4)
     1 LPANEL=.TRUE.
C
C***  DETERMINE LAST CONFIGURATION TO OUTPUT
C
      LBODY=LAXIS .OR. LELLB .OR. LARBOD
      IF(LBODY)ILAST=1
      IF(LFIN1)ILAST=2
      IF(LFIN2)ILAST=3
      IF(LFIN3)ILAST=4
      IF(LFIN4)ILAST=5
      IF(LBODY.AND.LFIN1)ILAST=6
      IF(LBODY.AND.LFIN1.AND.LFIN2)ILAST=7
      IF(LBODY.AND.LFIN1.AND.LFIN2.AND.LFIN3)ILAST=8
      IF(LBODY.AND.LFIN1.AND.LFIN2.AND.LFIN3.AND.LFIN4)ILAST=9
C
C***  DETERMINE IF BUILD CASE
C
      IF(LBUILD)GO TO 1010
      IF(ILAST .LT. 1 .OR. ILAST .GT. 9)GO TO 1100
C
C***  NOT BUILD, JUMP TO LAST CONFIGURATION OUTPUTS
C
      GO TO(1010,1020,1030,1040,1050,1060,1070,1080,1090),ILAST
C
 1010 IF(.NOT. LBODY)GO TO 1020
C
C***  BODY ALONE
C
      CALL PRIIOM(IC1,IM,CBOD(1),CBOD(21),CBOD(41),CBOD(61),
     1 CBOD(81),CBOD(101),CBOD(121),CBOD(141),CBOD(161),
     2 CBOD(181),CBOD(201))
C
      IF(MACH(IM).GT.1.2 .AND. .NOT. LHYBRD .AND. .NOT. LHYPER)
     1 WRITE(6,1200)
      IF(MACH(IM).GT.1.2 .AND. LHYBRD .AND. .NOT. LHYPER)WRITE(6,1210)
      IF(MACH(IM).GT.1.2 .AND. LHYPER)WRITE(6,1220)
      IF(LINLET)WRITE(6,1290)
      IF(LEXPR)WRITE(6,1300)
C
 1020 IF(.NOT.LFIN1)GO TO 1030
C
C***  FIN 1 ALONE
C
      CALL PRIIOM(IC2,IM,CFIN1(1),CFIN1(21),CFIN1(41),CFIN1(61),
     1 CFIN1(81),CFIN1(101),CFIN1(121),CFIN1(141),CFIN1(161),
     2 CFIN1(181),CFIN1(201))
C
 1030 IF(.NOT. LFIN2)GO TO 1040
C
C***  FIN 2 ALONE
C
      CALL PRIIOM(IC3,IM,CFIN2(1),CFIN2(21),CFIN2(41),CFIN2(61),
     1 CFIN2(81),CFIN2(101),CFIN2(121),CFIN2(141),CFIN2(161),
     2 CFIN2(181),CFIN2(201))
C
 1040 IF(.NOT. LFIN3)GO TO 1050
C
C***  FIN 3 ALONE
C
      CALL PRIIOM(IC4,IM,CFIN3(1),CFIN3(21),CFIN3(41),CFIN3(61),
     1 CFIN3(81),CFIN3(101),CFIN3(121),CFIN3(141),CFIN3(161),
     2 CFIN3(181),CFIN3(201))
C
 1050 IF(.NOT. LFIN4)GO TO 1060
C
C***  FIN 4 ALONE
C
      CALL PRIIOM(IC5,IM,CFIN4(1),CFIN4(21),CFIN4(41),CFIN4(61),
     1 CFIN4(81),CFIN4(101),CFIN4(121),CFIN4(141),CFIN4(161),
     2 CFIN4(181),CFIN4(201))
C
 1060 IF(.NOT. (LBODY.AND.LFIN1))GO TO 1070
C
C***  BODY-FIN 1
C
      CALL PRIIOM(IC6,IM,CB1(1),CB1(21),CB1(41),CB1(61),
     1 CB1(81),CB1(101),CB1(121),CB1(141),CB1(161),
     2 CB1(181),CB1(201))
C
      IF(.NOT.LSYN1) WRITE(6,1230)
      IF(.NOT.LSYN1) WRITE(6,1240)
      IF(.NOT.LSYN1) WRITE(6,1260) IF1,(DELTA1(IN),IN=1,NFIN1)
C
      IF(LSYN1) WRITE(6,1330)
      IF(LSYN1) WRITE(6,1240)
      IF(LSYN1) WRITE(6,1260) IF1,(DELTA1(IN),IN=1,NFIN1)
C
      IF(LSYN1)WRITE(6,1430)
      IF(LSYN1)WRITE(6,1240)
      IF(LSYN1) WRITE(6,1260) IF1,(DSYN1(IN),IN=1,NFIN1)
C
      IF(MACH(IM).GT.1.2 .AND. .NOT. LHYBRD .AND. .NOT. LHYPER)
     1 WRITE(6,1200)
      IF(MACH(IM).GT.1.2 .AND. LHYBRD .AND. .NOT. LHYPER)WRITE(6,1210)
      IF(MACH(IM).GT.1.2 .AND. LHYPER)WRITE(6,1220)
      IF(LINLET)WRITE(6,1290)
      IF(LEXPR)WRITE(6,1300)
C
 1070 IF(.NOT. (LBODY.AND.LFIN1.AND.LFIN2))GO TO 1080
C
C *** BODY-FIN1-FIN2
C
      CALL PRIIOM(IC7,IM,CB12(1),CB12(21),CB12(41),CB12(61),
     1 CB12(81),CB12(101),CB12(121),CB12(141),CB12(161),
     2 CB12(181),CB12(201))
C
      IF(.NOT.LSYN1 .OR. .NOT.LSYN2) WRITE(6,1230)
      IF(.NOT.LSYN1 .OR. .NOT.LSYN2) WRITE(6,1240)
      IF(.NOT.LSYN1) WRITE(6,1260) IF1,(DELTA1(IN),IN=1,NFIN1)
      IF(.NOT.LSYN2) WRITE(6,1260) IF2,(DELTA2(IN),IN=1,NFIN2)
C
      IF(LSYN1 .OR. LSYN2)WRITE(6,1330)
      IF(LSYN1 .OR. LSYN2)WRITE(6,1240)
      IF(LSYN1) WRITE(6,1260) IF1,(DELTA1(IN),IN=1,NFIN1)
      IF(LSYN2) WRITE(6,1260) IF2,(DELTA2(IN),IN=1,NFIN2)
C
      IF(LSYN1 .OR. LSYN2)WRITE(6,1430)
      IF(LSYN1 .OR. LSYN2)WRITE(6,1240)
      IF(LSYN1) WRITE(6,1260) IF1,(DSYN1(IN),IN=1,NFIN1)
      IF(LSYN2) WRITE(6,1260) IF2,(DSYN2(IN),IN=1,NFIN2)
C
      IF(MACH(IM).GT.1.2 .AND. .NOT. LHYBRD .AND. .NOT. LHYPER)
     1 WRITE(6,1200)
      IF(MACH(IM).GT.1.2 .AND. LHYBRD .AND. .NOT. LHYPER)WRITE(6,1210)
      IF(MACH(IM).GT.1.2 .AND. LHYPER)WRITE(6,1220)
      IF(LINLET)WRITE(6,1290)
      IF(LEXPR)WRITE(6,1300)
C
 1080 IF(.NOT. (LBODY.AND.LFIN1.AND.LFIN2.AND.LFIN3))GO TO 1090
C
C***  BODY-FIN 1-FIN 2-FIN 3
C
      CALL PRIIOM(IC8,IM,CB123(1),CB123(21),CB123(41),CB123(61),
     1 CB123(81),CB123(101),CB123(121),CB123(141),CB123(161),
     2 CB123(181),CB123(201))
C
      IF(.NOT.LSYN1 .OR. .NOT.LSYN2 .OR. .NOT.LSYN3) WRITE(6,1230)
      IF(.NOT.LSYN1 .OR. .NOT.LSYN2 .OR. .NOT.LSYN3) WRITE(6,1240)
      IF(.NOT.LSYN1) WRITE(6,1260) IF1,(DELTA1(IN),IN=1,NFIN1)
      IF(.NOT.LSYN2) WRITE(6,1260) IF2,(DELTA2(IN),IN=1,NFIN2)
      IF(.NOT.LSYN3) WRITE(6,1260) IF3,(DELTA3(IN),IN=1,NFIN3)
C
      IF(LSYN1 .OR. LSYN2 .OR. LSYN3)WRITE(6,1330)
      IF(LSYN1 .OR. LSYN2 .OR. LSYN3)WRITE(6,1240)
      IF(LSYN1) WRITE(6,1260) IF1,(DELTA1(IN),IN=1,NFIN1)
      IF(LSYN2) WRITE(6,1260) IF2,(DELTA2(IN),IN=1,NFIN2)
      IF(LSYN3) WRITE(6,1260) IF3,(DELTA3(IN),IN=1,NFIN3)
C
      IF(LSYN1 .OR. LSYN2 .OR. LSYN3)WRITE(6,1430)
      IF(LSYN1 .OR. LSYN2 .OR. LSYN3)WRITE(6,1240)
      IF(LSYN1) WRITE(6,1260) IF1,(DSYN1(IN),IN=1,NFIN1)
      IF(LSYN2) WRITE(6,1260) IF2,(DSYN2(IN),IN=1,NFIN2)
      IF(LSYN3) WRITE(6,1260) IF3,(DSYN3(IN),IN=1,NFIN3)
C
      IF(MACH(IM).GT.1.2 .AND. .NOT. LHYBRD .AND. .NOT. LHYPER)
     1 WRITE(6,1200)
      IF(MACH(IM).GT.1.2 .AND. LHYBRD .AND. .NOT. LHYPER)WRITE(6,1210)
      IF(MACH(IM).GT.1.2 .AND. LHYPER)WRITE(6,1220)
      IF(LINLET)WRITE(6,1290)
      IF(LEXPR)WRITE(6,1300)
C
 1090 IF(.NOT. (LBODY.AND.LFIN1.AND.LFIN2.AND.LFIN3.AND.LFIN4))
     1   GO TO 1100
C
C***  BODY-FIN 1-FIN 2-FIN 3-FIN 4
C
      CALL PRIIOM(IC9,IM,CB1234(1),CB1234(21),CB1234(41),CB1234(61),
     1 CB1234(81),CB1234(101),CB1234(121),CB1234(141),CB1234(161),
     2 CB1234(181),CB1234(201))
C
      IF(.NOT.LSYN1 .OR. .NOT.LSYN2 .OR. .NOT.LSYN3 .OR.
     1   .NOT.LSYN4) WRITE(6,1230)
      IF(.NOT.LSYN1 .OR. .NOT.LSYN2 .OR. .NOT.LSYN3 .OR.
     1   .NOT.LSYN4) WRITE(6,1240)
      IF(.NOT.LSYN1) WRITE(6,1260) IF1,(DELTA1(IN),IN=1,NFIN1)
      IF(.NOT.LSYN2) WRITE(6,1260) IF2,(DELTA2(IN),IN=1,NFIN2)
      IF(.NOT.LSYN3) WRITE(6,1260) IF3,(DELTA3(IN),IN=1,NFIN3)
      IF(.NOT.LSYN4) WRITE(6,1260) IF4,(DELTA4(IN),IN=1,NFIN4)
C
      IF(LSYN1 .OR. LSYN2 .OR. LSYN3 .OR. LSYN4)WRITE(6,1330)
      IF(LSYN1 .OR. LSYN2 .OR. LSYN3 .OR. LSYN4)WRITE(6,1240)
      IF(LSYN1) WRITE(6,1260) IF1,(DELTA1(IN),IN=1,NFIN1)
      IF(LSYN2) WRITE(6,1260) IF2,(DELTA2(IN),IN=1,NFIN2)
      IF(LSYN3) WRITE(6,1260) IF3,(DELTA3(IN),IN=1,NFIN3)
      IF(LSYN4) WRITE(6,1260) IF4,(DELTA4(IN),IN=1,NFIN4)
C
      IF(LSYN1 .OR. LSYN2 .OR. LSYN3 .OR. LSYN4)WRITE(6,1430)
      IF(LSYN1 .OR. LSYN2 .OR. LSYN3 .OR. LSYN4)WRITE(6,1240)
      IF(LSYN1) WRITE(6,1260) IF1,(DSYN1(IN),IN=1,NFIN1)
      IF(LSYN2) WRITE(6,1260) IF2,(DSYN2(IN),IN=1,NFIN2)
      IF(LSYN3) WRITE(6,1260) IF3,(DSYN3(IN),IN=1,NFIN3)
      IF(LSYN4) WRITE(6,1260) IF4,(DSYN4(IN),IN=1,NFIN4)
C
      IF(MACH(IM).GT.1.2 .AND. .NOT. LHYBRD .AND. .NOT. LHYPER)
     1 WRITE(6,1200)
      IF(MACH(IM).GT.1.2 .AND. LHYBRD .AND. .NOT. LHYPER)WRITE(6,1210)
      IF(MACH(IM).GT.1.2 .AND. LHYPER)WRITE(6,1220)
      IF(LINLET)WRITE(6,1290)
      IF(LEXPR)WRITE(6,1300)
C
 1100 CONTINUE
C
 1200 FORMAT(/,4X,'BODY ALONE LINEAR DATA GENERATED FROM ',
     1          'SECOND ORDER SHOCK EXPANSION METHOD',/)
 1210 FORMAT(/,4X,'BODY ALONE LINEAR DATA GENERATED FROM ',
     1          'VAN DYKE HYBRID THEORY',/)
 1220 FORMAT(/,4X,'BODY ALONE LINEAR DATA GENERATED FROM ',
     1          'MODIFIED NEWTONIAN FLOW THEORY',/)
 1230 FORMAT(/,4X,'PANEL DEFLECTION ANGLES (DEGREES)')
 1240 FORMAT(4X,'SET',4X,'FIN 1',3X,'FIN 2',3X,'FIN 3',3X,'FIN 4',
     1       3X,'FIN 5',3X,'FIN 6',3X,'FIN 7',3X,'FIN 8')
 1250 FORMAT(4X,'FIN 5',6X,'FIN 6',6X,'FIN 7',6X,'FIN 8')
 1260 FORMAT(5X,I2,8F8.2)
 1270 FORMAT(5X,F7.2,4X,F7.2,4X,F7.2,4X,F7.2)
 1330 FORMAT(/,4X,'FLAP DEFLECTION ANGLES (DEGREES)')
 1430 FORMAT(4X,'EQUIVALENT PANEL DEFLECTION ANGLES (DEGREES)')
 1290 FORMAT(4X,'AERODYNAMICS INCLUDE THE EFFECT OF AN AIRBREATHING ',
     1          'INLET')
 1300 FORMAT(4X,'THIS OUTPUT MAY INCLUDE THE EFFECT OF ',
     1          'EXPERIMENTAL DATA INPUTS')
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SPIN83(LN,BL,LAFT,D,FM,VCG,OR,SREF,LREF)
C
C***  SUBROUTINE TO COMPUTE DERIVATIVES FOR SPIN STABILIZED BODIES
C
C  MODIFIED BY F. SAWYER, WL/FIGC
C
C***  REFERENCE: ARDC SPINNER CODE
C
C***  NOTE:  CNP/SIN(ALPHA)=CNP1+CNP3*(SIN(ALPHA)**2)+CNP5*
C            (SIN(ALPHA)**4)
C
C***  CAUTION:  USE OF THIS POLYNOMIAL MUCH BEYOND THE  FIRST POSITIVE
C     EXTREMUM USUALLY BECOMES UNPHYSICAL - CNP FOR MOST PROJECTILES
C     IS EXPECTED TO REMAIN POSITIVE AT LARGER ALPHA.
C
C***  INPUT PARAMETERS
C       LN    - THE NOSE LENGTH (FT)
C       D     - BODY CYLINDER DIAMETER (FT)
C       BL    - TOTAL BODY LENGTH (FT)
C       LAFT  - BOATTAIL LENGTH (FT)
C       FM    - FREE STREAM MACH NUMBER
C       VCG   - DISTANCE FROM THE BODY VERTEX TO THE CENTER OF
C               GRAVITY (FT)
C       OR    - OGIVE FRUSTRUM RADIUS (CAL)
C       SREF  - USER DEFINED REFERENCE AREA (FT)
C       LREF  - USER DEFINED REFERENCE LENGTH (FT)
C
C***  OUTPUT VARIABLES
C       CLLP  - ROLLING MOMENT DUE TO ROLL RATE (ROLL DAMPING) (PER RAD)
C       CYP   - SIDE FORCE DUE TO ROLL RATE (PER RADIAN)
C       CNP1  - ZERO YAW MAGNUS COEFFFICIENT DERIVATIVE PER SIN ALPHA
C       CNP3  - CUBIC MAGNUS MOMENT COEFFICIENT PER (SIN ALPHA)**3
C       CNP5  - QUINTIC MAGNUS MOMENT COEFFICIENT PER (SIN ALPHA)**5
C       CNPY5 - 5 DEGREE SECANT SLOPE OF MAGNUS MOMENT COEFFICENT
C               DERIVATIVE (AT FIVE DEGREE YAW) PER SIN ALPHA
C
C***  CALLING ROUTINES
C       BDAMP
C
      COMMON /DBODY/ DUM(360),CLLP,CYP,CNP1,CNP3,CNP5,CNPY5,DUM1(40)
      REAL LAFT,LREF,LN
      DIMENSION CMACH(17)
      DIMENSION XE1(17),XE2(17),XE3(17),XE4(17)
      DIMENSION XE5(17),XG1(17)
      DIMENSION XG2(17),XG3(17),XG4(17),XG5(17),XG6(17)
      DIMENSION CYPA(17),CNPA1(17),CNPA3(17),CNPA5(17),CLP(17),
     1          CNPAA5(17),IROUT(2)
C
      DATA CMACH / 0.01,0.6,0.8,0.9,0.95,1.0,1.05,1.1,1.2,1.35,1.5,1.75,
     1   1          2.0,2.5,3.0,4.0,5.0 /
      DATA XE1 /-.16,-.16,-.16,-.18,-.23,-.21,-.19,-.18,-.16,-.16,-.16,
     1          -.16,-.16,-.16,-.16,-.16,-.16/
      DATA XE2 /1.8 ,1.8 ,2.0 ,2.4 ,2.7 ,2.8 ,2.9 ,
     1          2.95,2.98,3.00,3.01,3.02,3.03,3.04,3.05,3.05,3.05/
      DATA XE3 /2.5 ,2.5 ,2.6 ,2.75,2.9 ,3.0 ,3.06,
     1          3.07,3.08,3.08,3.08,3.09,3.09,3.09,3.09,3.09,3.09/
      DATA XE4 /2.9,2.9,3.0,3.05,3.1,3.1,3.1,
     1          3.1,3.1,3.1,3.10,3.1,3.1,3.1,3.1,3.1,3.1/
      DATA XE5 /0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.1,0.2,
     1          0.3,0.3,0.27,0.25,0.20/
      DATA XG1/-.0328,-.0327,-.0311,-.0295,-.02885,-.0277,-.0272,-.0267,
     1   -.0264,-.0254,-.0244,-.0238,-.0232,-.0225,-.0219,-.0216,-.0213/
      DATA XG2/-.0063,-.0063,-.0063,-.0063,-.00638,-.00594,-.00593,
     1  -.00593,-.00591,-.00557,-.00522,-.00455,-.00404,-.00404,-.00404,
     2  -.00404,-.00404/
      DATA XG3/.01229,.01229,.01229,.01229,.01229,.01097,.01039,.01039,
     1 .01036,.00968,.00898,.00814,.00717,.00688,.00688,.00688,.00688/
      DATA XG4/-.004,-.004,-.004,-.004,-.004,-.004,-.004,-.004,-.004,
     1   -.004,-.004,-.004,-.004,-.004,-.004,-.004,-.004/
      DATA XG5/-.2335,-.2335,-.2335,-.2132,-.2030,-.2130,-.2112,-.2112,
     1  -.1927,-.1722,-.1527,-.1131,-.0827,-.0827,-.0827,-.0827,-.0827/
      DATA XG6/.01556,.01556,.01556,.01418,.01349,.01279,.01298,.01298,
     1  .01131,.00918,.00705,.00352,.00305,.002,.001,0.0,0.0/
C
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     INITIALIZE DERIVATIVES TO ZERO
C
      CLLP=0.
      CYP=0.
      CNP1=0.
      CPN3=0.
      CPN5=0.
      CNPY5=0.
C
C***  SETUP CONSTANTS
C
      VCG=VCG/D
      VN=LN/D
      VL=BL/D
      VB=LAFT/D
      IF(VL .LT. 2.5) VL=2.5
      IF(VL .GT. 10.) VL=10.
      IF(VN .LT. 1.2) VN=1.2
      IF(VN .GT. 5.5) VN=5.5
      IF(VB .GT. 2.0) VB=2.0
      BD=1.
      AR=D*D*0.7854
      CVL=VL
      CXCL=VL-VN-VB-1.5
      CVN=VN-2.5
      CVB=VB
C
C***  SET UP TABLES OF CYPA, CNPA1, CNPA3, CNPA5, CNPAA5, CLP
C
      DO 1040 J=1,17
C
C***  COMPUTE CYPA
C
        CYP=XE1(J)*CVL
        CYPA(J)=CYP-0.1*CVB
C
C***  COMPUTE CPF AND CNPA AT A=1.0
C
        DCPF=0.0
        IF(VL .LE. 6.0) GO TO 1020
          DCPF=(VL-6.0)*XE5(J)
 1020   CONTINUE
        CNPAN=-CYP*(XE2(J)+0.55*CXCL+0.8*CVN)+1.0*CVL/4.7*CVB
        CPF=-CNPAN/CYPA(J)
        CPF=CPF+DCPF
        CNPA=(VCG-CPF )*CYPA(J)
C
C***  COMPUTE CPF AND CNPA AT A=2.0
C
        CNPAN=-CYP*(XE3(J)+0.55*CXCL+0.8*CVN)+1.0*CVL/4.7*CVB
        CPFA2=-CNPAN/CYPA(J)
        CPFA2=CPFA2+DCPF
        CNPAA2=(VCG-CPFA2)*CYPA(J)
C
C***  COMPUTE CPF AND CNPA AT A=5.0
C
        CNPAN=-CYP*(XE4(J)+0.55*CXCL+0.8*CVN)+1.0*CVL/4.7*CVB
        CPFA5=-CNPAN/CYPA(J)
        CPFA5=CPFA5+DCPF
        CNPAA5(J)=(VCG-CPFA5)*CYPA(J)
C
C***  COMPUTE CLP
C
        VLCLP=VL-3.49
        VNCLP=VN-1.71
        IF(VN .LT. 1.1) VNCLP=-.61
        IF(VN .GT. 3.5) VNCLP=1.79
        VBCLP=VB
        IF(VB .GT. 0.7) VBCLP=0.7
        VOR=VN*VN/OR-0.5
        VORCLP=VOR
        VBDCLP=BD-1.04
        CLP(J)=XG1(J)+XG2(J)*VLCLP+XG3(J)*VNCLP+XG4(J)*VBCLP+XG5(J)*
     1  VBDCLP+XG6(J)*VORCLP
        XMAG1=CNPAA5(J)-CNPA
        CNPA5(J)=2.1502E4*(CNPAA5(J)-7.9834*CNPAA2+6.9835*CNPA)
        CNPA3(J)=137.15*XMAG1-CNPA5(J)*7.9009E-3
        CNPA1(J)=CNPA-3.046E-4*CNPA3(J)-9.2773E-8*CNPA5(J)
 1040 CONTINUE
C
C***  USE THE VARIABLE TABLES GENERATED TO DO LINEAR INTERPOLATION
C     AT THE MACH NUMBER UNDER CONSIDERATION
C
      CALL LNTRP (CMACH,CLP,17,FM,CLLP)
      CALL LNTRP (CMACH,CYPA,17,FM,CYP)
      CALL LNTRP (CMACH,CNPA1,17,FM,CNP1)
      CALL LNTRP (CMACH,CNPA3,17,FM,CNP3)
      CALL LNTRP (CMACH,CNPA5,17,FM,CNP5)
      CALL LNTRP (CMACH,CNPAA5,17,FM,CNPY5)
C
C***  CHANGE REFERENCE QUANTITIES TO RATE*(LREF/V)
C
      CLLP=CLLP*.5*(AR*D*D)/(SREF*LREF*LREF)
      CYP=CYP*.5*(AR*D)/(SREF*LREF)
C
C***  POLYNOMIAL FIT TO SECANT SLOPE OF SIDE MOMENT SPIN DERIVATIVE
C     FOLLOWING CODE NOT PRESENTLY USED
C     CNP/SIN(ALPHA)=CNP1+CNP3*(SIN(ALPHA))**2+CNP5*(SIN(ALPHA))**4
C
      CNP1=CNP1*.5*(AR*D*D)/(SREF*LREF*LREF)
      CNP3=CNP3*.5*(AR*D*D)/(SREF*LREF*LREF)
      CNP5=CNP5*.5*(AR*D*D)/(SREF*LREF*LREF)
      CNPY5=CNPY5*.5*(AR*D*D)/(SREF*LREF*LREF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE VANDYK(IPRINT,BETA,RN,DIA,RP,R,N,NSHAPE,N2,NN1,NN2,
     1  NN3,NN4,NFL,NBLUNT,NN,NNI,VOVS,AL,XM,XINT,RR,IERROR,
     2  RREF,CAW,CNW,CMW)
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  ORIGINAL ROUTINE WRITTEN BY F. MOORE, NSWC
C  MODIFIED BY J. JENKINS, WL/FIGC
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /VDARY/ XB(220),RB(220),RBP(220),C(220),C1(220),RB1(220),
     1  RBP1(220),B(220),PSI(220),ZE0X(220),PSIR(220),PHIX(220)
      COMMON /VANVAR/PHIR(220),ZE1(220),ZE1X(220),ZE1R(220),
     1              T(100),AK(100),AE(100),C3
      DIMENSION RP(6),R(50)
      DIMENSION CPV(220,7)
      DIMENSION THET(7)
      DIMENSION ZE0PX(220)
      EQUIVALENCE (ZE0PX(1),ZE0X(1))
C
C     THIS ROUTINE COMPUTES THE SECOND ORDER AXIAL AND FIRST
C       ORDER CROSS FLOW PERTURBATION VELOCITY COMPONENTS. THESE
C        COMPONENTS ARE THEN COMBINED TO YIELD A HYBRID SOLUTION.
C
      IKK=1
      IK=1
      THET(1)=0.
      DO 1000 IJ=2,7
         THET(IJ)=THET(IJ-1)+30./RAD
 1000 CONTINUE
      TA=RP(1)
      TA2=TA**2
C
C ... J.A.S. EQUATION 23B
C
      BETATA=BETA*TA
      IF(BETATA.GE.1.) BETATA=0.9999
      C(1)=TA2/(SQRT(1.-BETA**2*TA2)+TA2*ARSECH(BETATA))
C
C
C........  EXACT SECOND ORDER SOLUTION FOR TANGENT CONE
C
      TAU=BETA*TA
      IF(TAU.GE.1.) TAU=0.9999
      TAU2=TAU*TAU
      F1=ARSECH(TAU)
      F2=SQRT(1.-TAU2)
C
C........  J.A.S. EQUATION 20B
C
      AN=1.2*VOVS**2/BETA**2
C
C........  CALCULATE BRACKETED TERMS ON R.H.S. OF J.A.S. EQUATION
C........  24B & 24C
C
      B1=F1**2-(AN-1.)*F1/F2-(AN+1.)-.75*BETA**2*C(1)*F2/TAU2
      B2=-2.*F2*F1/TAU+(AN+1.)/TAU+(AN-1.)*TAU*F1/F2+.25*BETA**2
     1 *C(1)*(2.+TAU2)*F2/TAU**3
C
C........  SOLVE FOR CONSTANT IN CHI0 FROM J.A.S. EQUATIONS
C........  24B, 24C, & 18C
C
      C1(1)=C(1)*(1.+(C(1)*VOVS)**2*B1)-BETA*(C(1)*VOVS)**2*C(1)
     1 *B2/RBP(1)
C
C........  CALCULATE PHIX AND PHIR FROM J.A.S. EQUATIONS 24B & 24C
C
      PHIX(1)=-C1(1)*F1+(C(1)*VOVS)**2*B1
      PHIR(1)=C1(1)*F2/RBP(1)+BETA*(C(1)*VOVS)**2*B2
C
C     FIRST ORDER AXIAL FLOW
C
      DO 1080 I=2,NN
      CALL DELV(1,I,BETA,XXI,TAU,F1,F2,PSIX,PSIR,C,SUM1,SUM2,
     1   SUM3,SUM4,SUM5,SUM6,NN1,NN2,NN3,IKK,JL,TTX,TTR,TEMP)
      IF(I .LE. JL) GO TO 1080
      D=ABS(RBP(JL+1)-RBP(JL))
      IF(D.GE.0.0001) GO TO 1070
      C(JL+1)=C(JL)
      IKK=IKK+1
      IF(NSHAPE .EQ. 3)IKK=IKK+1
      GO TO 1080
C
C ... J.A.S. EQUATION 27B
C
 1070 XI=XB(JL-1)-BETA*RB(JL-1)
      TAU=BETA*RB(JL)/(XB(JL)-XI)
      IF(TAU.GE.1.) TAU=0.9999
      F1=ARSECH(TAU)
      C(JL+1)=(RBP(JL+1)-RBP(JL))*(1.+TEMP-F1*C(1))/(RBP(JL+1)+BETA)
      IKK=IKK+1
      IF(NSHAPE .EQ. 3)IKK=IKK+1
 1080 CONTINUE
C
C     I=2 IS 2ND POINT ON SURFACE
C
      DO 1250 I=2,NN
      CALL SUMPOT(1,BETA,I,C,ZE0,ZE0X,ZE0R,ZE0XX,ZE0XR,ZE0RR,
     1   NN1,NN2,NN3)
      PHIX(I)=ZE0X(I)
      PHIR(I)=ZE0R
      IF(NSHAPE.LT.4)GO TO 1120
      IF(NSHAPE.NE.4) GO TO 1110
      IF(R(N2+1).GT.R(N2).AND.I.GT.NN1)GO TO 1120
      IF(R(N2+1).NE.R(N2).AND.I.GT.NN1)GO TO 1240
      IF(I.GT.NN2.AND.R(N).LT.R(N2+1))GO TO 1240
      GO TO 1120
 1110 IF(I.GT.NN3) GO TO 1240
 1120 CONTINUE
C
C   SECOND ORDER AXIAL SOLUTION.
C     A. PARTICULAR SOLUTION
C
C ... J.A.S. EQUATION 20A
C
      PSI(I)=VOVS**2*(ZE0X(I)*(ZE0+AN*RB(I)*ZE0R)-0.25*RB(I)
     1*ZE0R**3)
C
C ... J.A.S. EQUATION 20C
C
      PSIX=VOVS**2*((ZE0 +AN*RB(I)*ZE0R)*ZE0XX + ZE0X(I)*(
     1ZE0X(I)+AN*RB(I)*ZE0XR)-0.75*RB(I)*ZE0R**2*ZE0XR)
C
C ... J.A.S. EQUATION 20D
C
      PSIR(I)=VOVS**2*((ZE0+AN*RB(I)*ZE0R)*ZE0XR+ZE0X(I)*((AN
     1+1.)*ZE0R+AN*RB(I)*ZE0RR)-0.25*ZE0R**2*(ZE0R+3.*RB(I)
     2*ZE0RR))
C
C     B. COMPLIMENTARY SOLUTION
C
 1130 CONTINUE
      CALL DELV(2,I,BETA,XXI,TAU,F1,F2,PSIX,PSIR,C1,SUM1,SUM2,
     1   SUM3,SUM4,SUM5,SUM6,NN1,NN2,NN3,IK,JL,TTX,TTR,TEMP)
      IF(I .LE. JL) GO TO 1210
      D=ABS(RBP(JL+1)-RBP(JL))
      IF(D.LE.0.0001) GO TO 1200
      D1=PSI(JL+1)-PSI(JL)
      C3=-D1
      TAU1=BETA*RB(JL+1)/(XB(JL+1)-XB(1)+BETA*RB(1))
      IF(TAU1.GE.1.) TAU1=0.9999
      TTX=-C1(1)*ARSECH(TAU1)
      TTR=C1(1)*BETA*SQRT(1.-TAU1**2)/TAU1
      IF(TAU.GE.1.) TAU=0.9999
      F1=ARSECH(TAU)
      F2=SQRT(1.-TAU**2)
      C1(JL+1)=(RBP(JL+1)*(1.+PSIX+TTX+SUM2)-TTR-SUM3-PSIR(JL+1)+
     1 3.*C3/(8.*RB(JL+1)))/BETA
      IK=IK+1
      IF(NSHAPE .EQ. 3)IK=IK+1
      GO TO 1210
 1200 C1(JL+1)=(RBP(I)*(1.+PSIX+TTX+SUM2)-TTR-SUM3-PSIR(I))/BETA
      IK=IK+1
      IF(NSHAPE .EQ. 3)IK=IK+1
 1210 CONTINUE
      CALL SUMPOT(2,BETA,I,C1,ZE0P,ZE0PX,ZE0PR,ZE0PXX,ZE0PXR,ZE0PRR,
     1   NN1,NN2,NN3)
C
C  TOTAL 2ND ORDER SOLN.=PARTICULAR PLUS COMPLIMENTARY.
C
      PHIX(I)=PSIX+ZE0PX(I)
      PHIR(I)=PSIR(I)+ZE0PR
 1240 CONTINUE
 1250 CONTINUE
 1260 CONTINUE
      J=1
C
C ... BOUNDARY LAYER DISPLACEMENT THICKNESS INCLUDED FOR CROSSFLOW SOL.
C
      PQ=(1.+.0092*VOVS**2)**0.88
      RND=RN*DIA
      XCRIT=500000./RND
      DELI=0.125*PQ*5.*SQRT(XCRIT/RND)
      DEL1=(5.*SQRT(XCRIT/RND))**1.25
      DEL2=0.
      DRBP=0.
      DO 1320 I=2,NN
      RB1(I)=RB(I)
      RBP1(I)=RBP(I)
 1320 CONTINUE
      RB1(1)=RB(1)
      RBP1(1)=RBP(1)
      TA=RBP1(1)
      TA2=TA**2
      B(1)=BETA*TA2
      BETATA=BETA*TA
      IF(BETATA.GE.1.) BETATA=0.9999
      DEN=(1.+2.*TA2)*SQRT(1.-(BETATA)**2)+(BETATA)**2*ARSECH(BETATA)
      B(1)=B(1)/DEN
      I=1
      TAU=BETA*TA
      IF(TAU.GE.1.) TAU=0.9999
      F1=ARSECH(TAU)
      F2=SQRT(1.-TAU**2)
      ZE1(1)=B(1)*(F2/TAU-TAU*F1)
      ZE1X(1)=2.*B(1)*F2/TAU
      ZE1R(1)=-B(1)*BETA*(F2/TAU**2+F1)
      DO 1330 IJ=1,7
C
C ... J.A.S. EQUATIONS 2B, 4 AND 5
C
      UB=COS(AL)*(1.+PHIX(I))+SIN(AL)*COS(THET(IJ))*ZE1X(I)
      VB=COS(AL)*PHIR(I)+SIN(AL)*COS(THET(IJ))*(1.+ZE1R(I))
      WB=-SIN(AL)*SIN(THET(IJ))*(1.+ZE1(I)/TA)
      QB=UB**2+VB**2+WB**2
      QQ=1.+0.2*VOVS**2*(1.-QB)
      IF(QQ .LT. 0. .AND. PARTS(18))WRITE(6,1540)
      IF(QQ .LT. 0.)IERROR=1
      IF(QQ .LT. 0.)GO TO 1490
      CPV(1,IJ)=2./(1.4*VOVS**2)*((1.+0.2*VOVS**2*(1.-QB))**3.5-1.)
 1330 CONTINUE
      IF(NN.NE.2)GO TO 1350
      DO 1340 IJ=1,7
      CPV(2,IJ)=CPV(1,IJ)
 1340 CONTINUE
      GO TO 1480
 1350 J5=NN
      DO 1470 I=2,J5
      SUM2=0.
      SUM3=0.
      J6=I-1
      DO 1390 J=1,J6
      IF(J.GT.1) GO TO 1360
      TAU=BETA*RB1(I)/(XB(I)-XB(1)+BETA*RB(1))
      IF(TAU.GE.1.) TAU=0.9999
      GO TO 1370
 1360 TAU=BETA*RB1(I)/(XB(I)-XB(J-1)+BETA*RB1(J-1))
      IF(TAU.GE.1.) TAU=0.9999
 1370 F1=ARSECH(TAU)
      F2=SQRT(1.-TAU**2)
      IF(J.EQ.1) GO TO 1380
      D=ABS(XB(J)-XB(J-1))
      IF(D.LT.0.000001) GO TO 1390
 1380 SUM2=SUM2+2.*B(J)*F2/TAU
      SUM3=SUM3-B(J)*BETA*(F2/(TAU**2)+F1)
 1390 CONTINUE
      TAU=BETA*RB1(I)/(XB(I)-XB(I-1)+BETA*RB1(I-1))
      IF(TAU.GE.1.) TAU=0.9999
      F1=ARSECH(TAU)
      F2=SQRT(1.-TAU*TAU)
      D=ABS(XB(I)-XB(I-1))
      IF(D.LT.0.000001) GO TO 1400
      B(I)=(1.+SUM3-RBP1(I)*SUM2)*TAU**2/BETA
      B(I)=B(I)/(F2*(1.+2.*RBP1(I)*TAU/BETA)+TAU**2*F1)
      GO TO 1410
 1400 B(I)=0.
 1410 SUM1=0.
      SUM2=0.
      SUM3=0.
      DO 1440 J=1,I
      IF(J.GT.1) GO TO 1420
      TAU=BETA*RB1(I)/(XB(I)-XB(1)+BETA*RB(1))
      IF(TAU.GE.1.) TAU=0.9999
      XXI=XB(I)-XB(1)+BETA*RB(1)
      GO TO 1430
 1420 XXI=XB(I)-XB(J-1)+BETA*RB1(J-1)
      TAU=BETA*RB1(I)/XXI
      IF(TAU.GE.1.) TAU=0.9999
 1430 F1=ARSECH(TAU)
      F2=SQRT(1.-TAU**2)
      SUM1=SUM1+B(J)*XXI*(F2/TAU-TAU*F1)
      SUM2=SUM2+2.*B(J)*F2/TAU
      SUM3=SUM3-B(J)*BETA*(F2/TAU**2+F1)
      IF(I.EQ.1) GO TO 1450
 1440 CONTINUE
 1450 ZE1(I)=SUM1
      ZE1X(I)=SUM2
      ZE1R(I)=SUM3
C
C  HYBRID THEORY
C
      DO 1460 IJ=1,7
C
C ... J.A.S. EQUATIONS 2B, 4 AND 5
C
      RREF = 0.5
      UB=COS(AL)*(1.+PHIX(I))+SIN(AL)*COS(THET(IJ))*ZE1X(I)
      VB=COS(AL)*PHIR(I)+SIN(AL)*COS(THET(IJ))*(1.+ZE1R(I))
      WB=-SIN(AL)*SIN(THET(IJ))*(1.+ZE1(I)/RB1(I))
      QB=UB**2+VB**2+WB**2
      QQ=1.+0.2*VOVS**2*(1.-QB)
      IF(QQ .LT. 0.)WRITE(6,1540)
      IF(QQ .LT. 0.)IERROR=1
      IF(QQ .LT. 0.)GO TO 1490
      CPV(I,IJ)=2./(1.4*VOVS**2)*((1.+0.2*VOVS**2*(1.-QB))**3.5-1.)
 1460 CONTINUE
 1470 CONTINUE
 1480 IF(NBLUNT .NE. 0) CALL NEWT(CPV,R,NN1,NFL,NNI,VOVS,AL,XM,
     1  XINT,RR,RREF,CABL,CNBL,CMBL)
C
C ... FINAL RESULTS
C
      CALL WAVE(CPV,NN1,NN2,NN3,NN4,NBLUNT,NN,NNI,RR,RREF,
     1 SUM1,SUM2,SUM3,CABL,CNBL,CMBL,CAW,CNW,CMW)
C
      IF(IPRINT .NE. 1)GO TO 1490
C
C  PRINT PRESSURE DISTRIBUTION ABOUT THE BODY
C
C     CALL HEADR9
      ALD=AL*RAD
C     WRITE(6,1510)VOVS,ALD
C     WRITE(6,1500)
      WRITE(10,1520)(XB(J),(CPV(J,K),K=1,7),J=1,J5)
C     WRITE(6,1530)
 1490 CONTINUE
C
C  PRINT BODY COORDINATES TO TAPE UNIT 9
C
C  FOLLOWING CARD REMOVED FOR TECPLOT FORMAT
C
C     IF(IPRINT.EQ.2) WRITE(9,1600)
      IF(IPRINT.EQ.2) WRITE(9,1610) (DIA*XB(J),DIA*RB(J),J=1,J5)
C
C1500 FORMAT(//,52X,21HPRESSURE COEFFICIENTS,//,7X,10H  X/DMAX  ,9X,
C    15HPHI=0,8X,6HPHI=30,8X,6HPHI=60,8X,6HPHI=90,8X,7HPHI=120,7X,
C    27HPHI=150,7X,7HPHI=180)
C1510 FORMAT(51X,26HBODY ALONE PRESSURE OUTPUT//
C    1 43X,6HMACH =,F5.2,2X,17HANGLE OF ATTACK =,F7.2,5H DEG.)
 1520 FORMAT(F14.6,7F10.5)
C1530 FORMAT(49H0 NOTE - PHI=  0 IS TOP VERTICAL CENTER (LEEWARD) /
C    1       53H         PHI=180 IS BOTTOM VERTICAL CENTER (WINDWARD) )
 1540 FORMAT('*** HYBRID ANALYSIS FAILING - CHANGING TO ',
     1 ' SECOND-ORDER SHOCK EXPANSION FOR BODY ALONE')
C
C  BODY COORDINATE COMMENT REMOVED FOR TECPLOT FORMAT
C
C1600 FORMAT(3X,39HVAN DYKE HYBRID THEORY BODY COORDINATES)
 1610 FORMAT(3X,2F14.6)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ANGDET(MACH,DELEFF)
C ***
C *** SUBROUTINE TO DETERMINE THE WEDGE TURN ANGLE
C *** (DELEFF) FOR WHICH THE SHOCK WILL BECOME DETACHED
C ***
C *** REFERENCE  NACA 1135, EQUATIONS 168 AND 138
C ***
C *** INPUT    MACH     MACH NUMBER
C ***
C *** OUTPUT   DELEFF   ANGLE FOR SHOCK DETACHMENT, RADIANS
C ***
C ***
      REAL MACH
      DATA GAM / 1.4 /
C ***
C *** COMPUTE THE SHOCK ANGLE AT DELTA-MAX, NACA TR 1135 EQN 168
C ***
      SIN2TM=((1.+GAM)*MACH**2-4.+SQRT((GAM+1.)*((GAM+1.)*MACH**4
     1 +8.*(GAM-1.)*MACH**2+16.)))/(4.*GAM*MACH**2)
      TDM=ASIN(SQRT(SIN2TM))
C ***
C *** USE THIS ANGLE IN EQN 138
C ***
      COTD=TAN(TDM)*(((GAM+1.)*MACH**2)/(2.*(MACH**2*(SIN(TDM))**2
     1 -1.))-1.)
      DELEFF=ATAN(1./COTD)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BLKLDD(IFLAGA)
C      
C***     THIS SUBROUTINE BLANKS OUT LATERAL DIRECTIONAL DERIVATIVES IF
C         EXPERIMENTAL INPUTS HAVE BEEN USED IN THE FOLLOWING MANNER:
C           IF CY  HAS BEEN INPUT CYB  IS SET TO -UNUSED
C           IF CSN HAS BEEN INPUT CLNB IS SET TO -UNUSED
C           IF CSL HAS BEEN INPUT CLLB IS SET TO -UNUSED
C        THIS IS DONE FOR EACH DERIVATIVE BEGINNING WITH THE MOST
C         SIMPLE CONFIGURATION THAT EXPERIMENTAL DATA IS INPUT FOR
C         THROUGH THE MOST COMPLEX CONFIGURATION BEING RUN
C           -EXAMPLE-
C             IF EXPERIMENTAL DATA IS INPUT FOR CY OF THE BF1
C             CONFIGURATION THEN IN THE SAME CASE FOR THE BF12
C             CONFIGURATION AND ANY OTHER MORE COMPLEX CONFIGURATIONS
C             CYB IS SET TO -UNUSED
C      
C***  INPUT
C      
C     IFLAGA = A 2 DIMENSIONAL ARRAY IN WHICH THE FIRST VALUE (I)
C              REPRESENTS THE COEFFICIENT BEING CHECKED AND THE SECOND
C              VALUE (J) REPRESENTS THE CONFIGURATION BEING CHECKED IF
C              THE ARRAY ELEMENT EQUALS 1 THERE HAS BEEN EXPERIMENTAL
C              INPUT FOR THAT COEFFICIENT AND THAT CONFIGURATION
C              I = 1 FOR CY      J = 1 FOR BF1
C              I = 2 FOR CSN     J = 2 FOR BF12
C              I = 3 FOR CSL     J = 3 FOR BF123
C                                J = 4 FOR BF1234
C        -EXAMPLE-
C           IFLAGA(3,2)=1  MEANS EXPERIMENTAL VALUES OF CSL HAVE BEEN
C                          INPUT FOR A BF12 CONFIGURATION
C      
      COMMON /SBODY / DUM1(160),BCYB(20), BCLNB(20), BCLLB(20)
      COMMON /SB1   / DUM2(160),CYB1(20), CLNB1(20), CLLB1(20)
      COMMON /SB12  / DUM3(160),CYB12(20),CLNB12(20),CLLB12(20)
      COMMON /SB123 / DUM4(160),CYB13(20),CLNB13(20),CLLB13(20)
      COMMON /SB1234/ DUM5(160),CYB14(20),CLNB14(20),CLLB14(20)
      COMMON /CONST / PI,RAD,UNUSED,KAND
      DIMENSION IFLAGA(3,4)
C      
C         DETERMINE WHICH CONFIGURATIONS HAVE INPUT FOR CY
C         AND SET CYB TO -UNUSED
C      
      IF( BCYB(1) .EQ. -UNUSED )IFLAGA(1,1)=1
      IF(IFLAGA(1,1) .NE. 1)GO TO 1010
      DO 1000 K1=1,20
         CYB1(K1) = -UNUSED
         CYB12(K1)= -UNUSED
         CYB13(K1)= -UNUSED
         CYB14(K1)= -UNUSED
 1000 CONTINUE
      GO TO 1070
 1010 IF( IFLAGA(1,2) .NE. 1)GO TO 1030
      DO 1020 K2=1,20
         CYB12(K2)= -UNUSED
         CYB13(K2)= -UNUSED
         CYB14(K2)= -UNUSED
 1020 CONTINUE
      GO TO 1070
 1030 IF( IFLAGA(1,3) .NE. 1)GO TO 1050
      DO 1040 K3=1,20
         CYB13(K3)= -UNUSED
         CYB14(K3)= -UNUSED
 1040 CONTINUE
      GO TO 1070
 1050 IF( IFLAGA(1,4) .NE. 1)GO TO 1070
      DO 1060 K4=1,20
         CYB14(K4)= -UNUSED
 1060 CONTINUE
C      
C         DETERMINE WHICH CONFIGURATIONS HAVE INPUT FOR CSN
C         AND SET CLNB TO -UNUSED
C      
 1070 IF( BCLNB(1) .EQ. -UNUSED)IFLAGA(2,1)=1
      IF(IFLAGA(2,1) .NE. 1)GO TO 1090
      DO 1080 L1=1,20
         CLNB1(L1) = -UNUSED
         CLNB12(L1)= -UNUSED
         CLNB13(L1)= -UNUSED
         CLNB14(L1)= -UNUSED
 1080 CONTINUE
      GO TO 1150
 1090 IF( IFLAGA(2,2) .NE. 1)GO TO 1110
      DO 1100 L2=1,20
         CLNB12(L2)= -UNUSED
         CLNB13(L2)= -UNUSED
         CLNB14(L2)= -UNUSED
 1100 CONTINUE
      GO TO 1150
 1110 IF( IFLAGA(2,3) .NE. 1)GO TO 1130
      DO 1120 L3=1,20
         CLNB13(L3) = -UNUSED
         CLNB14(L3) = -UNUSED
 1120 CONTINUE
      GO TO 1150
 1130 IF( IFLAGA(2,4) .NE. 1)GO TO 1150
      DO 1140 L4=1,20
         CLNB14(L4) = -UNUSED
 1140 CONTINUE
C      
C         DETERMINE WHICH CONFIGURATIONS HAVE INPUT FOR CSB
C         AND SET CLLB TO -UNUSED
C      
 1150 IF( BCLLB(1) .EQ. -UNUSED)IFLAGA(3,1)=1
      IF(IFLAGA(3,1) .NE. 1)GO TO 1170
      DO 1160 M1=1,20
         CLLB1(M1) = -UNUSED
         CLLB12(M1)= -UNUSED
         CLLB13(M1)= -UNUSED
         CLLB14(M1)= -UNUSED
 1160 CONTINUE
      GO TO 1230
 1170 IF( IFLAGA(3,2) .NE. 1)GO TO 1190
      DO 1180 M2=1,20
         CLLB12(M2)= -UNUSED
         CLLB13(M2)= -UNUSED
         CLLB14(M2)= -UNUSED
 1180 CONTINUE
      GO TO 1230
 1190 IF( IFLAGA(3,3) .NE. 1)GO TO 1210
      DO 1200 M3=1,20
         CLLB13(M3) = -UNUSED
         CLLB14(M3) = -UNUSED
 1200 CONTINUE
      GO TO 1230
 1210 IF( IFLAGA(3,4) .NE. 1)GO TO 1230
      DO 1220 M4=1,20
         CLLB14(M4) = -UNUSED
 1220 CONTINUE
 1230 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CNSBT(A,B,PHI,CNCNO)
C
C ** SLENDER BODY CORRECTION FACTOR FOR ELLIPTICAL BODY
C
C ** INPUTS
C
C       A -- MAJOR AXIS
C       B -- MINOR AXIS
C     PHI -- BODY ROLL ANGLE, DEGREES
C            PHI= 0 IF MAJOR AXIS PERPENDICULAR TO CROSS FLOW
C            PHI=90 IF MINOR AXIS PERPENDICULAR TO CROSS FLOW
C
C ** OUTPUT
C
C   CNCNO -- CORRECTION FACTOR FOR ELLIPTICAL SEGMENT
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      CNCNO=1.
      IF(A .EQ. 0. .OR. B .EQ. 0.)GO TO 1000
      IF(A .EQ. B)GO TO 1000
C
      CNCNO=(A/B)*COS(PHI/RAD)**2+(B/A)*SIN(PHI/RAD)**2
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      LOGICAL FUNCTION DELNMS(KOL,IFLAG,NA)
C
C***  FUNCTION TO CHECK FOR VALID NAMELIST NAMES TO BE DELETED
C***  FOR THE CASE USING CONTROL CARD DELETE.  FUNCTION RETURNS
C***  A VALUE OF TRUE IF DELETE CONTROL CARD IS READ.
C
C***  INPUTS
C
C    KOL -- CARD IMAGE (80 COLUMN)
C  IFLAG -- TYPE OF ACTION TO TAKE
C           .EQ. 0 MEANS TO CHECK NAMES ONLY
C           .NE. 0 MEANS TO SET FLAG
C     NA -- COUNT OF NUMBER OF ERRORS ENCOUNTERED
C
      COMMON /DFLAGS/ DFLT,DREF,DAXI,DFIN1,DFIN2,DFIN3,DFIN4,DDEFL,
     1 DTRIM,DELLB,DINLET,DARBOD
C
      DIMENSION KOL(80),IDEL(6),NLNMS(71),NLLENS(12)
C
      LOGICAL DFLT,DREF,DAXI,DFIN1,DFIN2,DFIN3,DFIN4,DDEFL,DTRIM,DELLB,
     1 DINLET,DARBOD
      LOGICAL NMTEST,DELFLG(12)
      CHARACTER*4 IDEL,NLNMS,IBLANK,ICOMMA,KOL
C
      EQUIVALENCE (DELFLG(1),DFLT)
C
      DATA IDEL / 'D   ','E   ','L   ','E   ','T   ','E   '/
      DATA NLNMS /
     1 'F   ','L   ','T   ','C   ','O   ','N   ',
     2 'R   ','E   ','F   ','Q   ',
     3 'A   ','X   ','I   ','B   ','O   ','D   ',
     4 'F   ','I   ','N   ','S   ','E   ','T   ','1   ',
     5 'F   ','I   ','N   ','S   ','E   ','T   ','2   ',
     6 'F   ','I   ','N   ','S   ','E   ','T   ','3   ',
     7 'F   ','I   ','N   ','S   ','E   ','T   ','4   ',
     8 'D   ','E   ','F   ','L   ','C   ','T   ',
     9 'T   ','R   ','I   ','M   ',
     A 'E   ','L   ','L   ','B   ','O   ','D   ',
     B 'I   ','N   ','L   ','E   ','T   ',
     C 'P   ','R   ','O   ','T   ','U   ','B   '/
      DATA NLLENS / 6,4,6,7,7,7,7,6,4,6,5,6/
C
      DATA IBLANK / '    '/
      DATA ICOMMA / ',   '/
C
      DELNMS=.FALSE.
C
C***  CHECK FOR DELETE CONTROL CARD
C
      DO 1000 I=1,6
         IF(KOL(I) .NE. IDEL(I))GO TO 1080
 1000 CONTINUE
C
      II=6
C
C***  CARD COLUMN LOOP (IMPLIED DO LOOP)
C
 1010 II=II+1
         IF(II .GT. 80)GO TO 1070
         IF(KOL(II) .EQ. IBLANK .OR. KOL(II) .EQ. ICOMMA)GO TO 1010
         INDEX=1
C
C***     NAME LOOP
C
 1020    CONTINUE
         DO 1030 INAME=1,12
C
C***        CHECK NAME
C
            IF(NMTEST(KOL(II),NLNMS(INDEX),NLLENS(INAME)))GO TO 1040
            INDEX=INDEX+NLLENS(INAME)
C
 1030    CONTINUE
C
C***     NAME NOT FOUND
C
      IF(IFLAG .EQ. 0)NA=NA+1
      GO TO 1050
C
 1040 CONTINUE
C
         IF(IFLAG .NE. 0)DELFLG(INAME)=.TRUE.
C
         II=II+NLLENS(INAME)-1
C
      GO TO 1050
C
C***     FIND NEXT CARD COLUMN WITH A BLANK OR A COMMA
C
 1050    II=II+1
            IF(II .GT. 80)GO TO 1070
            IF(KOL(II) .EQ. IBLANK .OR. KOL(II) .EQ. ICOMMA)GO TO 1060
         GO TO 1050
C
 1060    II=II-1
C
      GO TO 1010
C
 1070 CONTINUE
C
      DELNMS=.TRUE.
C
 1080 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCAWT(M,SEXP,TOC,AR,SWEP25,SREF,CAWT)
C
C***  COMPUTE FIN ALONE TRANSONIC WAVE DRAG INCREMENT
C***  METHOD FROM DATCOM, SECTION 4.1.5.1
C
C***  INPUTS
C
C      M -- MACH NUMBER
C   SEXP -- EXPOSED PANEL AREA
C    TOC -- THICKNESS RATIO T/C
C     AR -- EXPOSED PANEL ASPECT RATIO
C SWEP25 -- PANEL QUARTER CHORD SWEEP ANGLE, DEG.
C   SREF -- REFERENCE AREA
C
C***  OUTPUT
C
C   CAWT -- PRESSURE DRAG COEFFICIENT
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL M
C
      DIMENSION TQ(7),TPX(15),TXKP(105),IROUT(2)
C
C***  TABLE OF ASPECT*(T/C)**(1/3)
C
      DATA TQ/ 0.,.5,1.,1.5,2.,3.,4./
C
C***  TABLE OF BETA/((T/C)**(5/3))
C
      DATA TPX/-1.4,-1.2,-1.0,-.8,-.6,-.4,-.2,
     1          .0,.2,.4,.6,.8,1.0,1.2,1.4/
C
C***  TABLE OF VALUES CAWT/(T/C)**(5/3)
C
      DATA TXKP/
     1 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00,
     2 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00,
     3 0.00,  .10,  .20,  .40,  .55,  .70,  .80,  .90,
     4 1.00, 1.10, 1.15, 1.20, 1.25, 1.30, 1.35,
     5 0.00,  .20,  .50, 1.05, 1.70, 2.05, 2.20, 2.35,
     6 2.45, 2.55, 2.65, 2.70, 2.70, 2.70, 2.80,
     7 0.00,  .30, 1.00, 1.95, 2.70, 2.90, 3.00, 3.00,
     8 3.05, 3.10, 3.15, 3.15, 3.15, 3.15, 3.10,
     9 0.00,  .40, 1.30, 2.50, 3.10, 3.25, 3.30, 3.30,
     A 3.30, 3.30, 3.30, 3.30, 3.30, 3.30, 3.25,
     B 0.00,  .50, 1.60, 2.90, 3.40, 3.45, 3.48, 3.50,
     C 3.50, 3.50, 3.48, 3.45, 3.42, 3.40, 3.35,
     D 0.00,  .60, 1.80, 3.20, 3.55, 3.60, 3.60, 3.65,
     E 3.65, 3.65, 3.60, 3.60, 3.57, 3.55, 3.50  /
C
C***  SWEEP ANGLE CORRECTION TO DATCOM CHART
C
      CCO4=COS(SWEP25/RAD)
      XM=M*SQRT(CCO4)
      IF(XM.LT.1.0 .AND. XM.GT.0.99) XM=0.99
      IF(XM.GE.1.0 .AND. XM.LT.1.01) XM=1.01
C
C***  PX IS RESCALED X AXIS OF THE PLOT
C
      PX=SQRT(ABS(XM**2-1.))/TOC**(1./3.)
      PX=PX*(XM**2-1.)/ABS(XM**2-1.)
      Q=AR*TOC**(1./3.)
C
      CAWT=0.
      IF(PX.LT.-1.4)GO TO 1000
C
C***  LOOKUP WAVE DRAG INCREMENT FROM CHART
C
      CALL MVLOOK(1,7,15,105,1.,TQ,TPX,TXKP,PX,Q,1.,XKP)
      CAWT=XKP*TOC**(5./3.)*CCO4**2.5*SEXP/SREF
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FORINT(IUNIT, NAME, COMBLK, II)
C
C***  FORCE AN INTEGER PRINT ONTO UNIT IUNIT
C
C  IUNIT - OUTPUT UNIT NUMBER
C   NAME - ARRAY WHICH DEFINES THE NAMELIST VARIABLE NAME
C COMBLK - DATA FOR NAMELIST NAME
C     II - NUMBER OF ELEMENTS TO PRINT
C
      CHARACTER*4 NAME
      INTEGER COMBLK
C
      DIMENSION NAME(8),COMBLK(II)
C
      WRITE(IUNIT,1000)(NAME(I),I=1,8),(COMBLK(I),I=1,II)
C
      RETURN
C
 1000 FORMAT('0',8A1,8(I14,',')/(9X,8(I14,',')))
C
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ILTCFD(ALPHAR,BETAR,XMACH,CNVIS,CMVIS,CYVIS,CLNVIS)
C
C     THIS SUBROUTINE DETERMINES THE CROSSFLOW DRAG COEFFICIENT
C     FOR EACH AXIAL SECTION OF THE BODY AND THEN INCREMENTS THE
C     TOTAL VEHICLE FORCE AND MOMENT COEFFICIENTS ACCORDINGLY.
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C  MODIFIED BY K. BURNS, MCDONNELL DOUGLAS
C
C                  *********************
C                  * INPUT/OUTPUT LIST *
C                  *********************
C
C     ***** INPUTS *****          ***** OUTPUTS *****
C           ALPHAR                      CNVIS
C           BETAR                       CMVIS
C           XMACH                       CYVIS
C                                       CLNVIS
C
C     SUBROUTINES USED: ILTCDC
C                       AXINWT
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      CNVIS  = 0.0
      CMVIS  = 0.0
      CYVIS  = 0.0
      CLNVIS = 0.0
C
      NUMI=NIN+0.5
      DO 100 INLET = 1, NUMI
C
C       INITIALIZE SUMMING VARIABLES
        CNSUM  = 0.0
        CMSUM  = 0.0
        CYSUM  = 0.0
        CLNSUM = 0.0
C
C       BEGIN LOOP FOR BODY SECTIONS
        DO 110 ICRX = 1, 4
          ICRXP1 = ICRX + 1
C
C         DETERMINE CROSSFLOW DRAG COEFFICIENTS
          CALL ILTCDC(ALPHAR,XMACH,FRI,CDCA)
          CALL ILTCDC(BETAR,XMACH,FRI,CDCB)
C
C         COMPUTE THE AVERAGE WIDTH AND HEIGHT AND THE AVERAGE
C         NEWTONIAN CORRECTION FACTOR BETWEEN THE TWO BOUNDING
C         CROSS SECTIONS
          WIDAVE = (CRXIWD(ICRX,INLET) + CRXIWD(ICRXP1,INLET)) / 2.0
          HGTAVE = (CRXIHT(ICRX,INLET) + CRXIHT(ICRXP1,INLET)) / 2.0
C
C         CHECK FOR POSITIVE OR NEGATIVE ANGLE OF ATTACK
          IF(INTYPE .NE. 3.)THEN
            IF (ALPHAR .GE. 0.0) THEN
              CNZAVE = (CNNIZP(ICRX,INLET) + CNNIZP(ICRXP1,INLET)) / 2.0
            ELSE
              CNZAVE = (CNNIZN(ICRX,INLET) + CNNIZN(ICRXP1,INLET)) / 2.0
            END IF
C
C         CHECK FOR POSITIVE OR NEGATIVE SIDESLIP ANGLE
            IF (BETAR .GE. 0.0) THEN
              CNYAVE = (CNNIYP(ICRX,INLET) + CNNIYP(ICRXP1,INLET)) / 2.0
            ELSE
              CNYAVE = (CNNIYN(ICRX,INLET) + CNNIYN(ICRXP1,INLET)) / 2.0
            END IF
C
C         INCREMENT AERO COEFFICIENTS FOR 2-D INLETS
            TEMPA  = CDCA * WIDAVE * LENGTH(ICRX) * CNZAVE
            TEMPB  = CDCB * HGTAVE * LENGTH(ICRX) * CNYAVE
            CNSUM  = CNSUM  + TEMPA
            CMSUM  = CMSUM - TEMPA * XMIDI(ICRX)
            CYSUM  = CYSUM  - TEMPB
            CLNSUM = CLNSUM + TEMPB * XMIDI(ICRX)
          ENDIF
C
          IF (INTYPE.EQ.3.)THEN
            WIDAXI = (DEQI(ICRX) + DEQI(ICRXP1)) / 2.0
            IF ((.NOT.ICOVER).AND.ICRX.EQ.1) THEN
              WII = 2*LENGTH(1)*TAN(RAMANG/RAD)
              WIDAXI = WII/2.
            ENDIF
            TEMPA = CDCA * WIDAXI * LENGTH(ICRX)
            TEMPB = CDCB * WIDAXI * LENGTH(ICRX)
            CNSUM = CNSUM + TEMPA
            CMSUM = CMSUM - TEMPA * XMIDI(ICRX)
            CYSUM = CYSUM - TEMPB
            CLNSUM= CLNSUM + TEMPB * XMIDI(ICRX)
          ENDIF
  110   CONTINUE
C
C       LOGIC TO RESOLVE DIVERTER/INLET DOUBLE FORCE ACCOUNTING
C       FOR AXISYMMETRIC INLETS. NOTE: DO NOT CALCULATE THESE 
C       PARAMETERS IF HDIV .LE. 0.0 SINCE INLET-BODY DOUBLE ACCOUNTING
C       IS DONE BY BODNWT AND BODCFD
C
        ANSUM  = 0.0
        AMSUM  = 0.0
        AYSUM  = 0.0
        ALNSUM = 0.0
        IF (INTYPE.EQ.3..AND. HDIV .GT. 0.0) THEN
         DO 120 IDCRX = 1, 3
             CALL AXINWT(IDCRX)
  120    CONTINUE
          DO 130 IDCRX = 1, 2
           IDCRX1 = IDCRX + 1
           WDAXI = (WD(IDCRX) + WD(IDCRX1)) / 2.
C
C     CHECK FOR POSITIVE OR NEGATIVE ANGLE OF ATTACK
          IF (ALPHAR .GE. 0.0) THEN
            CNZAVE = -(DLCNAP(IDCRX,INLET) + DLCNAP(IDCRX1,INLET)) / 2.0
          ELSE
            CNZAVE = -(DLCNAN(IDCRX,INLET) + DLCNAN(IDCRX1,INLET)) / 2.0
          ENDIF
C
C     CHECK FOR POSITIVE OR NEGATIVE SIDESLIP ANGLE
          IF (BETAR .GE. 0.0) THEN
            CNYAVE = -(DLCYAP(IDCRX,INLET) + DLCYAP(IDCRX1,INLET)) / 2.0
          ELSE
            CNYAVE = -(DLCYAN(IDCRX,INLET) + DLCYAN(IDCRX1,INLET)) / 2.0
          ENDIF
C
          TEMP1 = CDCA * WDAXI * DLEN(IDCRX) * CNZAVE / CNCIRN
          TEMP2 = CDCB * WDAXI * DLEN(IDCRX) * CNYAVE / CNCIRN
          ANSUM = ANSUM + TEMP1
          AMSUM = AMSUM - TEMP1 * XMIDD(IDCRX)
          AYSUM = AYSUM - TEMP2
          ALNSUM= ALNSUM + TEMP2 * XMIDD(IDCRX)
C
  130     CONTINUE
C
        ENDIF
C
C       COMPUTE THE DYNAMIC PRESSURE RATIO
        F3A = SIN(ALPHAR) * ABS(SIN(ALPHAR))
        F3B = SIN(BETAR)  * ABS(SIN(BETAR))
C
C       COMPLETE CROSSFLOW AERO CALCULATION
        CNVIS  = CNVIS  + (CNSUM+ANSUM)  * F3A /  SREF
        CMVIS  = CMVIS  + (CMSUM+AMSUM)  * F3A / (SREF * LREF)
        CYVIS  = CYVIS  + (CYSUM+AYSUM)  * F3B /  SREF
        CLNVIS = CLNVIS + (CLNSUM+ALNSUM) * F3B / (SREF * BREF)
C
  100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE MDIV(FRNOSE,NX,R,X,LNOSE,MSUB)
C
C     THIS SUBROUTINE DETERMINES CPmin BASED ON A CORRELATION
C     OF RESULTS GATHERED FROM A LINE SINGULARITY CODE WRITTEN
C     BY DR. MIKE HEMSCH OF NASA/LANGLEY.  CPmin IS THEN USED
C     TO PREDICT THE ONSET OF THE TRANSONIC DRAG RISE. THE DRAG
C     DIVERGENCE MACH NUMBER IS PASSED TO THE CALLING PROGRAM.
C
C  WRITTEN BY A. JENN, MCDONNELL DOUGLAS
C
      DIMENSION R(50),X(50)
      REAL MSUB,NX,LNOSE
C
C     ASSIGN NX AS AN INTEGER
      INX = NX
C
C     ONLY THE NOSE COORDINATES ARE NEEDED
      JNX = 0
      DO 50 I=1,INX
         JNX = JNX + 1
         IF (X(I) .EQ. X(1)+LNOSE) GOTO 75
         IF (X(I) .GT. X(1)+LNOSE) THEN
            JNX = JNX - 1
            GOTO 75
         ENDIF
   50 CONTINUE
C
   75 CONTINUE
C           
C     DETERMINE THE TERMINAL ANGLE OF A CONE OF
C     FINENESS RATIO FRNOSE
      THETAC = ATAN(1./(2.*FRNOSE))
C
C     CALCULATE CPPAN AS IF THE WHOLE NOSE WERE OF THE SHAPE
C     OF THIS PANEL
      THETA = ATAN((R(JNX) - R(JNX-1))/(X(JNX) - X(JNX-1)))
      IF (THETA.GT.THETAC) THETA=THETAC
      SLOPE = 0.22 - 0.13*(ABS(THETA/THETAC))**0.75
      Y2 = FRNOSE*SLOPE
      CPMIN = 1./(10.*Y2)**1.25
C
C     CALCULATE MSUB FOR THE SPECIFIC VALUE OF CPMIN
      MSUB = EXP(-0.521*CPMIN**0.645)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PRITRM(IM,NSET,DELTAB,PANL1,PANL2,PANL3,PANL4,PANL5,
     1 PANL6,PANL7,PANL8,DELTRM,CNTRM,CMTRM,CATRM,CYTRM,CLNTRM,CLLTRM)
C
C***  PRINT TRIMMED STATIC AERODYNAMICS COMPUTED
C
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
C
      COMMON /FSET1/  FS1(111),APAN1,FS12(287)
      COMMON /FSET2/  FS2(111),APAN2,FS22(287)
      COMMON /FSET3/  FS3(111),APAN3,FS32(287)
      COMMON /FSET4/  FS4(111),APAN4,FS42(287)
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C
      DIMENSION DELTRM(20),CNTRM(20),CMTRM(20),CATRM(20),
     1 CYTRM(20),CLNTRM(20),CLLTRM(20),CLTRM(20),CDTRM(20),
     2 FORM(37),ICONT(9)
      DIMENSION DELTAB(10),NPAN(4)
C
      REAL NALPHA,NMACH,MACH
      CHARACTER*4 FORM,NDM,NNA
C
      LOGICAL NM,NA,NB,PANL1,PANL2,PANL3,PANL4,PANL5,PANL6,PANL7,PANL8
C
      DATA I1,I2,I3,I4,I5,I6,I7,I8 / 1, 2, 3, 4, 5, 6, 7, 8 /
       DATA ICONT / 10,11,11,11,11,11,11,11,11 /
      DATA FORM /
     1 '(   ','13X,','  F7','.2, ',
     2 ' 2X,',' 1X,','  F1','0.4,',
     3 ' 2X,',' 1X,','  F1','0.4,',
     4 ' 2X,',' 1X,','  F1','0.4,',
     5 ' 2X,',' 1X,','  F1','0.4,',
     6 ' 2X,',' 1X,','  F1','0.4,',
     7 ' 2X,',' 1X,','  F1','0.4,',
     8 ' 2X,',' 1X,','  F1','0.4,',
     9 ' 2X,',' 1X,','  F1','0.4,',
     A '/)  '/
C
      DATA NDM /'*NT*'/
      DATA NNA /'*NT*'/
C
      NALP=NALPHA+0.5
      NPAN(1)=APAN1+.5
      NPAN(2)=APAN2+.5
      NPAN(3)=APAN3+.5
      NPAN(4)=APAN4+.5
C
      DO 500 I=1,NALP
      CALL CLOCD(ALPHA(I),CNTRM(I),CATRM(I),CLTRM(I),CDTRM(I),DUMM)
      IF(DELTRM(I).EQ.UNUSED) CLTRM(I)=UNUSED
      IF(DELTRM(I).EQ.UNUSED) CDTRM(I)=UNUSED
  500 CONTINUE
      CALL HEADR9
      WRITE(6,1010)
      CALL PRFLC9(IM,NB,NM,NA)
      WRITE(6,1020)
      DO 600 I=1,NALP
      IF(CLTRM(I).NE.UNUSED)WRITE(6,1500) ALPHA(I),DELTRM(I),CLTRM(I),
     1   CDTRM(I),CNTRM(I),CATRM(I)
      IF(CLTRM(I).EQ.UNUSED)WRITE(6,1600) ALPHA(I),
     1                   NDM,NDM,NDM,NDM,NDM
  600 CONTINUE
C
      WRITE(6,1040)NSET,DELTAB(1),DELTAB(10)
         IF(PANL1)WRITE(6,1050)I1
         IF(.NOT. PANL1)WRITE(6,1060)I1
      IF(NPAN(NSET) .LE. 1)GO TO 1005
         IF(PANL2)WRITE(6,1050)I2
         IF(.NOT. PANL2)WRITE(6,1060)I2
      IF(NPAN(NSET) .LE. 2)GO TO 1005
         IF(PANL3)WRITE(6,1050)I3
         IF(.NOT. PANL3)WRITE(6,1060)I3
      IF(NPAN(NSET) .LE. 3)GO TO 1005
         IF(PANL4)WRITE(6,1050)I4
         IF(.NOT. PANL4)WRITE(6,1060)I4
      IF(NPAN(NSET) .LE. 4)GO TO 1005
         IF(PANL5)WRITE(6,1050)I5
         IF(.NOT. PANL5)WRITE(6,1060)I5
      IF(NPAN(NSET) .LE. 5)GO TO 1005
         IF(PANL6)WRITE(6,1050)I6
         IF(.NOT. PANL6)WRITE(6,1060)I6
      IF(NPAN(NSET) .LE. 6)GO TO 1005
         IF(PANL7)WRITE(6,1050)I7
         IF(.NOT. PANL7)WRITE(6,1060)I7
      IF(NPAN(NSET) .LE. 7)GO TO 1005
         IF(PANL8)WRITE(6,1050)I8
         IF(.NOT. PANL8)WRITE(6,1060)I8
 1005 IF(NM)WRITE(6,1030)
C
 1010 FORMAT(18X,'STATIC AERODYNAMIC COEFFICIENTS TRIMMED IN PITCH',/)
 1020 FORMAT(4X,5X,'ALPHA',5X,'DELTA',7X,'CL',8X,'CD',8X,
     1       'CN',8X,'CA')
 1030 FORMAT(4X,'NOTE - *NT* PRINTED WHEN NO TRIM POINT COULD BE',
     1  ' FOUND')
 1040 FORMAT(4X,'PANELS FROM FIN SET',I2,' WERE DEFLECTED OVER THE',
     1 ' RANGE',F7.2,' TO',F7.2,' DEG')
 1050 FORMAT(4X,'PANEL',I2,' WAS VARIED')
 1060 FORMAT(4X,'PANEL',I2,' WAS FIXED')
 1500 FORMAT(4X,F10.2,F10.2,4F10.3)
 1600 FORMAT(4X,F10.2,5X,A4,6X,A4,6X,A4,6X,A4,6X,A4)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SPLIN2(M,X,Y,K)
C
C***  SUBROUTINE TO FIT A NATURAL SPLINE TO THE INPUT ARRAY
C***  THE SPLINE COEFFICIENTS ARE RETURNED
C
C***  INPUTS
C
C     M - NUMBER OF POINTS TO SPLINE
C     X - X ARRAY OF DATA TO SPLINE
C     Y - Y ARRAY OF DATA TO SPLINE
C
C***  OUTPUT
C
C     K - ARRAY OF SPLINE COEFFICIENTS
C                          
C***  THE FOLLOWING STATEMENTS ARE SET FOR UP TO 100 INPUT POINTS
C***  TWO ADDITIONAL ARE REQUIRED IN EACH ARRAY
C
      PARAMETER (NMAX=100)
      DIMENSION X(NMAX),Y(NMAX),A(NMAX,NMAX),K(NMAX)
C
      REAL K                                     
C
      DO 1010 I=1,M
         DO 1000 J=1,M
            A(I,J)=0.  
 1000    CONTINUE
 1010 CONTINUE
C
      A(1,1)=2.  
      A(1,2)=1.  
      A(1,M+1)=3.*(Y(2)-Y(1))/(X(2)-X(1))
      A(M,M-1)=1.      
      A(M,M)=2.  
      A(M,M+1)=3.*(Y(M)-Y(M-1))/(X(M)-X(M-1))
C
      MM2=M-2
      DO 1020 I=1,MM2
         A(I+1,I)=X(I+2)-X(I+1)
         A(I+1,I+2)=X(I+1)-X(I)
         A(I+1,I+1)=2.*(A(I+1,I)+A(I+1,I+2))
         D1=(Y(I+1)-Y(I))/A(I+1,I+2)
         D2=(Y(I+2)-Y(I+1))/A(I+1,I)
         A(I+1,M+1)=3.*(D1*A(I+1,I)+D2*A(I+1,I+2))
 1020 CONTINUE
C
      NROW=M-1
      NCOL=M
C
      DO 1030 J=1,NCOL
         A(1,J+1)=A(1,J+1)/A(1,1)
 1030 CONTINUE
C
      DO 1080 L=1,NROW
         DO 1050 I=L,NROW
            SUM=0.  
            DO 1040 KK=1,L
               SUM=SUM+A(I+1,KK)*A(KK,L+1)
 1040       CONTINUE
            A(I+1,L+1)=A(I+1,L+1)-SUM
 1050    CONTINUE
C
         LP1=L+1
         DO 1070 J=LP1,NCOL
            SUM=0.  
            DO 1060 KK=1,L
               SUM=SUM+A(L+1,KK)*A(KK,J+1)
 1060       CONTINUE
            A(L+1,J+1)=(A(L+1,J+1)-SUM)/A(L+1,L+1)
 1070    CONTINUE
 1080 CONTINUE
C
      K(NROW+1)=A(NROW+1,NCOL+1)
      DO 1100 MM=1,NROW
         I=NROW-MM
         SUM=0.  
         IP1=I+1
         DO 1090 J=IP1,NROW
            SUM=SUM+A(I+1,J+1)*K(J+1)
 1090    CONTINUE
         K(I+1)=A(I+1,NCOL+1)-SUM
 1100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE VNAME(KOL,L,LEN,NUM,NAMES,NNAM,I,FOUND,ARRAY,
     1            NDMS,NF,NUMBER,BLANK,EQUAL)
C
C***  SUBROUTINE TO CHECK VARIABLE NAME AND SYNTAX
C
      DIMENSION KOL(80), LEN(NUM), NAMES(NNAM), NUMBER(15)
      CHARACTER*4 PARL,PARR,EQUAL,BLANK,KOL,NUMBER,NAMES
      LOGICAL FOUND, ARRAY, NMTEST, FLAG
      DATA PARL, PARR /'(   ',')   ' /
C
C***  TEST FOR VARIABLE NAME
C
      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.
     1       (KOL(K) .EQ. PARL)
         IF(FLAG) GO TO 1020
 1000    J = J+LEN(I)
 1010 CONTINUE
C
      FOUND = .FALSE.
      I = 0
      GO TO 1090
C
C***  DETERMINE IF NAME IS AN ARRAY, CHECK FOR ARRAY ELEMENT
C***  DESIGNATION, AND CHECK NAME DELIMITERS
C
 1020 CONTINUE
      FOUND = .TRUE.
      ARRAY = .FALSE.
      L = L+LEN(I)
      NDMS = 0
      IF(KOL(L) .NE. PARL) GO TO 1090
        ARRAY = .TRUE.
        L = L+1
 1030   DO 1040 J=1,10
           IF(L .GE. 79) GO TO 1070
           IF(KOL(L) .EQ. NUMBER(J)) GO TO 1060
           IF(KOL(L) .EQ. PARR)      GO TO 1080
 1040   CONTINUE
        NF = NF+1
 1050   L = L+1
        IF(KOL(L) .EQ. EQUAL) GO TO 1090
        GO TO 1050
 1060   NDMS = 10*NDMS+J-1
        L = L+1
        GO TO 1030
 1070   CONTINUE
        IF(KOL(L) .NE. PARR) NF = NF+1
 1080   CONTINUE
        L = L+1
        NDMS = NDMS-1
        IF(NDMS .GE. 0) GO TO 1090
        NF = NF+1
        NDMS = 0
 1090 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ARCCA(L, YP, B, XM, XW, CP, NF, DCA, FAIL)
C
C
C     CALCULATE CP AND D(CA)/DY ARROUND CIRCULAR ARC AIRFOIL
C
C     INPUT VARIABLES
C          L - NUMBER OF POINTS ON NOSE CAP
C         YP - Y-POSITION ON FIN
C          B - SPAN OF TWO PANELS ALONE
C         XM - MACH NUMBER
C
C     INPUT VARIABLES FROM COMMON
C         XO - ROOT LOCATIONS OF SOSL
C         XT - TIP LOCATIONS OF SOSL
C
C     OUTPUT VARIABLES
C         XW - LOCATIONS OF PRESSURES
C         CP - PRESSURE COEFFICIENT AT XW
C         NF - NUMBER OF FINAL POINT ON AIRFOIL
C        DCA - D(CA)/DY
C
      COMMON /CAFD/  XO(60), XT(60), DZDXO(60), DZDXT(60), TGA(60),
     1               ETA(60), DZDX(60), NS, CPO
C
      LOGICAL FAIL
      DIMENSION XW(60), CP(60)
C     ...
C     ... CALCULATE AIRFOIL GEOMETRY
C     ...
      AJ  = 2.0*YP/B
      X11 = XO(L+1)+AJ*(XT(L+1)-XO(L+1))
      X14 = XO(NS)+AJ*(XT(NS)-XO(NS))
      N1  = L+2
      NF  = N1+32
      DXX = (X14-X11)/32.0
      DXX = DXX/10.0
C     ...
C     ... CALCULATE CP ON CIRCULAR ARC
C     ...
      DO 10 I=N1,NF
        XW(I) = XO(I-1)+AJ*(XT(I-1)-XO(I-1))
        XP = XW(I)+DXX
        IF(I .EQ. N1) XP = X11+0.00001
        IF(I .EQ. NF) XP = X14-0.00001
        CALL CP3DW(XP, YP, B, XM, CP(I),FAIL)
        IF(FAIL)GO TO 20
   10 CONTINUE
C     ...
C     ... CALCULATE DCA
C     ...
      DX  = (X14-X11)/32.0
      DCA = 0.0
      CALL SIMPW(CP, DZDX, DX, N1, NF, DCA)
C
   20 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      BLOCK DATA BLOCKD
C
C***  THIS ROUTINE SETS ALL OF THE CONSTANTS USED IN THE PROGRAM
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /INPCON/ LOC(11),LEN(11),NLNAME(56)
      COMMON /TRACE/  LEVEL,IROUTN(10,2)
C
C***  TO CONSERVE CORE, DATA REQUIRED FOR THE INPUT ERROR CHECKING
C***  MODULE IS OVERLAYED INTO GENERAL DATA STORAGE.  IT IS CLEARED
C***  PRIOR TO EXECUTION OF THE INPUT CASES.
C
      COMMON /VARNAM/ LEN1(11),LDM1(11),FLTCON(45),
     1                LEN2( 9),LDM2( 9),REFQ(39),
     2                LEN3(34),LDM3(34),AXIBOD(152),
     3                LEN4(23),LDM4(23),FINSET(113),
     4                LEN5( 6),LDM5( 6),DEFLCT(34),
     5                LEN6(12),LDM6(12),TRIM(59),
     6                LEN7(35),LDM7(35),ELLBOD(152),
     7                LEN8(14),LDM8(14),INLET(47),
     8                LEN9(15),LDM9(15),EXPR(53),
     9                LEN10(11),LDM10(11),ARBBOD(57)
C
      CHARACTER*4 FLTCON,REFQ,AXIBOD,FINSET,DEFLCT,TRIM,ELLBOD,INLET,
     1        EXPR,ARBBOD,KAND,NLNAME
C
C***  PROGRAM NUMERIC CONSTANTS
C
      DATA PI  / 3.14159265359 /
      DATA RAD / 57.29577951308 /
C
C***  ALL DATA LOCATIONS ARE INITIALIZED TO UNUSED, NOT ZERO

C***  BOTH THE REAL AND STRING CONSTANTS BELOW MUST BE CONSISTENT
C
      DATA UNUSED / 1.E-30 /
C
C***  VARIABLE KAND IS THE NAMELIST INPUT PARAMETER
C***  IT IS SET TO $ FOR CDC AND VAX COMPUTER SYSTEMS
C***  IT MAY NEED TO BE CHANGED FOR OTHER SYSTEMS
C
      DATA KAND / '$   ' /
C
C***  SET THE NAMELIST NAMES FOR CONERR
C
C***  LOCATION OF THE FIRST LETTER OF EACH NAME
C
      DATA LOC / 1,4,10,14,20,26,32,36,42,47,51 /
C
C***  NUMBER OF CHARACTERS IN EACH NAME
C
      DATA LEN / 3,6,4,6,6,6,4,6,5,4,6 /
C
C***  SET NAMELIST NAMES
C
      DATA NLNAME / 'E   ','N   ','D   ','F   ','L   ','T   ','C   ',
     1 'O   ','N   ','R   ','E   ','F   ','Q   ','A   ','X   ','I   ',
     2 'B   ','O   ','D   ','F   ','I   ','N   ','S   ','E   ','T   ',
     3 'D   ','E   ','F   ','L   ','C   ','T   ','T   ','R   ','I   ',
     4 'M   ','E   ','L   ','L   ','B   ','O   ','D   ','I   ','N   ',
     5 'L   ','E   ','T   ','E   ','X   ','P   ','R   ','P   ','R   ',
     6 'O   ','T   ','U   ','B   '/
C
C***  SET THE VARIABLE NAMES TO BE CHECKED IN CONERR
C
C***  NUMBER OF CHARACTERS IN EACH NAME
C
      DATA LEN1 / 6,5,4,3,5,4,3,3,4,4,4 /
C
C***  DIMENSION OF EACH VARIABLE (NEGATIVE MEANS LOGICAL)
C
      DATA LDM1 / 1,20,1,1,1,20,20,20,20,20,20 /
C
C***  SET THE CHARACTERS IN EACH NAME
C
      DATA FLTCON / 'N   ','A   ','L   ','P   ','H   ','A   ','A   ',
     1 'L   ','P   ','H   ','A   ','B   ','E   ','T   ','A   ','P   ',
     2 'H   ','I   ','N   ','M   ','A   ','C   ','H   ','M   ','A   ',
     3 'C   ','H   ','A   ','L   ','T   ','R   ','E   ','N   ','V   ',
     4 'I   ','N   ','F   ','T   ','I   ','N   ','F   ','P   ','I   ',
     5 'N   ','F   '/
      DATA LEN2 / 4,4,6,5,3,3,5,6,3 /
      DATA LDM2 / 1,1,1,1,1,1,1,1,1 /
      DATA REFQ / 'S   ','R   ','E   ','F   ','L   ','R   ','E   ',
     1 'F   ','L   ','A   ','T   ','R   ','E   ','F   ','R   ','O   ',
     2 'U   ','G   ','H   ','X   ','C   ','G   ','Z   ','C   ','G   ',
     3 'S   ','C   ','A   ','L   ','E   ','B   ','L   ','A   ','Y   ',
     4 'E   ','R   ','R   ','H   ','R   '/
      DATA LEN3 / 2,2,2,1,1,5,5,5,5,5,6,6,4,4,4,5,6,5,4,5,5,4,4,
     1 6,5,5,5,4,6,6,5,5,5,5 /
      DATA LDM3 / 1,1,1,50,50,1,1,1,1,-1,1,1,1,1,1,1,20,1,-1,1,20,
     1 20,20,-1,1,20,20,20,20,100,100,100,100,100 /
      DATA AXIBOD / 'N   ','X   ','X   ','O   ','X   ','0   ','X   ',
     1 'R   ','T   ','N   ','O   ','S   ','E   ','L   ','N   ','O   ',
     2 'S   ','E   ','D   ','N   ','O   ','S   ','E   ','B   ','N   ',
     3 'O   ','S   ','E   ','T   ','R   ','U   ','N   ','C   ','L   ',
     4 'C   ','E   ','N   ','T   ','R   ','D   ','C   ','E   ','N   ',
     5 'T   ','R   ','T   ','A   ','F   ','T   ','L   ','A   ','F   ',
     6 'T   ','D   ','A   ','F   ','T   ','P   ','O   ','W   ','E   ',
     7 'R   ','D   ','I   ','S   ','C   ','O   ','N   ','D   ','E   ',
     8 'X   ','I   ','T   ','B   ','A   ','S   ','E   ','B   ','E   ',
     9 'T   ','A   ','N   ','J   ','M   ','A   ','C   ','H   ','P   ',
     A 'R   ','A   ','T   ','T   ','R   ','A   ','T   ','P   ','R   ',
     B 'O   ','T   ','U   ','B   ','N   ','P   ','R   ','O   ','T   ',
     C 'P   ','T   ','Y   ','P   ','E   ','X   ','P   ','R   ','O   ',
     D 'T   ','N   ','L   ','O   ','C   ','B   ','L   ','D   ','M   ',
     E 'E   ','M   ','B   ','L   ','D   ','T   ','Y   ','P   ','L   ',
     F 'P   ','R   ','O   ','T   ','W   ','P   ','R   ','O   ','T   ',
     G 'H   ','P   ','R   ','O   ','T   ','O   ','P   ','R   ','O   ',
     H 'T   '/
      DATA LEN4 / 6,5,5,6,5,6,5,6,6,5,3,3,3,6,5,4,5,6,6,6,3,4,4 /
      DATA LDM4 / 1,10,10,10,10,10,10,10,10,10,10,10,10,1,
     1 50,50,50,50,50,1,8,8,10 /
      DATA FINSET / 'S   ','E   ','C   ','T   ','Y   ','P   ','S   ',
     1 'S   ','P   ','A   ','N   ','L   ','M   ','A   ','X   ','U   ',
     2 'L   ','F   ','L   ','A   ','T   ','U   ','L   ','M   ','A   ',
     3 'X   ','L   ','L   ','F   ','L   ','A   ','T   ','L   ','C   ',
     4 'H   ','O   ','R   ','D   ','Z   ','U   ','P   ','P   ','E   ',
     5 'R   ','Z   ','L   ','O   ','W   ','E   ','R   ','S   ','W   ',
     6 'E   ','E   ','P   ','S   ','T   ','A   ','L   ','E   ','R   ',
     7 'X   ','L   ','E   ','N   ','P   ','A   ','N   ','E   ','L   ',
     8 'X   ','C   ','O   ','R   ','D   ','M   ','E   ','A   ','N   ',
     9 'T   ','H   ','I   ','C   ','K   ','Y   ','U   ','P   ','P   ',
     A 'E   ','R   ','Y   ','L   ','O   ','W   ','E   ','R   ','F   ',
     B 'I   ','N   ','P   ','H   ','I   ','G   ','A   ','M   ','P   ',
     C 'H   ','I   ','F   ','C   ','F   ','O   ','C   '/
      DATA LEN5 / 6,6,6,6,6,4 /
      DATA LDM5 / 8,8,8,8,4,4 /
      DATA DEFLCT / 'D   ','E   ','L   ','T   ','A   ','1   ','D   ',
     1 'E   ','L   ','T   ','A   ','2   ','D   ','E   ','L   ','T   ',
     2 'A   ','3   ','D   ','E   ','L   ','T   ','A   ','4   ','X   ',
     3 'H   ','I   ','N   ','G   ','E   ','S   ','K   ','E   ','W   '/
      DATA LEN6 / 3,5,5,5,5,5,5,5,5,6,6,4 /
      DATA LDM6 / 1,-1,-1,-1,-1,-1,-1,-1,-1,1,1,-8 /
      DATA TRIM / 'S   ','E   ','T   ','P   ','A   ','N   ','L   ',
     1 '1   ','P   ','A   ','N   ','L   ','2   ','P   ','A   ','N   ',
     2 'L   ','3   ','P   ','A   ','N   ','L   ','4   ','P   ','A   ',
     3 'N   ','L   ','5   ','P   ','A   ','N   ','L   ','6   ','P   ',
     4 'A   ','N   ','L   ','7   ','P   ','A   ','N   ','L   ','8   ',
     5 'D   ','E   ','L   ','M   ','I   ','N   ','D   ','E   ','L   ',
     6 'M   ','A   ','X   ','A   ','S   ','Y   ','M   '/
      DATA LEN7 / 2,2,2,1,1,5,5,5,5,5,6,6,4,4,4,5,6,5,1,1,5,6,4,5,
     1 6,5,5,5,4,6,6,5,5,5,5 /
      DATA LDM7 / 1,1,1,50,50,1,1,1,1,-1,1,1,1,1,1,1,20,50,50,50,1,1,1,
     1 1,-1,1,20,20,20,20,100,100,100,100,100 /
      DATA ELLBOD / 'N   ','X   ','X   ','O   ','X   ','0   ','X   ',
     1 'R   ','T   ','N   ','O   ','S   ','E   ','L   ','N   ','O   ',
     2 'S   ','E   ','W   ','N   ','O   ','S   ','E   ','B   ','N   ',
     3 'O   ','S   ','E   ','T   ','R   ','U   ','N   ','C   ','L   ',
     4 'C   ','E   ','N   ','T   ','R   ','W   ','C   ','E   ','N   ',
     5 'T   ','R   ','T   ','A   ','F   ','T   ','L   ','A   ','F   ',
     6 'T   ','W   ','A   ','F   ','T   ','P   ','O   ','W   ','E   ',
     7 'R   ','D   ','I   ','S   ','C   ','O   ','N   ','E   ','L   ',
     8 'L   ','I   ','P   ','W   ','H   ','E   ','N   ','O   ','S   ',
     9 'E   ','E   ','C   ','E   ','N   ','T   ','R   ','E   ','A   ',
     A 'F   ','T   ','D   ','E   ','X   ','I   ','T   ','P   ','R   ',
     B 'O   ','T   ','U   ','B   ','N   ','P   ','R   ','O   ','T   ',
     C 'P   ','T   ','Y   ','P   ','E   ','X   ','P   ','R   ','O   ',
     D 'T   ','N   ','L   ','O   ','C   ','B   ','L   ','D   ','M   ',
     E 'E   ','M   ','B   ','L   ','D   ','T   ','Y   ','P   ','L   ',
     F 'P   ','R   ','O   ','T   ','W   ','P   ','R   ','O   ','T   ',
     G 'H   ','P   ','R   ','O   ','T   ','O   ','P   ','R   ','O   ',
     H 'T   '/
      DATA LEN8 / 3,6,5,4,4,4,3,1,1,1,5,4,3,3 /
      DATA LDM8 / 1,1,1,1,1,1,20,5,5,5,-1,1,-1,20 /
      DATA INLET   / 'N   ','I   ','N   ',
     1 'I   ','N   ','T   ','Y   ','P   ','E   ',
     2 'X   ','I   ','N   ','L   ','T   ',
     3 'X   ','D   ','I   ','V   ',
     4 'H   ','D   ','I   ','V   ',
     5 'L   ','D   ','I   ','V   ',
     6 'P   ','H   ','I   ',
     7 'X   ',
     8 'H   ',
     9 'W   ',
     A 'C   ','O   ','V   ','E   ','R   ',
     B 'R   ','A   ','M   ','P   ',
     C 'A   ','D   ','D   ',
     D 'M   ','F   ','R   '/
      DATA LEN9 / 4,6,5,4,4,6,3,3,4,2,2,2,2,3,3 /
      DATA LDM9 / 1,1,20,1,1,1,1,1,1,20,20,20,20,20,20 /
      DATA EXPR / 'M   ','A   ','C   ','H   ','N   ','A   ',
     1 'L   ','P   ','H   ','A   ','A   ','L   ','P   ','H   ','A   ',
     2 'S   ','R   ','E   ','F   ','L   ','R   ','E   ','F   ','L   ',
     3 'A   ','T   ','R   ','E   ','F   ','X   ','C   ','G   ','Z   ',
     4 'C   ','G   ','C   ','O   ','N   ','F   ','C   ','N   ','C   ',
     5 'M   ','C   ','A   ','C   ','Y   ','C   ','S   ','N   ','C   ',
     6 'S   ','L   '/
C
      DATA ARBBOD /'P   ','R   ',
     B 'O   ','T   ','U   ','B   ','N   ','P   ','R   ','O   ','T   ',
     C 'P   ','T   ','Y   ','P   ','E   ','X   ','P   ','R   ','O   ',
     D 'T   ','N   ','L   ','O   ','C   ','B   ','L   ','D   ','M   ',
     E 'E   ','M   ','B   ','L   ','D   ','T   ','Y   ','P   ','L   ',
     F 'P   ','R   ','O   ','T   ','W   ','P   ','R   ','O   ','T   ',
     G 'H   ','P   ','R   ','O   ','T   ','O   ','P   ','R   ','O   ',
     H 'T   '/
      DATA LEN10 /6,5,5,5,4,6,6,5,5,5,5/
      DATA LDM10 /-1,1,20,20,20,20,100,100,100,100,100/
C
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CONEP(GAM,AM,SD,PC)
C
C  COMPUTE CONE PRESSURE AT ZERO ANGLE OF ATTACK FROM THE METHOD
C  OF RASMUSSEN (AIAA JOURNAL, AUGUST 1967, PAGE 1495)
C
C  INPUTS
C
C    GAM -- RATIO OF SPECIFIC HEATS FOR THE GAS (1.4 FOR AIR)
C     AM -- FREE STREAM MACH NUMBER
C     SD -- SINE OF THE SEMI-APEX ANGLE
C
C  OUTPUT
C
C     PC -- PRESSURE ON THE SURFACE
C
C  SUBROUTINES CALLED -- NONE
C
      IF(SD.LT.0.005)GO TO 1000
         AKS=(AM**2-1.)*SD**2
         T=ALOG((GAM+1.)/2.+1./AKS)
         CP=SD**2*(1.+((GAM+1.)*AKS+2.)*T/((GAM-1.)*AKS+2.))
      GO TO 1010
 1000 CP=0.
 1010 PC=1.0+GAM/2.*AM**2*CP
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE DELV(ORDER,I,BETA,XXI,TAU,F1,F2,PSIX,PSIR,C,SUM1,SUM2,
     1 SUM3,SUM4,SUM5,SUM6,NN1,NN2,NN3,IK,JL,TTX,TTR,TEMP)
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  ORIGINAL ROUTINE WRITTEN BY F. MOORE, NSWC
C  MODIFIED BY J. JENKINS, WL/FIGC
C
      COMMON /VDARY/ XB(220),RB(220),RBP(220),DMM1(220),C1(220),
     1 RB1(220),RBP1(220),B(220),PSI(220),ZE0X(220),DMM2(220),PHIX(220)
      INTEGER ORDER
      DIMENSION PSIR(220),C(220)
      SUM1=0.
      SUM2=0.
      SUM3=0.
      IF(I.EQ.2) GO TO 1020
      J2=I-1
      DO 1010 J=2,J2
C
C ... SOLUTION OF J.A.S. EQUATION 26, NUMBER 3
C
      TEMP=SUM2
      CALL JAS26(XB(I),BETA,RB(J-1),XB(J-1),XXI,RB(I),TAU,F1,F2,
     1 C(J),SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,-1.,3)
 1010 CONTINUE
      JH=NN1+1
      IF(I.LE.JH) GO TO 1020
      CALL DISC2(I,JH,BETA,SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,3,ORDER)
      J=NN1+1
C
C ... SOLUTION OF J.A.S. EQUATION 26, NUMBER 3
C
      CALL JAS26(XB(I),BETA,RB(J-1),XB(J-1),XXI,RB(I),TAU,F1,F2,
     1 C(J),SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,1.,3)
      JH=NN2+1
      IF(I.LE.JH) GO TO 1020
      CALL DISC2(I,JH,BETA,SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,3,ORDER)
      J=NN2+1
C
C ... SOLUTION OF J.A.S. EQUATION 26, NUMBER 3
C
      CALL JAS26(XB(I),BETA,RB(J-1),XB(J-1),XXI,RB(I),TAU,F1,F2,
     1 C(J),SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,1.,3)
      JH=NN3+1
      IF(I.LE.JH) GO TO 1020
      CALL DISC2(I,JH,BETA,SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,3,ORDER)
      J=NN3+1
C
C ... SOLUTION OF J.A.S. EQUATION 26, NUMBER 3
C
      CALL JAS26(XB(I),BETA,RB(J-1),XB(J-1),XXI,RB(I),TAU,F1,F2,
     1 C(J),SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,1.,3)
 1020 CONTINUE
      IF(ORDER .GT. 1) GO TO 1030
        VX=SUM2
        VR=SUM3
        GO TO 1040
 1030 VX = PSIX + SUM2
      VR = PSIR(I) + SUM3
 1040 CALL AXBNDY(I,BETA,VX,VR,NN1,NN2,NN3,IK,JL,C,TTX,TTR)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCLMSB(AR, MACH, DELY, SLE, TAPER,
     1                  C1, C2, CLM, ACLM)
C ***
C *** COMPUTES SUBSONIC MAXIMUM LIFT AND ANGLE-OF-ATTACK
C *** FOR MAXIMUM LIFT FOR LOW ASPECT RATIO WINGS
C ***
C *** REFERENCE   DATCOM SECTION 4.1.3.4
C ***             METHOD 3
C ***
C *** LIMITATIONS   MACH .LE. 0.6
C ***               AR .LE. 4.0/((C1+1)*COS(SLE))
C ***
C *** INPUT   AR      EXPOSED FIN ASPECT RATIO OF TWO PANELS
C ***         MACH    MACH NUMBER
C ***         DELY    DIFFERENCE IN AIRFOIL ORDINATE BETWEEN
C ***                 .15% AND 6% CHORD,PER CENT CHORD
C ***         SLE     LEADING EDGE SWEEP ANGLE, DEG
C ***         TAPER   EXPOSED FIN TAPER RATIO
C ***
C *** OUTPUT  C1,C2   TAPER RATIO CORRECTION FACTORS(DATC FIG 4.1.3.4-24
C ***         CLM     MAXIMUM LIFT COEFFICIENT,REFERENCED TO EXPOSED
C ***                 PLANFORM AREA OF TWO PANELS
C ***         ACLM    ANGLE-OF-ATTACK FOR CLM,DEGREES
C ***
C ***
C
      COMMON /CONST/PI,RAD,UNUSED,KAND
C
      DIMENSION XC1(11), YC1(11)
      DIMENSION XC2(11), YC2(11)
      DIMENSION XCLMB(19), YCLMB(6),  ZCLMB(114)
      DIMENSION XDCLM(15), YDCLM(3), ZDCLM(45)
      DIMENSION XACLMB(10), YACLMB(10)
      DIMENSION X1DA(10), Y1DA(10), Z1DA(100)
      DIMENSION X2DA(20), Y2DA(3), Z2DA(60)
C
      REAL MACH
C
C ***
C *** DATA STATEMENTS
C ***
      DATA DUM / 1.0 /
C ***
C *** DATCOM FIGURE 4.1.3.4-24B   (C1 AND C2)
C ***
      DATA XC1 /0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
      DATA YC1 /0.,.225,.47,.496,.43,.32,.21,.125,.075,.0475,.0/
      DATA XC2 /0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
      DATA YC2 /0.,.21,.5,.9,1.08,1.05,1.,.94,.9,.86,.85/
C ***
C *** DATCOM FIGURE 4.1.3.4-23B  (CLMAX BASE)
C ***
      DATA XCLMB /  0.00,  .20,  .40,  .60,  .80, 1.00, 1.20, 1.40,
     *              1.60, 1.80, 2.00, 2.20, 2.40, 2.60, 2.80, 3.00,
     *              3.20, 3.40, 3.60 /
      DATA YCLMB /  0.00,  .25,  .50,  .75, 1.00, 1.35 /
      DATA ZCLMB /
     *      .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,  .90,  .89,  .88,
     *      .65, 1.11, 1.29, 1.36, 1.37, 1.31, 1.20, 1.13, 1.07, 1.03,
     *      .99,  .96,  .94,  .92,  .90,  .89,  .88,  .87,  .86,
     *      .60, 1.07, 1.23, 1.29, 1.30, 1.25, 1.16, 1.10, 1.05, 1.01,
     *      .97,  .94,  .92,  .90,  .88,  .87,  .86,  .85,  .84,
     *      .55,  .99, 1.15, 1.23, 1.25, 1.21, 1.14, 1.09, 1.04,  .99,
     *      .95,  .92,  .90,  .88,  .86,  .85,  .84,  .83,  .83,
     *      .50,  .91, 1.08, 1.17, 1.20, 1.17, 1.13, 1.07, 1.03,  .98,
     *      .94,  .90,  .88,  .86,  .84,  .83,  .82,  .82,  .82,
     *      .50,  .91, 1.08, 1.17, 1.20, 1.17, 1.11, 1.06, 1.01,  .96,
     *      .91,  .88,  .85,  .83,  .82,  .81,  .80,  .80,  .80 /
C ***
C *** DATCOM FIGURE 4.1.3.4-24A  (DCLMAX)
C ***
      DATA XDCLM /    0.,  1.,  2.,  3.,  4.,  5.,  6.,  7.,  8.,  9.,
     *               10., 11., 12., 13., 14.  /
      DATA YDCLM /   .20, .40, .60  /
      DATA ZDCLM /  -.11,-.10,-.09,-.05,0.00, .06, .12, .18, .23, .29,
     *               .34, .37, .36, .32, .23,
     *              -.11,-.10,-.09,-.05,0.00, .05, .10, .15, .20, .26,
     *               .30, .33, .32, .28, .19,
     *              -.11,-.10,-.09,-.05,0.00, .04, .08, .12, .15, .18,
     *               .21, .23, .21, .16, .08  /
C ***
C *** DATCOM FIGURE 4.1.3.4-25A  (ACLM BASE)
C ***
      DATA XACLMB /  0.00,  .40,  .80, 1.20, 1.60, 2.00, 2.40, 2.80,
     *               3.20, 3.60  /
      DATA YACLMB /  35.0, 35.0, 35.0, 32.0, 28.0, 25.0, 23.2, 22.0,
     *               21.5, 21.0  /
C ***
C *** DATCOM FIGURE 4.1.3.4-25B  (DACLM PART 1 - X .LE. 4.5)
C ***
      DATA X1DA /    0.00,  .50, 1.00, 1.50, 2.00, 2.50, 3.00, 3.50,
     *               4.00, 4.50  /
      DATA Y1DA /     0.0,  2.0,  3.0,  4.0,  5.0,  6.0,  7.0,  8.0,
     *                9.0, 30.0  /
      DATA Z1DA /
     *     10.0,  8.5,  6.9,  5.5,  4.0,  2.6,  1.5,   .7,   .1,  0.0,
     *      8.7,  7.3,  5.3,  4.2,  2.6,  1.4,   .5,  -.2,  -.5,  0.0,
     *      7.5,  5.9,  4.2,  2.5,  1.2,  0.0,  -.7, -1.1,  -.8,  0.0,
     *      5.5,  3.4,  1.6,  0.0, -1.3, -2.1, -2.5, -2.0,  -.8,  0.0,
     *      3.0,   .7, -1.4, -3.3, -4.3, -4.3, -3.1, -2.0,  -.8,  0.0,
     *       .3, -2.5, -4.7, -5.8, -5.3, -4.3, -3.1, -2.0,  -.8,  0.0,
     *     -2.2, -5.0, -6.7, -6.3, -5.3, -4.3, -3.1, -2.0,  -.8,  0.0,
     *     -3.3, -6.6, -7.2, -6.3, -5.3, -4.3, -3.1, -2.0,  -.8,  0.0,
     *     -4.2, -7.0, -7.2, -6.3, -5.3, -4.3, -3.1, -2.0,  -.8,  0.0,
     *     -8.5, -7.9, -7.2, -6.3, -5.3, -4.3, -3.1, -2.0,  -.8,  0.0 /
C ***
C *** DATCOM FIGURE 4.1.3.4-25B  (DACLM PART 2 - X .GE. 4.5)
C ***
      DATA X2DA /     4.5,  5.0,  5.5,  6.0,  6.5,  7.0,  7.5,  8.0,
     *                8.5,  9.0,  9.5, 10.0, 10.5, 11.0, 11.5, 12.0,
     *               12.5, 13.0, 13.5, 14.0  /
      DATA Y2DA /     .20,  .40,  .60   /
      DATA Z2DA /
     *      0.0,   .5,   .9,  1.4,  1.9,  2.5,  3.3,  4.0,  4.6,  5.6,
     *      6.4,  7.3,  8.2,  9.2, 10.0, 11.0, 12.0, 13.0, 14.0, 15.0,
     *      0.0,   .2,   .4,   .7,  1.2,  1.7,  2.4,  3.0,  3.7,  4.6,
     *      5.2,  6.0,  6.9,  7.8,  8.6,  9.5, 10.4, 11.4, 12.3, 13.5,
     *      0.0,  0.0,   .1,   .2,   .5,   .7,  1.0,  1.3,  1.6,  2.0,
     *      2.5,  3.0,  3.6,  4.3,  4.9,  5.5,  6.2,  7.0,  7.6,  8.5 /
C
C ***
C *** CALCULATE C1, C2, AND ARTEST - 4.0/((C1+1)*COS(SLE))
C ***
      CALL LNTRP(XC1, YC1, 11, TAPER, C1)
      CALL LNTRP(XC2, YC2, 11, TAPER, C2)
      ARTEST = 4.0/((C1+1.0)*COS(SLE/RAD))
C ***
C *** CALCULATE CLM
C ***
      BETA = SQRT(1.0 - MACH*MACH)
      XARG = (C1+1.0)*AR*COS(SLE/RAD)/BETA
      IF(XARG .GT. 3.60) XARG = 3.60
      YARG = DELY
      IF(YARG .GT. 1.35) YARG = 1.35
      CALL MVLOOK(1, 6, 19, 114, DUM, YCLMB, XCLMB, ZCLMB,
     *            XARG, YARG, 1.0, CLMB)
      XARG = (C2+1.0)*AR*TAN(SLE/RAD)
      YARG = MACH
      IF(YARG .LT. 0.20) YARG = 0.20
      CALL MVLOOK(1, 3, 15, 45, DUM, YDCLM, XDCLM, ZDCLM,
     *            XARG, YARG, 1.0, DCLM)
      CLM = CLMB + DCLM
C ***
C *** CALCULATE ACLM
C ***
      XARG = (C1+1.0)*AR*COS(SLE/RAD)/BETA
      IF(XARG .GT. 3.60) XARG = 3.60
      CALL LNTRP(XACLMB, YACLMB, 10, XARG, ACLMB)
      XARG = (C2+1.0)*AR*TAN(SLE/RAD)
      YARG = AR*COS(SLE/RAD)*(1.0+4.0*TAPER*TAPER)
      IF(XARG .LE. 4.5) CALL MVLOOK(1, 10, 10, 100, DUM, Y1DA, X1DA,
     *                              Z1DA, XARG, YARG, 1.0, DACLM)
      YARG = MACH
      IF(YARG .LT. 0.20) YARG = 0.20
      IF(XARG .GT. 4.5) CALL MVLOOK(1, 3, 20, 60, DUM, Y2DA, X2DA,
     *                              Z2DA, XARG, YARG, 1.0, DACLM)
      ACLM = ACLMB + DACLM
C ***
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FORLOG(IUNIT, NAME, COMBLK, II)
C
C***  FORCE A LOGICAL PRINT ONTO UNIT IUNIT
C
C  IUNIT - OUTPUT UNIT NUMBER
C   NAME - ARRAY WHICH DEFINES THE NAMELIST VARIABLE NAME
C COMBLK - DATA FOR NAMELIST NAME
C     II - NUMBER OF ELEMENTS TO PRINT
C
      CHARACTER*4 NAME
      LOGICAL COMBLK
C
      DIMENSION NAME(8),COMBLK(II)
C
      WRITE(IUNIT,1000)(NAME(I),I=1,8),(COMBLK(I),I=1,II)
C
      RETURN
C
 1000 FORMAT('0',8A1,8(13X,L1,',')/(9X,8(13X,L1,',')))
C
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ILTFR
C
C     THIS SUBROUTINE DETERMINES THE MAXIMUM EQUIVALENT DIAMETER
C     OF THE INLET, DIVERTER, AND BODY THEN COMPUTES THE FINENESS RATIO
C     OF EACH COMPONENT.
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
C                  *********************
C                  * INPUT/OUTPUT LIST *
C                  *********************
C
C
C     ***** INPUTS *****          ***** OUTPUTS *****
C
C           DEQD                       FRI
C           XI                         FRD
C           XD                         FRB
C           LBOD
C           RBOD
C
C     SUBROUTINES USED: NONE
C
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
      COMMON /GEOBOD/ DUM(32),DMAX,SMAX,LBOD,GDUM(12)
      REAL LBOD
      RBOD=DMAX/2.0
C
C     SET INITIAL MAXIMUM EQUIVALENT DIAMETER
      DEQM = 0.0
      DEQN = 0.0
C
C     LOOP FOR EACH CROSS SECTION OF THE INLET
      DO 100 ICRX = 1, 5
C
C        CHECK IF NEW MAXIMUM EQUIVALENT DIAMETER
         IF (DEQI(ICRX) .GT. DEQM) DEQM = DEQI(ICRX)
C
  100 CONTINUE
C
C     LOOP FOR EACH CROSS SECTION OF THE DIVERTER
      DO 110 IDCRX = 1, 3
C
C        CHECK IF NEW MAXIMUM EQUIVALENT DIAMETER
         IF (DEQD(IDCRX) .GT. DEQN) DEQN = DEQD(IDCRX)
C
  110 CONTINUE
C
C     COMPUTE THE BODY FINENESS RATIOS
      FRI = ABS((XI(5) - XI(1))) / DEQM
      IF(HDIV .GT. 0.0)THEN
        FRD = ABS((XD(3) - XD(1))) / DEQN
      ELSE
        FRD = 0.0
      ENDIF
      FRB = ABS(LBOD) / (2.* RBOD)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE QUAD1(Y,N,H,ANS)
C
C **  NUMERICAL INTEGRATION BY FIVE POINT QUADRATURE, THE TWO
C **  POINT FORMULA, SIMPSON'S RULE OR NEWTON'S 3/8'S RULE
C
C **  INPUTS
C **       Y  = ARRAY TO BE INTEGRATED
C **       N  = NUMBER OF POINTS IN ARRAY Y
C **       H  = COMMON STEPSIZE BETWEEN SUCESSIVE ELEMENTS OF Y
C
C **  OUTPUT
C **       ANS= RESULT OF THE INTEGRATION
C
      DIMENSION Y(N)
C
      K=N
      ANS=0.
      IF(H.LE.0. .OR. N.LE.0.) GO TO 1050
C
C **  OMIT QUADRATURE METHOD IF LESS THAN FIVE POINTS
C
      IF(N.LT.4)GO TO 1010
C
C **  LOOP AND INTEGRATE FOR EACH FIVE POINTS
C
      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 CONTINUE
C
      ANS=ANS*H/22.5
C
 1010 CONTINUE
C
C
C **  IF K = 1 STOP THE INTEGRATION PROCESS
C **  IF K = 2 USE THE TWO POINT FORMULA
C **  IF K = 3 USE SIMPSON'S RULE
C **  IF K = 4 USE NEWTON'S 3/8'S RULE
C
      GO TO (1050,1020,1030,1040),K
C
 1020 ANS=ANS+H*(Y(N)+Y(N-1))/2.
C
      GO TO 1050
C
 1030 ANS=ANS+H*(Y(N-2)+4.*Y(N-1)+Y(N))/3.
C
      GO TO 1050
C
 1040 ANS=ANS+3.*H*(Y(N-3)+3.*Y(N-2)+3.*Y(N-1)+Y(N))/8.
C
 1050 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SPLINE(X,Y,N,K1,K2,DY1,DY2,XP,NP,YP,DYDXP)
C
C  SUBROUTINE TO INTERPOLATE USING CUBIC SPLINES
C
C  *** INPUTS ***
C
C     X --- ARRAY OF INDEPENDENT VARIABLES (OF LENGTH N)
C     Y --- ARRAY OF DEPENDENT VARIABLES (OF LENGTH N)
C     N --- NUMBER OF INPUT VARIABLES TO BE SPLINED
C    K1 --- IF 1, DY1 IS FIRST DERIVATIVE AT LOWER END OF TABLE
C           IF 2, DY1 IS SECOND DERIVATIVE AT LOWER END OF TABLE
C    K2 --- IF 1, DY2 IS FIRST DERIVATIVE AT UPPER END OF TABLE
C           IF 2, DY2 IS SECOND DERIVATIVE AT UPPER END OF TABLE
C   DY1 --- DERIVATIVE AT LOWER END OF TABLE
C   DY2 --- DERIVATIVE AT UPPER END OF TABLE
C
C    XP --- ARRAY OF X POINTS TO BE INTERPOLATED (OF LENGTH NP)
C    NP --- NUMBER OF OUTPUT POINTS TO BE INTERPOLATED
C
C  *** OUTPUTS ***
C
C    YP --- ARRAY OF Y OUTPUTS AT EACH XP POINT (OF LENGTH NP)
C DYDXP --- ARRAY OF LOCAL SLOPES (DY/DX) AT EACH POINT XP (OF LENGTH NP
C
C  NOTE: PRESENTLY DIMENSIONED FOR N=100. FOR LARGER ARRAYS
C        ADJUST DIMENSIONS OF A AND B ARRAYS TO BE (2*N)
C
      DIMENSION A(200),B(200),X(N),Y(N),XP(NP),YP(NP),DYDXP(NP)
C
      N1=N-2
      C1=X(2)-X(1)
      IF(K1 .EQ. 2)GO TO 1000
      B(1)=0.
      A(1)=(DY1-(Y(2)-Y(1))/C1)/C1
      GO TO 1010
 1000 B(1)=-C1
      A(1)=-DY1/2.
 1010 J=1
      IF(N .EQ. 2)GO TO 1040
      DO 1020 I=1,N1
      J=J+1
      C1=X(I+1)-X(I)
      C2=X(I+2)-X(I+1)
      C3=Y(I+1)-Y(I)
      C4=Y(I+2)-Y(I+1)
      C5=C3/C1-C4/C2
      C6=C1/C2
      C7=C1*C2
      B(J)=1./(C6*(C1-B(J-1)))
      A(J)=(C5/C2-C6*A(J-1))*B(J)
      J=J+1
      B(J)=1./((-C1-C2)/C7-C6*B(J-1))
      A(J)=(-C5/C7-C6*A(J-1))*B(J)
 1020 CONTINUE
      IF(K2 .EQ. 2)GO TO 1030
      A(J+1)=(DY2-C4/C2+C2*A(J))/(C2*(B(J)-C2))
      GO TO 1060
 1030 A(J+1)=(DY2/2.+A(J))/(-2.*C2*B(J))
      GO TO 1060
C
C  THE FOLLOWING STATEMENTS ARE FOR CASE WHERE N=2
C
 1040 C3=K1
      C2=1./C3
      IF(K2 .EQ. 2)GO TO 1050
      A(J+1)=((Y(2)-Y(1))/C1-A(J)*C1-DY2)/(C1*C1)*C2
      GO TO 1060
 1050 A(J+1)=C3*((DY2+2.*A(1))/(4.*C1))
 1060 J=2*(N-1)
 1070 J=J-1
      IF(J .LE. 0)GO TO 1080
      A(J)=A(J)-B(J)*A(J+1)
      GO TO 1070
C
C  INTERPOLATE/EXTRAPOLATE AT INPUT VALUES OF XP
C
 1080 DO 1120 JJ=1,NP
      IF(XP(JJ) .GT. X(1))GO TO 1090
C
C  SPECIAL CASE FOR EXTRAPOLATION OFF LOWER END OF TABLE
C
      C=X(2)-X(1)
      DYDXP(JJ)=(Y(2)-Y(1))/C+A(1)*C
      YP(JJ)=Y(1)+DYDXP(JJ)*(XP(JJ)-X(1))
c     CALL MESSG(XP(JJ),YP(JJ),X(1),X(N),Y(1),Y(N),1)
      GO TO 1120
 1090 IF(XP(JJ) .LT. X(N))GO TO 1100
C
C  SPECIAL CASE FOR EXTRAPOLATION OFF UPPER END OF TABLE
C
      C=X(N)-X(N-1)
      DYDXP(JJ)=(Y(N)-Y(N-1))/C-A(2*N-3)*C-A(2*N-2)*C*C
      YP(JJ)=Y(N)+DYDXP(JJ)*(XP(JJ)-X(N))
c     CALL MESSG(XP(JJ),YP(JJ),X(1),X(N),Y(1),Y(N),1)
      GO TO 1120
 1100 I=1
 1110 I=I+1
      IF(X(I) .LT. XP(JJ))GO TO 1110
C
C  NOW XP(JJ) HAS BEEN BRACKETED
C
      C=XP(JJ)-X(I-1)
      D=X(I)-XP(JJ)
      K=2*I-3
      SLOPE=(Y(I)-Y(I-1))/(X(I)-X(I-1))
      YP(JJ)=Y(I-1)+(SLOPE+(A(K)+A(K+1)*C)*D)*C
      DYDXP(JJ)=SLOPE+A(K)*(D-C)+A(K+1)*(2.*D-C)*C
 1120 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE VRINTS(HR,VR,PHI,RL,TAPER,SSPANW,VRINT)
C **
C **  COMPUTES INTERFERENCE FACTOR FOR VORTEX INTERACTION WITH
C **  LIFTING SURFACE. MODIFICATION OF SVRINT FOR ONE PANEL AND 
C **  ONE VORTEX WITH ITS IMAGE.
C **
C **  REFERENCE - NACA 1307, PITTS, NIELSEN, AND KAATARI (APPENDIX B) 
C **
C **  LIMITATIONS -  STRIP AND SLENDER-BODY THEORY. 
C **
C **  NOTE - UNITS ON HR,VR,SSPAN AND RL MUST BE CONSISTENT.
C **
C **  INPUT - 
C **        HR    = HORIZONTAL POSITION OF VORTEX MEASURED FROM 
C **                VEHICLE CENTERLINE
C **        VR    = VERTICAL POSITION OF VORTEX MEASURED FROM 
C **                VEHICLE CENTERLINE
C **        PHI   = ROLL ANGLE OF PANEL, DEG. FROM TOP VERTICAL CENTER
C **        RL    = LOCAL BODY RADIUS AT LIFTING SURFACE
C **        TAPER = TIP TO ROOT CHORD TAPER RATIO 
C **        SSPANW= EXPOSED SEMI-SPAN OF THE WING 
C **
C **  OUTPUT -
C **        VRINT = VORTEX INTERFERENCE FACTOR
C **
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C 
      REAL L
      DIMENSION L(2)
C **
      I=1
      DIST=0.310*(SSPANW+RL)
      VRINT=0.
      CPHI=COS(PHI/RAD)
      SPHI=SIN(PHI/RAD)
      S=RL+SSPANW
      SIGN=1.
      IF(HR .LT. 0.)SIGN=-1.
      HOR=HR
      VOR=VR
C **
C **  DELETE VORTEX INFLUENCE IF INSIDE BODY
C **
      IF(SQRT(HOR**2+VOR**2) .LE. RL)GO TO 1040
C **
C **  HORIZONTAL AND VERTICAL DISTANCES OF RIGHT HAND VORTEX
C **  FROM RIGHT HAND LIFTING SURFACE.
C **
C ** LOCATION OF PRIMARY VORTEX
C **
 1000 F=HOR*SPHI+VOR*CPHI
      H=VOR*SPHI-HOR*CPHI
C
C ... LIMIT VORTEX POSITION TO VORTEX CORE RADIUS FROM FIN
C ... METHOD FROM J.A.S. JANUARY, 1951, PAGE 23
C ... BY SPRIETER AND SACKS
C
      HSIGN=1.
      IF(H .LT. 0.)HSIGN=-1.
      IF(ABS(H) .LT. DIST)H=HSIGN*DIST
      GO TO 1020
 1010 F=HOR*SPHI+VOR*CPHI
      H=VOR*SPHI-HOR*CPHI
 1020 A=((S-RL*TAPER)-F*(1.-TAPER))/(2.*(S-RL))
      A=A*ALOG((H*H+(F-S)**2)/(H*H+(F-RL)**2))
      HH=H
      IF(H.EQ.0.0) HH=0.0001
      FS=(F-S)/HH
      FR=(F-RL)/HH
      AA=1.0
      IF(FS.LT.0.0) AA=-AA
      B=S-RL+H*ATAN(ABS(FS))*AA
      AA=1.0
      IF(FR.LT.0.0) AA=-AA
      B=B-H*ATAN(ABS(FR))*AA
      B=B*(1.-TAPER)/(S-RL)
      L(I)=A-B
      IF(I.EQ.2) GO TO 1030
C **
C **  LOCATION OF IMAGE VORTEX
C **
      Z2=VOR*VOR+HOR*HOR
      IF(Z2.EQ.0.0) Z2=.0001
      VOR=VOR*RL*RL/Z2
      HOR=HOR*RL*RL/Z2
      I=I+1
      GO TO 1010
 1030 VRINT=SIGN*(L(1)-L(2))*2./(1.+TAPER)
C
 1040 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ARCOR(DH,CDCIR)
C
C**********    2-D DRAG ON CIRCULAR CYLINDER FIG.3-28    **********
C***       (DATA FOR ELLIPTICAL/CIRCULAR CYL. SUBROUTINE)        **     
C
C  WRITTEN BY K. DETERS, MCDONNELL DOUGLAS
C
      REAL XARRAY(10),YARRAY(10)
      DATA (YARRAY(I), I=1,10) /1.21,1.08,1.0,.94,.864,.788,.75,
     * .727,.712,.712/
      DATA (XARRAY(I), I=1,10) /0.0,.02,.04,.06,.1,.2,.3,.4,.5,1.0/
      DATA NDIM,NAVAL,NXARR,NXVAL,IEXTRP /1,10,10,10,9/
      X=DH
      CALL TABLOK(NDIM,NAVAL,NXARR,NXVAL,XARRAY,YARRAY,X,Y,IEXTRP,
     *  IERR)
      CDCIR=Y
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BLUNT(BETA,IERROR,RP,X,R,NN1,VOVS,K,RR,DRB)
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  ORIGINAL ROUTINE WRITTEN BY F. MOORE, NSWC
C  MODIFIED BY J. JENKINS, WL/FIGC
C
C***  THIS ROUTINE COMPUTES THE GRID POINTS AND SLOPES FOR
C***  BLUNTED OR TRUNCATED NOSES
C
C***  INPUT PARAMETERS
C       BETA - MACH PARAMETER, SQRT(M**2-1)
C       X    - ARRAY OF BODY AXIAL COORDINATES, REFERED TO SHIFTED
C              ORIGIN
C       R    - ARRAY OF BODY RADIAL COORDINATES
C       VOVS - MACH NUMBER
C       DRB  - SLOPE OF NOSE CAP SHOULDER CONTOUR
C
C***  OUTPUT VARIABLES
C       IERROR - SET TO 1, IF NOSE CAP SHOULDER ANGLE IS GREATER
C                THAN MACH ANGLE
C       RP     - SLOPE AT TIP OF PSEUDO NOSE CAP
C       NN1    - NUMBER OF COORDINATE SETS ALONG THE PSEUDO NOSE
C       K      - EQUALS NN1-1
C       RR     - EQUALS R(1)/COS(TH1)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /VDARY/ XB(220),RB(220),RBP(220),C(220),C1(220),
     1 RB1(220),RBP1(220),B(220),PSI(220),ZE0X(220),PSIR(220),PHIX(220)
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      DIMENSION RP(6),X(50),R(50)
      LOGICAL FLAG1,FLAG2
C
      F=1.0
      VOV=VOVS
      IF(VOVS.LE.1.19) VOV=1.0001
      AMU=TAN(ASIN(1./VOV))*F
      IF(DRB.LE.AMU) GO TO 1000
C
C***  SLOPE AT SHOULDER IS .GT. MACH SLOPE ---  RETURN.
C
        IF(PARTS(18))WRITE(6,1090)
        IERROR=1
        GO TO 1070
C
 1000   IF(VOVS .GT. 2.1) GO TO 1020
C
C***  HERE FOR 1.1 .LT. MACH .LT. 2.1
C
          TH1=ATAN(DRB)
          THET1=27.5/RAD
          IF(THET1 .LE. TH1) GO TO 1010
C
C***  HERE FOR NON-CONICAL PSEUDO NOSE
C
            RR=R(1)/COS(TH1)
            XBR=R(1)*DRB
            XB(1)=XBR-RR/SIN(THET1)
            RB(1)=0.
            RBP(1)=TAN(THET1)
            RP(1)=RBP(1)
            XB(2)=XBR-RR*SIN(THET1)
            RB(2)=RR*COS(THET1)
            RBP(2)=RBP(1)
            FLAG1=.FALSE.
            GO TO 1030
C
C***  HERE FOR CONICAL PSEUDO-NOSE
C
 1010       XB(1)=-R(1)/DRB
            RB(1)=0.
            RBP(1)=DRB
            XB(2)=0.
            RB(2)=R(1)
            RBP(2)=DRB
            K=1
            NN1=2
            FLAG1=.TRUE.
            GO TO 1030
C
C***  HERE FOR MACH .GT. 2.1
C
 1020     TH1=ATAN(DRB)
          RR=R(1)/COS(TH1)
          XBR=R(1)*DRB
          XB(1)=XBR-RR*VOVS
          RB(1)=0.
          RBP(1)=1./BETA
          RP(1)=RBP(1)
          XB(2)=XBR-RR/VOVS
          RB(2)=RR*BETA/VOVS
          RBP(2)=RBP(1)
          FLAG1=.FALSE.
 1030   CONTINUE
        IF(FLAG1) GO TO 1070
C
C***  NOW CALCULATE DATA TO END OF PSEUDO NOSE
C
          DXB=-XB(2)/100.
          K=2
 1040     CONTINUE
          XB(K+1)=XB(K)+DXB
          RB(K+1)=SQRT(RR**2-(XBR-XB(K+1))**2)
          RBP(K+1)=(XBR-XB(K+1))/RB(K+1)
          IF(XB(K+1).GE.X(1)) GO TO 1050
            CALL LOOP(K,100,FLAG2)
            GO TO 1060
C
 1050       FLAG2=.FALSE.
 1060     CONTINUE
          IF(FLAG2) GO TO 1040
C
C***  EQUATE LAST DATA ON PSEUDO NOSE TO DATA AT START OF NOSE SECTION
C
          XB(K+1)=X(1)
          RB(K+1)=R(1)
          RBP(K+1)=DRB
          NN1=K+1
 1070   CONTINUE
C
 1090 FORMAT(4X,'*** NOSE CAP SHOULDER ANGLE GREATER THAN MACH ANGLE',
     1 ' HYBRID THEORY INVALID.',/,8X,'SECOND ORDER SHOCK EXPANSION',
     2 ' TO BE USED.')
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CONERR(GO,NOEXEC)
C
C***  CONERR --- INPUT ERROR CHECKING
C
C***  THE USER DATA IS READ FROM TAPE5, CHECKED AND WRITTEN TO TAPE1
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /PARTF/  PARTS(19)
      LOGICAL PARTS
      DIMENSION KOL(80), NUM(10), NEXT(9), NOGO(4)
      COMMON /INPCON/ LOC(11),LEN(11),NLNAME(56)
      COMMON /VARNAM/ LEN1(11),LDM1(11),FLTCON(45),
     1                LEN2( 9),LDM2( 9),REFQ(39),
     2                LEN3(34),LDM3(34),AXIBOD(152),
     3                LEN4(23),LDM4(23),FINSET(113),
     4                LEN5( 6),LDM5( 6),DEFLCT(34),
     5                LEN6(12),LDM6(12),TRIM(59),
     6                LEN7(35),LDM7(35),ELLBOD(152),
     7                LEN8(14),LDM8(14),INLET(47),
     8                LEN9(15),LDM9(15),EXPR(53),
     9                LEN10(11),LDM10(11),ARBBOD(57)
C
      INTEGER FLTCON,REFQ,AXIBOD,FINSET,DEFLCT,TRIM,ELLBOD,INLET,
     1        EXPR,ARBBOD
      LOGICAL NMTEST,END,NEXRED,GO,NOEXEC,SUBED
      CHARACTER*4 IAST,NOGO,NEXT,IBLANK,NUM,KOL,KAND,NLNAME
C
      DATA IAST /'*   '/
      DATA END / .TRUE. /
      DATA NOGO /'N   ','O   ','G   ','O   '/
      DATA NEXT   /'N   ','E   ','X   ','T   ','    ','C   ','A   ',
     1             'S   ','E   '/
      DATA NNAME / 11 /
C
      DATA IBLANK / '    ' /
      DATA NUM /'0   ','1   ','2   ','3   ','4   ','5   ','6   ',
     1          '7   ','8   ','9   '/
C
      IF(PARTS(17))CALL HEADR9
C
C***  READ ONE CARD AND CHECK TYPE -
C***           K = 1 FIRST CARD OF NAMELIST
C***           K = 2 CONTINUATION CARD IN NAMELIST
C***           K = 3 CONTROL CARD
C
      GO=.TRUE.
      END=.TRUE.
      SUBED=.FALSE.
      ISEQ=0
      REWIND 8
      IF(PARTS(17))WRITE(6,1160)
 1000 CONTINUE
      ISEQ=ISEQ+1
C
C***  FOLLOWING READ CARDS FOR FORTRAN IV
C
C     READ(5,1020) (KOL(I),I=1,80)
C     IF(EOF(5))1150,1010
 1010 CONTINUE
C
C***  FOLLOWING READ CARD FOR IBM MACHINES OR FORTRAN V
C
      READ(5,1020,END=1150) (KOL(I),I=1,80)
 1020 FORMAT(80A1)
C
C***  IGNORE BLANK CARDS
C
      DO 1030 I=1,80
         IF(KOL(I) .NE. IBLANK)GO TO 1040
 1030 CONTINUE
C
      IF(PARTS(17))WRITE(6,1220)ISEQ
C
      GO TO 1000
C
C***  IGNORE COMMENT CARDS ON INPUT, * IN COLUMN 1
C
 1040 CONTINUE
      IF(KOL(1) .EQ. IAST .AND. PARTS(17))
     1 WRITE(6,1230)ISEQ,(KOL(I),I=1,80)
      IF(KOL(1) .EQ. IAST)WRITE(8,1020)(KOL(I),I=1,80)
      IF(KOL(1) .EQ. IAST)GO TO 1000
C
C***  VALID CARD READ
C
      NEXRED=.FALSE.
      K = 2
C
C***  ADD BLANK IF KAND IN COLUMN 1
C
      IF(KOL(1) .EQ. KAND)CALL INSBLK(KOL,1,ISKP)
C
C***  SHIFT CARD COLUMNS FOR NAMELIST TO START IN COLUMN 2
C
      CALL PACK(KOL,END)
C
C***  DETERMINE IF NOGO CONTROL CARD READ
C
      DO 1050 I=1,4
         IF(KOL(I) .NE. NOGO(I))GO TO 1060
 1050 CONTINUE
      NOEXEC=.TRUE.
      IF(PARTS(17))WRITE(6,1230)ISEQ,(KOL(I),I=1,80)
      GO TO 1000
C
 1060 CONTINUE
C
      IF(KOL(2) .EQ. KAND)   K = 1
      IF(KOL(1) .NE. IBLANK) K = 3
      IF(KOL(2) .NE. KAND .AND. END) K = 3
C
C***  CHECK NAMELIST NAME IF K = 1
C
      L = 2
      IF(K .NE. 1) GO TO 1130
        IERR = 0
        DO 1110 NAME = 1,NNAME
           I = LOC(NAME)
           L = LEN(NAME)
           IF(.NOT. NMTEST(KOL(3),NLNAME(I),L)) GO TO 1110
C
C***       CHECK FOR NUMERIC INPUTS AFTER NAMELIST NAME
C
           IF(NAME .NE. 5) GO TO 1100
           L=L+1
           M=L+2
           MNUM = 0
 1070      DO 1080 J=1,10
              JVAL=J
              IF(KOL(M) .EQ. NUM(J)) GO TO 1090
 1080      CONTINUE
           IERR = 1
        GO TO 1110
 1090      M=M+1
           IF((JVAL.EQ.1.OR.JVAL.GT.5).AND.NAME.EQ.5)IERR=1
           IF((JVAL.EQ.1.OR.JVAL.GT.5).AND.NAME.EQ.5)GO TO 1110
 1100    CONTINUE
         IF(KOL(L+3) .EQ. IBLANK) GO TO 1120
C
C  INSERT BLANK AFTER NAMELIST NAME IF POSSIBLE
C
        CALL INSBLK(KOL,L+3,ISKP)
        IF(ISKP .EQ. 0)GO TO 1120
 1110   CONTINUE
        IERR = 1
 1120   L = L+3
 1130 CONTINUE
C
C***  CHECK NAMELIST VARIABLES IF K = 1 OR 2
C***  CHECK CONTROL CARD IF K = 3
C
      IF(K .LE. 2) CALL NMLIST(ISEQ,GO,END,KOL,L,NAME,K,IERR,SUBED)
      IF(K .EQ. 3) CALL CCARD(ISEQ,END,KOL)
      DO 1140 I=1,9
         IF(KOL(I).NE.NEXT(I))GO TO 1000
 1140 CONTINUE
      NEXRED=.TRUE.
      GO TO 1000
 1150 CONTINUE
      IF(.NOT.END .AND. PARTS(17))WRITE(6,1170)KAND
      IF(.NOT.END)WRITE(8,1180)KAND,(IBLANK,J=1,75)
      IF(.NOT.END)END=.TRUE.
      IF(.NOT.NEXRED .AND. PARTS(17))WRITE(6,1200)
      IF(.NOT.NEXRED)WRITE(8,1190)
      REWIND 8
C
C***  TERMINATE ON FATAL ERROR
C
      IF(.NOT. GO .AND. PARTS(17))WRITE(6,1210)
C
 1160 FORMAT(4X,/,4X,'CONERR - INPUT ERROR CHECKING',//
     1       4X,'ERROR CODES - N* DENOTES THE NUMBER OF ',
     2          'OCCURENCES OF EACH ERROR',/
     3       4X,'A - UNKNOWN VARIABLE NAME',/
     4       4X,'B - MISSING EQUAL SIGN FOLLOWING VARIABLE NAME',/
     5       4X,'C - NON-ARRAY VARIABLE HAS AN ARRAY ELEMENT',
     6          'DESIGNATION - (N)',/
     7       4X,'D - NON-ARRAY VARIABLE HAS MULTIPLE VALUES ASSIGNED',/
     8       4X,'E - ASSIGNED VALUES EXCEED ARRAY DIMENSION',/
     9       4X,'F - SYNTAX ERROR',//
     A       4X,'*************************',
     B          ' INPUT DATA CARDS ',
     C          '*************************',/)
 1170 FORMAT(4X,A1,'END',18X,'** MISSING NAMELIST TERMINATION ADDED **')
 1180 FORMAT(1X,A1,'END',75A1)
 1190 FORMAT(1X,'NEXT CASE')
 1200 FORMAT(4X,'NEXT CASE',18X,'** MISSING NEXT CASE CARD ADDED **')
 1210 FORMAT(8X,'FATAL ERROR ENCOUNTERED IN CONERR.  PROGRAM STOPPED')
 1220 FORMAT(4X,I3,' ** BLANK CARD - IGNORED')
 1230 FORMAT(I4,1X,80A1)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE DIHED(PHI,GAMMA)
C
C  THIS SUBROUTINE CALCULATES THE FIN DIHEDRAL ANGLE
C
C *** INPUTS ***
C
C    PHI - FIN ROLL ORIENTATION
C
C *** OUTPUT ***
C
C  GAMMA - DIHEDRAL ANGLE, DEG.
C
      PHIA = ABS(PHI)
      IF(PHIA .GT. 180.0) PHIA = 360.0-PHIA
      GAMMA = 90.0-PHIA
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCLMSH(DELY, SLE, MACH, SCLM, CLA, CLM, ACLM)
C ***
C *** COMPUTES SUBSONIC MAXIMUM LIFT AND ANGLE-OF-ATTACK
C *** FOR MAXIMUM LIFT FOR HIGH ASPECT RATIO WINGS
C ***
C *** REFERENCE   DATCOM SECTION 4.1.3.4
C ***             METHOD 2
C ***
C *** LIMITATIONS   MACH .LE. 0.6
C ***               AR .GE. 3.0/((C1+1)*COS(SLE))
C ***
C *** INPUT   DELY    DIFFERENCE IN AIRFOIL ORDINATE BETWEEN
C ***                 .15% AND 6% CHORD,PER CENT CHORD
C ***         SLE     LEADING EDGE SWEEP ANGLE, DEG
C ***         MACH    MACH NUMBER
C ***         SCLM    SECTION MAXIMUM LIFT COEFFICIENT
C ***         CLA     WING LIFT CURVE SLOPE
C ***
C *** OUTPUT  CLM     MAXIMUM LIFT COEFFICIENT,REFERENCED TO EXPOSED
C ***                 PLANFORM AREA OF TWO PANELS
C ***         ACLM    ANGLE-OF-ATTACK FOR CLM,DEGREES
C ***
C ***
C
      COMMON /CONST/PI,RAD,UNUSED,KAND
      DIMENSION SALE(13), DELTAY(7), CLL(91)
      DIMENSION AMACH(5), DYA(6), SALE4(4), DCAR(120)
      DIMENSION DY(4), DACLL(52)
      REAL MACH
C
C ***
C *** DATA STATEMENTS
C ***
      DATA DUM / 1.0 /
C
C     ----4.1.3.4-22
C
      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,
     1-.4,-.445 , 0.,-.21,-.36,-.45,-.5 , 0.,-.24,-.42,-.545,-.64 ,
     2-0.,-.24,-.455,-.605,-.72 , 0.,-.04,-.045,-.02,0. , 0.,-.095,-.165
     3,-.22,-.25 , 0.,-.105,-.19,-.26,-.29 , 0.,-.125,-.225,-.3,-.345 ,
     4 0.,-.15,-.265,-.37,-.45 , 0.,-.15,-.29,-.41,-.51 , 0.,-.04,-.07,
     5-.095,-.1 , 0.,-.043,-.080,-.108,-.123 , 0.,-.045,-.085,-.12,-.145
     6 , 0.,-.05,-.095,-.14,-.19 , 0.,-.07,-.125,-.19,-.26 , 0.,-.07,
     7-.14,-.215,-.3,4*0.,-.02,4*0.,-.022,4*0.,-.03,3*0.,-.02,-.07,2*0.,
     8-.02,-.055,-.085,0.,-.04,-.085,-.14,-.2/
C
C     ----4.1.3.4-21 A
C
      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
     1 , .9,.91,.92,.94,.96,.98,1.,1.02,1.05,1.08,1.11,1.15,1.19 ,   .9,
     2 .91,.92,.93,.94,.95,.96,.965,.975,.99,1.,1.01,1.03 , 6*.9, 2*.89,
     3.885,2*.88,.875,.87 , .9,.895,.89,.88,.87,.86,.85,.835,.82,.8,.78,
     4.755,.73 , .9,.89,.88,.87,.85,.83,.81,.79,.76,.725,.695,.65,.59 ,
     5 .9,.89,.87,.86,.84,.82,.795,.77,.73,.7,.65,.59,.52 /
C
C     ----4.1.3.4-21 B
C
      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,
     113.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,
     21.2,1.4,1.7,2.,2.4,2.85,3.35,3.7,4.25,4.7,5.3,5.9,6.65,
     32.2,2.1,2*2.,2.1,2.15,2.3,2.4,2.55,2.7,2.9,3.05,3.3/
C
C  LOOK UP RCLM, DACLM, DCLM
C
      XDELY = DELY
      IF(XDELY .LT. 1.4) XDELY = 1.4
      IF(XDELY .GT. 2.5) XDELY = 2.5
      CALL MVLOOK(1, 7, 13, 91, DUM, DELTAY, SALE, CLL, SLE, XDELY,
     1            1.0, RCLM)
      XDELY = DELY
      IF(XDELY .LT. 1.2) XDELY = 1.2
      CALL MVLOOK(1, 4, 13, 52, DUM, DY, SALE, DACLL, SLE, XDELY,
     1            1.0, DACLM)
C
C  REV 3/99 CORRECTION TO DELTA-CLMAX FOR THIN AIRFOILS
C  PREVENTS BAD VALUE FROM TABLE LOOK-UP
C
      IF(XDELY .LT. 2.0) XDELY = 2.0
      CALL MVLOOK(4, 6, 5, 120, SALE4, DYA, AMACH, DCAR, MACH, XDELY,
     1            SLE, DCLM)
C
      CLM  = RCLM*SCLM + DCLM
      ACLM = CLM/CLA + DACLM
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FORREA(IUNIT, NAME, COMBLK, II)
C
C***  FORCE A REAL PRINT ONTO UNIT IUNIT
C
C  IUNIT - OUTPUT UNIT NUMBER
C   NAME - ARRAY WHICH DEFINES THE NAMELIST VARIABLE NAME
C COMBLK - DATA FOR NAMELIST NAME
C     II - NUMBER OF ELEMENTS TO PRINT
C
      CHARACTER*4 NAME
      DIMENSION NAME(8),COMBLK(II)
C
      WRITE(IUNIT,1000)(NAME(I),I=1,8),(COMBLK(I),I=1,II)
C
      RETURN
C
 1000 FORMAT('0',8A1,8(G14.7,',')/(9X,8(G14.7,',')))
C
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ILTNWT(ICRX)
C
C     THIS SUBROUTINE COMPUTES THE RATIO OF NORMAL FORCE COEFFICIENT
C     ON AN ARBITRARY CROSS SECTION AND NORMAL FORCE COEFFICIENT ON
C     A CIRCULAR CROSS SECTION.  THIS VALUE CAN THEN BE USED TO APPLY
C     THE CIRCULAR CROSS FLOWDRAG COEFFICIENT TO NON-CIRCULAR CROSS
C     SECTIONS.
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
C                  *********************
C                  * INPUT/OUTPUT LIST *
C                  *********************
C
C
C     ***** INPUTS *****          ***** OUTPUTS *****
C
C           NPAN                        CNNIZP
C           ICRX                        CNNIZN
C           THETA                       CNNIYP
C           PI                          CNNIYN
C           HALFPI
C           DEQ
C           CRXIWD
C           CRXIHT
C           CNCIRN
C
C     SUBROUTINES USED: NONE
C
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      NUMI=NIN+0.5
      DO 100 INLET=1,NUMI
C
C       INITIALIZE SUMMING VARIABLES
        CNNIZP(ICRX,INLET) = 0.0
        CNNIZN(ICRX,INLET) = 0.0
        CNNIYP(ICRX,INLET) = 0.0
        CNNIYN(ICRX,INLET) = 0.0
C
C     BEGIN LOOP FOR EACH PANEL
        DO 110 IPAN = 1, 4
C
C          INITIALIZE NEWTONIAN PRESSURE COEFFICIENT FOR LEE SURFACES
C          OR WINDWARD SURFACES
           IF (COS(THETAI(IPAN,INLET)).LE.0.00001) THEN
             CPZP=-2.0*COS(THETAI(IPAN,INLET))**2
             CPZN=0.0
           ELSE
             CPZP=0.0
             CPZN=2.0*COS(THETAI(IPAN,INLET))**2
           ENDIF
C
C          INITIALIZE NEWTONIAN PRESSURE COEFFICIENT FOR LEE SURFACES
C          OR WINDWARD SURFACES
           IF (SIN(THETAI(IPAN,INLET)).GE.-0.00001) THEN
             CPYP=2.0*COS(THETAI(IPAN,INLET))**2
             CPYN=0.0
           ELSE
             CPYP=0.0
             CPYN=-2.0*COS(THETAI(IPAN,INLET))**2
           ENDIF
C
C          DETERMINE PANEL CONTRIBUTION TO NEWTONIAN CN
           CNNIZP(ICRX,INLET) = CNNIZP(ICRX,INLET) +
     1        CPZP * COS(THETAI(IPAN,INLET)) * PANILN(IPAN,ICRX,INLET)
           CNNIZN(ICRX,INLET) = CNNIZN(ICRX,INLET) +
     1        CPZN * COS(THETAI(IPAN,INLET)) * PANILN(IPAN,ICRX,INLET)
           CNNIYP(ICRX,INLET) = CNNIYP(ICRX,INLET) +
     1        CPYP * SIN(THETAI(IPAN,INLET)) * PANILN(IPAN,ICRX,INLET)
           CNNIYN(ICRX,INLET) = CNNIYN(ICRX,INLET) +
     1        CPYN * SIN(THETAI(IPAN,INLET)) * PANILN(IPAN,ICRX,INLET)
C
  110   CONTINUE
C
C       SET DEFAULTS FOR REFERENCE WIDTH AND HEIGHT
        REFWID = 1.0
        REFHGT = 1.0
C
C       USE MAXIMUM WIDTH IF NONZERO
        IF (CRXIWD(ICRX,INLET) .GT. 0.0) REFWID = CRXIWD(ICRX,INLET)
C
C       USE MAXIMUM HEIGHT IF NONZERO
        IF (CRXIHT(ICRX,INLET) .GT. 0.0) REFHGT = CRXIHT(ICRX,INLET)
C
C       NORMALIZE NEWTONIAN CN WRT REFERENCE HEIGHT AND WIDTH AND
C       NEWTONIAN CIRCULAR CN
        CNNIZP(ICRX,INLET) = CNNIZP(ICRX,INLET) / (REFWID * CNCIRN)
        CNNIZN(ICRX,INLET) = CNNIZN(ICRX,INLET) / (REFWID * CNCIRN)
        CNNIYP(ICRX,INLET) = CNNIYP(ICRX,INLET) / (REFHGT * CNCIRN)
        CNNIYN(ICRX,INLET) = CNNIYN(ICRX,INLET) / (REFHGT * CNCIRN)
C
  100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE MOMFOR(ALPHAR,BETAR,CNFLOW,CYFLOW)
C
C***********************************************************************
C
C     SUBROUTINE TO CALCULATE THE FORCE CODFFICIENT INCREMENT DUE TO
C     FLOW TURNING INTO THE INLET.
C
C***********************************************************************
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      AC = NIN*PI/4.*DEQI(2)**2.
C
      CNFLOW = 2.*AC*SIN(ALPHAR)/SREF
      CYFLOW = -2.*AC*SIN(BETAR)/SREF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RARBOD(LARBOD,AA)
C
C***  READ NAMELIST PROTUB USING THE NAMELIST EMULATOR
C
C***  THIS ROUTINE READS THE PROTUBERANCE NAMELIST AND SETS
C***  LARBOD EQUAL TO TRUE.  IN ROUTINE AERO, LOGICAL VARIABLE
C***  PROTUB IS SET TO TRUE IF LARBOD IS TRUE, WHICH TURNS ON THE
C***  PROTUBERANCE CALCULATIONS.
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION AA(881),LEN10(11),LDM10(11),LOC(11)
      DIMENSION IARBOD(57),NLNAME(6)
C
      LOGICAL LARBOD,IEOF
      CHARACTER*4 NLNAME,IARBOD,KAND
C
      DATA NLNAME/'P   ','R   ','O   ','T   ','U   ','B   '/
      DATA IARBOD /'P   ','R   ',
     B 'O   ','T   ','U   ','B   ','N   ','P   ','R   ','O   ','T   ',
     C 'P   ','T   ','Y   ','P   ','E   ','X   ','P   ','R   ','O   ',
     D 'T   ','N   ','L   ','O   ','C   ','B   ','L   ','D   ','M   ',
     E 'E   ','M   ','B   ','L   ','D   ','T   ','Y   ','P   ','L   ',
     F 'P   ','R   ','O   ','T   ','W   ','P   ','R   ','O   ','T   ',
     G 'H   ','P   ','R   ','O   ','T   ','O   ','P   ','R   ','O   ',
     H 'T   '/
      DATA LEN10 /6,5,5,5,4,6,6,5,5,5,5/
      DATA LDM10 /-1,1,20,20,20,20,100,100,100,100,100/
      DATA LOC   /300,301,302,322,342,362,382,482,582,682,782 /

C
      LARBOD=.TRUE.
C
      CALL NAMER(KAND,2,NLNAME,6,IARBOD,57,LEN10,11,LDM10,AA,881,
     1           LOC,IEOF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SPLN2(XTERM,XMULT)
C
C***  2ND ORDER POLYNOMIAL SPLINE ROUTINE
C
      X1=.75
      X2=2.0
      Y1=1.0
      Y2=.05
      DY2=.005
       IF (XTERM .GT. X2) THEN
       XMULT=Y2-XTERM*DY2
       ELSE
       A=(Y1-Y2)/(X2-X1)**2+DY2/(X2-X1)
       B=DY2-2.*X2*A
       C=Y1-A*X1**2-B*X1
       XMULT=A*XTERM**2+B*XTERM+C
       ENDIF
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WARBOD
C
C***  WRITE NAMELIST PROTUB USING THE NAMELIST EMULATOR
C
C***  THIS ROUTINE FILLS THE BODY COMMON BLOCK ABODIN
C***  WITH THE PROTUBERANCE VALUES READ IN THRU NAMELIST
C***  PROTUB
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /ABODIN/ ARBOD(881)
C
      CHARACTER*4 KAND,IARBOD,NLNAME
C
      DIMENSION LEN10(11),LDM10(11),LOC(11),IARBOD(57),NLNAME(6)
C
      DATA IARBOD /'P   ','R   ',
     B 'O   ','T   ','U   ','B   ','N   ','P   ','R   ','O   ','T   ',
     C 'P   ','T   ','Y   ','P   ','E   ','X   ','P   ','R   ','O   ',
     D 'T   ','N   ','L   ','O   ','C   ','B   ','L   ','D   ','M   ',
     E 'E   ','M   ','B   ','L   ','D   ','T   ','Y   ','P   ','L   ',
     F 'P   ','R   ','O   ','T   ','W   ','P   ','R   ','O   ','T   ',
     G 'H   ','P   ','R   ','O   ','T   ','O   ','P   ','R   ','O   ',
     H 'T   '/
      DATA LEN10 /6,5,5,5,4,6,6,5,5,5,5/
      DATA LDM10 /-1,1,20,20,20,20,100,100,100,100,100/
      DATA LOC   /300,301,302,322,342,362,382,482,582,682,782 /

C
      CALL NAMEW(KAND,6,NLNAME,6,IARBOD,57,LEN10,11,LDM10,
     1           ARBOD,881,LOC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION ARSECH(Z)
C
C***  COMPUTE THE INVERSE HYPERBOLIC SECANT
C
      ARSECH=ALOG(1./Z+SQRT(1./Z**2-1.))
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BLUNTN(X1,Y1,X2,Y2,X,B,RO,Y,DYDX,D2YDX2,DEL,SD,CD)
C
C  SUBROUTINE TO FIT THE BLUNTED NOSE WITH AN ELLIPSE AND SOLVE FOR
C  THE LOCAL RADIUS AT THE INPUT STATION
C
C  FIT IS OF THE FORM
C        Y**2 = 2*RO*X + B*X**2
C        DRDX = (RO + B*X)/Y
C      D2RDX2 = (B - DRDX**2)/Y
C
C
C  INPUTS
C
C     X1 -- X COORDINATE OF FIRST POINT ON THE BODY
C     Y1 -- Y COORDINATE OF FIRST POINT ON THE BODY
C     X2 -- X COORDINATE OF THE SECOND POINT ON THE BODY
C     Y2 -- Y COORDINATE OF THE SECOND POINT ON THE BODY
C      X -- DESIRED X STATION FOR RESULTS
C
C  OUTPUTS
C
C      B -- SECOND DERIVATIVE OF FIT
C     RO -- FIRST DERIVATIVE OF FIT
C      Y -- RADIUS AT X
C   DYDX -- SLOPE AT X
C D2YDX2 -- SECOND DERIVATIVE AT X
C    DEL -- ANGULAR SLOPE AT X
C     SD -- SINE OF ANGULAR SLOPE
C     CD -- COSINE OF ANGULAR SLOPE
C
C  ROUTINES CALLED -- NONE
C
      RO=0.
      Y=0.
      DYDX=0.
      D2YDX2=0.
      IF(X1.EQ.0.)GO TO 1000
C
         RO=(X2**2*Y1**2-X1**2*Y2**2)/(2.*X1*X2*(X2-X1))
C
         B=(Y1**2/X1-2.*RO)/X1
C
         Y=SQRT(2.*RO*X+B*X**2)
C
         IF(Y.NE.0.)DYDX=(RO+B*X)/Y
         IF(Y.EQ.0.)DYDX=1.E+10
C
         IF(Y.NE.0.)D2YDX2=(B-DYDX**2)/Y
         IF(Y.EQ.0.)D2YDX2=1.E+10
C
 1000 DEL=ATAN(DYDX)
      SD=SIN(DEL)
      CD=COS(DEL)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CONIC(AA,NX,X,R,BNOSE,TRUNC,LENGTH,DIAM,DISCON)
C
C***  COMPUTE THE CHARACTERISTICS OF A CONIC SEGMENT
C
C***  INPUTS
C
C     NX -- NUMBER OF INPUT POINTS
C      X -- X STATIONS
C      R -- RADII AT EACH X STATION
C  BNOSE -- FORWARD RADIUS OF SECTION
C  TRUNC -- TRUNCATED FLAG (.TRUE. IF TRUNCATED NOT BLUNTED)
C LENGTH -- SECTION LENGTH
C   DIAM -- SECTION BASE DIAMETER
C
C***  OUTPUTS
C
C     AA -- ARRAY OF CHARACTERISTICS TO BE COMPUTED
C           AA(1)=PLANFORM AREA
C           AA(2)=WETTED AREA
C           AA(3)=VOLUME
C           AA(4)=VOLUME CENTROID
C           AA(5)=PLANFORM CENTROID
C           AA(6)=FINENESS RATIO
C           AA(7)=THEORETICAL LENGTH
C           AA(8)=THEORETICAL FINENESS RATIO
C DISCON -- ELEMENTS WHICH HAVE DISCONTINUOUS SLOPES
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION AA(8),X(50),R(50),XX(101),RR(101),DISCON(20)
C
      REAL NX,LENGTH
      LOGICAL TRUNC
C
C***  SET DISCONTINUOUS POINT FOR FIRST POINT IF NOSE IS TRUNCATED
C
      IF (TRUNC.AND.INT(NX+0.5).EQ.0) DISCON(1)=1.0
C
C***  SKIP PRIMARY CALCULATIONS FOR HEMISPHERICAL CAP
C
      IF(2.*BNOSE .GE. DIAM .AND. .NOT. TRUNC)GO TO 1070
C
C***  COMPUTE GEOMETRY AT 101 POINTS
C
      NPTS=101
      IF(.NOT. TRUNC .AND. BNOSE .GT. UNUSED)NPTS=51
C
      FR=LENGTH/DIAM
      IF(DIAM .LE. 2.*BNOSE)FR=LENGTH/(2.*BNOSE)
C
C  DO NOT DUPLICATE LAST POINT FOR THIS SEGMENT
C
      IF(NX .GT. UNUSED)NX=NX-1.
      NNX=NX+0.5
      XO=0.
      IF(NX .GT. UNUSED)XO=X(NNX+1)
C
      XT=0.
      YT=BNOSE
C
C***  SURFACE X AND R COORDINATES
C
C  BLUNTED NOSE
C
      ILAST=0
      IF(TRUNC .OR. BNOSE .LE. UNUSED)GO TO 1010
C
C  POINT OF TANGENCY OF BLUNTED NOSE
C
C  LENGTH FROM BASE TO CAP CENTER
C
      AL1=LENGTH-BNOSE
C
C  SLANT LENGTH FROM BASE RADIUS TO CAP CENTER
C
      ALD=SQRT(AL1**2+(DIAM/2.)**2)
C
C  SLANT LENGTH FROM BASE RADIUS TO CAP RADIUS
C
      ALS=SQRT(AL1**2+(DIAM/2.)**2-BNOSE**2)
C
C  ANGLE BETWEEN CAP CENTER AND BASE RADIUS
C
      PHI=ATAN(DIAM/(2.*AL1))
C
C  ANGLE BETWEEN ALD AND ALS
C
      DELTA=ASIN(BNOSE/ALD)
C
C  ANGLE OF CONICAL SURFACE (0=CYLINDER)
C
      THETA=PHI-DELTA
C
C  SLOPE OF CONICAL SURFACE
C
      SLOPE=TAN(THETA)
      IF(BNOSE .GT. UNUSED .AND. TRUNC)
     1   SLOPE=(DIAM-2.*BNOSE)/2./LENGTH
C
C  DISTANCE FROM ACTUAL NOSE TIP TO TANGENCY
C
      XT=BNOSE-BNOSE*SIN(THETA)
C
C  RADIUS AT TANGENCY
C
      YT=BNOSE*COS(THETA)
C
C  GET THEORETICAL LENGTH
C
      IF(SLOPE .NE. 0.)THEOL=ABS(DIAM/2./SLOPE)
      IF(SLOPE .NE. 0. .AND. BNOSE .GT. DIAM/2.)THEOL=ABS(BNOSE/SLOPE)
      IF(SLOPE .EQ. 0.)THEOL=LENGTH
C
      DO 1000 I=1,NPTS
         XX(I)=FLOAT(I-1)*XT/FLOAT(NPTS-1)
         RR(I)=SQRT(BNOSE**2-(XX(I)-BNOSE)**2)
         XX(I)=XX(I)+THEOL-LENGTH
 1000 CONTINUE
C
      XO=XX(NPTS)
C
      ILAST=NPTS-1
C
 1010 CONTINUE
C
C  THEORETICAL LENGTH OF SHARP CONIC
C
      SLOPE=(DIAM/2.-YT)/(LENGTH-XT)
      IF(BNOSE .GT. UNUSED .AND. TRUNC)
     1   SLOPE=(DIAM-2.*BNOSE)/2./LENGTH
      IF(SLOPE .NE. 0.)THEOL=ABS(DIAM/2./SLOPE)
      IF(SLOPE .NE. 0. .AND. BNOSE .GT. DIAM/2.)THEOL=ABS(BNOSE/SLOPE)
      IF(SLOPE .EQ. 0.)THEOL=LENGTH
C
C  THEORETICAL FINENESS RATIO
C
      FF=THEOL/DIAM
      IF(DIAM .LE. 2.*BNOSE)FF=THEOL/(2.*BNOSE)
C
C  ON SHAPED SEGMENT
C
      DO 1020 I=1,NPTS
         L=I+ILAST
         XX(L)=(LENGTH-XT)/FLOAT(NPTS-1)*FLOAT(I-1)
         RR(L)=YT+SLOPE*XX(L)
         XX(L)=XX(L)+XO
 1020 CONTINUE
C
C***  EXTRACT EVERY TENTH POINT FOR OUTPUT AND SUBSEQUENT CALCS.
C
      II=0
      DO 1030 I=1,101,10
         II=II+1
         L=II+NNX
         X(L)=XX(I)
         R(L)=RR(I)
 1030 CONTINUE
C
C  UPDATE POINT TOTAL
C
      NX=NX+FLOAT(II)
C
C  PLANFORM AREA
C
      SP=DSPLAN(101,XX,RR)
C
C  WETTED AREA
C
      SW=DSWET(101,XX,RR)
C
C  VOLUME
C
      VOL=DVOL(101,XX,RR)
C
C  VOLUME CENTROID
C
      XCENV=DXCENV(101,XX,RR)
C
C  PLANFORM AREA CENTROID
C
      XCENP=DXCENP(101,XX,RR)
C
C  STORE FOR RETURN TO CALLING ROUTINE
C
      AA(1)=SP
      AA(2)=SW
      AA(3)=VOL
      AA(4)=XCENV
      AA(5)=XCENP
      AA(6)=FR
      AA(7)=THEOL
      AA(8)=FF
C
C  SET DISCONTINUOUS POINTS
C
      DO 1040 I=1,20
         JJ=I
         IF(DISCON(I).EQ.UNUSED)GO TO 1050
 1040 CONTINUE
      GO TO 1060
C
C  END OF SEGMENT IS DISCONTINUOUS
C
 1050    DISCON(JJ)=NX
 1060 CONTINUE
C
      GO TO 1080
C
C***  HERE FOR SPHERICAL CAP
C
 1070 CONTINUE
C
      IF(LENGTH .GT. BNOSE)LENGTH=BNOSE
C
      CALL SPHERE(AA,NX,X,R,DIAM)
C
 1080 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE DISC2(I,JH,BETA,SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,NTERM,
     1   ORDER)
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  ORIGINAL ROUTINE WRITTEN BY F. MOORE, NSWC
C  MODIFIED BY J. JENKINS, WL/FIGC
C
      COMMON /VDARY/ XB(220),RB(220),RBP(220),C(220),C1(220),RB1(220),
     1  DUMMY(1320)
      COMMON /VANVAR/PHIR(220),ZE1(220),ZE1X(220),ZE1R(220),
     1              T(100),AK(100),AE(100),C3
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      INTEGER ORDER
      DIMENSION TT(100),AKT(100),AET(100)
      DATA TT /
     1 .01000, .02000, .03000, .04000, .05000, .06000, .07000, .08000,
     2 .09000, .10000, .11000, .12000, .13000, .14000, .15000, .16000,
     3 .17000, .18000, .19000, .20000, .21000, .22000, .23000, .24000,
     4 .25000, .26000, .27000, .28000, .29000, .30000, .31000, .32000,
     5 .33000, .34000, .35000, .36000, .37000, .38000, .39000, .40000,
     6 .41000, .42000, .43000, .44000, .45000, .46000, .47000, .48000,
     7 .49000, .50000, .51000, .52000, .53000, .54000, .55000, .56000,
     8 .57000, .58000, .59000, .60000, .61000, .62000, .63000, .64000,
     9 .65000, .66000, .67000, .68000, .69000, .70000, .71000, .72000,
     A .73000, .74000, .75000, .76000, .77000, .78000, .79000, .80000,
     B .81000, .82000, .83000, .84000, .85000, .86000, .87000, .88000,
     C .89000, .90000, .91000, .92000, .93000, .94000, .95000, .96000,
     D .97000, .98000, .99000,1.00000/
      DATA AKT /
     13.35902,3.02571,2.83492,2.70218,2.60107,2.51987,2.45234,2.39475,
     22.34473,2.30064,2.26132,2.22592,2.19380,2.16445,2.13748,2.11257,
     32.08946,2.06794,2.04782,2.02896,2.01123,1.99451,1.97871,1.96376,
     41.94957,1.93608,1.92324,1.91099,1.89929,1.88811,1.87740,1.86713,
     51.85727,1.84780,1.83870,1.82993,1.82148,1.81331,1.80547,1.79787,
     61.79053,1.78343,1.77655,1.76989,1.76344,1.75718,1.75111,1.74521,
     71.73948,1.73392,1.72851,1.72324,1.71812,1.71313,1.70827,1.70354,
     81.69892,1.69442,1.69003,1.68575,1.68157,1.67748,1.67350,1.66960,
     91.66579,1.66206,1.65842,1.65485,1.65137,1.64795,1.64461,1.64133,
     A1.63813,1.63499,1.63191,1.62889,1.62593,1.62303,1.62018,1.61739,
     B1.61465,1.61196,1.60932,1.60672,1.60418,1.60168,1.59922,1.59680,
     C1.59443,1.59210,1.58981,1.58755,1.58534,1.58316,1.58101,1.57890,
     D1.57683,1.57479,1.57278,1.570796/
      DATA AET /
     11.02836,1.04970,1.06835,1.08526,1.10085,1.11541,1.12909,1.14204,
     21.15433,1.16606,1.17727,1.18802,1.19835,1.20828,1.21786,1.22711,
     31.23604,1.24469,1.25307,1.26119,1.26907,1.27672,1.28416,1.29139,
     41.29843,1.30528,1.31196,1.31847,1.32482,1.33102,1.33707,1.34298,
     51.34875,1.35439,1.35991,1.36531,1.37059,1.37575,1.38082,1.38577,
     61.39063,1.39539,1.40005,1.40463,1.40911,1.41351,1.41783,1.42207,
     71.42623,1.43032,1.43433,1.43827,1.44214,1.44594,1.44968,1.45336,
     81.45697,1.46053,1.46402,1.46746,1.47085,1.47417,1.47745,1.48068,
     91.48385,1.48698,1.49006,1.49309,1.49607,1.49902,1.50192,1.50477,
     A1.50759,1.51036,1.51310,1.51579,1.51845,1.52107,1.52366,1.52621,
     B1.52872,1.53121,1.53365,1.53607,1.53845,1.54081,1.54313,1.54542,
     C1.54769,1.54992,1.55213,1.55430,1.55646,1.55858,1.56068,1.56275,
     D1.56480,1.56682,1.56882,1.570796/
C
      DO 800 II=1,100
      T(II)=TT(II)
      AK(II)=AKT(II)
      AE(II)=AET(II)
  800 CONTINUE
C
      XI=XB(JH)-BETA*RB(JH)
      TAU=BETA*RB(I)/(XB(I)-XI)
      IF(TAU.GE.1.) TAU=0.9999
C
C ... LOOK-UP COMPLETE ELLIPTIC INTEGRAL OF THE FIRST KIND
C
      CALL INTERP(T,AK,TAU,AKX,100,3)
C
C ... LOOK-UP COMPLETE ELLIPTIC INTEGRAL OF THE SECOND KIND
C
      CALL INTERP(T,AE,TAU,AEX,100,3)
      A=SQRT(XB(I)-XI)
      B=SQRT(1.+TAU)
      D=2.**1.5/PI
      E=ABS(RBP(JH)-RBP(JH-1))
      IF(ORDER .GT. 1) GO TO 1030
C
C ... FIRST ORDER SOLUTION
C       CURVATURE SOLUTION
C
        A1=C(JH)*SQRT(BETA*RB(JH))
        SUM1=SUM1-A1*A**1.5*4./9.*D*B*((3.+TAU)*AKX-4.*AEX)
        SUM2=SUM2-A1*A*2.*D*B*(AKX-AEX)
        SUM3=SUM3+A1*BETA*A*2./3.*D*B*(AEX/TAU-AKX)
        IF(NTERM .GT. 0 .AND. NTERM .LT. 6) GO TO 900
          SUM4=SUM4-A1/A*D*AKX/B
          SUM5=SUM5+A1*BETA/A*D/B*((1.+TAU)/TAU*AEX-AKX)
          SUM6=SUM6-A1*BETA**2/A*D/B*(2.*(1.+TAU)/TAU**2*AEX-(2.-TAU)/
     1    TAU*AKX)/3.
  900   CONTINUE
        IF(E.LT.0.0001) GO TO 1050
C
C      CORNER SOLUTION
C
          A2=A**2
          F=SQRT(RB(JH)/RB(I))/PI
          G=SQRT(2.*TAU)/B
          IF(TAU.GT.0.9999) GO TO 1000
            H=1./(1.-TAU)
 1000     H1=C(JH)
          SUM1 = SUM1-H1*4.*A2*F*B**2*G*(AKX-AEX)
          SUM2 = SUM2-H1*2.*F*G*AKX
          SUM3 = SUM3+H1*2.*BETA*F*G*(B**2*AEX/TAU-AKX)
          IF(NTERM .GT. 0 .AND. NTERM .LT. 6) GO TO 1050
            IF(TAU.LT.0.9999) GO TO 1010
              SUM4=SUM4+H1/(8.*BETA*RB(JH))
              SUM5=SUM5+3.*H1/(8.*RB(JH))
              SUM6=SUM6-7.*BETA*H1/(8.*RB(JH))
              GO TO 1050
 1010         SUM4 = SUM4+H1*F/A2*H*G*(AKX-AEX)
              SUM5 = SUM5+H1*BETA*F/A2*H*G*(AEX/TAU-AKX)
              SUM6 = SUM6-H1*BETA**2/A2*F*H*G*((2.-TAU**2)/TAU**2*AEX-
     1          (2.-TAU)/TAU*AKX)
              GO TO 1050
C
C     HERE IF 2-ND ORDER
C       CUVATURE SOLUTION
 1030   F=SQRT(RB(JH)/RB(I))/PI
        G=SQRT(2.*TAU)/B
        A2=A**2
        H1=C1(JH)*F*G
        SUM1=SUM1-H1*4.*A2*B**2*(AKX-AEX)
        SUM2=SUM2-H1*2.*AKX
        SUM3=SUM3+H1*2.*BETA*(B**2*AEX/TAU-AKX)
        IF(E.LT.0.0001) GO TO 1050
C
C           CORNER SOLUTION
C
          H2=C1(JH)*D*B*SQRT(BETA*RB(JH))
          SUM1=SUM1-H2*A**1.5*4./9.*((3.+TAU)*AKX-4.*AEX)
          SUM2=SUM2-H2*A*2.*(AKX-AEX)
          SUM3=SUM3+H2*BETA*A*2./3.*(AEX/TAU-AKX)
          SUM1=SUM1+C3*2.*G*F*AKX
          IF(TAU.LT.0.995) GO TO 1040
            SUM2=SUM2-C3/(8.*BETA*RB(JH))
            SUM3=SUM3-3.*C3/(8.*RB(JH))
            GO TO 1050
C
C        HERE IF TAU LESS THAN 0.995
C
 1040       H=1./(1.-TAU)
            SUM2=SUM2-C3/A2*F*H*G*(AKX-AEX)
            SUM3=SUM3-C3*BETA/A2*F*H*G*(AEX/TAU-AKX)
 1050 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCNA(MACH, AR, FINTPR, SWAVLE, SWAV50, SWAVTE,
     1                DEL, SECCLA, SPLAN, SREF, CNA)
C ***
C *** COMPUTES FIN ALONE LINEAR NORMAL FORCE CURVE SLOPE PER DEG
C ***
C *** REFERENCES  DATCOM SECTION 4.1.3.2
C ***             RAS DATA SHEETS
C ***
C *** INPUT   MACH    MACH NUMBER
C ***         AR      EXPOSED FIN ASPECT RATIO FOR TWO PANELS
C ***         FINTPR  EXPOSED FIN TAPER RATIO
C ***         SWAVLE  LEADING EDGE SWEEP ANGLE, DEGREES
C ***         SWAV50  HALF CHORD FIN SWEEP ANGLE, DEGREES
C ***         SWAVTE  TRAILING EDGE SWEEP ANGLE, DEGREES
C ***         DEL     LEADING EDGE SEMI-WEDGE ANGLE, DEGREES
C ***         SECCLA  SECTION LIFT COEFFICIENT PER RADIAN
C ***         SPLAN   EXPOSED PLANFORM AREA OF TWO PANELS
C ***         SREF    REFERENCE AREA
C ***
C *** OUTPUT  CNA     FIN NORMAL FORCE CURVE SLOPE REFERENCED
C ***                 TO SREF, PER DEGREE
C ***
C ***
      COMMON /CONST/PI,RAD,UNUSED,KAND
      REAL MACH
C
C ***
C *** SUBSONIC   (FCNASB)  MACH .LE. 0.60            DATCOM SEC 4.1.3.2
C *** TRANSONIC  (FCNATR)  0.60 .LT. MACH .LT. 1.40  RAS DATA SHEETS
C *** SUPERSONIC (FCNASP)  MACH .GE. 1.40            DATCOM SEC 4.1.3.2
C ***
      IF(MACH .LE. 0.60) CALL FCNASB(SWAV50, AR, SECCLA, MACH, CNA)
      IF((MACH .GT. 0.60) .AND. (MACH .LT. 1.40)) CALL FCNATR(MACH, AR,
     *                   FINTPR, SWAV50, CNA, CPFLTR)
      IF(MACH .GE. 1.40 .AND. SWAVLE .GE. 0.)
     * CALL FCNASP(MACH, FINTPR, AR, SWAVLE, DEL, CNA)
      IF(MACH .GE. 1.40 .AND. SWAVLE .LT. 0.)
     * CALL FCNASP(MACH, FINTPR, AR, ABS(SWAVTE), DEL, CNA)
C ***
      CNA = CNA*SPLAN/SREF
C ***
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FPART9(IM,NSET,NALP,ALPHA,XCPL,XCPNL,XCG,LREF,
     1 CML,CMNL,CM,XO,CNA,CNL,CNNL,CN)
C
C***  FORTRAN 90 VERSION
C***  PRINT FIN SET PARTIAL OUTPUT FOR NORMAL FORCE
C***  AND PITCHING MOMENT
C
      DIMENSION ALPHA(20),CML(20),CMNL(20),CM(20)
      DIMENSION CNL(20),CNNL(20),CN(20)
C
      REAL LREF
C
      LOGICAL NA,NM,ND
C
      DXCPL=((XCG-XO)-XCPL)/LREF
      DXCPNL=((XCG-XO)-XCPNL)/LREF
C
      CALL HEADR9
      WRITE(6,1010)NSET
      CALL PRFLC9(IM,NA,NM,ND)
      WRITE(6,1020) CNA,DXCPL,DXCPNL
C
      WRITE(6,1030)
C
      DO 1000 I=1,NALP
         WRITE(6,1040) ALPHA(I),CNL(I),CNNL(I),CN(I),
     1                 CML(I),CMNL(I),CM(I)
 1000 CONTINUE
C
 1010 FORMAT(23X,'FIN SET',I2,' CN, CM PARTIAL OUTPUT',/)
 1020 FORMAT(4X,'NORMAL FORCE SLOPE AT ALPHA ZERO, CNA =',F11.5,
     1          '/DEG (1 PANEL)',/,
     2       4X,'     CENTER OF PRESSURE FOR LINEAR CN =',F11.5,
     3          ' (CALIBERS FROM C.G.)',/,
     4       4X,' CENTER OF PRESSURE FOR NON-LINEAR CN =',F11.5,
     5          ' (CALIBERS FROM C.G.)',/)
 1030 FORMAT(4X,2X,'ALPHA',6X,'CN',8X,'CN',8X,'CN',8X,'CM',
     2  8X,'CM',8X,'CM',/,15X,'LINEAR',2X,'NON-LINEAR',2X,'TOTAL',
     3  5X,'LINEAR',2X,'NON-LINEAR',2X,'TOTAL',/)
 1040 FORMAT(4X,F7.2,6F10.4)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
       SUBROUTINE ILTRVX(NSTEP,X,R)
C***********************************************************************
C
C     THIS SUBROUTINE RESOLVES THE CROSS SECTIONAL AREAS OF THE INLET
C     DIVERTER COMBINATION INTO R VS X VALUES FOR USE BY THE SUBROU-
C     TINE CDPRESS.
C
C***********************************************************************
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      DIMENSION XTEMP1(50),XTEMP2(50),AREA(50),RTEMP1(50),
     1                            RTEMP2(50),X(200),R(200)
C
      IF(HDIV .GT. 0.0)THEN
        K = 1
        JJ = 1
    5   CONTINUE
        IF (XI(JJ).LT.XD(1)) THEN
          XTEMP1(K) = XI(JJ)
          AREA(K) = AREAI(JJ)
          JJ = JJ + 1
          K = K + 1
          GO TO 5
        ENDIF
        DO 20 J = JJ-1, 4
          DO 10 I = 1, 2
            IF (XD(I).GT.XI(J).AND.XD(I).LT.XI(J+1)) THEN
              XTEMP1(K) = XD(I)
              AREA(K) = AREAD(I) + (AREAI(J) + ((XD(I)-XI(J))/
     1  (XI(J+1)-XI(J)))**2.*(AREAI(J+1)-AREAI(J)))
              K = K +1
            ELSEIF (XI(J).GT.XD(I).AND.XI(J).LT.XD(I+1)) THEN
              XTEMP1(K) = XI(J)
              AREA(K) = AREAI(J) + (AREAD(I) + ((XI(J)-XD(I))/
     1  (XD(I+1)-XD(I)))**2.*(AREAD(I+1)-AREAD(I)))
              K = K +1
            ELSEIF (XI(J).EQ.XD(I)) THEN
              XTEMP1(K) = XI(J)
              XTEMP1(K+1) = XD(I)
              AREA(K) = AREAI(J) + AREAD(I)
              AREA(K+1) = AREAI(J) + AREAD(I)
              K = K + 2
            ENDIF
   10     CONTINUE
   20   CONTINUE
        XTEMP1(7) = XI(5)
        AREA(7) = AREAI(5) + AREAD(3)
      ENDIF
C
C     WHEN THERE IS NO DIVERTER, ADD A SECTION MID-WAY BETWEEN 
C     INPUT SECTIONS 2 AND 3 AS WELL AS 4 AND 5 TO MATCH THE NUMBER
C     OF SECTIONS IN XTEMP1 WHEN THERE IS A DIVERTER
C
      IF(HDIV .LE. 0.0)THEN
        J = 1
        DO 25 I=1,7
          IF(I.NE.3 .AND. I.NE.6)THEN
            XTEMP1(I) = XI(J)
            AREA(I)   = AREAI(J)
            J = J+1
          ENDIF
   25   CONTINUE
        RTMPL = SQRT(ABS(AREAI(2))/PI)
        IF(AREAI(2) .LT. 0.0)RTMPL = -RTMPL
        RTMPH = SQRT(ABS(AREAI(3))/PI)
        IF(AREAI(3) .LT. 0.0)RTMPH = -RTMPH
        RAVE  = 0.5*(RTMPL + RTMPH)
        AREA(3) = PI*RAVE**2
        XTEMP1(3) = XI(2) + 0.5*(XI(3) - XI(2))
C
        RTMPL = SQRT(ABS(AREAI(4))/PI)
        IF(AREAI(4) .LT. 0.0)RTMPL = -RTMPL
        RTMPH = SQRT(ABS(AREAI(5))/PI)
        IF(AREAI(5) .LT. 0.0)RTMPH = -RTMPH
        RAVE  = 0.5*(RTMPL + RTMPH)
        AREA(6) = PI*RAVE*ABS(RAVE)
        XTEMP1(6) = XI(4) + 0.5*(XI(5) - XI(4))
      ENDIF
C
C     CALCULATE RADIUS FROM THE GIVEN AREA, REMOVE COINCIDENT POINTS,
C     AND INSERT NEW POINTS BETWEEN THE CROSS SECTIONS.
C
      DO 30 I=1,7
        RTEMP1(I)=SQRT(ABS(AREA(I)/PI))
        IF (AREA(I).LT.0.0) RTEMP1(I)=-RTEMP1(I)
   30 CONTINUE
      MCOUNT = 7
      DO 50 I=1,5
        IF (RTEMP1(I).EQ.RTEMP1(I+1)) THEN
          II = I
          K = I+1
          DO 40 J=II,5
            XTEMP1(K)=XTEMP1(K+1)
            RTEMP1(K)=RTEMP1(K+1)
            K = K+1
   40     CONTINUE
          XTEMP1(K)=0.0
          RTEMP1(K)=0.0
          MCOUNT = MCOUNT - 1
        ENDIF
   50 CONTINUE
      K = 1
      DO 60 I=1,MCOUNT-1
        XTEMP2(K)=XTEMP1(I)
        XTEMP2(K+1)=XTEMP1(I)+0.25*(XTEMP1(I+1)-XTEMP1(I))
        XTEMP2(K+2)=XTEMP1(I)+0.50*(XTEMP1(I+1)-XTEMP1(I))
        XTEMP2(K+3)=XTEMP1(I)+0.75*(XTEMP1(I+1)-XTEMP1(I))
        RTEMP2(K)=RTEMP1(I)
        RTEMP2(K+1)=RTEMP1(I)+0.25*(RTEMP1(I+1)-RTEMP1(I))
        RTEMP2(K+2)=RTEMP1(I)+0.50*(RTEMP1(I+1)-RTEMP1(I))
        RTEMP2(K+3)=RTEMP1(I)+0.75*(RTEMP1(I+1)-RTEMP1(I))
        K = K+4
   60 CONTINUE
      XTEMP2(K) = XTEMP1(MCOUNT)
      RTEMP2(K) = RTEMP1(MCOUNT)
      DO 70 I=1,K
        IF (RTEMP2(I).GT.0.0) GO TO 80
   70 CONTINUE
   80 CONTINUE
      M = 1
      DO 90 N=I-1,K
       IF (RTEMP2(N).LT.0.0) GO TO 100
        X(M)=XTEMP2(N)
        R(M)=RTEMP2(N)
        M = M+1
   90 CONTINUE
  100 CONTINUE
      NSTEP = M-1
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE MVLOOK(KGRAPH,KCURVE,KPOINT,NPTS,FGRAPH,FCURVE,
     1 XCURVE,YCURVE,ARGX,ARGCUR,ARGGPH,ANS)
C
C***  SUBROUTINE TO PERFORM A MULTI-VARIABLE TABLE LOOKUP
C
C***  INPUTS
C
C KGRAPH -- NUMBER OF GRAPHS IN SET
C KCURVE -- NUMBER OF CURVES ON EACH GRAPH
C KPOINT -- NUMBER OF POINTS ON EACH CURVE
C   NPTS -- TOTAL NUMBER OF POINTS, KGRAPH*KCURVE*KPOINT
C FGRAPH -- TABLE GIVING VALUES FOR EACH GRAPH
C FCURVE -- TABLE GIVING VALUES FOR EACH CURVE
C XCURVE -- TABLE OF X VALUES (COMMON FOR EACH CURVE)
C YCURVE -- TABLE OF Y VALUES FOR EACH CURVE
C   ARGX -- VALUE OF X FOR INTERPOLATION
C ARGCUR -- VALUE OF CURVE FOR INTERPOLATION
C ARGGPH -- VALUE OF GRAPH FOR INTERPOLATION
C
C***  OUTPUT
C
C    ANS -- INTERPOLATED VALUE
C
      DIMENSION FGRAPH(KGRAPH),FCURVE(KCURVE),XCURVE(KPOINT),
     1 YCURVE(NPTS),X(50),Y1(50),Y2(50),Y3(50)
C
      L=0
C
      DO 1020 I=1,KGRAPH
         DO 1010 J=1,KCURVE
            DO 1000 K=1,KPOINT
               L=L+1
               X(K)=XCURVE(K)
               Y1(K)=YCURVE(L)
 1000       CONTINUE
            CALL LNTRP(X,Y1,KPOINT,ARGX,ANS)
            Y2(J)=ANS
 1010    CONTINUE
         CALL LNTRP(FCURVE,Y2,KCURVE,ARGCUR,ANS)
         Y3(I)=ANS
 1020 CONTINUE
C
      CALL LNTRP(FGRAPH,Y3,KGRAPH,ARGGPH,ANS)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RAXIS(LAXIS, AA)
C
C***  READ AXISYMMETRIC BODY INPUTS
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION AA(881),NLNAME(6),IVNAME(152),LEN(34),IDIM(34),LOC(34)
C
      LOGICAL LAXIS,IEOF
C
      DATA NLNAME /  'A   ','X   ','I   ','B   ','O   ','D   '/
      DATA IVNAME /  'N   ','X   ','X   ','O   ','X   ','0   ','X   ',
     1 'R   ','T   ','N   ','O   ','S   ','E   ','L   ','N   ','O   ',
     2 'S   ','E   ','D   ','N   ','O   ','S   ','E   ','B   ','N   ',
     3 'O   ','S   ','E   ','T   ','R   ','U   ','N   ','C   ','L   ',
     4 'C   ','E   ','N   ','T   ','R   ','D   ','C   ','E   ','N   ',
     5 'T   ','R   ','T   ','A   ','F   ','T   ','L   ','A   ','F   ',
     6 'T   ','D   ','A   ','F   ','T   ','P   ','O   ','W   ','E   ',
     7 'R   ','D   ','I   ','S   ','C   ','O   ','N   ','D   ','E   ',
     8 'X   ','I   ','T   ','B   ','A   ','S   ','E   ','B   ','E   ',
     9 'T   ','A   ','N   ','J   ','M   ','A   ','C   ','H   ','P   ',
     A 'R   ','A   ','T   ','T   ','R   ','A   ','T   ','P   ','R   ',
     B 'O   ','T   ','U   ','B   ','N   ','P   ','R   ','O   ','T   ',
     C 'P   ','T   ','Y   ','P   ','E   ','X   ','P   ','R   ','O   ',
     D 'T   ','N   ','L   ','O   ','C   ','B   ','L   ','D   ','M   ',
     E 'E   ','M   ','B   ','L   ','D   ','T   ','Y   ','P   ','L   ',
     F 'P   ','R   ','O   ','T   ','W   ','P   ','R   ','O   ','T   ',
     G 'H   ','P   ','R   ','O   ','T   ','O   ','P   ','R   ','O   ',
     H 'T   '/
      DATA IDIM   / 1,1,1,50,50,1,1,1,1,-1,1,1,1,1,1,1,20,1,-1,1,
     1  20,20,20,-1,1,20,20,20,20,100,100,100,100,100 /
      DATA LEN    / 2,2,2,1,1,5,5,5,5,5,6,6,4,4,4,5,6,5,4,5,5,4,4,
     1  6,5,5,5,4,6,6,5,5,5,5 /
      DATA LOC    / 1,2,2,3,53,103,104,105,106,107,108,109,110,111,112,
     1              113,114,237,238,239,240,260,280,
     2             300,301,302,322,342,362,382,482,582,682,782 /
C
      LAXIS=.TRUE.
C
      CALL NAMER(KAND,2,NLNAME,6,IVNAME,152,LEN,34,IDIM,AA,881,LOC,IEOF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SRATIO(MACH,LMACH,DELTA,RATIO,A2)
C
C *** CALCULATES THE COEFFICIENTS USED TO COMPUTE
C *** THE MODIFIED DAHLEM-BUCK PRESSURE COEFFICIENT
C
C ***   A1 = A
C ***   A2 = -N
C ***   LMACH = NATURAL LOG OF FREE STREAM MACH NUMBER
C
      REAL MACH,LMACH
      COMMON /CONST/PI,RAD,UNUSED,KAND
C
      A1=(6.-.3*MACH)+SIN((LMACH-.588)/1.20*PI)
      A2=1.15+0.5*SIN((LMACH-0.916)/3.29*PI)
      RATIO=A1*(DELTA*RAD)**(-A2)+1.0
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WAVE(CPV,NN1,NN2,NN3,NN4,NBLUNT,NN,NNI,
     1 RR,RREF,SUM1,SUM2,SUM3,CABL,CNBL,CMBL,CAW,CNW,CMW)
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  ORIGINAL ROUTINE WRITTEN BY F. MOORE, NSWC
C  MODIFIED BY J. JENKINS, WL/FIGC
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /VDARY/ XB(220),RB(220),RBP(220),C(220),C1(220),RB1(220),
     1  RBP1(220),B(220),PSI(220),ZE0X(220),PSIR(220),PHIX(220)
      DIMENSION CPV(220,7)
      CA2=0.
      CA3=0.
      CA4=0.
      CN2=0.
      CN3=0.
      CN4=0.
      CM2=0.
      CM3=0.
      CM4=0.
      SUM1=0.
      SUM2=0.
      SUM3=0.
      AREF=PI*RREF**2
      IF(NBLUNT .NE. 1) GO TO 1000
        K=NNI
        JB=0
  500   JB=JB+1
        IF(XB(JB) .LT. 0.) GO TO 500
        IF(JB .LE. NNI) GO TO 600
          CALL SIMP(CPV,K,JB,RR,SUM1,SUM2,SUM3)
          K=JB+1
  600 K1=NN1
      K2=NN2
      K3=NN3
      K4=NN4
      GO TO 1010
 1000 K=1
      K1=NN1
      K2=NN2
      K3=NN3
      K4=NN4
      CABL=0.
      CNBL=0.
      CMBL=0.
 1010 JA=K
      JB=K1
      CALL SIMP(CPV,JA,JB,RR,SUM1,SUM2,SUM3)
      CA1= 2.*SUM1/AREF
      CN1=-2.*SUM2/AREF
      CM1= 2.*SUM3/(AREF*2.*RREF)
      SUM1=0.
      SUM2=0.
      SUM3=0.
      IF(NN1.EQ.NN ) GO TO 1020
      JA=K1+1
      JB=K2
      CALL SIMP(CPV,JA,JB,RR,SUM1,SUM2,SUM3)
      CA2= 2.*SUM1/AREF
      CN2=-2.*SUM2/AREF
      CM2= 2.*SUM3/(AREF*2.*RREF)
      SUM1=0.
      SUM2=0.
      SUM3=0.
      IF(NN2.EQ.NN ) GO TO 1020
      JA=K2+1
      JB=K3
      CALL SIMP(CPV,JA,JB,RR,SUM1,SUM2,SUM3)
      CA3= 2.*SUM1/AREF
      CN3=-2.*SUM2/AREF
      CM3= 2.*SUM3/(AREF*2.*RREF)
      SUM1=0.
      SUM2=0.
      SUM3=0.
      IF(NN3.EQ.NN ) GO TO 1020
      JA=K3+1
      JB=K4
      CALL SIMP(CPV,JA,JB,RR,SUM1,SUM2,SUM3)
      CA4= 2.*SUM1/AREF
      CN4=-2.*SUM2/AREF
      CM4= 2.*SUM3/(AREF*2.*RREF)
 1020 CAW= CABL+CA1+CA2+CA3+CA4
      CNW= CNBL+CN1+CN2+CN3+CN4
      CMW=CMBL+CM1+CM2+CM3+CM4
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ASECT
C
C***  COMPUTE AIRFOIL SECTION AERODYNAMICS
C
      COMMON /F1WORK/ F1WK(290)
      COMMON /F2WORK/ F2WK(290)
      COMMON /F3WORK/ F3WK(290)
      COMMON /F4WORK/ F4WK(290)
C
      COMMON /DESIG/  NACA(80,4)
C
      COMMON /FLC/    FLT(144)
C
      COMMON /GEOFS1/ GFIN1(188)
      COMMON /GEOFS2/ GFIN2(188)
      COMMON /GEOFS3/ GFIN3(188)
      COMMON /GEOFS4/ GFIN4(188)
C
      COMMON /FSET1/  FIN1(399)
      COMMON /FSET2/  FIN2(399)
      COMMON /FSET3/  FIN3(399)
      COMMON /FSET4/  FIN4(399)
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      COMMON /ASMVAR/TDATA(523)
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL MACH,NMACH
      CHARACTER*4 NACA
      DIMENSION MACH(20),REN(20)
C
      EQUIVALENCE (MACH(1),FLT(25)),(REN(1),FLT(65)),(NMACH,FLT(24))
C
      DO 1000 I=1,523
         TDATA(I)=UNUSED
 1000 CONTINUE
C
C***  FIN SET 1
C
      IF(LFIN1) CALL CLMAX(GFIN1(184),GFIN1(185),FIN1(113),FIN1(213),
     1          FIN1(163),NMACH,REN,F1WK(271))
      IF(LFIN1) CALL THEORY(NACA(1,1),NMACH,MACH,REN,1,F1WK(1),F1WK(2),
     1          GFIN1(185),GFIN1(184),FIN1(113),FIN1(213),FIN1(163),
     2          F1WK(4),F1WK(24),F1WK(44),F1WK(268),F1WK(269),
     3          F1WK(270),F1WK(271))
C
C***  FIN SET 2
C
      IF(LFIN2) CALL CLMAX(GFIN2(184),GFIN2(185),FIN2(113),FIN2(213),
     1          FIN2(163),NMACH,REN,F2WK(271))
      IF(LFIN2) CALL THEORY(NACA(1,2),NMACH,MACH,REN,2,F2WK(1),F2WK(2),
     1          GFIN2(185),GFIN2(184),FIN2(113),FIN2(213),FIN2(163),
     2          F2WK(4),F2WK(24),F2WK(44),F2WK(268),F2WK(269),
     3          F2WK(270),F2WK(271))
C
C***  FIN SET 3
C
      IF(LFIN3) CALL CLMAX(GFIN3(184),GFIN3(185),FIN3(113),FIN3(213),
     1          FIN3(163),NMACH,REN,F3WK(271))
      IF(LFIN3) CALL THEORY(NACA(1,3),NMACH,MACH,REN,3,F3WK(1),F3WK(2),
     1          GFIN3(185),GFIN3(184),FIN3(113),FIN3(213),FIN3(163),
     2          F3WK(4),F3WK(24),F3WK(44),F3WK(268),F3WK(269),
     3          F3WK(270),F3WK(271))
C
C***  FIN SET 4
C
      IF(LFIN4) CALL CLMAX(GFIN4(184),GFIN4(185),FIN4(113),FIN4(213),
     1          FIN4(163),NMACH,REN,F4WK(271))
      IF(LFIN4) CALL THEORY(NACA(1,4),NMACH,MACH,REN,4,F4WK(1),F4WK(2),
     1          GFIN4(185),GFIN4(184),FIN4(113),FIN4(213),FIN4(163),
     2          F4WK(4),F4WK(24),F4WK(44),F4WK(268),F4WK(269),
     3          F4WK(270),F4WK(271))
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BODCFD(ALPHAR,BETAR,XMACH,CNVIS,CMVIS,CYVIS,CLNVIS)
C
C     THIS SUBROUTINE DETERMINES THE CROSSFLOW DRAG COEFFICIENT
C     FOR THE BODY AT EACH AXIAL SECTION OF THE DIVERTER AND THEN
C     INCREMENTS THE TOTAL VEHICLE FORCE AND MOMENT COEFFICIENTS
C     ACCORDINGLY.  THIS ELIMINATES DOUBLE FORCE ACCOUNTING.
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C  MODIFIED BY K. BURNS, MCDONNELL DOUGLAS
C
C                  *********************
C                  * INPUT/OUTPUT LIST *
C                  *********************
C
C     ***** INPUTS *****          ***** OUTPUTS *****
C           ALPHAR                      CNVIS
C           BETAR                       CMVIS
C           XMACH                       CYVIS
C
C     SUBROUTINES USED: ILTCDC
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
      COMMON /GEOBOD/ DUM(32),DMAX,SMAX,LBOD,GDUM(12)
      REAL LBOD
      RBOD=DMAX/2.0
C
      CNVIS  = 0.0
      CMVIS  = 0.0
      CYVIS  = 0.0
      CLNVIS = 0.0
C
      NUMI=NIN+0.5
      DO 100 INLET = 1, NUMI
C
C       INITIALIZE SUMMING VARIABLES
        CNSUM  = 0.0
        CMSUM  = 0.0
        CYSUM  = 0.0
        CLNSUM = 0.0
C
C       BEGIN LOOP FOR DIVERTER OR INLET SECTIONS
C
C       NCRX IS SET ACCORDING TO WHETHER BODY/DIVERTER OR BODY/INLET
C       INTERFERENCE IS BEING DETERMINED
        IF(HDIV .GT. 0.0)NCRX=2
        IF(HDIV .LE. 0.0)NCRX=4
        DO 110 IDCRX = 1, NCRX
          IDCRX1 = IDCRX + 1
C
C         DETERMINE CROSSFLOW DRAG COEFFICIENTS
          CALL ILTCDC(ALPHAR,XMACH,FRB,CDCA)
          CALL ILTCDC(BETAR,XMACH,FRB,CDCB)
C
C         COMPUTE THE AVERAGE NEWTONIAN CORRECTION FACTOR BETWEEN
C         THE TWO BOUNDING CROSS SECTIONS
C
C         CHECK FOR POSITIVE OR NEGATIVE ANGLE OF ATTACK
          IF (ALPHAR .GE. 0.0) THEN
            CNZAVE = -(DLCNBP(IDCRX,INLET) + DLCNBP(IDCRX1,INLET)) / 2.0
          ELSE
            CNZAVE = -(DLCNBN(IDCRX,INLET) + DLCNBN(IDCRX1,INLET)) / 2.0
          END IF
C
C         CHECK FOR POSITIVE OR NEGATIVE SIDESLIP ANGLE
          IF (BETAR .GE. 0.0) THEN
            CNYAVE = -(DLCYBP(IDCRX,INLET) + DLCYBP(IDCRX1,INLET)) / 2.0
          ELSE
            CNYAVE = -(DLCYBN(IDCRX,INLET) + DLCYBN(IDCRX1,INLET)) / 2.0
          END IF
C
C         INCREMENT AERO COEFFICIENTS FOR 2-D INLETS
          TEMPA  = CDCA * 2. * RBOD * DLEN(IDCRX) * CNZAVE / CNCIRN
          TEMPB  = CDCB * 2. * RBOD * DLEN(IDCRX) * CNYAVE / CNCIRN
          CNSUM  = CNSUM  + TEMPA
          CMSUM  = CMSUM  - TEMPA * XMIDD(IDCRX)
          CYSUM  = CYSUM  - TEMPB
          CLNSUM = CLNSUM + TEMPB * XMIDD(IDCRX)
C
  110   CONTINUE
C
C       COMPUTE THE DYNAMIC PRESSURE RATIO
        F3A = SIN(ALPHAR) * ABS(SIN(ALPHAR))
        F3B = SIN(BETAR)  * ABS(SIN(BETAR))
C
C       COMPLETE CROSSFLOW AERO CALCULATION
        CNVIS  = CNVIS  + CNSUM  * F3A /  SREF
        CMVIS  = CMVIS  + CMSUM  * F3A / (SREF * LREF)
        CYVIS  = CYVIS  + CYSUM  * F3B /  SREF
        CLNVIS = CLNVIS + CLNSUM * F3B / (SREF * BREF)
C
  100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CONTRL(KOL,CASE,SAVCSE,IWARN)
C
C***  SUBROUTINE TO TEST FOR LEGAL CONTROL CARDS
C***  AND SET APPROPIATE CONTROL FLAGS
C
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),CCASE,NOEXTR,NOLAT,
     1                IR,IPAGE
      COMMON /THERY/  LSOSE,PRESUR,LHYBRD,LHYPER
      LOGICAL LSOSE,PRESUR,LHYBRD,LHYPER,NOEXTR,NOLAT
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD,PROTUB
C
      LOGICAL SAVCSE,IWARN
C
      COMMON /DESIG/ NNACA(80,4)
      COMMON /DUMPF/
     1   LGEOB,LF1GM,LF2GM,LF3GM,LF4GM,LATMP,LBDWK,LFLCT,LINLD,
     2   LINPT,LFLTC,LREFQN,LBDIN,LF1IN,LF2IN,LF3IN,LF4IN,LINLEN,
     3   LIOM,LSBOD,LSF1,LSF2,LSF3,LSF4,LSB1,LSB12,LSB123,LS1234,LBOD,
     4   LDF1,LDF2,LDF3,LDF4,LDB1,LDB12,LDB123,LD1234
      LOGICAL
     1   LGEOB,LF1GM,LF2GM,LF3GM,LF4GM,LATMP,LBDWK,LFLCT,LINLD,
     2   LINPT,LFLTC,LREFQN,LBDIN,LF1IN,LF2IN,LF3IN,LF4IN,LINLEN,
     3   LIOM,LSBOD,LSF1,LSF2,LSF3,LSF4,LSB1,LSB12,LSB123,LS1234,LBOD,
     4   LDF1,LDF2,LDF3,LDF4,LDB1,LDB12,LDB123,LD1234
      COMMON /DFLAGS/ DFLT,DREF,DAXI,DFIN1,DFIN2,DFIN3,DFIN4,DDEFL,
     1                DTRIM,DELLB,DINLET,DARBOD
      LOGICAL DFLT,DREF,DAXI,DFIN1,DFIN2,DFIN3,DFIN4,DDEFL,DTRIM
      LOGICAL LDMP(37),LTEST
      EQUIVALENCE (LDMP(1),LGEOB)
      INTEGER CASE
      DIMENSION KOL(80), PART(4), IDIM(3), IDIMT(8), NMLIST(8)
      DIMENSION ISOSE(4),IPRESR(9),IEXTRA(12)
      DIMENSION IWRIE(6),IFORMT(6),INOLAT(6)
      DIMENSION BUILD(5), NACA(4), DERD(9), DERR(9), KASE(6)
      DIMENSION IDMP(5), IDMC(4), TRIM(4), IHYPER(5),ICRMT(6)
      DIMENSION DAMP(4), NACAT(4), PLOT(4),ISPIN(4)
C
      DIMENSION KEYDP(136),  NDP(37)
      DIMENSION KEYARY(36), NDPARY(9)
      DIMENSION KEYINP(35), NDPINP(9)
      DIMENSION KEYIOM(65), NDPIOM(19)
      EQUIVALENCE (KEYDP(  1),KEYARY(1)), (NDP( 1),NDPARY(1))
      EQUIVALENCE (KEYDP( 37),KEYINP(1)), (NDP(10),NDPINP(1))
      EQUIVALENCE (KEYDP( 72),KEYIOM(1)), (NDP(19),NDPIOM(1))
C
C     INTEGER BUILD, DERD, DERR, TRIM, DAMP, PART, PLOT
      CHARACTER*4 IRGEOM,IRAERO,IRTYPE,BUILD,ISOSE,IEXTRA,IPRESR,
     1  IWRIE,IFORMT,INOLAT,NACA,NACAT,DERD,DERR,PART,IDIM,IDIMT,
     2  NMLIST,KASE,IDMP,IDMC,IBLNK,KOMMA,TRIM,DAMP,PLOT,IHYPER,
     3  ICRMT,ISPIN,KEYARY,KEYINP,KEYIOM,KOL,NNACA,IDCASE,KEYDP
C
      LOGICAL NMTEST,DELNMS
      DIMENSION IRGEOM(10),IRAERO(10),IRTYPE(47),IRLEN(11)
      DATA IRLEN / 1,5,9,13,17,21,26,32,36,40,45 /
      DATA IRGEOM /
     1 'P   ','R   ','I   ','N   ','T   ','    ',
     2 'G   ','E   ','O   ','M   '/
      DATA IRAERO /
     1 'P   ','R   ','I   ','N   ','T   ','    ',
     2 'A   ','E   ','R   ','O   '/
      DATA IRTYPE /
     1 'B   ','O   ','D   ','Y   ',
     2 'F   ','I   ','N   ','1   ',
     3 'F   ','I   ','N   ','2   ',
     4 'F   ','I   ','N   ','3   ',
     5 'F   ','I   ','N   ','4   ',
     6 'I   ','N   ','L   ','E   ','T   ',
     7 'S   ','Y   ','N   ','T   ','H   ','S   ',
     8 'T   ','R   ','I   ','M   ',
     9 'B   ','E   ','N   ','D   ',
     A 'H   ','I   ','N   ','G   ','E   ','+   ','-   ','*   '/
C
      DATA BUILD  /'B   ', 'U   ', 'I   ', 'L   ', 'D   ' /
      DATA ISOSE /'S   ','O   ','S   ','E   '/
      DATA IEXTRA/'P   ','R   ','I   ','N   ','T   ','    ',
     1 'E   ','X   ','T   ','R   ','A   ','P   '/
      DATA IPRESR / 'P   ','R   ','E   ','S   ','S   ',
     1 'U   ','R   ','E   ','S   '/
      DATA IWRIE / 'W   ','R   ','I   ','T   ','E   ','    ' /
      DATA IFORMT/ 'F   ','O   ','R   ','M   ','A   ','T   ' /
      DATA INOLAT/ 'N   ','O   ','    ','L   ','A   ','T   ' /
      DATA NACA   /'N   ', 'A   ', 'C   ', 'A   ' /
      DATA NACAT  /'1   ', '2   ', '3   ', '4   '/
      DATA DERD   /'D   ','E   ','R   ','I   ','V   ','    ',
     1             'D   ','E   ','G   '/
      DATA DERR   /'D   ','E   ','R   ','I   ','V   ','    ',
     1             'R   ','A   ','D   '/
      DATA PART   /'P   ','A   ','R   ','T   '/
      DATA IDIM   /'D   ','I   ','M   ' /
      DATA IDIMT  /'F   ','T   ','I   ','N   ','M   ','    ',
     1             'C   ','M   '/
      DATA NMLIST /'N   ','A   ','M   ','E   ','L   ',
     1             'I   ','S   ','T   '/
      DATA KASE   /'C   ','A   ','S   ','E   ','I   ','D   '/
      DATA IDMP   /'D   ','U   ','M   ','P   ','    '/
      DATA IDMC   /'C   ','A   ','S   ','E   '/
      DATA IBLNK  /'    '/
      DATA KOMMA /',   '/
      DATA TRIM   /'T   ','R   ','I   ','M   '/
      DATA DAMP   /'D   ','A   ','M   ','P   '/
      DATA PLOT   /'P   ','L   ','O   ','T   '/
      DATA IHYPER /'H   ','Y   ','P   ','E   ','R   '/
      DATA ICRMT  /'I   ','N   ','C   ','R   ','M   ','T   '/
      DATA ISPIN  /'S   ','P   ','I   ','N   '/
C
      DATA NLN / 37 /
C
      DATA KEYARY  /
     1       'G   ','E   ','O   ','B   ','F   ','1   ','G   ','M   ',
     2       'F   ','2   ','G   ','M   ','F   ','3   ','G   ','M   ',
     3       'F   ','4   ','G   ','M   ','A   ','T   ','M   ','P   ',
     4       'B   ','D   ','W   ','K   ','F   ','L   ','C   ','T   ',
     5       'I   ','N   ','L   ','D   '/
      DATA NDPARY / 9*4 /
C
      DATA KEYINP  /
     1       'I   ','N   ','P   ','T   ','F   ','L   ','T   ','R   ',
     2       'E   ','F   ','Q   ','B   ','D   ','I   ','N   ','F   ',
     3       '1   ','I   ','N   ','F   ','2   ','I   ','N   ','F   ',
     4       '3   ','I   ','N   ','F   ','4   ','I   ','N   ','I   ',
     5       'N   ','L   ','I   '/
      DATA NDPINP / 4,3,7*4 /
C
      DATA KEYIOM  /
     1       'I   ','O   ','M   ','S   ','B   ','O   ','D   ','S   ',
     2       'F   ','1   ','S   ','F   ','2   ','S   ','F   ','3   ',
     3       'S   ','F   ','4   ','S   ','B   ','1   ','S   ','B   ',
     4       '1   ','2   ','S   ','B   ','1   ','3   ','S   ','B   ',
     5       '1   ','4   ','D   ','B   ','O   ','D   ','D   ','F   ',
     6       '1   ','D   ','F   ','2   ','D   ','F   ','3   ','D   ',
     7       'F   ','4   ','D   ','B   ','1   ','D   ','B   ','1   ',
     8       '2   ','D   ','B   ','1   ','3   ','D   ','B   ','1   ',
     9       '4   '/
      DATA NDPIOM / 3,4,5*3,4*4,5*3,3*4 /
C
C***  TEST FOR DELETE CONTROL CARD
C
      ND=0
      IF(DELNMS(KOL,1,ND))GO TO 1600
C
C***  TEST FOR - DUMP
C
      DO 1000 I=1,5
         IF(KOL(I) .NE. IDMP(I)) GO TO 1090
 1000 CONTINUE
C
C***  TEST FOR - DUMP CASE
C
      J=1
      DO 1010 L=6,9
      IF(KOL(L) .NE. IDMC(J)) GO TO 1030
      J=J+1
 1010 CONTINUE
C
C***  TEST FOR COLUMNS 10-80 BLANK
C
      DO 1020 I=10,80
      IF(KOL(I) .NE. IBLNK) GO TO 1030
 1020 CONTINUE
      LDMPCS=.TRUE.
      LPART=.TRUE.
      GO TO 1600
C
C***  TEST FOR ARRAY NAMES
C
 1030 I=5
 1040 I=I+1
      IF(I.GT.80) GO TO 1600
      IF(KOL(I) .EQ. IBLNK .OR. KOL(I) .EQ. KOMMA)GO TO 1040
      NS=I
      NCHAR=1
 1050 I=I+1
      IF(I.GT.80)GO TO 1600
      IF(KOL(I) .EQ. IBLNK .OR. KOL(I) .EQ. KOMMA) GO TO 1060
      NCHAR=NCHAR+1
      GO TO 1050
 1060 IF(NCHAR .LT. 7) GO TO 1070
      NA = NA+1
      GO TO 1040
 1070 LOC = 1
      DO 1080 J=1,NLN
         IF(J .GT. 1) LOC = LOC+NDP(J-1)
         IF(NDP(J) .NE. NCHAR) GO TO 1080
         LTEST=NMTEST(KOL(NS),KEYDP(LOC),NDP(J))
         IF(LTEST)LDMP(J)=.TRUE.
         IF(LTEST)GO TO 1040
 1080 CONTINUE
      NA = NA+1
      GO TO 1040
C
C***  TEST FOR - CASEID
C
 1090 DO 1100 I=1,6
         IF(KOL(I) .NE. KASE(I)) GO TO 1120
 1100 CONTINUE
      DO 1110 I=7,80
         IDCASE(I-6)=KOL(I)
 1110 CONTINUE
      GO TO 1600
C
C***  TEST FOR - TRIM
C
 1120 DO 1130 I=1,4
         IF(KOL(I) .NE. TRIM(I)) GO TO 1140
 1130 CONTINUE
      LTRIM=.TRUE.
      GO TO 1600
C
C***  TEST FOR - DAMP
C
 1140 DO 1150 I=1,4
         IF(KOL(I) .NE. DAMP(I)) GO TO 1160
 1150 CONTINUE
      LDAMP=.TRUE.
      GO TO 1600
C
C***  TEST FOR - SPIN
C
 1160 DO 1170 I=1,4
         IF(KOL(I) .NE. ISPIN(I))GO TO 1180
 1170 CONTINUE
      LSPIN=.TRUE.
      GO TO 1600
C
C***  TEST FOR - BUILD
C
 1180 DO 1190 I=1,5
         IF(KOL(I) .NE. BUILD(I)) GO TO 1200
 1190 CONTINUE
      LBUILD=.TRUE.
      GO TO 1600
C
C***  TEST FOR - INCRMT
C
 1200 DO 1210 I=1,6
         IF(KOL(I) .NE. ICRMT(I))GO TO 1220
 1210 CONTINUE
      LICRMT=.TRUE.
      GO TO 1600
C
C***  TEST FOR - NACA
C
 1220 DO 1230 I=1,4
         IF(KOL(I) .NE. NACA(I)) GO TO 1270
 1230 CONTINUE
      LNACA=.TRUE.
      DO 1240 I=1,4
         NSET=I
         IF(KOL(6) .EQ. NACAT(I)) GO TO 1250
 1240 CONTINUE
      GO TO 1600
 1250 DO 1260 I=1,80
         NNACA(I,NSET)=KOL(I)
 1260 CONTINUE
      GO TO 1600
C
C***  TEST FOR - DERIV DEG
C
 1270 DO 1280 I=1,9
         IF(KOL(I) .NE. DERD(I)) GO TO 1290
 1280 CONTINUE
      LDERDG=.TRUE.
      GO TO 1600
C
C***  TEST FOR - DERIV RAD
C
 1290 DO 1300 I=1,9
         IF(KOL(I) .NE. DERR(I)) GO TO 1310
 1300 CONTINUE
      LDERRD=.TRUE.
      GO TO 1600
C
C***  TEST FOR - PART
C
 1310 DO 1320 I=1,4
         IF(KOL(I) .NE. PART(I)) GO TO 1330
 1320 CONTINUE
      LPART=.TRUE.
      GO TO 1600
C
C***  TEST FOR DIMENSION CARD
C
 1330 DO 1340 I=1,3
         IF(KOL(I) .NE. IDIM(I)) GO TO 1350
 1340 CONTINUE
C
C***  KEEP PRESENT UNITS SYSTEM TO COMPARE LATER
C
      LUNIT=0
      IF(LDIMFT)LUNIT=1
      IF(LDIMIN)LUNIT=2
      IF(LDIMM )LUNIT=3
      IF(LDIMCM)LUNIT=4
      IF(LUNIT .EQ. 0)LUNIT=1
C
C***  NEGATE ANY PREVIOUSLY SET UNITS SYSTEM
C
      LDIMFT=.FALSE.
      LDIMIN=.FALSE.
      LDIMM=.FALSE.
      LDIMCM=.FALSE.
C
C***  SET CORRECT UNITS SYSTEM
C
      IF(KOL(5) .EQ. IDIMT(1) .AND. KOL(6) .EQ. IDIMT(2))LDIMFT=.TRUE.
      IF(KOL(5) .EQ. IDIMT(3) .AND. KOL(6) .EQ. IDIMT(4))LDIMIN=.TRUE.
      IF(KOL(5) .EQ. IDIMT(5) .AND. KOL(6) .EQ. IDIMT(6))LDIMM=.TRUE.
      IF(KOL(5) .EQ. IDIMT(7) .AND. KOL(6) .EQ. IDIMT(8))LDIMCM=.TRUE.
C
      IF(LDIMFT)MUNIT=1
      IF(LDIMIN)MUNIT=2
      IF(LDIMM )MUNIT=3
      IF(LDIMCM)MUNIT=4
      IF(LUNIT .NE. MUNIT .AND. SAVCSE)IWARN=.TRUE.
C
      IF(LDIMFT .OR. LDIMM .OR. LDIMIN .OR. LDIMCM)GO TO 1600
C
C***  IF UNRECOGNIZABLE SET DEFAULT
C
      LDIMFT=.TRUE.
      GO TO 1600
C
C***  TEST FOR NAMELIST CARD
C
 1350 DO 1360 I=1,8
         IF(KOL(I) .NE. NMLIST(I)) GO TO 1370
 1360 CONTINUE
      LNAME=.TRUE.
      GO TO 1600
C
C***  TEST FOR PLOT CARD
C
 1370 DO 1380 I=1,4
         IF(KOL(I) .NE. PLOT(I)) GO TO 1390
 1380 CONTINUE
      LPLOT=.TRUE.
      GO TO 1600
C
C***  TEST FOR SOSE CONTROL CARD
C
 1390 DO 1400 I=1,4
         IF(KOL(I) .NE. ISOSE(I)) GO TO 1410
 1400 CONTINUE
      LSOSE=.TRUE.
      LHYBRD=.FALSE.
      LHYPER=.FALSE.
      GO TO 1600
C
C***  TEST FOR PRESSURES CONTROL CARD
C
 1410 DO 1420 I=1,9
         IF(KOL(I) .NE. IPRESR(I)) GO TO 1430
 1420 CONTINUE
      PRESUR=.TRUE.
      GO TO 1600
C
C***  PRINT EXTRAP CONTROL CARD
C
 1430 DO 1440 I=1,12
         IF(KOL(I) .NE. IEXTRA(I))GO TO 1450
 1440 CONTINUE
      NOEXTR=.FALSE.
      GO TO 1600
C
C***  WRITE CONTROL CARD
C
 1450 DO 1460 I=1,6
         IF(KOL(I) .NE. IWRIE(I))GO TO 1470
 1460 CONTINUE
      WRITE(7,1610)(KOL(I),I=7,80)
      GO TO 1600
C
C
 1470 DO 1480 I=1,6
         IF(KOL(I) .NE. IFORMT(I))GO TO 1490
 1480 CONTINUE
      WRITE(7,1610)(KOL(I),I=7,80)
      GO TO 1600
C
C***  NOLAT CONTROL CARD
C
 1490 DO 1500 I=1,6
         IF(KOL(I) .NE. INOLAT(I))GO TO 1510
 1500 CONTINUE
      NOLAT=.TRUE.
      GO TO 1600
C
C*** HYPER CONTROL CARD
C
 1510 DO 1520 I=1,5
         IF(KOL(I) .NE. IHYPER(I))GO TO 1530
 1520 CONTINUE
      LHYPER=.TRUE.
      LSOSE=.FALSE.
      LHYBRD=.FALSE.
      GO TO 1600
C
C*** PRINT GEOM CARD
C
 1530 DO 1540 I=1,10
         IF(KOL(I) .NE. IRGEOM(I))GO TO 1550
 1540 CONTINUE
      IMAX=6
      GO TO 1570
C
C*** PRINT AERO CARD
C
 1550 DO 1560 I=1,10
         IF(KOL(I) .NE. IRAERO(I))GO TO 1600
 1560 CONTINUE
      IMAX=10
C
C ... NOW FIND TYPE MATCH
C
 1570 DO 1590 I=1,IMAX
         IR1=12
         IR2=IR1+IRLEN(I+1)-IRLEN(I)-1
         DO 1580 II=IR1,IR2
            IND=IRLEN(I)+II-IR1
            IF(KOL(II) .NE. IRTYPE(IND))GO TO 1590
 1580    CONTINUE
C
C ... SET APPROPIATE FLAG
C
         JJ=I
         IF(I .GT. 6)JJ=I-1
         IF(I .EQ. 6 .AND. IMAX .EQ. 6)JJ=15
         IF(I .EQ. 6 .AND. IMAX .EQ. 10)JJ=16
         IF(I .NE. 6 .AND. IMAX .EQ. 10)JJ=JJ+5
         PARTS(JJ)=.TRUE.
         GO TO 1600
C
 1590 CONTINUE
C
C ... PRINT AERO - OR PRINT GEOM - SUPPRESSES INPUT LISTING
C
      IF(KOL(12).EQ.IRTYPE(46))PARTS(18)=.FALSE.
C
C ... PRINT AERO * OR PRINT GEOM * SUPPRESSES ALL NORMAL OUTPUT
C
      IF(KOL(12).EQ.IRTYPE(47))PARTS(19)=.FALSE.
C
 1600 CONTINUE
C
      RETURN
C***  FORMAT CONTROL CARD
 1610 FORMAT(74A1)
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE DIVCFD(ALPHAR,BETAR,XMACH,CNVIS,CMVIS,CYVIS,CLNVIS)
C
C     THIS SUBROUTINE DETERMINES THE CROSSFLOW DRAG COEFFICIENT
C     FOR EACH AXIAL SECTION OF THE DIVERTER AND THEN INCREMENTS THE
C     TOTAL DIVERTER FORCE AND MOMENT COEFFICIENTS ACCORDINGLY.
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
C                  *********************
C                  * INPUT/OUTPUT LIST *
C                  *********************
C
C     ***** INPUTS *****          ***** OUTPUTS *****
C           ALPHAR                      CNVIS
C           BETAR                       CMVIS
C           XMACH                       CYVIS
C
C     SUBROUTINES USED: ILTCDC
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      CNVIS  = 0.0
      CMVIS  = 0.0
      CYVIS  = 0.0
      CLNVIS = 0.0
C
      NUMI=NIN+0.5
      DO 100 INLET = 1, NUMI
C
C       INITIALIZE SUMMING VARIABLES
        CNSUM  = 0.0
        CMSUM  = 0.0
        CYSUM  = 0.0
        CLNSUM = 0.0
C
C       BEGIN LOOP FOR BODY SECTIONS
        DO 110 IDCRX = 1, 2
          IDCRX1 = IDCRX + 1
C
C         DETERMINE CROSSFLOW DRAG COEFFICIENTS
          CALL ILTCDC(ALPHAR,XMACH,FRD,CDCA)
          CALL ILTCDC(BETAR,XMACH,FRD,CDCB)
C
C         COMPUTE THE AVERAGE WIDTH AND HEIGHT AND THE AVERAGE
C         NEWTONIAN CORRECTION FACTOR BETWEEN THE TWO BOUNDING
C         CROSS SECTIONS
          WIDAVE = (CRXDWD(IDCRX,INLET) + CRXDWD(IDCRX1,INLET)) / 2.0
          HGTAVE = (CRXDHT(IDCRX,INLET) + CRXDHT(IDCRX1,INLET)) / 2.0
C
C
C         CHECK FOR POSITIVE OR NEGATIVE ANGLE OF ATTACK
          IF (ALPHAR .GE. 0.0) THEN
            CNZAVE = (CNNDZP(IDCRX,INLET) + CNNDZP(IDCRX1,INLET)) / 2.0
          ELSE
            CNZAVE = (CNNDZN(IDCRX,INLET) + CNNDZN(IDCRX1,INLET)) / 2.0
          END IF
C
C         CHECK FOR POSITIVE OR NEGATIVE SIDESLIP ANGLE
          IF (BETAR .GE. 0.0) THEN
            CNYAVE = (CNNDYP(IDCRX,INLET) + CNNDYP(IDCRX1,INLET)) / 2.0
          ELSE
            CNYAVE = (CNNDYN(IDCRX,INLET) + CNNDYN(IDCRX1,INLET)) / 2.0
          END IF
C
C         INCREMENT AERO COEFFICIENTS FOR 2-D INLETS
          TEMPA  = CDCA * WIDAVE * DLEN(IDCRX) * CNZAVE
          TEMPB  = CDCB * HGTAVE * DLEN(IDCRX) * CNYAVE
          CNSUM  = CNSUM  + TEMPA
          CMSUM  = CMSUM - TEMPA * XMIDD(IDCRX)
          CYSUM  = CYSUM  - TEMPB
          CLNSUM = CLNSUM + TEMPB * XMIDD(IDCRX)
C
  110   CONTINUE
C
C       COMPUTE THE DYNAMIC PRESSURE RATIO
        F3A = SIN(ALPHAR) * ABS(SIN(ALPHAR))
        F3B = SIN(BETAR)  * ABS(SIN(BETAR))
C
C       COMPLETE CROSSFLOW AERO CALCULATION
        CNVIS  = CNVIS  + CNSUM  * F3A /  SREF
        CMVIS  = CMVIS  + CMSUM  * F3A / (SREF * LREF)
        CYVIS  = CYVIS  + CYSUM  * F3B /  SREF
        CLNVIS = CLNVIS + CLNSUM * F3B / (SREF * BREF)
C
  100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCNAA(MACH, AR, DELY, SLE, STE, TAPER, ALPHA, CNA,
     1                  B, SECCLA, SPLAN, SREF, SCLM, CNAA)
C ***
C *** COMPUTES NON-LINEAR NORMAL FORCE PER SINE(ALPHA)**2
C ***
C *** REFERENCE   DATCOM SECTION 4.1.3.3
C ***
C *** LIMITATIONS   ALPHA .LT. 90 DEG
C ***               AR .LE. 4.0/((C1+1)*COS(SLE))
C ***               STRAIGHT TAPERED FINS
C ***               NO CAMBER
C ***
C *** INPUT   MACH    MACH NUMBER
C ***         AR      EXPOSED FIN ASPECT RATIO FOR TWO PANELS
C ***         DELY    DIFFERENCE IN AIRFOIL ORDINATE BETWEEN
C ***                 .15% AND 6% CHORD,PER CENT CHORD LENGTH
C ***         SLE     LEADING EDGE SWEEP ANGLE, DEG
C ***         STE     TRAILING EDGE SWEEP ANGLE, DEG
C ***         TAPER   EXPOSED FIN TAPER RATIO
C ***         ALPHA   ANGLE-OF-ATTACK, DEG
C ***         CNA     LINEAR CN, CN PER ALPHA AT ALPHA = 0, 1/DEG,
C ***                 REFERENCED TO SREF
C ***         B       FIN EXPOSED SPAN, TWO PANELS
C ***         SECCLA  SECTION LIFT CURVE SLOPE
C ***         SPLAN   EXPOSED PLANFORM AREA OF TWO PANELS
C ***         SREF    REFERENCE AREA
C ***         SCLM    AIRFOIL SECTION MAX LIFT
C ***
C *** OUTPUT  CNAA    CN PER SIN(ALPHA)**2, REFERENCED TO SREF
C ***
C ***
      REAL MACH
C
C ***
C *** SUBSONIC   (FCNAAS)  MACH .LE. 0.60
C *** TRANSONIC  (FCNAAT)  0.60 .LT. MACH .LT. 1.40
C *** SUPERSONIC (FCNAAH)  MACH .GE. 1.40
C ***
      CNAW = CNA*SREF/SPLAN
C ***
      SWP=SLE
      IF(SLE .LT. 0.)SWP=-STE
C ***
      IF(MACH .LE. 0.60)
     * CALL FCNAAS(MACH, AR, DELY, SWP, TAPER, ALPHA, CNAW, SCLM, CNAA)
C ***
      IF((MACH .GT. 0.60) .AND. (MACH .LT. 1.40))
     * CALL FCNAAT(MACH, AR, DELY, SWP, TAPER, ALPHA, CNAW, B, SECCLA,
     *             SCLM, CNAA)
C ***
      IF(MACH .GE. 1.40)
     * CALL FCNAAH(MACH, DELY, SWP, ALPHA, CNAW, CNAA)
C ***
      CNAA = CNAA*SPLAN/SREF
C ***
      RETURN
      END
c *************************************
c *************************************
c *************************************
      REAL FUNCTION FRCOR(FRNOSE,VOLNOS,VCONE,VTNOGV)
C     FUNCTION TO DETERMINE CORRECTION FACTOR FOR ARBITRARY BODY
      FRCOR=0.
C
C     CHECK FOR VOLUME DEPENDENCY
      IF (VOLNOS .GT. VCONE) THEN   
C
C        FIND FINENESS RATIO CORRECTION
         IF (FRNOSE .LT. 1.) THEN
            COR=0.240
         ELSE IF (FRNOSE .LT. 1.5) THEN
            COR=0.24+0.66*(FRNOSE-1.)
         ELSE IF (FRNOSE .LT. 2.) THEN
            COR=0.57+0.41*(FRNOSE-1.5)
         ELSE IF (FRNOSE .LT. 3.) THEN
            COR=0.775+0.133*(FRNOSE-2.)
         ELSE IF (FRNOSE .LT. 6.7) THEN
            COR=0.908+0.024*(FRNOSE-3.)
         ELSE IF (FRNOSE .GT. 6.7) THEN
            COR=1.0
         ENDIF
      ELSE
         COR=1.
      ENDIF
      FRCOR=1.+(COR-1.)*(VOLNOS-VCONE)/(VTNOGV-VCONE)
      RETURN
      END         
c *************************************
c *************************************
c *************************************
      SUBROUTINE ILTSWT(SWET)
C***********************************************************************
C
C     THIS SUBROUTINE CALCULATES THE WETTED AREA OF THE INLET AND
C     DIVERTER COMBINATION.
C
C***********************************************************************
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C  MODIFIED BY K. BURNS, MCDONNELL DOUGLAS
C
      COMMON /GEOBOD/ DUM(32),DMAX,SMAX,LBOD,DUM2(12)
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
      REAL LBOD
C
      DIMENSION LD(2)
C
      RBOD=DMAX/2.0
C
C     DIVERTER
C
      SWETD  = 0.0
      DOUBLE = 0.0
      IF(HDIV .GT. 0.0)THEN
        LD(1) = SQRT((WD(2)/2.)**2.+(XD(2)-XD(1))**2.)
        LD(2) = XD(3) - XD(2)
        DO 10 I=1,2
          SWETD1 = (HD(I+1)+HD(I))*LD(I)
          SWETD  = SWETD + SWETD1
C
C     CALCULATION TO ACCOUNT FOR INLET-DIVERTER INTERFACE
C
          DOUBLE = DOUBLE + 0.5*(WD(I)+WD(I+1))*(XD(I+1)-XD(I))
C
   10   CONTINUE
      ENDIF
C
C     CALCULATE INLET/BODY AREA OVERLAP WHEN NO DIVERTER EXIST
C
      IF(HDIV .LT. 0.0)THEN
        IF(INTYPE .EQ. 1.)THEN
          DO 15 I=1,4
            DOUBLE = DOUBLE + (WI(I) + WI(I+1))/2.*LENGTH(I)
   15     CONTINUE
        ENDIF
        IF(INTYPE .EQ. 2.)THEN
          DO 16 I=1,4
            DOUBLE = DOUBLE + (HI(I) + HI(I+1))/2.*LENGTH(I)
   16     CONTINUE
        ENDIF
        IF(INTYPE .EQ. 3.)THEN
          DO 17 I=2,4
C
C           CALCULATE THE ARC AT THE ENDS OF THIS INLET SECTION THAT 
C           DEFINE BODY/INLET INTERSECTION POINTS AND REMOVE AREA
C           SUBTENDED BY THESE ARCS FROM WETTED AREA
            RINL  = WI(I)/2.
            XINT  = (RBOD**2 + RBOD*RINL + RBOD*HDIV + 
     1              RINL*HDIV + HDIV**2/2.)/ (RBOD + RINL + HDIV)
            YINT  = SQRT(RBOD**2 - XINT**2)
            THETI = 2.*ATAN(YINT/(RBOD+RINL+HDIV-XINT))
            IF(THETI .LT. 0.0)THETI = THETI + 2.0*PI
            ARCI  = THETI*RINL
C
            RINL   = WI(I+1)/2.
            XINT        = (RBOD**2 + RBOD*RINL + RBOD*HDIV + 
     1                    RINL*HDIV + HDIV**2/2.)/ (RBOD + RINL + HDIV)
            YINT        = SQRT(RBOD**2 - XINT**2)
            THETI1 = 2.*ATAN(YINT/(RBOD+RINL+HDIV-XINT))
            IF(THETI1 .LT. 0.0)THETI1 = THETI1 + 2.0*PI
            ARCI1  = THETI1*RINL
            DOUBLE = DOUBLE + (ARCI + ARCI1)/2.*LENGTH(I)
   17     CONTINUE
        ENDIF
      ENDIF            
C
C     INLET
C
      SWETI = 0.0
      IF (INTYPE.NE.3.) THEN
        DO 20 I=1,4
          SWETI1 = (WI(I)+HI(I) + WI(I+1)+HI(I+1))*LENGTH(I)
          SWETI  = SWETI + SWETI1
   20   CONTINUE
      ELSE
        DO 25 I=1,4
          SWETI1 = PI*(WI(I)+WI(I+1))/2.*LENGTH(I)
          SWETI = SWETI + SWETI1
   25   CONTINUE
      ENDIF
C
C     SUM INLET AND DIVERTER WETTED AREAS
C
      SWET = SWETI + SWETD - DOUBLE
      IF ((.NOT.ICOVER).AND.INTYPE.NE.3.) THEN
        SWET = SWET - 0.5*(WI(1)+WI(2))*LENGTH(1)
      ELSEIF ((.NOT.ICOVER).AND.INTYPE.EQ.3.) THEN
        SWET = SWET - PI*WI(2)/2.*LENGTH(1)
      ENDIF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE NAMER(KAND,IUNIT,NLNAME,LENNLN,VNAME,DVNAME,LENVN,
     1                 NUMVN,VDIME,COMBLK,MAXCOM,LOC,IEOF)
C
C***  SIMULATE NAMELIST INPUT.  THE FILE ON IUNIT IS READ UNTIL THE
C***  NAMELIST DEFINED IN NLNAME IS FOUND.  IF FOUND, IT IS READ AND
C***  THE CONSTANTS ASSOCIATED WITH EACH VARIABLE ARE SET INTO THE
C***  ARRAY COMBLK.  IUNIT IS NOT REWOUND BEFORE OR AFTER EXECUTION.
C***  ALL ERROR MESSAGES ARE PRINTED TO UNIT IO (SET TO 6).
C
C   KAND - NAMELIST DELIMITER ($ ON CDC AND VAX, & ON IBM AND OTHER)
C          (BUT CAN BE SPECIFIED TO BE ANY UNIQUE CHARACTER)
C  IUNIT - TAPE UNIT FOR READING
C NLNAME - NAMELIST NAME TO FIND AND READ
C LENNLN - NUMBER OF CHARACTERS IN NAMELIST NAME (DIMENSION OF NLNAME)
C  VNAME - VARIABLE NAMES FOR THIS NAMELIST (AN ARRAY)
C DVNAME - DIMENSION OF VNAME ARRAY
C  LENVN - ARRAY WHICH DEFINES THE NUMBER OF CHARACTERS IN EACH
C          VARIABLE NAME
C  NUMVN - NUMBER OF VARIABLE NAMES DEFINED
C  VDIME - NUMBER OF CONSTANTS PERMITTED FOR EACH VARIABLE
C          (DIMENSION OF EACH VARIABLE; USE NEGATIVE FOR LOGICAL
C           VARIABLES)
C COMBLK - COMMON BLOCK NAME
C MAXCOM - MAXIMUM DIMENSION OF STORAGE ARRAY
C          (USUALLY THE LENGTH OF THE COMMON BLOCK)
C    LOC - POINTER TO STORAGE ARRAY FOR THE STARTING LOCATION
C          OF EACH INPUT VARIABLE (IF ZERO THE CONSTANT IS NOT STORED)
C   IEOF - .TRUE. IF AN END-OF-FILE WAS DETECTED DURING READ
C
C***  NOTES -
C
C***  ALL INPUT STRING ARRAYS MUST BE DECLARED INTEGER
C
C***  ALL VARIABLES ARE ASSUMMED TO BE REAL; IF VDIME IS NEGATIVE
C***  THE VARIABLE IS ASSUMMED TO BE LOGICAL.  ALTHOUGH THE CODE IS
C***  DESIGNED TO HANDLE INTEGERS AS WELL, THIS OPTION IS NOT
C***  CURRENTLY USED.  IT CAN BE ACTIVATED BY PASSING ANOTHER ARRAY,
C***  VTYPE, TO DEFINE THE TYPE OF VARIABLE, WITH THE CODE
C***  0=LOGICAL, 1=INTEGER, OR 2=REAL; THEN REPLACE THE NAME VTYPE
C***  WITH THE NAME VTYPE(NVN) IN THE REMAINING CODE.
C
C***  THIS ROUTINE CAN BE USED AS A NAMELIST ERROR CHECKER BY SETTING
C***  THE ARRAY LOC TO ALL ZEROS.  THE VARIABELS AND CONSTANTS WILL
C***  BE READ, BUT THE CONSTANTS NOT STORED.
C
      INTEGER DVNAME,VTYPE,VDIME
C
      CHARACTER*4 BLANK,EQUAL,COMMA,PARL,PARR,CARET,INUMS,
     1    KOL,INAME,IDIM,INLN,ICONST,KERR,
     2    KAND,VNAME,NLNAME
C
      LOGICAL IEOF,LANS,SEARCH,FOUND,IEND
C
      DIMENSION NLNAME(LENNLN),VNAME(DVNAME),LENVN(NUMVN),
     1          VDIME(NUMVN),COMBLK(MAXCOM),LOC(NUMVN)
      DIMENSION INUMS(13),KOL(80),INAME(80),IDIM(80),INLN(80),
     1          ICONST(80),KERR(80)
C
      DATA BLANK / '    ' /
      DATA EQUAL / '=   ' /
      DATA COMMA / ',   ' /
      DATA PARL  / '(   ' /
      DATA PARR  / ')   ' /
      DATA CARET / '^   ' /
      DATA INUMS / '0   ','1   ','2   ','3   ','4   ','5   ','6   ',
     1             '7   ','8   ','9   ','+   ','-   ','.   '/
      DATA IO    / 6 /
C
C******************************************************************
C***  STAGE 1 - READ CARD AND CHECK FOR KAND AS FIRST CHARACTER ***
C******************************************************************
C
 1000 IEND=.FALSE.
      DO 1010 I=1,80
         INLN(I)=BLANK
         KERR(I)=BLANK
 1010 CONTINUE
C
C***  READ CARD FROM IUNIT
C
 1020 CALL READCD(IUNIT, KOL, IEOF)
      IF(IEOF)GO TO 1290
C
C***  SKIP LEADING BLANKS
C
      ICOL=1
      CALL SKIPBL(KOL, ICOL)
      IF(ICOL .GT. 80)GO TO 1020
C
C***  LOOK FOR KAND FIRST, ELSE READ NEXT CARD
C
      IF(KOL(ICOL) .NE. KAND)GO TO 1020
C
C********************************************************
C***  STAGE 2 - CHECK IF NAMELIST READ IS ONE DESIRED ***
C********************************************************
C
C ... EXTRACT NAMELIST NAME TO BLANK
C
      ICOL=ICOL+1
      LCOL=ICOL
      IECOL=ICOL
      CALL FINDCH(KOL, BLANK, LCOL)
      IF(LCOL .EQ. ICOL)GO TO 1040
C
      CALL EXTRST(KOL, ICOL, LCOL-1, INLN)
C
C ... CHECK FOR NAME MATCH
C
      DO 1030 I=1,LENNLN
         IF(INLN(I) .NE. NLNAME(I))GO TO 1050
 1030 CONTINUE
      ICOL=LCOL
      GO TO 1060
C
C***  KAND FOUND BUT NO NAMELIST NAME FOUND
C
 1040 CONTINUE
C
      WRITE(IO,1310)(KOL(I),I=1,80)
      WRITE(*,1310)(KOL(I),I=1,80)
      KERR(IECOL)=CARET
      WRITE(IO,1410)(KERR(I),I=1,80)
      GO TO 1300
C
C***  NAMELIST NAME DESIRED NOT FOUND, READ UNTIL KAND SEEN AGAIN
C***  (SKIP UNTIL END OF THIS NAMELIST INPUT)
C
 1050 CALL FINDCH(KOL, KAND, ICOL)
      IF(ICOL .LE. 80)GO TO 1000
C
C ... READ CARD FROM IUNIT
C
      CALL READCD(IUNIT, KOL, IEOF)
      IF(IEOF)GO TO 1290
      ICOL=1
      GO TO 1050
C
C****************************************
C***  STAGE 3 - EXTRACT VARIABLE NAME ***
C****************************************
C
 1060 SEARCH=.TRUE.
      IOFF=0
C
      DO 1070 I=1,80
         INAME(I)=BLANK
         IDIM(I)=BLANK
         KERR(I)=BLANK
 1070 CONTINUE
C
C ... SKIP BLANKS
C
      CALL SKIPBL(KOL, ICOL)
C
      IF(ICOL .LT. 81)GO TO 1080
C
C ... READ CARD FROM IUNIT
C
      CALL READCD(IUNIT, KOL, IEOF)
      IF(IEOF)GO TO 1290
      ICOL=1
C
      CALL SKIPBL(KOL, ICOL)
C
 1080 IF((KOL(ICOL) .EQ. KAND) .OR. IEND)GO TO 1290
C
C ... EXTRACT TO =
C
      LCOL=ICOL
      IECOL=ICOL
      CALL FINDCH(KOL, EQUAL, LCOL)
C
      IF(LCOL .LT. 81)GO TO 1090
C
         WRITE(IO,1320)(KOL(I),I=1,80)
         KERR(IECOL)=CARET
         WRITE(IO,1410)(KERR(I),I=1,80)
         GO TO 1300
C
 1090 KNAME=ICOL
      IECOL=KNAME
      CALL EXTRST(KOL, ICOL, LCOL-1, INAME)
C
C ... LOOK FOR ( IN VARIABLE STRING
C
      KK=1
      CALL FINDCH(INAME, PARL, KK)
      IF(KK .GT. 80)GO TO 1130
C
C ... HAVE SUBSCRIPT DEFINED, NOW LOOK FOR )
C
      LL=KK
      CALL FINDCH(INAME, PARR, LL)
C
      IF(LL .LT. 81)GO TO 1100
C
         WRITE(IO,1330)(KOL(I),I=1,80)
         KERR(IECOL)=CARET
         WRITE(IO,1410)(KERR(I),I=1,80)
         GO TO 1300
C
C ... EXTRACT SUBSCRIPT (OFFSET)
C
 1100 CALL EXTRST(INAME, KK+1, LL-1, IDIM)
      KSUB=KNAME+KK
      IECOL=KSUB
C
C ... BLANK ( TO ) IN VARIABLE NAME
C
      DO 1110 I=KK,LL
         INAME(I)=BLANK
 1110 CONTINUE
C
C ... CONVERT OFFSET
C
      CALL TOINT(IDIM, IOFF, IERR)
C
C ... CHECK IF SUBSCRIPT VALID
C
      IF(.NOT.(IERR .NE. 0 .OR. IOFF .LT. 1))GO TO 1120
C
      WRITE(IO,1370)(KOL(I),I=1,80)
      KERR(IECOL)=CARET
      WRITE(IO,1410)(KERR(I),I=1,80)
      GO TO 1300
C
 1120 IOFF=IOFF-1
C
 1130 CONTINUE
C
      ICOL=LCOL+1
C
 1140 IF(KOL(ICOL) .EQ. KAND)IEND=.TRUE.
C
      DO 1150 I=1,80
         ICONST(I)=BLANK
 1150 CONTINUE
C
C***********************************
C***  STAGE 4 - EXTRACT CONSTANT ***
C***********************************
C
C ... EXTRACT TO COMMA OR KAND
C
      LCOL=ICOL
      KCONS=ICOL
      IECOL=KCONS
      CALL FINDCH(KOL, COMMA, LCOL)
C
      IF(LCOL .LT. 81)GO TO 1160
C
C ... COMMA NOT THERE, SEARCH FOR KAND
C
         LCOL=ICOL
         CALL FINDCH(KOL, KAND, LCOL)
C
         IF(LCOL .LT. 81)IEND=.TRUE.
         IF(LCOL .LT. 81)GO TO 1160
C
C ...    NEITHER COMMA NOR KAND, ASSUME COMMA
C
C           CALL FINDCH(KOL, BLANK, IECOL)
C           WRITE(IO,1340)KAND,(KOL(I),I=1,80)
C           KERR(IECOL)=CARET
C           WRITE(IO,1410)(KERR(I),I=1,80)
C
 1160 CALL EXTRST(KOL, ICOL, LCOL-1, ICONST)
C
C ... EXTRACT REPEAT COUNT SPECIFIED IN CONSTANT
C
      IECOL=KCONS
      CALL REPTCT(ICONST, IREPT, IERR)
C
      IF(IERR .EQ. 0 .AND. IREPT .GT. 0)GO TO 1170
C
      WRITE(IO,1390)(KOL(I),I=1,80)
      KERR(IECOL)=CARET
      WRITE(IO,1410)(KERR(I),I=1,80)
      GO TO 1300
C
 1170 ICOL=LCOL+1
C
C*************************************
C***  STAGE 5 - FIND VARIABLE NAME ***
C*************************************
C
C ... SEARCH FOR VARIABLE NAME IN VNAME ARRAY
C
      IECOL=KNAME
      IF(SEARCH)CALL FINDVN(NUMVN, LENVN, INAME, VNAME, DVNAME, NVN,
     1 FOUND)
C
      IF(.NOT.(SEARCH .AND. .NOT. FOUND))GO TO 1180
C
      WRITE(IO,1350)(KOL(I),I=1,80)
      KERR(IECOL)=CARET
      WRITE(IO,1410)(KERR(I),I=1,80)
      GO TO 1300
C
C ... CHECK VARIABLE DIMENSION LIMIT
C
 1180 IECOL=KCONS
C
      IF(.NOT.((IOFF+1) .GT. IABS(VDIME(NVN))))GO TO 1190
C
      WRITE(IO,1370)(KOL(I),I=1,80)
      KERR(IECOL)=CARET
      WRITE(IO,1410)(KERR(I),I=1,80)
      GO TO 1300
C
 1190 LANS=.FALSE.
      IANS=0
      ANS=0.
C
C**************************************
C***  STAGE 6 - SUBSTITUTE CONSTANT ***
C**************************************
C
C ... CONVERT CONSTANT DEPENDING ON TYPE
C
      IECOL=KCONS
C
C ... A NEGATIVE DIMENSION MEANS LOGICAL
C ... ELSE VARIABLE TYPE IS REAL
C
      IF(VDIME(NVN) .LT. 0)VTYPE=0
      IF(VDIME(NVN) .GT. 0)VTYPE=2
C
      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)
C
      IF(IERR .EQ. 0)GO TO 1220
C
      IF(VTYPE .EQ. 1)GO TO 1200
C
         WRITE(IO,1390)(KOL(I),I=1,80)
         KERR(IECOL)=CARET
         WRITE(IO,1410)(KERR(I),I=1,80)
         GO TO 1300
C
 1200 IF(IERR .EQ. 1 .AND. VTYPE .NE. 1)GO TO 1210
C
         WRITE(IO,1390)(KOL(I),I=1,80)
         KERR(IECOL)=CARET
         WRITE(IO,1410)(KERR(I),I=1,80)
         GO TO 1300
C
 1210 IF(IERR .EQ. 2 .AND. VTYPE .NE. 1)GO TO 1220
C
C        WRITE(IO,1400)(KOL(I),I=1,80)
C        KERR(IECOL)=CARET
C        WRITE(IO,1410)(KERR(I),I=1,80)
C
C ... SUBSTITUTE CONSTANT
C
 1220 DO 1250 I=1,IREPT
C
C ...    CHECK VARIABLE DIMENSION LIMIT
C
         IF((I+IOFF) .LE. IABS(VDIME(NVN)))GO TO 1230
C
            IECOL=KCONS
            WRITE(IO,1380)(KOL(J),J=1,80)
            KERR(IECOL)=CARET
            WRITE(IO,1410)(KERR(J),J=1,80)
            GO TO 1300
C
 1230    IF(LOC(NVN) .LT. 1)GO TO 1250
         II=LOC(NVN)+I+IOFF-1
C
C ...    CHECK DATA BLOCK SIZE LIMIT
C
         IF(II .LE. MAXCOM)GO TO 1240
C
            WRITE(IO,1360)(KOL(J),J=1,80)
            KERR(IECOL)=CARET
            WRITE(IO,1410)(KERR(J),J=1,80)
            GO TO 1300
C
C ...    SUBSTITUTE CONSTANT DEPENDING ON TYPE
C
 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)
C
 1250 CONTINUE
C
C ... UPDATE OFFSET IN CASE NEXT INPUT IS A CONSTANT INSTEAD OF A
C ... VARIABLE NAME
C
      IOFF=IOFF+IREPT
C
C ... CHECK IF NEXT INPUT IS A NUMERIC OR LOGICAL
C
      CALL SKIPBL(KOL, ICOL)
C
C ... IF KAND PREVIOUSLY DETECTED, EXIT
C
      IF(IEND)GO TO 1290
C
      IF(ICOL .LT. 81)GO TO 1260
C
C ... READ NEXT CARD
C
      CALL READCD(IUNIT, KOL, IEOF)
      IF(IEOF)GO TO 1290
      ICOL=1
C
      CALL SKIPBL(KOL, ICOL)
C
C ... CHECK IF NEXT NON-BLANK CHARACTER SPECIFIES A NUMERIC OR
C ... LOGICAL INPUT
C
 1260 DO 1270 I=1,13
         IF(KOL(ICOL) .EQ. INUMS(I))GO TO 1280
 1270 CONTINUE
C
C ... NO, SEARCH FOR NEXT VARIABLE NAME INPUT
C
      IERR=0
      GO TO 1060
C
C ... YES, SEARCH FOR NEXT INPUT CONSTANT
C
 1280 SEARCH=.FALSE.
      IERR=0
      GO TO 1140
C
 1290 CONTINUE
C
      RETURN
C
 1300 WRITE(IO,1420)
      STOP
C
 1310 FORMAT(8X,'*** NAMELIST INPUT ERROR.',
     1 ' ILLEGAL/INCORRECT SPECIFICATION OF NAMELIST NAME.',
     2 /,1X,80A1)
 1320 FORMAT(8X,'*** NAMELIST INPUT ERROR.',
     1 ' NO EQUALS FOLLOWING VARIABLE NAME.',/,1X,80A1)
 1330 FORMAT(8X,'*** NAMELIST INPUT ERROR.',
     1 ' NO CLOSING RIGHT PARENTHESIS IN ARRAY DEFINITION.',
     2 /,1X,80A1)
C1340 FORMAT(8X,'*** NAMELIST INPUT ERROR.',
C    1 ' NO TERMINATING COMMA OR'A1,' AFTER CONSTANT.',
C    2 ' A COMMA HAS BEEN ASSUMED.',/,1X,80A1)
 1350 FORMAT(8X,'*** NAMELIST INPUT ERROR.',
     1 ' VARIABLE NAME NOT IN NAMELIST.',/,1X,80A1)
 1360 FORMAT(8X,'*** NAMELIST INPUT ERROR.',
     1 ' ARRAY SUBSCRIPT OR NUMBER OF CONSTANTS EXCEEDS VARIABLE,',
     2 ' DIMENSION OR COMMON BLOCK SIZE.',/,1X,80A1)
 1370 FORMAT(8X,'*** NAMELIST INPUT ERROR.',
     1 ' ILLEGAL/INVALID ARRAY SUBSCRIPT.',/,1X,80A1)
 1380 FORMAT(8X,'*** NAMELIST INPUT ERROR.',
     1 ' REPEAT COUNT EXCEEDS VARIABLE ARRAY DIMENSION.',/,1X,80A1)
 1390 FORMAT(8X,'*** NAMELIST INPUT ERROR.',
     1 ' CONSTANT DOES NOT MATCH TYPE OF INPUT REQUIRED.',/,1X,80A1)
C1400 FORMAT(8X,'*** NAMELIST INPUT ERROR.'
C    1 ' REAL NUMBER SPECIFIED FOR INTEGER, CONVERTED.',/,1X,80A1)
 1410 FORMAT(1X,80A1)
 1420 FORMAT(8X,'*** EXECUTION TERMINATING DUE TO NAMELIST ERROR.')
C
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RDEFL(LDEFL, AA)
C
C***  READ INCIDENCE CONTROL DEVICE INPUTS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION AA(40),NLNAME(6),IVNAME(34),LEN(6),IDIM(6),LOC(6)
C
      LOGICAL LDEFL,IEOF
C
      DATA NLNAME /  'D   ','E   ','F   ','L   ','C   ','T   '/
      DATA IVNAME /  'D   ','E   ','L   ','T   ','A   ','1   ','D   ',
     1 'E   ','L   ','T   ','A   ','2   ','D   ','E   ','L   ','T   ',
     2 'A   ','3   ','D   ','E   ','L   ','T   ','A   ','4   ','X   ',
     3 'H   ','I   ','N   ','G   ','E   ','S   ','K   ','E   ','W   '/
      DATA IDIM   / 8,8,8,8,4,4 /
      DATA LEN    / 6,6,6,6,6,4 /
      DATA LOC    / 1,9,17,25,33,37 /
C
      LDEFL=.TRUE.
C
      CALL NAMER(KAND,2,NLNAME,6,IVNAME,34,LEN,6,IDIM,AA,40,LOC,IEOF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE STBODY(IM)
C
C***  SUBROUTINE TO COMPUTE THE SUBSONIC AND TRANSONIC
C***  CHARACTERISTICS OF AXISYMMETRIC BODIES
C
C***  COMPUTE NORMAL FORCE
C
      CALL BODYCN(IM,CNAN,CNAC,CNABT)
C
C***  COMPUTE AXIAL FORCE
C
      CALL BODYCA(IM)
C
C***  COMPUTE PITCHING MOMENT
C
      CALL BODYCM(IM,CNAN,CNAC,CNABT)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WEDGE(MACH,DELTA,THETA,CP)
C
C***  COMPUTE THE SHOCK ANGLE FROM AND THE PRESSURE COEFFICIENT
C***  BEHIND THE SHOCK DUE TO A TWO-DIMENSIONAL WEDGE IN
C***  SUPERSONIC FLOW
C
C***  INPUTS
C
C  MACH - FREESTREAM MACH NUMBER
C DELTA - WEDGE HALF-ANGLE (DEGREES)
C
C***  OUTPUTS
C
C THETA - SHOCK WAVE ANGLE (DEG)
C    CP - PRESSURE COEFFICIENT
C
C***  METHOD FROM NACA 1135
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL MACH
C
C***  SOLVE CUBIC EQUATION FOR SHOCK ANGLE
C
  100 CONTINUE
      B=-(MACH**2+2)/MACH**2-7./5.*SIN(DELTA/RAD)**2
      C=(2.*MACH**2+1.)/MACH**4+(36./25.+2./(5.*MACH**2))*
     1   SIN(DELTA/RAD)**2
      D=-COS(DELTA/RAD)**2/MACH**4
      COSP=(9./2.*B*C-B**3-27./2.*D)/(B*B-3.*C)**1.5
      IF(ABS(COSP).LE.1.0) GO TO 200
      DELTA=DELTA-1.0
      GO TO 100
  200 CONTINUE
      PHI=ACOS(COSP)
C
C***  N=0 IS STRONG SHOCK SOLUTION
C***  N=2 IS DECREASE IN ENTROPY (DISREGARD)
C***  N=4 IS WEAK SHOCK SOLUTION
C
C***  FOLLOWING METHOD USES N=4
C***  ..........................................N.........
      SIN2T=-B/3.+2./3.*SQRT(B*B-3.*C)*COS((PHI+4.*PI)/3.)
C
      THETA=ASIN(SQRT(SIN2T))*RAD
C
C***  WITH SHOCK ANGLE KNOWN, CALCULATE PRESSURE COEFFICIENT
C
      CP=5./3.*(MACH**2*SIN(THETA/RAD)**2-1.)/MACH**2
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ASOSL(CR, CT, B, TR, TT, RLER, RLET, RTER,
     1                 RTET, SWP1, MACH,
     2                 XM, ZM, XU, ZU, L, FAIL)
C
C     CONSTRUCT ROOT AND TIP LOCATIONS OF SOURCE OR SINK LINES
C     (SOSL), SURFACE SLOPES, AND ASSOCIATED GEOMETRY FOR
C     CIRCULAR ARC AIRFOILS
C
C     INPUT VARIABLES
C            CR - ROOT CHORD
C            CT - TIP CHORD
C             B - SPAN OF TWO PANELS ALONE
C            TR - ROOT THICKNESS
C            TT - TIP THICKNESS
C          RLER - ROOT L.E. RADIUS
C          RLET - TIP L.E. RADIUS
C          RTER - ROOT T.E. RADIUS
C          RTET - TIP T.E. RADIUS
C          SWP1 - L.E. SWEEP, DEG.
C          MACH - MACH NUMBER
C
C     OUTPUT VARIABLES
C            XM - X-LOCATIONS OF INTERSECTION OF RLE AND FWD WEDGE
C            ZM - Z-LOCATIONS OF INTERSECTION OF RLE AND FWD WEDGE
C            XU - X-LOCATIONS ON RLE WHERE SLOPE IS 15 DEG.
C            ZU - Z-LOCATIONS ON RLE WHERE SLOPE IS 15 DEG.
C             L - NUMBER OF SOSL POINTS ON BLUNT L.E.
C
C     OUTPUT VARIABLES - COMMON /CAFD/
C            XO - ROOT LOCATIONS OF SOSL
C            XT - TIP LOCATIONS OF SOSL
C         DZDXO - ROOT SURFACE SLOPES FWD OF XO
C         DZDXT - TIP SURFACE SLOPES FWD OF XT
C           TGA - TAN OF SOSL SWEEP BACK
C           ETA - TGA/BETA WHERE BETA = SQRT(MACH**2-1)
C            NS - NUMBER OF SOSL POINTS
C
      REAL MACH
C
      DIMENSION XM(2), ZM(2), XU(2), ZU(2)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /CAFD/  XO(60), XT(60), DZDXO(60), DZDXT(60), TGA(60),
     1               ETA(60), DZDX(60), NS, CPO
C
      LOGICAL FAIL
C     ...
C     ... SET GEOMETRIC CONSTANTS
C     ...
      B2   = B/2.0
      SWP4 = (B2*TAN(SWP1/RAD)+CT-CR)/B2
      SWP4 = RAD*ATAN(SWP4)
      CS1  = COS(SWP1/RAD)
      RLE  = (RLER+RLET)/2.0
      RTE  = (RTER+RTET)/2.0
      XT1  = B2*TAN(SWP1/RAD)
      IF(RLE .GE. 1.E-4) GO TO 10
C       ...
C       ... SHARP L.E.
C       ...
        XO(1) = 0.0
        XT(1) = XT1
        XM(1) = 0.0
        ZM(1) = 0.0
        XM(2) = 0.0
        ZM(2) = 0.0
        XU(1) = 0.0
        ZU(1) = 0.0
        XU(2) = 0.0
        ZU(2) = 0.0
        RRF = TR*((0.5*CR/TR)**2+0.25)
        RTF = TT*((0.5*CT/TT)**2+0.25)
        DRF = ASIN(0.5*CR/RRF)
        DTF = ASIN(0.5*CT/RTF)
C
        DZDXO(1) = 0.0
        DZDXO(2) = TAN(DRF)
        DZDXT(1) = 0.0
        DZDXT(2) = TAN(DTF)
        L  = 0
   10 CONTINUE
      IF(RLE .LT. 1.E-4) GO TO 30
C       ...
C       ... BLUNT L.E.
C       ...
        IF(RLER .LT. 1.E-4) RLER = 1.E-4
        IF(RLET .LT. 1.E-4) RLET = 1.E-4
        CALL AXZU(RLER, TR, CR, SWP1, XU(1), ZU(1), DZDXUR,
     1            XM(1), ZM(1), RRF)
        CALL AXZU(RLET, TT, CT, SWP1, XU(2), ZU(2), DZDXUT,
     1            XM(2), ZM(2), RTF)
C
        DELR = RAD*ATAN(DZDXUR)
        DELT = RAD*ATAN(DZDXUT)
C
        LR = 17.0-DELR
        LT = 17.0-DELT
        L  = LR
        IF(LT .GT. LR) L = LT
C
        IF(L .LE. 1) FAIL=.TRUE.
        IF(FAIL .AND. PARTS(18)) WRITE(6,110)
        IF(FAIL) GO TO 100
C
        XO(1)    = XM(1)-ZM(1)**2/(CS1*(RLER-XM(1)*CS1))
        XT(1)    = XM(2)-ZM(2)**2/(CS1*(RLET-XM(2)*CS1))+XT1
        DZDXO(1) = 0.0
        DZDXT(1) = 0.0
        DZDXO(2) = TAN(15.0/RAD)
        DZDXT(2) = DZDXO(2)
C
        DO 20 I=2,L
          DELTA = 17-I
C         ...
C         ... ROOT
C         ...
          TAND = TAN(DELTA/RAD)
          IF(DELTA .LT. DELR) TAND = DZDXUR
          GG       = SQRT(TAND*TAND/(CS1*CS1+TAND*TAND))
          XO(I)    = RLER*(1.0-GG)/CS1
          DZDXO(I+1) = TAND
C         ...
C         ... TIP
C         ...
          TAND = TAN(DELTA/RAD)
          IF(DELTA .LT. DELT) TAND = DZDXUT
          GG       = SQRT(TAND*TAND/(CS1*CS1+TAND*TAND))
          XT(I)    = RLET*(1.0-GG)/CS1+XT1
          DZDXT(I+1) = TAND
   20   CONTINUE
        XO(L+1) = XU(1)
        XT(L+1) = XU(2)+XT1
        DZDXO(L+2) = DZDXUR
        DZDXT(L+2) = DZDXUT
   30 CONTINUE
C     ...
C     ... REMAINDER OF AIRFOIL
C     ...
      IF(RTE .GE. 1.E-4) GO TO 40
C       ...
C       ... SHARP T.E.
C       ...
        XUR = 0.0
        ZUR = 0.0
        XUT = 0.0
        ZUT = 0.0
        RRA = TR*((0.5*CR/TR)**2+0.25)
        RTA = TT*((0.5*CT/TT)**2+0.25)
   40 CONTINUE
      IF(RTE .LT. 1.E-4) GO TO 50
C       ...
C       ... BLUNT T.E.
C       ...
        CALL AXZU(RTER, TR, CR, SWP4, XUR, ZUR, DZDXUR,
     1            XMR, ZMR, RRA)
        CALL AXZU(RTET, TT, CT, SWP4, XUT, ZUT, DZDXUT,
     1            XMT, ZMT, RTA)
   50 CONTINUE
C
      DXR = (CR-XU(1)-XUR)/32.0
      DXT = (CT-XU(2)-XUT)/32.0
      CR2 = CR/2.0
      CT2 = CT/2.0+B2*TAN(SWP1/RAD)
      N1  = L+2
      NS  = L+33
      NC  = L+18
      DO 80 I=N1,NS
        XO(I) = XO(I-1)+DXR
        XT(I) = XT(I-1)+DXT
        IF(I .GT. NC) GO TO 60
C         ...
C         ... FWD ARC
C         ...
          SIND       = (CR2-XO(I-1))/RRF
          DZDXO(I+1) = TAN(ASIN(SIND      ))
          SIND       = (CT2-XT(I-1))/RTF
          DZDXT(I+1) = TAN(ASIN(SIND))
   60   CONTINUE
        IF(I .LE. NC) GO TO 70
C         ...
C         ... AFT ARC
C         ...
          SIND       = (CR2-XO(I-1))/RRA
          DZDXO(I+1) = TAN(ASIN(SIND  ))
          SIND       = (CT2-XT(I-1))/RTA
          DZDXT(I+1) = TAN(ASIN(SIND))
   70   CONTINUE
   80 CONTINUE
      DZDXO(NS+1) = 0.0
      DZDXT(NS+1) = 0.0
C     ...
C     ... CONSTRUCT TGA AND ETA
C     ...
      BETA = SQRT(MACH**2-1.0)
      DO 90 I=1,NS
        TGA(I) = (XT(I)-XO(I))/B2
        ETA(I) = TGA(I)/BETA
        IF((ETA(I).GT.0.98) .AND. (ETA(I).LE.1.))ETA(I) = 0.98
   90 CONTINUE
C
  100 CONTINUE
C
  110 FORMAT(4X,'FIN POTENTIAL FLOW METHOD FAILING.  NOSE CAP/',
     1  'WEDGE ANGLE > THAN 15 DEGREES.')
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BODNWT(IDCRX)
C***********************************************************************
C
C     THIS SUBROUTINE ACCOUNTS FOR BODY CROSS FLOW CONTRIBUTIONS
C     THAT DO NOT ACTUALLY EXIST BECAUSE THE INLET DIVERTER.  THESE
C     FORCE CONTRIBUTIONS ARE CALCULATED AND THEN SUBTRACTED FROM THE
C     INLET CROSS FLOW FORCE CALCULATIONS.
C
C***********************************************************************
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      REAL MINARC,M
C
      DELFOR(P,M)=1./3.*(SIN(P)*(COS(P)**2+2.)-SIN(M)*(COS(M)**2+2.))
C
C     DETERMINE THE ARC LENGTH COVERED BY THE INLET OR DIVERTER
      NUMI=NIN+0.5
      DO 100 INLET=1,NUMI
C
C     INITIALIZE VARIABLES
        DLCNBP(IDCRX,INLET) = 0.0
        DLCNBN(IDCRX,INLET) = 0.0
        DLCYBP(IDCRX,INLET) = 0.0
        DLCYBN(IDCRX,INLET) = 0.0
C
        PHIPR = PHI(INLET)/RAD+RARC(IDCRX)
        PHIMR = PHI(INLET)/RAD-RARC(IDCRX)
        COSPR = COS(PHIPR)
        COSMR = COS(PHIMR)
        SINPR = SIN(PHIPR)
        SINMR = SIN(PHIMR)
        IF (ABS(COSPR).LT.0.00001) COSPR = 0.0
        IF (ABS(COSMR).LT.0.00001) COSMR = 0.0
        IF (ABS(SINPR).LT.0.00001) SINPR = 0.0
        IF (ABS(SINMR).LT.0.00001) SINMR = 0.0
C
C     FOR POSITIVE ANGLES OF ATTACK
C       CHECK IF ANY PART OF INLET IS IN SECOND AND THIRD QUADRANT
        IF(COSPR.LE.0..OR.COSMR.LE.0.)THEN
C         FIRST AND SECOND QUADRANT
          IF(COSMR.GT.0.)THEN
            PLSARC =PHIPR-PI
            MINARC =-PI/2.0
C         THIRD AND FOURTH QUADRANT
          ELSEIF(COSPR.GT.0.0)THEN
            PLSARC =PI/2.0 
            MINARC =PHIMR-PI
C         FULLY IN SECOND AND THIRD QUADRANT
          ELSE
            PLSARC =PHIPR-PI 
            MINARC =PHIMR-PI
          ENDIF
          DLCNBP(IDCRX,INLET) = DELFOR(PLSARC,MINARC)
        ENDIF
C
C     FOR NEGATIVE ANGLES OF ATTACK
C       CHECK IF ANY PART OF INLET IS IN FOURTH OR FIRST QUADRANT
        IF(COSPR.GE.0..OR.COSMR.GE.0.)THEN
C         FIRST AND SECOND QUADRANT
          IF(COSPR.LT.0.)THEN
            PLSARC =PI/2.0
            MINARC =PHIMR
C         THIRD AND FOURTH QUADRANT
          ELSEIF(COSMR.LT.0.0)THEN
            PLSARC =PHIPR-2.0*PI
            MINARC =-PI/2.0
C         FOURTH AND FIRST QUADRANT
          ELSEIF(PHI(INLET).GE.0.0.AND.PHI(INLET).LE.90.) THEN
            PLSARC =PHIPR
            MINARC =PHIMR
          ELSE
            PLSARC =PHIPR-2.0*PI
            MINARC =PHIMR-2.0*PI
          ENDIF
          DLCNBN(IDCRX,INLET) = DELFOR(PLSARC,MINARC)
        ENDIF
C
C     FOR POSITIVE SIDE-SLIP ANGLES 
C       CHECK IF ANY PART OF INLET IS IN FIRST OR SECOND QUADRANT
        IF(SINPR.GE.0..OR.SINMR.GE.0.)THEN
C         FOURTH AND FIRST QUADRANT
          IF(SINMR.LT.0.)THEN
            PLSARC =PHIPR-PI/2.0
            MINARC =-PI/2.0
C         SECOND AND THIRD QUADRANT
          ELSEIF(SINPR.LT.0.0)THEN
            PLSARC =PI/2.0
            MINARC =PHIMR-PI/2.0
C         FULLY IN FIRST OR SECOND QUADRANT
          ELSE
            PLSARC =PHIPR-PI/2.0
            MINARC =PHIMR-PI/2.0
          ENDIF
          DLCYBP(IDCRX,INLET) = DELFOR(PLSARC,MINARC)
        ENDIF
C
C     FOR NEGATIVE SIDE-SLIP ANGLES 
C       CHECK IF ANY PART OF INLET IS IN THIRD OR FOURTH QUADRANT
        IF(SINPR.LE.0..OR.SINMR.LE.0.)THEN
C         FOURTH AND FIRST QUADRANT
          IF(SINPR.GT.0.)THEN
            PLSARC =PI/2.0
            MINARC =PHIMR-3.0*PI/2.0
C         SECOND AND THIRD QUADRANT
          ELSEIF(SINMR.GT.0.0)THEN
            PLSARC =PHIPR-3.0*PI/2.0
            MINARC =-PI/2.0
C         FULLY IN THIRD AND FOURTH QUADRANT
          ELSE
            PLSARC =PHIPR-3.0*PI/2.0
            MINARC =PHIMR-3.0*PI/2.0
          ENDIF
          DLCYBN(IDCRX,INLET) = DELFOR(PLSARC,MINARC)
        ENDIF
  100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CONVRT(VALUE,NPTS,ITYPE)
C
C**  ROUTINE TO CHANGE THE UNITS OF A PARAMETER
C
C***  INPUTS
C
C  VALUE -- VALUE OR ARRAY OF VALUES TO BE CONVERTED
C   NPTS -- NUMBER OF POINTS
C  ITYPE -- TYPE OF CONVERSION TO BE PERFORMED
C   VALUE OF ITYPE            CONVERSION PERFORMED
C        -3                VOLUME FROM SPECIFIED UNITS TO FEET**3
C        -2                AREA FROM SPECIFIED UNITS TO FEET**2
C        -1                LENGTH FROM SPECIFIED UNITS TO FEET
C         1                LENGTH FROM FEET TO SPECIFIED UNITS
C         2                AREA FROM FEET**2 TO SPECIFIED UNITS
C         3                VOLUME FROM FEET**3 TO SPECIFIED UNITS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      DIMENSION VALUE(NPTS)
C
      IF(NPTS .LE. 0)GO TO 1070
      IF(.NOT.(LDIMIN .OR. LDIMCM .OR. LDIMM))GO TO 1070
C
      JUMP=ITYPE+4
      IF(JUMP .LT. 1 .OR. JUMP .GT. 7)GO TO 1070
C
      DO 1060 I=1,NPTS
C
      IF(VALUE(I) .EQ. UNUSED)GO TO 1060
C
      GO TO (1000,1010,1020,1060,1030,1040,1050), JUMP
C
C  CONVERT VOLUME TO FEET**3
C
 1000 CONTINUE
      IF(LDIMM)VALUE(I)=VALUE(I)*(3.28)**3
      IF(LDIMIN)VALUE(I)=VALUE(I)/(12.)**3
      IF(LDIMCM)VALUE(I)=VALUE(I)/(2.54*12.)**3
      GO TO 1060
C
C  CONVERT AREA TO FEET**2
C
 1010 CONTINUE
      IF(LDIMM)VALUE(I)=VALUE(I)*(3.28)**2
      IF(LDIMIN)VALUE(I)=VALUE(I)/(12.)**2
      IF(LDIMCM)VALUE(I)=VALUE(I)/(2.54*12.)**2
      GO TO 1060
C
C  CONVERT LENGTH TO FEET
C
 1020 CONTINUE
      IF(LDIMM)VALUE(I)=VALUE(I)*3.28
      IF(LDIMIN)VALUE(I)=VALUE(I)/12.
      IF(LDIMCM)VALUE(I)=VALUE(I)/(2.54*12.)
      GO TO 1060
C
 1030 CONTINUE
C
C  CONVERT LENGTH FROM FEET
C
      IF(LDIMM)VALUE(I)=VALUE(I)/3.28
      IF(LDIMIN)VALUE(I)=VALUE(I)*12.
      IF(LDIMCM)VALUE(I)=VALUE(I)*(2.54*12.)
      GO TO 1060
C
 1040 CONTINUE
C
C  CONVERT AREA FROM FEET**2
C
      IF(LDIMM)VALUE(I)=VALUE(I)/(3.28)**2
      IF(LDIMIN)VALUE(I)=VALUE(I)*(12.)**2
      IF(LDIMCM)VALUE(I)=VALUE(I)*(2.54*12.)**2
      GO TO 1060
C
 1050 CONTINUE
C
C  CONVERT VOLUME FROM FEET**3
C
      IF(LDIMM)VALUE(I)=VALUE(I)/(3.28)**3
      IF(LDIMIN)VALUE(I)=VALUE(I)*(12.)**3
      IF(LDIMCM)VALUE(I)=VALUE(I)*(2.54*12.)**3
C
 1060 CONTINUE
C
 1070 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE DIVNWT(ICRX)
C
C     THIS SUBROUTINE COMPUTES THE RATIO OF NORMAL FORCE COEFFICIENT
C     ON A DIVERTER CROSS SECTION AND NORMAL FORCE COEFFICIENT ON
C     A CIRCULAR CROSS SECTION.  THIS VALUE CAN THEN BE USED TO APPLY
C     THE CIRCULAR CROSSFLOW DRAG COEFFICIENT TO NON-CIRCULAR CROSS
C     SECTIONS.
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
C                  *********************
C                  * INPUT/OUTPUT LIST *
C                  *********************
C
C
C     ***** INPUTS *****          ***** OUTPUTS *****
C
C           NPAN                        CNNDZP
C           ICRX                        CNNDZN
C           THETAD                      CNNDYP
C           PI                          CNNDYN
C           HALFPI
C           CRXDWD
C           CRXDHT
C           CNCIRN
C
C     SUBROUTINES USED: NONE
C
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      NUMI=NIN+0.5
      DO 100 INLET=1,NUMI
C
C       INITIALIZE SUMMING VARIABLES
        CNNDZP(ICRX,INLET) = 0.0
        CNNDZN(ICRX,INLET) = 0.0
        CNNDYP(ICRX,INLET) = 0.0
        CNNDYN(ICRX,INLET) = 0.0
C
C     BEGIN LOOP FOR EACH PANEL
        DO 110 IPAN = 1, 3, 2
C
C          INITIALIZE NEWTONIAN PRESSURE COEFFICIENT FOR LEE SURFACES
C          OR WINDWARD SURFACES
           IF (COS(THETAD(IPAN,INLET)).LE.0.00001) THEN
             CPZP=-2.0*COS(THETAD(IPAN,INLET))**2
             CPZN=0.0
           ELSE
             CPZP=0.0
             CPZN=2.0*COS(THETAD(IPAN,INLET))**2
           ENDIF
C
C          INITIALIZE NEWTONIAN PRESSURE COEFFICIENT FOR LEE SURFACES
C          OR WINDWARD SURFACES
           IF (SIN(THETAD(IPAN,INLET)).GE.-0.00001) THEN
             CPYP=2.0*COS(THETAD(IPAN,INLET))**2
             CPYN=0.0
           ELSE
             CPYP=0.0
             CPYN=-2.0*COS(THETAD(IPAN,INLET))**2
           ENDIF
C
C          DETERMINE PANEL CONTRIBUTION TO NEWTONIAN CN
           CNNDZP(ICRX,INLET) = CNNDZP(ICRX,INLET) +
     1          CPZP * COS(THETAD(IPAN,INLET)) * PANDLN(IPAN,ICRX)
           CNNDZN(ICRX,INLET) = CNNDZN(ICRX,INLET) +
     1          CPZN * COS(THETAD(IPAN,INLET)) * PANDLN(IPAN,ICRX)
           CNNDYP(ICRX,INLET) = CNNDYP(ICRX,INLET) +
     1          CPYP * SIN(THETAD(IPAN,INLET)) * PANDLN(IPAN,ICRX)
           CNNDYN(ICRX,INLET) = CNNDYN(ICRX,INLET) +
     1          CPYN * SIN(THETAD(IPAN,INLET)) * PANDLN(IPAN,ICRX)
C
  110   CONTINUE
C
C       SET DEFAULTS FOR REFERENCE WIDTH AND HEIGHT
        REFWID = 1.0
        REFHGT = 1.0
C
C       USE MAXIMUM WIDTH IF NONZERO
        IF (CRXDWD(ICRX,INLET) .GT. 0.0) REFWID = CRXDWD(ICRX,INLET)
C
C       USE MAXIMUM HEIGHT IF NONZERO
        IF (CRXDHT(ICRX,INLET) .GT. 0.0) REFHGT = CRXDHT(ICRX,INLET)
C
C       NORMALIZE NEWTONIAN CN WRT REFERENCE HEIGHT AND WIDTH AND
C       NEWTONIAN CIRCULAR CN
        CNNDZP(ICRX,INLET) = CNNDZP(ICRX,INLET) / (REFWID * CNCIRN)
        CNNDZN(ICRX,INLET) = CNNDZN(ICRX,INLET) / (REFWID * CNCIRN)
        CNNDYP(ICRX,INLET) = CNNDYP(ICRX,INLET) / (REFHGT * CNCIRN)
        CNNDYN(ICRX,INLET) = CNNDYN(ICRX,INLET) / (REFHGT * CNCIRN)
C
  100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCNAAH(MACH, DELY, SLE, ALPHA, CNA, CNAA)
C ***
C *** COMPUTES SUPERSONIC NON-LINEAR NORMAL FORCE PER SINE(ALP)**2
C ***
C *** REFERENCE   DATCOM SECTION 4.1.3.3
C ***
C *** LIMITATIONS   ALP .LT. 90 DEG
C ***               STRAIGHT TAPERED FINS
C ***
C *** INPUT   MACH    MACH NUMBER
C ***         DELY    DIFFERENCE IN AIRFOIL ORDINATE BETWEEN
C ***                 .15% AND 6% CHORD,PER CENT CHORD LENGTH
C ***         SLE     LEADING EDGE SWEEP ANGLE, DEG
C ***         ALP     ANGLE-OF-ATTACK, DEG
C ***         CNA     LINEAR CN, CN PER ALP AT ALP = 0, 1/DEG
C ***
C *** OUTPUT  CNAA    CN PER SIN(ALP)**2,REFERENCED TO EXPOSED
C ***                 PLANFORM AREA OF TWO PANELS
C ***
C ***
C
      COMMON /CONST/PI,RAD,UNUSED,KAND
C
      DIMENSION XRCNA(11), YRCNA(8), ZRCNAL(88), ZRCNAR(88)
      DIMENSION XC(9), YC(11), ZC(99)
      DIMENSION X59BL(6), Y59B(10), Z59BL(60), X59BR(11), Z59BR(110)
      DIMENSION X60AL(6), Y60A(12), Z60AL(72), X60AR(13), Z60AR(156)
      DIMENSION Z60AR1(78), Z60AR2(78)
      DIMENSION X61A(9), Y61A(9)
C
      EQUIVALENCE (Z60AR(1),Z60AR1(1)), (Z60AR(79),Z60AR2(1))
C
      REAL MACH
C
C ***
C *** DATA STATEMENTS
C ***
      DATA DUM / 1.0 /
C ***
C *** DATCOM FIGURE 4.1.3.2-60    (CNA/CNAT)
C ***
      DATA XRCNA / 0.00,  .10,  .20,  .30,  .40,  .50,  .60,  .70,
     *              .80,  .90, 1.00 /
      DATA YRCNA / 0.0,  4.0,  8.0, 12.0, 20.0, 30.0, 50.0, 70.0 /
      DATA ZRCNAL /
     *     1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000,
     *     1.000, 1.000, 1.000,
     *     1.050, 1.050, 1.050, 1.050, 1.050, 1.050,  .985,  .945,
     *      .915,  .900,  .900,
     *     1.040, 1.040, 1.040, 1.040, 1.040, 1.040,  .965,  .908,
     *      .870,  .850,  .840,
     *     1.120, 1.120, 1.120, 1.120, 1.120, 1.015,  .940,  .880,
     *      .838,  .810,  .796,
     *     1.110, 1.110, 1.110, 1.110, 1.110, 1.000,  .903,  .840,
     *      .795,  .765,  .750,
     *     1.080, 1.080, 1.080, 1.080, 1.080,  .954,  .865,  .800,
     *      .750,  .720,  .700,
     *     1.200, 1.200, 1.200, 1.200, 1.043,  .907,  .817,  .750,
     *      .707,  .675,  .660,
     *     1.140, 1.140, 1.140, 1.140,  .975,  .857,  .772,  .717,
     *      .675,  .650,  .632 /
      DATA ZRCNAR /
     *     1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000,
     *     1.000, 1.000, 1.000,
     *     1.150, 1.150, 1.150, 1.150, 1.095, 1.040,  .990,  .960,
     *      .935,  .915,  .900,
     *     1.120, 1.120, 1.120, 1.120, 1.050,  .985,  .940,  .905,
     *      .880,  .857,  .840,
     *     1.150, 1.150, 1.150, 1.080, 1.005,  .945,  .902,  .870,
     *      .842,  .820,  .796,
     *     1.220, 1.140, 1.050,  .980,  .930,  .890,  .853,  .823,
     *      .795,  .770,  .750,
     *     1.130, 1.050,  .980,  .925,  .880,  .845,  .810,  .782,
     *      .752,  .730,  .700,
     *     1.020,  .942,  .895,  .855,  .820,  .790,  .760,  .735,
     *      .710,  .685,  .660,
     *     1.000,  .920,  .870,  .825,  .790,  .755,  .728,  .700,
     *      .678,  .655,  .632 /
C ***
C *** DATCOM FIGURE 4.1.3.3-59A   (C)
C ***
      DATA XC /  0.0, 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, 70.0, 80.0 /
      DATA YC /  .70,  .80,  .90, 1.00, 1.10, 1.25, 1.50, 2.00, 2.50,
     *          3.00, 3.25 /
      DATA ZC / 0.00, 3.50, 4.95, 5.85, 6.40, 6.83, 7.25, 7.57, 7.85,
     *          0.00, 3.00, 4.19, 4.95, 5.58, 6.04, 6.49, 6.80, 7.00,
     *          0.00, 2.34, 3.40, 4.00, 4.49, 4.91, 5.28, 5.63, 5.92,
     *          0.00, 1.86, 2.78, 3.20, 3.53, 3.90, 4.25, 4.60, 4.85,
     *          0.00, 1.42, 2.20, 2.68, 3.05, 3.34, 3.62, 3.87, 4.06,
     *          0.00, 1.10, 1.62, 1.94, 2.19, 2.40, 2.64, 2.80, 2.95,
     *          0.00,  .92, 1.35, 1.65, 1.84, 2.00, 2.17, 2.28, 2.35,
     *          0.00,  .73, 1.10, 1.35, 1.54, 1.67, 1.76, 1.83, 1.85,
     *          0.00,  .62,  .94, 1.00, 1.10, 1.12, 1.12, 1.10, 1.09,
     *          0.00,  .54,  .72,  .68,  .42, 0.00, 0.00, 0.00, 0.00,
     *          0.00,  .45,  .63,  .51,  .23, 0.00, 0.00, 0.00, 0.00 /
C ***
C *** DATCOM FIGURE 4.1.3.3-59B   (SUBSONIC LE CNAA)
C ***
      DATA X59BL /  0.,   .5,   .6,   .7,   .8,  1.0 /
      DATA Y59B  /     .6,   .8,  1.0,  1.2,  1.6,  2.0,  2.4,  2.6,
     *                2.8,  3.0 /
      DATA Z59BL /  2*2.03, 1.95, 1.90, 1.86, 1.78,
     *              2*1.94, 1.87, 1.82, 1.77, 1.70,
     *              2*1.82, 1.75, 1.69, 1.64, 1.57,
     *              2*1.71, 1.63, 1.58, 1.54, 1.46,
     *              2*1.51, 1.44, 1.37, 1.32, 1.24,
     *              2*1.32, 1.24, 1.16, 1.10,  .99,
     *               2*.98,  .89,  .82,  .75,  .65,
     *               2*.58,  .52,  .47,  .42,  .37,
     *               2*.18,  .15,  .12,  .13,  .17,
     *              2*0.00, 0.00, 0.00, 0.00, 0.00 /
      DATA X59BR /    0.0,   .1,   .2,   .3,   .4,   .5,   .6,   .7,
     *                 .8,   .9,  1.0 /
      DATA Z59BR /   1.69, 1.69, 1.69, 1.69, 1.69, 1.69, 1.69, 1.70,
     *               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,  .99,  .94,  .91,
     *                .91,  .94,  .98,
     *               1.69, 1.40, 1.14,  .94,  .80,  .70,  .65,  .62,
     *                .61,  .63,  .65,
     *               1.69, 1.32, 1.08,  .89,  .74,  .64,  .54,  .47,
     *                .42,  .38,  .37,
     *               1.69, 1.32, 1.04,  .84,  .67,  .54,  .45,  .34,
     *                .27,  .20,  .17,
     *               1.69, 1.31, 1.02,  .79,  .61,  .46,  .33,  .21,
     *                .12,  .03, 0.00 /
C ***
C *** DATCOM FIGURE 4.1.3.3-60A   (SUPERSONIC LE, DETACHED SHOCK CNAA)
C ***
      DATA X60AL /   0.00,  .20,  .40,  .60,  .80, 1.00 /
      DATA Y60A  /   1.00, 1.20, 1.40, 1.60, 1.80, 2.00, 2.20, 2.26,
     *               2.40, 2.60, 2.80, 3.00 /
      DATA Z60AL /   1.60, 1.35, 1.12,  .94,  .79,  .68,
     *               1.60, 1.35, 1.12,  .94,  .79,  .68,
     *               1.60, 1.35, 1.12,  .94,  .79,  .68,
     *               1.60, 1.35, 1.12,  .94,  .79,  .68,
     *               1.60, 1.35, 1.12,  .94,  .79,  .68,
     *               1.60, 1.35, 1.12,  .94,  .79,  .68,
     *               1.60, 1.35, 1.12,  .94,  .79,  .68,
     *               1.60, 1.35, 1.12,  .94,  .79,  .68,
     *               1.48, 1.25, 1.03,  .85,  .70,  .60,
     *                .84,  .63,  .50,  .42,  .37,  .37,
     *                .34,  .25,  .17,  .13,  .11,  .16,
     *               0.00, 0.00, 0.00, 0.00, 0.00, 0.00 /
      DATA X60AR /
     *     0.000,  .200,  .220,  .240,  .270,  .300,  .320,  .375,
     *      .400,  .471,  .600,  .800, 1.000 /
      DATA Z60AR1 /  1.68, 1.46, 1.45, 1.40, 1.31, 1.23, 1.16, 1.05,
     *               1.00,  .88,  .72,  .64,  .68,
     *               1.68, 1.41, 1.40, 1.40, 1.31, 1.23, 1.16, 1.05,
     *               1.00,  .88,  .72,  .64,  .68,
     *               1.68, 1.37, 1.35, 1.33, 1.31, 1.23, 1.16, 1.05,
     *               1.00,  .88,  .72,  .64,  .68,
     *               1.68, 1.30, 1.26, 1.24, 1.21, 1.18, 1.16, 1.05,
     *               1.00,  .88,  .72,  .64,  .68,
     *               1.68, 1.24, 1.20, 1.16, 1.14, 1.11, 1.10, 1.05,
     *               1.00,  .88,  .72,  .64,  .68,
     *               1.68, 1.16, 1.11, 1.10, 1.07, 1.04, 1.02,  .96,
     *                .94,  .88,  .72,  .64,  .68 /
      DATA Z60AR2 /  1.68, 1.11, 1.07, 1.03, 1.00,  .97,  .95,  .89,
     *                .87,  .81,  .72,  .64,  .68,
     *               1.68, 1.10, 1.03, 1.02,  .98,  .95,  .93,  .87,
     *                .85,  .79,  .72,  .64,  .68,
     *               1.68, 1.07, 1.00,  .98,  .95,  .90,  .87,  .81,
     *                .79,  .72,  .63,  .56,  .60,
     *               1.68, 1.04,  .98,  .94,  .90,  .86,  .83,  .76,
     *                .74,  .66,  .54,  .42,  .37,
     *               1.68, 1.03,  .97,  .92,  .86,  .77,  .76,  .69,
     *                .65,  .57,  .42,  .25,  .16,
     *               1.68, 1.02,  .96,  .90,  .84,  .78,  .75,  .67,
     *                .63,  .52,  .34,  .10, 0.00 /
C ***
C *** DATCOM FIGURE 4.1.3.3-61A   (DELTA ALPHA FOR FULLY DETACHED SHOCK)
C ***
      DATA X61A /    1.0, 1.5, 2.0, 2.5, 3.0, 4.0, 5.0, 6.0, 7.0  /
      DATA Y61A /  59.375, 41.667, 33.000, 27.778, 23.611, 16.667,
     *             12.500,  8.750,  6.000 /
C
C ***
C *** CALCULATE  L.E. SWEEP PARM BTLE = BETA/TAN(SLE),
C ***            L.E. PARAMETER E, AND RCNA (CNA/CNAT)
C ***
      ALP  = ABS(ALPHA)
      BETA = SQRT(MACH*MACH-1.0)
      TSLE = TAN(SLE/RAD)
      IF(TSLE .LT. 0.0001) TSLE = 0.0001
      BTLE = BETA/TSLE
C ***
      DELN = RAD*ATAN(DELY/5.85)
      E    = CNA*RAD
      IF(TSLE .LE. 1.92) GO TO 10
        YARG = CNA*RAD*TSLE/1.92
        CALL MVLOOK(1, 11, 9, 99, DUM, YC, XC, ZC, DELN, YARG, 1.0, C)
        E = CNA*RAD*(TSLE/1.92+C*(TSLE/1.92-1.0))
   10 CONTINUE
C ***
      XARG = BTLE
      IF(BTLE .GT. 1.0) XARG = 1.0/BTLE
      IF(BTLE .LE. 1.0) CALL MVLOOK(1, 8, 11, 88, DUM, YRCNA, XRCNA,
     *                              ZRCNAL, XARG, DELN, 1.0, RCNA)
      IF(BTLE .GT. 1.0) CALL MVLOOK(1, 8, 11, 88, DUM, YRCNA, XRCNA,
     *                              ZRCNAR, XARG, DELN, 1.0, RCNA)
      IF(RCNA .GT. 1.0) RCNA = 1.0
C ***
C *** SUBSONIC L.E. - BTLE .LE. 1.0
C ***
      IF(BTLE .GT. 1.0) GO TO 20
        XARG = RCNA*BETA*TAN(ALP/RAD)
        YARG = E*BTLE
        IF(XARG .LE. 1.0) CALL MVLOOK(1, 10, 6, 60, DUM, Y59B, X59BL,
     *                                Z59BL, XARG, YARG, 1.0, CNAA)
        IF(XARG .LT. 0.0001) XARG = 0.0001
        XARG = 1.0/XARG
        IF(XARG .LT. 1.0) CALL MVLOOK(1, 10, 11, 110, DUM, Y59B, X59BR,
     *                                Z59BR, XARG, YARG, 1.0, CNAA)
   20 CONTINUE
C ***
C *** SUPERSONIC L.E. - BTLE .GT. 1.0
C ***
      IF(BTLE .LE. 1.0) GO TO 80
        CALL FSDETA(MACH, DELN, SLE, ALPS)
C       ***
C       *** SHOCK DETACHED AT ALP = 0.0 - ALPS .LE. 0.0
C       ***
        IF(ALPS .GT. 0.0) GO TO 30
          XARG = RCNA*BETA*TAN(ALP/RAD)
          IF(XARG .LE. 1.0) CALL MVLOOK(1, 12, 6, 72, DUM, Y60A, X60AL,
     *                                  Z60AL, XARG, E, 1.0, CNAA)
          IF(XARG .LT. 0.0001) XARG = 0.0001
          XARG = 1.0/XARG
          IF(XARG .LT. 1.0) CALL MVLOOK(1, 12, 13, 156, DUM, Y60A,
     *                                 X60AR, Z60AR, XARG, E, 1.0, CNAA)
   30   CONTINUE
C       ***
C       *** SHOCK ATTACHED AT ALP = 0.0
C       ***
        IF(ALPS .LE. 0.0) GO TO 70
          XARG = BETA*TAN(ALPS/RAD)
          CALL FIG60B(BETA, XARG, CNAAS)
          CALL LNTRP(X61A, Y61A, 9, BETA, SLOPE)
          DALP = SLOPE*CNAAS
          IF(ALPS+DALP .GE. 90.0) DALP = 89.9-ALPS
C         ***
C         *** ATTACHED SHOCK - ALP .LE. ALPS
C         ***
          IF(ALP .GT. ALPS) GO TO 40
            XARG = BETA*TAN(ALP/RAD)
            CALL FIG60B(BETA, XARG, CNAA)
   40     CONTINUE
C         ***
C         *** INCIPIENT SEPARATION - ALPS .LT. ALP .LT. ALPS+DALP
C         ***
          IF(ALP .LE. ALPS)      GO TO 50
          IF(ALP .GT. ALPS+DALP) GO TO 50
            XARG = RCNA*BETA*TAN((ALPS+DALP)/RAD)
            IF(XARG .LE. 1.0) CALL MVLOOK(1, 12, 6, 72, DUM, Y60A,
     *                             X60AL, Z60AL, XARG, E, 1.0, CNAAP)
            XARG = 1.0/XARG
            IF(XARG .LT. 1.0) CALL MVLOOK(1, 12, 13, 156, DUM, Y60A,
     *                             X60AR, Z60AR, XARG, E, 1.0, CNAAP)
            CNAA = CNAAS-(ALP-ALPS)*(CNAAS-CNAAP)/DALP
   50     CONTINUE
C         ***
C         *** FULLY SEPARATED SHOCK - ALP .GE. ALPS+DALP
C         ***
          IF(ALP .LT. ALPS+DALP) GO TO 60
            XARG = RCNA*BETA*TAN(ALP/RAD)
            IF(XARG .LE. 1.0) CALL MVLOOK(1, 12, 6, 72, DUM, Y60A,
     *                             X60AL, Z60AL, XARG, E, 1.0, CNAA)
            XARG = 1.0/XARG
            IF(XARG .LT. 1.0) CALL MVLOOK(1, 12, 13, 156, DUM, Y60A,
     *                             X60AR, Z60AR, XARG, E, 1.0, CNAA)
   60     CONTINUE
   70   CONTINUE
   80 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FSDETA(MACH, DELN, SLE, ALPD)
C ***
C *** CALCULATES SHOCK DETACHMENT ANGLE-OF-ATTACK ON FINS
C ***
C *** REFERENCE   DATCOM SECTION 4.1.3.3
C ***                    PAGE 4.1.3.3-33  STEP 2B
C ***                    ALSO USES NACA 1135 EQUATIONS 168 AND 138
C ***                    AS PROGRAMMED IN ANGDET
C ***
C *** INPUT   MACH    MACH NUMBER
C ***         DELN    SLOPE AT AIRFOIL LEADING EDGE(.15% TO 6% CHORD),DE
C ***         SLE     LEADING EDGE SWEEP ANGLE, DEG
C ***
C *** OUTPUT  ALPD    ANGLE-OF-ATTACK FOR SHOCK DETACHMENT, DEG
C ***
C ***
      REAL MACH
C ***
C *** CONSTANT DATA
C ***
      COMMON /CONST/PI,RAD,UNUSED,KAND
      DATA EPS / 0.00001 /
C ***
C *** LOOP 10 TIMES OR UNTIL ABS(DALP) .LT. EPS
C ***
      DELR = DELN/RAD
      SSLE = SIN(SLE/RAD)
      CSLE = COS(SLE/RAD)
      ALPD = 10.0/RAD
      DO 10 I=1,10
            XMN = MACH*SQRT(1.0-SSLE*SSLE*(COS(ALPD)**2))
            CALL ANGDET(XMN, DELD)
            ALPN = DELR + ATAN(TAN(ALPD)/CSLE)
            DALP = DELD - ALPN
         IF(ABS(DALP) .LT. EPS) GO TO 20
            XMN = MACH*SQRT(1.0-SSLE*SSLE*(COS(ALPD+0.01)**2))
            CALL ANGDET(XMN, DELD2)
            DDELD = (DELD2-DELD)/0.01
            DALPN = 1.0/(CSLE*(COS(ALPD)**2)+(SIN(ALPD)**2)/CSLE)
            DALPD = DALP/(DALPN-DDELD)
            ALPD  = ALPD + DALPD
   10 CONTINUE
C ***
   20 ALPD = ALPD*RAD
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ILTVIN
C**********************************************************************
C
C     THIS SUBROUTINE IS USED TO CALCULATE HEIGHTS AND WIDTHS OF
C     INLETS IN THE BODY SYSTEM.  THESE PARAMETERS ARE NEEDED BY THE
C     SUBROUTINES ILTNWT AND ILTCFD.
C
C**********************************************************************
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C  MODIFIED BY K. BURNS, MCDONNELL DOUGLAS
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      DIMENSION PANINC(5)
C
      CNCIRN = 4.0 / 3.0
      NUMI=NIN+0.5
      DO 10 INLET=1,NUMI
        PHIR(INLET)=PHI(INLET)/RAD
        IF (INTYPE.NE.3.0) THEN
          IF (INTYPE.EQ.1.0) THEN
            DO 20 ICRX=1,5
              ANGP=PHI(INLET)/RAD+PI/2.+SI(ICRX)
              ANGM=PHI(INLET)/RAD+PI/2.-SI(ICRX)
              IF((PHI(INLET).GE.0.0.AND.PHI(INLET).LE.90.).OR.
     &            (PHI(INLET).GE.180.AND.PHI(INLET).LE.270))THEN
                CRXIWD(ICRX,INLET)=ABS(CRXLEN(ICRX)*SIN(ANGM))
                CRXIHT(ICRX,INLET)=ABS(CRXLEN(ICRX)*COS(ANGP))
              ELSE
                CRXIWD(ICRX,INLET)=ABS(CRXLEN(ICRX)*SIN(ANGP))
                CRXIHT(ICRX,INLET)=ABS(CRXLEN(ICRX)*COS(ANGM))
              ENDIF
   20       CONTINUE
          ELSE
            DO 25 ICRX=1,5
              ANGP=PHI(INLET)/RAD+SI(ICRX)
              ANGM=PHI(INLET)/RAD-SI(ICRX)
              IF((PHI(INLET).GE.0.0.AND.PHI(INLET).LE.90.).OR.
     &            (PHI(INLET).GE.180.AND.PHI(INLET).LE.270))THEN
                CRXIWD(ICRX,INLET)=ABS(CRXLEN(ICRX)*SIN(ANGP))
                CRXIHT(ICRX,INLET)=ABS(CRXLEN(ICRX)*COS(ANGM))
              ELSE
                CRXIWD(ICRX,INLET)=ABS(CRXLEN(ICRX)*SIN(ANGM))
                CRXIHT(ICRX,INLET)=ABS(CRXLEN(ICRX)*COS(ANGP))
              ENDIF
   25       CONTINUE
          ENDIF
C
          DO 40 ICRX = 1, 5
            PANINC(ICRX) = 0.0
            IF(HDIV .GT. 0.0)THEN
              DO 50 IDCRX = 1, 2
               IF(XI(ICRX).GE.XD(IDCRX).AND.XI(ICRX).LE.XD(IDCRX+1))THEN
                 PANINC(ICRX)=WD(IDCRX)+((XI(ICRX)-XD(IDCRX))/
     &                  (XD(IDCRX+1)-XD(IDCRX)))*(WD(IDCRX+1)-WD(IDCRX))
               ENDIF
   50         CONTINUE
            ENDIF
   40     CONTINUE
          DO 60 ICRX = 1, 5
            IF (INTYPE.EQ.1.) THEN
              PANILN(1,ICRX,INLET)=HI(ICRX)
              PANILN(2,ICRX,INLET)=WI(ICRX)
              PANILN(3,ICRX,INLET)=HI(ICRX)
              PANILN(4,ICRX,INLET)=WI(ICRX)-PANINC(ICRX)
            ELSE
              PANILN(1,ICRX,INLET)=WI(ICRX)
              PANILN(2,ICRX,INLET)=HI(ICRX)
              PANILN(3,ICRX,INLET)=WI(ICRX)
              PANILN(4,ICRX,INLET)=HI(ICRX)-PANINC(ICRX)
            ENDIF
   60     CONTINUE
        ENDIF
C
C     CALCULATE THE DIVERTER HEIGTHS AND WIDTHS
        IF(HDIV .GT. 0.0)THEN
          DO 30 IDCRX = 1, 3
            CRXDHT(IDCRX,INLET)=ABS(HD(IDCRX)*COS(PHI(INLET)/RAD))
            CRXDWD(IDCRX,INLET)=ABS(HD(IDCRX)*SIN(PHI(INLET)/RAD))
   30     CONTINUE
        ENDIF
C
   10 CONTINUE
C
      IF(HDIV .GT. 0.0)THEN
        DO 70 IDCRX = 1, 3
          PANDLN(1,IDCRX)=HD(IDCRX)
          PANDLN(2,IDCRX)=0.0
          PANDLN(3,IDCRX)=HD(IDCRX)
          PANDLN(4,IDCRX)=0.0
   70   CONTINUE
      ENDIF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE NAMEW(KAND,IUNIT,NLNAME,LENNLN,VNAME,DVNAME,LENVN,
     1                 NUMVN,VDIME,COMBLK,MAXCOM,LOC)
C
C***  SIMULATE NAMELIST OUTPUT.
C
C   KAND - NAMELIST DELIMITER ($ ON CDC AND VAX, & ON IBM AND OTHER)
C          (BUT CAN BE SPECIFIED TO BE ANY UNIQUE CHARACTER)
C  IUNIT - TAPE UNIT FOR WRITING NAMELIST DATA
C NLNAME - NAMELIST NAME TO WRITE
C LENNLN - NUMBER OF CHARACTERS IN NAMELIST NAME (DIMENSION OF NLNAME)
C  VNAME - VARIABLE NAMES FOR THIS NAMELIST (AN ARRAY)
C DVNAME - DIMENSION OF VNAME ARRAY
C  LENVN - ARRAY WHICH DEFINES THE NUMBER OF CHARACTERS IN EACH
C          VARIABLE NAME
C  NUMVN - NUMBER OF VARIABLE NAMES DEFINED
C  VDIME - NUMBER OF CONSTANTS PERMITTED FOR EACH VARIABLE
C          (DIMENSION OF EACH VARIABLE; USE NEGATIVE FOR LOGICAL
C           VARIABLES)
C COMBLK - STARTING LOCATION FOR RESULTS
C          (USUALLY THE FIRST LOCATION OF A COMMON BLOCK)
C MAXCOM - MAXIMUM DIMENSION OF STORAGE ARRAY
C          (USUALLY THE LENGTH OF THE COMMON BLOCK)
C    LOC - POINTER TO STORAGE ARRAY FOR THE STARTING LOCATION
C          OF EACH INPUT VARIABLE (IF ZERO THE CONSTANT IS NOT PRINTED)
C
C***  NOTES -
C
C***  ALL INPUT STRING ARRAYS MUST BE DECLARED INTEGER
C
C***  ALL VARIABLES ARE ASSUMMED TO BE REAL; IF VDIME IS NEGATIVE
C***  THE VARIABLE IS ASSUMMED TO BE LOGICAL.  ALTHOUGH THE CODE IS
C***  DESIGNED TO HANDLE INTEGERS AS WELL, THIS OPTION IS NOT
C***  CURRENTLY USED.  IT CAN BE ACTIVATED BY PASSING ANOTHER ARRAY,
C***  VTYPE, TO DEFINE THE TYPE OF VARIABLE, WITH THE CODE
C***  0=LOGICAL, 1=INTEGER, OR 2=REAL; THEN REPLACE THE NAME VTYPE
C***  WITH THE NAME VTYPE(NVN) IN THE REMAINING CODE.
C
C***  IF ANY ELEMENT OF ARRAY LOC IS ZERO, THAT VARIABLE WILL NOT
C***  BE INCLUDED IN THE LISTING.
C
      INTEGER DVNAME,VTYPE,VDIME
      CHARACTER*4 BLANK,EQUAL,KOL,VNAME,KAND,NLNAME
C
      DIMENSION NLNAME(LENNLN),VNAME(DVNAME),LENVN(NUMVN),
     1          VDIME(NUMVN),COMBLK(MAXCOM),LOC(NUMVN)
      DIMENSION KOL(8)
C
      DATA BLANK / '    ' /
      DATA EQUAL / '=   ' /
C
      WRITE(IUNIT,1030)KAND,(NLNAME(I),I=1,LENNLN)
C
      INDX=1
C
      DO 1020 NVN=1,NUMVN
C
         IF(NVN .GT. 1)INDX=INDX+MAXC
C
         MAXC=LENVN(NVN)
C
         DO 1000 J=1,8
            KOL(J)=BLANK
 1000    CONTINUE
C
         DO 1010 I=1,MAXC
            KOL(I)=VNAME(I+INDX-1)
 1010    CONTINUE
C
         KOL(8)=EQUAL
C
         KK=LOC(NVN)
         IF(KK .LT. 1)GO TO 1020
         JJ=IABS(VDIME(NVN))
C
C ... A NEGATIVE DIMENSION MEANS LOGICAL
C ... ELSE VARIABLE TYPE IS REAL
C
         IF(VDIME(NVN) .LT. 0)VTYPE=0
         IF(VDIME(NVN) .GT. 0)VTYPE=2
C
         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)
C
 1020 CONTINUE
C
      WRITE(IUNIT,1040)KAND
C
      RETURN
C
 1030 FORMAT('1',8A1)
 1040 FORMAT('0',A1,'END')
C
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE READCD(IUNIT, KOL, IEOF)
C
C***  READ AN 80 COLUMN CARD IMAGE FROM UNIT IUNIT AND STORE THE
C***  CHARACTERS IN ARRAY KOL.  VARIABLE IEOF IS TRUE IF AN
C***  END-OF-FILE IS DETECTED.
C
      DIMENSION KOL(80)
      CHARACTER*4 KOL
C
      LOGICAL IEOF
C
      IEOF=.FALSE.
C
C***  READ CARD OR LOOK FOR A DOUBLE END-OF-FILE
C
      DO 1000 J=1,2
C
C***     FOLLOWING CARDS FOR FORTRAN-IV
C
C        READ(IUNIT,1020)(KOL(I),I=1,80)
C        IF(EOF(IUNIT))1000,1010
C
C***     FOLLOWING CARDS FOR FORTRAN-V
C
         READ(IUNIT,1020,END=1000)(KOL(I),I=1,80)
         GO TO 1010
C
 1000 CONTINUE
C
      IEOF=.TRUE.
C
 1010 CONTINUE
C
      RETURN
C
 1020 FORMAT(80A1)
C
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE STREAM(MACH,RPUL,DEL,XB,H,W,L,CDSTR)
      REAL MACH,L,MSUB,MSUP
C
C  WRITTEN BY K. DETERS, MCDONNELL DOUGLAS
C
      MSUB=.6
      MSUP=1.
      G=1.4
      S=H*W
      TMACH=0.0
      IF(MACH.GT.MSUB) GO TO 315
C
C*** SUBSONIC DRAG CALCULATION
 310  FR=L/H
        IF (FR .LT. 20.0) THEN
        CD0=.1349-.02761*FR+.0026596*(FR**2)-1.1082E-4*(FR**3)
     &  +1.7526E-6*(FR**4)
        ELSE
        CD0=.002*FR
        ENDIF
      DELXB=.015
      HX1=.08
      HX2=.3
      CD1=CD0*(1.0-.25*(DELXB/HX1))
      CD2=.037
      CDCH1=CD0*(1.-.25*(DELXB/HX1))
      CDCH2=CD0*(1.-.25*(DELXB/HX2))
      HX=H/XB
      IF (HX .LT. HX1) THEN
        HDEL=HX/DELXB
        IF (HDEL .LE. 1.0) THEN
        CD=.75*CD0*(HDEL**(1./3.))      
        ELSE
        DELH=DELXB/HX
        CD=CD0*(1.-.25*DELH)
        ENDIF
      ELSE IF (HX .GT. HX2) THEN
        IF (CDCH1 .LT. CD2 .AND. CDCH2 .LT. CD2) THEN 
        DELH=DELXB/HX
        CD=CD0*(1.-.25*DELH)
        ELSE
        CD=-7.2165E-5*HX+CD2
        ENDIF
      ELSE
        IF (CDCH1 .LT. CD2) THEN 
          IF (CDCH2 .LT. CD2) THEN
          DELH=DELXB/HX
          CD=CD0*(1.-.25*DELH)
          ELSE
          SLOPE=(CD2-CDCH1)/(HX2-HX1)
          YINT=CDCH1-(SLOPE*HX1)
          CD=SLOPE*HX+YINT
          ENDIF
        ELSE
C
C***  CUBIC SPLINE INTERPOLATION
        DY1=0.0
        DY2=0.0
        CALL CUBIC(HX,HX1,HX2,CD1,CD2,DY1,DY2,CDY)
        CD=CDY
C
        ENDIF
      ENDIF
      CD=CD/(SQRT(1.0-MACH**2))
      IF(TMACH.EQ.0.) GO TO 345
      GO TO 320
 315  IF(MACH.LT.MSUP) GO TO 325
C
C*** SUPERSONIC DRAG CALCULATION
C
C***  NUMBER OF INCREMENTS IN X AND Y DIRECTIONS
 330  NX=100
      NY=100     
C
C***  CONSTANTS
      PI=3.141593
C
C***  INITIALIZE SUMMING VARIABLES
      CDCUM=0.0
      K=0
C
C***  CALCULATE THE ELLIPSOID PARAMETERS
      A=L/2.0
      B=W/2.0
      C=H
C
C***  CALCULATE THE X AND Y  INCREMENTS
      DELX=A/FLOAT(NX)
      DELY=B/FLOAT(NY)
      DO 200 J=1,NY
        IF (J.EQ.1) THEN
          Y=DELY
          YT=DELY/2.0
        ELSE
          Y=YPREV+DELY
          YT=(YPREV+Y)/2.0
        ENDIF
        YPREV=Y
        IF (YT.GT.B) GOTO 300
        DO 100 I=1,NX
          IF (I.EQ.1) THEN
            X=DELX
            XT=DELX/2.0
          ELSE
            X=XPREV+DELX
            XT=(XPREV+X)/2.0
          ENDIF
          XPREV=X
          IF (XT.GT.A*SQRT(1.-(YT/B)**2)) GOTO 200
          ZT=C*SQRT(1-(XT/A)**2-(YT/B)**2)
          SINE=XT/A**2/SQRT(XT**2/A**4+YT**2/B**4+ZT**2/C**4)
          FX=-C*XT/A**2/SQRT(1.-(XT/A)**2-(YT/B)**2)
          FY=-C*YT/B**2/SQRT(1.-(XT/A)**2-(YT/B)**2)
          K=K+1
          DS=SQRT(FX**2+FY**2+1.)*DELX*DELY
          CDD=SINE**3*DS
          CDCUM=CDCUM+CDD
 100    CONTINUE
 200  CONTINUE
 300  CONTINUE
      RMACH=5.
      EQ1=(((G+1.))**2*RMACH**2)/((4.0*G*RMACH**2)-2.0*(G-1.0))
      EQ2=(1.0-G+(2.0*G*RMACH**2))/(G+1.0)
      CPMAX=(2.0/(G*RMACH**2))*((EQ1**(G/(G-1.0)))*EQ2-1.0)
      CD=4.0*CDCUM*CPMAX/(PI*B*C)
        IF (H .GT. DEL) THEN
        CD=CD*(1.0-.25*(DEL/H))
        ELSE
        CD=CD*(.75*((H/DEL)**(1.0/3.0)))
        ENDIF
      CALL CROSS(MACH,CDT)
      CD=CD*(CDT/1.2)
      IF(TMACH.EQ.0.) GO TO 345
      GO TO 340
 325  CONTINUE
C
C*** TRANSONIC DRAG CALCULATION
      TMACH=MACH
      MACH=MSUB
      GO TO 310
 320  CDSUB=CD
      SUBM=CD*1.172
      MACH=MSUP
      GO TO 330
 340  CDSUP=CD
      SUPM=0.
      CALL CUBIC(TMACH,MSUB,MSUP,CDSUB,CDSUP,SUBM,SUPM,CDTR)
      MACH=TMACH
      CD=CDTR
 345  CONTINUE
C
C***  FINAL CALCULATION OF DRAG COEFFICIENT
      CDSTR=CD*S
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WELLB
C
C***  WRITE ELLIPTICAL BODY INPUTS
C
      COMMON /ABODIN/ AA(881)
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION NLNAME(6),IVNAME(152),LEN(35),IDIM(35),LOC(35)
C
      DATA NLNAME /  'E   ','L   ','L   ','B   ','O   ','D   '/
      DATA IVNAME /  'N   ','X   ','X   ','O   ','X   ','0   ','X   ',
     1 'R   ','W   ','T   ','N   ','O   ','S   ','E   ','L   ','N   ',
     2 'O   ','S   ','E   ','W   ','N   ','O   ','S   ','E   ','B   ',
     3 'N   ','O   ','S   ','E   ','T   ','R   ','U   ','N   ','C   ',
     4 'L   ','C   ','E   ','N   ','T   ','R   ','W   ','C   ','E   ',
     5 'N   ','T   ','R   ','T   ','A   ','F   ','T   ','L   ','A   ',
     6 'F   ','T   ','W   ','A   ','F   ','T   ','P   ','O   ','W   ',
     7 'E   ','R   ','D   ','I   ','S   ','C   ','O   ','N   ','E   ',
     8 'L   ','L   ','I   ','P   ','H   ','E   ','N   ','O   ','S   ',
     9 'E   ','E   ','C   ','E   ','N   ','T   ','R   ','E   ','A   ',
     A 'F   ','T   ','D   ','E   ','X   ','I   ','T   ','P   ','R   ',
     B 'O   ','T   ','U   ','B   ','N   ','P   ','R   ','O   ','T   ',
     C 'P   ','T   ','Y   ','P   ','E   ','X   ','P   ','R   ','O   ',
     D 'T   ','N   ','L   ','O   ','C   ','B   ','L   ','D   ','M   ',
     E 'E   ','M   ','B   ','L   ','D   ','T   ','Y   ','P   ','L   ',
     F 'P   ','R   ','O   ','T   ','W   ','P   ','R   ','O   ','T   ',
     G 'H   ','P   ','R   ','O   ','T   ','O   ','P   ','R   ','O   ',
     H 'T   '/
      DATA IDIM   / 1,1,1,50,50,50,1,1,1,1,-1,1,1,1,1,1,1,20,50,50,1,1,
     1              1,1,-1,1,20,20,20,20,100,100,100,100,100 /
      DATA LEN    / 2,2,2,1,1,1,5,5,5,5,5,6,6,4,4,4,5,6,5,1,5,6,4,5,
     1              6,5,5,5,4,6,6,5,5,5,5 /
      DATA LOC    / 1,2,2,3,53,53,103,104,105,106,107,108,109,110,111,
     1              112,113,114,134,184,234,235,236,237,
     2              300,301,302,322,342,362,382,482,582,682,782 /
C
      CALL NAMEW(KAND,6,NLNAME,6,IVNAME,152,LEN,35,IDIM,AA,881,LOC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION ASPECT(SPAN,CROOT,TAPER)
C
C***  FUNCTION TO COMPUTE THE ASPECT RATIO OF A STRAIGHT TAPERED
C***  FIN OR FIN SEGMENT
C
C***  INPUTS
C
C   SPAN -- PANEL EXPOSED SPAN (TIP-TO-TIP) FOR TWO PANELS
C           JOINED AT THEIR EXPOSED ROOT CHORDS
C  CROOT -- PANEL EXPOSED ROOT CHORD
C  TAPER -- PANEL TIP CHORD DIVIDED BY EXPOSED ROOT CHORD
C
      ASPECT=2.*SPAN/(CROOT*(1.+TAPER))
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BODY(IM)
C
C***  TOP LEVEL EXECUTIVE FOR BODY ALONE AERODYNAMICS
C
C***  IM IS THE CURRENT MACH NUMBER INDEX
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
C***  AXISYMMETRIC BODIES
C
      IF(LAXIS .AND. .NOT. LELLB)CALL BODYA(IM)
C
C***  ELLIPTICAL BODIES
C
      IF(LELLB)CALL BODYE(IM)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE COORD1(X,XU,XL,YUN,YLN,L,I,J,K,II,JJ,KK,III,JJJ,
     1 THN,CAM,ALPHAI,ALPHAO,AII,RHO,T)
C
C*****
C***** CALCULATE NACA 1-SERIES AIRFOIL COORDINATES
C*****
C
C  ROUTINE ADAPTED FROM DIGITAL DATCOM
C  ORIGINAL ROUTINE WRITTEN BY D. KINSEY, D. BOWERS, AFFDL
C  MODIFIED BY S.R. VUKELICH, MCDONNELL DOUGLAS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION X(50),XU(50),XL(50),YUN(50),YLN(50),THN(50),CAM(50)
C
      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
C
C ... COMPUTE COORDINATES ALONG CHORD
C
      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 CONTINUE
      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
c *************************************
c *************************************
c *************************************
      SUBROUTINE DMPARY(ITYPE,ARRAY,NPT,NAME,NLET)
C
C***  SUBROUTINE TO PRINT THE CONTENTS OF AN ARRAY
C
C  ITYPE -- ARRAY TYPE TO BE DUMPED
C           0 = FLOATING POINT
C           1 = INTEGER
C           2 = LOGICAL
C           3 = HOLLERITH
C  ARRAY -- ARRAY TO BE DUMPED
C    NPT -- DIMENSION OF ARRAY
C   NAME -- NAME OF ARRAY TO BE PRINTED
C   NLET -- NUMBER OF LETTERS IN NAME
C
      DIMENSION ARRAY(NPT),IFOR(8),AFOR(4),BFOR(4)
      DIMENSION IEXP(3),IINT(3),ILOG(3),IHOL(3)
C
      CHARACTER*4 AFOR,BFOR,IEXP,IINT,ILOG,IHOL,IFOR,NAME
C
      DATA IFOR / '    ','    ',',1H(',',I3,','2H)=','    ',
     1            '    ','    '/
C
      DATA AFOR / '(5(5','(5(4','(5(3','(5(2'/
      DATA BFOR / 'X,A1','X,A2','X,A3','X,A4'/
C
      DATA IEXP / '1P, ',' E12','.5))'/
      DATA IINT / '3X, ','I6, ','3X))'/
      DATA ILOG / '2X, ','L1, ','9X))'/
      DATA IHOL / '4X, ','A4, ','4X))'/
C
C***  SET FORMAT FOR THE NUMBER OF LETTERS IN THE NAME AND PRINT
C
      IFOR(1)=AFOR(NLET)
      IFOR(2)=BFOR(NLET)
C
C***  SUBSTITUTE FOR TYPE OF OUTPUT DESIRED
C
C   FLOATING POINT
C
      IF(ITYPE .LE. 0 .OR. ITYPE .GT. 3)IFOR(6)=IEXP(1)
      IF(ITYPE .LE. 0 .OR. ITYPE .GT. 3)IFOR(7)=IEXP(2)
      IF(ITYPE .LE. 0 .OR. ITYPE .GT. 3)IFOR(8)=IEXP(3)
C
C  INTEGER
C
      IF(ITYPE .EQ. 1)IFOR(6)=IINT(1)
      IF(ITYPE .EQ. 1)IFOR(7)=IINT(2)
      IF(ITYPE .EQ. 1)IFOR(8)=IINT(3)
C
C  LOGICAL
C
      IF(ITYPE .EQ. 2)IFOR(6)=ILOG(1)
      IF(ITYPE .EQ. 2)IFOR(7)=ILOG(2)
      IF(ITYPE .EQ. 2)IFOR(8)=ILOG(3)
C
C  HOLLERITH
C
      IF(ITYPE .EQ. 3)IFOR(6)=IHOL(1)
      IF(ITYPE .EQ. 3)IFOR(7)=IHOL(2)
      IF(ITYPE .EQ. 3)IFOR(8)=IHOL(3)
C
C***  WRITE ARRAY
C
      WRITE(6,1000)
      WRITE(6,IFOR)(NAME,I,ARRAY(I),I=1,NPT)
C
 1000 FORMAT(' ')
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCNAAS(MACH, AR, DELY, SLE, TAPER, ALPHA, CNA, SCLM,
     1                  CNAA)
C ***
C *** COMPUTES SUBSONIC NON-LINEAR NORMAL FORCE PER SINE(ALPHA)**2
C ***
C *** REFERENCE   DATCOM SECTION 4.1.3.3
C ***
C *** LIMITATIONS   ALPHA .LT. 90 DEG
C ***               STRAIGHT TAPERED FINS
C ***               NO CAMBER
C ***
C *** INPUT   MACH    MACH NUMBER
C ***         AR      EXPOSED FIN ASPECT RATIO OF TWO PANELS
C ***         DELY    DIFFERENCE IN AIRFOIL ORDINATE BETWEEN
C ***                 .15% AND 6% CHORD,PER CENT CHORD LENGTH
C ***         SLE     LEADING EDGE SWEEP ANGLE, DEG
C ***         TAPER   EXPOSED FIN TAPER RATIO
C ***         ALPHA   ANGLE-OF-ATTACK, DEG
C ***         CNA     LINEAR CN, CN PER ALPHA AT ALPHA = 0, 1/DEG
C ***         SCLM    AIRFOIL SECTION MAX LIFT
C ***
C *** OUTPUT  CNAA    CN PER SIN(ALPHA)**2,REFERENCED TO EXPOSED
C ***                 PLANFORM AREA OF TWO PANELS
C ***
C ***
C
      COMMON /CONST/PI,RAD,UNUSED,KAND
C
      DIMENSION XDCNAA(7), YDCNAA(12), ZDCNAA(84)
      DIMENSION XTAB(11), YD(11), YCNL(11), YCNR(11)
C
      REAL MACH, J
C
C ***
C *** DATA STATEMENTS
C ***
      DATA DUM / 1.0 /
C ***
C *** DATCOM FIGURE 4.1.3.3-55A   (DCNAA)
C ***
      DATA XDCNAA /   .20,  .40,  .46,  .50,  .55,  .60, 1.00  /
      DATA YDCNAA / -4.00,-2.00,-1.00, 0.00,  .15,  .25,  .50, 1.00,
     *               1.50, 2.00, 2.50, 3.00 /
      DATA ZDCNAA /
     *     -.9000, -.6760, -.6070, -.5640, -.5060, -.4520, 0.0000,
     *     -.4000, -.3000, -.2700, -.2500, -.2250, -.2000, 0.0000,
     *     -.1000, -.0750, -.0650, -.0625, -.0562, -.0500, 0.0000,
     *      .2500,  .2500,  .2250,  .2083,  .1874,  .1666, 0.0000,
     *      .6000,  .6000,  .5400,  .5000,  .4500,  .4000, 0.0000,
     *      .8800,  .7800,  .7350,  .7000,  .6500,  .6000, 0.0000,
     *     1.1000, 1.1000,  .9900,  .9170,  .8250,  .7340, 0.0000,
     *     1.6000, 1.6000, 1.4400, 1.3340, 1.2000, 1.0680, 0.0000,
     *     2.0000, 2.0000, 2.0000, 1.8520, 1.6660, 1.4800, 0.0000,
     *     2.3500, 2.3500, 2.3500, 2.3500, 2.1150, 1.8800, 0.0000,
     *     2.6500, 2.6500, 2.6500, 2.6500, 2.6500, 2.3600, 0.0000,
     *     2.8500, 2.8500, 2.8500, 2.8500, 2.8500, 2.8500, 0.0000 /
C ***
C *** DATCOM FIGURE 4.1.3.3-55A  (D)
C ***
      DATA XTAB /  0.00,  .10,  .20,  .30,  .40,  .50,  .60,
     *              .70,  .80,  .90, 1.00 /
      DATA YD   /  0.00, -.35, -.70,-1.00,-1.27,-1.46,-1.55,
     *            -1.40,-1.00, -.21, 0.00 /
C ***
C *** DATCOM FIGURE 4.1.3.3-55B  (CNAAPI)
C ***        (USE XTAB FOR ORDINATE)
C ***
      DATA YCNL /  2.00, 1.32, 1.20, 1.20, 1.20, 1.20, 1.20,
     *             1.20, 1.20, 1.20, 1.20 /
      DATA YCNR /  2.00, 1.40, 1.26, 1.21, 1.20, 1.20, 1.20,
     *             1.20, 1.20, 1.20, 1.20 /
C
C ***
C *** CALCULATE C1, C2, CLM, ACLM, BETA, AND CNP (CN AT CLM)
C ***
      CALL FCLMSB(AR, MACH, DELY, SLE, TAPER, C1, C2, CLML, ACLML)
      CALL FCLMSH(DELY, SLE, MACH, SCLM, CNA, CLMH, ACLMH)
      AR1   = 3.0/((C1+1.0)*COS(SLE/RAD))
      AR2   = 4.0/((C1+1.0)*COS(SLE/RAD))
      IF(AR .GT. AR1) GO TO 2
        CLM  = CLML
        ACLM = ACLML
        GO TO 6
   2  IF(AR .LT. AR2) GO TO 4
        CLM  = CLMH
        ACLM = ACLMH
        GO TO 6
   4  CONTINUE
        CLM  = CLML + (CLMH-CLML)*(AR-AR1)/(AR2-AR1)
        ACLM = ACLML + (ACLMH-ACLML)*(AR-AR1)/(AR2-AR1)
   6  CONTINUE
      ALP   = ABS(ALPHA)
      CNP   = CLM/COS(ACLM/RAD)
      CNAAR = (CNP-0.5*CNA*RAD*SIN(2.0*ACLM/RAD))/(SIN(ACLM/RAD)**2)
      BETA  = SQRT(1.0-MACH*MACH)
C ***
C *** ANGLE-OF-ATTACK BELOW STALL - ALP .LE. ACLM
C ***
      IF(ALP .GT. ACLM) GO TO 10
        J = 0.3*(C1+1.0)*(AR/BETA)*COS(SLE/RAD)*
     *      ((C1+1.0)*(C2+1.0)-((C2+1.0)*AR*TAN(SLE/RAD)/7.0)**3)
        IF(J .GT. 3.0) J = 3.0
        TRAT = TAN(ALP/RAD)/TAN(ACLM/RAD)
        IF(TRAT .LT. 0.20) TRAT = 0.20
        CALL MVLOOK(1, 12, 7, 84, DUM, YDCNAA, XDCNAA, ZDCNAA,
     *              TRAT, J, 1.0, DCNAA)
        CNAA = CNAAR + DCNAA
   10 CONTINUE
C ***
C *** ANGLE-OF-ATTACK ABOVE STALL - ALP .GT. ACLM
C ***
      IF(ALP .LE. ACLM) GO TO 20
        TRAT = TAN(ACLM/RAD)/TAN(ALP/RAD)
        CALL LNTRP(XTAB, YD, 11, TRAT, D)
        XARG = AR
        IF(AR .GT. 1.0) XARG = 1.0/AR
        IF(AR .LE. 1.0) CALL LNTRP(XTAB, YCNL, 11, XARG, CNAAPI)
        IF(AR .GT. 1.0) CALL LNTRP(XTAB, YCNR, 11, XARG, CNAAPI)
        CNAA = CNAAR+(CNAAPI-CNAAR)*(1.0-TRAT)
     *         +BETA*BETA*D*CNA*RAD*(CLM/CLML)**2/2.3
   20 CONTINUE
C ***
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FWDXAC(MACH,AR,SWEEP,TAPER,XAC)
C
C***  CALCULATES THE AERODYNAMIC CENTER OF SWEPT FORWARD WINGS
C***  REF D. SHARPES, AFWAL-TR-84-3084
C
C***  INPUTS
C
C  MACH - MACH NUMBER
C    AR - WING ASPECT RATIO (TWO PANELS JOINED AT EXPOSED ROOT CHORD)
C SWEEP - LEADING EDGE SWEEP ANGLE
C TAPER - PANEL TAPER RATIO
C
C***  OUTPUT
C
C   XAC - AERODYNAMIC CENTER, ROOT CHORDS FROM ROOT CHORD L.E.
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      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 IROUT(2),TYSUBL(216),TYSUBR(216),TYSUPL(216),TYSUPR(216)
      DIMENSION TGRAPH(6),TCURVE(6),TX(6)
C
      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))
C
      REAL MACH
C
      DATA TGRAPH / 0., .2, .25, .33, .5, 1. /
      DATA TCURVE / 1., 2., 3., 4., 5., 6. /
      DATA TX / 0., .2, .4, .6, .8, 1. /
C
C*** TAN(SWEEP)/BETA, TAPER=0.
C
      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/
C
C*** TAN(SWEEP)/BETA, TAPER=.2
C
      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/
C
C*** TAN(SWEEP)/BETA, TAPER=.25
C
      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/
C
C*** TAN(SWEEP)/BETA, TAPER=.33
C
      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/
C
C*** TAN(SWEEP)/BETA, TAPER=.5
C
      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/
C
C*** TAN(SWEEP)/BETA, TAPER=1.
C
      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/
C
C*** BETA/TAN(SWEEP), TAPER=0.
C
      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/
C
C*** BETA/TAN(SWEEP), TAPER=.2
C
      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/
C
C*** BETA/TAN(SWEEP), TAPER=.25
C
      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/
C
C*** BETA/TAN(SWEEP), TAPER=.33
C
      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/
C
C*** BETA/TAN(SWEEP), TAPER=.5
C
      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/
C
C*** BETA/TAN(SWEEP), TAPER=1.
C
      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/
C
C*** BETA/TAN(SWEEP), TAPER=0.
C
      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/
C
C*** BETA/TAN(SWEEP), TAPER=.2
C
      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/
C
C*** BETA/TAN(SWEEP), TAPER=.25
C
      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/
C
C*** BETA/TAN(SWEEP), TAPER=.33
C
      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/
C
C*** BETA/TAN(SWEEP), TAPER=.5
C
      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/
C
C*** BETA/TAN(SWEEP), TAPER=1.
C
      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/
C
C*** TAN(SWEEP)/BETA, TAPER=0.
C
      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/
C
C*** TAN(SWEEP)/BETA, TAPER=.2
C
      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/
C
C*** TAN(SWEEP)/BETA, TAPER=.25
C
      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/
C
C*** TAN(SWEEP)/BETA, TAPER=.33
C
      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/
C
C*** TAN(SWEEP)/BETA, TAPER=.5
C
      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/
C
C*** TAN(SWEEP)/BETA, TAPER=1.
C
      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/
C
      BETA=SQRT(ABS(MACH*MACH-1.))
      IF(BETA .EQ. 0.)BETA=1.E-10
C
      IF(BETA .NE. 0.)FACTOR=ABS(TAN(SWEEP/RAD)/BETA)
      IF(BETA .EQ. 0.)FACTOR=1.E10
C
      IF(FACTOR .NE. 0.)FACTI=1./FACTOR
      IF(FACTOR .EQ. 0.)FACTI=1.E10
C
      ATANS=ABS(AR*TAN(SWEEP/RAD))
C
      IF(MACH .LT. 1. .AND. FACTOR .LE. 1.)
     1 CALL MVLOOK(6,6,6,216,TGRAPH,TCURVE,TX,TYSUBL,FACTOR,ATANS,
     2             TAPER,XAC)
C
      IF(MACH .LT. 1. .AND. FACTOR .GT. 1.)
     1 CALL MVLOOK(6,6,6,216,TGRAPH,TCURVE,TX,TYSUBR,FACTI ,ATANS,
     2             TAPER,XAC)
C
      IF(MACH .GE. 1. .AND. FACTOR .GT. 1.)
     1 CALL MVLOOK(6,6,6,216,TGRAPH,TCURVE,TX,TYSUPL,FACTI ,ATANS,
     2             TAPER,XAC)
C
      IF(MACH .GE. 1. .AND. FACTOR .LE. 1.)
     1 CALL MVLOOK(6,6,6,216,TGRAPH,TCURVE,TX,TYSUPR,FACTOR,ATANS,
     2             TAPER,XAC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ILTVIS(IMACH)
C
C     THIS SUBROUTINE DETERMINES THE NONLINEAR AERODYNAMICS OF
C     AN INLET AND DIVERTER BY INCREMENTING THE LINEAR AERODYNAMICS
C     USING CROSSFLOW DRAG COEFFICIENTS. THE AERODYNAMICS ARE
C     COMPUTED AT EACH COMBINATION OF FLIGHT CONDITIONS SPECIFIED
C     IN THE INPUT FILE.
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
C                  *********************
C                  * INPUT/OUTPUT LIST *
C                  *********************
C
C
C     ***** INPUTS *****          ***** OUTPUTS *****
C           MACH                        CNCF
C           ALPHA                       CMCF
C           BETA                        CYCF
C                                       CLNCF
C
C
C     SUBROUTINES USED: ILTCFD,DIVCFD,BODCFD
C
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      NUMFLT=NALPHA+0.5
      NUMMCH=NMACH+0.5
C
      XMACH  = MACH(IMACH)
C     BEGIN LOOP FOR FLIGHT CONDITIONS
      BETAR  = BETA/RAD
      DO 100 IFLT = 1, NUMFLT
C
C       COMPUTE ALPHA IN RADIANS
C
        ALPHAR = ALPHA(IFLT) / RAD
C
C       COMPUTE AERO CONTRIBUTION DUE TO CROSSFLOW
C
        CALL ILTCFD(ALPHAR,BETAR,XMACH,CNIVIS,CMIVIS,CYIVIS,CLNIVS)
        IF(HDIV .GT. 0.0)THEN
          CALL DIVCFD(ALPHAR,BETAR,XMACH,CNDVIS,CMDVIS,CYDVIS,CLNDVS)
        ELSE
          CNDVIS = 0.0
          CMDVIS = 0.0
          CYDVIS = 0.0
          CLNDVS = 0.0
        ENDIF
        CALL BODCFD(ALPHAR,BETAR,XMACH,CNBVIS,CMBVIS,CYBVIS,CLNBVS)
        CNCF(IFLT)=CNIVIS+CNDVIS+CNBVIS
        CMCF(IFLT)=CMIVIS+CMDVIS+CMBVIS
        CYCF(IFLT)=CYIVIS+CYDVIS+CYBVIS
        CLNCF(IFLT)=CLNIVS+CLNDVS+CLNBVS
  100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE NDIV(XL, DX, NP)
C
C     CALCULATE THE NUMBER OF DIVISIONS IN XL AND INCREASE
C     TO AN EVEN NUMBER
C
C     INPUT VARIABLES
C         XL - SEGMENT LENGTH
C         DX - NOMINAL INCREMENT SIZE
C
C     OUTPUT VARIABLE
C         NP - NUMBER OF DIVISIONS
C
      NP = 0.5+XL/DX
      IF(NP .LT. 2)NP=2
      NN = NP/2
      NN = 2*NN
      IF(NN .LT. NP) NP = NP+1
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE READIN(GO,SAVE,IEND,ITERM)
C
C***  SUBROUTINE TO READ INPUTS FROM TAPE1 (GENERATED BY CONERR)
C***  AND PUT ON TAPE2 FOR READING BY NAMELIST READS.  THE CONTROL
C***  CARDS ARE ALSO READ AND THE PROGRAM FLAGS SET.
C
      LOGICAL GO,SAVE,IEND,SSAVE,IWARN,ITERM
      COMMON /INPCON/ LOC(11),LEN(11),NLNAME(56)
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),CASE,NOEXTR,NOLAT,
     1                IR,IPAGE
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,
     4               LELLB,LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,
     4               LELLB,LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      COMMON /DFLAGS/ DFLT,DREF,DAXI,DFIN1,DFIN2,DFIN3,DFIN4,DDEFL,
     1 DTRIM,DELLB,DINLET,DARBOD
      LOGICAL DFLT,DREF,DAXI,DFIN1,DFIN2,DFIN3,DFIN4,DDEFL,DTRIM,DELLB,
     1 DINLET,DARBOD
C
      COMMON /PARTF/ PARTS(19)
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
      CHARACTER*4 IAST,ISAVE,NEXT,IBLANK,KOL
      LOGICAL PARTS
      DIMENSION KOL(80),NEXT(9),ISAVE(4),NAMORD(300)
      INTEGER CASE
      DATA IAST/'*   '/
      DATA ISAVE/'S   ','A   ','V   ','E   '/
      DATA NEXT/'N   ','E   ','X   ','T   ','    ','C   ',
     1 'A   ','S   ','E   '/
      DATA IBLANK / '    ' /
C
      jsave=0
      IF(IEND)GO TO 1160
      IWARN=.FALSE.
      IF(SAVE)GO TO 1000
      SSAVE=.FALSE.
      REWIND 2
      KOUNT=0
      GO TO 1020
C
C***  UNPACK PREVIOUSLY SAVED NAMELISTS
C
 1000 KK=KOUNT/3
      KK3=3*KK
      IF(KK3.NE.KOUNT)KK=KK+KOUNT-KK3
      I=1
      DO 1010 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)
         I=I+3
 1010 CONTINUE
      JSAVE=KOUNT
C
      SSAVE=.TRUE.
 1020 SAVE=.FALSE.
      GO=.TRUE.
      NCARD=0
C
C***  READ DATA WRITTEN FROM CONERR
C
 1030 NCARD=NCARD+1
C
C***  FOLLOWING READ CARDS FOR FORTRAN IV
C
C     READ(8,1180)(KOL(I),I=1,80)
C     IF(EOF(1))1150,1040
 1040 CONTINUE
C
C***  FOLLOWING READ CARD FOR IBM MACHINES OR FORTRAN V
C
      READ(8,1180,END=1150)(KOL(I),I=1,80)
C
      IF(NCARD .EQ. 1 .AND. PARTS(18))CALL HEADR9
      IF(NCARD .EQ. 1 .AND. PARTS(18))WRITE(6,1190)
C
      IF(PARTS(18))WRITE(6,1200)(KOL(I),I=1,80)
      IF(KOL(1).EQ.IAST)GO TO 1030
C
C***  CHECK FOR NEXT CASE CARD
C
      DO 1050 I=1,9
         IF(KOL(I).NE.NEXT(I))GO TO 1070
 1050 CONTINUE
C
C***  SET-UP TO DELETE NAMELISTS READ IF REQUESTED
C
      DO 1060 K=1,JSAVE
C
C  FLTCON NAMELIST
C
         IF(DFLT .AND. NAMORD(K).EQ.1)NAMORD(K)=800+NAMORD(K)
C
C  REFQ NAMELIST
C
         IF(DREF .AND. NAMORD(K).EQ.2)NAMORD(K)=800+NAMORD(K)
C
C  AXIBOD NAMELIST
C
         IF(DAXI .AND. NAMORD(K).EQ.3)NAMORD(K)=800+NAMORD(K)
C
C  FIN SET 1 NAMELIST
C
         IF(DFIN1 .AND. NAMORD(K).EQ.104)NAMORD(K)=800+NAMORD(K)
C
C  FIN SET 2 NAMELIST
C
         IF(DFIN2 .AND. NAMORD(K).EQ.204)NAMORD(K)=800+NAMORD(K)
C
C  FIN SET 3 NAMELIST
C
         IF(DFIN3 .AND. NAMORD(K).EQ.304)NAMORD(K)=800+NAMORD(K)
C
C  FIN SET 4 NAMELIST
C
         IF(DFIN4 .AND. NAMORD(K).EQ.404)NAMORD(K)=800+NAMORD(K)
C
C  DEFLCT NAMELIST
C
         IF(DDEFL .AND. NAMORD(K).EQ.5)NAMORD(K)=800+NAMORD(K)
C
C  TRIM NAMELIST
C
         IF(DTRIM .AND. NAMORD(K).EQ.6)NAMORD(K)=800+NAMORD(K)
C
C  ELLBOD NAMELIST
C
         IF(DELLB .AND. NAMORD(K).EQ.7)NAMORD(K)=800+NAMORD(K)
C
C  INLET NAMELIST
C
         IF(DINLET .AND. NAMORD(K).EQ.8)NAMORD(K)=800+NAMORD(K)
C
C  ARBITRARY BODY NAMELIST
C
         IF(DARBOD .AND. NAMORD(K) .EQ.10)NAMORD(K)=800+NAMORD(K)
C
 1060 CONTINUE
      GO TO 1100
C
 1070 CONTINUE
C
C***  TEST FOR SAVE CARD
C
      DO 1080 I=1,4
         IF(KOL(I).NE.ISAVE(I))GO TO 1090
 1080 CONTINUE
      SAVE=.TRUE.
      GO TO 1030
C
 1090 CONTINUE
C
C***  IF COLUMN 1 IS NOT BLANK, THEN CONTROL CARD READ
C
      IF(KOL(1).NE.IBLANK)CALL CONTRL(KOL,CASE,SSAVE,IWARN)
      IF(KOL(1).NE.IBLANK)GO TO 1030
C
C***  OTHERWISE HAVE NAMELIST INPUT CARD
C
      CALL GETNLN(LOC,LEN,11,NLNAME,56,KOUNT,NAMORD,KOL,GO)
      WRITE(2,1180)(KOL(I),I=1,80)
      GO TO 1030
C
C***  START READING NAMELIST DATA FROM UNIT 2
C
 1100 CONTINUE
      IF(.NOT.GO)GO TO 1140
C
      CALL READNL(KOUNT,NAMORD)
C
C***  CHECK IF THIS IS A SAVE CASE
C
      IF(.NOT.SAVE)GO TO 1140
C
C***  SAVE PREVIOUS NAMELIST ORDER FOR READING IN NEXT CASE
C***  ARRAY NAMSV IS A PACKED ARRAY (THREE NAMELISTS PER WORD)
C
         KK=KOUNT
         DO 1110 I=1,2
            IF(3*(KK/3).EQ.KK)GO TO 1120
            KK=KK+1
            NAMORD(KK)=0
 1110    CONTINUE
 1120    K=1
         DO 1130 I=1,KK,3
            NAMSV(K)=NAMORD(I)+1000*NAMORD(I+1)+1000000*NAMORD(I+2)
         K=K+1
 1130    CONTINUE
 1140 CONTINUE
C
C***  DETERMINE IF SUFFICIENT NAMELISTS HAVE BEEN INPUT
C***  IN ORDER TO EXECUTE THE CASE
C
      CALL MAJERR(GO,IWARN)
C
C***  WRITE NAMELIST DATA IF REQUESTED
C
      IF(LNAME)CALL WRITNL
C
C***  WRITE MESSAGE IF GO = .FALSE.
C
      IF(.NOT.GO.AND.PARTS(18))WRITE(6,1220)
C
C***  CASE DATA READ, EXECUTE CASE
C
      SSAVE=.FALSE.
      GO TO 1170
C
C***  END-OF-FILE HIT, THIS IS THE LAST CASE
C
 1150 IEND=.TRUE.
      IF(NCARD.LE.1)GO=.FALSE.
      GO TO 1170
C
C***  END OF JOB
C
 1160 IF(PARTS(18))WRITE(6,1210)
C
      ITERM=.TRUE.
C
 1170 CONTINUE
 1180 FORMAT(80A1)
 1190 FORMAT(4X,'CASE INPUTS',/
     1 4X,'FOLLOWING ARE THE CARDS INPUT FOR THIS CASE',/)
 1200 FORMAT(1X,80A1)
 1210 FORMAT(4X,'*** END OF JOB ***')
 1220 FORMAT(/,'THIS CASE TERMINATED DUE TO INSUFFICIENT OR',
     1    ' ILLEGAL DATA INPUT')
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SUBEXP(EXPFLG,RMACH,ICONF,ARRAY)
C
C***  GET THE USER INPUT EXPERIMENTAL DATA FROM UNIT 2.
C***  THE DATA FOR THE CONFIGURATION DESIRED IS FIRST CONVERTED
C***  TO THE CORRECT REFERENCE AREAS/LENGTHS, ADJUSTED TO THE CORRECT
C***  C.G., AND THEN INTERPOLATED AT THE ANGLES OF ATTACK REQUIRED.
C
C***  INPUTS
C
C  IFOUND - 1 IF NO DATA FOUND, 0 IF DATA IS FOUND
C   RMACH - MACH NUMBER OF DATA DESIRED
C   ICONF - CONFIGURATION CODE
C           1=BODY, 2=F1,   3=F2,    4=F3,    5=F4,
C           6=BF1,  7=BF12, 8=BF123, 9=BF1234
C
C***  OUTPUT
C
C   EXPFLG - ARRAY OF FLAGS TO DETERMINE WHICH COEFFICIENTS (CN,CM,CA,
C            CY,CSN,CSL RESPECTIVELY) HAVE EXPERIMENTAL INPUT 1=INPUT
C   ARRAY - ARRAY WHERE DATA IS TO BE PLACED
C           STRUCTURE OF ARRAY IS -
C            1 - 20 CN
C           21 - 40 CM
C           41 - 60 CA
C           61 - 80 CY
C           81 -100 CSN
C          101 -120 CSL
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /REFQN/ SREFR,LREFR,LATR,ROUGH,XCGR,ZCGR,SCALE,BLAYER,RHR
      COMMON /FLC/   NALPHR,ALPHAR(20),BETA,PHI,NMACHR,MACHR(20),
     1               ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
C
      REAL LREF,LATREF,LREFR,LATR,NALPHR,NMACHR,MACHR,NALPHA
      INTEGER EXPFLG
C
      COMMON /LOGIC/ LFLAG(28)
      LOGICAL LFLAG
C
      COMMON /F1WORK/ F1WK(290)
      COMMON /F2WORK/ F2WK(290)
      COMMON /F3WORK/ F3WK(290)
      COMMON /F4WORK/ F4WK(290)
      COMMON /SFIN1/ FIN1(220)
      COMMON /SFIN2/ FIN2(220)
      COMMON /SFIN3/ FIN3(220)
      COMMON /SFIN4/ FIN4(220)
      COMMON /SBODY/ BODY(220)
C
      DIMENSION ARRAY(120),CN(20),CM(20),CA(20),CY(20),CSN(20),CSL(20),
     1          ALPHA(20),IROUT(2),CNF(20),CMF(20),EXPFLG(6),ALPW(20)
C
C***  IS EXPERIMENTAL DATA INPUT
C
      IFOUND=1
      IF(.NOT. LFLAG(25))GO TO 1120
C
C***  SEARCH FOR EXPERIMENTAL DATA
C
      REWIND 2
C
C***  LOOP UNTIL ALL DATA HAS BEEN READ
C
 1000 CALL REXPR(RMACH,ICONF,IFOUND,SREF,LREF,LATREF,XCG,ZCG,
     1    NALPHA,ALPHA,CN,CM,CA,CY,CSN,CSL)
C
      IF(IFOUND .NE. 0)GO TO 1120
C
C***  DATA FOUND, POST-PROCESS DATA
C
C***  CONVERT FROM USER SPECIFIED UNITS TO FEET
C
      CALL CONVRT(SREF,1,-2)
      CALL CONVRT(LREF,1,-1)
      CALL CONVRT(LATREF,1,-1)
      CALL CONVRT(XCG,1,-1)
      CALL CONVRT(ZCG,1,-1)
C
C***  VERIFY NONZERO REFERENCE AREA AND LENGTHS
C
      IF(SREF   .LE. UNUSED)SREF=SREFR
      IF(LREF   .LE. UNUSED)LREF=LREFR
      IF(LATREF .LE. UNUSED)LATREF=LATR
      IF(XCG    .EQ. UNUSED)XCG=XCGR
      IF(ZCG    .EQ. UNUSED)ZCG=ZCGR
      IF(NALPHA .LE. UNUSED)NALPHA=NALPHR
C
C***  CHANGE SREF, LREF AND/OR LATREF OF DATA TO MATCH PREDICTION
C
      DXCG=XCGR-XCG
      DZCG=ZCGR-ZCG
C
      NA=NALPHA+.5
C
      DO 1050 I=1,NA
         IF(SREF .EQ. SREFR)GO TO 1010
            IF(CN (I) .NE. UNUSED)CN (I)=CN (I)*SREF/SREFR
            IF(CA (I) .NE. UNUSED)CA (I)=CA (I)*SREF/SREFR
            IF(CY (I) .NE. UNUSED)CY (I)=CY (I)*SREF/SREFR
            IF(CM (I) .NE. UNUSED)CM (I)=CM (I)*SREF/SREFR
            IF(CSN(I) .NE. UNUSED)CSN(I)=CSN(I)*SREF/SREFR
            IF(CSL(I) .NE. UNUSED)CSL(I)=CSL(I)*SREF/SREFR
 1010    IF(LREF .EQ. LREFR)GO TO 1020
            IF(CM (I) .NE. UNUSED)CM (I)=CM (I)*LREF/LREFR
 1020    IF(LATREF .EQ. LATR)GO TO 1030
            IF(CSN(I) .NE. UNUSED)CSN(I)=CSN(I)*LATREF/LREFR
            IF(CSL(I) .NE. UNUSED)CSL(I)=CSL(I)*LATREF/LREFR
 1030    IF(DXCG .EQ. 0.)GO TO 1040
            IF(CM (I) .NE. UNUSED .AND. CN (I) .NE. UNUSED)
     1         CM (I)=CM (I)+DXCG*CN(I)/LREFR
            IF(CSN(I) .NE. UNUSED .AND. CY (I) .NE. UNUSED)
     1         CSN(I)=CSN(I)+DXCG*CY(I)/LREFR
 1040    IF(DZCG .EQ. 0.)GO TO 1050
            IF(CM (I) .NE. UNUSED .AND. CA (I) .NE. UNUSED)
     1         CM (I)=CM (I)+DZCG*CA(I)/LREFR
            IF(CSL(I) .NE. UNUSED .AND. CA (I) .NE. UNUSED)
     1         CSL(I)=CSL(I)+DZCG*CA(I)/LREFR
 1050 CONTINUE
C
C***  INTERPOLATE AT PREDICTED ANGLES OF ATTACK
C
      MM=NALPHR+.5
      DO 1080 I=1,MM
         IF(CN (1) .EQ. UNUSED)GO TO 1060
         CALL LNTRP(ALPHA,CN ,NA,ALPHAR(I),ARRAY(I    ))
         CNF(I)=ARRAY(I)
 1060    IF(CM (1) .EQ. UNUSED)GO TO 1070
         CALL LNTRP(ALPHA,CM ,NA,ALPHAR(I),ARRAY(I+20 ))
         CMF(I)=ARRAY(I+20)
 1070    IF(CA (1) .NE. UNUSED)
     1      CALL LNTRP(ALPHA,CA ,NA,ALPHAR(I),ARRAY(I+40 ))
         IF(CY (1) .NE. UNUSED)
     1      CALL LNTRP(ALPHA,CY ,NA,ALPHAR(I),ARRAY(I+60 ))
         IF(CSN(1) .NE. UNUSED)
     1      CALL LNTRP(ALPHA,CSN,NA,ALPHAR(I),ARRAY(I+80 ))
         IF(CSL(1) .NE. UNUSED)
     1      CALL LNTRP(ALPHA,CSL,NA,ALPHAR(I),ARRAY(I+100))
 1080 CONTINUE
C
C     CHECK TO SEE WHICH COEFFICIENTS HAVE BEEN INPUT AND SET THE FLAG
C
      IF(CN(1) .NE. UNUSED)EXPFLG(1)=1
      IF(CM(1) .NE. UNUSED)EXPFLG(2)=1
      IF(CA(1) .NE. UNUSED)EXPFLG(3)=1
      IF(CY(1) .NE. UNUSED)EXPFLG(4)=1
      IF(CSN(1) .NE. UNUSED)EXPFLG(5)=1
      IF(CSL(1) .NE. UNUSED)EXPFLG(6)=1
C
C***  FOR FIN ALONE EXPERIMENTAL DATA, CORRECT PANEL DATA
C
      IF(ICONF .LT. 2 .OR. ICONF .GT. 5)GO TO 1110
C
C      DIFFERENTIATE CN AND CM TO DETERMINE FIN ALONE CNA AND CMA
C        AND UPDATE FIN IOM COMMON BLOCKS
C
      DO 1090 I=1,20
         IF(ICONF .EQ. 2 .AND. CN(1) .NE. UNUSED)
     1     CALL POLINT(ALPHAR,CNF,MM,ALPHAR(I),CNFINT,FIN1(I+120))
         IF(ICONF .EQ. 2 .AND. CM(1) .NE. UNUSED)
     1     CALL POLINT(ALPHAR,CMF,MM,ALPHAR(I),CMFINT,FIN1(I+140))
         IF(ICONF .EQ. 3 .AND. CN(1) .NE. UNUSED)
     1     CALL POLINT(ALPHAR,CNF,MM,ALPHAR(I),CNFINT,FIN2(I+120))
         IF(ICONF .EQ. 3 .AND. CM(1) .NE. UNUSED)
     1     CALL POLINT(ALPHAR,CMF,MM,ALPHAR(I),CMFINT,FIN2(I+140))
         IF(ICONF .EQ. 4 .AND. CN(1) .NE. UNUSED)
     1     CALL POLINT(ALPHAR,CNF,MM,ALPHAR(I),CNFINT,FIN3(I+120))
         IF(ICONF .EQ. 4 .AND. CM(1) .NE. UNUSED)
     1     CALL POLINT(ALPHAR,CMF,MM,ALPHAR(I),CMFINT,FIN3(I+140))
         IF(ICONF .EQ. 5 .AND. CN(1) .NE. UNUSED)
     1     CALL POLINT(ALPHAR,CNF,MM,ALPHAR(I),CNFINT,FIN4(I+120))
         IF(ICONF .EQ. 5 .AND. CM(1) .NE. UNUSED)
     1     CALL POLINT(ALPHAR,CMF,MM,ALPHAR(I),CMFINT,FIN4(I+140))
 1090 CONTINUE
C
C ***   UPDATE COMMON BLOCK FWORK (PANEL ALONE BLOCKS)
C
C
C     LINES ADDED TO ACCOUNT FOR NON-ZERO CMO AND ALPHA-ZERO NORMAL
C     FORCE (ONLY ACCOUNTS FOR FIN ALONE CMO. WILL NOT ACCOUNT FOR 
C     BODY+FIN CMO AS CODED)
C
      AOL = 0.0
      IF(CN(1) .NE. UNUSED)CALL LNTRP(CN,ALPHA,NA,0.0,AOL)
      IF(CM(1) .NE. UNUSED)CALL LNTRP(ALPHA,CM,NA,AOL,CMO)
      IF(ABS(AOL) .LT. 0.0001)GO TO 1101
C
C     DETERMINE CURRENT MACH NUMBER
C
      NM = NMACHR + 0.5
      DO 1091 I=1,NM
         IF(RMACH .EQ. MACHR(I))IM=I
 1091 CONTINUE
C
      IF(ICONF .EQ. 2)THEN
        F1WK(269)   = AOL
        F1WK(43+IM) = CMO
      ELSEIF(ICONF .EQ. 3)THEN
        F2WK(269)   = AOL
        F2WK(43+IM) = CMO
      ELSEIF(ICONF .EQ. 4)THEN
        F3WK(269)   = AOL
        F3WK(43+IM) = CMO
      ELSEIF(ICONF .EQ. 5)THEN
        F4WK(269)   = AOL
        F4WK(43+IM) = CMO
      ENDIF
C
C --- FWK(248-267) ('INTERPOLATED CN FOR PANEL CHARACTERISTICS') 
C     IS RELATIVE TO AOL.  THERFORE SUBTRACT CN AT ALPHA=0 FROM
C     EXPERIMENTAL CN BEFORE INTERPOLATING AT ANGLES OF ATTACK
C     IN FWK(228-247) ARRAY
C
C     FWK(208-227) SAME FOR CA AS CN
C
      DO 1095 I=1,NA
        ALPW(I)   = ALPHA(I) - AOL
 1095 CONTINUE
C
      DO 1100 I=1,20
         IF(ICONF .EQ. 2 .AND. CN(1) .NE. UNUSED)
     1      CALL LNTRP(ALPW,CN,NA,F1WK(I+227),F1WK(I+247))
         IF(ICONF .EQ. 3 .AND. CN(1) .NE. UNUSED)
     1      CALL LNTRP(ALPW,CN,NA,F2WK(I+227),F2WK(I+247))
         IF(ICONF .EQ. 4 .AND. CN(1) .NE. UNUSED)
     1      CALL LNTRP(ALPW,CN,NA,F3WK(I+227),F3WK(I+247))
         IF(ICONF .EQ. 5 .AND. CN(1) .NE. UNUSED)
     1      CALL LNTRP(ALPW,CN,NA,F4WK(I+227),F4WK(I+247))
 1100 CONTINUE
C
 1101 CONTINUE
      IF(CA(1).EQ.UNUSED) GO TO 1110
      DO 1109 I=1,MM
         IF(ICONF.NE.2) GO TO 1102
            F1WK(207)=0.0
            CALL POLINT(ALPW,CA,NA,ALPHAR(I),F1WK(I+207),CAA)
 1102    IF(ICONF.NE.3) GO TO 1103
            F2WK(207)=0.0
            CALL POLINT(ALPW,CA,NA,ALPHAR(I),F2WK(I+207),CAA)
 1103    IF(ICONF.NE.4) GO TO 1104
            F3WK(207)=0.0
            CALL POLINT(ALPW,CA,NA,ALPHAR(I),F3WK(I+207),CAA)
 1104    IF(ICONF.NE.5) GO TO 1105
            F4WK(207)=0.0
            CALL POLINT(ALPW,CA,NA,ALPHAR(I),F4WK(I+207),CAA)
 1105    CONTINUE
 1109 CONTINUE
 1110  GO TO 1000
C
 1120 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WINLET
C
C***  WRITE INLET INPUTS
C
      COMMON /INLETN/ AA(64)
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION NLNAME(5),IVNAME(47),LEN(14),IDIM(14),LOC(14)
C
      DATA NLNAME /  'I   ','N   ','L   ','E   ','T   '/
      DATA IVNAME /  'N   ','I   ','N   ',
     1 'I   ','N   ','T   ','Y   ','P   ','E   ',
     2 'X   ','I   ','N   ','L   ','T   ',
     3 'X   ','D   ','I   ','V   ',
     4 'H   ','D   ','I   ','V   ',
     5 'L   ','D   ','I   ','V   ',
     6 'P   ','H   ','I   ',
     7 'X   ',
     8 'H   ',
     9 'W   ',
     A 'C   ','O   ','V   ','E   ','R   ',
     B 'R   ','A   ','M   ','P   ',
     C 'A   ','D   ','D   ',
     D 'M   ','F   ','R   '/
      DATA IDIM   / 1,1,1,1,1,1,20,5,5,5,-1,1,-1,20 /
      DATA LEN    / 3,6,5,4,4,4,3,1,1,1,5,4,3,3 /
      DATA LOC    / 1,2,3,4,5,6,7,27,32,37,42,43,44,45 /
C
      CALL NAMEW(KAND,6,NLNAME,5,IVNAME,47,LEN,14,IDIM,AA,64,LOC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ATMOS(ALT,A)
C
C  ROUTINE ADAPTED FROM DIGITAL DATCOM
C  ORIGINAL ROUTINE WRITTEN BY J.E. WILLIAMS, MCDONNELL DOUGLAS
C  MODIFIED BY S.R. VUKELICH
C
C     THIS ROUTINE CALCULATES ATMOSPHERIC PROPERTIES OF THE
C     U.S. STANDARD ATMOSPHERE,1962,ASSUMING AN INVERSE SQUARE
C     GRAVITATIONAL FIELD. THIS ASSUMPTION YIELDS DATA THAT
C     AGREES WITH THE COESA DOCUMENT WITHIN 1 PER CENT AT
C     ALL ALTITUDES UP TO 700 KILOMETERS (2296588 FEET). THE
C     DATA IS ARRANGED IN THE ATMOSPHERE ARRAY, A, AS
C     FOLLOWS
C
C     A(1) = CS, SPEED OF SOUND, FT/SEC
C     A(2) = (1/CS)(DCS/DZ), SOUND DERIVATIVE, 1/FT
C     A(3) = Z, GEOMETRIC ALTITUDE, FT
C     A(4) = P, PRESSURE, LB/FT2
C     A(5) = DP/DZ, PRESSURE DERIVATIVE, LB/FT3
C     A(6) = RHO, DENSITY, SLUGS/FT3
C     A(7) = (1/RHO)(DRHO/DZ), DENSITY DERIVATIVE, 1/FT
C     A(8) = T, TEMPERATURE, DEG RANKINE
C     A(9) = DT/DZ, TEMPERATURE DERIVATIVE, DEG RANKINE/FT
C
C     VARIOUS CONSTANTS USED
C      EARTH RADIUS                = 20890855 FT
C      SPECIFIC HEAT RATIO FOR AIR = 1.4
C     SEA LEVEL VALUES
C      GRAVITATIONAL ACCELERATION  = 32.1740484 FT/SEC2
C      MOLECULAR WEIGHT            = 28.9644
C      GO*MO/R                     = 0.018743418 DEG RANK/FT
C
      DIMENSION  A( 9),HG(10),ZM(14),WM(14),TM(23),PM(22)
C
C     SET ARRAYS AND CONSTANT VALUES
C
      DATA G0,WM0,R0,GMRS/32.1740484,28.9644,20890855.0,
     1     0.018743418/,HG/-16404.,0.0
     2     ,36089.,65617.,104987.,154199.,170604.,200131.,
     3     250186.,291160./,ZM/295276.,328084.,
     4     360892.,393701.,492126.,524934.,557743.,623360.,
     5     754593.,984252.,1312336.,1640420.,1968504.,
     6     2296588./,WM/28.9644,28.88,28.56,
     7     28.07,26.92,26.66,26.4,25.85,24.7,22.66,19.94,
     8     17.94,16.84,16.17/
C
      DATA TM/577.17,518.67,389.97,389.97,411.57
     1     ,487.17,487.17,454.77,325.17,325.17,379.17,469.17
     2     ,649.17,1729.17,1999.17,2179.17,2431.17,2791.17
     3     ,3295.17,3889.17,4357.17,4663.17,4861.17/,PM/
     4     3711.0839,2116.2165,472.67563,114.34314,
     5     18.128355,2.3162178,1.2321972,3.8030279E-01,
     6     2.1671352E-02,3.4313478E-03,6.2773411E-04,1.53490
     7     91E-04,5.2624212E-05,1.0561806E-05,7.7083076E-06,
     8     5.8267151E-06,3.5159854E-06,1.4520255E-06,3.92905
     9     63E-07,8.4030242E-08,2.2835256E-08,7.1875452E-09/
C
      A(3) = ALT
C
C     CALCULATE G, Z, AND CHECK
C
 1000 Z = A(3)
      G = G0*(R0/(R0+Z))**2
      IF (Z .GT. 295276.0) GO TO 1040
C
C     TMS LINEAR WITH GEOPOTENTIAL. CALCULATE H AND SEARCH
C
      H     = R0*Z/(R0+Z)
      DO 1010 I = 2,10
      J     = I - 1
      IF (HG(I) .GE. H) GO TO 1020
 1010 CONTINUE
C
C     CALCULATE TMS SLOPE,TMS, AND SET MOL WT STUFF
C
 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
C
C     CHECK TMS SLOPE AND CALCULATE PRESSURE
C
      IF (ELH .EQ. 0.0) GO TO 1030
C
C     NON - ZERO SLOPE PRESSURE EQUATION
C
      A(4) = PM(J)*(TM(J)/TMS)**(GMRS/ELH)
      GO TO 1070
C
C     ZERO SLOPE PRESSURE EQUATION
C
 1030 A(4) = PM(J)*EXP(GMRS*(HG(J)-H)/TMS)
      GO TO 1070
C
C     TMS LINEAR WITH Z. SEARCH MATRIX
C
 1040 DO 1050 I = 2,14
      J      = I + 8
      K      = I - 1
      IF (ZM(I) .GE. Z) GO TO 1060
 1050 CONTINUE
C
C     CALCULATE TMS, SLOPE, AND STUFF
C
 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
C
C     PRESSURE EQUATION FOR TMS LINEAR WITH Z
C
      A(4) = PM(J)*EXP(GMRS/ELZ*(R0/(R0+ZLZ))**2*((Z-ZM(K))*
     1       (R0+ZLZ)/(R0+Z)/(R0+ZM(K)) - ALOG(TMS*(R0+ZM(K)
     2       )/TM(J)/(R0+Z))))
C
C     CALCULATE SOUND SPEED AND DERIVATIVE
C
 1070 A(1) = 49.022164*SQRT(TMS)
      A(2) = 0.5*ELZ/TMS
C
C     CALCULATE DENSITY, DERIVATIVE, AND PRESSURE DERIVATIVE
C
      A(6) = GMRS*A(4)/G0/TMS
      A(7) = - (A(6)*G/A(4) + ELZ/TMS)
      A(5) = -A(6)*G
C
C     CALCULATE TEMPERATURE, DERIVATIVE, AND LEAVE
C
      A(8) = EM*TMS/WM0
      A(9) = (EM*ELZ + TMS*DMDZ)/WM0
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BODYA(IM)
C
C***  EXECUTIVE FOR AXISYMMETRIC BODY ALONE AERODYNAMICS
C
C***  IM IS THE CURRENT MACH NUMBER INDEX
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /ABODIN/ NX,X0,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     1                TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,POWER,
     2                DISCON(20),ELLIP(50),H(50),ADUM(648)
      REAL NX,LNOSE,LCENTR,LAFT
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      REAL NALPHA,NMACH,MACH
      COMMON /TOTALC/ BALPHA(20),BBETA(20),BPHI(20),ALPTOT(20)
C
      COMMON /SBODY/ CNB(20),CMB(20),CAB(20),CYB(20),CLNB(20),CLLB(20),
     1               CNAB(20),CMAB(20),CYBB(20),CNBB(20),CLBB(20)
      COMMON /BDWORK/ CNP(20),CMP(20),CNV(20),CMV(20),DUM(161)
C
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
C***  CALL SUBSONIC/TRANSONIC OR SUPERSONIC METHOD SUBROUTINES
C
C     * IF THE CURRENT MACH NUMBER IS LESS THAN 1.2
           IF(MACH(IM) .LE. 1.2)GO TO 1000
           GO TO 1010
C       THEN USE SUBSONIC OR TRANSONIC METHODS
 1000      CALL STBODY(IM)
           GO TO 1020
C       ELSE USE SUPERSONIC METHODS
 1010      CONTINUE
           CALL SUPBOD(IM)
 1020      CONTINUE
C     * ENDIF
C
C***  DIFFERENTIATE CN AND CM CURVES, SET ROLL MOMENT EQUAL TO ZERO
C
      NALP=NALPHA+0.5
      DO 1030 I=1,NALP
         CALL POLINT(ALPHA,CNB,NALP,ALPHA(I),CNBINT,CNAB(I))
         CALL POLINT(ALPHA,CMB,NALP,ALPHA(I),CMBINT,CMAB(I))
         CLLB(I)=0.
         CLBB(I)=0.
 1030 CONTINUE
C
C***  DIRECTIONAL DERIVATIVES (PERTURBATING BETA BY ONE DEGREE)
C
      DO 1040 I=1,NALP
         BETNEW=BBETA(I)+1.
         PHINEW=UNUSED
         CALL ALPBET(BALPHA(I),ALTNEW,BETNEW,PHINEW)
         CALL POLINT(BALPHA,CNB,NALP,ALTNEW,CNNPHI,DYDX)
         CYBB(I)=-CYB(I)-SIN(PHINEW/RAD)*CNNPHI
 1040 CONTINUE
C
      DO 1050 I=1,NALP
         BETNEW=BBETA(I)+1.
         PHINEW=UNUSED
         CALL ALPBET(BALPHA(I),ALTNEW,BETNEW,PHINEW)
         CALL POLINT(BALPHA,CMB,NALP,ALTNEW,CMNPHI,DYDX)
         CNBB(I)=-CLNB(I)-SIN(PHINEW/RAD)*CMNPHI*LREF/LATREF
 1050 CONTINUE
C
      IF(PARTS(6))CALL BDPART(IM,1.,1.,1.,1.,1.,1.,1.,1.)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE COORD4(X,XU,XL,YUN,YLN,L,I,J,K,II,JJ,KK,III,JJJ,
     1 THN,CAM,RHO,T)
C
C*****
C***** CALCULATE NACA FOUR DIGIT AIRFOIL COORDINATES
C*****
C
C  ROUTINE ADAPTED FROM DIGITAL DATCOM
C  ORIGINAL ROUTINE WRITTEN BY D. KINSEY, D. BOWERS, AFFDL
C  MODIFIED BY S.R. VUKELICH, MCDONNELL DOUGLAS
C
      DIMENSION X(50),XU(50),XL(50),YUN(50),YLN(50),THN(50),CAM(50)
C
      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
C
C ... COMPUTE COORDINATES ALONG CHORD
C
      DO 1000 M=1,L
      YT=5.*T*(.2969*SQRT(X(M))-.126*X(M)-.3516*X(M)**2+.2843*X(M)**3
     1  -.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 CONTINUE
      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
c *************************************
c *************************************
c *************************************
      SUBROUTINE DREAD(NSET,JUMP)
C
C***  SUBROUTINE TO DETERMINE NAMELIST TO BE READ FROM UNIT 2
C***  BUT THE DATA NOT USED ... ACTS AS A NAMELIST DELETE
C
      DIMENSION AA1(125),AA2(9),AA3(881),AA4(389),AA5(40),
     1          AA6(15),AA7(881),AA8(64),AA9(115)
C
      LOGICAL LDUM
C
      JJUMP=JUMP
C
 1000 IF(JJUMP .GT. 0 .AND. JJUMP .LT. 10)GO TO 1010
C
         JJUMP=JJUMP-100
         IF(JJUMP .LT. 0)GO TO 1100
         GO TO 1000
C
 1010 CONTINUE
C
      GO TO (1020,1030,1040,1050,1060,1070,1080,1090,1100,1095), JJUMP
C
 1020 CALL RFLT(LDUM, AA1)
      GO TO 1100
C
 1030 CALL RREFQ(LDUM, AA2)
      GO TO 1100
C
 1040 CALL RAXIS(LDUM, AA3)
      GO TO 1100
C
 1050 CALL RFIN1(LDUM, AA4)
      GO TO 1100
C
 1060 CALL RDEFL(LDUM, AA5)
      GO TO 1100
C
 1070 CALL RTRIM(LDUM, AA6)
      GO TO 1100
C
 1080 CALL RELLB(LDUM, AA7)
      GO TO 1100
C
 1090 CALL RINLET(LDUM, AA8)
      GO TO 1100
C
 1095 CALL RARBOD(LDUM,AA9)
C
 1100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCNAAT(MACH, AR, DELY, SLE, TAPER, ALPHA, CNA,
     1                  B, SECCLA, SCLM, CNAA)
C ***
C *** COMPUTES TRANSONIC NON-LINEAR NORMAL FORCE PER SINE(ALPHA)**2
C ***
C *** REFERENCE   DATCOM SECTION 4.1.3.3
C ***
C *** LIMITATIONS   ALPHA .LT. 90 DEG
C ***               AR .LE. 4.0/((C1+1)*COS(SLE))
C ***               STRAIGHT TAPERED FINS
C ***               NO CAMBER
C ***
C *** INPUT   MACH    MACH NUMBER
C ***         AR      EXPOSED FIN ASPECT RATIO OF TWO PANELS
C ***         DELY    DIFFERENCE IN AIRFOIL ORDINATE BETWEEN
C ***                 .15% AND 6% CHORD,PER CENT CHORD LENGTH
C ***         SLE     LEADING EDGE SWEEP ANGLE, DEG
C ***         TAPER   EXPOSED FIN TAPER RATIO
C ***         ALPHA   ANGLE-OF-ATTACK, DEG
C ***         CNA     LINEAR CN, CN PER ALPHA AT ALPHA = 0, 1/DEG
C ***         B       FIN EXPOSED SPAN, TWO PANELS
C ***         SECCLA  SECTION LIFT CURVE SLOPE
C ***         SCLM    SECTION MAXIMUM LIFT
C ***
C *** OUTPUT  CNAA    CN PER SIN(ALPHA)**2,REFERENCED TO EXPOSED
C ***                 PLANFORM AREA OF TWO PANELS
C ***
C ***
      REAL MACH
C ***
C *** CONSTANT DATA
C ***
      COMMON /CONST/PI,RAD,UNUSED,KAND
C
C ***
C *** GET CNA AND CNAA AT MACH 0.60
C ***
      CR   = 2.0*B/(AR*(1.0+TAPER))
      CT   = CR*TAPER
      TLE  = TAN(SLE/RAD)
      TC2  = TLE+(CT-CR)/B
      SWEP50= ATAN(TC2)*RAD
      CALL FCNASB( SWEP50, AR, SECCLA, 0.60, CNA6)
      CALL FCNAAS(0.60, AR, DELY, SLE, TAPER, ALPHA, CNA6, SCLM, CNAA6)
      RC6 = CNAA6/CNA6
C ***
C *** GET CNA AND CNAA AT MACH 1.40
C ***
      DELN = RAD*ATAN(DELY/5.85)
      CALL FCNASP(1.40, TAPER, AR, SLE, DELN, CNA14)
      CALL FCNAAH(1.40, DELY, SLE, ALPHA, CNA14, CNAA14)
      RC14 = CNAA14/CNA14
C ***
C *** CALCULATE CNAA AT MACH
C ***
      RCM  = RC6+(RC14-RC6)*(MACH-0.60)/0.80
      CNAA = RCM*CNA
C ***
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE GEO(X,Y,Z,SLL,SLR,RO,B,NN,XX,FF,FX,FXX,GM,SG,CG,J)
C
C  SUBROUTINE TO INTERPOLATE THE GEOMETRY FOR LOCAL RADIUS,
C  SLOPE AND SECOND DERIVATIVE OF THE RADIUS
C
C  INPUTS
C
C      X -- ARRAY OF X COORDINATES
C      Y -- ARRAY OF BODY RADII
C      Z -- ARRAY OF FITTING PARAMETERS (FROM SETGEO)
C    SLL -- ARRAY OF LEFT HAND SLOPES FOR EACH SEGMENT
C    SLR -- ARRAY OF RIGHT HAND SLOPES FOR EACH SEGMENT
C     RO -- NOSE BLUNTNESS FACTOR IN CONIC FIT
C      B -- NOSE BLUNTNESS FACTOR IN CONIC FIT
C     NN -- ARRAY OF POINTS FOR EACH SECTION
C     XX -- LOCAL VALUE OF X
C      J -- SEGMENT NUMBER BEING ANALYIZED
C
C  OUTPUTS
C
C     FF -- INTERPOLATED RADIUS
C     FX -- DERIVATIVE D(RADIUS)/D(X)
C    FXX -- DERIVATIVE D2(RADIUS)/D(X)2
C     GM -- LOCAL BODY SLOPE, RADIANS
C     SG -- SIN OF GM
C     CG -- COSINE OF GM
C
C  ROUTINES CALLED -- NONE
C
      DIMENSION X(50),Y(50),Z(50),SLL(5),SLR(5),NN(5)
      IF(J.EQ.1)GO TO 1050
      NM=NN(J)-1
      NZ=NN(J)
      NB=NN(J-1)
      DO 1000 I=NB,NM
         XM=(X(I+1)+X(I))/2.
         IF(XX.LT.XM)GO TO 1010
 1000 CONTINUE
      GO TO 1030
 1010 IF(I.EQ.NB)GO TO 1020
      DXP=X(I+1)-X(I)
      DX=X(I)-X(I-1)
      T1=(Z(I)-Y(I))/DXP/(DXP+DX)
      T2=(Z(I-1)-Y(I))/DX/(DXP+DX)
      DYX=2.*(DX*T1-DXP*T2)
      FXX=8.*(T1+T2)
      GO TO 1040
C
C    BEG OF SEGMENT
C
 1020 FXX=8.*(Z(NB)-Y(NB))/(X(NB+1)-X(NB))**2-4.*SLR(J-1)/(X(NB+1)-X(NB)
     1)
      DYX=SLR(J-1)
      GO TO 1040
C
C     END OF SEGMENT
C
 1030 FXX=8.*(Z(NM)-Y(NZ))/(X(NZ)-X(NM))**2+4.*SLL(J)/(X(NZ)-X(NM))
      DYX=SLL(J)
 1040 FF=Y(I)+DYX*(XX-X(I))+FXX*(XX-X(I))**2/2.
      FX=DYX+FXX*(XX-X(I))
      GO TO 1060
C
C    BLUNTED NOSE FIT BY CONIC
C
 1050 FF=SQRT(2.*RO*XX+B*XX**2)
      FX=(RO+B*XX)/FF
      FXX=(B-FX**2)/FF
 1060 GM=ATAN(FX)
      SG=SIN(GM)
      CG=COS(GM)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE INITZ(CASE,SAVE)
C
C***  SUBROUTINE TO INITIALIZE ALL PROGRAM ARRAYS TO UNUSED
C
      INTEGER CASE
      LOGICAL SAVE
C
C  BODY ARRAYS
C
      CALL INZBOD
C
C  FIN ARRAYS
C
      CALL INZFIN(CASE,SAVE)
C
C  PROGRAM FLAGS
C
      CALL INZFLG(CASE,SAVE)
C
C  FLIGHT CONDITIONS
C
      CALL INZFLC
C
C  IDEAL OUTPUT MATRIX (IOM)
C
      CALL INZIOM
C
C  REFERENCE QUANTITIES
C
      CALL INZREF
C
C  TRIM ARRAYS
C
      CALL INZTRM
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE NEWT(CPV,R,NN1,NFL,NNI,VOVS,AL,XM,XINT,RR,
     1  RREF,CABL,CNBL,CMBL)
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  ORIGINAL ROUTINE WRITTEN BY F. MOORE, NSWC
C  MODIFIED BY J. JENKINS, WL/FIGC
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /VDARY/ XB(220),RB(220),RBP(220),C(220),C1(220),RB1(220),
     1  RBP1(220),B(220),PSI(220),ZE0X(220),PSIR(220),PHIX(220)
      DIMENSION R(50)
      DIMENSION CPV(220,7)
      DIMENSION PH(7),CPP(7)
C
      PLPI=(1.2*VOVS**2)**3.5*(6./(7.*VOVS**2-1.))**2.5
      IF(NFL.EQ.1) GO TO 1000
      CP0= (0.906*PLPI-1.)/(0.7*VOVS**2)
      CA=CP0*(R(1)/RREF)**2
      CN=0.
      CM=0.
      CABL=CA
      CNBL=0.
      CMBL=0.
      XCP=0.
      CL=-CA*SIN(AL)
      CD=CA*COS(AL)
      IF(NFL.EQ.2) GO TO 1100
      NNI=2
      GO TO 1110
 1000 CP0=(PLPI-1.)/(0.7*VOVS**2)
      CS=COS(AL)
      SS=SIN(AL)
      PH(1)=0.
      IF(AL.GT.0.0001) GO TO 1010
      NM=1
      GO TO 1030
 1010 DO 1020 I=2,7
      PH(I)=PH(I-1)+30./RAD
 1020 CONTINUE
      NM=7
 1030 CONTINUE
      X1=0.
      DX=(RR+XM)/6.
      DO 1050 I=1,7
      X2=X1-RR
      R2=SQRT(RR**2-X2**2)
      DO 1040 L=1,NM
      A=(1.-X1/RR)**2
      CP=CP0*(A*CS**2+(X1/RR-1.)*SQRT(1.-A)*COS(PH(L))*SIN(2.*AL)
     1+(1.-A)*COS(PH(L))**2*SS**2)
      CPP(L)=CP
 1040 CONTINUE
      X1=X1+DX
 1050 CONTINUE
      D=CP-CPV(2,7)
      D2=D
      DO 1080 I=3,NN1
      X2=XB(I)
      IF(X2.GE.XINT) GO TO 1090
      X1=RR+X2
      IF(X1.GE.RR) X1=RR
      IF(X1.GE.RR) X2=RR
      R2=SQRT(RR**2-X2**2)
      DO 1060 L=1,NM
      A=(1.-X1/RR)**2
      CP=CP0*(A*CS**2+(X1/RR-1.)*SQRT(1.-A)*COS(PH(L))*SIN(2.*AL)
     1+(1.-A)*COS(PH(L))**2*SS**2)
      IF(I.LT.NN1) GO TO 1060
      CPP(L)=CP
 1060 CONTINUE
      IF(D.GT.0.) GO TO 1070
      D1=D2
      D2=CP-CPV(I,7)
      IF(D2.LE.0.) GO TO 1080
      SLOPE=(D2-D1)/(XB(I)-XB(I-1))
      XNV= XB(I-1)-D1/SLOPE
      NNI=I
      GO TO 1090
 1070 D1=D2
      D2=CP-CPV(I,7)
      IF(D2.GE.0.)GO TO 1080
      SLOPE=(D2-D1)/(XB(I)-XB(I-1))
      XNV=XB(I-1)-D1/SLOPE
      NNI=I
      GO TO 1090
 1080 CONTINUE
 1090 IF(I.GE.NN1) XNV=XINT
      NNI=I
      IF(X2.GE.XINT) XNV=XINT
      IF(I.GE.NN1) NNI=I-1
      YNV=SQRT(RR**2-XNV**2)
      TH2=ATAN(-YNV/XNV)
      SH=SIN(TH2)
      CH=COS(TH2)
      RA=(RR/RREF)**2
      CA=CP0/2.*RA*(CS**2*(1.-CH**4)+.5*SS**2*SH**4)
      CN=CP0*RA*SIN(2.*AL)*SH**4/4.
      CM=-CP0/2.*RA*SIN(2.*AL)*(SH**4/4.+SH**2*CH**3/5.+2./15.*(CH**3
     1-1.))
      CABL=CA
      CNBL=CN
      CMBL=CM
      CL=CN*CS-CA*SS
      CD=CA*CS+CN*SS
      XCP=-CM/CN
 1100 CONTINUE
 1110 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE READNL(KOUNT,NAMORD)
C      
C***  SUBROUTINE TO READ NAMELIST INPUTS FROM TAPE UNIT 2
C      
C***  KOUNT IS THE NUMBER OF NAMELISTS TO BE READ
C***  NAMORD CONTAINS NAMELIST ORDER
C      
      COMMON /ABODIN/ ABOD(881)
      COMMON /INCID/  INCI(40)
      COMMON /FLC/    FLTC(144)
      COMMON /REFQN/  REFQ(9)
      COMMON /TRIMIN/ TRIM(19)
      COMMON /INLETN/ INLE(64)
      COMMON /FSET1/  FIN1(399)
      COMMON /FSET2/  FIN2(399)
      COMMON /FSET3/  FIN3(399)
      COMMON /FSET4/  FIN4(399)
C      
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C      
      REAL INLE,INCI
      DIMENSION NAMORD(300)
      REWIND 2
C      
C***  NAMORD ARRAY CONTAINS NAMELIST ORDER
C      
      DO 1120 J=1,KOUNT
         JUMP=NAMORD(J)
         NSET=0
 1000       IF(JUMP.LT.100)GO TO 1010
C      
C***  DETERMINE FIN SET (SUBTRACT 100 FROM JUMP)
C      
               NSET=NSET+1
               JUMP=JUMP-100
               GO TO 1000
 1010       CONTINUE
C      
C***  IF NSET .GT. 4 (800 ADDED TO JUMP), THEN DELETE NAMELIST
C      
         IF(NSET .GT. 4)CALL DREAD(NSET,JUMP)
         IF(NSET .GT. 4)GO TO 1120
C      
C***  EXPERIMENTAL DATA NOT READ HERE (JUMP=9)
C      
         IF(JUMP.LE.0 .OR. JUMP.GT.10)GO TO 1120
         IF(JUMP.EQ.4 .AND. (NSET.EQ.0 .OR. NSET.GT.4))GO TO 1110
         GO TO (1020,1030,1040,1050,1060,1070,1080,1090,1120,1100),JUMP
C      
C***  READ FLTCON NAMELIST
C      
 1020       CALL RFLT(LFLT,FLTC)
         GO TO 1110
C      
C***  READ REFQ NAMELIST
C      
 1030       CALL RREFQ(LREFQ,REFQ)
         GO TO 1110
C      
C***  READ AXIBOD NAMELIST
C      
 1040       CALL RAXIS(LAXIS,ABOD)
         GO TO 1110
C      
C***  READ FINSET NAMELIST
C      
 1050       CALL RFINS(NSET,LFIN1,LFIN2,LFIN3,LFIN4,
     1                 FIN1,FIN2,FIN3,FIN4)
         GO TO 1110
C      
C***  READ DEFLCT NAMELIST
C      
 1060       CALL RDEFL(LDEFL,INCI)
         GO TO 1110
C      
C***  READ TRIM NAMELIST
C      
 1070       CALL RTRIM(LTRIM,TRIM)
         GO TO 1110
C      
C***  READ ELLIPTICAL BODY NAMELIST
C      
 1080       CALL RELLB(LELLB,ABOD)
      GO TO 1110
C      
C***  READ INLET NAMELIST
C      
 1090       CALL RINLET(LINLET,INLE)
      GO TO 1110
C      
C***  READ ARBITRARY BODY NAMELIST
C      
 1100       CALL RARBOD(LARBOD,ABOD)
C      
 1110    CONTINUE
 1120 CONTINUE
C      
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SUBINT(LLOC, LANS)
C
C***  FORCE AN INTEGER INTO AN EXTERNAL ARRAY
C
      LLOC=LANS
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WRAXIS
C
C***  WRITE AXISYMMETRIC BODY INPUTS
C
      COMMON /ABODIN/ AA(881)
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION NLNAME(6),IVNAME(152),LEN(34),IDIM(34),LOC(34)
C
      DATA NLNAME /  'A   ','X   ','I   ','B   ','O   ','D   '/
      DATA IVNAME /  'N   ','X   ','X   ','O   ','X   ','0   ','X   ',
     1 'R   ','T   ','N   ','O   ','S   ','E   ','L   ','N   ','O   ',
     2 'S   ','E   ','D   ','N   ','O   ','S   ','E   ','B   ','N   ',
     3 'O   ','S   ','E   ','T   ','R   ','U   ','N   ','C   ','L   ',
     4 'C   ','E   ','N   ','T   ','R   ','D   ','C   ','E   ','N   ',
     5 'T   ','R   ','T   ','A   ','F   ','T   ','L   ','A   ','F   ',
     6 'T   ','D   ','A   ','F   ','T   ','P   ','O   ','W   ','E   ',
     7 'R   ','D   ','I   ','S   ','C   ','O   ','N   ','D   ','E   ',
     8 'X   ','I   ','T   ','B   ','A   ','S   ','E   ','B   ','E   ',
     9 'T   ','A   ','N   ','J   ','M   ','A   ','C   ','H   ','P   ',
     A 'R   ','A   ','T   ','T   ','R   ','A   ','T   ','P   ','R   ',
     B 'O   ','T   ','U   ','B   ','N   ','P   ','R   ','O   ','T   ',
     C 'P   ','T   ','Y   ','P   ','E   ','X   ','P   ','R   ','O   ',
     D 'T   ','N   ','L   ','O   ','C   ','B   ','L   ','D   ','M   ',
     E 'E   ','M   ','B   ','L   ','D   ','T   ','Y   ','P   ','L   ',
     F 'P   ','R   ','O   ','T   ','W   ','P   ','R   ','O   ','T   ',
     G 'H   ','P   ','R   ','O   ','T   ','O   ','P   ','R   ','O   ',
     H 'T   '/
      DATA IDIM   / 1,1,1,50,50,1,1,1,1,-1,1,1,1,1,1,1,20,1,-1,1,
     1              20,20,20,-1,1,20,20,20,20,100,100,100,100,100 /
      DATA LEN    / 2,2,2,1,1,5,5,5,5,5,6,6,4,4,4,5,6,5,4,5,5,4,4,
     1              6,5,5,5,4,6,6,5,5,5,5 /
      DATA LOC    / 1,2,2,3,53,103,104,105,106,107,108,109,110,111,112,
     1              113,114,237,238,239,240,260,280,
     2              300,301,302,322,342,362,382,482,582,682,782 /
C
      CALL NAMEW(KAND,6,NLNAME,6,IVNAME,152,LEN,34,IDIM,AA,881,LOC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE AXBNDY(I,BETA,VX,VR,NN1,NN2,NN3,IK,JL,C,TTX,TTR)
C
      COMMON /VDARY/  XB(220),RB(220),RBP(220),DUMM(220),C1(220),
     1 RB1(220),RBP1(220),B(220),PSI(220),ZE0X(220),PSIR(220),PHIX(220)
      DIMENSION C(220)
C
      C(I) = 0.
      XI = XB(I-1)-BETA*RB(I-1)
      TAU = BETA*RB(I)/(XB(I)-XI)
      IF(TAU .GE. 1.0) GO TO 1020
          TAU1 = BETA*RB(I)/(XB(I)-XB(1)+BETA*RB(1))
          IF(TAU1 .GE. 1.0) GO TO 1000
              TTR = C(1)*BETA*SQRT(1.0-TAU1**2)/TAU1
              TTX = -C(1)*ARSECH(TAU1)
            GO TO 1010
 1000         TTR = 0.0
              TTX = 0.0
 1010     CONTINUE
          F1 = ARSECH(TAU)
          F2 = SQRT(1.-TAU**2)
          C(I) = RBP(I)*(1.0+VX+TTX)-TTR-VR
          DEN = (XB(I)-XI)*(BETA*(F2/TAU-TAU*F1)+2.*RBP(I)*(F1-F2))
          C(I) = C(I)/DEN
 1020 CONTINUE
      IF(IK.LT.2) JL=NN1
      IF(IK.EQ.2) JL=NN2
      IF(IK.GT.2) JL=NN3
 1060 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BODYCA(IM)
C
C***  SUBROUTINE TO COMPUTE THE BODY ALONE AXIAL FORCE COEFFICIENT
C
C  MODIFIED BY W. BLAKE, WL/FIGC
C
C***  IM IS THE CURRENT MACH NUMBER INDEX
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
C
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     1              TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,POWER,
     2              DISCON(20),ELLDAT(103),DEXIT,DUM(62),PROTUB,
     3              ADUM(581)
      REAL NX,LNOSE,LCENTR,LAFT
      LOGICAL TRUNC,PROTUB,NA,NM,ND
C
      COMMON /XRBLNT/ XTEMP(50),RTEMP(50),NXTEMP,VNTEMP,SWTEMP,ITYPE
      REAL NXTEMP
C
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     1  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     2  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     3  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     4                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,GDUM(12)
      REAL LTOTAL
C
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      REAL NALPHA,NMACH,MACH
      COMMON /TOTALC/ BALPHA(20),BBETA(20),BPHI(20),ALPTOT(20)
C
      COMMON /SBODY/ CNB(20),CMB(20),CAB(20),CYB(20),CLNB(20),CLLB(20),
     1               CNAB(20),CMAB(20),CYBB(20),CNBB(20),CLBB(20)
C
      COMMON /BDWORK/  CNP(20),CMP(20),CNVIS(20),CMVIS(20),CAPR(20),
     &                 CAF(20),CABASE(20),ETA,CDC(20),CAPROT(20),
     &                 BOTDCA(20),BOTDCN(20),BOTDCM(20)
C
      COMMON /PARTF/ PART(19)
      LOGICAL PART
C
      DIMENSION CAOPI(11),CAOM(11)
C
C***  CAO FOR BLUNT NOSED BODIES, FROM HOERNER
C***  REFERENCE AFFDL-TR-76-55, MARCH 1979, P. 84
C
      DATA CAOM / 0.,.6,.8,1.,1.2,1.4,1.6,1.8,2.2,2.6,3.0/
      DATA CAOPI/ .86,.86,.96,1.21,1.39,1.53,1.62,4*1.68/
C
C***  PROTUBERANCE DRAG AT ZERO ANGLE OF ATTACK
      CPRTZ=0.0
      IF (PROTUB) CALL CDPROT(MACH(IM),REN(IM),SREF,CPRTZ)
C
C***  FRICTION DRAG AT ZERO ANGLE OF ATTACK
      CALL CAFRIC(0.,MACH(IM),REN(IM),LTOTAL,ROUGH,
     1            BLAYER,SWET,SREF,1.1547,1.022,CAFZ)
C
C***  SUBSONIC PRESSURE DRAG AT ZERO ANGLE OF ATTACK
      CALL BDCAPR(FR,CAFZ,CAPR(1))
C
C***  CORRECT FOR COMPRESSIBILITY EFFECTS
      IF (MACH(IM) .LT. 1.) CAPR(1)=CAPR(1)/SQRT(1.-MACH(IM)**2)
C
      IF (LNOSE.LE.UNUSED) GOTO 1000
C
C***  CHECK TO SEE IF THE CRITICAL MACH NUMBER HAS BEEN REACHED
      IF (BNOSE.GT.UNUSED) THEN
        CALL MDIV(FRNOSE,NXTEMP,RTEMP,XTEMP,LNOSE,CRMACH)
      ELSE
        CALL MDIV(FRNOSE,NX,R,X,LNOSE,CRMACH)
      ENDIF
C
C***  CALCULATE TRANSONIC WAVE DRAG
      IF (MACH(IM).GT.CRMACH) THEN
        IF (BNOSE.GT.UNUSED) THEN
C
C***      DETERMINE RATIO OF WAVE DRAG FOR BLUNTED BODY
C***      TO THAT OF A POINTED BODY.
          CALL BDCAWN(2.*BNOSE/DNOSE,FRNOSE,MACH(IM),CAWB)
          CALL BDCAWN(UNUSED,FRNOSE,MACH(IM),CAWS)
C
C VERSION 4/91A CORRECTION FOR NOSE BLUNTNESS
C
         CAPRAT=(CAWB-CAWS)*PI*DNOSE**2/4./SREF
C
C***      CALCULATE INCOMPRESSIBLE PRESSURE DRAG TO BE
C***      USED IN THE TRANSONIC WAVE DRAG CALCULATION
          CALL CAFRIC(0.,CRMACH,REN(IM),LTOTAL,ROUGH,BLAYER,SWTEMP,
     &            SREF,1.1547,1.022,CAFO)
          CALL BDCAPR(FR,CAFO,CDPO)
          CAPR(1)=0.0
C
C***      USE AREA RULE FORMULATION FOR WAVE DRAG
C***      CALCULATION OF SHARP NOSE
          CALL CDPRES(NXTEMP,XTEMP,RTEMP,SREF,MACH(IM),
     &           FRNOSE,VNTEMP,LNOSE,CRMACH,CDPO,CAPR(1))
C
C***      APPLY BLUNT NOSE CORRECTION FOR WAVE DRAG
          CAPR(1)=CAPR(1)+CAPRAT
        ELSE
C
C***      CALCULATE INCOMPRESSIBLE PRESSURE DRAG TO BE
C***      USED IN THE TRANSONIC WAVE DRAG CALCULATION
          CALL CAFRIC(0.,CRMACH,REN(IM),LTOTAL,ROUGH,BLAYER,SWET,
     &            SREF,1.1547,1.022,CAFO)
          CALL BDCAPR(FR,CAFO,CDPO)
          CAPR(1)=0.0
C
C***      USE AREA RULE FORMULATION FOR WAVE DRAG CALCULATION
          CALL CDPRES(NX,X,R,SREF,MACH(IM),FRNOSE,
     &                VOLNOS,LNOSE,CRMACH,CDPO,CAPR(1))
        ENDIF
      ENDIF
C
C***  BOATTAIL/FLARE PRESSURE/WAVE DRAG
 1000 DFWD=DCENTR
      IF(LCENTR .LE. UNUSED)DFWD=DNOSE
      CAPBT=0.
      CAWFL=0.
      IF(LAFT .GT. UNUSED .AND. DAFT .LT. DFWD)
     &    CALL BDCDRV(TAFT,DFWD,DAFT,LAFT,MACH(IM),THEOLA,CAPBT)
      IF(LAFT .GT. UNUSED .AND. DAFT .GT. DFWD)
     &    CALL BDCAWF(DFWD,DAFT,LAFT,MACH(IM),CAWFL)
C
C***  REFERENCE CAPBT AND CAWFL TO SREF
      CAPBT=CAPBT*PI*DFWD**2/4./SREF
      CAWFL=CAWFL*PI*DFWD**2/4./SREF
C
      CAPR(1)=CAPR(1)+CAPBT+CAWFL
C
C***  BASE DRAG AT ZERO ANGLE OF ATTACK
      CALL BDCAB(DFWD,DBASE,DEXIT,LAFT,SREF,MACH(IM),CABAS0)
C
C***  ESTIMATE CAO AT ALPHA=180 DEGREES
      CALL LNTRP(CAOM,CAOPI,11,MACH(IM),CAPI)
      CAPI=CAPI*PI*DMAX**2/4./SREF
      IF(TRUNC .OR. LNOSE.LE.UNUSED) CAPR(1)=CAPR(1)+
     &          CAPI*(2.*BNOSE/DMAX)**2
C
C***  AXIAL FORCE AT ZERO NORMAL FORCE (CAO)
      CAPRZ=CAPR(1)
      CAOB=CAFZ+CAPRZ+CPRTZ
C
C***  ANGLE OF ATTACK LOOP
      NALP=NALPHA+0.5
      DIABAS=DBASE
      IF(DBASE .LE. UNUSED)DIABAS=0.00001
      DO 1010 I=1,NALP
         ABSALP=ABS(ALPTOT(I))
C
C***  AXIAL FORCE VARIATION WITH ANGLE OF ATTACK
C
         CAF(I)=CAFZ*COS(ALPTOT(I)/RAD)*ABS(COS(ALPTOT(I)/RAD))
         CAPR(I)=CAPRZ*COS(ALPTOT(I)/RAD)*ABS(COS(ALPTOT(I)/RAD))
         CAPROT(I)=CPRTZ*COS(ALPTOT(I)/RAD)*ABS(COS(ALPTOT(I)/RAD))
C        CABASE(I)=(CABAS0*(SQRT(4.*SREF/PI)/DIABAS)**3-
C    1             (0.012-.0036*MACH(IM))*ABSALP/RAD*
C    2             (DIABAS/SQRT(4.*SREF/PI))**3
C   
C  REV 1/96  CORRECTED IMPLEMENTATION OF ANGLE OF ATTACK EFFECT
C
         CABASE(I)=CABAS0+(0.012-0.0036*MACH(IM))*ABSALP/RAD*
     1             (DIABAS/SQRT(4.*SREF/PI))**3
         CABASE(I)=CABASE(I)*COS(ALPTOT(I)/RAD)
C
C ...    SWITCH FROM ALLEN AND PERKINS FOR CA TO JORGENSEN
C ...    FOR ALPHAS GREATER THAN 30 DEGREES
C
         CNI=CNP(I)+CNVIS(I)
         IF(ABSALP .LE. 30.)CALL BDCALP(ALPTOT(I),CNI,CAOB,CADB)
C
C***     TOTAL AXIAL FORCE COEFFICIENT
C
C  REV 1/96  HIGH AOA AXIAL FORCE SUMMATION MODIFIED
C            PERKINS&ALLEN SWITCHOVER MOVED FROM 45 DEG AOA
C            TO 30 DEG AOA TO MINIMIZE DISCONTINUITY
C
         IF(ABSALP .LE. 30.)CAB(I)=CAOB+CADB
         IF(ABSALP .GT. 30.)CAB(I)=CAOB*COS(ALPTOT(I)/RAD)**2
         IF(DEXIT .NE. UNUSED)CAB(I)=CAB(I)+CABASE(I)
C
C ...    FOR ALPHAS GREATER THAN 90 DEGREES USE JORGENSEN
C ...    BUT USE CAO FROM BLUNT-NOSED BODY DATA
C
         IF(ABSALP .GE. 90.) CAB(I)=CAPI*COS(ALPTOT(I)/RAD)*
     1                              ABS(COS(ALPTOT(I)/RAD))
C
C  REV 1/96  ALPHA > 90 CA CHARGED TO BASE DRAG
C
         IF(ABSALP .GE. 90.) CABASE(I)=CAB(I)-CAF(I)-CAPR(I)-CAPROT(I)
C
 1010 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE COORD5(X,XU,XL,YUN,YLN,L,I,J,K,II,JJ,KK,III,JJJ,
     1 THN,CAM,RHO,T)
C
C*****
C***** CALCULATE NACA FIVE DIGIT AIRFOIL COORDINATES
C*****
C
C  ROUTINE ADAPTED FROM DIGITAL DATCOM
C  ORIGINAL ROUTINE WRITTEN BY D. KINSEY, D. BOWERS, AFFDL
C  MODIFIED BY S.R. VUKELICH, MCDONNELL DOUGLAS
C
      DIMENSION X(50),XU(50),XL(50),YUN(50),YLN(50),THN(50),CAM(50)
C
      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=ACOS((-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)
C
C ... COMPUTE COORDINATES ALONG CHORD
C
      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
     1   -.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)
     1   *X(M))
      IF(X(M).LT.ZM)ALPHA=ATAN((1./6.)*XK*(3.*X(M)**2-6.*ZM*X(M)+ZM**2
     1   *(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
     1   -.1015*X(M)**4)
      IF(X(M).LT.ZM)YC=(1./6.)*XK*((X(M)-ZM)**3-RK*X(M)*(1.-ZM)**3
     1   -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
     1   -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
     1   -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)
     1   **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 CONTINUE
      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
c *************************************
c *************************************
c *************************************
      FUNCTION DSPLAN(NPTS,X,R)
C
C**  FUNCTION TO COMPUTE THE PLANFORM AREA
C
C***  INPUTS
C
C   NPTS -- NUMBER OF INPUT POINTS
C      X -- X STATIONS
C      R -- RADII AT EACH X STATION
C
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION X(NPTS),R(NPTS)
C
      DSPLAN=0.0
      DO 1000 I=2,NPTS
         DX=X(I)-X(I-1)
         DSPLAN=DSPLAN+DX*(R(I)+R(I-1))
 1000 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCNASB(SWEP50,ASPECT,SECCLA,MACH,CLA)
C
C     THIS SUBROUTINE COMPUTES FIN-ALONE LIFT CURVE SLOPE FOR
C     TWO PANELS CONNECTED AT THE ROOT CHORD.  THE CALCULATION USES
C     THE METHOD OF LOWRY-POLHAMUS (DATCOM 4.1.3.2).  THE LIFT CURVE
C     SLOPE IS BASED ON FIN AREA.
C
C  MODIFIED BY W. BLAKE, WL/FIGC
C
C     INPUTS
C
C       SWEP50 -- HALF CHORD FIN SWEEP ANGLE, DEGREES
C       ASPECT -- EXPOSED ASPECT RATIO OF TWO PANELS
C       SECCLA -- SECTION LIFT COEFFICIENT PER RADIAN
C       MACH   -- FREESTREAM MACH NUMBER
C
C     OUTPUTS
C
C       CLA    -- LIFT CURVE SLOPE REFERENCED TO EXPOSED FIN
C                 AREA, PER DEGREE
C
      COMMON /CONST/PI,RAD,UNUSED,KAND
      REAL MACH,KAPPA
C
C     CALCULATE BETA (MACH SIMILARITY PARAMETER)
C
      BETA=SQRT(1.-MACH**2)
C
C     CALCULATE KAPPA (SECTION LIFT CURVE SLOPE TO TWO PI RATIO)
C
      KAPPA=SECCLA/((2.*PI)/BETA)
C
C     CALCULATE CLA
C
      CLA=2.*PI/(2.+SQRT(((TAN(SWEP50/RAD))**2/BETA**2+1.)*
     *    ASPECT**2*BETA**2/KAPPA**2+4.))*ASPECT/RAD
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE GEOAXI
C
C***  SUBROUTINE TO CALCULATE THE GEOMETRIC PARAMETERS
C***  OF AXISYMMETRIC BODIES
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
C
C
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     1  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     2  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     3  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     4                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,GDUM(12)
C
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     1                TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,
     2                POWER,DISCON(20),ADUM(748)
      REAL NX,LNOSE,LCENTR,LAFT,LTOTAL
C
      COMMON /XRBLNT/ XTEMP(50),RTEMP(50),NXTEMP,VNTEMP,SWTEMP,ITYPE
      REAL NXTEMP
C
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /LOGIC/ LFLAGS(18),LDIMIN,LDIMFT,LDIMCM,LDIMM,LDUM2(6)
      LOGICAL        LFLAGS    ,LDIMIN,LDIMFT,LDIMCM,LDIMM
C
      DIMENSION GEOB(35),DUMMY(20)
      EQUIVALENCE (GEOB(1),SPNOSE)
C
      LOGICAL TRUNC
C
C***  SCALE THE INPUT GEOMETRY
C
      IF(SCALE .EQ. UNUSED .OR. SCALE .EQ. 1.)GO TO 1010
      IF(XO .NE. UNUSED)XO=XO*SCALE
         DO 1000 I=1,50
            IF(X(I) .NE. UNUSED)X(I)=X(I)*SCALE
            IF(R(I) .NE. UNUSED)R(I)=R(I)*SCALE
 1000    CONTINUE
C
         IF(LNOSE .NE. UNUSED)LNOSE=LNOSE*SCALE
         IF(BNOSE .NE. UNUSED)BNOSE=BNOSE*SCALE
         IF(DNOSE .NE. UNUSED)DNOSE=DNOSE*SCALE
         IF(LCENTR .NE. UNUSED)LCENTR=LCENTR*SCALE
         IF(DCENTR .NE. UNUSED)DCENTR=DCENTR*SCALE
         IF(LAFT .NE. UNUSED)LAFT=LAFT*SCALE
         IF(DAFT .NE. UNUSED)DAFT=DAFT*SCALE
C
 1010 CONTINUE
C
      NXTEMP=UNUSED
C
C  CHECK FOR INPUT OPTION
C
      IF(NX .GT. UNUSED)GO TO 1120
C
C***  HERE FOR OPTION 1 (SHAPES DEFINED)
C
C DEFAULTS ...
C
      IF(LNOSE .NE. UNUSED .AND. TNOSE .EQ. UNUSED)TNOSE=1.
      IF(LAFT .NE. UNUSED .AND. TAFT .EQ. UNUSED)TAFT=0.
      IF(LNOSE .NE. UNUSED .AND. TNOSE .GT. 4.)TNOSE=0.
      IF(LAFT  .NE. UNUSED .AND. TAFT  .GT. 1.)TAFT=0.
C
      IF(LNOSE .LE. UNUSED)GO TO 1080
C
C  CHECK FOR PROPER SHAPE DEFINED
C
      IF(TNOSE .NE. 0. .AND. LNOSE .LT. DNOSE/2. .AND. PARTS(18))
     1 WRITE(6,1190)
      IF(TNOSE .NE. 0. .AND. LNOSE .LT. DNOSE/2.)TNOSE=0.
C
C  SET NOSE TYPE
C
      JUMP=TNOSE+1.5
C
C  COMPUTE THE APPROPIATE SHAPE
C  THE FIRST CALL IS TO CALCULATE GEOMETRY FOR A SHARP NOSE MISSILE,
C  WHICH IS USED IN LATER CALCULATIONS TO CALCULATE WAVE DRAG.
C  THE SECOND CALL IS TO CALCULATE THE ACTUAL GEOMETRY OF THE MISSILE,
C  BLUNTED NOSE, TRUNCATED NOSE, OR SHARP NOSE.
C
      GO TO (1030,1040,1050,1060,1060),JUMP
C
 1030 IF (BNOSE.GT.UNUSED) THEN
        CALL CONIC(GEOB(1),NXTEMP,XTEMP,RTEMP,UNUSED,.FALSE.,
     &             LNOSE,DNOSE,DUMMY)
        SWNTMP=GEOB(2)
        VNTEMP=GEOB(3)
      ENDIF
      CALL CONIC(GEOB(1),NX,X,R,BNOSE,TRUNC,LNOSE,DNOSE,DISCON)
      GO TO 1080
C
 1040 IF (BNOSE.GT.UNUSED) THEN
        CALL OGIVE(GEOB(1),NXTEMP,XTEMP,RTEMP,UNUSED,.FALSE.,
     &             LNOSE,DNOSE,DUMMY)
        SWNTMP=GEOB(2)
        VNTEMP=GEOB(3)
      ENDIF
      CALL OGIVE(GEOB(1),NX,X,R,BNOSE,TRUNC,LNOSE,DNOSE,DISCON)
      GO TO 1080
C
 1050 IF (BNOSE.GT.UNUSED) THEN
        CALL POWR(GEOB(1),NXTEMP,XTEMP,RTEMP,UNUSED,.FALSE.,
     &            LNOSE,DNOSE,POWER,DUMMY)
        SWNTMP=GEOB(2)
        VNTEMP=GEOB(3)
      ENDIF
      CALL POWR(GEOB(1),NX,X,R,BNOSE,TRUNC,LNOSE,DNOSE,POWER,DISCON)
      GO TO 1080
C
 1060 IF (BNOSE.GT.UNUSED) THEN
        CALL HAACK(XO,TNOSE,DNOSE,UNUSED,.FALSE.,LNOSE,DUMMY,
     &             XTEMP,RTEMP,NXTEMP,GEOB(1))
        SWNTMP=GEOB(2)
        VNTEMP=GEOB(3)
      ENDIF
      CALL HAACK(XO,TNOSE,DNOSE,BNOSE,TRUNC,LNOSE,
     &           DISCON,X,R,NX,GEOB(1))
C
 1080 CONTINUE
C
C  NOW COMPUTE CENTERBODY DATA IF DEFINED
C
      IF(LCENTR .LE. UNUSED)GO TO 1090
      RFWD=DNOSE/2.
      IF (BNOSE.GT.UNUSED) 
     & CALL CONIC(GEOB(9),NXTEMP,XTEMP,RTEMP,RFWD,.TRUE.,
     &            LCENTR,DCENTR,DUMMY)
      CALL CONIC(GEOB(9),NX,X,R,RFWD,.TRUE.,LCENTR,DCENTR,DISCON)
C
C  NOW THE AFTERBODY
C
 1090 CONTINUE
      IF(LAFT .LE. UNUSED)GO TO 1140
C
      RFWD=DCENTR/2.
      IF(LCENTR .LE. UNUSED)RFWD=DNOSE/2.
C
C  CHECK FOR PROPER SHAPE DEFINED
C
      IF(TAFT .NE. 0. .AND. LAFT .LT. RFWD .AND. PARTS(18))WRITE(6,1200)
      IF(TAFT .NE. 0. .AND. LAFT .LT. RFWD)TAFT=0.
C
C  SET AFTERBODY TYPE
C
      JUMP=TAFT+1.5
C
C  COMPUTE THE APPROPIATE SHAPE
C
      GO TO (1100,1110),JUMP
C
 1100 IF (BNOSE.GT.UNUSED) 
     & CALL CONIC(GEOB(17),NXTEMP,XTEMP,RTEMP,RFWD,.TRUE.,
     &            LAFT,DAFT,DUMMY)
      CALL CONIC(GEOB(17),NX,X,R,RFWD,.TRUE.,LAFT,DAFT,DISCON)
      GO TO 1140
C
 1110 IF (BNOSE.GT.UNUSED) 
     & CALL OGIVE(GEOB(17),NXTEMP,XTEMP,RTEMP,RFWD,.TRUE.,
     &            LAFT,DAFT,DUMMY)
      CALL OGIVE(GEOB(17),NX,X,R,RFWD,.TRUE.,LAFT,DAFT,DISCON)
      GO TO 1140
C
 1120 CONTINUE
C
C***  HERE FOR OPTION 2 (COORDINATES DEFINED)
C
      NNX=NX+0.5
      ITYPE=1
C
      CALL USERS
C
      GO TO 1160
C
 1140 CONTINUE
C
C  GET TOTALS FOR OPTION 1 INPUTS
C
      ITYPE=2
      SPLAN=SPNOSE+SPCENT+SPAFT
      SWET =SWNOSE+SWCENT+SWAFT
C
C***  FIND TOTAL WETTED AREA FOR A SHARP NOSE
      IF (BNOSE.GT.UNUSED) SWTEMP=SWNTMP+SWCENT+SWAFT
C
      VOL  =VOLNOS+VOLCEN+VOLAFT
      LTOTAL=LNOSE+LCENTR+LAFT
      XCENTV=(XCVNOS*VOLNOS+XCVCEN*VOLCEN+XCVAFT*VOLAFT)/VOL
      XCENTP=(XCPNOS*SPNOSE+XCPCEN*SPCENT+XCPAFT*SPAFT)/SPLAN
C
C  CORRECT FOR NOSE APEX COORDINATE
C
      NNX=NX+0.5
      X1=X(1)
      DMAX=2.*R(1)
      DO 1150 I=1,NNX
         X(I)=X(I)-X1+XO
         IF(2.*R(I) .GT. DMAX)DMAX=2.*R(I)
 1150 CONTINUE
C
      SMAX=PI*DMAX**2/4.
      DBASE=2.*R(NNX)
      SBASE=PI*DBASE**2/4.
      FR=LTOTAL/DMAX
      IF(XCVNOS .NE. UNUSED)XCVNOS=XCVNOS-X1
      IF(XCPNOS .NE. UNUSED)XCPNOS=XCPNOS-X1
      IF(XCVCEN .NE. UNUSED)XCVCEN=XCVCEN-X1
      IF(XCPCEN .NE. UNUSED)XCPCEN=XCPCEN-X1
      IF(XCVAFT .NE. UNUSED)XCVAFT=XCVAFT-X1
      IF(XCPAFT .NE. UNUSED)XCPAFT=XCPAFT-X1
      IF(XCENTV .NE. UNUSED)XCENTV=XCENTV-X1
      IF(XCENTP .NE. UNUSED)XCENTP=XCENTP-X1
      IF(R(1) .LE. UNUSED)R(1)=0.
C
 1160 CONTINUE
C
C***  CONVERT RESULTS TO INPUT UNITS FOR OUTPUT
C
      IF(.NOT.(LDIMIN .OR. LDIMCM .OR. LDIMM))GO TO 1170
C
         CALL CVRTFT
C
 1170 CONTINUE
C
      IF(PARTS(1))CALL PRIAXI(ITYPE)
C
C***  CONVERT RESULTS TO UNITS OF FEET FOR PROGRAM CALCULATIONS
C
      IF(.NOT.(LDIMIN .OR. LDIMCM .OR. LDIMM))GO TO 1180
C
         CALL CVRTUS
C
 1180 CONTINUE
C
C***  SET DEFAULT REFERENCE QUANTITIES
C
      IF(SREF .EQ. 0. .OR. SREF .EQ. UNUSED)SREF=SMAX
      IF(LREF .EQ. 0. .OR. LREF .EQ. UNUSED)LREF=DMAX
      IF(LATREF .EQ. 0. .OR. LATREF .EQ. UNUSED)LATREF=LREF
C
 1190 FORMAT(4X,'* WARNING * THE NOSE IS TOO SHORT',
     1 ' TO USE THE SHAPE SPECIFIED.',/,16X,'A CONICAL SEGMENT',
     2 ' HAS BEEN ASSUMED.')
 1200 FORMAT(4X,'* WARNING * THE AFTERBODY IS TOO SHORT',
     1 ' TO USE THE SHAPE SPECIFIED.',/,16X,'A CONICAL SEGMENT',
     2 ' HAS BEEN ASSUMED.')
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE INLETA(IM,CAADD,MFRM)
C
C*** PRINT INLET AERODYANMIC INCREMENTALS
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1            XI(5),HI(5),WI(5),ICOVER,RAMANG,IADD,MFR(20)
      COMMON /INLTD/ CNI(20),CMI(20),CAI(20),CYI(20),CLNI(20),
     1               CLLI(20)
      COMMON /FLC/ NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1             FLDUM(100)
      REAL NALPHA,NMACH,MACH,MFR,MFRM,NIN,INTYPE,LDIV
      LOGICAL NA,NN,NM,ICOVER,IADD
C
      NALP=NALPHA+.5
C
      CALL HEADR9
      WRITE(6,1000)
      CALL PRFLC9(IM,NA,NN,NM)
C
      WRITE (6,1050)
      IF (IADD.AND.(.NOT.ICOVER).AND.(MACH(IM).GE.1.0)) THEN
        DO 200 I=1,NALP
          WRITE(6,1060) ALPHA(I),CNI(I),CMI(I),CAI(I),
     &                  CAADD,CYI(I),CLNI(I),CLLI(I)
  200   CONTINUE
        WRITE(6,1070) MFR(IM),MFRM
      ELSE
        DO 100 I=1,NALP
          WRITE(6,1020) ALPHA(I),CNI(I),CMI(I),CAI(I),
     1              CYI(I),CLNI(I),CLLI(I)
  100   CONTINUE
      ENDIF
      IF (IADD.AND.ICOVER) WRITE(6,1030)
      IF (IADD.AND.(MACH(IM).LT.1.0)) WRITE(6,1040)
C
 1000 FORMAT(23X,'INLET AERODYNAMIC INCREMENTALS',/)
 1020 FORMAT(4X,F7.2,3(F9.4),9X,3(F9.4))
 1030 FORMAT(/,4X,'ADDITIVE DRAG CANNOT BE CALCULATED BECAUSE',
     &       ' INLET IS COVERED')
 1040 FORMAT(/,4X,'ADDITIVE DRAG CANNOT BE CALCULATED BECAUSE',
     &       ' MACH NUMBER IS LESS THAN 1.0')
 1050 FORMAT(6X,'ALPHA',2X,'CN-INLT',2X,'CM-INLT',2X,'CA-INLT',
     1       3X,'CA-ADD',2X,'CY-INLT',2X,'CLN-INLT',1X,'CLL-INLT')
 1060 FORMAT(4X,F7.2,7(F9.4))
 1070 FORMAT(/,4X,'NOTE: CA-ADD IS INLET ADDITIVE DRAG COEFFICIENT',
     &       ' FOR MASS FLOW RATIO OF ',F4.2,/,4X,
     &       'NOTE: MAXIMUM MASS FLOW RATIO ',
     &       'AT THESE FLIGHT CONDITIONS IS ',F4.2)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE NEWTON(THETA,ALPHA,PHI1,CAF,CNF,CMF)
C
C***  COMPUTES THE PRESSURE-SURFACE-SLOPE INTEGRAL FACTORS
C***  FROM NASA TN D-176, EQUATIONS 13, 14, AND 15
C
C*** INPUTS
C
C  THETA - SURFACE SLOPE ANGLE, DEG.
C  ALPHA - ANGLE OF ATTACK, DEG.
C
C***  OUTPUTS
C
C   PHI1 - POLAR ANGLE TO EDGE OF SHADOWED REGION, DEG.
C          PHI1=0 AT TOP VERTICAL CENTER
C          IF PHI<PHI1 THEN THE LOCAL CP IS ZERO
C    CAF - INTEGRAL FACTOR FOR CA
C    CNF - INTGGRAL FACTOR FOR CN
C    CMF - INTEGRAL FACTOR FOR CM
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      EQN13(PHI)=-2.*CT*CT*SA*SA*SIN(PHI/RAD)*(COS(PHI/RAD)**2+2.)/3.
     1           +4.*ST*CT*CA*SA*(.5*SIN(PHI/RAD)*COS(PHI/RAD)+
     2           PHI/RAD/2.)-2.*ST*ST*CA*CA*SIN(PHI/RAD)
      EQN14(PHI)=2.*CT*ST*SA*SA*(.5*SIN(PHI/RAD)*COS(PHI/RAD)+PHI/RAD
     1           /2.)-4.*ST*ST*SA*CA*SIN(PHI/RAD)
     2           +2.*ST*ST*ST*CA*CA/CT*PHI/RAD
      EQN15(PHI)=-2.*CT*CT*SA*SA*SIN(PHI/RAD)*(COS(PHI/RAD)**2
     1           +2.)/3.+4.*ST*CT*CA*SA*(.5*SIN(PHI/RAD)*COS(PHI/RAD)
     2           +PHI/RAD/2.)-2.*ST*ST*CA*CA*SIN(PHI/RAD)
      ST=SIN(THETA/RAD)
      CT=COS(THETA/RAD)
      TT=ST/CT
      SA=SIN(ALPHA/RAD)
      CA=COS(ALPHA/RAD)
C
      IF(THETA .GT. 0.0) PHI1 = 0.0
      IF(THETA .LE. 0.0) PHI1 = PI
      IF(ALPHA .GT. ABS(THETA)) PHI1 = ACOS(TAN(THETA/RAD)/
     *TAN(ALPHA/RAD))
C
      CNF=EQN13(PI*RAD)-EQN13(PHI1*RAD)
      CAF=EQN14(PI*RAD)-EQN14(PHI1*RAD)
      CMF=EQN15(PI*RAD)-EQN15(PHI1*RAD)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RELLB(LELLB, AA)
C
C***  READ ELLIPTICAL BODY INPUTS
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION AA(881),NLNAME(6),IVNAME(152),LEN(35),IDIM(35),LOC(35)
C
      LOGICAL LELLB,IEOF
C
      DATA NLNAME /  'E   ','L   ','L   ','B   ','O   ','D   '/
      DATA IVNAME /  'N   ','X   ','X   ','O   ','X   ','0   ','X   ',
     1 'R   ','W   ','T   ','N   ','O   ','S   ','E   ','L   ','N   ',
     2 'O   ','S   ','E   ','W   ','N   ','O   ','S   ','E   ','B   ',
     3 'N   ','O   ','S   ','E   ','T   ','R   ','U   ','N   ','C   ',
     4 'L   ','C   ','E   ','N   ','T   ','R   ','W   ','C   ','E   ',
     5 'N   ','T   ','R   ','T   ','A   ','F   ','T   ','L   ','A   ',
     6 'F   ','T   ','W   ','A   ','F   ','T   ','P   ','O   ','W   ',
     7 'E   ','R   ','D   ','I   ','S   ','C   ','O   ','N   ','E   ',
     8 'L   ','L   ','I   ','P   ','H   ','E   ','N   ','O   ','S   ',
     9 'E   ','E   ','C   ','E   ','N   ','T   ','R   ','E   ','A   ',
     A 'F   ','T   ','D   ','E   ','X   ','I   ','T   ','P   ','R   ',
     B 'O   ','T   ','U   ','B   ','N   ','P   ','R   ','O   ','T   ',
     C 'P   ','T   ','Y   ','P   ','E   ','X   ','P   ','R   ','O   ',
     D 'T   ','N   ','L   ','O   ','C   ','B   ','L   ','D   ','M   ',
     E 'E   ','M   ','B   ','L   ','D   ','T   ','Y   ','P   ','L   ',
     F 'P   ','R   ','O   ','T   ','W   ','P   ','R   ','O   ','T   ',
     G 'H   ','P   ','R   ','O   ','T   ','O   ','P   ','R   ','O   ',
     H 'T   '/
      DATA IDIM   / 1,1,1,50,50,50,1,1,1,1,-1,1,1,1,1,1,1,20,50,50,1,1,
     1              1,1,-1,1,20,20,20,20,100,100,100,100,100 /
      DATA LEN    / 2,2,2,1,1,1,5,5,5,5,5,6,6,4,4,4,5,6,5,1,5,6,4,5,
     1              6,5,5,5,4,6,6,5,5,5,5 /
      DATA LOC    / 1,2,2,3,53,53,103,104,105,106,107,108,109,110,111,
     1              112,113,114,134,184,234,235,236,237,
     2              300,301,302,322,342,362,382,482,582,682,782 /
C
      LELLB=.TRUE.
C
      CALL NAMER(KAND,2,NLNAME,6,IVNAME,152,LEN,35,IDIM,AA,881,LOC,IEOF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SUBLOG(LLOC, LANS)
C
C***  FORCE A LOGICAL INTO AN EXTERNAL ARRAY
C
      LOGICAL LLOC,LANS
C
      LLOC=LANS
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WRDEFL
C
C***  WRITE INCIDENCE CONTROL DEVICE INPUTS
C
      COMMON /INCID/ AA(40)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION NLNAME(6),IVNAME(34),LEN(6),IDIM(6),LOC(6)
C
      DATA NLNAME /  'D   ','E   ','F   ','L   ','C   ','T   '/
      DATA IVNAME /  'D   ','E   ','L   ','T   ','A   ','1   ','D   ',
     1 'E   ','L   ','T   ','A   ','2   ','D   ','E   ','L   ','T   ',
     2 'A   ','3   ','D   ','E   ','L   ','T   ','A   ','4   ','X   ',
     3 'H   ','I   ','N   ','G   ','E   ','S   ','K   ','E   ','W   '/
      DATA IDIM   / 8,8,8,8,4,4 /
      DATA LEN    / 6,6,6,6,6,4 /
      DATA LOC    / 1,9,17,25,33,37 /
C
      CALL NAMEW(KAND,6,NLNAME,6,IVNAME,34,LEN,6,IDIM,AA,40,LOC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE AXINWT(IDCRX)
C***********************************************************************
C
C     THIS SUBROUTINE ACCOUNTS FOR AXISYMMETRIC INLET CROSS FLOW
C     CONTRIBUTIONS NEED TO BE SUBTRACTED BECAUSE OF DIVERTER SHIELDING.
C     THES FORCES ARE CALCULATED AND THEN SUBTRACTED FROM THE INLET
C     CROSS FLOW CALCULATIONS.
C
C***********************************************************************
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      REAL MINARC,M
C
      DELFOR(P,M)=1./3.*(SIN(P)*(COS(P)**2+2.)-SIN(M)*(COS(M)**2+2.))
C
      NUMFLT=NALPHA+0.5
      NUMMCH=NMACH+0.5
C
C     DETERMINE THE ARC LENGTH COVERED BY THE INLET DIVERTER
      NUMI=NIN+0.5
      DO 100 INLET=1,NUMI
C
C     INITIALIZE VARIABLES
        DLCNAP(IDCRX,INLET) = 0.0
        DLCNAN(IDCRX,INLET) = 0.0
        DLCYAP(IDCRX,INLET) = 0.0
        DLCYAN(IDCRX,INLET) = 0.0
C
        PHIPR = PHI(INLET)/RAD+PI+RARX(IDCRX)
        PHIMR = PHI(INLET)/RAD+PI-RARX(IDCRX)
        COSPR = COS(PHIPR)
        COSMR = COS(PHIMR)
        IF (ABS(COSPR).LT.0.00001) COSPR = 0.0
        IF (ABS(COSMR).LT.0.00001) COSMR = 0.0
C
C     FOR POSITIVE ANGLES OF ATTACK
        IF(COSPR.LE.0..OR.COSMR.LE.0.)THEN
          IF(COSMR.GT.0.)THEN
            PLSARC = PHIPR - PI
            MINARC = -PI/2.
          ELSEIF(COSPR.GT.0.0)THEN
            PLSARC = PI/2.
            MINARC = PHIMR - PI
          ELSE
            PLSARC = PHIPR - PI
            MINARC = PHIMR - PI
          ENDIF
          DLCNAP(IDCRX,INLET) = DELFOR(PLSARC,MINARC)
        ENDIF
C     FOR NEGATIVE ANGLES OF ATTACK
        IF(COSPR.GE.0..OR.COSMR.GE.0.)THEN
          IF(COSPR.LT.0.)THEN
            PLSARC = PI/2.
            MINARC = PHIMR
          ELSEIF(COSMR.LT.0.0)THEN
            PLSARC = PHIPR
            MINARC = -PI/2.
          ELSE
            PLSARC = PHIPR
            MINARC = PHIMR
          ENDIF
          DLCNAN(IDCRX,INLET) = DELFOR(PLSARC,MINARC)
        ENDIF
  100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BODYCM(IM,CNAN,CNAC,CNABT)
C
C***  SUBROUTINE TO COMPUTE THE PITCHING MOMENT OF BODIES
C***  ABOUT THE USER SPECIFIED CENTER OF GRAVITY
C
C***  INPUTS
C
C     IM -- MACH NUMBER INDEX
C   CNAN -- NOSE NORMAL FORCE SLOPE, PER RADIAN
C   CNAC -- CENTERBODY NORMAL FORCE SLOPE, PER RADIAN
C  CNABT -- BOATTAIL/FLARE NORMAL FORCE SLOPE, PER RADIAN
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      REAL NALPHA,NMACH,MACH
C
      COMMON /TOTALC/ BALPHA(20),BBETA(20),BPHI(20),ALPTOT(20)
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
C
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     1  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     2  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     3  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     4                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,GDUM(12)
      REAL LTOTAL
C
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     1                TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,
     2                POWER,DISCON(20),ADUM(748)
      REAL NX,LNOSE,LCENTR,LAFT
      LOGICAL TRUNC
C
      COMMON /SBODY/ CNB(20),CMB(20),CAB(20),CYB(20),CLNB(20),CLLB(20),
     1               CNAB(20),CMAB(20),CYBB(20),CNBB(20),CLBB(20)
C
      COMMON /BDWORK/  CNP(20),CMP(20),CNVIS(20),CMVIS(20),CAPR(20),
     &                 CAF(20),CABASE(20),ETA,CDC(20),CAPROT(20),
     &                 BOTDCA(20),BOTDCN(20),BOTDCM(20)
      COMMON /XRBLNT/ XTEMP(50),RTEMP(50),NXTEMP,VNTEMP,SWTEMP,ITYPE
C
      XCPN=0.
      XCPC=0.
      XCPB=0.
      IF(ITYPE.EQ.1) GO TO 500
C
C***  POTENTIAL PITCHING MOMENT SLOPE
C
C ... NOSE/CENTERBODY CENTER OF PRESSURE
C
      CALL BDXCPN(TNOSE,MACH(IM),THEOFN,FRCENT+FRAFT,XCPN)
      XCPN=XCPN*DNOSE/LREF
C
C ... BOATTAIL/FLARE CENTER OF PRESSURE
C
C     AREA AT FORWARD END OF AFTER BODY
C
      SFWD=PI*DCENTR**2/4.
      DFWD=DCENTR
      IF(LCENTR .LE. UNUSED)SFWD=PI*DNOSE**2/4.
      IF(LCENTR .LE. UNUSED)DFWD=DNOSE
      IF(LAFT .GT. UNUSED .AND. DAFT .LT. DFWD)
     1 CALL BDXCPB(LTOTAL,LAFT,VOLAFT,DAFT,SFWD,XCPB)
      IF(LAFT .GT. UNUSED .AND. DAFT .GT. DFWD)
     1 CALL BDXCPF(DFWD,DAFT,LNOSE+LCENTR,LAFT,XCPB)
      XCPB=XCPB*DFWD/LREF
C
C ... PITCHING MOMENT SLOPE ABOUT NOSE
C
      CMNCB=-XCPN*CNAN-XCPC*CNAC-XCPB*CNABT
      CNALP=CNAN+CNAC+CNABT
      GO TO 600
  500 CONTINUE
C
C  FOR USER DEFINED BODIES (X,R) CALCULATE POTENTIAL CM-ALPHA
C
      CALL SUBPTS(NX,X,R,MACH(IM),CNALP,CMNCB)
C
C ... PITCHING MOMENT SLOPE ABOUT C. G.
C
  600 CONTINUE
      CMALP=CMNCB+CNALP*(XCG-XO)/LREF
C
C***  ANGLE OF ATTACK LOOP
C
      NALP=NALPHA+0.5
      DO 1000 I=1,NALP
C
C***     POTENTIAL CM
C
         CALL BDCMP(CMALP,ALPTOT(I),CMP(I))
C
C***     VISCOUS CM
C
         CALL BDCMV(ALPTOT(I),CDC(I),ETA,SPLAN,XCG-XO,XCENTP,SREF,
     1              LREF,CMVIS(I))
C
C***     TOTAL PITCHING MOMENT
C
      CMB(I)=(CMP(I)+CMVIS(I))*COS(BPHI(I)/RAD)
      CLNB(I)=-(CMP(I)+CMVIS(I))*SIN(BPHI(I)/RAD)*LREF/LATREF
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE COORD6(X,XU,XL,YUN,YLN,L,I,J,K,II,JJ,KK,III,JJJ,
     1 THN,CAM,ALPHAI,ALPHAO,AJJ,RHO,T)
C
C*****
C***** CALCULATE NACA 6-SERIES AIRFOIL COORDINATES
C*****
C
C  ROUTINE ADAPTED FROM DIGITAL DATCOM
C  ORIGINAL ROUTINE WRITTEN BY D. KINSEY, D. BOWERS, AFFDL
C  MODIFIED BY S.R. VUKELICH, MCDONNELL DOUGLAS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION X(50),XU(50),XL(50),YUN(50),YLN(50),THN(50),CAM(50)
C
      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
C
C ... COMPUTE COORDINATES ALONG CHORD
C
      DO 1100 M=2,LL
      IF(ZA.EQ.1.)GO TO 1050
      S=1.-X(M)
      D=ZA-X(M)
      IF(D .EQ. 0.)D=1.E-10
      YC=(AJJ/(2.*PI*(ZA+1.)))*((1./C)*((.5*D**2)*ALOG(ABS(D))
     1   -(.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))
     1   +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 CONTINUE
      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
c *************************************
c *************************************
c *************************************
      FUNCTION DSWET(NPTS,X,R)
C
C**  FUNCTION TO INTEGRATE FOR WETTED AREA
C
C***  INPUTS
C
C   NPTS -- NUMBER OF INPUT POINTS
C      X -- X STATIONS
C      R -- RADII AT EACH X STATION
C
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION X(NPTS),R(NPTS)
C
      DSWET=0.0
      DO 1000 I=2,NPTS
         DX=X(I)-X(I-1)
         DR=R(I)-R(I-1)
         DSWET=DSWET+PI*(R(I)+R(I-1))*SQRT(DX**2+DR**2)
 1000 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCNASP (M,TAPER,AR,SWAVLE,DEL,CNAW)
C
C **
C **  COMPUTES SUPERSONIC LIFTING SURFACE CN/ALPHA.
C **  REFERENCE DATCOM FIGURES 4.1.3.2-56 AND 4.1.3.2-60
C **             AND DOUGLAS REPORT DAC SM-13110
C **  LIMITATIONS -
C **          MACH MUST FALL IN THE INTERVAL 1.2-5.0 INCLUSIVE.
C **          TAPER MUST FALL IN THE INTERVAL 0.-1.0 INCLUSIVE.
C **          NO FORWARD SWEPT FINS.
C **          DEL MUST FALL IN THE INTERVAL 0.-70. INCLUSIVE.
C **  NOTE -    INPUT UNITS ON SREF AND SWING MUST BE CONSISTENT.
C **  INPUT -
C **          M = MACH NO.
C **          TAPER = EXPOSED TAPER RATIO
C **          AR = EXPOSED FIN ASPECT RATIO OF TWO PANELS
C **          SWAVLE = FIN LEADING EDGE SWEEP ANGLE,DEGREES
C **          DEL = LEADING EDGE SEMI WEDGE ANGLE, DEG
C **  OUTPUT -
C **          CNAW = NORMAL FORCE CURVE SLOPE REFERENCED TO
C **                 EXPOSED FIN AREA, PER DEGREE
C
C  MODIFIED BY K. DETERS, MCDONNELL DOUGLAS
C
      COMMON /CONST/PI,RAD,UNUSED,KAND
C
      DIMENSION G(6),Z(8),TX(6),A(288),B(288)
      DIMENSION D(16),E(9),IROUT(2),CT(2),ST(2)
      DIMENSION ALT0(48),ALT2(48),ALT25(48),ALT333(48),
     1          ALT5(48),ALT10(48)
      DIMENSION BRT0(48),BRT2(48),BRT25(48),BRT333(48),
     1          BRT5(48),BRT10(48)
C
      REAL M
C
      EQUIVALENCE ( A(  1) ,  ALT0 (1)) , ( A( 49) , ALT2  (1)) ,
     1            ( A( 97) ,  ALT25(1)) , ( A(145) , ALT333(1)) ,
     2            ( A(193) ,  ALT5 (1)) , ( A(241) , ALT10 (1))
      EQUIVALENCE ( B(  1) ,  BRT0 (1)) , ( B( 49) , BRT2  (1)) ,
     1            ( B( 97) ,  BRT25(1)) , ( B(145) , BRT333(1)) ,
     2            ( B(193) ,  BRT5 (1)) , ( B(241) , BRT10 (1))
C
C **  EXPLANATION OF DATA -
C **          G = VALUE OF EACH GRAPH, (TAPER RATIO).
C **          Z = VALUE OF EACH CURVE, (AR*TLES).
C **          TX = X VALUE OF EACH DATA POINT, (BETA/TLES OR TLES/BETA).
C
      DATA KG,KC,KP,KD/6,8,6,288/
      DATA G/.0,.2,.25,.3333,.5,1./
      DATA Z/.25,.5,1.,2.,3.,4.,5.,6./
      DATA TX/.0,.2,.4,.6,.8,1./
C
C **  DATA TABLE FOR LEFT SIDE OF DATCOM FIG.4.1.3.2-56
C **  LEFT SIDE OF THE GRAPH TAPER = 0.  ROWS CORRESPOND TO VALUES
C **  OF Z.  COLUMNS CORRESPOND TO VALUES OF TX.
C
      DATA ALT0/
     1   .392,  .392,  .392,  .400,  .408,  .431
     2,  .784,  .784,  .784,  .800,  .831,  .863
     3, 1.569, 1.569, 1.584, 1.631, 1.678, 1.765
     4, 3.137, 3.145, 3.153, 3.176, 3.255, 3.373
     5, 4.706, 4.784, 5.020, 4.525, 4.078, 3.686
     6, 6.196, 5.922, 5.412, 4.878, 4.408, 4.000
     7, 6.353, 6.353, 5.741, 5.122, 4.667, 4.235
     8, 6.353, 6.353, 6.094, 5.506, 4.957, 4.471/
C **  LEFT SIDE OF THE GRAPH TAPER = .2.
      DATA ALT2/
     1   .392,  .392,  .392,  .400,  .408,  .431
     2,  .784,  .784,  .784,  .800,  .831,  .863
     3, 1.569, 1.608, 1.647, 1.671, 1.725, 1.804
     4, 3.137, 3.216, 3.592, 3.624, 3.467, 3.255
     5, 4.706, 5.082, 4.824, 4.431, 3.992, 3.686
     6, 5.569, 5.584, 5.412, 4.902, 4.455, 4.039
     7, 5.710, 5.741, 5.718, 5.310, 4.808, 4.353
     8, 5.796, 5.882, 5.882, 5.647, 5.114, 4.643/
C **  LEFT SIDE OF THE GRAPH TAPER = .25.
      DATA ALT25/
     1   .392,  .392,  .392,  .400,  .408,  .431
     2,  .784,  .784,  .800,  .831,  .847,  .871
     3, 1.569, 1.608, 1.624, 1.655, 1.733, 1.835
     4, 3.137, 3.412, 3.702, 3.631, 3.443, 3.184
     5, 4.706, 5.027, 4.792, 4.392, 4.008, 3.686
     6, 5.373, 5.420, 5.325, 4.871, 4.431, 4.627
     7, 5.576, 5.631, 5.576, 5.286, 4.784, 4.392
     8, 5.725, 5.733, 5.725, 5.631, 5.114, 4.118/
C **  LEFT SIDE OF THE GRAPH TAPER = .333.
      DATA ALT333/
     1   .392,  .392,  .392,  .400,  .408,  .431
     2,  .784,  .784,  .808,  .839,  .855,  .878
     3, 1.569, 1.569, 1.584, 1.647, 1.733, 1.922
     4, 3.137, 3.294, 3.710, 3.655, 3.427, 3.161
     5, 4.706, 4.784, 4.690, 4.353, 3.914, 3.624
     6, 5.176, 5.176, 5.137, 4.839, 4.400, 4.000
     7, 5.404, 5.412, 5.373, 5.255, 4.784, 4.329
     8, 5.529, 5.569, 5.561, 5.514, 5.114, 4.627/
C **  LEFT SIDE OF THE GRAPH TAPER = .5.
      DATA ALT5/
     1   .392,  .392,  .392,  .400,  .408,  .431
     2,  .784,  .784,  .863,  .824,  .863,  .918
     3, 1.569, 1.624, 1.765, 1.835, 1.898, 1.953
     4, 3.137, 3.373, 3.647, 3.459, 3.255, 3.027
     5, 4.392, 4.384, 4.369, 4.220, 3.867, 3.545
     6, 4.863, 4.784, 4.745, 4.643, 4.314, 3.937
     7, 5.035, 5.035, 5.020, 4.957, 4.722, 4.314
     8, 5.161, 5.176, 5.192, 5.176, 5.090, 4.471/
C **  LEFT SIDE OF THE GRAPH TAPER = 1.0.
      DATA ALT10/
     1   .392,  .400,  .439,  .486,  .557,  .627
     2,  .784,  .824,  .863,  .933, 1.043, 1.200
     3, 1.569, 1.584, 1.631, 1.725, 1.843, 2.000
     4, 3.137, 3.051, 3.035, 2.980, 2.910, 2.894
     5, 3.725, 3.788, 3.686, 3.537, 3.443, 3.373
     6, 4.078, 4.141, 4.016, 3.922, 3.843, 3.827
     7, 4.314, 4.408, 4.275, 4.196, 4.220, 4.235
     8, 4.549, 4.604, 4.525, 4.431, 4.510, 4.565/
C
C **  DATA TABLE FOR RIGHT SIDE OF DATCOM FIG. 4.1.3.2-56
C **  RIGHT SIDE OF THE GRAPH TAPER = 0.
C
      DATA BRT0/
     1  4.000, 1.859, 1.020,  .690,  .533,  .431
     2, 4.000, 3.239, 1.922, 1.349, 1.035,  .863
     3, 4.000, 3.843, 3.333, 2.604, 2.094, 1.765
     4, 4.000, 3.922, 3.804, 3.671, 3.522, 3.373
     5, 4.000, 3.922, 3.882, 3.843, 3.765, 3.686
     6, 4.000, 4.000, 4.000, 4.000, 4.000, 4.000
     7, 4.000, 4.008, 4.039, 4.078, 4.149, 4.235
     8, 4.000, 4.016, 4.078, 4.157, 4.314, 4.471/
C **  RIGHT SIDE OF THE GRAPH TAPER = .2.
      DATA BRT2/
     1  4.000, 2.157, 1.082,  .690,  .510,  .431
     2, 4.000, 3.506, 2.235, 1.490, 1.106,  .863
     3, 4.000, 3.820, 3.506, 2.902, 2.251, 1.804
     4, 4.000, 3.922, 3.843, 3.702, 3.506, 3.255
     5, 4.000, 4.000, 4.000, 4.000, 3.898, 3.686
     6, 4.000, 4.024, 4.314, 4.102, 4.157, 4.039
     7, 4.000, 4.047, 4.078, 4.220, 4.384, 4.353
     8, 4.000, 4.016, 4.118, 4.314, 4.557, 4.643/
C **  RIGHT SIDE OF THE GRAPH TAPER = .25.
      DATA BRT25/
     1  4.000, 2.282, 1.137,  .706,  .525,  .431
     2, 4.000, 3.490, 2.275, 1.490, 1.082,  .871
     3, 4.000, 3.788, 3.467, 2.949, 2.290, 1.835
     4, 4.000, 3.922, 3.835, 3.686, 3.451, 3.184
     5, 4.000, 4.000, 4.000, 4.000, 3.859, 3.686
     6, 4.000, 4.008, 4.078, 4.118, 4.157, 4.627
     7, 4.000, 4.016, 4.102, 4.235, 4.416, 4.392
     8, 4.000, 4.024, 4.118, 4.314, 4.588, 4.118/
      DATA BRT333/
C **  RIGHT SIDE OF THE GRAPH TAPER = .333.
     1  4.000, 2.353, 1.106,  .714,  .525,  .431
     2, 4.000, 3.435, 2.298, 1.498, 1.106,  .878
     3, 4.000, 3.773, 3.412, 2.965, 2.447, 1.922
     4, 4.000, 3.922, 3.835, 3.678, 3.435, 3.161
     5, 4.000, 4.000, 4.000, 4.000, 3.851, 3.624
     6, 4.000, 4.008, 4.071, 4.157, 4.173, 4.000
     7, 4.000, 4.016, 4.118, 4.275, 4.431, 4.329
     8, 4.000, 4.024, 4.157, 3.584, 4.627, 4.627/
C **  RIGHT SIDE OF THE GRAPH TAPER = .5.
      DATA BRT5/
     1  4.000, 2.447, 1.216,  .784,  .533,  .431
     2, 4.000, 3.388, 2.447, 1.710, 1.176,  .918
     3, 4.000, 3.741, 3.365, 2.878, 2.376, 1.953
     4, 4.000, 3.882, 3.788, 3.647, 3.318, 3.027
     5, 4.000, 3.961, 4.000, 4.000, 3.804, 3.545
     6, 4.000, 3.984, 4.024, 4.149, 4.165, 3.937
     7, 4.000, 4.016, 4.078, 4.282, 4.455, 4.314
     8, 4.000, 4.039, 4.141, 4.392, 4.643, 4.471/
C **  RIGHT SIDE OF THE GRAPH TAPER = 1.0.
      DATA BRT10/
     1  4.000, 2.431, 1.263,  .902,  .745,  .627
     2, 4.000, 3.176, 2.337, 1.749, 1.435, 1.200
     3,4.000, 3.647, 3.208, 2.722, 2.314, 2.000
     4,4.000, 3.843, 3.741, 3.506, 3.161, 2.894
     5,4.000, 3.922, 3.961, 3.937, 3.702, 3.373
     6,4.000, 3.953, 4.039, 4.173, 4.094, 3.827
     7,4.000, 3.984, 4.078, 4.314, 4.290, 4.235
     8,4.000, 4.024, 4.118, 4.463, 4.706, 4.565/
C
C **  CURVE FIT FOR LEFT SIDE OF DATCOM FIG. 4.1.3.2-60
C
      DATA D/1.56127, -1.07271, 0.0,.449111,-4.13978E-3,
     1      0.0,-7.32931E-3,0.0,0.0,1.34777E-4,0.0,0.0,
     2      -4.57070E-7,0.0,0.0,0.0/
C
C **  CURVE FIT FOR RIGHT SIDE OF DATCOM FIG. 4.1.3.2-60
C
      DATA E/1.33824,-.673748,.243197,-1.02618E-2,
     1       1.43125E-3,0.0,7.46318E-5,0.0,0.0/
C
      BETA=SQRT(ABS(1.-M*M))
C
C
C***  LUCERO'S METHOD LIMITATIONS
      SUBLE=M*COS(SWAVLE/RAD)
      XSWP=0.
      XRECT=0.
      IF(TAPER.GT.0.5 .OR.  SWAVLE.EQ.0.) XRECT=BETA*AR
      IF(TAPER.LE.0.5 .AND. SWAVLE.NE.0.) XSWP=BETA/TAN(SWAVLE/RAD)
C
      IF(M .GE. 2.5 .AND. XRECT .LE. 1.35 .AND. XSWP .LE. 1.35 
     &   .AND. SWAVLE .GE. 0. .AND. SUBLE .GT. 1.)THEN
C
C***    SUBROUTINE CALL STATEMENTS 
        IF(SWAVLE .EQ. 0.)THEN
        XTERM=1./(BETA*AR)
        CALL LUCERO(BETA,XTERM,CNAW)
        ELSE IF(TAPER .EQ. 0.)THEN
        XTERM=TAN(SWAVLE/RAD)/BETA
        CALL LUCERO(BETA,XTERM,CNAW)
        ELSE
        XTERM1=1./(BETA*AR)
        CALL LUCERO(BETA,XTERM1,CNA1)
        XTERM2=TAN(SWAVLE/RAD)/BETA
        CALL LUCERO(BETA,XTERM2,CNA2)
        CNAW=CNA1*TAPER+CNA2*(1.-TAPER)
        ENDIF
      ELSE
C
      IF(ABS(SWAVLE) .LE. UNUSED .AND. TAPER .EQ. 1.)GO TO 1040
C
      TLES=TAN(SWAVLE/RAD)
      R=AR*TLES
      IF(R .LT. 0.25)R=.25
C
C **  CNAW = THEORETICAL CN/ALPHA PER DATCOM FIG. 4.1.3.2-56
C
      IF(BETA.GE.TLES) GO TO 1000
      Q=BETA/TLES
      CALL MVLOOK(KG,KC,KP,KD,G,Z,TX,A,Q,R,TAPER,CNAW)
      CNAW=CNAW/TLES
      GO TO 1010
 1000 Q=TLES/BETA
      CALL MVLOOK(KG,KC,KP,KD,G,Z,TX,B,Q,R,TAPER,CNAW)
      CNAW=CNAW/BETA
 1010 IF(BETA.GE.TLES) GO TO 1020
C
C **  CORR = CORRECTION FOR SONIC L.E. REGION DATCOM FIG. 4.1.3.2-60
C
      CORR=D(1)+D(2)*Q+D(3)*Q**2+D(4)*Q**3+
     1     DEL*(D(5)+D(6)*Q+D(7)*Q**2+D(8)*Q**3)+
     2     DEL**2*(D(9)+D(10)*Q+D(11)*Q**2+D(12)*Q**3)+
     3     DEL**3*(D(13)+D(14)*Q+D(15)*Q**2+D(16)*Q**3)
      GO TO 1030
 1020 CORR=E(1)+E(2)*Q+E(3)*Q**2+
     1     DEL*(E(4)+E(5)*Q+E(6)*Q**2)+
     2     DEL**2*(E(7)+E(8)*Q+E(9)*Q**2)
 1030 IF(CORR.GT.1.) CORR=1.
      CNAW=CNAW*CORR/RAD
C
      IF(R .GT. 0.25)GO TO 1050
      CNAWW=CNAW
C
C **  LEADING EDGE SWEEP = 0 (DATCOM FIG. 4.1.3.2-56G)
C
 1040 AB=AR*BETA
C ...
C ... USING EQUATIONS FROM DAC SM-13110 FOR RECTANGULAR WINGS
C ...
      IF(AB.GE..5 .AND. AB.LT.1.)BCNA=4./(PI*AB)*((2.*AB-1.)*ASIN(AB)+
     1 AB*(AB-2.)*ALOG((1.+SQRT(1.-AB**2))/AB)+(1.+AB)*SQRT(1.-AB**2))
      IF(AB .LT. .5)BCNA=0.7928
      IF(AB .GE. 1.)BCNA=4.*(1.-.5/AB)
      CNAW=BCNA/BETA/RAD
      IF(ABS(SWAVLE) .LE. UNUSED .AND. TAPER .EQ. 1.)GO TO 1050
      IF(R .GT. 0.25)GO TO 1050
C
C ... LINEARILY INTERPOLATE BETWEEN AR*TAN(LE) AND RECTANGULAR
C
      ST(1)=0.
      ST(2)=ATAN(R/AR)
      CT(1)=CNAWW
      CT(2)=CNAW
      CALL LNTRP(ST,CT,2,AR*TAN(SWAVLE/RAD),CNAW)
C
 1050 CONTINUE
C
      ENDIF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE GEOELL
C
C***  COMPUTE GEOMETRY FOR ELLIPTICAL BODIES
C
C***  NOTE THAT THE ELLIPTICAL BODY DATA IS PLACED IN THE
C***  SAME ARRAY AS THE CIRCULAR BODY DATA IS PLACED
C***  THIS IS DONE TO CONSERVE CORE
C
      COMMON /ABODIN/ NX,XO,X(50),WIDTH(50),TNOSE,LNOSE,WNOSE,BNOSE,
     1                TRUNC,LCENTR,WCENTR,TAFT,LAFT,WAFT,
     2                POWER,DISCON(20),ELLIP(50),HEIGHT(50),ENOSE,
     3                ECENTR,EAFT,ADUM(645)
C
      COMMON /XRBLNT/ XTEMP(50),RTEMP(50),NXTEMP,VNTEMP,SWTEMP,ITYPE
      REAL NXTEMP,NXTMP
      REAL NX,LNOSE,LCENTR,LAFT,NCENT,NAFT
      LOGICAL TRUNC
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
C
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     1  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     2  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     3  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     4                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,
     5  BPNOSE,BCPNOS,BPCENT,BCPCEN,BPAFT,BCPAFT,BPLAN,
     6  BCENTP,ECSPN,ECSPC,ECSPA,ECSPT
C
      REAL LTOTAL
C
C            **NOTE**
C  ALL CALCULATIONS REFERENCED TO THE HORIZONTAL AXIS
C  ARE STORED IN GEOBOD 1-35 --- ALL VERTICAL AXIS
C  CALCULATIONS (DIFFERENT FROM HORIZONTAL CALCULATIONS)
C  ARE STORED IN GEOBOD 36-43
C
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /LOGIC/ LFLAGS(18),LDIMIN,LDIMFT,LDIMCM,LDIMM,LDUM2(6)
      LOGICAL        LFLAGS    ,LDIMIN,LDIMFT,LDIMCM,LDIMM
C
      DIMENSION GEOB(43),GEOBEA(43),GEOBEB(43),TX(4),TE(4)
      DIMENSION REQ(50),DUMMY(20),WTEMP(50),HTEMP(50)
C
      EQUIVALENCE (GEOB(1),SPNOSE)
C
      X1V=0.
      X1H=0.
C
      NXTEMP=UNUSED
      DO 990 I=1,43
         GEOBEA(I)=UNUSED
         GEOBEB(I)=UNUSED
  990 CONTINUE
C
C***  DEFAULTS FOR ENOSE, ECENTR, AND EAFT
C
      IF(ENOSE .LE. UNUSED)ENOSE=1.
      IF(ECENTR .LE. UNUSED)ECENTR=1.
      IF(EAFT .LE. UNUSED)EAFT=1.
      IF(BNOSE .LE. UNUSED)BNOSE=0.
C
      HNOSE=UNUSED
      HCENTR=UNUSED
      HAFT=UNUSED
      IF(WNOSE .NE. UNUSED)HNOSE=ENOSE*WNOSE
      IF(WCENTR .NE. UNUSED)HCENTR=ECENTR*WCENTR
      IF(WAFT .NE. UNUSED)HAFT=EAFT*WAFT
C
      DO 1000 I=1,50
         IF(ELLIP(I) .EQ. UNUSED .AND. HEIGHT(I) .GT. UNUSED .AND.
     1      WIDTH(I) .GT. UNUSED)ELLIP(I)=HEIGHT(I)/WIDTH(I)
         IF(ELLIP(I) .EQ. UNUSED .AND. (HEIGHT(I) .LE. UNUSED .OR.
     1      WIDTH(I) .LE. UNUSED))ELLIP(I)=1.
         IF(ELLIP(I) .NE. UNUSED .AND. HEIGHT(I) .EQ. UNUSED)
     1    HEIGHT(I)=WIDTH(I)*ELLIP(I)
         IF(ELLIP(I) .NE. UNUSED .AND. WIDTH(I) .EQ. UNUSED)
     1    WIDTH(I)=HEIGHT(I)/ELLIP(I)
 1000 CONTINUE
C
C***  SCALE THE INPUT GEOMETRY
C
      IF(SCALE .EQ. UNUSED .OR. SCALE .EQ. 1.)GO TO 1020
      IF(XO .NE. UNUSED)XO=XO*SCALE
         DO 1010 I=1,50
            IF(X(I) .NE. UNUSED)X(I)=X(I)*SCALE
            IF(WIDTH(I) .NE. UNUSED)WIDTH(I)=WIDTH(I)*SCALE
            IF(HEIGHT(I) .NE. UNUSED)HEIGHT(I)=HEIGHT(I)*SCALE
 1010    CONTINUE
C
         IF(LNOSE .NE. UNUSED)LNOSE=LNOSE*SCALE
         IF(BNOSE .NE. UNUSED)BNOSE=BNOSE*SCALE
         IF(WNOSE .NE. UNUSED)WNOSE=WNOSE*SCALE
         IF(HNOSE .NE. UNUSED)HNOSE=HNOSE*SCALE
         IF(LCENTR .NE. UNUSED)LCENTR=LCENTR*SCALE
         IF(WCENTR .NE. UNUSED)WCENTR=WCENTR*SCALE
         IF(HCENTR .NE. UNUSED)HCENTR=HCENTR*SCALE
         IF(LAFT .NE. UNUSED)LAFT=LAFT*SCALE
         IF(WAFT .NE. UNUSED)WAFT=WAFT*SCALE
         IF(HAFT .NE. UNUSED)HAFT=HAFT*SCALE
C
 1020 CONTINUE
C
C  CHECK FOR INPUT OPTION
C
      IF(NX .GT. UNUSED)GO TO 1170
C
      ISEG=0
C
      BNOSEW=0.
      BNOSEH=0.
      IF(BNOSE .GT. UNUSED)BNOSEW=BNOSE
      IF(BNOSE .GT. UNUSED)BNOSEH=BNOSE*HNOSE/WNOSE
C
C***  HERE FOR OPTION 1 (SHAPES DEFINED)
C
C DEFAULTS ...
C
      IF(TAFT .LE. UNUSED)TAFT=0.
C
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. UNUSED)TNOSE=1.
      IF(LNOSE .GT. UNUSED .AND. TNOSE .GT. 4.)TNOSE=0.
      IF(LAFT  .GT. UNUSED .AND. TAFT  .GT. 1.)TAFT=0.
C
      IF(LNOSE .LE. UNUSED)GO TO 1100
C
      IF(TNOSE .NE. 0. .AND. LNOSE .LT. WNOSE/2.)TNOSE=0.
      IF(TNOSE .NE. 0. .AND. LNOSE .LT. HNOSE/2.)TNOSE=0.
      IF(TNOSE .NE. 0. .AND. LNOSE .LT. WNOSE/2. .AND. PARTS(18))
     1 WRITE(6,1240)
      IF(TNOSE .NE. 0. .AND. LNOSE .LT. HNOSE/2. .AND. PARTS(18))
     1 WRITE(6,1240)
C
C  SET NOSE TYPE
C
      JUMP=TNOSE+1.5
C
      IF(LNOSE .LE. UNUSED)GO TO 1100
C
C  COMPUTE THE APPROPIATE SHAPE
C
      GO TO (1030,1040,1050,1060,1060),JUMP
C
C            **NOTE**
C  GEOBEA -- GEOBOD PARAMETERS WITH RESPECT TO HORIZ.AXIS
C  GEOBEB -- GEOBOD PARAMETERS WITH RESPECT TO VERT. AXIS
C
 1030 IF (BNOSEW.GT.UNUSED)
     & CALL CONIC(GEOBEA,NXTEMP,XTEMP,WTEMP,UNUSED,.FALSE.,
     &            LNOSE,WNOSE,DUMMY)
      CALL CONIC(GEOBEA,NX,X,WIDTH,BNOSEW,TRUNC,LNOSE,WNOSE,DISCON)
      X1H=X(1)
      NX = 0.
      NXTEMP=0.0
      IF (BNOSEH.GT.UNUSED)
     & CALL CONIC(GEOBEB,NXTEMP,XTEMP,HTEMP,UNUSED,.FALSE.,
     &            LNOSE,HNOSE,DUMMY)
      CALL CONIC(GEOBEB,NX,X,HEIGHT,BNOSEH,TRUNC,LNOSE,HNOSE,DISCON)
      X1V=X(1)
      GO TO 1080
C
 1040 IF (BNOSEW.GT.UNUSED)
     & CALL OGIVE(GEOBEA,NXTEMP,XTEMP,WTEMP,UNUSED,.FALSE.,
     &            LNOSE,WNOSE,DUMMY)
      CALL OGIVE(GEOBEA,NX,X,WIDTH,BNOSEW,TRUNC,LNOSE,WNOSE,DISCON)
      X1H=X(1)
      NX = 0.
      NXTEMP=0.0
      IF (BNOSEH.GT.UNUSED)
     & CALL OGIVE(GEOBEB,NXTEMP,XTEMP,HTEMP,UNUSED,.FALSE.,
     &            LNOSE,HNOSE,DUMMY)
      CALL OGIVE(GEOBEB,NX,X,HEIGHT,BNOSEH,TRUNC,LNOSE,HNOSE,DISCON)
      X1V=X(1)
      GO TO 1080
C
 1050 IF (BNOSEW.GT.UNUSED)
     & CALL POWR(GEOBEA,NXTEMP,XTEMP,WTEMP,UNUSED,.FALSE.,
     &           LNOSE,WNOSE,POWER,DUMMY)
      CALL POWR(GEOBEA,NX,X,WIDTH,BNOSEW,TRUNC,LNOSE,WNOSE,POWER,
     1          DISCON)
      X1H=X(1)
      NX = 0.
      NXTEMP=0.0
      IF (BNOSEH.GT.UNUSED)
     & CALL POWR(GEOBEB,NXTEMP,XTEMP,HTEMP,UNUSED,.FALSE.,
     &           LNOSE,HNOSE,POWER,DUMMY)
      CALL POWR(GEOBEB,NX,X,HEIGHT,BNOSEH,TRUNC,LNOSE,HNOSE,POWER,
     1          DISCON)
      X1V=X(1)
      GO TO 1080
C
 1060 IF (BNOSEW.GT.UNUSED)
     & CALL HAACK(XO,TNOSE,WNOSE,UNUSED,.FALSE.,LNOSE,DUMMY,
     &            XTEMP,WTEMP,NXTEMP,GEOBEA)
      CALL HAACK(XO,TNOSE,WNOSE,BNOSEW,TRUNC,LNOSE,DISCON,
     &           X,WIDTH,NX,GEOBEA)
      X1H=X(1)
      NX = 0.
      NXTEMP=0.0
      IF (BNOSEH.GT.UNUSED)
     & CALL HAACK(XO,TNOSE,HNOSE,UNUSED,.FALSE.,LNOSE,DUMMY,
     &            XTEMP,HTEMP,NXTEMP,GEOBEB)
      CALL HAACK(XO,TNOSE,HNOSE,BNOSEH,TRUNC,LNOSE,DISCON,
     &           X,HEIGHT,NX,GEOBEB)
      X1V=X(1)
C
 1080 CONTINUE
      GEOB(1)=GEOBEA(1)
      GEOB(36)=GEOBEB(1)
      NNX=NX+.5
      GEOB(2)=DSWETE(NNX,X,WIDTH,HEIGHT)
      GEOB(3)=DVOLE(NNX,X,WIDTH,HEIGHT)
      GEOB(4)=DXCNVE(NNX,X,WIDTH,HEIGHT)
      GEOB(5)=GEOBEA(5)
      GEOB(37)=GEOBEB(5)
      GEOB(6)=LNOSE/(2.*SQRT((WNOSE/2.)*(HNOSE/2.)))
      GEOB(7)=GEOBEA(7)
      GEOB(8)=GEOB(7)/(2.*SQRT((WNOSE/2.)*(HNOSE/2.)))
C
      ISEG=ISEG+1
      TX(ISEG)=X(1)
      TE(ISEG)=ENOSE
      ISEG=ISEG+1
      TX(ISEG)=X(NNX)
      TE(ISEG)=ENOSE
      DO 1090 I=1,NNX
         REQ(I)=SQRT(WIDTH(I)*HEIGHT(I))
 1090 CONTINUE
C
      ECSPN=DSPLAN(NNX,X,REQ)
C
C***  FIND EQUIVALENT CIRCULAR RADIUS FOR SHARP NOSE (RTEMP)
C***  AND THE VOLUME FOR A SHARP AXISYMMETRIC NOSE (VNTEMP)
      IF (BNOSE.GT.UNUSED) THEN
        NTMP=NXTEMP+0.5
        DO 1095 I=1,NTMP
          RTEMP(I)=SQRT(WTEMP(I)*HTEMP(I))
 1095   CONTINUE
        VNTEMP=DVOL(NTMP,XTEMP,RTEMP)
      ENDIF
C
 1100 CONTINUE
C
C  NOW COMPUTE CENTERBODY DATA IF DEFINED
C
      IF(LCENTR .LE. UNUSED)GO TO 1120
      RFWDEA=WNOSE/2.
      RFWDEB=HNOSE/2.
C
      IF (BNOSE.GT.UNUSED) THEN
        NXTMP=NXTEMP
        CALL CONIC(GEOBEA(9),NXTEMP,XTEMP,WTEMP,RFWDEA,.TRUE.,
     &             LCENTR,WCENTR,DUMMY)
        NXTEMP=NXTMP
        CALL CONIC(GEOBEB(9),NXTEMP,XTEMP,HTEMP,RFWDEB,.TRUE.,
     &             LCENTR,WCENTR,DUMMY)
      ENDIF
C
      NCENT = NX
      CALL CONIC(GEOBEA(9),NX,X,WIDTH,RFWDEA,.TRUE.,LCENTR,WCENTR,
     1          DISCON)
      NX = NCENT
      CALL CONIC(GEOBEB(9),NX,X,HEIGHT,RFWDEB,.TRUE.,LCENTR,HCENTR,
     1          DISCON)
C
      GEOB(9)=GEOBEA(9)
      GEOB(38)=GEOBEB(9)
      NNX=NX+.5
      GEOB(10)=DSWETE(NNX,X,WIDTH,HEIGHT)-GEOB(2)
      GEOB(11)=DVOLE(NNX,X,WIDTH,HEIGHT)-GEOB(3)
      GEOB(12)=(DXCNVE(NNX,X,WIDTH,HEIGHT)*(GEOB(11)+GEOB(3))-
     1         GEOB(4)*GEOB(3))/GEOB(11)
      GEOB(13)=GEOBEA(13)
      GEOB(39)=GEOBEB(13)
      GEOB(14)=LCENTR/(2.*SQRT((WCENTR/2.)*(HCENTR/2.)))
      GEOB(15)=GEOBEA(15)
      GEOB(16)=GEOB(15)/(2.*SQRT((WCENTR/2.)*(HCENTR/2.)))
C
      DO 1110 I=1,NNX
         REQ(I)=SQRT(WIDTH(I)*HEIGHT(I))
 1110 CONTINUE
      ECSPC=DSPLAN(NNX,X,REQ)-ECSPN
      ISEG=ISEG+1
      TX(ISEG)=X(NNX)
      TE(ISEG)=ECENTR
C
C  NOW THE AFTERBODY
C
 1120 CONTINUE
      IF(LAFT .LE. UNUSED)GO TO 1180
      IF(LCENTR .NE. UNUSED)WC=WCENTR
      IF(LCENTR .NE. UNUSED)HC=HCENTR
      IF(LCENTR .LE. UNUSED)WC=WNOSE
      IF(LCENTR .LE. UNUSED)HC=HNOSE
C
C  SET AFTERBODY TYPE
C
      JUMP=TAFT+1.5
C
      RFWDEA=WC/2.
      RFWDEB=HC/2.
C
      IF(TAFT .NE. 0. .AND. LAFT .LT. RFWDEA)TAFT=0.
      IF(TAFT .NE. 0. .AND. LAFT .LT. RFWDEB)TAFT=0.
      IF(TAFT .NE. 0. .AND. LAFT .LT. RFWDEA .AND. PARTS(18))
     1 WRITE(6,1250)
      IF(TAFT .NE. 0. .AND. LAFT .LT. RFWDEB .AND. PARTS(18))
     1 WRITE(6,1250)
C
      NAFT = NX
      NXTMP=NXTEMP
C
C  COMPUTE THE APPROPIATE SHAPE
C
      GO TO (1130,1140),JUMP
C
 1130 IF (BNOSEW.GT.UNUSED)
     & CALL CONIC(GEOBEA(17),NXTEMP,XTEMP,WTEMP,RFWDEA,.TRUE.,
     &            LAFT,WAFT,DUMMY)
      CALL CONIC(GEOBEA(17),NX,X,WIDTH,RFWDEA,.TRUE.,LAFT,WAFT,DISCON)
      NX = NAFT
      NXTEMP=NXTMP
      IF (BNOSEH.GT.UNUSED)
     & CALL CONIC(GEOBEB(17),NXTEMP,XTEMP,HTEMP,RFWDEB,.TRUE.,
     &            LAFT,HAFT,DUMMY)
      CALL CONIC(GEOBEB(17),NX,X,HEIGHT,RFWDEB,.TRUE.,LAFT,HAFT,DISCON)
      GO TO 1150
C
 1140 IF (BNOSEW.GT.UNUSED)
     & CALL OGIVE(GEOBEA(17),NXTEMP,XTEMP,WTEMP,RFWDEA,.TRUE.,
     &            LAFT,WAFT,DUMMY)
      CALL OGIVE(GEOBEA(17),NX,X,WIDTH,RFWDEA,.TRUE.,LAFT,WAFT,DISCON)
      NX = NAFT
      NXTEMP=NXTMP
      IF (BNOSEH.GT.UNUSED)
     & CALL OGIVE(GEOBEB(17),NXTEMP,XTEMP,HTEMP,RFWDEB,.TRUE.,
     &            LAFT,HAFT,DUMMY)
      CALL OGIVE(GEOBEB(17),NX,X,HEIGHT,RFWDEB,.TRUE.,LAFT,HAFT,DISCON)
C
 1150 CONTINUE
      GEOB(17)=GEOBEA(17)
      GEOB(40)=GEOBEB(17)
      NNX=NX+.5
      GEOB(18)=DSWETE(NNX,X,WIDTH,HEIGHT)-GEOB(10)-GEOB(2)
      GEOB(19)=DVOLE(NNX,X,WIDTH,HEIGHT)-GEOB(11)-GEOB(3)
      GEOB(20)=(DXCNVE(NNX,X,WIDTH,HEIGHT)*(GEOB(19)+GEOB(11)+
     1         GEOB(3))-GEOB(4)*GEOB(3)-GEOB(11)*GEOB(12))/GEOB(19)
      GEOB(21)=GEOBEA(21)
      GEOB(41)=GEOBEB(21)
      GEOB(22)=LAFT/(2.*SQRT((WC/2.)*(HC/2.)))
      GEOB(23)=GEOBEA(23)
      GEOB(24)=GEOB(23)/(2.*SQRT((WC/2.)*(HC/2.)))
C
      DO 1160 I=1,NNX
         REQ(I)=SQRT(WIDTH(I)*HEIGHT(I))
 1160 CONTINUE
      ECSPA=DSPLAN(NNX,X,REQ)-ECSPN-ECSPC
      ISEG=ISEG+1
      TX(ISEG)=X(NNX)
      TE(ISEG)=EAFT
C
C***  EQUIVALENT CIRCULAR BODY RADIUS FOR SHARP NOSES (RTEMP)
      IF (BNOSE.GT.UNUSED) THEN
        NTMP=NXTEMP+0.5
        DO 1165 I=1,NTMP
          RTEMP(I)=SQRT(WTEMP(I)*HTEMP(I))
 1165   CONTINUE
      ENDIF
C
      GO TO 1180
C
 1170 CONTINUE
C
C***  HERE FOR OPTION 2 (COORDINATES DEFINED)
C
      NNX=NX+0.5
      ITYPE=1
C
      CALL USEREL(REQ)
C
      NNX=NX+0.5
C
      X1V=X(1)
      GO TO 1200
C
 1180 CONTINUE
C
C  GET TOTALS FOR OPTION 1 INPUTS
C
      ITYPE=2
      SPLAN=SPNOSE+SPCENT+SPAFT
      ECSPT=ECSPN+ECSPC+ECSPA
      BPLAN=BPNOSE+BPCENT+BPAFT
      SWET =SWNOSE+SWCENT+SWAFT
C
C***  FIND TOTAL WETTED AREA FOR A SHARP NOSE (SWTEMP)
      IF (BNOSE.GT.UNUSED) SWTEMP=DSWET(NTMP,XTEMP,RTEMP)
C
      VOL  =VOLNOS+VOLCEN+VOLAFT
      LTOTAL=LNOSE+LCENTR+LAFT
      XCENTV=(XCVNOS*VOLNOS+XCVCEN*VOLCEN+XCVAFT*VOLAFT)/VOL
      XCENTP=(XCPNOS*SPNOSE+XCPCEN*SPCENT+XCPAFT*SPAFT)/SPLAN
      BCENTP=(BCPNOS*BPNOSE+BCPCEN*BPCENT+BCPAFT*BPAFT)/BPLAN
C
C  FILL ELLIP ARRAY FOR BODY ELLIPTICITY
C
      NNX=NX+0.5
      IF(ISEG .LT. 1)GO TO 1200
      DO 1190 I=1,NNX
         CALL LNTRP(TX,TE,ISEG,X(I),ELLIP(I))
 1190 CONTINUE
C
C  CORRECT FOR NOSE APEX COORDINATE
C
 1200 CONTINUE
      DMAX=2.*REQ(1)
      DO 1210 I=1,NNX
         X(I)=X(I)-X1V+XO
         IF(2.*REQ(I) .GT. DMAX)DMAX=2.*REQ(I)
 1210 CONTINUE
      SMAX=PI*DMAX**2/4.
      DBASE=2.*REQ(NNX)
      SBASE=PI*DBASE**2/4.
      IF(LNOSE .GT. UNUSED)FRNOSE=LNOSE/DMAX
      THEOFN=FRNOSE
      IF(LCENTR .GT. UNUSED)FRCENT=LCENTR/DMAX
      THEOFC=FRCENT
      IF(LAFT .GT. UNUSED)FRAFT=LAFT/DMAX
      THEOFA=FRAFT
      IF(LTOTAL .GT. UNUSED)FR=LTOTAL/DMAX
C
      IF(XCVNOS .NE. UNUSED)XCVNOS=XCVNOS-X1V
      IF(XCPNOS .NE. UNUSED)XCPNOS=XCPNOS-X1H
      IF(BCPNOS .NE. UNUSED)BCPNOS=BCPNOS-X1V
      IF(XCVCEN .NE. UNUSED)XCVCEN=XCVCEN-X1V
      IF(XCPCEN .NE. UNUSED)XCPCEN=XCPCEN-X1H
      IF(BCPCEN .NE. UNUSED)BCPCEN=BCPCEN-X1V
      IF(XCVAFT .NE. UNUSED)XCVAFT=XCVAFT-X1V
      IF(XCPAFT .NE. UNUSED)XCPAFT=XCPAFT-X1H
      IF(BCPAFT .NE. UNUSED)BCPAFT=BCPAFT-X1V
      IF(XCENTV .NE. UNUSED)XCENTV=XCENTV-X1V
      IF(XCENTP .NE. UNUSED)XCENTP=XCENTP-X1H
      IF(BCENTP .NE. UNUSED)BCENTP=BCENTP-X1V
      IF(WIDTH(1) .LE. UNUSED)WIDTH(1)=0.
      IF(HEIGHT(1) .LE. UNUSED)HEIGHT(1)=0.
C
C***  CONVERT RESULTS TO INPUT UNITS FOR OUTPUT
C
      IF(.NOT.(LDIMIN .OR. LDIMCM .OR. LDIMM))GO TO 1220
C
         CALL CVRTFT
C
 1220 CONTINUE
C
      IF(PARTS(1))CALL PRIELL(ITYPE)
C
C***  CONVERT RESULTS TO UNITS OF FEET FOR PROGRAM CALCULATIONS
C
      IF(.NOT.(LDIMIN .OR. LDIMCM .OR. LDIMM))GO TO 1230
C
         CALL CVRTUS
C
 1230 CONTINUE
C
C***  SET DEFAULT REFERENCE QUANTITIES
C
      IF(SREF .EQ. 0. .OR. SREF .EQ. UNUSED)SREF=SMAX
      IF(LREF .EQ. 0. .OR. LREF .EQ. UNUSED)LREF=DMAX
      IF(LATREF .EQ. 0. .OR. LATREF .EQ. UNUSED)LATREF=LREF
C
 1240 FORMAT(4X,'* WARNING * THE NOSE IS TOO SHORT',
     1 ' TO USE THE SHAPE SPECIFIED.',/,16X,'A CONICAL SEGMENT',
     2 ' HAS BEEN ASSUMED.')
 1250 FORMAT(4X,'* WARNING * THE AFTERBODY IS TOO SHORT',
     1 ' TO USE THE SHAPE SPECIFIED.',/,16X,'A CONICAL SEGMENT',
     2 ' HAS BEEN ASSUMED.')
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE INLETG
C
C*** PRINT THE INLET GEOMETRY INPUT BY THE USER
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C  MODIFIED BY K. BURNS, MCDONNELL DOUGLAS
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
C
      REAL INTYPE,NIN,LDIV
      LOGICAL ICOVER
C
      CALL HEADR9
      WRITE(6,100)
C
      CALL CVRTFT
C
      IF(INTYPE .EQ. 1.)WRITE(6,200)
      IF(INTYPE .EQ. 2.)WRITE(6,300)
      IF(INTYPE .EQ. 3.)WRITE(6,400)
      IF (ICOVER) THEN
        WRITE(6,1600)
      ELSE
        WRITE(6,1700)
      ENDIF
      IF (.NOT.ICOVER) THEN
        WRITE(6,1800) RAMANG
      ENDIF
      NUMI=NIN+0.5
      WRITE(6,500) NUMI
      WRITE(6,600)
      WRITE(6,700) (PHI(I),I=1,NUMI)
      WRITE(6,800) XINLT
      IF (INTYPE .EQ. 3.) THEN
        WRITE(6,900)
        WRITE(6,1000) XI(1),WI(1),XI(2),WI(2),XI(3),WI(3),
     1                XI(4),WI(4),XI(5),WI(5)
      ELSE
        WRITE(6,1100)
        WRITE(6,1200) XI(1),WI(1),HI(1),XI(2),WI(2),HI(2),
     1                XI(3),WI(3),HI(3),XI(4),WI(4),HI(4),
     2                XI(5),WI(5),HI(5)
      ENDIF
      IF(HDIV .GT. 0.0)THEN
        WRITE(6,1300) XDIV
        WRITE(6,1400) LDIV
        WRITE(6,1500) HDIV
      ENDIF
C
      CALL CVRTUS
C
  100 FORMAT(31X,'INLET GEOMETRY'/)
  200 FORMAT(/,12X,'INLET IS A TOP MOUNTED TWO-DIMENSIONAL TYPE')
  300 FORMAT(/,12X,'INLET IS A SIDE MOUNTED TWO-DIMENSIONAL TYPE')
  400 FORMAT(/,12X,'INLET IS AN AXISYMMETRIC TYPE')
  500 FORMAT(/,12X,'NUMBER OF INLETS =',I2)
  600 FORMAT(/,12X,'INLET ANGULAR ROLL POSITIONS FROM TOP VERTICAL ',
     1 'CENTER (DEG)',/,17X,'(SAME CONVENTION AS FIN ROLL POSITIONS)')
  700 FORMAT(12X,20(F8.1))
  800 FORMAT(/,12X,'LONGITUDINAL DISTANCE FROM MISSILE NOSE TIP TO',/,
     1         12X,'INLET LEADING EDGE =',F7.2)
  900 FORMAT(/,12X,'INLET POSITIONS RELATIVE TO THE INLET TIP',
     1    /,12X,'    POSITION      LONGITUDINAL        DIAMETER')
 1000 FORMAT(12X,'   INLET TIP',8X,F10.3,6X,F10.3,/,30X,
     1         'COWL LIP LEADING EDGE',1X,F10.3,6X,F10.3,/,32X,
     2           ' MID BODY START',5X,F10.3,6X,F10.3,/,32X,
     3           ' BOATTAIL START',5X,F10.3,6X,F10.3,/,32X,
     4           '  BOATTAIL END',6X,F10.3,6X,F10.3)
 1100 FORMAT(/,19X,'INLET POSITIONS RELATIVE TO THE LEADING EDGE',
     1/,19X,'POSITION            LONGITUDINAL     WIDTH       HEIGHT')
 1200 FORMAT(12X,' TOP LIP LEADING EDGE',5X,F10.3,3X,F10.3,3X,F10.3,/,
     1     12X,' COWL LIP LEADING EDGE ',3X,F10.3,3X,F10.3,3X,F10.3,/,
     2     12X,'    MID BODY START',8X,F10.3,3X,F10.3,3X,F10.3,/,
     3     12X,'    BOATTAIL START',8X,F10.3,3X,F10.3,3X,F10.3,/,
     4     12X,'     BOATTAIL END',9X,F10.3,3X,F10.3,3X,F10.3)
 1300 FORMAT(/,12X,'LONGITUDINAL DISTANCE FROM INLET LEADING EDGE TO',/,
     1      12X,'DIVERTER LEADING EDGE =',F7.2)
 1400 FORMAT(/,12X,'DIVERTER LENGTH =',F7.2)
 1500 FORMAT(/,12X,'HEIGHT OF DIVERTER LEADING EDGE =',F7.2)
 1600 FORMAT(/,12X,'THE INLETS ARE COVERED')
 1700 FORMAT(/,12X,'THE INLETS ARE OPEN')
 1800 FORMAT(/,12X,'EXTERNAL COMPRESSION RAMP ANGLE (DEG) =',F7.2)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE NMLIST(ISEQ,GO,END,KOL,L,NAME,K,IER,SUBED)
C
C***  SUBROUTINE TO TEST SPELLING OF NAMELIST NAMES
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /INPCON/ LOC(11),LEN(11),NLNAME(56)
      COMMON /VARNAM/ LEN1(11),LDM1(11),FLTCON(45),
     1                LEN2( 9),LDM2( 9),REFQ(39),
     2                LEN3(34),LDM3(34),AXIBOD(152),
     3                LEN4(23),LDM4(23),FINSET(113),
     4                LEN5( 6),LDM5( 6),DEFLCT(34),
     5                LEN6(12),LDM6(12),TRIM(59),
     6                LEN7(35),LDM7(35),ELLBOD(152),
     7                LEN8(14),LDM8(14),INLET(47),
     8                LEN9(15),LDM9(15),EXPR(53),
     9                LEN10(11),LDM10(11),ARBBOD(57)
C
      CHARACTER*4 FLTCON,REFQ,AXIBOD,FINSET,DEFLCT,TRIM,ELLBOD,INLET,
     1        EXPR,ARBBOD
C
      DIMENSION KOL(80),IUNSD(6),ILAYER(7,2),LAYLEN(2),IVALUE(2,6),
     1          IVALUF(2,4),NAMES(7,6),NLET(6),LENV(6),NAMFIN(4,4),
     2          NLTFIN(4),LENFIN(4),NINLT(6,3),NNLEN(3),NVINL(2,3),
     3          NVLEN(3),NEXP(6,9),NELEN(9),NES(2,9),NNES(9),
     4          NAMES2(7,7),NLET2(7),LENV2(7),IVALU2(2,7)
      LOGICAL END,GO,SUBED
C
      CHARACTER*4 ILAYER,IUNSD,NAMES,IVALUE,NAMES2,IVALU2,NAMFIN,
     1  KAND,KOL,IVALUF,NINLT,NVINL,NEXP,NES,JUNSD
C
C***  NAME SUBSTITUTION CONSTANTS
C
      DATA ILAYER/'T   ','U   ','R   ','B   ','    ','    ','    ',
     1            'N   ','A   ','T   ','U   ','R   ','A   ','L   '/
      DATA LAYLEN / 4,7 /
C
      DATA IUNSD /'U   ','N   ','U   ','S   ','E   ','D   '/
      DATA NAMES /'C   ','O   ','N   ','I   ','C   ','A   ','L   ',
     1            'O   ','G   ','I   ','V   ','E   ','    ','    ',
     2            'P   ','O   ','W   ','E   ','R   ','    ','    ',
     3            'H   ','A   ','A   ','C   ','K   ','    ','    ',
     4            'K   ','A   ','R   ','M   ','A   ','N   ','    ',
     5            'C   ','O   ','N   ','E   ','    ','    ','    '/
      DATA NLET / 7,5,5,5,6,4 /
      DATA IVALUE/'0   ','.   ','1   ','.   ','2   ',
     1            '.   ','3   ','.   ','4   ','.   ',
     2            '0   ','.   '/
      DATA LENV / 2,2,2,2,2,2 /
C
      DATA NAMES2/'V   ','C   ','Y   ','L   ','    ','    ','    ',
     1            'H   ','C   ','Y   ','L   ','    ','    ','    ',
     2            'L   ','U   ','G   ','    ','    ','    ','    ',
     3            'S   ','H   ','O   ','E   ','    ','    ','    ',
     4            'B   ','L   ','O   ','C   ','K   ','    ','    ',
     5            'F   ','A   ','I   ','R   ','I   ','N   ','G   ',
     6            'C   ','O   ','M   ','P   ','    ','    ','    '/
      DATA NLET2 / 4,4,3,4,5,7,4 /
      DATA IVALU2 /'1   ','.   ','2   ','.   ','3   ','.   ','4   ',
     1             '.   ','5   ','.   ','6   ','.   ','7   ','.   '/
      DATA LENV2 / 2,2,2,2,2,2,2 /
C
      DATA NAMFIN /'H   ','E   ','X   ','    ',
     1             'N   ','A   ','C   ','A   ',
     2             'A   ','R   ','C   ','    ',
     3             'U   ','S   ','E   ','R   '/
      DATA NLTFIN / 3,4,3,4 /
      DATA IVALUF/'0   ','.   ','1   ','.   ','2   ',
     1            '.   ','3   ','.   '/
      DATA LENFIN / 2,2,2,2 /
      DATA NINLT / '2   ','D   ','T   ','O   ','P   ','    ',
     1             '2   ','D   ','S   ','I   ','D   ','E   ',
     2             'A   ','X   ','I   ','    ','    ','    '/
      DATA NNLEN/ 5,6,3 /
      DATA NVINL/ '1   ','.   ',
     1            '2   ','.   ',
     2            '3   ','.   '/
      DATA NVLEN / 2,2,2 /
      DATA NEXP/'B   ','O   ','D   ','Y   ','    ','    ',
     1          'F   ','1   ','    ','    ','    ','    ',
     2          'F   ','2   ','    ','    ','    ','    ',
     3          'F   ','3   ','    ','    ','    ','    ',
     4          'F   ','4   ','    ','    ','    ','    ',
     5          'B   ','F   ','1   ','2   ','3   ','4   ',
     6          'B   ','F   ','1   ','2   ','3   ','    ',
     7          'B   ','F   ','1   ','2   ','    ','    ',
     8          'B   ','F   ','1   ','    ','    ','    '/
      DATA NELEN/ 4,2,2,2,2,6,5,4,3 /
      DATA NES/ '1   ','.   ','2   ','.   ','3   ','.   ',
     1          '4   ','.   ','5   ','.   ','9   ','.   ',
     2          '8   ','.   ','7   ','.   ','6   ','.   '/
      DATA NNES/ 9*2 /
C
C***  PASS CORRECT NAMELIST VARIABLES TO TESTOR FOR NAME
C***  AND SYNTAX VERIFICATION
C
C***  REPLACE UNUSED WITH CONSTANT 1.E-30
C
      CALL SUBNAM(ISEQ,KOL,IUNSD,6,1,6,JUNSD,6,6,SUBED)
C
      IF(IER .EQ. 1) NAME = 1
      IF(NAME .LE. 0 .OR. NAME .GT. 11)GO TO 1000
      GO TO (1000,1000,1010,1020,1030,1040,1050,1060,1070,1080,1085)
     1       ,NAME
C
C***  TEST FLTCON NAMELIST
C
 1000 CALL TESTOR(ISEQ,GO,END,KOL,L,NAME,K,
     1 IER,LEN1,LDM1,11,FLTCON,45,SUBED)
      GO TO 1090
C
C***  TEST REFQ NAMELIST
C
 1010 CONTINUE
      CALL SUBNAM(ISEQ,KOL,ILAYER,7,2,LAYLEN,IVALUE,2,LENV,SUBED)
      CALL TESTOR(ISEQ,GO,END,KOL,L,NAME,K,
     1 IER,LEN2,LDM2, 9,REFQ,39,SUBED)
      GO TO 1090
C
C***  TEST AXIBOD NAMELIST
C
 1020 CALL CHKEND(KOL,KAND,END)
      CALL SUBNAM(ISEQ,KOL,NAMES,7,6,NLET,IVALUE,2,LENV,SUBED)
      CALL SUBNM2(ISEQ,KOL,NAMES2,7,7,NLET2,IVALU2,2,LENV2,SUBED)
      CALL TESTOR(ISEQ,GO,END,KOL,L,NAME,K,
     1 IER,LEN3,LDM3,34,AXIBOD,152,SUBED)
      GO TO 1090
C
C***  TEST FINSET NAMELIST
C
 1030 CALL CHKEND(KOL,KAND,END)
      CALL SUBNAM(ISEQ,KOL,NAMFIN,4,4,NLTFIN,IVALUF,2,LENFIN,SUBED)
      CALL TESTOR(ISEQ,GO,END,KOL,L,NAME,K,
     1 IER,LEN4,LDM4,23,FINSET,113,SUBED)
      GO TO 1090
C
C***  TEST DEFLCT NAMELIST
C
 1040 CALL CHKEND(KOL,KAND,END)
      CALL TESTOR(ISEQ,GO,END,KOL,L,NAME,K,
     1 IER,LEN5,LDM5, 6,DEFLCT,34,SUBED)
      GO TO 1090
C
C***  TEST TRIM NAMELIST
C
 1050 CALL CHKEND(KOL,KAND,END)
      CALL TESTOR(ISEQ,GO,END,KOL,L,NAME,K,
     1 IER,LEN6,LDM6,12,TRIM,59,SUBED)
      GO TO 1090
C
C***  TEST ELLBOD NAMELIST
C
 1060 CALL CHKEND(KOL,KAND,END)
      CALL SUBNAM(ISEQ,KOL,NAMES,7,6,NLET,IVALUE,2,LENV,SUBED)
      CALL SUBNM2(ISEQ,KOL,NAMES2,7,7,NLET2,IVALU2,2,LENV2,SUBED)
      CALL TESTOR(ISEQ,GO,END,KOL,L,NAME,K,
     1 IER,LEN7,LDM7,35,ELLBOD,152,SUBED)
      GO TO 1090
C
C***  TEST INLET NAMELIST
C
 1070 CALL CHKEND(KOL,KAND,END)
      CALL SUBNAM(ISEQ,KOL,NINLT,6,3,NNLEN,NVINL,2,NVLEN,SUBED)
      CALL TESTOR(ISEQ,GO,END,KOL,L,NAME,K,IER,LEN8,LDM8,14,
     1            INLET,47,SUBED)
      GO TO 1090
C
C***  TEST EXPR NAMELIST
C
 1080 CALL CHKEND(KOL,KAND,END)
      CALL SUBNAM(ISEQ,KOL,NEXP,6,9,NELEN,NES,2,NNES,SUBED)
      CALL TESTOR(ISEQ,GO,END,KOL,L,NAME,K,
     1 IER,LEN9,LDM9,15,EXPR,53,SUBED)
      GO TO 1090
C
C***  TEST PROTUB NAMELIST
C
 1085 CALL CHKEND(KOL,KAND,END)
      CALL SUBNM2(ISEQ,KOL,NAMES2,7,7,NLET2,IVALU2,2,LENV2,SUBED)
      CALL TESTOR(ISEQ,GO,END,KOL,L,NAME,K,
     1 IER,LEN10,LDM10,11,ARBBOD,57,SUBED)
C
 1090 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE REPTCT(ICONST, IREPT, IERR)
C
C***  LOOK FOR REPEAT COUNT ON A CONSTANT.  DEFAULT IS 1.
C
      CHARACTER*4 BLANK,STAR,ITCON,ICONST
C
      DIMENSION ICONST(80),ITCON(80)
C
      DATA STAR  / '*   ' /
      DATA BLANK / '    ' /
C
      IERR=0
      IREPT=1
C
      DO 1000 I=1,80
         ITCON(I)=BLANK
 1000 CONTINUE
C
C***  LOOK FOR *
C
      ICOL=1
      CALL FINDCH(ICONST, STAR, ICOL)
C
      IF(ICOL .LT. 81)GO TO 1010
C
      GO TO 1030
C
C***  BACKUP AND EXTRACT TO *
C
 1010 ICOL=ICOL-1
      CALL EXTRST(ICONST, 1, ICOL, ITCON)
C
C***  CONVERT COUNT TO INTEGER
C
      CALL TOINT(ITCON, IRR, IERR)
      IF(IRR .NE. 0)IREPT=IRR
C
C***  REMOVE REPEAT COUNT FROM STRING
C
      ICOL=ICOL+2
      J=1
      DO 1020 I=ICOL,80
         ICONST(J)=ICONST(I)
         J=J+1
 1020 CONTINUE
C
 1030 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SUBNAM(ISEQ,CARD,NAMES,MAXLET,NNAM,NLET,VALUES,MAXLV,
     1 LENV,SUBED)
C
C***  SUBROUTINE TO SUBSTITUTE A STRING OF LETTERS IN AN INPUT CARD
C***  WITH ANOTHER CONSTANT IF IT FOLLOWS AND EQUALS SIGN
C
C***  INPUTS
C
C   CARD -- THE INPUT CARD (80 COLUMNS)
C  NAMES -- THE NAMES TO BE CHANGED (A TWO-DIMENSIONAL ARRAY)
C MAXLET -- MAXIMUM NUMBER OF LETTERS IN ANY ONE NAME
C   NNAM -- NUMBER OF NAMES TO BE CHECKED
C   NLET -- NUMBER OF LETTERS IN EACH NAME (AN ARRAY)
C VALUES -- VALUES TO BE SUBSTITUTED (A TWO-DIMENSIONAL ARRAY)
C  MAXLV -- MAXIMUM NUMBER OF LETTERS IN SUBSTITUTION VALUES
C   LENV -- NUMBER OF CHARACTERS IN EACH SUBSTITUTED VALUE (AN ARRAY)
C
C***  OUTPUT
C
C   CARD -- THE NEW CARD IMAGE
C
C***  OTHER ROUTINES CALLED -- NONE
C
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      CHARACTER*4 IBLNK,IEQL,ICOL,CARD,VALUES,NAMES
C
C     INTEGER CARD(80),VALUES(MAXLV,NNAM)
      DIMENSION CARD(80),VALUES(MAXLV,NNAM)
      LOGICAL SKIPPR,EQUALS,SUBED
      DIMENSION ICOL(80),NAMES(MAXLET,NNAM),NLET(NNAM),LENV(NNAM)
      DATA IBLNK / '    ' /
      DATA IEQL / '=   ' /
C
C***  FILL THE NEW CARD WITH BLANKS
C
      DO 1000 I=1,80
         ICOL(I)=IBLNK
 1000 CONTINUE
      INUM=0
      ISKIP=0
      SKIPPR=.FALSE.
      EQUALS=.FALSE.
C
C***  MOVE ALONG THE CARD BY COLUMNS
C
      DO 1060 I=1,80
         IM1=I-1
         IF(I.LE.ISKIP)GO TO 1060
         INUM=INUM+1
         ICOL(INUM)=CARD(I)
C
C***  IF EQUALS SIGN, LOOK FOR NON-BLANK CHARACTER
C
         IF(EQUALS .AND. CARD(I).EQ.IBLNK)GO TO 1060
C
C***  IF EQUALS SIGN SEEN, CHECK FOR NAME
C
         IF(EQUALS)GO TO 1010
C
C***  LOOK FOR EQUALS SIGN
C
         IF(CARD(I).NE.IEQL)GO TO 1060
         EQUALS=.TRUE.
         GO TO 1060
C
C***  CHECK EACH NAME INPUT
C
 1010    EQUALS=.FALSE.
         DO 1050 N=1,NNAM
            NN=N
            KLEN=NLET(N)
C
C***  CHECK EACH LETTER IN THE NAME
C
            DO 1020 K=1,KLEN
                KPIM1=K+IM1
                IF(CARD(KPIM1).NE.NAMES(K,N))GO TO 1050
 1020       CONTINUE
C
C***  NAME FOUND, SUBSTITUTE NEW STRING AND SKIP REST OF CHARACTERS
C
            MAXK=LENV(NN)
            K1=IM1+1
            K2=KLEN+IM1
            IF(SKIPPR)GO TO 1030
            IF(PARTS(17))WRITE(6,1090)ISEQ,(CARD(K),K=1,80),
     1      (CARD(K),K=K1,K2)
 1030       IF(SKIPPR.AND.PARTS(17))WRITE(6,1100)(CARD(K),K=K1,K2)
            SKIPPR=.TRUE.
            INUMM1=INUM-1
            DO 1040 K=1,MAXK
               KK=K+INUMM1
               ICOL(KK)=VALUES(K,NN)
 1040       CONTINUE
            INUM=INUM+MAXK-1
            ISKIP=I+KLEN-1
            GO TO 1060
 1050    CONTINUE
 1060 CONTINUE
C
C***  IF ISKIP .EQ. 0, THEN NO SUBSTITUTION HAS BEEN MADE -- EXIT
C
      IF(ISKIP.EQ.0)GO TO 1080
C
C***  PACK NEW CARD IMAGE INTO OLD
C
      DO 1070 I=1,80
         CARD(I)=ICOL(I)
 1070 CONTINUE
      SUBED=.TRUE.
 1080 CONTINUE
 1090 FORMAT(1X,I3,1X,80A1,/,14X,' ** SUBSTITUTING NUMERIC FOR NAME ',
     1 10A1)
 1100 FORMAT(14X,' ** SUBSTITUTING NUMERIC FOR NAME ',10A1)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WRFIN1
C
C***  WRITE FINSET1 INPUTS
C
      COMMON /FSET1/ AA(399)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION NLNAME(7),IVNAME(113),LEN(23),IDIM(23),LOC(23)
C
      DATA NLNAME /  'F   ','I   ','N   ','S   ','E   ','T   ','1   '/
      DATA IVNAME /  'S   ','E   ','C   ','T   ','Y   ','P   ','S   ',
     1 'S   ','P   ','A   ','N   ','L   ','M   ','A   ','X   ','U   ',
     2 'L   ','F   ','L   ','A   ','T   ','U   ','L   ','M   ','A   ',
     3 'X   ','L   ','L   ','F   ','L   ','A   ','T   ','L   ','C   ',
     4 'H   ','O   ','R   ','D   ','Z   ','U   ','P   ','P   ','E   ',
     5 'R   ','Z   ','L   ','O   ','W   ','E   ','R   ','S   ','W   ',
     6 'E   ','E   ','P   ','S   ','T   ','A   ','X   ','L   ','E   ',
     7 'N   ','P   ','A   ','N   ','E   ','L   ','X   ','C   ','O   ',
     8 'R   ','D   ','M   ','E   ','A   ','N   ','T   ','H   ','I   ',
     9 'C   ','K   ','Y   ','U   ','P   ','P   ','E   ','R   ','Y   ',
     A 'L   ','O   ','W   ','E   ','R   ','F   ','I   ','N   ','P   ',
     B 'H   ','I   ','L   ','E   ','R   ','G   ','A   ','M   ','P   ',
     C 'H   ','I   ','F   ','C   ','F   ','O   ','C   '/
      DATA IDIM   / 1,10,10,10,10,10,10,10,10,10,10,10,1,50,50,50,50,
     1              50,1,10,8,8,10 /
      DATA LEN    / 6,5,5,6,5,6,5,6,6,5,3,3,6,5,4,5,6,6,6,3,3,4,4 /
      DATA LOC    / 1,2,12,22,32,42,52,62,72,82,92,102,112,113,163,213,
     1              263,313,363,364,374,382,390 /
C
      CALL NAMEW(KAND,6,NLNAME,7,IVNAME,113,LEN,23,IDIM,AA,399,LOC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE AXZU(RLE, T, C, SWP, XU, ZU, DZDX, XM, ZM, RR)
C
C     CALCULATE THE INTERSECTION POINT OF THE ELLIPTICAL NOSE
C     CAP AND CIRCULAR ARC SURFACE AND LOCATION OF POINT WHERE
C     LOCAL SLOPE IS 15 DEG.
C
C     INPUT VARIABLES
C         RLE - L.E. RADIUS
C           T - THICKNESS
C           C - CHORD OF WEDGE
C         SWP - SWEEP ANGLE, DEG.
C
C     OUTPUT VARIABLES
C          XU - X-LOCATION OF INTERSECTION
C          ZU - Z-LOCATION OF INTERSECTION
C        DZDX - SURFACE SLOPE AT INTERSECTION
C          XM - X-LOCATION WHERE SLOPE IS 15 DEG.
C          ZM - Z-LOCATION WHERE SLOPE IS 15 DEG.
C          RR - CIRCULAR ARC RADIUS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      CS = COS(SWP/RAD)
      C2 = C/2.0
      XU = 0.0
      ZU = RLE
      DO 10 I=1,15
        FR  = (C2-XU)/(T-2.0*ZU)
        RR  = (T-2.0*ZU)*(FR**2+0.25)
        DEL = ASIN((C2-XU)/RR)
        TD = TAN(DEL)
        GG = SQRT(TD*TD/(CS*CS+TD*TD))
        XU2 = RLE*(1.0-GG)/CS
        ZU = RLE*CS*GG/TD
        IF(ABS(XU-XU2) .LT. 1.E-6) GO TO 20
        XU = XU2
   10 CONTINUE
   20 CONTINUE
      XU   = XU2
      DZDX = TD
C
      TM = TAN(15.0/RAD)
      GG = SQRT(TM*TM/(CS*CS+TM*TM))
      XM = RLE*(1.0-GG)/CS
      ZM = RLE*CS*GG/TM
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BODYCN(IM,CNAN,CNAC,CNABT)
C
C***  EXECUTIVE SUBROUTINE TO COMPUTE THE NORMAL FORCE OF BODIES
C
C***  INPUT
C
C     IM -- MACH NUMBER INDEX
C
C***  OUTPUTS
C
C   CNAN -- NOSE NORMAL FORCE SLOPE, PER RADIAN
C   CNAC -- CENTERBODY NORMAL FORCE SLOPE, PER RADIAN
C  CNABT -- BOATTAIL/FLARE NORMAL FORCE SLOPE, PER RADIAN
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      REAL NALPHA,NMACH,MACH
C
      COMMON /TOTALC/ BALPHA(20),BBETA(20),BPHI(20),ALPTOT(20)
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
C
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     1                TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,
     2                POWER,DISCON(20),ADUM(748)
      REAL NX,LNOSE,LCENTR,LAFT
      LOGICAL TRUNC
C
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     1  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     2  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     3  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     4                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,GDUM(12)
      REAL LTOTAL
C
      COMMON /SBODY/ CNB(20),CMB(20),CAB(20),CYB(20),CLNB(20),CLLB(20),
     1               CNAB(20),CMAB(20),CYBB(20),CNBB(20),CLBB(20)
C
      COMMON /BDWORK/  CNP(20),CMP(20),CNVIS(20),CMVIS(20),CAPR(20),
     &                 CAF(20),CABASE(20),ETA,CDC(20),CAPROT(20),
     &                 BOTDCA(20),BOTDCN(20),BOTDCM(20)
      COMMON /XRBLNT/ XTEMP(50),RTEMP(50),NXTEMP,VNTEMP,SWTEMP,ITYPE
C
      CNAN=0.
      CNAC=0.
      CNABT=0.
      IF(ITYPE.EQ.1) GO TO 500
C
C***  POTENTIAL CN SLOPE
C
C ... NOSE - CENTERBODY
C
      FRCNA = FRCENT + FRAFT
      CALL BDCNAN(TNOSE,MACH(IM),THEOFN,FRCNA,CNAN)
      CNAN=CNAN*PI*DNOSE**2/4./SREF
C
C ... BOATTAIL/FLARE INCREMENT
C
      DFWD=DNOSE
      IF(LCENTR .GT. UNUSED)DFWD=DCENTR
C
      IF(LAFT .GT. UNUSED .AND. DAFT .LT. DFWD)
     1 CALL BDCNAB(MACH(IM),DBASE,DFWD,CNABT)
      IF(LAFT .GT. UNUSED .AND. DAFT .GT. DFWD)
     1 CALL BDCNAF(DFWD,DAFT,CNABT)
      CNABT=CNABT*PI*DFWD**2/4./SREF
C
C ... TOTAL
C
      CNALP=CNAN+CNAC+CNABT
      IF(CNALP .LT. 0.) CNALP=0.
      GO TO 600
  500 CONTINUE
C
C  FOR USER DEFINED BODIES (X,R) CALCULATE POTENTIAL CN-ALPHA
C
      CALL SUBPTS(NX,X,R,MACH(IM),CNALP,CMNCB)
  600 CONTINUE
C
C***  COMPUTE CROSS FLOW DRAG PROPORTIONALITY FACTOR
C***  USING EFFECTIVE BODY FINENESS RATIO
C
      CALL GETETA(LTOTAL**2/SPLAN,MACH(IM),ETA)
C
C***  ANGLE OF ATTACK LOOP
C
      NALP=NALPHA+0.5
      DO 1000 I=1,NALP
C
C***     POTENTIAL CN
C
         CALL BDCNP(CNALP,ALPTOT(I),CNP(I))
C
C***     VISCOUS CN
C
C        COMPUTE CROSS FLOW DRAG COEFFICIENT
C        USING EFFECTIVE DIAMETER
C
         CALL CDCS(ALPTOT(I),REN(IM),SPLAN/LTOTAL,MACH(IM),CDC(I))
C
C        VISCOUS COMPONENT AT ANGLE OF ATTACK
C
         CALL BDCNV(ALPTOT(I),CDC(I),ETA,SPLAN,SREF,CNVIS(I))
C
C***     TOTAL NORMAL FORCE
C
         CNB(I)=(CNP(I)+CNVIS(I))*COS(BPHI(I)/RAD)
         CYB(I)=-(CNP(I)+CNVIS(I))*SIN(BPHI(I)/RAD)
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CORD4M(X,XU,XL,YUN,YLN,L,I,J,K,II,JJ,KK,III,JJJ,
     1 THN,CAM,RHO,T)
C
C*****
C***** CALCULATE NACA FOUR DIGIT (MODIFIED) AIRFOIL COORDINATES
C*****
C
C  ROUTINE ADAPTED FROM DIGITAL DATCOM
C  ORIGINAL ROUTINE WRITTEN BY D. KINSEY, D. BOWERS, AFFDL
C  MODIFIED BY S.R. VUKELICH, MCDONNELL DOUGLAS
C
      DIMENSION X(50),XU(50),XL(50),YUN(50),YLN(50),THN(50),CAM(50)
C
      COMMON /CONST/ PI,RAD,UNUSED,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)
C
C ... COMPUTE COORDINATES ALONG CHORD
C
      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 CONTINUE
      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
c *************************************
c *************************************
c *************************************
      FUNCTION DSWETE(NPTS,X,A,B)
C
C** FUNCTION TO COMPUTE THE WETTED AREA OF AN ELLIPTICAL SEGMENT
C
C** INPUTS
C
C   NPTS -- NUMBER OF INPUTS
C      X -- X STATION
C      A -- HORIZONTAL AXIS AT EACH X STATION
C      B -- VERTICAL AXIS AT EACH X STATION
C
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION TA(100), TB(100), TX(100), XMAJOR(50), XMINOR(50)
      DIMENSION X(NPTS),A(NPTS),B(NPTS),CAYSQ(50),R(2),XL(2),XSTA(50)
      LOGICAL SWITCH
C
C** STORE INPUT PARAMETERS TO BE MANIPULATED
C
      SWITCH=.FALSE.
C
      DO 1000 II=1,NPTS
         IF(A(II) .EQ. B(II))GO TO 1000
         IF(A(II) .LT. B(II))SWITCH=.TRUE.
         GO TO 1010
 1000 CONTINUE
C
 1010 CONTINUE
C
      DO 1020 II=1,NPTS
         IN=II*2-1
         TA(IN)=A(II)
         TB(IN)=B(II)
         IF(SWITCH)TA(IN)=B(II)
         IF(SWITCH)TB(IN)=A(II)
         TX(IN)=X(II)
         TA(IN+1)=-9999.
         TB(IN+1)=-9999.
         TX(IN+1)=-9999.
 1020 CONTINUE
      NPTS2=NPTS*2-1
C
C** LOOK FOR POSSIBLE MAJOR AXIS SHIFT (EX: HORIZ. AXIS TO VERT. AXIS)
C
      DO 1050 J=3,NPTS2,2
         IF(TB(J) .LE. TA(J)) GO TO 1050
C
C** COMPUTE A=B POINT AND PUT IN A DUMMY ARGUMENT (-9999.) LOCATION
C
 1030    SLOPE=(TB(J)-TB(J-2))/(TA(J)-TA(J-2))
         YINT=TB(J)-SLOPE*TA(J)
         XPOS=YINT/(1.-SLOPE)
         TA(J-1)=XPOS
         TB(J-1)=XPOS
         TX(J-1)=TX(J-2)+(TX(J)-TX(J-2))*ABS((TA(J-1)-TA(J-2))/
     1           (TA(J)-TA(J-2)))
C
C** SWITCH REST OF TA & TB PARAMETERS TO REFLECT AXIS SHIFT
C
        DO 1040 K=J,NPTS2,2
           TEMP=TA(K)
           TA(K)=TB(K)
           TB(K)=TEMP
 1040   CONTINUE
 1050 CONTINUE
C
C** REMOVE DUMMY ARRAY ELEMENTS (-9999.)
C
      NN=0
      DO 1060 M=1,NPTS2
         IF(TA(M) .EQ. -9999.) GO TO 1060
         NN=NN+1
         XMAJOR(NN)=TA(M)
         XMINOR(NN)=TB(M)
         XSTA(NN)=TX(M)
 1060 CONTINUE
C
      CAYSQ(1)=0.
      DSWETE=0.0
      IF(XMAJOR(1).NE.0.) CAYSQ(1)=1.-XMINOR(1)**2/XMAJOR(1)**2
      DO 1080 JJ=2,NN
         IF(XMAJOR(JJ).NE.0.) CAYSQ(JJ)=1.-XMINOR(JJ)**2/XMAJOR(JJ)**2
         IF(XMAJOR(JJ).EQ.0.) CAYSQ(JJ)=1.-XMINOR(JJ-1)**2/
     1                                  XMAJOR(JJ-1)**2
         IF(CAYSQ(JJ).EQ.CAYSQ(JJ-1)) GO TO 1070
         XL(1)=XSTA(JJ-1)
         XL(2)=XSTA(JJ)
         IF(XL(1) .EQ. XL(2))GO TO 1080
         R(1)=XMAJOR(JJ-1)
         R(2)=XMAJOR(JJ)
         XCENP=(DXCENP(2,XL,R)-XSTA(JJ-1))/(XSTA(JJ)-XSTA(JJ-1))
         XLMIN=XMINOR(JJ-1)-XMINOR(JJ)
         XLMAJ=XMAJOR(JJ-1)-XMAJOR(JJ)
         CAYSQ(JJ)=1.-(XCENP*XLMIN+XMINOR(JJ))**2/
     1             (XCENP*XLMAJ+XMAJOR(JJ))**2
 1070    E=ELLIP2(CAYSQ(JJ))
         DSWETE=DSWETE+2.*E*SQRT((XMAJOR(JJ)-XMAJOR(JJ-1))**2+
     1          (XSTA(JJ)-XSTA(JJ-1))**2)*
     2          (XMAJOR(JJ)+XMAJOR(JJ-1))
 1080 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FCNATR(XM,AR,TR,SWAV50,CLA,XCPCB)
C ***
C *** THIS SUBROUTINE COMPUTES FIN ALONE TRANSONIC LIFT CURVE
C *** SLOPE FOR TWO PANELS(EXPOSED PLANFORM).
C ***
C *** REFERENCE      BRITISH DATA SHEETS  S.01.03.06
C ***                                     S.01.03.05
C ***                                     S.01.03.04
C ***                                     S.01.03.03
C ***                                     S.08.01.02
C *** INPUTS
C ***
C *** XM    = FREE STREAM MACH NO.
C *** AR    = EXPOSED FIN ASPECT RATIO OF TWO PANELS
C *** TR    = EXPOSED TAPER RATIO
C *** SWAV50= WING MID-CHORD SWEEPBACK ANGLE (DEG)
C ***
C *** OUTPUTS
C ***
C *** CLA   = LIFT COEFF. SLOPE, BASED ON EXPOSED FIN AREA  1/DEG.
C *** XCPCB = CENTER OF PRESSURE (PERCENT MEAN GEOMETERIC CHORD),
C ***         MEASURED FROM LEADING EDGE MEAN GEOMETERIC CHORD.
C ***
C ***
      COMMON /CONST/PI,RAD,UNUSED,KAND
C
      DIMENSION XT1(15),YT1(7),ZT1(4),XT2(8),YT2(5),ZT2(4),YT4(7)
      DIMENSION BAR1(420), BAR2(160),BAR3(420),BAR4(224)
      DIMENSION BAR1A(105),BAR1B(105),BAR1C(105),BAR1D(105)
      DIMENSION BAR3A(105),BAR3B(105),BAR3C(105),BAR3D(105)
C
      EQUIVALENCE (BAR1(1),BAR1A(1)) , (BAR1(106),BAR1B(1)),
     .            (BAR1(211),BAR1C(1)) , (BAR1(316),BAR1D(1))
      EQUIVALENCE (BAR3(1),BAR3A(1)) , (BAR3(106),BAR3B(1)),
     .            (BAR3(211),BAR3C(1)) , (BAR3(316),BAR3D(1))
C
      DATA XT1/0.,.5,1.,1.5,2.,2.5,3.,3.5,4.,4.5,5.,5.5,6.,6.5,7./
      DATA YT1/0.,1.,2.,3.,4.,5.,6./
      DATA ZT1/0.,.25,.5,1./
      DATA XT2/0.,1.,2.,3.,4.,5.,6.,7./
      DATA YT2/0.,1.,2.,3.,4./
      DATA YT4/0.,1.,2.,3.,4.,5.,6./
      DATA ZT2/0.,.25,.5,1./
C
      DATA BAR1A /
     1 1.560, 1.520, 1.410, 1.300, 1.200, 1.110, 1.030,  .950,
     2  .890,  .830,  .780,  .740,  .700,  .660,  .630, 1.560,
     3 1.520, 1.400, 1.270, 1.170, 1.080, 1.000,  .930,  .870,
     4  .820,  .770,  .730,  .690,  .650,  .620, 1.560, 1.470,
     5 1.300, 1.170, 1.080, 1.010,  .950,  .890,  .840,  .790,
     6  .750,  .710,  .670,  .640,  .610, 1.260, 1.210, 1.130,
     7 1.050,  .990,  .930,  .880,  .830,  .790,  .750,  .710,
     8  .680,  .650,  .620,  .590, 1.050, 1.010,  .980,  .940,
     9  .890,  .850,  .810,  .770,  .730,  .700,  .670,  .640,
     A  .610,  .590,  .570,  .900,  .880,  .860,  .830,  .800,
     B  .770,  .740,  .710,  .680,  .660,  .630,  .610,  .590,
     C  .570,  .550,  .790,  .780,  .770,  .750,  .730,  .700,
     D  .680,  .650,  .630,  .610,  .590,  .570,  .550,  .530,
     E  .520 /
      DATA BAR1B /
     1 1.570, 1.530, 1.450, 1.340, 1.250, 1.160, 1.070, 1.000,
     2  .930,  .875,  .820,  .780,  .735,  .695,  .660, 1.570,
     3 1.530, 1.420, 1.310, 1.200, 1.110, 1.030,  .970,  .910,
     4  .860,  .810,  .765,  .720,  .685,  .650, 1.570, 1.450,
     5 1.310, 1.205, 1.120, 1.050,  .980,  .925,  .870,  .820,
     6  .780,  .740,  .700,  .665,  .630, 1.260, 1.190, 1.120,
     7 1.060, 1.000,  .950,  .900,  .850,  .810,  .770,  .740,
     8  .700,  .670,  .640,  .610, 1.050, 1.000,  .960,  .920,
     9  .885,  .860,  .830,  .790,  .760,  .725,  .690,  .665,
     A  .640,  .610,  .590,  .900,  .855,  .820,  .800,  .780,
     B  .760,  .740,  .720,  .700,  .670,  .640,  .620,  .600,
     C  .570,  .550,  .790,  .750,  .730,  .710,  .700,  .680,
     D  .670,  .650,  .640,  .620,  .600,  .580,  .560,  .550,
     E  .530 /
      DATA BAR1C /
     1 1.580, 1.530, 1.450, 1.350, 1.250, 1.160, 1.070, 1.000,
     2  .930,  .880,  .820,  .780,  .730,  .690,  .660, 1.580,
     3 1.520, 1.420, 1.310, 1.210, 1.120, 1.040,  .980,  .915,
     4  .860,  .805,  .760,  .720,  .680,  .640, 1.580, 1.440,
     5 1.320, 1.200, 1.120, 1.050,  .980,  .920,  .870,  .820,
     6  .780,  .740,  .700,  .760,  .630, 1.260, 1.200, 1.130,
     7 1.060, 1.010,  .960,  .900,  .850,  .810,  .770,  .740,
     8  .700,  .660,  .630,  .600, 1.050, 1.010,  .970,  .930,
     9  .890,  .850,  .820,  .780,  .750,  .720,  .680,  .660,
     A  .630,  .600,  .580,  .900,  .870,  .840,  .810,  .790,
     B  .760,  .730,  .710,  .680,  .660,  .640,  .620,  .590,
     C  .570,  .550,  .790,  .760,  .740,  .710,  .690,  .670,
     D  .660,  .640,  .620,  .600,  .590,  .570,  .550,  .540,
     E  .520 /
      DATA BAR1D /
     1 1.570, 1.520, 1.450, 1.340, 1.220, 1.120, 1.040,  .970,
     2  .900,  .840,  .770,  .740,  .700,  .670,  .640, 1.570,
     3 1.510, 1.420, 1.300, 1.180, 1.080, 1.000,  .940,  .880,
     4  .820,  .780,  .730,  .690,  .650,  .630, 1.570, 1.480,
     5 1.360, 1.220, 1.100, 1.020,  .950,  .880,  .820,  .780,
     6  .730,  .690,  .660,  .630,  .610, 1.270, 1.170, 1.100,
     7 1.120,  .960,  .910,  .860,  .810,  .770,  .730,  .690,
     8  .660,  .630,  .600,  .580, 1.060,  .990,  .940,  .890,
     9  .840,  .810,  .780,  .740,  .710,  .680,  .650,  .620,
     A  .600,  .580,  .560,  .910,  .850,  .800,  .770,  .740,
     B  .720,  .700,  .680,  .650,  .620,  .600,  .580,  .560,
     C  .550,  .540,  .790,  .740,  .700,  .670,  .650,  .630,
     D  .620,  .610,  .590,  .580,  .560,  .540,  .530,  .520,
     E  .500 /
      DATA BAR2 / .265, .270, .273, .275, .274, .273, .270, .268,
     2  .380,  .397,  .327,  .314,  .303,  .295,  .290,  .285,
     3  .500,  .470,  .378,  .352,  .335,  .325,  .318,  .313,
     4  .505,  .445,  .405,  .380,  .365,  .353,  .345,  .340,
     5  .505,  .460,  .440,  .410,  .395,  .383,  .375,  .370,
     6  .145,  .195,  .225,  .240,  .247,  .250,  .250,  .250,
     7  .262,  .265,  .267,  .267,  .267,  .267,  .267,  .267,
     8  .380,  .332,  .305,  .290,  .283,  .282,  .282,  .282,
     9  .395,  .355,  .330,  .315,  .405,  .298,  .295,  .293,
     A  .405,  .385,  .365,  .345,  .325,  .315,  .307,  .303,
     B  .070,  .185,  .225,  .237,  .243,  .245,  .247,  .248,
     C  .177,  .217,  .235,  .243,  .245,  .245,  .245,  .244,
     D  .285,  .247,  .243,  .247,  .250,  .250,  .248,  .247,
     E  .305,  .267,  .257,  .255,  .255,  .255,  .255,  .255,
     F  .317,  .287,  .275,  .270,  .270,  .270,  .270,  .270,
     G 0.000,  .175,  .225,  .237,  .243,  .245,  .245,  .245,
     H  .085,  .120,  .165,  .205,  .220,  .225,  .227,  .230,
     I  .165,  .167,  .170,  .192,  .197,  .205,  .210,  .213,
     J  .193,  .190,  .189,  .190,  .193,  .197,  .200,  .203,
     K  .200,  .197,  .189,  .190,  .193,  .195,  .196,  .198 /
      DATA BAR3A /
     1 1.560, 1.700, 1.760, 1.750, 1.700, 1.430, 1.220, 1.060,
     2  .940,  .850,  .770,  .710,  .650,  .600,  .560, 1.560,
     3 1.735, 1.760, 1.620, 1.480, 1.350, 1.240, 1.090,  .960,
     4  .860,  .780,  .715,  .660,  .610,  .565, 1.560, 1.535,
     5 1.470, 1.395, 1.310, 1.220, 1.140, 1.070, 1.005,  .900,
     6  .805,  .730,  .670,  .620,  .580, 1.260, 1.300, 1.275,
     7 1.233, 1.170, 1.110, 1.050, 1.000,  .945,  .900,  .860,
     8  .775,  .700,  .645,  .600, 1.046, 1.070, 1.085, 1.085,
     9 1.060, 1.023,  .986,  .950,  .900,  .860,  .822,  .790,
     A  .760,  .682,  .635,  .985,  .915,  .930,  .940,  .940,
     B  .930,  .910,  .888,  .855,  .822,  .788,  .760,  .730,
     C  .707,  .682,  .790,  .795,  .800,  .800,  .800,  .802,
     D  .805,  .810,  .810,  .780,  .755,  .730,  .710,  .680,
     E  .661 /
      DATA BAR3B /
     1 1.570, 1.560, 1.850, 1.820, 1.640, 1.410, 1.210, 1.060,
     2  .940,  .845,  .770,  .710,  .650,  .600,  .558, 1.570,
     3 1.500, 1.830, 1.720, 1.585, 1.410, 1.215, 1.065,  .955,
     4  .860,  .780,  .716,  .660,  .610,  .562, 1.570, 1.130,
     5 1.460, 1.460, 1.400, 1.305, 1.220, 1.110,  .985,  .890,
     6  .804,  .730,  .670,  .620,  .572, 1.260, 1.180, 1.100,
     7 1.230, 1.275, 1.200, 1.125, 1.065, 1.015,  .940,  .850,
     8  .772,  .710,  .650,  .600, 1.050, 1.050, 1.050, 1.050,
     9 1.050, 1.050, 1.040, 1.010,  .962,  .920,  .870,  .815,
     A  .740,  .680,  .630,  .900,  .908,  .915,  .923,  .930,
     B  .942,  .950,  .935,  .910,  .875,  .840,  .815,  .780,
     C  .730,  .670,  .790,  .786,  .780,  .780,  .779,  .780,
     D  .785,  .800,  .820,  .830,  .820,  .785,  .755,  .730,
     E  .704 /
      DATA BAR3C /
     1 1.580, 1.880, 1.920, 1.800, 1.590, 1.360, 1.170, 1.030,
     2  .920,  .840,  .750,  .690,  .635,  .590,  .550, 1.580,
     3 1.800, 1.900, 1.760, 1.550, 1.355, 1.180, 1.045,  .935,
     4  .847,  .770,  .705,  .645,  .600,  .560, 1.580, 1.460,
     5 1.350, 1.445, 1.430, 1.320, 1.200, 1.080,  .970,  .870,
     6  .790,  .720,  .660,  .610,  .570, 1.260, 1.250, 1.235,
     7 1.220, 1.260, 1.210, 1.145, 1.080,  .995,  .910,  .830,
     8  .756,  .693,  .640,  .590, 1.050, 1.050, 1.055, 1.055,
     9 1.055, 1.070, 1.050, 1.015,  .970,  .925,  .860,  .800,
     A  .740,  .680,  .630,  .900,  .900,  .902,  .903,  .905,
     B  .907,  .910,  .910,  .900,  .880,  .860,  .830,  .770,
     C  .710,  .670,  .790,  .792,  .800,  .800,  .804,  .810,
     D  .813,  .816,  .820,  .822,  .817,  .798,  .760,  .740,
     E  .690 /
      DATA BAR3D /
     1 1.570, 1.790, 2.000, 1.800, 1.520, 1.290, 1.120,  .985,
     2  .880,  .795,  .720,  .665,  .620,  .575,  .535, 1.570,
     3 1.600, 2.000, 1.720, 1.480, 1.290, 1.130, 1.000,  .900,
     4  .810,  .740,  .680,  .630,  .583,  .545, 1.570, 1.550,
     5 1.520, 1.480, 1.440, 1.290, 1.160, 1.030,  .930,  .835,
     6  .760,  .700,  .645,  .600,  .560, 1.270, 1.300, 1.300,
     7 1.280, 1.240, 1.190, 1.145, 1.050,  .960,  .870,  .800,
     8  .735,  .680,  .625,  .580, 1.060, 1.055, 1.050, 1.040,
     9 1.020,  .995,  .980,  .970,  .970,  .900,  .830,  .765,
     A  .700,  .655,  .610,  .905,  .900,  .885,  .875,  .865,
     B  .860,  .858,  .855,  .853,  .850,  .840,  .785,  .735,
     C  .690,  .650,  .795,  .783,  .780,  .770,  .762,  .760,
     D  .757,  .750,  .750,  .758,  .760,  .770,  .740,  .720,
     E  .710 /
      DATA BAR4 /
     1 .250,.350,.450,.465,.475,.483,.486,.490,.380,.472,.472,.472,
     2 .480,.487,.490,.495,.500,.500,.500,.500,.500,.500,.501,.501,
     3 .505,.540,.540,.540,.540,.540,.525,.520,.505,.542,.580,.580,
     4 .580,.580,.580,.558,.560,.548,.585,.625,.625,.625,.625,.625,
     5 .565,.555,.595,.633,.673,.673,.673,.673,.145,.295,.450,.475,
     6 .485,.490,.495,.495,.267,.350,.437,.473,.483,.487,.492,.493,
     7 .380,.445,.445,.445,.488,.502,.502,.502,.395,.440,.481,.481,
     8 .481,.532,.530,.523,.405,.433,.470,.525,.525,.525,.570,.560,
     9 .413,.407,.503,.550,.520,.520,.520,.615,.425,.450,.477,.510,
     A .560,.625,.625,.625,.070,.210,.450,.477,.485,.490,.493,.493,
     B .177,.270,.365,.457,.475,.482,.485,.485,.285,.360,.385,.415,
     C .480,.485,.485,.485,.305,.355,.400,.435,.465,.511,.510,.505,
     D .317,.323,.326,.460,.487,.501,.593,.537,.330,.320,.310,.425,
     E .505,.523,.550,.585,.337,.315,.300,.423,.500,.560,.580,.605,
     F .000,.330,.445,.465,.475,.483,.485,.485,.085,.310,.400,.440,
     G .455,.465,.470,.470,.165,.290,.380,.425,.448,.458,.467,.475,
     H .193,.300,.390,.433,.457,.470,.477,.477,.200,.330,.423,.465,
     I .485,.493,.496,.495,.200,.330,.423,.465,.485,.493,.496,.495,
     J .200,.330,.423,.465,.485,.493,.496,.495/
C
      X=AR*SQRT(ABS(1.-XM**2))
      Y=AR*TAN(SWAV50/RAD)
      Z=TR
      IF(XM.GT.1.0) GO TO 1000
      CALL MVLOOK(4,7,15,420,ZT1,YT1,XT1,BAR1,X,Y,Z,CLAR)
      CALL MVLOOK(4,5,8,160,ZT2,YT2,XT2,BAR2,X,Y,Z,XCPCB)
      CLA=CLAR*AR/RAD
      GO TO 1010
 1000 CONTINUE
      CALL MVLOOK(4,7,15,420,ZT1,YT1,XT1,BAR3,X,Y,Z,CLAR)
      CALL MVLOOK(4,7,8,224,ZT2,YT4,XT2,BAR4,X,Y,Z,XCPCB)
      CLA=CLAR*AR/RAD
C
 1010 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE GEOFIN
C
C***  SUBROUTINE TO COMPUTE FIN GEOMETRIC DATA
C
      COMMON /FSET1/  FDATA1(399)
      COMMON /FSET2/  FDATA2(399)
      COMMON /FSET3/  FDATA3(399)
      COMMON /FSET4/  FDATA4(399)
C
      COMMON /GEOFS1/ GFIN1(188)
      COMMON /GEOFS2/ GFIN2(188)
      COMMON /GEOFS3/ GFIN3(188)
      COMMON /GEOFS4/ GFIN4(188)
C
      COMMON /INCID/  DELTAS(32),XHINGE(4),SKEW(4)
C
      DIMENSION SSPAN(10),LMAXU(10),LFLATU(10),LMAXL(10),
     1          LFLATL(10),CHORD(10),THICKU(10),THICKL(10),
     2          SWEEP(10),STA(10),XLE(10),
     3          XCORD(50),MEAN(50),THICK(50),YUPPER(50),
     4          YLOWER(50),LER(10)
C
      REAL LER,LMAXU,LMAXL,LFLATU,LFLATL,NPANEL,MEAN
C
      EQUIVALENCE (FDATA1(1),SECTYP),(FDATA1(2),SSPAN(1)),
     1            (FDATA1(12),LMAXU(1)),(FDATA1(22),LFLATU(1)),
     2            (FDATA1(32),LMAXL(1)),(FDATA1(42),LFLATL(1)),
     3            (FDATA1(52),CHORD(1)),(FDATA1(62),THICKU(1)),
     4            (FDATA1(72),THICKL(1)),(FDATA1(82),SWEEP(1)),
     5            (FDATA1(92),STA(1)),(FDATA1(102),XLE(1)),
     6            (FDATA1(112),NPANEL),(FDATA1(113),XCORD(1)),
     7            (FDATA1(163),MEAN(1)),(FDATA1(213),THICK(1)),
     8            (FDATA1(263),YUPPER(1)),(FDATA1(313),YLOWER(1)),
     9            (FDATA1(363),FINPHI),(FDATA1(364),LER(1))
C
      DIMENSION SPLANF(10),CBAR(10),SWEPLE(10),SWEP25(10),
     1          SWEP50(10),SWEP75(10),SWEPTE(10),
     2          XMGCLE(10),XMGC25(10),
     3          XMGC50(10),XMGC75(10),XMGCTE(10),YMEANC(10),
     4          ASPCT(10),TAPER(10),TOVERC(10),XCENT(10)
C
      EQUIVALENCE (GFIN1(1),SPLANF(1)),(GFIN1(11),CBAR(1)),
     1            (GFIN1(21),SWEPLE(1)),(GFIN1(31),SWEP25(1)),
     2            (GFIN1(41),SWEP50(1)),(GFIN1(51),SWEP75(1)),
     3            (GFIN1(61),SWEPTE(1)),(GFIN1(71),XMGCLE(1)),
     4            (GFIN1(81),XMGC25(1)),(GFIN1(91),XMGC50(1)),
     5            (GFIN1(101),XMGC75(1)),(GFIN1(111),XMGCTE(1)),
     6            (GFIN1(121),YMEANC(1)),(GFIN1(131),ASPCT(1)),
     7            (GFIN1(141),TAPER(1)),(GFIN1(151),TOVERC(1)),
     8            (GFIN1(161),XCENT(1)),(GFIN1(171),FINAR),
     9            (GFIN1(172),FINTPR),(GFIN1(173),FINSPN),
     A            (GFIN1(174),FINSP),(GFIN1(175),FINWET),
     B            (GFIN1(176),TCEFF),(GFIN1(177),FINXGC),
     C            (GFIN1(178),FINYGC),(GFIN1(179),SWAVLE),
     D            (GFIN1(180),SWAV25),(GFIN1(181),SWAV50),
     E            (GFIN1(182),SWAV75),(GFIN1(183),SWAVTE),
     F            (GFIN1(184),FINCBR),(GFIN1(185),DELTAY),
     G            (GFIN1(186),DELTAD)
C
      COMMON /CONST/ PI,RAD,UNUSED,DEG
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
C
      REAL LREF,LATREF
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
C***  SCALE INPUT GEOMETRY IF REQUIRED
C
      IF(SCALE .EQ. 0. .OR. SCALE .EQ. UNUSED)SCALE=1.
C
      IF(SCALE .EQ. 1.)GO TO 1010
C
      DO 1000 I=2,111
         IF(I .GE. 12 .AND. I .LE.  51)GO TO 1000
         IF(I .GE. 62 .AND. I .LE. 101)GO TO 1000
         IF(FDATA1(I) .NE. UNUSED)FDATA1(I)=SCALE*FDATA1(I)
         IF(FDATA2(I) .NE. UNUSED)FDATA2(I)=SCALE*FDATA2(I)
         IF(FDATA3(I) .NE. UNUSED)FDATA3(I)=SCALE*FDATA3(I)
         IF(FDATA4(I) .NE. UNUSED)FDATA4(I)=SCALE*FDATA4(I)
 1000 CONTINUE
C
      DO 1005 I=364,373
         IF(FDATA1(I) .NE. UNUSED)FDATA1(I)=SCALE*FDATA1(I)
         IF(FDATA2(I) .NE. UNUSED)FDATA2(I)=SCALE*FDATA2(I)
         IF(FDATA3(I) .NE. UNUSED)FDATA3(I)=SCALE*FDATA3(I)
         IF(FDATA4(I) .NE. UNUSED)FDATA4(I)=SCALE*FDATA4(I)
 1005 CONTINUE
C
      IF(XHINGE(1) .NE. UNUSED)XHINGE(1)=XHINGE(1)*SCALE
      IF(XHINGE(2) .NE. UNUSED)XHINGE(2)=XHINGE(2)*SCALE
      IF(XHINGE(3) .NE. UNUSED)XHINGE(3)=XHINGE(3)*SCALE
      IF(XHINGE(4) .NE. UNUSED)XHINGE(4)=XHINGE(4)*SCALE
C
 1010 CONTINUE
C
C***  COMPUTE GEOMETRIC DATA FOR ALL FIN SETS PRESENT
C
      CALL FGEOM
C
C***  SET REFERENCE QUANTITIES IF ABSENT
C
      IF(SREF .NE. 0. .AND. SREF .NE. UNUSED)GO TO 1020
C
         SREF=GFIN1(174)
         IF(SREF .LT. GFIN2(174))SREF=GFIN2(174)
         IF(SREF .LT. GFIN3(174))SREF=GFIN3(174)
         IF(SREF .LT. GFIN4(174))SREF=GFIN4(174)
C
 1020 IF(LREF .NE. 0. .AND. LREF .NE. UNUSED)GO TO 1030
C
         LREF=GFIN1(184)
         IF(LREF .LT. GFIN2(184))LREF=GFIN2(184)
         IF(LREF .LT. GFIN3(184))LREF=GFIN3(184)
         IF(LREF .LT. GFIN4(184))LREF=GFIN4(184)
C
 1030 CONTINUE
C
      IF(LATREF .EQ. 0. .OR. LATREF .EQ. UNUSED)LATREF=LREF
C
C***  OUTPUT GEOMETRIC RESULTS
C
      CALL PRIFIN
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE INSBLK(KOL,ICOL,ISKP)
C
C***  ROUTINE TO INSERT A BLANK COLUMN IN THE CARD IMAGE AT ICOL
C***  THE REMAINDER OF THE CARD IS SHIFTED TO THE RIGHT
C
C  INPUTS
C
C    KOL -- 80 COLUMN CARD IMAGE
C   ICOL -- COLUMN WHERE BLANK IS TO BE INSERTED
C
C  OUTPUT
C
C   ISKP -- SET TO 1 IF COLUMN 80 IS NOT BLANK
C           WAS SUCCESSFUL IF EQUALS TO 0
C
      CHARACTER*4 IBLANK,KOL,IBUFF
      DIMENSION KOL(80),IBUFF(80)
C
      DATA IBLANK /'    ' /
C
      ISKP=1
C
C***  SKIP IF COLUMN 80 IS NOT BLANK
C
      IF(KOL(80) .NE. IBLANK)GO TO 1030
C
      ICOLM1=ICOL-1
C
C***  RETAIN FIRST ICOL COLUMNS IN BUFFER
C
      DO 1000 I=1,ICOLM1
         IBUFF(I)=KOL(I)
 1000 CONTINUE
C
C***  INSERT BLANK
C
      IBUFF(ICOL)=IBLANK
C
C***  GET THE REST OF THE CARD INTO THE BUFFER
C
      DO 1010 I=ICOL,79
         IBUFF(I+1)=KOL(I)
 1010 CONTINUE
C
C***  WRITE BUFFER OVER PREVIOUS CARD IMAGE
C
      DO 1020 I=1,80
         KOL(I)=IBUFF(I)
 1020 CONTINUE
C
      ISKP=0
C
 1030 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      LOGICAL FUNCTION NMTEST(KOL,KEY,NCHAR)
      DIMENSION KOL(80),KEY(NCHAR)
      CHARACTER*4 KOL,KEY
C
C***  TEST FOR NAME IN KEY = NAME IN KOL, NCHAR = NO. OF CHARACTERS
C
      DO 1000 I=1,NCHAR
         IF(KOL(I).NE.KEY(I)) GO TO 1010
 1000 CONTINUE
C
C***  HERE IF NAME CHECKS
C
      NMTEST=.TRUE.
      GO TO 1020
C
C***  HERE IF NAME DOES NOT CHECK
C
 1010 NMTEST=.FALSE.
 1020 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE REXPR(RMACH,ICONF,IFOUND,XSREF,XLREF,XLATR,XXCG,
     1   XZCG,XNALPH,XALPHA,XCN,XCM,XCA,XCY,XCSN,XCSL)
C
C***  READ EXPERIMENTAL DATA FROM TAPE 2
C
C***  INPUTS
C
C   RMACH - MACH NUMBER DESIRED
C   ICONF - CODE OF CONFIGURATION DESIRED
C           1=BODY, 2=F1,   3=F2,    4=F3,    5=F4,
C           6=BF1,  7=BF12, 8=BF123, 9=BF1234
C
C***  OUTPUTS
C
C   IFOUND - ZERO IF DATA FOUND, ONE IF NOT FOUND
C    XSREF - REFERENCE AREA
C    XLREF - REFERENCE LENGTH
C    XLATR - LAT/DIR REFERENCE LENGTH
C     XXCG - LONGITUDINAL CG
C     XZCG - VERTICAL CG
C   XNALPH - NUMBER OF ANGLES OF ATTACK
C   XALPHA - ANGLES OF ATTACK
C      XCN - NORMAL FORCE COEFFICIENT
C      XCM - PITCHING MOMENT COEFFICIENT
C      XCA - AXIAL FORCE COEFFICIENT
C      XCY - SIDE FORCE COEFFICIENT
C     XCSN - YAWING MOMENT COEFFICIENT
C     XCSL - ROLLING MOMENT COEFFICIENT
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      REAL MACH,NALPHA,LREF,LATREF
C
      LOGICAL IEOF
C
      DIMENSION ALPHA(20),CN(20),CM(20),CA(20),CY(20),CSN(20),CSL(20)
      DIMENSION XALPHA(20),XCN(20),XCM(20),XCA(20),XCY(20),XCSN(20),
     1 XCSL(20)
C
      DIMENSION NLNAME(4),IVNAME(53),LEN(15),IDIM(15),LOC(15),AA(148)
C
      EQUIVALENCE (MACH,AA(1)),(NALPHA,AA(2)),(ALPHA(1),AA(3)),
     1 (SREF,AA(23)),(LREF,AA(24)),(LATREF,AA(25)),(XCG,AA(26)),
     2 (ZCG,AA(27)),(CONF,AA(28)),(CN(1),AA(29)),(CM(1),AA(49)),
     3 (CA(1),AA(69)),(CY(1),AA(89)),(CSN(1),AA(109)),
     2 (CSL(1),AA(129))
C
      DATA NLNAME /  'E   ','X   ','P   ','R   '/
      DATA IVNAME /  'M   ','A   ','C   ','H   ','N   ','A   ','L   ',
     1 'P   ','H   ','A   ','A   ','L   ','P   ','H   ','A   ','S   ',
     2 'R   ','E   ','F   ','L   ','R   ','E   ','F   ','L   ','A   ',
     3 'T   ','R   ','E   ','F   ','X   ','C   ','G   ','Z   ','C   ',
     4 'G   ','C   ','O   ','N   ','F   ','C   ','N   ','C   ','M   ',
     5 'C   ','A   ','C   ','Y   ','C   ','S   ','N   ','C   ','S   ',
     6 'L   '/
      DATA IDIM   / 1,1,20,1,1,1,1,1,1,20,20,20,20,20,20 /
      DATA LEN    / 4,6,5,4,4,6,3,3,4,2,2,2,2,3,3 /
      DATA LOC    / 1,2,3,23,24,25,26,27,28,29,49,69,89,109,129 /
C
      IFOUND=1
C
 1000 MACH=UNUSED
      NALPHA=UNUSED
      SREF=UNUSED
      LREF=UNUSED
      LATREF=UNUSED
      XCG=UNUSED
      ZCG=UNUSED
      CONF=UNUSED
      DO 1010 I=1,20
         ALPHA(I)=UNUSED
         CN(I)=UNUSED
         CM(I)=UNUSED
         CA(I)=UNUSED
         CY(I)=UNUSED
         CSN(I)=UNUSED
         CSL(I)=UNUSED
 1010 CONTINUE
C
      CALL NAMER(KAND,2,NLNAME,4,IVNAME,53,LEN,15,IDIM,AA,148,LOC,IEOF)
      IF(IEOF)GO TO 1040
C
C***  CHECK FOR CORRECT MACH NUMBER
C***  NO INPUT MACH NUMBER IMPLIES CURRENT MACH NUMBER
C
 1020 IF(MACH .EQ. UNUSED)GO TO 1030
      IF(MACH .NE. RMACH) GO TO 1000
C
C***  CHECK FOR CORRECT CONFIGURATION
C
 1030 JCONF=CONF+.5
      IF(JCONF .NE. ICONF)GO TO 1000
C
      IFOUND=0
C
 1040 CONTINUE
C
      XSREF=SREF
      XLREF=LREF
      XLATR=LATREF
      XXCG=XCG
      XZCG=ZCG
      XNALPH=NALPHA
      DO 1050 I=1,20
         XALPHA(I)=ALPHA(I)
         XCN(I)=CN(I)
         XCM(I)=CM(I)
         XCA(I)=CA(I)
         XCY(I)=CY(I)
         XCSN(I)=CSN(I)
         XCSL(I)=CSL(I)
 1050 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SUBNM2(ISEQ,CARD,NAMES,MAXLET,NNAM,NLET,VALUES,MAXLV,
     1 LENV,SUBED)
C
C***  SUBROUTINE TO SUBSTITUTE NUMERIC VALUES FOR NAMES IN PROTUBERANCE
C***  DRAG INPUTS IN AN INPUT CARD
C
C***  INPUTS
C
C   CARD -- THE INPUT CARD (80 COLUMNS)
C  NAMES -- THE NAMES TO BE CHANGED (A TWO-DIMENSIONAL ARRAY)
C MAXLET -- MAXIMUM NUMBER OF LETTERS IN ANY ONE NAME
C   NNAM -- NUMBER OF NAMES TO BE CHECKED
C   NLET -- NUMBER OF LETTERS IN EACH NAME (AN ARRAY)
C VALUES -- VALUES TO BE SUBSTITUTED (A TWO-DIMENSIONAL ARRAY)
C  MAXLV -- MAXIMUM NUMBER OF LETTERS IN SUBSTITUTION VALUES
C   LENV -- NUMBER OF CHARACTERS IN EACH SUBSTITUTED VALUE (AN ARRAY)
C
C***  OUTPUT
C
C   CARD -- THE NEW CARD IMAGE
C
C***  OTHER ROUTINES CALLED -- NONE
C
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      CHARACTER*4 IBLNK,CARD,VALUES,ICOL,NAMES
C
      DIMENSION CARD(80),VALUES(MAXLV,NNAM)
      LOGICAL SKIPPR,SUBED
      DIMENSION ICOL(80),NAMES(MAXLET,NNAM),NLET(NNAM),LENV(NNAM)
      DATA IBLNK / '    ' /
C
C***  FILL THE NEW CARD WITH BLANKS
C
      DO 1000 I=1,80
         ICOL(I)=IBLNK
 1000 CONTINUE
      INUM=0
      ISKIP=0
      SKIPPR=.FALSE.
C
C***  MOVE ALONG THE CARD BY COLUMNS
C
      DO 1060 I=1,80
         IM1=I-1
         IF(I.LE.ISKIP)GO TO 1060
         INUM=INUM+1
         ICOL(INUM)=CARD(I)
C
C***  LOOK FOR NON-BLANK CHARACTER
C
         IF(CARD(I).EQ.IBLNK)GO TO 1060
C
C***  CHECK FOR NAME
C
C***  CHECK EACH NAME INPUT
C
         DO 1050 N=1,NNAM
            NN=N
            KLEN=NLET(N)
C
C***  CHECK EACH LETTER IN THE NAME
C
            DO 1020 K=1,KLEN
                KPIM1=K+IM1
                IF(CARD(KPIM1).NE.NAMES(K,N))GO TO 1050
 1020       CONTINUE
C
C***  NAME FOUND, SUBSTITUTE NEW STRING AND SKIP REST OF CHARACTERS
C
            MAXK=LENV(NN)
            K1=IM1+1
            K2=KLEN+IM1
            IF(SKIPPR)GO TO 1030
            IF(PARTS(17))WRITE(6,1090)ISEQ,(CARD(K),K=1,80),
     1      (CARD(K),K=K1,K2)
 1030       IF(SKIPPR.AND.PARTS(17))WRITE(6,1100)(CARD(K),K=K1,K2)
            SKIPPR=.TRUE.
            INUMM1=INUM-1
            DO 1040 K=1,MAXK
               KK=K+INUMM1
               ICOL(KK)=VALUES(K,NN)
 1040       CONTINUE
            INUM=INUM+MAXK-1
            ISKIP=I+KLEN-1
            GO TO 1060
 1050    CONTINUE
 1060 CONTINUE
C
C***  IF ISKIP .EQ. 0, THEN NO SUBSTITUTION HAS BEEN MADE -- EXIT
C
      IF(ISKIP.EQ.0)GO TO 1080
C
C***  PACK NEW CARD IMAGE INTO OLD
C
      DO 1070 I=1,80
         CARD(I)=ICOL(I)
 1070 CONTINUE
      SUBED=.TRUE.
 1080 CONTINUE
 1090 FORMAT(1X,I3,1X,80A1,/,14X,' ** SUBSTITUTING NUMERIC FOR NAME ',
     1 10A1)
 1100 FORMAT(14X,' ** SUBSTITUTING NUMERIC FOR NAME ',10A1)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WRFIN2
C
C***  WRITE FINSET2 INPUTS
C
      COMMON /FSET2/ AA(399)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION NLNAME(7),IVNAME(113),LEN(23),IDIM(23),LOC(23)
C
      DATA NLNAME /  'F   ','I   ','N   ','S   ','E   ','T   ','2   '/
      DATA IVNAME /  'S   ','E   ','C   ','T   ','Y   ','P   ','S   ',
     1 'S   ','P   ','A   ','N   ','L   ','M   ','A   ','X   ','U   ',
     2 'L   ','F   ','L   ','A   ','T   ','U   ','L   ','M   ','A   ',
     3 'X   ','L   ','L   ','F   ','L   ','A   ','T   ','L   ','C   ',
     4 'H   ','O   ','R   ','D   ','Z   ','U   ','P   ','P   ','E   ',
     5 'R   ','Z   ','L   ','O   ','W   ','E   ','R   ','S   ','W   ',
     6 'E   ','E   ','P   ','S   ','T   ','A   ','X   ','L   ','E   ',
     7 'N   ','P   ','A   ','N   ','E   ','L   ','X   ','C   ','O   ',
     8 'R   ','D   ','M   ','E   ','A   ','N   ','T   ','H   ','I   ',
     9 'C   ','K   ','Y   ','U   ','P   ','P   ','E   ','R   ','Y   ',
     A 'L   ','O   ','W   ','E   ','R   ','F   ','I   ','N   ','P   ',
     B 'H   ','I   ','L   ','E   ','R   ','G   ','A   ','M   ','P   ',
     C 'H   ','I   ','F   ','C   ','F   ','O   ','C   '/
      DATA IDIM   / 1,10,10,10,10,10,10,10,10,10,10,10,1,50,50,50,50,
     1              50,1,10,8,8,10 /
      DATA LEN    / 6,5,5,6,5,6,5,6,6,5,3,3,6,5,4,5,6,6,6,3,3,4,4 /
      DATA LOC    / 1,2,12,22,32,42,52,62,72,82,92,102,112,113,163,213,
     1              263,313,363,364,374,382,390 /
C
      CALL NAMEW(KAND,6,NLNAME,7,IVNAME,113,LEN,23,IDIM,AA,399,LOC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BASPRS(ISHAPE,XO,BOTLEN,MISDIA,BASDIA,JETDIA,PRAT, 
     1                  FMACH,JMACH,BETAN,TRAT,ALPHA,XB,REOL,
     2                  NFIN,PHIFIN,CPBASE,CABASE,PBASE,TBASE, 
     3                  XSEP,THSEP,BOTDCN,BOTDCM,BOTDCA)
C
C     THIS PROGRAM WILL COMPUTE THE BASE PRESSURE RATIO ON A
C     CYLINDRICAL MISSILE AS A FUNCTION OF SEVERAL PARAMETERS.
C     THE COMPUTED RESULTS ARE BASED ON DATA FROM A PARAMETRIC
C     BASE FLOW ANALYSIS MADE USING A CHAPMAN-KORST COMPONENT
C     FLOW CODE.
C
C  WRITTEN BY A. JENN, MCDONNELL DOUGLAS
C
C     CONSTANTS
      PARAMETER (GAMMA = 1.4, NFINM = 8)
C
C     EXTERNAL CKDAT
C
C     ARRAYS FOR THE CHAPMAN-KORST DATA
      COMMON /CKDATA/ CKPR(5,5,5,5,5), CKFM(5,5,5,5,5), CKJM(5,5,5,5,5),
     1                CKBN(5,5,5,5,5), CKTR(5,5,5,5,5), CKDJ(5,5,5,5,5),
     2                XPR(5,5), XFM(5,5), XJM(5,5), XBN(5,5), XTR(5,5),
     3                XDJ(5,5), PNOM
C
C     ARRAYS FOR THE TABLE LOOK-UP ROUTINE
      COMMON /INTERPP/ NAVALP(5), NAVALF(5), NAVALJ(5), NAVALB(5), 
     1                NAVALT(5), NAVALD(5), NXVALP(5), NXVALF(5),
     2                NXVALJ(5), NXVALB(5), NXVALT(5), NXVALD(5),
     3                IEXTRP(5), NDIM, NXARR
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
C
      REAL XLOOK(5), PRMUL(4), FMMUL(4), JMMUL(4), BNMUL(4), TRMUL(4),
     1     DJMUL(4), PRPNOM(4), PRPACT(4), DAOD0W(3), DAOD0L(3),
     2     ALPEXP(3), CZDAT(12), SOD(12), JMACH, MSEP, MISDIA, JETDIA, 
     3     MU, XSEP(NFINM), THSEP(NFINM), PHIFIN(NFINM) 
C
C     BOUNDARY LAYER THICKNESS AT ANGLE OF ATTACK
      DATA DAOD0W /1.00, 0.39, 0.26/
      DATA DAOD0L /1.00, 1.75, 1.93/
      DATA ALPEXP /0.00, 4.00, 8.00/
C
C     SEPARATION LOCATION AS A FUNCTION OF ZUKOWSKI'S CONSTANT
      DATA CZDAT /0.000, 0.050, 0.100, 0.150, 0.200, 0.250, 
     1            0.300, 0.350, 0.400, 0.450, 0.475, 0.500/
      DATA SOD   / 0.00,  0.06,  0.15,  0.25,  0.45,  0.70, 
     1             1.00,  1.45,  2.20,  4.00,  7.00, 10.00/ 
C
C     ASSIGN THE VALUE OF PI
      PI = ACOS(-1.0)
C
C     COMPUTE THE BOATTAIL FINENESS RATIO
      ALOD = BOTLEN / MISDIA
C
C     COMPUTE THE BOATTAIL TERMINAL ANGLE BASED ON SHAPE
      IF (ISHAPE .EQ. 1 .OR. BASDIA .GE. MISDIA) THEN
C
C        CYLINDRICAL BOATTAIL
         BETAM = 0.0
C
      ELSE IF (ISHAPE .EQ. 2) THEN
C
C        CONICAL BOATTAIL
         DR = (MISDIA - BASDIA) / 2.0
         BETAM = ATAN(DR / BOTLEN) * 180.0 / PI
C
      ELSE
C
C        OGIVE BOATTAIL
         DR = (MISDIA - BASDIA) / 2.0
         BIGR = (DR**2 + BOTLEN**2) / (2.0 * DR)
         DEN  = SQRT(BIGR**2 - BOTLEN**2)
         BETAM = ATAN(BOTLEN / DEN) * 180.0 / PI
C
      END IF
C
C     ASSIGN INVARIANT INDEPENDENT VARIABLES TO THE INDEPENDENT
C     VARIABLE LOOKUP ARRAY
      XLOOK(1) = ISHAPE
      XLOOK(3) = ALOD
      XLOOK(4) = BETAM
C
C     INSERT THE NOMINAL JET PRESSURE RATIO IN THE LOOKUP ARRAY
      XLOOK(5) = PNOM
C                     
C     LOOP TO DETERMINE THE NOMINAL BASE PROPERTIES
      DO 10 I = 1, 4
         XLOOK(2) = I
         CALL TABLOK(NDIM,NAVALP,NXARR,NXVALP,XPR,CKPR,XLOOK,PRPNOM(I),
     1               IEXTRP,IERR)
   10 CONTINUE
C                        
C     DETERMINE THE CORRECTION FACTORS FOR BASE PRESSURE RATIO
      XLOOK(5) = PRAT
      DO 20 I = 1, 4
      XLOOK(2) = I
         CALL TABLOK(NDIM,NAVALP,NXARR,NXVALP,XPR,CKPR,XLOOK,PRMUL(I),
     1               IEXTRP,IERR)
   20 CONTINUE
C
C     DETERMINE THE CORRECTION FACTORS FOR FREESTREAM MACH NUMBER
      XLOOK(5) = FMACH
      DO 30 I = 1, 4
      XLOOK(2) = I
         CALL TABLOK(NDIM,NAVALF,NXARR,NXVALF,XFM,CKFM,XLOOK,FMMUL(I),
     1               IEXTRP,IERR)
   30 CONTINUE
C
C     DETERMINE THE CORRECTION FACTORS FOR JET MACH NUMBER
      XLOOK(5) = JMACH - FMACH
      DO 40 I = 1, 4
      XLOOK(2) = I
         CALL TABLOK(NDIM,NAVALJ,NXARR,NXVALJ,XJM,CKJM,XLOOK,JMMUL(I),
     1               IEXTRP,IERR)
   40 CONTINUE
C
C     DETERMINE THE CORRECTION FACTORS FOR JET NOZZLE ANGLE
      XLOOK(5) = BETAN
      DO 50 I = 1, 4
      XLOOK(2) = I
         CALL TABLOK(NDIM,NAVALB,NXARR,NXVALB,XBN,CKBN,XLOOK,BNMUL(I),
     1               IEXTRP,IERR)
   50 CONTINUE
C
C     DETERMINE THE CORRECTION FACTORS JET TEMPERATURE RATIO
      XLOOK(5) = TRAT
      DO 60 I = 1, 4
      XLOOK(2) = I
         CALL TABLOK(NDIM,NAVALT,NXARR,NXVALT,XTR,CKTR,XLOOK,TRMUL(I),
     1               IEXTRP,IERR)
   60 CONTINUE
C
C     DETERMINE THE CORRECTION FACTORS FOR JET DIAMETER RATIO
      XLOOK(5) = JETDIA / BASDIA
      DO 70 I = 1, 4
      XLOOK(2) = I
         CALL TABLOK(NDIM,NAVALD,NXARR,NXVALD,XDJ,CKDJ,XLOOK,DJMUL(I),
     1               IEXTRP,IERR)
   70 CONTINUE
C
C     CALCULATE THE BASE FLOW PROPERTIES AT THE ACTUAL CONDITIONS
      DO 80 I = 1, 4
         PRPACT(I) = PRMUL(I) * FMMUL(I) * JMMUL(I) * BNMUL(I) * 
     1               TRMUL(I) * DJMUL(I) / PRPNOM(I)**5
   80 CONTINUE
C
C     ASSIGN PROPERTIES TO THEIR CORRESPONDING NAMES
      TBASE = PRPACT(1)
      PBASE = PRPACT(2)
      PSEP  = PRPACT(3)
      MSEP  = PRPACT(4)
C
C     DETERMINE THE BASE PRESSURE COEFFICIENT
      CPBASE = 2.0 / (GAMMA * FMACH**2) * (PBASE - 1)
C
C     DETERMINE THE BASE DRAG COEFFICIENT
      CABASE = -CPBASE * (BASDIA**2 - JETDIA**2) / MISDIA**2
C
C     CONVERT BASE TEMPERATURE RATIO TO STATIC TEMPERATURES
      TBASE = TBASE * (1.0 + (GAMMA - 1.0) / 2.0 * FMACH**2)
C
C     COMPUTE THE BOUNDARY LAYER THICKNESS AT THE BOATTAIL BEGINNING
C     ASSUMING TURBULENT BOUNDARY LAYER AT ZERO ANGLE OF ATTACK
      REB = REOL * XB
      DELA0 = 0.37 * XB / REB**0.2
C
C     COMPUTE THE ANGLE OF ATTACK CORRECTIONS TO THE B.L. THICKNESS
      CALL TABLOK(1,3,3,3,ALPEXP,DAOD0W,ALPHA,DRATW,0,IERR)
      CALL TABLOK(1,3,3,3,ALPEXP,DAOD0L,ALPHA,DRATL,0,IERR)
C
C     COMPUTE THE WINDWARD AND LEESIDE BOUNDARY LAYER THICKNESSES
      DELW = DELA0 * DRATW
      DELL = DELA0 * DRATL
C
C     COMPUTE ZUKOWSKI'S CONSTANT FROM SEPARATION PRESSURE AND 
C     MACH NUMBER
      CZUK = (PSEP - 1.0) / MSEP
      IF (CZUK .LT. 0.0) CZUK = 0.0
C
C     COMPUTE SEPARATION LOCATION IN TERMS OF BOUNDARY LAYER THICKNESS
      CALL TABLOK(1,12,12,12,CZDAT,SOD,CZUK,XSODEL,3,IERR)
C
C     COMPUTE THE WINDWARD AND LEESIDE SEPARATION LOCATIONS
      XSW = XSODEL * DELW
      XSL = XSODEL * DELL
C
C     LIMIT SEPARATION LOCATIONS TO BEGINNING OF BOATTAIL
      IF (XSW .GT. BOTLEN) XSW = BOTLEN
      IF (XSL .GT. BOTLEN) XSL = BOTLEN
C
C     CALCULATE THE MACH ANGLE IN DEGREES
      MU = ASIN(1.0 / FMACH) * 180.0 / PI
C
C     COMPUTE THE WINDWARD AND LEEWARD MACH CONE ANGLES
      THETW = MU - ALPHA
      THETL = MU + ALPHA
C
C     BEGIN LOOP TO CALCULATE SEPARATION LOCATION AND MACH CONE ANGLE
C     AT SPECIFIED CIRCUMFERENTIAL LOCATIONS AROUND THE BOATTAIL.
      DXS   = XSL - XSW
      DTHET = THETL - THETW 
      DO 90 IFIN = 1, NFIN
         PHI  = PHIFIN(IFIN) * PI / 180.0
         IF (PHI .GT. PI) PHI = 2.0 * PI - PHI
         FPHI = 0.5 * (1.0 - COS(PHI))
         XSEP(IFIN)  = XB + BOTLEN - XSL + DXS * FPHI
         THSEP(IFIN) = THETL - DTHET * FPHI
   90 CONTINUE
C
C     COMPUTE THE ZERO ANGLE OF ATTACK SEPARATION LOCATION
      XSEPA0 = XSODEL * DELA0
      IF (XSEPA0 .GT. BOTLEN) XSEPA0 = BOTLEN
C
C     CALCULATE BOATTAIL NORMAL FORCE AND MOMENT INCREMENT
      CALL BOTCNM(ISHAPE,SREF,LREF,XCG,XO,XB,FMACH,ALPHA,BOTLEN,
     1            MISDIA,BASDIA,XSEPA0,BOTDCN,BOTDCM)
C
C     CALCULATE BOATTAIL AXIAL FORCE INCREMENT
      CALL BOTCA(ISHAPE,SREF,BOTLEN,MISDIA,BASDIA,FMACH, 
     1           XSEPA0,PBASE,BOTDCA)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
       SUBROUTINE BODYE(IM)
C
C***  EXECUTIVE FOR ELLIPTICAL BODY ALONE AERODYNAMICS
C
C***  IM IS THE CURRENT MACH NUMBER INDEX
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
C
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      REAL NALPHA,NMACH,MACH
C
      COMMON /TOTALC/ BALPHA(20),BBETA(20),BPHI(20),ALPTOT(20)
C
      COMMON /ABODIN/ NX,XO,X(50),WIDTH(50),TNOSE,LNOSE,WNOSE,BNOSE,
     1                TRUNC,LCENTR,WCENTR,TAFT,LAFT,WAFT,
     2                POWER,DISCON(20),ELLIP(50),HEIGHT(50),ENOSE,
     3                ECENTR,EAFT,ADUM(645)
C
      REAL NX,LNOSE,LCENTR,LAFT,LTOTAL,LNOSEX,LCNTRX,LAFTX
      LOGICAL TRUNC
C
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     1  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     2  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     3  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     4                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,
     5  BPNOSE,BCPNOS,BPCENT,BCPCEN,BPAFT,BCPAFT,BPLAN,
     6  BCENTP,ECSPN,ECSPC,ECSPA,ECSPT
      LOGICAL LPARTS,LPARTT
C
      COMMON /SBODY/ CNB(20),CMB(20),CAB(20),CYB(20),CLNB(20),CLLB(20),
     1               CNAB(20),CMAB(20),CYBB(20),CNBB(20),CLBB(20)
      COMMON /BDWORK/ CNP(20),CMP(20),CNV(20),CMV(20),DUM(161)
C
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      DIMENSION IROUT(2),REQ(50),WSAVE(50)
      DIMENSION CNPV(20),CNVV(20),CMPV(20),CMVV(20)
      DIMENSION CNHOR(20),CMHOR(20),CNVER(20),CMVER(20)
C
C
C***  ADJUST FOR BODY ELLIPTICITY
C
      NNX=NX+.5
C
      TWNOSE=WNOSE
      TWCENT=WCENTR
      TWAFT=WAFT
C
      WNOSE=UNUSED
      WCENTR=UNUSED
      WAFT=UNUSED
C
C***  COMPUTE EQUIVALENT CIRCULAR BODY AERODYNAMICS
C
      SPT=SPLAN
      SPLAN=ECSPT
C
      DO 1000 I=1,NNX
         REQ(I)=SQRT(WIDTH(I)*HEIGHT(I))
         WSAVE(I)=WIDTH(I)
         WIDTH(I)=REQ(I)
 1000 CONTINUE
C
      LNOSEX = LNOSE + XO
      LCNTRX = LCENTR + LNOSEX
      LAFTX  = LAFT + LCNTRX
      IF(LNOSE .GT. UNUSED)CALL LNTRP(X,REQ,NNX,LNOSEX,WNOSE)
      IF(LCENTR .GT. UNUSED)CALL LNTRP(X,REQ,NNX,LCNTRX,WCENTR)
      IF(LAFT .GT. UNUSED)CALL LNTRP(X,REQ,NNX,LAFTX,WAFT)
      IF(LNOSE .GT. UNUSED)WNOSE=2.*WNOSE
      IF(LCENTR .GT. UNUSED)WCENTR=2.*WCENTR
      IF(LAFT .GT. UNUSED)WAFT=2.*WAFT
C
      LPARTS=PARTS(6)
      PARTS(6)=.FALSE.
      LPARTT=LPART
      LPART=.FALSE.
      CALL BODYA(IM)
C
      PARTS(6)=LPARTS
      LPART=LPARTT
C
      SPLAN=SPT
C
      WNOSE=TWNOSE
      WCENTR=TWCENT
      WAFT=TWAFT
C
      DO 1010 I=1,50
         IF(I .LE. NNX)WIDTH(I)=WSAVE(I)
         IF(I .GT. 20)GO TO 1010
         CNPV(I)=CNP(I)
         CNVV(I)=CNV(I)
         CMPV(I)=CMP(I)
         CMVV(I)=CMV(I)
 1010 CONTINUE
C
C***  COMPUTE CN/CNO TERMS
C
C ... HORIZONTAL PLANE
C
      CALL GETCNO(NX,X,WIDTH,HEIGHT,CNSB,CNNEW,CMSBT,CMNEWT)
C
      CALL GETCNO(NX,X,REQ,REQ,CNSBC,CNNEWC,CMSBTC,CMNEWC)
      NALP=NALPHA+0.5
C
      CNRAH1=1.
      CNRAH2=1.
      CNRAH3=1.
      CNRAH4=1.
      IF(CNSBC .NE. 0.)CNRAH1=CNSB/CNSBC
      IF(CNNEWC .NE. 0.)CNRAH2=CNNEW/CNNEWC
      IF(CMSBTC .NE. 0.)CNRAH3=CMSBT/CMSBTC
      IF(CMNEWC .NE. 0.)CNRAH4=CMNEWT/CMNEWC
C
      DO 1020 I=1,NALP
         CNP(I)=CNP(I)*CNRAH1
         CNV(I)=CNV(I)*CNRAH2
         CMP(I)=CMP(I)*CNRAH3
         CMV(I)=CMV(I)*CNRAH4
 1020 CONTINUE
C
C ... VERTICAL PLANE
C
      CALL GETCNO(NX,X,HEIGHT,WIDTH,CNSB,CNNEW,CMSBT,CMNEWT)
C
      CNRAV1=1.
      CNRAV2=1.
      CNRAV3=1.
      CNRAV4=1.
      IF(CNSBC .NE. 0.)CNRAV1=CNSB/CNSBC
      IF(CNNEWC .NE. 0.)CNRAV2=CNNEW/CNNEWC
      IF(CMSBTC .NE. 0.)CNRAV3=CMSBT/CMSBTC
      IF(CMNEWC .NE. 0.)CNRAV4=CMNEWT/CMNEWC
      DO 1030 I=1,NALP
         CNPV(I)=CNPV(I)*CNRAV1
         CNVV(I)=CNVV(I)*CNRAV2
         CMPV(I)=CMPV(I)*CNRAV3
         CMVV(I)=CMVV(I)*CNRAV4
 1030 CONTINUE
C
C***  COMPUTE STATIC AERODYNAMICS AT ROLL ORIENTATION
C
      DO 1040 I=1,NALP
         CNHOR(I)=CNP(I) + CNV(I)
         CNVER(I)=CNPV(I)+ CNVV(I)
         CMHOR(I)=CMP(I) + CMV(I)
         CMVER(I)=CMPV(I)+ CMVV(I)
C
         CNB(I)=CNHOR(I)*COS(BPHI(I)/RAD)
         CMB(I)=CMHOR(I)*COS(BPHI(I)/RAD)
         CYB(I)= -CNVER(I)*SIN(BPHI(I)/RAD)
         CLNB(I)=-CMVER(I)*SIN(BPHI(I)/RAD)*LREF/LATREF
C
      IF(CNB(I).LT.0.0) CNVER(I)=-1.*CNVER(I)
      IF(CMB(I).LT.0.0) CMVER(I)=-1.*CMVER(I)
 1040 CONTINUE
C
C***  DIFFERENTIATE CN AND CM CURVES, SET ROLL MOMENT EQUAL TO ZERO
C
      DO 1050 I=1,NALP
         CALL POLINT(ALPHA,CNB,NALP,ALPHA(I),CNBINT,CNAB(I))
         CALL POLINT(ALPHA,CMB,NALP,ALPHA(I),CMBINT,CMAB(I))
         CLLB(I)=0.
         CLBB(I)=0.
 1050 CONTINUE
C
C***  DIRECTIONAL DERIVATIVES (PERTURBATING BETA BY ONE DEGREE)
C
      DO 1060 I=1,NALP
         BETNEW=BBETA(I)+1.
         PHINEW=UNUSED
         CALL ALPBET(BALPHA(I),ALTNEW,BETNEW,PHINEW)
         CALL POLINT(BALPHA,CNVER,NALP,ALTNEW,CNVB,DYDX)
         CALL POLINT(BALPHA,CMVER,NALP,ALTNEW,CMVB,DYDX)
         CYP1= -CNVB*SIN(PHINEW/RAD)
         CLNP1=-CMVB*SIN(PHINEW/RAD)*LREF/LATREF
         CYBB(I)=CYP1-CYB(I)
         CNBB(I)=CLNP1-CLNB(I)
 1060 CONTINUE
C
      IF(PARTS(6))CALL BDPART(IM,CNRAH1,CNRAH2,CNRAH3,CNRAH4,
     1                        CNRAV1,CNRAV2,CNRAV3,CNRAV4)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CORD5M(X,XU,XL,YUN,YLN,L,I,J,K,II,JJ,KK,III,JJJ,
     1 THN,CAM,RHO,T)
C
C*****
C***** CALCULATE NACA FIVE DIGIT (MODIFIED) AIRFOIL COORDINATES
C*****
C
C  ROUTINE ADAPTED FROM DIGITAL DATCOM
C  ORIGINAL ROUTINE WRITTEN BY D. KINSEY, D. BOWERS, AFFDL
C  MODIFIED BY S.R. VUKELICH, MCDONNELL DOUGLAS
C
      DIMENSION X(50),XU(50),XL(50),YUN(50),YLN(50),THN(50),CAM(50)
C
      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=ACOS((-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)
C
C ... COMPUTE COORDINATES ALONG CHORD
C
      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
     1   *(3.-ZM)*X(M))
      IF(X(M).LT.ZM)ALPHA=ATAN((1./6.)*XK*(3.*X(M)**2-6.*ZM*X(M)+ZM**2*
     1   (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
     1   -ZM**3*X(M)+ZM**3)
      IF(X(M).LT.ZM)ALPHA=ATAN((1./6.)*XK*(3.*(X(M)-ZM)**2-RK*(1.-ZM)
     1   **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
     1   -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)
     1   **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 CONTINUE
      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
c *************************************
c *************************************
c *************************************
      SUBROUTINE DUMPRT
C
C***  ROUTINE TO DUMP INTERNAL ARRAYS
C
      COMMON /DUMPF/
     1   LGEOB,LF1GM,LF2GM,LF3GM,LF4GM,LATMP,LBDWK,LFLCT,LINLD,
     2   LINPT,LFLTC,LREFQN,LBDIN,LF1IN,LF2IN,LF3IN,LF4IN,LINLIN,

     3   LIOM,LSBOD,LSF1,LSF2,LSF3,LSF4,LSB1,LSB12,LSB123,LS1234,LDBOD,
     4   LDF1,LDF2,LDF3,LDF4,LDB1,LDB12,LDB123,LD1234
      LOGICAL
     1   LGEOB,LF1GM,LF2GM,LF3GM,LF4GM,LATMP,LBDWK,LFLCT,LINLD,
     2   LINPT,LFLTC,LREFQN,LBDIN,LF1IN,LF2IN,LF3IN,LF4IN,LINLIN,
     3   LIOM,LSBOD,LSF1,LSF2,LSF3,LSF4,LSB1,LSB12,LSB123,LS1234,LDBOD,
     4   LDF1,LDF2,LDF3,LDF4,LDB1,LDB12,LDB123,LD1234
C
      LOGICAL LDMP(37),LBODY
      EQUIVALENCE (LDMP(1),LGEOB)
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,LDERRD,LPART,
     1             LNAME,LPLOT,LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     2             LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,LINLET,
     3             LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL      LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,LDERRD,LPART,
     1             LNAME,LPLOT,LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     2             LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,LINLET,
     3             LEXPR,LICRMT,LSPIN,LARBOD
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /FLC/    FLCT(144)
      COMMON /TOTALC/ ATOTAL(80)
      COMMON /REFQN/  REFF(9)
      COMMON /GEOBOD/ GEOB(47)
      COMMON /ABODIN/ BDIN(881)
      COMMON /BDWORK/ BDW(241)
      COMMON /INLETN/ INLE(64)
      COMMON /SBODY/  CBOD(220)
      COMMON /SFIN1/  CF1(220)
      COMMON /SFIN2/  CF2(220)
      COMMON /SFIN3/  CF3(220)
      COMMON /SFIN4/  CF4(220)
      COMMON /SB1/    CB1(220)
      COMMON /SB12/   CB12(220)
      COMMON /SB123/  CB123(220)
      COMMON /SB1234/ CB1234(220)
      COMMON /DBODY/  DBOD(406)
      COMMON /DB1/    D1(400)
      COMMON /DB12/   D12(400)
      COMMON /DB123/  D123(400)
      COMMON /DB1234/ D1234(400)
C
      COMMON /FSET1/  FDATA1(399)
      COMMON /FSET2/  FDATA2(399)
      COMMON /FSET3/  FDATA3(399)
      COMMON /FSET4/  FDATA4(399)
C
      COMMON /GEOFS1/ GFIN1(188)
      COMMON /GEOFS2/ GFIN2(188)
      COMMON /GEOFS3/ GFIN3(188)
      COMMON /GEOFS4/ GFIN4(188)
C
      COMMON /F1WORK/ F1WK(290)
      COMMON /F2WORK/ F2WK(290)
      COMMON /F3WORK/ F3WK(290)
      COMMON /F4WORK/ F4WK(290)
      COMMON /INLTD/  INLD(120)
C
      REAL INLE,INLD
      CHARACTER*4 IFLT,IREFF,ITOT,IBDIN,IBDW,IGEOB,IFIN1,IFIN2,
     1  IFIN3,IFIN4,IGF1,IGF2,IGF3,IGF4,IF1WK,IF2WK,IF3WK,IF4WK,
     2  ICBOD,ICF1,ICF2,ICF3,ICF4,ICB1,ICB12,ICB123,ICB1234,
     3  IINLD,IINLIN,IDBOD,IDB1,IDB12,IDB123,IDB1234,IC1234,ID1234
C
      DATA IFLT   /'FLT '/
      DATA IREFF  /'REFQ'/
      DATA ITOT   /'FLCT'/
      DATA IBDIN  /'BDIN'/
      DATA IBDW   /'BDWK'/
      DATA IGEOB  /'GEOB'/
      DATA IFIN1  /'F1IN'/
      DATA IFIN2  /'F2IN'/
      DATA IFIN3  /'F3IN'/
      DATA IFIN4  /'F4IN'/
      DATA IGF1   /'F1GM'/
      DATA IGF2   /'F2GM'/
      DATA IGF3   /'F3GM'/
      DATA IGF4   /'F4GM'/
      DATA IF1WK  /'F1WK'/
      DATA IF2WK  /'F2WK'/
      DATA IF3WK  /'F3WK'/
      DATA IF4WK  /'F4WK'/
      DATA ICBOD  /'SBOD'/
      DATA ICF1   /'SF1 '/
      DATA ICF2   /'SF2 '/
      DATA ICF3   /'SF3 '/
      DATA ICF4   /'SF4 '/
      DATA ICB1   /'SB1 '/
      DATA ICB12  /'SB12'/
      DATA ICB123 /'SB13'/
      DATA IC1234 /'SB14'/
      DATA IINLD  /'INLD'/
      DATA IINLIN /'INLI'/
      DATA IDBOD  /'DBOD'/
C     DATA IDF1   /'DF1 '/
C     DATA IDF2   /'DF2 '/
C     DATA IDF3   /'DF3 '/
C     DATA IDF4   /'DF4 '/
      DATA IDB1   /'DB1 '/
      DATA IDB12  /'DB12'/
      DATA IDB123 /'DB13'/
      DATA ID1234 /'DB14'/
C
C***  DETERMINE IF ANY ARRAY DUMPS ARE NECESSARY
C
      IF(LDMPCS)GO TO 1010
C
      DO 1000 I=1,37
         IF(LDMP(I))GO TO 1010
 1000 CONTINUE
C
      GO TO 1020
C
 1010 CONTINUE
C
      WRITE(6,1030)
C
C  FLIGHT CONDITIONS
C
      IF((LDMPCS.AND.LFLT) .OR. LFLTC .OR. LATMP .OR. (LINPT.AND.LFLT))
     1 CALL DMPARY(0,FLCT,125,IFLT,3)
      IF((LDMPCS.AND.LFLT) .OR. LFLCT .OR. (LINPT.AND.LFLT))
     1 CALL DMPARY(0,ATOTAL,80,ITOT,4)
C
C  REFERENCE QUANTITIES
C
      IF((LDMPCS.AND.LREFQ) .OR. LREFQN .OR. (LINPT.AND.LREFQ))
     1 CALL DMPARY(0,REFF,9,IREFF,4)
C
C  AXISYMMETRIC BODY INPUTS
C
      LBODY=LAXIS .OR. LELLB
C
      IF((LDMPCS.AND.LAXIS) .OR. (LBDIN.AND.LAXIS)
     1    .OR. (LINPT.AND.LAXIS)) CALL DMPARY(0,BDIN,881,IBDIN,4)
      IF((LDMPCS.AND.LELLB) .OR. (LBDIN.AND.LELLB)
     1    .OR. (LINPT.AND.LELLB)) CALL DMPARY(0,BDIN,881,IBDIN,4)
C
C  AXISYMMETRIC BODY GEOMETRY
C
      IF((LDMPCS.AND.LAXIS) .OR. LGEOB)
     1 CALL DMPARY(0,GEOB,35,IGEOB,4)
      IF((LDMPCS.AND.LELLB) .OR. LGEOB)
     1 CALL DMPARY(0,GEOB,47,IGEOB,4)
C
C  AXISYMMETRIC BODY WORKING DATA ARRAYS
C
      IF((LDMPCS.AND.LBODY) .OR. LGEOB .OR. LBDWK)
     1 CALL DMPARY(0,BDW,241,IBDW,4)
C
C  FIN SET 1 INPUTS
C
      IF((LDMPCS.AND.LFIN1) .OR. LF1IN .OR. (LINPT.AND.LFIN1))
     1 CALL DMPARY(0,FDATA1,399,IFIN1,4)
C
C  FIN SET 2 INPUTS
C
      IF((LDMPCS.AND.LFIN2) .OR. LF2IN .OR. (LINPT.AND.LFIN2))
     1 CALL DMPARY(0,FDATA2,399,IFIN2,4)
C
C  FIN SET 3 INPUTS
C
      IF((LDMPCS.AND.LFIN3) .OR. LF3IN .OR. (LINPT.AND.LFIN3))
     1 CALL DMPARY(0,FDATA3,399,IFIN3,4)
C
C  FIN SET 4 INPUTS
C
      IF((LDMPCS.AND.LFIN4) .OR. LF4IN .OR. (LINPT.AND.LFIN4))
     1 CALL DMPARY(0,FDATA4,399,IFIN4,4)
C
C  FIN SET 1 GEOMETRY
C
      IF((LDMPCS.AND.LFIN1) .OR. LF1GM)
     1 CALL DMPARY(0,GFIN1,188,IGF1,4)
      IF((LDMPCS.AND.LFIN1) .OR. LF1GM)
     1 CALL DMPARY(0,F1WK,290,IF1WK,4)
C
C  FIN SET 2 GEOMETRY
C
      IF((LDMPCS.AND.LFIN2) .OR. LF2GM)
     1 CALL DMPARY(0,GFIN2,188,IGF2,4)
      IF((LDMPCS.AND.LFIN2) .OR. LF2GM)
     1 CALL DMPARY(0,F2WK,290,IF2WK,4)
C
C  FIN SET 3 GEOMETRY
C
      IF((LDMPCS.AND.LFIN3) .OR. LF3GM)
     1 CALL DMPARY(0,GFIN3,188,IGF3,4)
      IF((LDMPCS.AND.LFIN3) .OR. LF3GM)
     1 CALL DMPARY(0,F3WK,290,IF3WK,4)
C
C  FIN SET 4 GEOMETRY
C
      IF((LDMPCS.AND.LFIN4) .OR. LF4GM)
     1 CALL DMPARY(0,GFIN4,188,IGF4,4)
      IF((LDMPCS.AND.LFIN4) .OR. LF4GM)
     1 CALL DMPARY(0,F4WK,290,IF4WK,4)
C
C  AXISYMMETRIC BODY I.O.M.
C
      IF((LDMPCS.AND.LBODY) .OR. LSBOD .OR. (LIOM.AND.LBODY))
     1 CALL DMPARY(0,CBOD,220,ICBOD,4)
C
C  FIN SET 1 I.O.M.
C
      IF((LDMPCS.AND.LFIN1) .OR. LSF1 .OR. (LIOM.AND.LFIN1))
     1 CALL DMPARY(0,CF1,220,ICF1,4)
C
C  FIN SET 2 I.O.M.
C
      IF((LDMPCS.AND.LFIN2) .OR. LSF2 .OR. (LIOM.AND.LFIN2))
     1 CALL DMPARY(0,CF2,220,ICF2,4)
C
C  FIN SET 3 I.O.M.
C
      IF((LDMPCS.AND.LFIN3) .OR. LSF3 .OR. (LIOM.AND.LFIN3))
     1 CALL DMPARY(0,CF3,220,ICF3,4)
C
C  FIN SET 4 I.O.M.
C
      IF((LDMPCS.AND.LFIN4) .OR. LSF4 .OR. (LIOM.AND.LFIN4))
     1 CALL DMPARY(0,CF4,220,ICF4,4)
C
C  BODY-FIN SET 1 I.O.M.
C
      IF((LDMPCS.AND.LBODY.AND.LFIN1) .OR. LSB1 .OR.
     1 (LIOM.AND.LBODY.AND.LFIN1))
     2 CALL DMPARY(0,CB1,220,ICB1,4)
C
C  BODY-FIN SET 1-FIN SET 2 I.O.M.
C
      IF((LDMPCS.AND.LBODY.AND.LFIN1.AND.LFIN2) .OR. LSB12 .OR.
     1 (LIOM.AND.LBODY.AND.LFIN1.AND.LFIN2))
     2 CALL DMPARY(0,CB12,220,ICB12,4)
C
C  BODY + FIN SET 1,2 AND 3  I.O.M.
C
      IF((LDMPCS.AND.LBODY.AND.LFIN1.AND.LFIN2.AND.LFIN3) .OR. LSB123
     1  .OR. (LIOM.AND.LBODY.AND.LFIN1.AND.LFIN2.AND.LFIN3))
     2 CALL DMPARY(0,CB123,220,ICB123,4)
C
C  BODY + FIN SET 1,2,3 AND 4  I.O.M.
C
      IF((LDMPCS.AND.LBODY.AND.LFIN1.AND.LFIN2.AND.LFIN3.AND.LFIN4)
     1  .OR. LS1234 .OR. (LIOM.AND.LBODY.AND.LFIN1.AND.LFIN2.AND.
     2   LFIN3.AND.LFIN4))
     3 CALL DMPARY(0,CB1234,220,IC1234,4)
C
C  BODY DYNAMIC DERIVATIVES
C
      IF((LDMPCS.AND.LBODY.AND.LDAMP) .OR. (LDBOD.AND.LDAMP.AND.LBODY))
     1   CALL DMPARY(0,DBOD,406,IDBOD,4)
C
C  BODY + FIN SET 1 DYNAMIC DERIVATIVES
C
      IF((LDMPCS.AND.LBODY.AND.LFIN1.AND.LDAMP) .OR.
     1  (LDB1.AND.LBODY.AND.LFIN1.AND.LDAMP))
     2  CALL DMPARY(0,D1,400,IDB1,4)
C
C  BODY + FIN SET 1 AND 2 DYNAMIC DERIVATIVES
C
      IF((LDMPCS.AND.LBODY.AND.LFIN1.AND.LFIN2.AND.LDAMP) .OR.
     1  (LDB12.AND.LBODY.AND.LFIN1.AND.LFIN2.AND.LDAMP))
     2  CALL DMPARY(0,D12,400,IDB12,4)
C
C  BODY + FIN SET 1,2 AND 3 DYNAMIC DERIVATIVES
C
      IF((LDMPCS.AND.LBODY.AND.LFIN1.AND.LFIN2.AND.LFIN3.AND.LDAMP) .OR.
     1  (LDB123.AND.LBODY.AND.LFIN1.AND.LFIN2.AND.LFIN3.AND.LDAMP))
     2  CALL DMPARY(0,D123,400,IDB123,4)
C
C  BODY + FIN SET 1,2,3 AND 4 DYNAMIC DERIVATIVES
C
      IF((LDMPCS.AND.LBODY.AND.LFIN1.AND.LFIN2.AND.LFIN3.AND.LFIN4.AND.
     1  LDAMP) .OR.(LD1234.AND.LBODY.AND.LFIN1.AND.LFIN2.AND.LFIN3.AND.
     2  LFIN4.AND.LDAMP))
     2  CALL DMPARY(0,D1234,400,ID1234,4)
C
C  INLET INPUTS
C
      IF((LDMPCS.AND.LINLET) .OR. (LINLIN .AND. LINLET))
     1   CALL DMPARY(0,INLE,64,IINLIN,4)
C
C  INLET INCREMENTALS
C
      IF((LDMPCS.AND.LINLET) .OR. (LINLD.AND.LINLET))
     1    CALL DMPARY(0,INLD,100,IINLD,4)
C
 1020 CONTINUE
C
 1030 FORMAT(4X,'DUMP OF INTERNAL DATA ARRAYS IN FOOT-POUND-RANKINE',
     1  ' UNITS')
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FD5 (X,X1,X2,X3,X4,X5,F1,F2,F3,F4,F5,FX)
C
C     THIS SUBROUTINE USES A FIVE POINT LA GRANGE FOR DIFFERENTIATION 
C     OF A FUNCTION 
C
C  WRITTEN BY F. MOORE, NSWC
C
      A1=(X-X4)*(X-X5)*(2.*X-X2-X3)+(X-X2)*(X-X3)*(2.*X-X4-X5)
      A2=(X-X4)*(X-X5)*(2.*X-X1-X3)+(X-X1)*(X-X3)*(2.*X-X4-X5)
      A3=(X-X4)*(X-X5)*(2.*X-X1-X2)+(X-X1)*(X-X2)*(2.*X-X4-X5)
      A4=(X-X3)*(X-X5)*(2.*X-X1-X2)+(X-X1)*(X-X2)*(2.*X-X3-X5)
      A5=(X-X3)*(X-X4)*(2.*X-X1-X2)+(X-X1)*(X-X2)*(2.*X-X3-X4)
      D1=(X1-X2)*(X1-X3)*(X1-X4)*(X1-X5)
      D2=(X2-X1)*(X2-X3)*(X2-X4)*(X2-X5)
      D3=(X3-X1)*(X3-X2)*(X3-X4)*(X3-X5)
      D4=(X4-X1)*(X4-X2)*(X4-X3)*(X4-X5)
      D5=(X5-X1)*(X5-X2)*(X5-X3)*(X5-X4)
      C1=A1/D1
      C2=A2/D2
      C3=A3/D3
      C4=A4/D4
      C5=A5/D5
      FX=C1*F1+C2*F2+C3*F3+C4*F4+C5*F5
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE GEOINL
C
C***********************************************************************
C
C     THIS SUBROUTINE PROCESSES THE INPUT GEOMETRY.  IT DEFINES
C     GEOMETRIC VALUES FOR USE IN OTHER PARTS OF THE PROGRAM.
C
C***********************************************************************
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C  MODIFIED BY K. BURNS, MCDONNELL DOUGLAS
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
      COMMON /GEOBOD/ DUM(32),DMAX,SMAX,LBOD,GDUM(12)
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      REAL LBOD
      RBOD=DMAX/2.0
C
C***  SCALE THE INPUT GEOMETRY IF REQUIRED
      IF ((SCALE.NE.UNUSED).OR.(SCALE.NE.1.)) THEN
        XINLT=XINLT*SCALE
        XDIV=XDIV*SCALE
        HDIV=HDIV*SCALE
        LDIV=LDIV*SCALE
        DO 5 I=1,5
          XI(I)=XI(I)*SCALE
          HI(I)=HI(I)*SCALE
          WI(I)=WI(I)*SCALE
   5    CONTINUE
      ENDIF
C
C     CALCULATE INLET SPECIFIC GEOMETRY CHARACTERISTICS
C
      IF(INTYPE.NE.3.)THEN
        DO 10 ICRX=1,5
          IF ((HI(ICRX).EQ.0.0).AND.(WI(ICRX).EQ.0.0)) THEN
            IF (ABS(HI(ICRX)-HI(ICRX-1)).GT.
     &        ABS(WI(ICRX)-WI(ICRX-1))) THEN
              SI(ICRX)=PI/2.0
            ELSEIF (ABS(WI(ICRX)-WI(ICRX-1)).GT.
     &        ABS(HI(ICRX)-HI(ICRX-1))) THEN
              SI(ICRX)=0.0
            ELSEIF (ABS(WI(ICRX)-WI(ICRX-1)).EQ.
     &        ABS(HI(ICRX)-HI(ICRX-1))) THEN
              SI(ICRX)=PI/4.0
            ENDIF
          ELSE
            SI(ICRX)=ATAN2(HI(ICRX),WI(ICRX))
          ENDIF
          CRXLEN(ICRX)=SQRT(WI(ICRX)**2.+HI(ICRX)**2.)
   10   CONTINUE
      ENDIF
C
      DO 20 JSEC=1,4
        LENGTH(JSEC)=XI(JSEC+1)-XI(JSEC)
        XMIDI(JSEC)=XI(JSEC)+LENGTH(JSEC)/2.
        ALPEFF(JSEC)=0.0
   20 CONTINUE
C
C *** CALCULATION OF INLET CROSS SECTIONAL AREA CHANGE FROM
C     FIRST INLET SECTION (USED FOR PRESSURE DRAG CALCS)
C
C     FOR 2-D TOP OR SIDE MOUNTED INLETS 
C     (EITHER SURFACE MOUNT OR WITH DIVERTER)
C
      IF (INTYPE.EQ.1. .OR. INTYPE.EQ.2. .AND. HDIV.GE.0.0) THEN
        IF (ICOVER) THEN
          DO 30 ICRX=1,5
            AREAI(ICRX)=HI(ICRX)*WI(ICRX)
            DEQI(ICRX)=SQRT(4*AREAI(ICRX)/PI)
            IF(HDIV .EQ. 0.0)RARC(ICRX) = 0.0
   30     CONTINUE
        ELSE
          AREAI(1) = 0.0
          DEQI(1)  = 0.0
          IF(HDIV .EQ. 0.0)RARC(1) = 0.0
          DO 40 ICRX=2,5
            AREAI(ICRX)=HI(ICRX)*WI(ICRX)-HI(2)*WI(1)
            DEQI(ICRX) = SQRT(4.*HI(ICRX)*WI(ICRX)/PI)
            IF(HDIV .EQ. 0.0)RARC(ICRX) = 0.0
   40     CONTINUE
        ENDIF
      ENDIF
C
C     FOR 2-D TOP MOUNTED SEMI-SUBMERGED INLETS
C
C     THETAB = ANGLE OF ARC WHERE BODY AND INLET INTERSECT
C     AREAS  = AREA OF INLET SUBMERGED INSIDE BODY MOLDLINE
C     RARC   = ANGLE USED TO CALCULATE FORCES ON OVERLAPPING AREAS
C              OF BODY AND INLET (OR DIVERTER IF HDIV .GT. 0)
C
      IF (INTYPE.EQ.1. .AND. HDIV.LT.0.0) THEN
        IF (ICOVER) THEN
          DO 41 ICRX=1,5
            THETAB     = 2.0*ASIN(WI(ICRX)/2./RBOD)
            AREAS      = 0.5*RBOD**2*(THETAB - SIN(THETAB))
            AREAI(ICRX)= HI(ICRX)*WI(ICRX) - AREAS
            DEQI(ICRX) = SQRT(4.*AREAI(ICRX)/PI)
            RARC(ICRX) = 90./RAD - THETAB/2.
   41     CONTINUE
        ELSE
          AREAI(1) = 0.0
          DEQI(1)  = 0.0
          RARC(1)  = 0.0
          THETAB   = 2.0*ASIN(WI(2)/2./RBOD)
          AREAS    = 0.5*RBOD**2*(THETAB - SIN(THETAB))
          AREA2    = WI(1)*HI(2) - AREAS
          DO 42 ICRX=2,5
            THETAB     = 2.0*ASIN(WI(ICRX)/2./RBOD)
            AREAS      = 0.5*RBOD**2*(THETAB - SIN(THETAB))
            AREAI(ICRX)= HI(ICRX)*WI(ICRX) - AREA2 - AREAS
            DEQI(ICRX) = SQRT(4.*(HI(ICRX)*WI(ICRX)-AREAS)/PI)
            RARC(ICRX) = 90./RAD - THETAB/2.
   42     CONTINUE
        ENDIF
      ENDIF
C
C     FOR 2-D SIDE MOUNTED SEMI-SUBMERGED INLETS
C
      IF (INTYPE.EQ.2. .AND. HDIV.LT.0.0) THEN
        IF (ICOVER) THEN
          DO 43 ICRX=1,5
            THETAB     = 2.0*ASIN(HI(ICRX)/2./RBOD)
            AREAS      = 0.5*RBOD**2*(THETAB - SIN(THETAB))
            AREAI(ICRX)= HI(ICRX)*WI(ICRX) - AREAS
            DEQI(ICRX) = SQRT(4.*AREAI(ICRX)/PI)
            RARC(ICRX) = 90./RAD - THETAB/2.
   43     CONTINUE
        ELSE
          AREAI(1) = 0.0
          DEQI(1)  = 0.0
          RARC(1)  = 0.0
          THETAB   = 2.0*ASIN(HI(2)/2./RBOD)
          AREAS    = 0.5*RBOD**2*(THETAB - SIN(THETAB))
          AREA2    = WI(1)*HI(2) - AREAS
          DO 44 ICRX=2,5
            THETAB     = 2.0*ASIN(HI(ICRX)/2./RBOD)
            AREAS      = 0.5*RBOD**2*(THETAB - SIN(THETAB))
            AREAI(ICRX)= HI(ICRX)*WI(ICRX) - AREA2 - AREAS
            DEQI(ICRX) = SQRT(4.*(HI(ICRX)*WI(ICRX)-AREAS)/PI)
            RARC(ICRX) = 90./RAD - THETAB/2.
   44     CONTINUE
        ENDIF
      ENDIF
C
C     FOR AXISYMMETRIC INLETS WITH DIVERTERS OR SURFACE MOUNTED
C
      IF (INTYPE.EQ.3. .AND. HDIV.GE.0.0) THEN
        IF (ICOVER) THEN
          DO 50 ICRX=1,5
            AREAI(ICRX) = PI/4.*WI(ICRX)**2.
            DEQI(ICRX)  = WI(ICRX)
   50     CONTINUE
        ELSE
          AREAI(1) = 0.0
          DEQI(1)  = 0.0
          DO 60 ICRX=2,5
            AREAI(ICRX) = PI/4.*WI(ICRX)**2.-PI/4.*WI(2)**2.
            DEQI(ICRX)  = WI(ICRX)
   60     CONTINUE
        ENDIF
      ENDIF
C
C     FOR AXISYMMETRIC INLETS THAT ARE SEMI-SUBMERGED
C
C     THETAB = ANGLE FROM BODY CENTER TO BODY/INLET INTERSECTION PTS
C     THETI  = ANGLE FROM INLET CENTER TO INTERSECTION PTS
C     XINT   = DISTANCE TO INTERSECTION POINT ALONG A LINE CONNECTING
C              THE BODY CENTER TO INLET CENTER
C     YINT   = VERTICAL DISTANCE TO INTERSECTION POINT NORMAL TO A LINE
C              CONNECTING THE BODY CENTER TO INLET CENTER
C
      IF (INTYPE.EQ.3. .AND. HDIV.LT.0.0) THEN
        IF (ICOVER) THEN
          DO 61 ICRX=1,5
            RINL        = WI(ICRX)/2.
            XINT        = (RBOD**2 + RBOD*RINL + RBOD*HDIV + 
     1                    RINL*HDIV + HDIV**2/2.)/ (RBOD + RINL + HDIV)
            YINT        = SQRT(RBOD**2 - XINT**2)
            THETAB      = 2.*ATAN(YINT/XINT)
            THETI       = 2.*ATAN(YINT/(RBOD + RINL + HDIV - XINT))
            IF(THETI .LT. 0.0)THETI = THETI + 2.0*PI
            AREAS       = 0.5*RBOD**2*(THETAB - SIN(THETAB)) +
     1                    0.5*RINL**2*(THETI  - SIN(THETI))
            AREAI(ICRX) = PI/4.*WI(ICRX)**2. - AREAS
            DEQI(ICRX)  = SQRT(4.*(AREAI(ICRX) - AREAS)/PI)
            RARC(ICRX) = 90./RAD - THETAB/2.
   61     CONTINUE
        ELSE
          AREAI(1) = 0.0
          DEQI(1)  = 0.0
          RARC(1)  = 0.0
          DO 62 ICRX=2,5
            RINL        = WI(ICRX)/2.
            XINT        = (RBOD**2 + RBOD*RINL + RBOD*HDIV + 
     1                    RINL*HDIV + HDIV**2/2.)/ (RBOD + RINL + HDIV)
            YINT        = SQRT(RBOD**2 - XINT**2)
            THETAB      = 2.*ATAN(YINT/XINT)
            THETI       = 2.*ATAN(YINT/(RBOD + RINL + HDIV - XINT))
            IF(THETI .LT. 0.0)THETI = THETI + 2.0*PI
            AREAS       = 0.5*RBOD**2*(THETAB - SIN(THETAB)) +
     1                    0.5*RINL**2*(THETI  - SIN(THETI))
            AREAI(ICRX) = PI/4.*WI(ICRX)**2.-PI/4.*WI(2)**2.
            DEQI(ICRX)  = SQRT(4.*(PI*RINL**2 - AREAS)/PI)
            RARC(ICRX) = 90./RAD - THETAB/2.
   62     CONTINUE
        ENDIF
      ENDIF
C
C     VEHICLE SPAN CALCULATION USED TO DETERMINE WING-BODY CARRY
C     OVER AND ASPECT RATIO EFFECTS
C
      IF (INTYPE.EQ.1.)THEN
        SPAN = RBOD + HDIV + HI(3)
      ELSE
        SPAN = RBOD + HDIV + WI(3)
      ENDIF
      NUMI=NIN+0.5
      DO 70 INLET=1,NUMI
        KWA(INLET) = (1. + ABS(SIN(PHI(INLET)/RAD))*RBOD/SPAN)**2.
        KWB(INLET) = (1. + ABS(COS(PHI(INLET)/RAD))*RBOD/SPAN)**2.
        IF (INTYPE.EQ.1.) THEN
          RA2(INLET) = SPAN*ABS(SIN(PHI(INLET)/RAD)) +
     1                                ABS(COS(PHI(INLET)/RAD))*WI(3)/2.
          RB2(INLET) = SPAN*ABS(COS(PHI(INLET)/RAD)) +
     1                                ABS(SIN(PHI(INLET)/RAD))*WI(3)/2.
        ELSEIF (INTYPE.EQ.2.) THEN
          RA2(INLET) = SPAN*ABS(SIN(PHI(INLET)/RAD)) +
     1                                ABS(COS(PHI(INLET)/RAD))*HI(3)/2.
          RB2(INLET) = SPAN*ABS(COS(PHI(INLET)/RAD)) +
     1                                ABS(SIN(PHI(INLET)/RAD))*HI(3)/2.
        ELSEIF (INTYPE.EQ.3.) THEN
          RA2(INLET) = (SPAN-WI(3)/2.)*ABS(SIN(PHI(INLET)/RAD)) +
     1                                                          WI(3)/2.
          RB2(INLET) = (SPAN-WI(3)/2.)*ABS(COS(PHI(INLET)/RAD)) +
     1                                                          WI(3)/2.
        ENDIF
   70 CONTINUE
C
C
C     CALCULATE DIVERTER SPECIFIC GEOMETRY CHARACTERISTICS SUCH AS
C     HEIGTH, WIDTH, AND CROSS SECTIONAL AREA
C
      DO 79 IDCRX=1,3
        XD(IDCRX) = 0.0
        HD(IDCRX) = 0.0
        WD(IDCRX) = 0.0
        AREAD(IDCRX) = 0.0
        DEQD(IDCRX) = 0.0
        RARC(IDCRX) = 0.0
        RARX(IDCRX) = 0.0
   79 CONTINUE
C
      IF(HDIV .GT. 0.0)THEN
        XD(1) =  XDIV
        XD(2) =  XDIV + LDIV
        XD(3) =  XI(5)
        HD(1) =  HDIV
        WD(1) =  0.0
        AREAD(1) = 0.0
        DEQD(1)= WD(1)
        RARC(1)= 0.0
        RARX(1)= 0.0
        RARX(2)= 90./RAD
        RARX(3)= 90./RAD
        DO 80 J=1,4
          IF((INTYPE.EQ.1.).OR.(INTYPE.EQ.3.))THEN
            IF(ABS(XD(2)-XI(J+1)).LT.0.00001)WD(2)=WI(J+1)
            IF(XD(2).GT.XI(J).AND.XD(2).LT.XI(J+1))WD(2)=WI(J)+
     1             (XD(2)-XI(J))*(WI(J+1)-WI(J))/(XI(J+1)-XI(J))
          ELSEIF(INTYPE.EQ.2.)THEN
            IF(ABS(XD(2)-XI(J+1)).LT.0.00001)WD(2)=HI(J+1)
            IF(XD(2).GT.XI(J).AND.XD(2).LT.XI(J+1))WD(2)=HI(J)+
     1                     (XD(2)-XI(J))*(HI(J+1)-HI(J))/(XI(J+1)-XI(J))
          ENDIF
   80   CONTINUE
        WD(3)=WI(5)
        DEQD(2) = WD(2)
        DEQD(3) = WD(3)
        DO 90 I=2,3
          THETA = ACOS(WD(I)/(2.*RBOD))
          RARC(I) = 90./RAD - THETA
          HD(I) = HD(1) + RBOD*(1.-SIN(THETA))
          IF(INTYPE.EQ.3.)HD(I)=HD(1)+RBOD*(1.-SIN(THETA))+WD(I)/2.
          DLEN(I-1) = XD(I)-XD(I-1)
          XMIDD(I-1)= XD(I-1) + DLEN(I-1)/2.
          AREAD(I) = WD(I)*HD(I)-RBOD**2.*RARC(I)+
     1               0.5*RBOD*WD(I)*SIN(THETA)
          IF (INTYPE.EQ.3.) AREAD(I)=AREAD(I)-0.125*PI*WD(I)**2.
   90   CONTINUE
      ENDIF
C
C     CREATE PARAMETERS NEEDED BY THE CROSS FLOW DRAG ROUTINES
C
      CALL ILTVIN
C
C     DETERMINE ANGLES NEEDED BY THE CROSS FLOW DRAG ROUTINES
C
      CALL ILTANG
C
C     DETERMINE THE FINENESS RATIO OF THE VEHICLE COMPONENTS
C
      CALL ILTFR
C
C     DETERMINE NEWTONIAN CORRECTION FOR 2-D INLETS
C
      IF(INTYPE .NE. 3.)THEN
        DO 100 ICRX=1,5
          CALL ILTNWT(ICRX)
  100   CONTINUE
      ENDIF
C
C     DETERMINE INCREMENTS IN NEWTONIANS TERMS DUE TO DIVERTER
C     OR INLET OVERLAP WITH BODY
C
      IF(HDIV .GT. 0.0)THEN
        NCRX = 3
      ELSE
        NCRX = 5
      ENDIF
      DO 105 ICX = 1,NCRX
        CALL BODNWT(ICX)
  105 CONTINUE
C
C       DETERMINE NEWTONIAN CORRECTION FOR DIVERTERS
C
      IF(HDIV .GT. 0.0)THEN
        DO 110 IDCRX=1,3
          CALL DIVNWT(IDCRX)
  110   CONTINUE
      ELSE
        DO 120 IDCRX=1,3
          DO 122 IALP=1,20
            CRXDWD(IDCRX,IALP) = 0.0
            CRXDHT(IDCRX,IALP) = 0.0
            CNNDZP(IDCRX,IALP) = 0.0
            CNNDYP(IDCRX,IALP) = 0.0
            CNNDZN(IDCRX,IALP) = 0.0
            CNNDYN(IDCRX,IALP) = 0.0
  122     CONTINUE
  120   CONTINUE
        FRD = 0.0
        DO 130 IDCRX=1,5
          DO 132 IALP=1,20
            THETAD(IDCRX,IALP) = 0.0
            PANDLN(IDCRX,IALP) = 0.0
  132     CONTINUE
  130   CONTINUE
      ENDIF
C
C***  PRINT INLET GEOMETRY INPUTS
      IF (PARTS(15)) CALL INLETG
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE INTER5(X,X1,X2,X3,X4,X5,F1,F2,F3,F4,F5,F)
C     5 POINT LAGRANGE INTERPOLATION SUBROUTINE
C     X1.LE.X.LE.X5
      SL=(F3-F2)/(X3-X2)
      SLP=(F4-F3)/(X4-X3)
      SLM=(F2-F1)/(X2-X1)
      SLPP=(F5-F4)/(X5-X4)
      SL1=(SLPP-SLP)/(X5-X3)
      SL2=(SLP-SL)/(X4-X2)
      SL3=(SL-SLM)/(X3-X1)
      IF(SL1.EQ.0.0.OR.SL2.EQ.0.0.OR.SL3.EQ.0.0)GO TO 1000
      A1=(X-X2)*(X-X3)*(X-X4)*(X-X5)
      A2=(X-X1)*(X-X3)*(X-X4)*(X-X5)
      A3=(X-X1)*(X-X2)*(X-X4)*(X-X5)
      A4=(X-X1)*(X-X2)*(X-X3)*(X-X5)
      A5=(X-X1)*(X-X2)*(X-X3)*(X-X4)
      D1=(X1-X2)*(X1-X3)*(X1-X4)*(X1-X5)
      D2=(X2-X1)*(X2-X3)*(X2-X4)*(X2-X5)
      D3=(X3-X1)*(X3-X2)*(X3-X4)*(X3-X5)
      D4=(X4-X1)*(X4-X2)*(X4-X3)*(X4-X5)
      D5=(X5-X1)*(X5-X2)*(X5-X3)*(X5-X4)
      C1=A1/D1
      C2=A2/D2
      C3=A3/D3
      C4=A4/D4
      C5=A5/D5
      F=C1*F1+C2*F2+C3*F3+C4*F4+C5*F5
      GO TO 1030
 1000 IF(SL1.NE.0.0)GO TO 1010
      IF(X.GE.X3)F=F3+SLP*(X-X3)
      IF(X.LT.X3)F=F2+(X-X2)*(.5*(SL+SLM-SL3*(X3+X1-2.*X2))+SL3*(X-X2))
      GO TO 1030
 1010 IF(SL2.NE.0.0)GO TO 1020
      IF(X.GE.X4)F=F4+SLPP*(X-X4)
      IF(X.LE.X2)F=F1+SLM*(X-X1)
      IF(X.GT.X2.AND.X.LT.X4)F=F2+SL*(X-X2)
      GO TO 1030
 1020 IF(X.LE.X3)F=F1+SLM*(X-X1)
      IF(X.GT.X3)F=F4+(X-X4)*(.5*(SLPP+SLP-SL1*(X3+X5-2.*X4))+SL1*(X-X4)
     1)
 1030 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE OGIVE(AA,NX,X,R,BNOSE,TRUNC,LENGTH,DIAM,DISCON)
C
C***  COMPUTE THE CHARACTERISTICS OF A OGIVE SEGMENT
C
C***  INPUTS
C
C     NX -- NUMBER OF INPUT POINTS
C      X -- X STATIONS
C      R -- RADII AT EACH X STATION
C  BNOSE -- FORWARD RADIUS OF SECTION
C  TRUNC -- TRUNCATED FLAG (.TRUE. IF TRUNCATED NOT BLUNTED)
C LENGTH -- SECTION LENGTH
C   DIAM -- SECTION BASE DIAMETER
C
C***  OUTPUTS
C
C     AA -- ARRAY OF CHARACTERISTICS TO BE COMPUTED
C           AA(1)=PLANFORM AREA
C           AA(2)=WETTED AREA
C           AA(3)=VOLUME
C           AA(4)=VOLUME CENTROID
C           AA(5)=PLANFORM CENTROID
C           AA(6)=FINENESS RATIO
C           AA(7)=THEORETICAL LENGTH
C           AA(8)=THEORETICAL FINENESS RATIO
C DISCON -- ELEMENTS WHICH HAVE DISCONTINUOUS SLOPES
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION AA(8),X(50),R(50),XX(101),RR(101),DISCON(20)
C
      REAL NX,LENGTH
      LOGICAL TRUNC
C
C***  SKIP PRIMARY CALCULATIONS FOR HEMISPHERICAL CAP
C
      IF(2.*BNOSE .GE. DIAM .AND. .NOT. TRUNC)GO TO 1090
C
C***  COMPUTE GEOMETRY AT 101 POINTS
C
      NPTS=101
      IF(.NOT. TRUNC .AND. BNOSE .GT. UNUSED)NPTS=51
C
      IF(DIAM .GT. 2.*BNOSE)FR=LENGTH/DIAM
      IF(DIAM .LE. 2.*BNOSE)FR=LENGTH/(2.*BNOSE)
C
C  DO NOT DUPLICATE LAST POINT FOR THIS SEGMENT
C
      IF(NX .GT. UNUSED)NX=NX-1.
      NNX=NX+0.5
      XO=0.
      IF(NX .GT. UNUSED)XO=X(NNX+1)
C 
C  INITIALIZE THE X POSITION OF THE BLUNTED NOSE (XT) AND THE START OF THE 
C  FLARE SECTION (XF)
C
      XT=0.
      XF=0.
C
C  OGIVAL ARC RADIUS
C
      ETA=ABS((LENGTH*(LENGTH-2.*BNOSE)+(DIAM/2.)**2)/(DIAM-2.*BNOSE))
C
C  COMPUTE ARC IF TRUNCATED
C
      ABSDMB=ABS(DIAM/2.-BNOSE)
      IF(TRUNC)ETA=(LENGTH**2+ABSDMB**2)/(2.*ABSDMB)
C
C***  SURFACE X AND R COORDINATES
C
C  BLUNTED NOSE
C
      ILAST=0
C
      IF(TRUNC .OR. BNOSE .LE. UNUSED)GO TO 1010
C
C  POINT OF TANGENCY OF BLUNTED NOSE
C
      XT=BNOSE*(ETA-LENGTH)/(ETA-BNOSE)
      YT=SQRT(XT*(2.*BNOSE-XT))
C
      IF(DIAM .GT. 2.*BNOSE)THEOL=DIAM*SQRT(ETA/DIAM-0.25)
      IF(DIAM .LE. 2.*BNOSE)THEOL=2.*BNOSE*SQRT(ETA/2./BNOSE-0.25)
C
      DO 1000 I=1,NPTS
         XX(I)=FLOAT(I-1)*XT/FLOAT(NPTS-1)
         RR(I)=SQRT(BNOSE**2-(XX(I)-BNOSE)**2)
         XX(I)=XX(I)+THEOL-LENGTH
 1000 CONTINUE
C
      ILAST=NPTS-1
C
 1010 CONTINUE
C
C  THEORETICAL LENGTH OF SHARP OGIVE
C
      IF(DIAM .GT. 2.*BNOSE)THEOL=DIAM*SQRT(ETA/DIAM-0.25)
      IF(DIAM .LE. 2.*BNOSE)THEOL=2.*BNOSE*SQRT(ETA/2./BNOSE-0.25)
C
      IF(DIAM .GT. 2.*BNOSE)FF=THEOL/DIAM
      IF(DIAM .LE. 2.*BNOSE)FF=THEOL/(2.*BNOSE)
C
C  ON SHAPED SEGMENT
C
C     COMPUTE THE DISTANCE FROM THJE THEORETICAL NOSE TIP TO THE START
C     OF THE FLARE
C
      IF (TRUNC .AND. BNOSE .GT. UNUSED) XF=THEOL-LENGTH
      DO 1040 I=1,NPTS
         L=I+ILAST
         IF(BNOSE .GT. DIAM/2.)GO TO 1020
C
C  HERE FOR NOSES OR FLARES
C
         XX(L)=THEOL-LENGTH+XT+(LENGTH-XT)/FLOAT(NPTS-1)*FLOAT(I-1)
C
         RR(L)=DIAM/2.*(1.+2.*(SQRT((FF**2-.25)**2+FF**2*(2.*XX(L)/
     1        THEOL-XX(L)**2/THEOL**2))-(FF**2+.25)))
C
C  IF CHECK IS TO PREVENT THE USE OF THIS CORRECTION FOR NOSES SINCE
C  IT IS INTENDED FOR USE WITH FLARES
C
         IF (NX .GT. UNUSED) XX(L)=XX(L)-XF
C
         GO TO 1030
C
 1020    CONTINUE
C
C  HERE FOR BOATTAILS
C
         XX(L)=LENGTH/FLOAT(NPTS-1)*FLOAT(I-1)
         RR(L)=SQRT(ETA**2-XX(L)**2)-(ETA-BNOSE)
C
 1030    CONTINUE
C
         XX(L)=XX(L)+XO
C
 1040 CONTINUE
C
C***  EXTRACT EVERY TENTH POINT FOR OUTPUT AND SUBSEQUENT CALCS.
C
      II=0
      DO 1050 I=1,101,10
         II=II+1
         L=II+NNX
         X(L)=XX(I)
         R(L)=RR(I)
 1050 CONTINUE
C
C  UPDATE POINT TOTAL
C
      NX=NX+FLOAT(II)
C
C  PLANFORM AREA
C
      SP=DSPLAN(101,XX,RR)
C
C  WETTED AREA
C
      SW=DSWET(101,XX,RR)
C
C  VOLUME
C
      VOL=DVOL(101,XX,RR)
C
C  VOLUME CENTROID
C
      XCENV=DXCENV(101,XX,RR)
C
C  PLANFORM AREA CENTROID
C
      XCENP=DXCENP(101,XX,RR)
C
C  STORE FOR RETURN TO CALLING ROUTINE
C
      AA(1)=SP
      AA(2)=SW
      AA(3)=VOL
      AA(4)=XCENV
      AA(5)=XCENP
      AA(6)=FR
      AA(7)=THEOL
      AA(8)=FF
C
C  SET DISCONTINUOUS POINTS
C
      DO 1060 I=1,20
         JJ=I
         IF(DISCON(I).EQ.UNUSED)GO TO 1070
 1060 CONTINUE
      GO TO 1080
C
C  END OF SEGMENT IS DISCONTINUOUS IF BNOSE .GT. DIAM/2. OR
C  FIRST OF SEGMENT IS DISCONTINUOUS IF TRUNCATED
C
 1070    IF(TRUNC .AND. 2.*BNOSE .LE. DIAM)DISCON(JJ)=NX-FLOAT(II)+1
         NNN=0
         IF(TRUNC .AND. 2.*BNOSE .LE. DIAM)NNN=1
         IF(BNOSE .GT. DIAM/2.)DISCON(JJ+NNN)=NX
 1080 CONTINUE
C
      GO TO 1100
C
C***  HERE FOR SPHERICAL CAP
C
 1090 CONTINUE
C
      IF(LENGTH .GT. BNOSE)LENGTH=BNOSE
C
      CALL SPHERE(AA,NX,X,R,DIAM)
C
 1100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RFIN1(LFIN1, AA)
C
C***  READ FINSET1 INPUTS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION AA(399),NLNAME(6),IVNAME(113),LEN(23),IDIM(23),LOC(23)
C
      LOGICAL LFIN1,IEOF
C
      DATA NLNAME /  'F   ','I   ','N   ','S   ','E   ','T   '/
      DATA IVNAME /  'S   ','E   ','C   ','T   ','Y   ','P   ','S   ',
     1 'S   ','P   ','A   ','N   ','L   ','M   ','A   ','X   ','U   ',
     2 'L   ','F   ','L   ','A   ','T   ','U   ','L   ','M   ','A   ',
     3 'X   ','L   ','L   ','F   ','L   ','A   ','T   ','L   ','C   ',
     4 'H   ','O   ','R   ','D   ','Z   ','U   ','P   ','P   ','E   ',
     5 'R   ','Z   ','L   ','O   ','W   ','E   ','R   ','S   ','W   ',
     6 'E   ','E   ','P   ','S   ','T   ','A   ','X   ','L   ','E   ',
     7 'N   ','P   ','A   ','N   ','E   ','L   ','X   ','C   ','O   ',
     8 'R   ','D   ','M   ','E   ','A   ','N   ','T   ','H   ','I   ',
     9 'C   ','K   ','Y   ','U   ','P   ','P   ','E   ','R   ','Y   ',
     A 'L   ','O   ','W   ','E   ','R   ','F   ','I   ','N   ','P   ',
     B 'H   ','I   ','L   ','E   ','R   ','G   ','A   ','M   ','P   ',
     C 'H   ','I   ','F   ','C   ','F   ','O   ','C   '/
      DATA IDIM   / 1,10,10,10,10,10,10,10,10,10,10,10,1,50,50,50,50,
     1              50,1,10,8,8,10 /
      DATA LEN    / 6,5,5,6,5,6,5,6,6,5,3,3,6,5,4,5,6,6,6,3,3,4,4 /
      DATA LOC    / 1,2,12,22,32,42,52,62,72,82,92,102,112,113,163,213,
     1              263,313,363,364,374,382,390 /
C
      LFIN1=.TRUE.
C
      CALL NAMER(KAND,2,NLNAME,6,IVNAME,113,LEN,23,IDIM,AA,399,LOC,
     1 IEOF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SUBPTS(NX,X,R,MACH,CNALP,CMNCB)
C
C  THIS ROUTINE CALCULATES THE POTENTIAL NORMAL FORCE
C  AND PITCHING MOMENT SLOPE ABOUT THE NOSE AT
C  AT SUB/TRANSONIC SPEEDS FOR ARBITRARY BODIES (X,R)
C
C  CNSUM:  NORMAL FORCE DERIVATIVE WITH ANGLE OF ATTACK
C  CMSUM:  PITCHING MOMENT DERIVATIVE WITH ANGLE OF ATTACK
C          REFERENCED TO NOSE
C  FVOL:   VOLUME OF CONICAL FRUSTUM BETWEEN X-STATIONS
C  SBFACT: SLENDER BODY THEORY NORMAL FORCE SLOPE CORRECTED
C          FOR COMPRESSIBILITY (NOMINAL VALUE=2)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
C
      REAL MACH,LREF,LMAX,NX
      DIMENSION X(50),R(50),S(50)
C
      NNX=NX+0.5
      DMAX=0.
      LMAX=X(NNX)-X(1)
      DO 500 I=1,NNX
         IF(2.*R(I).GT.DMAX) DMAX=2.*R(I)
         S(I)=PI*R(I)**2
  500 CONTINUE
C
C TRANSONIC SLENDER BODY THEORY CORRECTION FACTORS (EMPIRICAL)
C
      IF(MACH.LT.0.6) FM=1.0
      IF(MACH.GE.0.6) FM=1.+0.2*(MACH-0.6)
     1           +1.2562*(MACH-0.6)**2-1.74305*(MACH-0.6)**3
      FL=2.5+5./(6.*PI)*ATAN((LMAX/DMAX-15.)/3.)
C
C  INTEGRATE ALONG BODY
C
      CNSUM=0.
      CMSUM=0.
      SBFACT=2.
C     SBFACT=FL*FM
      DO 600 I=1,NNX-1
         CNSUM=CNSUM+SBFACT*(S(I+1)-S(I))/SREF
         FVOL=(X(I+1)-X(I))*(S(I+1)+S(I)+PI*R(I+1)*R(I))/3.
         CMSUM=CMSUM-SBFACT*(X(I+1)*S(I+1)-X(I)*S(I)-FVOL)/(LREF*SREF)
  600 CONTINUE
C
      CNALP=CNSUM
      CMNCB=CMSUM
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WRFIN3
C
C***  WRITE FINSET3 INPUTS
C
C  WRITTEN BY S. STOY, MCDONNELL DOUGLAS
C
      COMMON /FSET3/ AA(399)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION NLNAME(7),IVNAME(113),LEN(23),IDIM(23),LOC(23)
C
      DATA NLNAME /  'F   ','I   ','N   ','S   ','E   ','T   ','3   '/
      DATA IVNAME /  'S   ','E   ','C   ','T   ','Y   ','P   ','S   ',
     1 'S   ','P   ','A   ','N   ','L   ','M   ','A   ','X   ','U   ',
     2 'L   ','F   ','L   ','A   ','T   ','U   ','L   ','M   ','A   ',
     3 'X   ','L   ','L   ','F   ','L   ','A   ','T   ','L   ','C   ',
     4 'H   ','O   ','R   ','D   ','Z   ','U   ','P   ','P   ','E   ',
     5 'R   ','Z   ','L   ','O   ','W   ','E   ','R   ','S   ','W   ',
     6 'E   ','E   ','P   ','S   ','T   ','A   ','X   ','L   ','E   ',
     7 'N   ','P   ','A   ','N   ','E   ','L   ','X   ','C   ','O   ',
     8 'R   ','D   ','M   ','E   ','A   ','N   ','T   ','H   ','I   ',
     9 'C   ','K   ','Y   ','U   ','P   ','P   ','E   ','R   ','Y   ',
     A 'L   ','O   ','W   ','E   ','R   ','F   ','I   ','N   ','P   ',
     B 'H   ','I   ','L   ','E   ','R   ','G   ','A   ','M   ','P   ',
     C 'H   ','I   ','F   ','C   ','F   ','O   ','C   '/
      DATA IDIM   / 1,10,10,10,10,10,10,10,10,10,10,10,1,50,50,50,50,
     1              50,1,10,8,8,10 /
      DATA LEN    / 6,5,5,6,5,6,5,6,6,5,3,3,6,5,4,5,6,6,6,3,3,4,4 /
      DATA LOC    / 1,2,12,22,32,42,52,62,72,82,92,102,112,113,163,213,
     1              263,313,363,364,374,382,390 /
C
      CALL NAMEW(KAND,6,NLNAME,7,IVNAME,113,LEN,23,IDIM,AA,399,LOC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDAMP(IM)
C      
C  REV 1/96 UPDATE - NEW SUBROUTINE
C
C*** SUBROUTINE FOR CALCULATING BODY ALONE DYNAMIC
C*** DERIVATIVES.  SLENDER BODY THEORY RELATIONSIPHS
C*** BETWEEN THE STATIC AND DYNAMIC DERIVATIVES ARE USED.
C*** LMSC METHOD USED FOR CMQ+CMAD COMBINATION
C
C  WRITTEN BY W. BLAKE, WL/FIGC
C
C*** REF: NACA TN-3283, SACKS (POINTED NOSES)
C*** WL/FIGC RESULTS (TRUNCATED NOSES)
C
C    LB  = TOTAL BODY LENGTH
C    XVC = CENTROID OF BODY VOLUME, AFT OF APEX 
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      COMMON /GEOBOD/ GEBOD(47)
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,
     1                BLAYER,RHR
C
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     1                TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,POWER,
     2                DUM(768)
C
      COMMON /SBODY/  CBODY(220)
      COMMON /DBODY/ BCNQ(20),BCMQ(20),BCAQ(20),BCYQ(20),
     1  BCLNQ(20),BCLLQ(20),BCNR(20),BCMR(20),BCAR(20),
     2  BCYR(20),BCLNR(20),BCLLR(20),BCNP(20),BCMP(20),
     3  BCAP(20),BCYP(20),BCLNP(20),BCLLP(20),
     4  BCNAD(20),BCMAD(20),CLLP,CYP,CNP1,CNP3,CNP5,CNPY5
C
      REAL LREF,LATREF,NALPHA,MACH,LAFT,LB,LNOSE,LATR,LN,LT
C
      COMMON /LOGIC/ LOG(28)
      DIMENSION BCYBD(20),BCNBD(20)
      LOGICAL LOG,TRUNC
C
C*** SET ROLL AXIS DERIVATIVES TO ZERO
C
      DO 1000 I=1,20
         BCYP(I)=0.
         BCLNP(I)=0.
         BCLLP(I)=0.
         BCAQ(I)=0.
         BCLLR(I)=0.
 1000 CONTINUE
C
C*** RETRIEVE GEOMETRY PARAMETERS FROM APPROPRIATE COMMON BLOCK
C
      VB=GEBOD(27)
      XVC=GEBOD(28)
      SB=GEBOD(32)
      LB=GEBOD(35)
C     LN=BODIN(104)
C     DN=BODIN(105)
C     BD=BODIN(109)
C     LAFT=BODIN(111)
C     AI=BODIN(113)
C     IOPT=BODIN(103)+1.5
C     RO=BODIN(106)
C     XO=BODIN(2)
      SO=0.
      IF(TRUNC) SO=PI*BNOSE**2
C
C*** CALCULATE DYNAMIC DERIVATIVES USING STATIC FORCE AND MOMENT
C*** SLOPE VALUES AT ZERO ANGLE OF ATTACK
C
      NALP=NALPHA+0.5
      CALL LNTRP(ALPHA,CBODY(121),NALP,0.,CNA)
      CALL LNTRP(ALPHA,CBODY(141),NALP,0.,CMA)
      CALL LNTRP(ALPHA,CBODY(161),NALP,0.,CYB)
      CALL LNTRP(ALPHA,CBODY(181),NALP,0.,CLNB)
      DO 1100 I=1,NALP
         BCNQ(I) = CNA*RAD*(LB-(XCG-XO))/LREF+SO*LB/LREF
         BCNAD(I)= BCNQ(I)+CMA*RAD
         BCMAD(I)= BCNAD(I)*((XCG-XO)-XVC)/LREF
         BCMQ(I) = -(CNA*RAD-SO/SREF)*((LB-(XCG-XO))/LREF)**2
     1             -BCMAD(I)
C
         BCYR(I) = -CYB*RAD*(LB-(XCG-XO))/LATREF+SO*LB/LATREF
         BCYBD(I)= BCYR(I)-CLNB*RAD
         BCNBD(I)= BCYBD(I)*((XCG-XO)-XVC)/LATREF
         BCLNR(I)= -(-CYB*RAD-SO/SREF)*((LB-(XCG-XO))/LATREF)**2
     1             -BCNBD(I)
 1100 CONTINUE
C
C*** AT SUBSONIC/TRANSONIC SPEEDS USE LMSC METHOD FOR CMQ+CMAD
C*** USING ABOVE RESULTS TO DIVIDE CMQ+CMAD INTO CMQ AND CMAD
C
      IF(MACH(IM).GT.1.2) GO TO 1400
      DO 1300 I=1,NALP
      PSI=0.77+0.23*MACH(IM)**2
      CMQPAD=-2.*PSI*((LB*SQRT(PSI)-(XCG-XO))/LREF)**2
      CMQR=BCMQ(I)/(BCMQ(I)+BCMAD(I))
      CMADR=BCMAD(I)/(BCMQ(I)+BCMAD(I))
      BCMQ(I)=CMQR*CMQPAD
      BCMAD(I)=CMADR*CMQPAD
      BCLNR(I)=BCMQ(I)*LREF**2/LATREF**2
 1300 CONTINUE
 1400 CONTINUE

      IF(.NOT.LOG(27)) GO TO 2000
C
C*** MAGNUS ANALYSIS FOR SPIN STABILIZED BODIES
C
C*** OBTAIN REQUIRED GEOMETRY DATA
C
      LN=LNOSE
      DN=DNOSE
      LT=LAFT
      DC=DCENTR
      FM=MACH(IM)
      VCG=XCG
      SR=SREF
      LATR=LATREF
      TYPEN=TNOSE
      AI=POWER
C
C*** CALCULATE EQUIVALENT OGIVE RADIUS
C
      IF(TYPEN.GE.3.) TYPEN=1.
      IF(TYPEN.EQ.0.) OR=500.
      IF(TYPEN.EQ.1.) OR=(LN/DN)**2+0.25
      IF(TYPEN.NE.2.) GO TO 1500
         T=0.5**AI
         FN=LN/DC
         R2=(4.*FN**2+1.)*(T**2+FN**2)*(T**2-2*T+FN**1+1.)/
     1      (FN*(2*T-1.))**2
         OR=0.25*SQRT(R2)
 1500 CONTINUE
C
C*** CALL SPIN 83
C
      CALL SPIN83(LN,LB,LT,DC,FM,VCG,OR,SR,LATR)
C
 2000 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BOTCA(ISHAPE, SREF, BOTLEN, MISDIA, BASDIA, FMACH,
     1                 XSEPA0, PBASE, BOTDCA)
C
C     THIS SUBROUTINE CALCULATES THE INCREMENTAL AXIAL FORCE ON A
C     BOATTAIL DUE TO FLOW SEPARATION.  PRANDTL-MEYER EXPANSION IS
C     USED TO DETERMINE THE SURFACE PRESSURE AHEAD OF SEPARATION,
C     AND THE BASE PRESSURE IS USED BEHIND SEPARATION.
C
C  WRITTEN BY A. JENN, MCDONNELL DOUGLAS
C
      REAL PMACH(41), PMU(41), MISDIA
C
      PARAMETER (GAMMA = 1.4)
C
C     DATA STATEMENTS FOR PRANDTL MEYER FUNCTION
      DATA PMACH / 2.00,  2.10,  2.20,  2.30,  2.40,  2.50,  2.60,
     1             2.70,  2.80,  2.90,  3.00,  3.10,  3.20,  3.30,
     2             3.40,  3.50,  3.60,  3.70,  3.80,  3.90,  4.00,
     3             4.10,  4.20,  4.30,  4.40,  4.50,  4.60,  4.70,
     4             4.80,  4.90,  5.00,  5.10,  5.20,  5.30,  5.40,
     5             5.50,  5.60,  5.70,  5.80,  5.90,  6.00 /
      DATA PMU   /26.38, 29.10, 31.73, 34.28, 36.75, 39.12, 41.41,
     1            43.62, 45.75, 47.79, 49.76, 51.65, 53.47, 55.22,
     2            56.91, 58.53, 60.09, 61.60, 63.04, 64.44, 65.78,
     3            67.08, 68.33, 69.54, 70.71, 71.83, 72.92, 73.97,
     4            74.99, 75.97, 76.92, 77.84, 78.73, 79.60, 80.43,
     5            81.24, 82.03, 82.80, 83.54, 84.26, 84.96 /
C
C     DETERMINE VALUE OF PI
      PI = ACOS(-1.0)
C
C     CALCULATE THE MISSILE CROSS SECTIONAL AREA
      ARAMIS = PI * MISDIA**2 / 4.0
C
C     CHECK FOR BODY SHAPE
      IF (ISHAPE .EQ. 1 .OR. BASDIA .GE. MISDIA) THEN
C
C        CYLINDRICAL BOATTAIL
C
C        NO AXIAL FORCE CONTRIBUTION
         BOTDCA = 0.0
C
      ELSE IF (ISHAPE .EQ. 2) THEN
C
C        CONICAL BOATTAIL
C
C        CALCULATE BOATTAIL DIAMETER AT SEPARATION
         DBSEP = BASDIA + (MISDIA - BASDIA) * XSEPA0 / BOTLEN
C
C        CALCULATE AXIAL PROJECTION SEPARATED SURFACE AREA
         ARASEP = PI * (DBSEP**2 - BASDIA**2) / 4.0
C
C        CALCULATE THE FREESTREAM PRANDTL MEYER ANGLE
         CALL TABLOK(1,41,41,41,PMACH,PMU,FMACH,FMU,0,IERR)
C
C        CALCULATE THE BOATTAIL ANGLE
         DR = (MISDIA - BASDIA) / 2.0
         BETAM = ATAN(DR / BOTLEN) * 180.0 / PI
C                               
C        CALCULATE THE PRANDTL MEYER ANGLE ON THE BOATTAIL
         BMU = FMU + BETAM
C
C        DETERMINE THE MACH NUMBER ON THE BOATTAIL
         CALL TABLOK(1,41,41,41,PMU,PMACH,BMU,BMACH,0,IERR)
C
C        CALCULATE THE BOATTAIL TO FREESTREAM STATIC PRESSURE RATIO
         PTOPF = (1.0 + (GAMMA - 1.0) / 2.0 * FMACH**2)**(GAMMA / 
     1           (GAMMA - 1.0))
         PTOPB = (1.0 + (GAMMA - 1.0) / 2.0 * BMACH**2)**(GAMMA / 
     1           (GAMMA - 1.0))
         PBOAT = PTOPF / PTOPB
C
C        CALCULATE CP ON THE BOATTAIL
         CPBOAT = 2.0 / (GAMMA * FMACH**2) * (PBOAT - 1.0)
C
C        CALCULATE CP ON THE BASE
         CPBASE = 2.0 / (GAMMA * FMACH**2) * (PBASE - 1.0)
C
C        CALCULATE UNSEPARATED CA FOR THE SEPARATED REGION
         CABU = -CPBOAT * ARASEP / ARAMIS
         CABU=CABU*ARAMIS/SREF
C
C        CALCULATE SEPARATED CA FOR THE SEPARATED REGION
         CABS = -CPBASE * ARASEP / ARAMIS
         CABS=CABS*ARAMIS/SREF
C
C        CALCULATE INCREMENTAL CA DUE TO SEPARATION
         BOTDCA = CABS - CABU
C
      ELSE
C
C        OGIVE BOATTAIL
C
C        CALCULATE BOATTAIL RADIUS OF CURVATURE
         DR = (MISDIA - BASDIA) / 2.0
         RCUR = (DR**2 + BOTLEN**2) / (2.0 * DR)
C
C        DETERMINE LENGTH OF UNSEPARATED BOATTAIL
         BOTLS = BOTLEN - XSEPA0
C
C        BOATTAIL DIAMETER AT SEPARATION
         P = SQRT(RCUR**2 - BOTLEN**2)
         DBSEP = BASDIA + 2.0 * (SQRT(RCUR**2 - BOTLS**2) - P)
C
C        CALCULATE AXIAL PROJECTION SEPARATED SURFACE AREA
         ARASEP = PI * (DBSEP**2 - BASDIA**2) / 4.0
C
C        CALCULATE THE FREESTREAM PRANDTL MEYER ANGLE
         CALL TABLOK(1,41,41,41,PMACH,PMU,FMACH,FMU,0,IERR)
C
C        DEFINE PANEL LENGTH FOR SEPARATED REGION OF BOATTAIL
         PERSEP = XSEPA0 / BOTLEN       
         NPAN   = NINT(20.0 * PERSEP + 1.0)  
C
C        DETERMINE INCREMENTAL PANEL LENGTH
         DXP = XSEPA0 / NPAN
C
C        INITIALIZE VARIABLES FOR AXIAL FORCE SUMMATION
         XLAS = BOTLS
         RLAS = DBSEP / 2.0
         CABU = 0.0
C
C        LOOP FOR EACH UNSEPARATED PANEL ON THE BOATTAIL
         DO 100 IPAN = 1, NPAN
C
C           DETERMINE THE PANEL MID AND END POINT
            XEND = XLAS + DXP
            XMID = (XEND + XLAS) / 2.0
C
C           DETERMINE THE ANNUAR RADIUS AND AXIAL PROJECTION
            REND = BASDIA / 2.0 + (SQRT(RCUR**2 - XEND**2) - P)
            ARARNG = PI * (RLAS**2 - REND**2)
C
C           SAVE PANEL AXIAL LOCATION AND RADIUS FOR NEXT PANEL
            RLAS = REND
            XLAS = XEND
C
C           DETERMINE THE ANGLE AT THE PANEL MIDPOINT
            BETAM = ATAN(XEND / SQRT(RCUR**2 - XEND**2)) * 180.0 / PI
C
C           CALCULATE THE PRANDTL MEYER ANGLE ON THE PANEL
            BMU = FMU + BETAM
C
C           DETERMINE THE MACH NUMBER ON THE PANEL
            CALL TABLOK(1,41,41,41,PMU,PMACH,BMU,BMACH,0,IERR)
C
C           CALCULATE THE PANEL TO FREESTREAM STATIC PRESSURE RATIO
            PTOPF = (1.0 + (GAMMA - 1.0) / 2.0 * FMACH**2)**(GAMMA / 
     1              (GAMMA - 1.0))
            PTOPP = (1.0 + (GAMMA - 1.0) / 2.0 * BMACH**2)**(GAMMA / 
     1              (GAMMA - 1.0))
            PPAN = PTOPF / PTOPP
C
C           CALCULATE CP ON THE PANEL
            CPPAN = 2.0 / (GAMMA * FMACH**2) * (PPAN - 1.0)
C
C           INCREMENT THE AXIAL FORCE COEFFICIENT
            CABU = CABU - CPPAN * ARARNG / ARAMIS
C
  100    CONTINUE
C
         CABU=CABU*ARAMIS/SREF
C
C        CALCULATE CP ON THE BASE
         CPBASE = 2.0 / (GAMMA * FMACH**2) * (PBASE - 1.0)
C
C        CALCULATE SEPARATED CA FOR THE SEPARATED REGION
         CABS = -CPBASE * ARASEP / ARAMIS
         CABS=CABS*ARAMIS/SREF
C
C        CALCULATE INCREMENTAL CA DUE TO SEPARATION
         BOTDCA = CABS - CABU
C
      END IF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CORDSP(X,XU,XL,YUU,YLL,YU,YL,L,I,J,K,II,JJ,KK,III,JJJ,
     1 KKK,LLL,TOC,XT,KSHARP)
C
C*****
C***** CALCULATE SUPERSONIC AIRFOIL COORDINATES
C*****
C
C  ROUTINE ADAPTED FROM DIGITAL DATCOM
C  ORIGINAL ROUTINE WRITTEN BY D. KINSEY, D. BOWERS, AFFDL
C  MODIFIED BY S.R. VUKELICH, MCDONNELL DOUGLAS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION X(50),XU(50),XL(50),YUU(50),YLL(50),YU(50),YL(50)
C
      REAL KSHARP
      XT=(100.*J+10.*K+II)/1000.
      TOC=(100.*JJ+10.*KK+III)/1000.
      XF=(100.*JJJ+10.*KKK+LLL)/1000.
      GO TO (1020,1000,1050), I
 1000 CONTINUE
C
C**** HERE FOR BICONVEX (CIRCULAR ARC)
C
      XT=0.50
      KSHARP=16./3.
      RC=(TOC**2+1.)/(4.*TOC)
      DO 1010 IL=1,L
      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 CONTINUE
      GO TO 1090
 1020 CONTINUE
C
C**** HERE FOR DOUBLE WEDGE
C
      KSHARP=16./3.
      IF(XT .NE. 1.)KSHARP=(1./XT)/(1.-XT)
      DO 1040 IL=1,L
      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 CONTINUE
      GO TO 1090
 1050 CONTINUE
C
C**** HERE FOR HEXAGONAL
C
      OMTMF=1.-XT-XF
      KSHARP=16./3.
      IF(OMTMF .GT. 0.)KSHARP=(1.-XF)/(OMTMF*XT)
      DO 1080 IL=1,L
      XU(IL)=X(IL)
      XL(IL)=X(IL)
      IF(X(IL).GT.(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 IF(OMTMF .LE. 0.)GO TO 1060
      YU(IL)=TOC/2.-(X(IL)-XT-XF)*TOC/(2.*OMTMF)
      YL(IL)=-YU(IL)
 1080 CONTINUE
 1090 CONTINUE
      IF(ABS(YU(L)) .LT. 0.00001)YU(L)=0.
      IF(ABS(YL(L)) .LT. 0.00001)YL(L)=0.
      DO 1100 IL=1,L
      YUU(IL)=YU(IL)
      YLL(IL)=YL(IL)
 1100 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION DVOL(NPTS,X,R)
C
C**  FUNCTION TO COMPUTE THE VOLUME
C
C***  INPUTS
C
C  NPTS -- NUMBER OF INPUT POINTS
C     X -- X STATIONS
C     R -- RADII AT EACH X STATION
C
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION X(NPTS),R(NPTS)
C
      DVOL=0.0
      DO 1000 I=2,NPTS
         DX=X(I)-X(I-1)
         DVOL=DVOL+PI/3.*DX*(R(I)**2+R(I-1)**2+R(I)*R(I-1))
 1000 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FDAMP(IM)
C
C  THIS ROUTINES CALCULATES THE FIN CONTRIBUTION TO THE
C  ALPHA-DOT DYNAMIC DERIVATIVES USING SLENDER BODY THEORY
C
C  WRITTEN BY WILLIAM BLAKE
C  REV 5/97 UPDATE - NEW ROUTINE
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
C
      COMMON /FSET1/  FDATA1(399)
      COMMON /FSET2/  FDATA2(399)
      COMMON /FSET3/  FDATA3(399)
      COMMON /FSET4/  FDATA4(399)
      COMMON /GEOFS1/  GFIN1(188)
      COMMON /GEOFS2/  GFIN2(188)
      COMMON /GEOFS3/  GFIN3(188)
      COMMON /GEOFS4/  GFIN4(188)
C
      COMMON /DBODY/ DUM0(360),BCNAD(20),BCMAD(20),SCR(6)
      COMMON /DB1/   DUM1(360),D1CNAD(20),D1CMAD(20)
      COMMON /DB12/  DUM2(360),D2CNAD(20),D2CMAD(20)
      COMMON /DB123/ DUM3(360),D3CNAD(20),D3CMAD(20)
      COMMON /DB1234/DUM4(360),D4CNAD(20),D4CMAD(20)
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,LDERRD,LPART,
     1               LDUM(4),LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,LDUM2(6),
     2               LELLB,LDUM3(3),LSPIN,LARBOD
      DIMENSION PHI1(8),PHI2(8),PHI3(8),PHI4(8),TCN(4),TCM(4)
      DIMENSION GAM1(8),GAM2(8),GAM3(8),GAM4(8)
      EQUIVALENCE (PHI1(1),FDATA1(382)),(PHI2(1),FDATA2(382))
      EQUIVALENCE (PHI3(1),FDATA3(382)),(PHI4(1),FDATA4(382))
      EQUIVALENCE (GAM1(1),FDATA1(374)),(GAM2(1),FDATA2(374))
      EQUIVALENCE (GAM3(1),FDATA3(374)),(GAM4(1),FDATA4(374))
C
      LOGICAL     LFIN1,LFIN2,LFIN3,LFIN4
      REAL MACH,NALPHA,LREF
      REAL NPAN1,NPAN2,NPAN3,NPAN4
C
      NALP=NALPHA+0.5
C
      IF(.NOT. LFIN1) GO TO 2000
C
C   BODY+1 FIN SET
C
      SPAN=2.*GFIN1(173)
      AREA=2.*GFIN1(174)
      PCENT=GFIN1(187)
      XLE=FDATA1(102)
      XCENT=PCENT+XLE
      AR=SPAN**2/AREA
      NPAN1=FDATA1(112)
      NP=NPAN1+0.5
C
C  ANGLE OF ATTACK LOOP
C
      DO 1100 I=1,NALP
      TCN(1)=0.
      TCM(1)=0.
C
C  COMPUTE AND SUM INDIVIDUAL PANEL VALUES
C
        DO 1110 II=1,NP
          CCORR=( SIN( (PHI1(II)+GAM1(II)) /RAD) )**2
          F1CNAD=2.*PI/3.*CCORR*(SPAN/LREF)*(AREA/SREF)
          F1CMAD=F1CNAD*(XCG-XCENT)/LREF
     1    -1.*PI/(9.*AR)*CCORR*(SPAN/LREF)**2*(AREA/SREF)
          TCN(1)=TCN(1)+0.5*F1CNAD
          TCM(1)=TCM(1)+0.5*F1CMAD
 1110   CONTINUE
C
C  ADD TO BODY ALONE TO GET BODY +1 FIN SET TOTAL
C
        D1CNAD(I)=BCNAD(I)+TCN(1)
        D1CMAD(I)=BCMAD(I)+TCM(1)
 1100 CONTINUE
C
      IF(.NOT. LFIN2) GO TO 2000
C
C   BODY+2 FIN SETS
C
      SPAN=2.*GFIN2(173)
      AREA=2.*GFIN2(174)
      PCENT=GFIN2(187)
      XLE=FDATA2(102)
      XCENT=PCENT+XLE
      AR=SPAN**2/AREA
      NPAN1=FDATA2(112)
      NP=NPAN1+0.5
C
C  ANGLE OF ATTACK LOOP
C
      DO 1200 I=1,NALP
      TCN(2)=0.
      TCM(2)=0.
C
C  COMPUTE AND SUM INDIVIDUAL PANEL VALUES
C
        DO 1210 II=1,NP
          CCORR=( SIN( (PHI2(II)+GAM2(II)) /RAD) )**2
          F2CNAD=2.*PI/3.*CCORR*(SPAN/LREF)*(AREA/SREF)
          F2CMAD=F2CNAD*(XCG-XCENT)/LREF
     1    -1.*PI/(9.*AR)*CCORR*(SPAN/LREF)**2*(AREA/SREF)
          TCN(2)=TCN(2)+0.5*F2CNAD
          TCM(2)=TCM(2)+0.5*F2CMAD
 1210   CONTINUE
C
C  ADD TO BODY ALONE TO GET BODY+2 FIN SETS TOTAL
C
        D2CNAD(I)=D1CNAD(I)+TCN(2)
        D2CMAD(I)=D1CMAD(I)+TCM(2)
 1200 CONTINUE
C
      IF(.NOT. LFIN3) GO TO 2000
C
C   BODY+3 FIN SETS
C
      SPAN=2.*GFIN3(173)
      AREA=2.*GFIN3(174)
      PCENT=GFIN3(187)
      XLE=FDATA3(102)
      XCENT=PCENT+XLE
      AR=SPAN**2/AREA
      NPAN1=FDATA3(112)
      NP=NPAN1+0.5
C
C  ANGLE OF ATTACK LOOP
C
      DO 1300 I=1,NALP
      TCN(3)=0.
      TCM(3)=0.
C
C  COMPUTE AND SUM INDIVIDUAL PANEL VALUES
C
        DO 1310 II=1,NP
          CCORR=( SIN( (PHI3(II)+GAM3(II)) /RAD) )**2
          F3CNAD=2.*PI/3.*CCORR*(SPAN/LREF)*(AREA/SREF)
          F3CMAD=F3CNAD*(XCG-XCENT)/LREF
     1    -1.*PI/(9.*AR)*CCORR*(SPAN/LREF)**2*(AREA/SREF)
          TCN(3)=TCN(3)+0.5*F3CNAD
          TCM(3)=TCM(3)+0.5*F3CMAD
 1310   CONTINUE
C
C  ADD TO BODY ALONE TO GET BODY +3 FIN SETS TOTAL
C
        D3CNAD(I)=D2CNAD(I)+TCN(3)
        D3CMAD(I)=D2CMAD(I)+TCM(3)
 1300 CONTINUE
C
      IF(.NOT. LFIN4) GO TO 2000
C
C   BODY+4 FIN SETS
C
      SPAN=2.*GFIN4(173)
      AREA=2.*GFIN4(174)
      PCENT=GFIN4(187)
      XLE=FDATA4(102)
      XCENT=PCENT+XLE
      AR=SPAN**2/AREA
      NPAN1=FDATA4(112)
      NP=NPAN1+0.5
C
C  ANGLE OF ATTACK LOOP
C
      DO 1400 I=1,NALP
      TCN(4)=0.
      TCM(4)=0.
C
C  COMPUTE AND SUM INDIVIDUAL PANEL VALUES
C
        DO 1410 II=1,NP
          CCORR=( SIN( (PHI4(II)+GAM4(II)) /RAD) )**2
          F4CNAD=2.*PI/3.*CCORR*(SPAN/LREF)*(AREA/SREF)
          F4CMAD=F4CNAD*(XCG-XCENT)/LREF
     1    -1.*PI/(9.*AR)*CCORR*(SPAN/LREF)**2*(AREA/SREF)
          TCN(4)=TCN(4)+0.5*F4CNAD
          TCM(4)=TCM(4)+0.5*F4CMAD
 1410   CONTINUE
C
C  ADD TO BODY ALONE TO GET BODY +4 FIN SETS TOTAL
C
        D4CNAD(I)=D3CNAD(I)+TCN(4)
        D4CMAD(I)=D3CMAD(I)+TCM(4)
 1400 CONTINUE
C
 2000 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE GEOM
C
C***  TOP LEVEL EXECUTIVE ROUTINE FOR CALCULATING GEOMETRIC DATA
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     1                TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,POWER,
     2                DISCON(20),ELLIP(50),H(50),ADUM(648)
      REAL NX,LNOSE,LCENTR,LAFT,LREF,LATREF
      LOGICAL TRUNC
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
C
      COMMON /FSET1/  FDATA1(399)
      COMMON /FSET2/  FDATA2(399)
      COMMON /FSET3/  FDATA3(399)
      COMMON /FSET4/  FDATA4(399)
C
C***  SCALE REFERENCE QUANTITIES IF REQUIRED
C
      IF(SREF.NE.UNUSED .AND. SCALE.GT.UNUSED)SREF=SREF*SCALE**2
      IF(LREF.NE.UNUSED .AND. SCALE.GT.UNUSED)LREF=LREF*SCALE
      IF(LATREF.NE.UNUSED .AND. SCALE.GT.UNUSED)LATREF=LATREF*SCALE
      IF(XCG .NE. UNUSED .AND. SCALE .GT. UNUSED)XCG=XCG*SCALE
      IF(ZCG .NE. UNUSED .AND. SCALE .GT. UNUSED)ZCG=ZCG*SCALE
C
C***  CONVERT ALL USER INPUTS TO FEET-POUNDS-DEGREES RANKINE
C
      CALL CVRTUS
C
C***  COMPUTE AXISYMMETRIC BODY DATA
C
      IF(LAXIS .AND. .NOT.LELLB)CALL GEOAXI
C
C***  COMPUTE ELLIPTICAL BODY DATA
C
      IF(LELLB)CALL GEOELL
C
C***  COMPUTE FIN ALONE GEOMETRY DATA
C
      IF(LFIN1.OR.LFIN2.OR.LFIN3.OR.LFIN4)CALL GEOFIN
C
C***  PUT FIN ON BODY SURFACE IF SSPAN(1) EQUALS ZERO
C
      IF(.NOT.(LAXIS .OR. LELLB))GO TO 1080
C
      NNX=NX+.5
C
      IF(FDATA1(2) .NE. 0.)GO TO 1020
C
      XCRO2=FDATA1(102)+FDATA1(52)/2.
C
      IF(XCRO2 .LT. X(1) .OR. XCRO2 .GT. X(NNX))GO TO 1020
C
      CALL LNTRP(X,R,NNX,XCRO2,RCRO2)
      IF(LELLB)CALL LNTRP(X,H,NNX,XCRO2,HCRO2)
      IF(LELLB)RCRO2=RCRO2*HCRO2/SQRT(RCRO2**2+HCRO2**2)
C
      DO 1010 I=1,10
         IF(FDATA1(I+1) .NE. UNUSED)FDATA1(I+1)=FDATA1(I+1)+RCRO2
 1010 CONTINUE
C
 1020 IF(FDATA2(2) .NE. 0.)GO TO 1040
C
      XCRO2=FDATA2(102)+FDATA2(52)/2.
C
      IF(XCRO2 .LT. X(1) .OR. XCRO2 .GT. X(NNX))GO TO 1040
C
      CALL LNTRP(X,R,NNX,XCRO2,RCRO2)
      IF(LELLB)CALL LNTRP(X,H,NNX,XCRO2,HCRO2)
      IF(LELLB)RCRO2=RCRO2*HCRO2/SQRT(RCRO2**2+HCRO2**2)
C
      DO 1030 I=1,10
         IF(FDATA2(I+1) .NE. UNUSED)FDATA2(I+1)=FDATA2(I+1)+RCRO2
 1030 CONTINUE
C
 1040 IF(FDATA3(2) .NE. 0.)GO TO 1060
C
      XCRO2=FDATA3(102)+FDATA3(52)/2.
C
      IF(XCRO2 .LT. X(1) .OR. XCRO2 .GT. X(NNX))GO TO 1060
C
      CALL LNTRP(X,R,NNX,XCRO2,RCRO2)
      IF(LELLB)CALL LNTRP(X,H,NNX,XCRO2,HCRO2)
      IF(LELLB)RCRO2=RCRO2*HCRO2/SQRT(RCRO2**2+HCRO2**2)
C
      DO 1050 I=1,10
         IF(FDATA3(I+1) .NE. UNUSED)FDATA3(I+1)=FDATA3(I+1)+RCRO2
 1050 CONTINUE
C
 1060 IF(FDATA3(2) .NE. 0.)GO TO 1080
C
      XCRO2=FDATA3(102)+FDATA3(52)/2.
C
      IF(XCRO2 .LT. X(1) .OR. XCRO2 .GT. X(NNX))GO TO 1080
C
      CALL LNTRP(X,R,NNX,XCRO2,RCRO2)
      IF(LELLB)CALL LNTRP(X,H,NNX,XCRO2,HCRO2)
      IF(LELLB)RCRO2=RCRO2*HCRO2/SQRT(RCRO2**2+HCRO2**2)
C
      DO 1070 I=1,10
         IF(FDATA3(I+1) .NE. UNUSED)FDATA3(I+1)=FDATA3(I+1)+RCRO2
 1070 CONTINUE
C
 1080 CONTINUE
C
C  **  CALCULATION OF INLET GEOMETRY
C
      IF(LINLET) CALL GEOINL
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE INTERP(TX,TY,X,Y,N,J)
      DIMENSION TX(100),TY(100)
      IF((N-J+2).EQ.1)GO TO 1010
      I=J-3
 1000 I=I+1
      IF(TX(I).LT.X) GO TO 1000
      IF(I.LE.J) I=J
      IF(I.GT.(N-2)) I=N-2
      CALL INTER5(X,TX(I-2),TX(I-1),TX(I),TX(I+1),TX(I+2),TY(I-2),TY(I-1
     1),TY(I),TY(I+1),TY(I+2),Y)
      GO TO 1020
 1010 Y=TY(J-2)+(X-TX(J-2))*(TY(N)-TY(J-2))/(TX(N)-TX(J-2))
 1020 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PACK(KOL,END)
C
C***  SUBROUTINE TO PACK THE NAMELIST INPUT CARD STARTING IN COLUMN 2
C***  OR CONTROL CARDS IN COLUMN 1
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C
      CHARACTER*4 KAND,IBLANK,ICOMMA,IEQUAL,IPOINT,IEND,KOL,ICARD
C
      DIMENSION KOL(80),ICARD(80),IEND(3)
      LOGICAL END
      DATA IBLANK / '    ' /
      DATA ICOMMA / ',   ' /
      DATA IEQUAL / '=   ' /
      DATA IPOINT / '.   ' /
      DATA IEND / 'E   ','N   ','D   '/
C
C***  EXIT IF COLUMN 1 IS NOT BLANK
C
      IF(KOL(1).NE.IBLANK)GO TO 1080
C
C***  PACK NEW CARD IMAGE WITH BLANKS
C
      DO 1000 I=1,80
         ICARD(I)=IBLANK
 1000 CONTINUE
C
C***  FIND FIRST NON-BLANK CARD COLUMN
C
      DO 1010 I=1,80
         II=I
         IF(KOL(I).NE.IBLANK)GO TO 1020
 1010 CONTINUE
      GO TO 1080
 1020 CONTINUE
C
C***  CHECK IF CONTROL CARD
C
      IF(END .AND. KOL(II).NE.KAND)GO TO 1090
C
      IF(KOL(II).NE.KAND)GO TO 1050
C
C***  SHIFT TO CARD COLUMN 2
C
      IIM2=II-2
      DO 1030 I=II,80
         IJ=I-IIM2
         ICARD(IJ)=KOL(I)
 1030 CONTINUE
C
C***  PUT NEW CARD INTO OLD CARD IMAGE
C
      DO 1040 I=1,80
         KOL(I)=ICARD(I)
 1040 CONTINUE
C
C***  VERIFY LAST NON-BLANK CHARACTER IS A COMMA, $ OR $END
C
 1050 DO 1060 I=1,80
         II=80-I+1
         IF(KOL(II).EQ.IBLANK)GO TO 1060
         IF(KOL(II).NE.ICOMMA)GO TO 1070
         GO TO 1080
 1060 CONTINUE
      GO TO 1080
 1070 IF(KOL(II).EQ.KAND .OR. (KOL(II-3).EQ.KAND .AND. KOL(II-2).EQ.
     1  IEND(1) .AND. KOL(II-1).EQ.IEND(2) .AND. KOL(II).EQ.IEND(3)))
     2  GO TO 1080
C
C***  CHECK FOR NO BLANKS TO $
C
      DO 1072 I=2,II
         ICC=II+2-I
         IF(KOL(ICC) .EQ. IBLANK)GO TO 1074
         IF(KOL(ICC) .EQ. IPOINT)GO TO 1074
         IF(KOL(ICC) .EQ. IEQUAL)GO TO 1074
         IF(KOL(ICC) .EQ. ICOMMA)GO TO 1074
         IF(KOL(ICC) .EQ. KAND)GO TO 1080
 1072 CONTINUE
      GO TO 1080
 1074 IF(II.LT.80)KOL(II+1)=ICOMMA
 1080 CONTINUE
      GO TO 1120
 1090 CONTINUE
C
C***  HERE FOR CONTROL CARD
C
      IL=0
      DO 1100 I=II,80
         IL=IL+1
         ICARD(IL)=KOL(I)
 1100 CONTINUE
      DO 1110 I=1,80
         KOL(I)=ICARD(I)
 1110 CONTINUE
C
 1120 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RFIN2(LFIN2, AA)
C
C***  READ FINSET2 INPUTS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION AA(399),NLNAME(6),IVNAME(113),LEN(23),IDIM(23),LOC(23)
C
      LOGICAL LFIN2,IEOF
C
      DATA NLNAME /  'F   ','I   ','N   ','S   ','E   ','T   '/
      DATA IVNAME /  'S   ','E   ','C   ','T   ','Y   ','P   ','S   ',
     1 'S   ','P   ','A   ','N   ','L   ','M   ','A   ','X   ','U   ',
     2 'L   ','F   ','L   ','A   ','T   ','U   ','L   ','M   ','A   ',
     3 'X   ','L   ','L   ','F   ','L   ','A   ','T   ','L   ','C   ',
     4 'H   ','O   ','R   ','D   ','Z   ','U   ','P   ','P   ','E   ',
     5 'R   ','Z   ','L   ','O   ','W   ','E   ','R   ','S   ','W   ',
     6 'E   ','E   ','P   ','S   ','T   ','A   ','X   ','L   ','E   ',
     7 'N   ','P   ','A   ','N   ','E   ','L   ','X   ','C   ','O   ',
     8 'R   ','D   ','M   ','E   ','A   ','N   ','T   ','H   ','I   ',
     9 'C   ','K   ','Y   ','U   ','P   ','P   ','E   ','R   ','Y   ',
     A 'L   ','O   ','W   ','E   ','R   ','F   ','I   ','N   ','P   ',
     B 'H   ','I   ','L   ','E   ','R   ','G   ','A   ','M   ','P   ',
     C 'H   ','I   ','F   ','C   ','F   ','O   ','C   '/
      DATA IDIM   / 1,10,10,10,10,10,10,10,10,10,10,10,1,50,50,50,50,
     1              50,1,10,8,8,10 /
      DATA LEN    / 6,5,5,6,5,6,5,6,6,5,3,3,6,5,4,5,6,6,6,3,3,4,4 /
      DATA LOC    / 1,2,12,22,32,42,52,62,72,82,92,102,112,113,163,213,
     1              263,313,363,364,374,382,390 /
C
      LFIN2=.TRUE.
C
      CALL NAMER(KAND,2,NLNAME,6,IVNAME,113,LEN,23,IDIM,AA,399,LOC,
     1 IEOF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SUBREA(LLOC, LANS)
C
C***  FORCE A REAL INTO AN EXTERNAL ARRAY
C
      REAL LLOC,LANS
C
      LLOC=LANS
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WRFIN4
C
C***  WRITE FINSET4 INPUTS
C
C  WRITTEN BY S. STOY, MCDONNELL DOUGLAS
C
      COMMON /FSET4/ AA(399)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION NLNAME(7),IVNAME(113),LEN(23),IDIM(23),LOC(23)
C
      DATA NLNAME /  'F   ','I   ','N   ','S   ','E   ','T   ','4   '/
      DATA IVNAME /  'S   ','E   ','C   ','T   ','Y   ','P   ','S   ',
     1 'S   ','P   ','A   ','N   ','L   ','M   ','A   ','X   ','U   ',
     2 'L   ','F   ','L   ','A   ','T   ','U   ','L   ','M   ','A   ',
     3 'X   ','L   ','L   ','F   ','L   ','A   ','T   ','L   ','C   ',
     4 'H   ','O   ','R   ','D   ','Z   ','U   ','P   ','P   ','E   ',
     5 'R   ','Z   ','L   ','O   ','W   ','E   ','R   ','S   ','W   ',
     6 'E   ','E   ','P   ','S   ','T   ','A   ','X   ','L   ','E   ',
     7 'N   ','P   ','A   ','N   ','E   ','L   ','X   ','C   ','O   ',
     8 'R   ','D   ','M   ','E   ','A   ','N   ','T   ','H   ','I   ',
     9 'C   ','K   ','Y   ','U   ','P   ','P   ','E   ','R   ','Y   ',
     A 'L   ','O   ','W   ','E   ','R   ','F   ','I   ','N   ','P   ',
     B 'H   ','I   ','L   ','E   ','R   ','G   ','A   ','M   ','P   ',
     C 'H   ','I   ','F   ','C   ','F   ','O   ','C   '/
      DATA IDIM   / 1,10,10,10,10,10,10,10,10,10,10,10,1,50,50,50,50,
     1              50,1,10,8,8,10 /
      DATA LEN    / 6,5,5,6,5,6,5,6,6,5,3,3,6,5,4,5,6,6,6,3,3,4,4 /
      DATA LOC    / 1,2,12,22,32,42,52,62,72,82,92,102,112,113,163,213,
     1              263,313,363,364,374,382,390 /
C
      CALL NAMEW(KAND,6,NLNAME,7,IVNAME,113,LEN,23,IDIM,AA,399,LOC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCAB(DFWD,DBASE,DEXIT,LAFT,SREF,MACH,CABASE)
C
C***  SUBROUTINE TO COMPUTE THE BASE DRAG FOR BODIES AT ALL SPEEDS
C
C  MODIFIED BY K. BURNS, MCDONNELL DOUGLAS, W. BLAKE, WL/FIGC
C
C***  METHOD FROM EMPIRICAL DATA OF NASA TR R-100
CC***  BOATTAIL/FLARE CORRECTION FROM AMC PAMPHLET AMCP 706-280
C
C***  INPUTS
C
C   DFWD - DIAMETER OF THE BODY AHEAD OF THE AFTERBODY
C  DBASE - DIAMETER OF THE BODY BASE
C  DEXIT - DIAMETER OF THE NOZZLE EXIT
C   LAFT - LENGTH OF THE AFTERBODY
C   SREF - REFERENCE AREA FOR CA
C   MACH - FREESTREAM MACH NUMBER
C
C***  OUTPUT
C
C CABASE - INCREMENT IN AXIAL FORCE DUE TO BASE DRAG AT ALPHA=0.
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL MACH,LAFT
C
C  REV 3/99 CORRECTED BASE DRAG TABLE ARRAY DIMENSIONS 
C
      DIMENSION AM(24),CP(24),SBSC(13),PCPB(13),IROUT(2)
C
C.....NSWC METHOD ADDED 2/17/93 TO IMPROVE FLARE BASE PRESSURE PREDICTIONS
C
C.....ADDITIONAL HIGH MACH (M=5-9) POINTS ADDED 3/13/95
C
      DIMENSION AMF(22),CPF(110),FLARE(5),
     1          CPF1(22),CPF2(22),CPF3(22),CPF4(22),CPF5(22)
      EQUIVALENCE (CPF(1),CPF1(1)),(CPF(23),CPF2(1)),
     1            (CPF(45),CPF3(1)),(CPF(67),CPF4(1)),
     2            (CPF(89),CPF5(1))
      DATA AMF / 0.0,.2,.4,.6,.8,.9,1.0,1.1,1.2,1.4,1.6,2.0,2.4,
     1           3.0,3.5,4.0,5.,6.,7.,8.,9.,10.0/
      DATA FLARE / 0.0,5.,10.,15.,90./
      DATA CPF1 / 0.137,
     1     .137,.137,.136,.134,.132,.1825,.203,.193,.1834,.1727,
     2     .147,.123,.095,.078,.065,
     3     .04,.0278,.0204,.0156,.0123,.01/
      DATA CPF2 / 0.188,
     1     .190,.194,.196,.208,.225,.267,.276,.273,.235,.210,.165,
     2     .133,.098,.082,.065,
     3     .04,.0278,.0204,.0156,.0123,.01/
      DATA CPF3 / 0.220,
     1     .222,.224,.225,.237,.273,.339,.350,.343,.288,.239,.180,
     2     .143,.104,.084,.065,
     3     .04,.0278,.0204,.0156,.0123,.01/
      DATA CPF4 / 0.288,
     1     .290,.292,.295,.314,.367,.457,.470,.459,.371,.280,.192,
     2     .153,.114,.086,.065,
     3     .04,.0278,.0204,.0156,.0123,.01/
      DATA CPF5 / 0.288,
     1     .290,.292,.295,.314,.367,.457,.470,.459,.371,.280,.192,
     2     .153,.114,.086,.065,
     3     .04,.0278,.0204,.0156,.0123,.01/
C
      DATA AM / 0.,.5,.8,.9,.95,1.05,1.10,1.15,1.25,1.5,1.8,2.0,
     1          2.2,2.5,2.8,3.0,3.5,4.0,5.,6.,7.,8.,9.,10.0/
      DATA CP / .137,.137,.134,.132,.155,.210,.203,.196,.190,
     1     .179,.160,.147,.135,.117,.104,.095,.078,.065,
     2     .04,.0278,.0204,.0156,.0123,.01/
C
      CABASE=0.
      IF(DFWD .LE. 0. .OR. DBASE .LE. 0.)GO TO 1000
C
      IF(MACH .LE. 10.)CALL LNTRP(AM,CP,24,MACH,CPBASE)
      IF(MACH .GT. 10.)CPBASE=1./MACH**2
C
C... BOATTAIL CORRECTION
C
      CORR=DBASE/DFWD
C
C... FLARE CPB WITHOUT EXTRAPOLATION ON FLARE ANGLE (15 DEG MAX)
C
      IF(CORR.GT.1.) THEN
        CORR=1.
        FLRANG=ATAN2((DBASE-DFWD)/2.,LAFT)*RAD
        CALL MVLOOK(1,5,22,110,1,FLARE,AMF,CPF,MACH,FLRANG,1,CPBASE)
      ENDIF
C
      ANNULR=DBASE**2-DEXIT**2
      IF(ANNULR .LT. 0.)ANNULR=0.
      CABASE=CORR*CPBASE*PI*ANNULR/4./SREF
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BOTCNM(ISHAPE,SREF,LREF,XCG,XO,XB,FMACH,ALPHA,
     1              BOTLEN,MISDIA,BASDIA,XSEPA0,BOTDCN,BOTDCM)
C
C     THIS SUBROUTINE CALCULATES THE INCREMENTAL NORMAL FORCE
C     AND PITCHING MOMENT COEFFICIENTS ON A BOATTAIL DUE TO 
C     FLOW SEPARATION.
C
C  WRITTEN BY A. JENN, MCDONNELL DOUGLAS
C
      REAL MISDIA,LREF
C
C     CHECK FOR A CYLINDRICAL BOATTAIL
      IF (ISHAPE .EQ. 1 .OR .BASDIA .GE. MISDIA) THEN
C
C        SET COEFFICIENTS TO ZERO
         BOTDCN = 0.0
         BOTDCM = 0.0
C
C        EXIT THE SUBROUTINE
         GOTO 100
C
      END IF
C
C     CALCULATE THE VALUE OF PI
      PI = ACOS(-1.0)
C
C     CALCULATE THE MISSILE AND BASE RADII
      RMIS = MISDIA / 2.0
      RBAS = BASDIA / 2.0
C
C     CALCULATE CROSS SECTIONAL AREA OF MISSILE
      CSA1 = PI * RMIS**2
C
C     CALCULATE BOATTAIL BASE AREA FOR UNSEPARATED CASE
      CSA2U = PI * RBAS**2
C
C     CALCULATE THE LENGTH OF THE BOATTAIL AT SEPARATION
      BOTLS = BOTLEN - XSEPA0
C
C     CALCULATE VOLUME OF CYLINDER WITH SAME FINENESS RATIO AS BOATTAIL
      VOL1U = CSA1 * BOTLEN
      VOL1S = CSA1 * BOTLS
C
C     CALCULATE REMAINING BOATTAIL GEOMETRIC PARAMETERS
      IF (ISHAPE .EQ. 2) THEN
C
C        CONICAL BOATTAIL
C
C        BOATTAIL DIAMETER AT SEPARATION
         DBSEP = BASDIA + (MISDIA - BASDIA) * XSEPA0 / BOTLEN
C
C        BOATTAIL VOLUME FOR UNSEPARATED CASE
         VOL2U = PI * BOTLEN / 3.0 * (RMIS**2 + RBAS**2 + RMIS * RBAS)
C
C        BOATTAIL VOLUME FOR SEPARATED CASE
         RSEP = DBSEP / 2.0
         VOL2S = PI * BOTLS / 3.0 * (RMIS**2 + RSEP**2 + RMIS * RSEP)
C
      ELSE
C
C        OGIVE BOATTAIL
C
C        RADIUS OF CURVATURE
         DR = RMIS - RBAS
         RCUR = (DR**2 + BOTLEN**2) / (2.0 * DR)
C
C        BOATTAIL DIAMETER AT SEPARATION
         P = SQRT(RCUR**2 - BOTLEN**2)
         DBSEP = BASDIA + 2.0 * (SQRT(RCUR**2 - BOTLS**2) - P)
C
C        BOATTAIL VOLUME FOR UNSEPARATED CASE
         PMRB   = P - RBAS                           
         VOL2U = PI * BOTLEN * (PMRB**2 + RCUR**2 - BOTLEN**2 / 3.0 -
     1           PMRB * (P + RCUR**2 / BOTLEN * ASIN(BOTLEN / RCUR)))
C
C        BOATTAIL VOLUME FOR SEPARATED CASE
         P = SQRT(RCUR**2 - BOTLS**2)
         VOL2S = PI * BOTLS * (PMRB**2 + RCUR**2 - BOTLS**2 / 3.0 -
     1           PMRB * (P + RCUR**2 / BOTLS * ASIN(BOTLS / RCUR)))
C
      END IF         
C
C     CALCULATE BOATTAIL BASE AREA FOR SEPARATED CASE
      CSA2S = PI * DBSEP**2 / 4.0
C
C     CALCULATE NORMAL FORCE CURVE SLOPE FOR UNSEPARATED BOATTAIL
      CALL BDCNAB(FMACH, BASDIA, MISDIA, CNABU)
C
C     CONVERT TO NORMAL FORCE COEFFICIENT
      CNBU = CNABU * ALPHA * PI / 180.0
      CNBU=CNBU*PI*MISDIA**2/4./SREF
C
C     CALCULATE NORMAL FORCE CURVE SLOPE FOR SEPARATED BOATTAIL
      CALL BDCNAB(FMACH, DBSEP, MISDIA, CNABS)
C
C     CONVERT TO NORMAL FORCE COEFFICIENT
      CNBS = CNABS * ALPHA * PI / 180.0
      CNBS=CNBS*PI*MISDIA**2/4./SREF
C
C     CALCULATE NORMAL FORCE COEFFICIENT INCREMENT
      BOTDCN = CNBS - CNBU
C
C     CALCULATE BOATTAIL CENTER OF PRESSURE FOR UNSEPARATED CASE.
C     CENTER OF PRESSURE IS REFERENCED TO LONGITUDINAL C.G. LOCATION
      DVOLU = VOL1U  - VOL2U
      DCSAU = CSA1   - CSA2U
      XCPU  = (XB+BOTLEN-(XCG-XO)-DVOLU/DCSAU)/LREF
C
C     CALCULATE BOATTAIL CENTER OF PRESSURE FOR SEPARATED CASE
      IF (XSEPA0 .LT. BOTLEN) THEN
C
C        NOMINAL BOATTAIL SEPARATION
         DVOLS = VOL1S - VOL2S
         DCSAS = CSA1  - CSA2S
         XCPS  = (XB+BOTLS-(XCG-XO)-DVOLS/DCSAS)/LREF
C
      ELSE
C
C        ENTIRE BOATTAIL IS SEPARATED
         XCPS = 0.0
C
      END IF
C
C     CALCULATE PITCHING MOMENT FOR UNSEPARATED BOATTAIL
      CMBU = -CNBU * XCPU
C
C     CALCULATE PITCHING MOMENT FOR SEPARATED BOATTAIL
      CMBS = -CNBS * XCPS
C
C     CALCULATE PITCHING MOMENT COEFFICIENT INCREMENT
      BOTDCM = CMBS - CMBU 
C
  100 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CP3DW(XP, YP, BB, XM, CP, FAIL)
C      
C     THIS SUBROUTINE CALCULATES THE PRESSURE COEFFICIENT ON
C     A 3-DIMENSIONAL FIN AT POINT XP, YP.  THE METHOD IS
C     DESCRIBED IN NWL TR-3018, PAGES 10 THRU 16.  THE INDUCED
C     VELOCITY (D(PHI)/DX) FROM EACH SOURCE OR SINK LINE (SOSL)
C     IS CALCULATED AT THE POINT AND SUMMED.  THE PRESSURE
C     COEFFICIENT IS THEN CALCULATED FROM THE POTENTIAL VELOCITY.
C      
C     INPUT VARIABLES
C         XP - X-LOCATION OF POINT
C         YP - Y-LOCATION OF POINT
C         BB - SPAN OF FIN
C         XM - MACH NUMBER
C      
C     INPUT VARIABLES FROM COMMON
C         XO   - X-LOCATION AT ROOT OF SOSL
C         XT   - X-LOCATION AT TIP OF SOSL
C         TGA  - TANGENT OF SOSL SWEEP
C         ETA  - TGA/SQRT(XM**2-1)
C         DZDX - SLOPE FWD OF SOSL AT YP
C         NS   - NUMBER OF SOSL
C      
C     OUTPUT
C         CP - PRESSURE COEFFICIENT
C      
      LOGICAL FAIL
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /CAFD/  XO(60), XT(60), DZDXO(60), DZDXT(60), TGA(60),
     1               ETA(60), DZDX(60), NS, CPO
C      
C     STATEMENT FUNCTION FOR ARCOSH(X)
C      
      ARCOSH(X) = ALOG(X+SQRT(X*X-1.0))
C      
      BETA = SQRT(XM*XM-1.0)
      B2 = BB/2.0
      PHEX = 0.0
C      
C     LOOP ON SOSL, J = SOSL INDEX
C      
      DO 1080 J=1,NS
C       ...
C       ... CALCULATE SIG AT ROOT AND TIP (NSWC TR 3018,EQ 7A)
C       ...
        XXP = XP-XO(J)
        SIGR = 1.0
        IF(XXP .GE. 1.E-6) SIGR = TGA(J)*YP/XXP
        XXP = XP-XT(J)
        SIGT = 1.0
        IF(XXP .GE. 1.E-6) SIGT = TGA(J)*(B2-YP)/XXP
        XMA = XO(J)+BETA*YP
        XGA = XO(J)+YP*TGA(J)
        XMT = XT(J)+BETA*(B2-YP)
C       ...
C       ... SUBSONIC SOSL
C       ...
        IF(XMA .GE. XGA) GO TO 1030
C         ...
C         ... REGION 1 - MACH LINE TO SOSL
C         ...
          IF(XP .LT. XMA) GO TO 1000
          IF(XP .GE. (XGA-0.0001)) GO TO 1000
          IF(SIGR .LT. 1.00001) SIGR = 1.00001
          IF(ETA(J)**2 .LT. 1.)FAIL=.TRUE.
          IF(FAIL)GO TO 1090
            A = PI*BETA*SQRT(ETA(J)**2-1.0)
            B = SQRT((ETA(J)**2-1.0)/(SIGR**2-1.0))
            PHEX = PHEX-2.0*(DZDX(J+1)-DZDX(J))*ARCOSH(B)/A
 1000     CONTINUE
C         ...
C         ... REGION 2 - DOWNSTREAM OF SOSL
C         ...
          IF(XP .LT. (XGA-0.0001)) GO TO 1010
            IF(SIGR .GT. 0.99999) SIGR = 0.99999
            IF(ETA(J)**2 .LT. 1.)FAIL=.TRUE.
            IF(FAIL)GO TO 1090
            A = PI*BETA*SQRT(ETA(J)**2-1.0)
            B = SQRT((ETA(J)**2-SIGR**2)/(1.0-SIGR**2))
            PHEX = PHEX-2.0*(DZDX(J+1)-DZDX(J))*ARCOSH(B)/A
 1010     CONTINUE
C         ...
C         ... REGION 3 - DOWNSTREAM OF MACH LINE FROM TIP
C         ...
          IF(XP .LT. XMT) GO TO 1020
          IF(ETA(J)**2 .LT. 1.)FAIL=.TRUE.
          IF(FAIL)GO TO 1090
            A = PI*BETA*SQRT(ETA(J)**2-1.0)
            B = (ETA(J)**2+SIGT)/(ETA(J)*(SIGT+1.0))
            IF(B .LT. 1.00001) B = 1.00001
            PHEX = PHEX+(DZDX(J+1)-DZDX(J))*ARCOSH(B)/A
 1020     CONTINUE
 1030   CONTINUE
C       ...
C       ... SUPERSONIC SOSL
C       ...
        IF(XMA .LT. XGA) GO TO 1070
C         ...
C         ... REGION 1 - SOSL TO MACH LINE
C         ...
          IF(XP .LT. (XGA-0.0001)) GO TO 1040
          IF(XP .GE. XMA) GO TO 1040
          IF(ETA(J)**2 .GT. 1.)FAIL=.TRUE.
          IF(FAIL)GO TO 1090
            A = BETA*SQRT(1.0-ETA(J)**2)
            PHEX = PHEX-(DZDX(J+1)-DZDX(J))/A
 1040     CONTINUE
C         ...
C         ... REGION 2 - DOWNSTREAM OF MACH LINE
C         ...
          IF(XP .LT. XMA) GO TO 1050
            IF(SIGR .GT. 0.99999) SIGR = 0.99999
            IF(ETA(J)**2 .GT. 1.)FAIL=.TRUE.
            IF(FAIL)GO TO 1090
            A = PI*BETA*SQRT(1.0-ETA(J)**2)
            IF(ETA(J)**2 .LT. SIGR**2)FAIL=.TRUE.
            IF(FAIL)GO TO 1090
            B = SQRT((ETA(J)**2-SIGR**2)/(1.0-SIGR**2))
            PHEX = PHEX-(DZDX(J+1)-DZDX(J))*(PI-2.0*ASIN(B))/A
 1050     CONTINUE
C         ...
C         ... REGION 3 - DOWNSTREAM OF MACH LINE FROM TIP
C         ...
          IF(XP .LT. XMT) GO TO 1060
          IF(ETA(J)**2 .GT. 1.)FAIL=.TRUE.
          IF(FAIL)GO TO 1090
            A = PI*BETA*SQRT(1.0-ETA(J)**2)
            B = (ETA(J)**2+SIGT)/(ETA(J)*(1.0+SIGT))
            IF(B .GE. 0.99999) B = 0.99999
            PHEX = PHEX+(DZDX(J+1)-DZDX(J))*ACOS(B)/A
 1060     CONTINUE
 1070   CONTINUE
 1080 CONTINUE
C     ...
C     ... CALCULATE CP
C     ...
      CP = -2.0*PHEX
      IF(CP .LT. -CPO) CP = -CPO
      IF(CP .GT. CPO)  CP = CPO
C      
 1090 CONTINUE
C      
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION DVOLE(NPTS,X,A,B)
C** FUNCTION TO COMPUTE THE VOLUME OF AN ELLIPTIC SEGMENT
C
C** INPUTS
C
C   NPTS -- NUMBER OF INPUT POINTS
C      X -- X STATION
C      A -- HORIZONTAL AXIS AT EACH X STATION
C      B -- VERTICAL AXIS AT EACH X STATION
C
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION TA(100), TB(100), TX(100), XMAJOR(50), XMINOR(50)
      DIMENSION X(NPTS),A(NPTS),B(NPTS),XSTA(50)
      LOGICAL SWITCH
C
C** STORE INPUT PARAMETERS TO BE MANIPULATED
C
      SWITCH=.FALSE.
C
      DO 1000 II=1,NPTS
         IF(A(II) .EQ. B(II))GO TO 1000
         IF(A(II) .LT. B(II))SWITCH=.TRUE.
         GO TO 1010
 1000 CONTINUE
C
 1010 CONTINUE
C
      DO 1020 II=1,NPTS
         IN=II*2-1
         TA(IN)=A(II)
         TB(IN)=B(II)
         IF(SWITCH)TA(IN)=B(II)
         IF(SWITCH)TB(IN)=A(II)
         TX(IN)=X(II)
         TA(IN+1)=-9999.
         TB(IN+1)=-9999.
         TX(IN+1)=-9999.
 1020 CONTINUE
      NPTS2=NPTS*2-1
C
C** LOOK FOR POSSIBLE MAJOR AXIS SHIFT (EX: HORIZ. AXIS TO VERT. AXIS)
C
      DO 1050 J=3,NPTS2,2
         IF(TB(J) .LE. TA(J)) GO TO 1050
C
C** COMPUTE A=B POINT AND PUT IN A DUMMY ARGUMENT (-9999.) LOCATION
C
 1030    SLOPE=(TB(J)-TB(J-2))/(TA(J)-TA(J-2))
         YINT=TB(J)-SLOPE*TA(J)
         XPOS=YINT/(1.-SLOPE)
         TA(J-1)=XPOS
         TB(J-1)=XPOS
         TX(J-1)=TX(J-2)+(TX(J)-TX(J-2))*ABS((TA(J-1)-TA(J-2))/
     1           (TA(J)-TA(J-2)))
C
C** SWITCH REST OF TA & TB PARAMETERS TO REFLECT AXIS SHIFT
C
        DO 1040 K=J,NPTS2,2
           TEMP=TA(K)
           TA(K)=TB(K)
           TB(K)=TEMP
 1040   CONTINUE
 1050 CONTINUE
C
C** REMOVE DUMMY ARRAY ELEMENTS (-9999.)
C
      NN=0
      DO 1060 M=1,NPTS2
         IF(TA(M) .EQ. -9999.) GO TO 1060
         NN=NN+1
         XMAJOR(NN)=TA(M)
         XMINOR(NN)=TB(M)
         XSTA(NN)=TX(M)
 1060 CONTINUE
C
      DVOLE=0.0
      DO 1070 I=2,NN
         DVOLE=DVOLE+PI*(XSTA(I)-XSTA(I-1))*(XMAJOR(I)*XMINOR(I)
     1         -.5*((XMINOR(I)-XMINOR(I-1))*XMAJOR(I)+(XMAJOR(I)-
     2         XMAJOR(I-1))*XMINOR(I))+1./3.*(XMINOR(I)-XMINOR(I-1))*
     3         (XMAJOR(I)-XMAJOR(I-1)))
 1070 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FDP5(TX,TY,X,Y,N,J)
C
C     THIS SUBROUTINE IS USED IN CONJUNCTION WITH FD5 TO DETERMINE
C     A DERIVATIVE AT A GIVEN POINT WHICH IS BETWEEN THE INPUT POINTS.
C
C  WRITTEN BY F. MOORE, NSWC
C
      DIMENSION TX(50),TY(50)
      IF((N-J).EQ.1)GO TO 1010
      I=J-1
      K=J+2
 1000 I=I+1
      IF(TX(I).LT.X) GO TO 1000
      IF(I.LE.K) I=K
      IF(I.GT.(N-2)) I=N-2
      CALL FD5(X,TX(I-2),TX(I-1),TX(I),TX(I+1),TX(I+2),TY(I-2),TY(I-1
     1),TY(I),TY(I+1),TY(I+2),Y)
      GO TO 1020
 1010 Y=(TY(N)-TY(J))/(TX(N)-TX(J))
 1020 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE GETCNO(NX,X,WIDTH,HEIGHT,CNSB,CNNEW,CMSBT,CMNEWT)
C
C***  COMPUTE THE INTEGRALS FOR THE LINEAR AND NON-LINEAR
C***  FACTORS FOR JORGENSEN CN AND CM EQUATIONS FOR ELLIPTICAL
C***  BODIES
C
C***  INPUTS
C
C     NX - NUMBER OF INPUT POINTS (REAL NUMBER)
C      X - LONGITUDINAL STATIONS
C  WIDTH - BODY HALF-WIDTHS
C HEIGHT - BODY HALF-HEIGHTS
C
C***  OUTPUTS
C
C   CNSB - INTEGRAL OF CN/CNO*DADX
C  CNNEW - INTEGRAL OF CN/CNO*R
C  CMSBT - INTEGRAL OF CN/CNO*DADX*(XM-X)
C CMNEWT - INTEGRAL OF CN/CNO*R*(XM-X)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
C
      DIMENSION CNOS(101),DADX(101),R(101),XMX(101)
      DIMENSION WIDTH(50),HEIGHT(50),X(50)
C
      REAL NX
C
C***  COMPUTE CN/CNO AT 101 STATIONS ALONG THE BODY
C
      NNX=NX+.5
C
      DX=(X(NNX)-X(1))/100.
C
      XX=X(1)-DX
C
C***  COMPUTE SLENDER BODY THEORY VALUES
C
      DO 1000 I=1,101
         XX=XX+DX
         CALL LNTRP(X,WIDTH,NNX,XX,WW)
         CALL LNTRP(X,HEIGHT,NNX,XX,HH)
C
         AMAJOR=WW
         IF(HH .GT. WW)AMAJOR=HH
         IF(AMAJOR .EQ. WW)AMINOR=HH
         IF(AMAJOR .EQ. HH)AMINOR=WW
         IF(AMAJOR .EQ. WW)PHI=0.
         IF(AMINOR .EQ. WW)PHI=90.
C
         CALL CNSBT(AMAJOR,AMINOR,PHI,CNOS(I))
C
         XMX(I)=XCG-XX
         R(I)=SQRT(WW*HH)
         IF(I .EQ. 1)GO TO 1000
         DADX(I)=PI*(R(I)**2-R(I-1)**2)/DX
 1000 CONTINUE
C
      DADX(1)=DADX(2)
C
C ... COMPUTE INTEGRAL CN/CNO*DADX
C
      DO 1010 I=1,101
         CNOS(I)=CNOS(I)*DADX(I)
 1010 CONTINUE
C
      CALL QUAD1(CNOS,101,DX,CNSB)
C
C ... COMPUTE INTEGRAL CN/CNO*DADX*(XM-X)
C
      DO 1020 I=1,101
         CNOS(I)=CNOS(I)*XMX(I)
 1020 CONTINUE
C
      CALL QUAD1(CNOS,101,DX,CMSBT)
C
C***  REPEAT FOR NEWTONIAN VALUES
C
      XX=X(1)-DX
C
      DO 1030 I=1,101
         XX=XX+DX
         CALL LNTRP(X,WIDTH,NNX,XX,WW)
         CALL LNTRP(X,HEIGHT,NNX,XX,HH)
C
         AMAJOR=WW
         IF(HH .GT. WW)AMAJOR=HH
         IF(AMAJOR .EQ. WW)AMINOR=HH
         IF(AMAJOR .EQ. HH)AMINOR=WW
         IF(AMAJOR .EQ. WW)PHI=0.
         IF(AMINOR .EQ. WW)PHI=90.
C
         CALL CNNEWT(AMAJOR,AMINOR,PHI,CNOS(I))
C
 1030 CONTINUE
C
C ... COMPUTE INTEGRAL CN/CNO*R
C
      DO 1040 I=1,101
         CNOS(I)=CNOS(I)*R(I)
 1040 CONTINUE
C
      CALL QUAD1(CNOS,101,DX,CNNEW)
C
C ... COMPUTE INTEGRAL CN/CNO*R*(XM-X)
C
      DO 1050 I=1,101
         CNOS(I)=CNOS(I)*XMX(I)
 1050 CONTINUE
C
      CALL QUAD1(CNOS,101,DX,CMNEWT)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE INZBOD
C
C***  INITIALIZE ALL BODY ARRAYS
C
C***  BODY AND INLET INPUTS
C
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     1                TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,
     2                POWER,DISCON(20),ELLIP(50),H(50),
     3                ENOSE,ECENTR,EAFT,DEXIT,BASE,BETAN,
     4                JMACH(20),PRAT(20),TRAT(20),PROTUB,
     5                NPROT,PTYPE(20),XPROT(20),NLOC(20),
     6                BLDMEM(20),BLDTYP(100),LPROT(100),
     7                WPROT(100),HPROT(100),OPROT(100)
C
      REAL NX,LNOSE,LCENTR,LAFT,JMACH,NPROT,NLOC,LPROT
C
      LOGICAL TRUNC,BASE,PROTUB
C
      COMMON /INLETN/ RINLET(41),ICOVER,RAMANG,IADD,MFR(20)
      LOGICAL ICOVER,IADD
      REAL MFR
      COMMON /INLTD/  DINLET(120)
C
C***  BODY GEOMETRIC CONSTANTS
C
      COMMON /GEOBOD/ GEOB(47)
C
C***  PROGRAM CONSTANTS
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C
      COMMON /PAERO/ PDATA(4024)
C
C****   INITIALIZE PARTIAL AERO COEFFICIENTS   *******
      DO 10 I=1,4024
         PDATA(I)=UNUSED
  10  CONTINUE
C
C****   INITIALIZE AXIBOD OR ELLBOD INPUTS  *******
      NX=UNUSED
      TNOSE=UNUSED
      LNOSE=UNUSED
      DNOSE=UNUSED
      BNOSE=UNUSED
      TRUNC=.FALSE.
      LCENTR=UNUSED
      DCENTR=UNUSED
      TAFT=UNUSED
      LAFT=UNUSED
      DAFT=UNUSED
      POWER=UNUSED
      XO=UNUSED
      DO 20 I=1,50
        X(I)=UNUSED
        R(I)=UNUSED
        IF(I .LE. 20) DISCON(I)=UNUSED
 20   CONTINUE
C
C*****   INITIALIZE BASE-JET PLUME INTERACTION INPUTS   *******
      BASE=.FALSE.
      BETAN=UNUSED
      DO 30 I=1,20
        JMACH(I)=UNUSED
        PRAT(I)=UNUSED
        TRAT(I)=UNUSED
 30   CONTINUE
C
C***    INITIALIZE BODY GEOMETRIC CONSTANTS  *******
      DO 40 I=1,47
         GEOB(I)=UNUSED
 40   CONTINUE
C
C****   INITIALIZE ELLIPTICAL BODY INPUTS  *******
      DO 50 I=1,50
         ELLIP(I)=UNUSED
         H(I)=UNUSED
 50   CONTINUE
      ENOSE=UNUSED
      ECENTR=UNUSED
      EAFT=UNUSED
      DEXIT=UNUSED
C
C***   INITIALIZE PROTUBERANCE INPUTS  *******
      PROTUB=.FALSE.
      NPROT=0.0
      DO 60 I=1,20
        PTYPE(I)=UNUSED
        XPROT(I)=UNUSED
        NLOC(I)=0.0
        BLDMEM(I)=0.0
 60   CONTINUE
      DO 70 I=1,100
        BLDTYP(I)=UNUSED
        LPROT(I)=UNUSED
        WPROT(I)=UNUSED
        HPROT(I)=UNUSED
        OPROT(I)=0.0
 70   CONTINUE
C
C***   INITIALIZE INLET INPUTS   ******        
      DO 80 I=1,41
         RINLET(I)=UNUSED
 80   CONTINUE
      ICOVER=.FALSE.
      IADD=.FALSE.
      DO 90 I=1,20
        MFR(I)=UNUSED
 90   CONTINUE
      RAMANG=UNUSED
      DO 100 I=1,100
         DINLET(I)=UNUSED
 100  CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PANLCN(ALPHA,MACH,CDC,PHIB,PHIW,GAM,ALO,NTHEO,ATHEO,
     1   CNTHEO,XW,SPAN,AR,TAPER,CR,LODN,RADN,RADF,DREF,DELT,NSURF,
     2   DAQVW,KW,KKW,BLUNT,SWEEP0,AREA,YCPFIN,
     3   CN,CNWING,CYWING,CL,CLWING,WAQ,FACTH,FACTV,KSET,DFLAG)
C      
C  THIS SUBROUTINE COMPUTES THE TOTAL FIN NORMAL FORCE OF
C  A CRUCIFORM FIN SET USING THE CONCEPT OF EQUIVALENT
C  ANGLE OF ATTACK SUGGESTED BY NIELSEN (AIAA PAPER 77-1153)
C
C  MODIFIED BY W. BLAKE, WL/FIGC
C      
C  HERE THE TERM WING MEANS TWO EXPOSED FIN PANELS JOINED TOGETHER
C  AT THE ROOT.  FIN IMPLIES A SINGLE FIN PANEL.
C      
C *** INPUTS ***
C      
C  ALPHA - BODY TOTAL ANGLE OF ATTACK, DEG.
C   MACH - FREESTREAM MACH NUMBER
C    CDC - CROSS FLOW DRAG COEFFICIENT
C   PHIB - BODY ROLL ANGLE, CLOCKWISE FROM VERTICAL
C   PHIW - PANEL ROLL ANGLES, CLOCKWISE FROM VERTICAL
C    GAM - PANEL ROLL ANGLE FROM ROOT CHORD ROLL POSITION, DEG.
C          (POSITIVE CLOCKWISE)
C  NTHEO - NUMBER OF INPUT POINTS IN WING THEORETICAL CN TABLE
C  ATHEO - ANGLE OF ATTACK CORRESPONDING TO CNTHEO, DEG.
C CNTHEO - WING THEORETICAL NORMAL FORCE AS A FUNCTION OF
C          ATHEO; BASED UPON THE PLANFORM AREA
C     XW - DISTANCE FROM THE NOSE APEX TO THE FIN EXPOSED ROOT
C          CHORD LEADING EDGE
C   SPAN - WING SPAN, MEASURED TIP TO TIP (INCLUDES BODY)
C     AR - FIN EXPOSED ASPECT RATIO (WING: TWO FINS JOINED AT ROOT)
C  TAPER - FIN EXPOSED TAPER RATIO
C     CR - FIN EXPOSED ROOT CHORD
C   LODN - OGIVE NOSE FINENESS RATIO
C   RADN - BODY RADIUS AT NOSE/CENTERBODY JUNCTURE
C   RADF - BODY RADIUS AT FIN
C   DREF - REFERENCE DIAMETER (LENGTH)
C   DELT - ARRAY OF DEFLECTION ANGLES
C  NSURF - NUMBER OF SURFACES
C  DAQVW - EQUIV. ALPHA DUE TO VORTICES
C     KW - WING DUE TO BODY CARRY OVER INTERFERENCE FACTOR (ALPHA)
C    KKW - WING DUE TO BODY CARRY OVER INTERFERENCE FACTOR (DELTA)
C  BLUNT - BODY NOSE TIP RADIUS TO BODY RADIUS (BLUNTNESS RATIO)
C SWEEP0 - L.E. SWEEP ANGLE OF THE PANEL, DEG.
C   AREA - FIN PANEL ALONE PLANFORM AREA
C YCPFIN - FIN LATERAL CENTER OF PRESSURE
C FACTH  - CORRECTION TO PANEL LIFT DUE TO ELLIPTICITY - ELLIPSE IN HORIZONTAL
C          POSITION (WIDTH .GT. HEIGHT) EQUALS 1. FOR AXISYMETRIC BODY
C FACTV  - CORRECTION TO PANEL LIFT DUE TO ELLIPTICITY - ELLIPSE IN VERTCIAL
C          POSITON
C KSET   - INDEX OF FIN SET BEING EVALUATED
C DFLAG  - FLAG FOR AXIS OF ROTATION, STATIC: 0., PITCH: 1., YAW: 2.,
C          ROLL: 3.
C      
C *** OUTPUTS ***
C      
C     CN - PANEL NORMAL FORCE COEFFICIENT, FOR ALL FIN PANELS
C CNWING - TOTAL CN DUE TO WING SURFACES IN THE PRESENCE OF THE BODY
C CYWING - TOTAL CY DUE TO WING SURFACES IN THE PRESENCE OF THE BODY
C     CL - PANEL ROLLING MOMENT COEFFICIENT, FOR ALL PANELS
C CLWING - TOTAL WING ROLLING MOMENT COEFFICIENT
C    WAQ - ALPHA EQUIV. FOR ALL PANELS
C      
C  NOTE- REFER TO SUBROUTINES ALPEQ AND CLVR FOR OTHER DEFINITIONS
C        AND USE RESTRICTIONS
C      
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /FFINDL/ DUM(32),CLD(4)
      COMMON /FSET1/  D1,SPAN1(10),D2(251),YUP1(50),D3(77),CFOC1(10)
      COMMON /FSET2/  D4,SPAN2(10),D5(251),YUP2(50),D6(77),CFOC2(10)
      COMMON /FSET3/  D7,SPAN3(10),D8(251),YUP3(50),D9(77),CFOC3(10)
      COMMON /FSET4/  DX,SPAN4(10),DY(251),YUP4(50),DZ(77),CFOC4(10)
C      
      DIMENSION PHIW(8),GAM(8)
      DIMENSION ATHEO(NTHEO),CNTHEO(NTHEO)
      DIMENSION DELT(8),DAQVW(8),CN(8),CL(8),WAQ(8),DELTMP(4)
C
      REAL MACH,LODN,L12,L24,KW,KKW
C      
      DOB  = 2.*RADF/SPAN
C      
C***  DETERMINE FIN/FIN INTERFERENCE FACTORS
C      
      IF(NSURF .LE. 2)ISURF=1
      IF(NSURF .GT. 2)ISURF=2
C      
      CALL FINFIN(MACH,AR,CR,SPAN,TAPER,RADF,ISURF,A14,A24,A34,A44,
     1            B12,B24)
      L12=B12
      L24=B24
C      
C***  COMPUTE PANEL LOADS
C      
      CNWING=0.
      CYWING=0.
      CLWING=0.
C      
      DO 900 I=1,NSURF
        IF (PHIW(I).GT.360.) PHIW(I)=PHIW(I)-360.
        IF (PHIW(I).LT.0.0) PHIW(I)=PHIW(I)+360.
 900  CONTINUE
      IF (PHIW(NSURF).EQ.0.) PHIW(NSURF)=360.
C
C***  SET UP PANEL ROLL POSITION AND DEFLECTION ANGLE
C      
      DO 1140 I=1,NSURF
         PHI=PHIB+PHIW(I)+GAM(I)
         IF(PHI .GE. 360.) PHI=PHI-360.
         DEL=DELT(I)/RAD
C      
C***  ZERO OUT THE TEMPORARY ARRAY FOR PANEL DEFLECTIONS
C      
         DO 1000 J=1,4
              DELTMP(J)=0.0
 1000 CONTINUE
C      
C***  SET UP THE DEFLECTION ANGLES FOR AN EQUIVALENT CRUCIFORM PANEL
C     ARRANGEMENT TO BE USED TO COMPUTE THE PANEL TO PANEL INTERFERENCE
C     THE PANEL WHOSE EQUIVALENT ANGLE OF ATTACK IS BEING EVALUATED
C     IS SET UP AS THE TOP PANEL (FIN 1) IN A CRUCIFORM FIN CONFIGURATIO
C     THE OTHER PANELS IN THE DUMMY FIN SET ARE DEFLECTED TO MODEL THE
C     INFLUENCE OF THE OTHER PANELS IN THE REAL FIN SET.  THEN THE WHOLE
C     DUMMY FIN SET IS ROLLED SO THAT THE PANEL BEING EVALUATED IS
C     POSITIONED IN ITS PROPER ROLL ATTITUDE.
C      
C      
C***  SET TEMPORARY DEFLECTION ANGLE ARRAY ELEMENT FOR PANEL BEING
C     EVALTUATED
C      
              DELTMP(1)=DELT(I)
C      
C***  EVALUATE INTERFERENCE IF CONFIGURATION ONLY HAS ONE PANEL
C      
      IF (NSURF .EQ. 1) GOTO 1080
C      
C***  HERE FOR TWO PANEL FIN SET
      IF (NSURF .NE. 2) GOTO 1020
C      
C*          FIRST PANEL
C      
         IF (I .EQ. 2)  GOTO 1010
              DELTMP(3)= DELT(2)
      GOTO 1080
 1010 CONTINUE
C      
C*          SECOND PANEL
C      
              DELTMP(3)= DELT(1)
      GOTO 1080
 1020 CONTINUE
C      
C*** HERE FOR THREE PANEL FIN SET
C      
      IF (NSURF .NE. 3) GOTO 1050
C      
C*        FIRST PANEL
C      
         IF (I .NE. 1)  GOTO 1030
         IF (ABS(PHIW(2)-PHIW(1)).GT.120.) THEN
           DELTMP(2)= 0.0
           DELTMP(3)= DELT(2)
           DELTMP(4)= DELT(3)
         ELSEIF (ABS(PHIW(3)-PHIW(2)).GT.120.) THEN
           DELTMP(2)= DELT(2)
           DELTMP(3)= 0.0
           DELTMP(4)= DELT(3)
         ELSEIF (ABS(PHIW(3)-(PHIW(1)+360.)).GT.120.) THEN
           DELTMP(2)= DELT(2)
           DELTMP(3)= DELT(3)
           DELTMP(4)= 0.0
         ELSEIF (DELT(1).EQ.0.0) THEN
           DELTMP(2)=DELT(2)
           DELTMP(3)=0.0
           DELTMP(4)=DELT(3)
         ELSEIF (DELT(2).EQ.0.0) THEN
           DELTMP(2)=DELT(2)
           DELTMP(3)=DELT(3)
           DELTMP(4)=0.0
         ELSE
           DELTMP(2)=0.0
           DELTMP(3)=DELT(2)
           DELTMP(4)=DELT(3)
         ENDIF 
      GOTO 1080
 1030 CONTINUE
C      
C*        SECOND PANEL
C      
         IF (I .NE. 2) GOTO 1040
         IF (ABS(PHIW(2)-PHIW(1)).GT.120.) THEN
           DELTMP(2)= DELT(3)
           DELTMP(3)= DELT(1)
           DELTMP(4)= 0.0
         ELSEIF (ABS(PHIW(3)-PHIW(2)).GT.120.) THEN
           DELTMP(2)= 0.0
           DELTMP(3)= DELT(3)
           DELTMP(4)= DELT(1)
         ELSEIF (ABS(PHIW(3)-(PHIW(1)+360.)).GT.120.) THEN
           DELTMP(2)= DELT(3)
           DELTMP(3)= 0.0
           DELTMP(4)= DELT(1)
         ELSEIF (DELT(1).EQ.0.0) THEN
           DELTMP(2)=0.0
           DELTMP(3)=DELT(3)
           DELTMP(4)=DELT(1)
         ELSEIF (DELT(2).EQ.0.0) THEN
           DELTMP(2)=DELT(3)
           DELTMP(3)=0.0
           DELTMP(4)=DELT(1)
         ELSE 
           DELTMP(2)=DELT(3)
           DELTMP(3)=DELT(1)
           DELTMP(4)=0.0
         ENDIF 
      GOTO 1080
 1040 CONTINUE
C      
C*        THIRD PANEL
C      
         IF (ABS(PHIW(2)-PHIW(1)).GT.120.) THEN
           DELTMP(2)= DELT(1)
           DELTMP(3)= 0.0
           DELTMP(4)= DELT(2)
         ELSEIF (ABS(PHIW(3)-PHIW(2)).GT.120.) THEN
           DELTMP(2)= DELT(1)
           DELTMP(3)= DELT(2)
           DELTMP(4)= 0.0
         ELSEIF (ABS(PHIW(3)-(PHIW(1)+360.)).GT.120.) THEN
           DELTMP(2)= 0.0
           DELTMP(3)= DELT(1)
           DELTMP(4)= DELT(2)
         ELSEIF (DELT(1).EQ.0.0) THEN
           DELTMP(2)=DELT(1)
           DELTMP(3)=DELT(2)
           DELTMP(4)=0.0
         ELSEIF (DELT(2).EQ.0.0) THEN
           DELTMP(2)=0.0
           DELTMP(3)=DELT(1)
           DELTMP(4)=DELT(2)
         ELSE 
           DELTMP(2)=DELT(1)
           DELTMP(3)=0.0
           DELTMP(4)=DELT(3)
         ENDIF 
      GOTO 1080
 1050 CONTINUE
      IF(NSURF.NE.4) GO TO 1055
C      
C*** HERE FOR FIN SETS WITH FOUR PANELS
C
C  REV 8/99
C  CORRECT ADJACENT PANEL NUMBERING FOR 4 PANEL SETS
C
C*    FIRST PANEL
      IF (I .EQ. 1) THEN
              DELTMP(4)= DELT(4)
              DELTMP(3)= DELT(3)
              DELTMP(2)= DELT(2)
C*    SECOND PANEL
      ELSEIF(I .EQ. 2) THEN
              DELTMP(4)= DELT(1)
              DELTMP(3)= DELT(4)
              DELTMP(2)= DELT(3)
C*    THIRD PANEL
      ELSEIF(I .EQ. 3) THEN
              DELTMP(4)= DELT(2)
              DELTMP(3)= DELT(1)
              DELTMP(2)= DELT(4)
C*    LAST PANEL
      ELSEIF(I .EQ. 4) THEN
              DELTMP(4)= DELT(3)
              DELTMP(3)= DELT(2)
              DELTMP(2)= DELT(1)
      ENDIF
      GO TO 1080
 1055 CONTINUE
C      
C*** HERE FOR FIN SETS WITH MORE THAN FOUR PANELS
C      
      IF (I .GT. 1) GOTO 1060
C      
C*        FIRST PANEL
C      
              DELTMP(4)= DELT(NSURF)
              DELTMP(2)= DELT(2)
      GOTO 1080
 1060 CONTINUE
      IF (I .EQ. NSURF) GOTO 1070
C      
C*       MIDDLE PANELS
C      
              DELTMP(4)= DELT(I-1)
              DELTMP(2)= DELT(I+1)
      GOTO 1080
 1070 CONTINUE
C      
C*       LAST PANEL
C      
              DELTMP(4)= DELT(NSURF-1)
              DELTMP(2)= DELT(1)
C
 1080 CONTINUE
C
C  CALCULATE QWB, THE KWB CORRECTION FOR PANEL DIHEDRAL
C
         QWBTOP=SIN(GAM(I)/RAD)*SIN(GAM(I)/RAD)
         QWBBOT=(0.7*SQRT(1.-ABS(SIN(GAM(I)/RAD)))+0.6)
     1          **(2./SQRT(SPAN/2./RADF))
         QWBBOT=QWBBOT*SPAN/2./RADF*LOG(SPAN/2./RADF)+1.
         QWB=1.-QWBTOP/QWBBOT
         PDKW=KW*QWB
C      
C***  COMPUTE ALPHA EQUIVALENT
C      
         CALL ALPEQ(DOB,ALPHA,AR,PHI,1,DELTMP,MACH,DAQVW(I),LODN,RADN,
     1     XW,RADF,TAPER,ISURF,A14,A24,A34,A44,L12,L24,AEQ,PDKW,KKW,
     2     CDC,BLUNT,SWEEP0,AREA,ALO,KSET,DFLAG)
         WAQ(I)=AEQ
C      
C***     SPLINE INPUT CURVE FOR FIN CN AT AEQ
C      
C***     DETERMINE IF CN IS POSITIVE OR NEGATIVE AND ADJUST SIGN
C        OF CN EQUATION APPROPRIATELY.
C      
         SIGN=1.0
         IF (AEQ .LT. 0.0) SIGN=-1.0
         ACORR=ABS(AEQ)
         CALL SPLINE(ATHEO,CNTHEO,NTHEO,2,2,0.,0.,ACORR,1,CN(I),CNA)
         CN(I)=SIGN*CN(I)/2.*(FACTV*COS(PHIW(I)/RAD)**2+
     &         FACTH*SIN(PHIW(I)/RAD)**2)
C
C*** COMPUTE FIN LATERAL CENTER OF PRESSURE
C
      CALL YCP(AR,TAPER,MACH,ABS(CN(I)),YCPFIN)
      ROS=RADF/(SPAN/2.)
      DYCP=(1.-ROS)**2*(9.*PI**2-64.)/(12.*PI*(4.*(1.-ROS)+3.*PI*ROS))
C
C  LATERAL CP FOR ROLLING FIN
C
      IF(DFLAG.EQ.3.) YCPFIN=YCPFIN+DYCP
      IF(ABS(DELT(I)).LE.UNUSED .OR. MACH.GT.0.8) GO TO 1200
C         IF(KSET.EQ.1 .AND. CFOC1(1).LT.1.) THEN
C            CALL YCPAIL(AR,TAPER,MACH,SWEEP0,SPAN1,CFOC1,
C     1                  YUP1,CLD(KSET),YCPFIN)
C         ELSEIF(KSET.EQ.2 .AND. CFOC2(1).LT.1.) THEN
C            CALL YCPAIL(AR,TAPER,MACH,SWEEP0,SPAN2,CFOC2,
C     2                  YUP2,CLD(KSET),YCPFIN)
C         ELSEIF(KSET.EQ.3 .AND. CFOC3(1).LT.1.) THEN
C            CALL YCPAIL(AR,TAPER,MACH,SWEEP0,SPAN3,CFOC3,
C     3                  YUP3,CLD(KSET),YCPFIN)
C         ELSEIF(KSET.EQ.4 .AND. CFOC4(1).LT.1.) THEN
C            CALL YCPAIL(AR,TAPER,MACH,SWEEP0,SPAN4,CFOC4,
C     4                  YUP4,CLD(KSET),YCPFIN)
C         ENDIF
 1200 CONTINUE
C
C*** COMPUTE CL FROM CN
C
         CL(I)=-CN(I)*(YCPFIN*(SPAN/2.-RADF)+RADF*COS(GAM(I)/RAD))
     1               *COS(DEL)/DREF
C      
C***     TOTAL TAIL RESULTS
C      
         PHIR=(PHI-PHIB)/RAD
C
C***     IN MISSILE DATCOM, FIN PANELS WITH POSITIVE CAMBER WHICH 
C        ARE LOCATED BETWEEN 180 AND 360 DEGREES (180<PHI<360) ARE 
C        ASSUMED TO HAVE POSITIVE CN. THE SIGN OF
C        CN IS ADJUSTED HERE BY MULTIPLYING BY SIN(PHIR).
C
         CNWING=CNWING+CN(I)*COS(DEL)*SIN(PHIR)
         CYWING=CYWING-CN(I)*COS(DEL)*COS(PHIR)
         CLWING=CLWING+CL(I)
 1140 CONTINUE
C      
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RFIN3(LFIN3, AA)
C
C***  READ FINSET3 INPUTS
C
C  WRITTEN BY S. STOY, MCDONNELL DOUGLAS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION AA(399),NLNAME(6),IVNAME(113),LEN(23),IDIM(23),LOC(23)
C
      LOGICAL LFIN3,IEOF
C
      DATA NLNAME /  'F   ','I   ','N   ','S   ','E   ','T   '/
      DATA IVNAME /  'S   ','E   ','C   ','T   ','Y   ','P   ','S   ',
     1 'S   ','P   ','A   ','N   ','L   ','M   ','A   ','X   ','U   ',
     2 'L   ','F   ','L   ','A   ','T   ','U   ','L   ','M   ','A   ',
     3 'X   ','L   ','L   ','F   ','L   ','A   ','T   ','L   ','C   ',
     4 'H   ','O   ','R   ','D   ','Z   ','U   ','P   ','P   ','E   ',
     5 'R   ','Z   ','L   ','O   ','W   ','E   ','R   ','S   ','W   ',
     6 'E   ','E   ','P   ','S   ','T   ','A   ','X   ','L   ','E   ',
     7 'N   ','P   ','A   ','N   ','E   ','L   ','X   ','C   ','O   ',
     8 'R   ','D   ','M   ','E   ','A   ','N   ','T   ','H   ','I   ',
     9 'C   ','K   ','Y   ','U   ','P   ','P   ','E   ','R   ','Y   ',
     A 'L   ','O   ','W   ','E   ','R   ','F   ','I   ','N   ','P   ',
     B 'H   ','I   ','L   ','E   ','R   ','G   ','A   ','M   ','P   ',
     C 'H   ','I   ','F   ','C   ','F   ','O   ','C   '/
      DATA IDIM   / 1,10,10,10,10,10,10,10,10,10,10,10,1,50,50,50,50,
     1              50,1,10,8,8,10 /
      DATA LEN    / 6,5,5,6,5,6,5,6,6,5,3,3,6,5,4,5,6,6,6,3,3,4,4 /
      DATA LOC    / 1,2,12,22,32,42,52,62,72,82,92,102,112,113,163,213,
     1              263,313,363,364,374,382,390 /
C
      LFIN3=.TRUE.
C
      CALL NAMER(KAND,2,NLNAME,6,IVNAME,113,LEN,23,IDIM,AA,399,LOC,
     1 IEOF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SUMPOT(ORDER,BETA,I,C,ZE0,ZE0X,ZE0R,ZE0XX,
     1    ZE0XR,ZE0RR,NN1,NN2,NN3)
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  ORIGINAL ROUTINE WRITTEN BY F. MOORE, NSWC
C  MODIFIED BY J. JENKINS, WL/FIGC
C
      COMMON /VDARY/ XB(220),RB(220),RBP(220),DMM1(220),C1(220),
     1  RB1(220),RBP1(220),B(220),PSI(220),DMM2(220),PSIR(220),
     2  PHIX(220)
      DIMENSION C(220),ZE0X(220)
      INTEGER ORDER
      SUM1=0.
      SUM2=0.
      SUM3=0.
      SUM4=0.
      SUM5=0.
      SUM6=0.
      NTERM=3
      IF(ORDER .EQ. 1) NTERM=6
C
C  J=1 IS CONICAL SOLN. WHICH WILL BE ADDED IN BELOW.
C
      DO 1000 J=2,I
C
C ... SOLUTION OF J.A.S. EQUATION 26
C
         CALL JAS26(XB(I),BETA,RB(J-1),XB(J-1),XXI,RB(I),TAU,F1,F2,
     1        C(J),SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,-1.,NTERM)
 1000 CONTINUE
      JH=NN1+1
      IF(I.LE.NN1) GO TO 1010
      CALL DISC2(I,JH,BETA,SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,NTERM,ORDER)
      J=NN1+1
      IF(NN2 .EQ. 0)GO TO 1005
C
C ... SOLUTION OF J.A.S. EQUATION 26
C
      CALL JAS26(XB(I),BETA,RB(J-1),XB(J-1),XXI,RB(I),TAU,F1,F2,
     1        C(J),SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,+1.,NTERM)
      JH=NN2+1
      IF(I.LE.NN2) GO TO 1010
      CALL DISC2(I,JH,BETA,SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,NTERM,ORDER)
      J=NN2+1
C
C ... SOLUTION OF J.A.S. EQUATION 26
C
 1005 CALL JAS26(XB(I),BETA,RB(J-1),XB(J-1),XXI,RB(I),TAU,F1,F2,
     1        C(J),SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,+1.,NTERM)
      JH=NN3+1
      IF(I.LE.NN3) GO TO 1010
      CALL DISC2(I,JH,BETA,SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,NTERM,ORDER)
      J=NN3+1
C
C ... SOLUTION OF J.A.S. EQUATION 26
C
      CALL JAS26(XB(I),BETA,RB(J-1),XB(J-1),XXI,RB(I),TAU,F1,F2,
     1        C(J),SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,+1.,NTERM)
 1010 XIMX1=XB(I)-XB(1) +BETA*RB(1)
C
C ... SOLUTION OF J.A.S. EQUATION 25
C
      TAU=BETA*RB(I)/XIMX1
      IF(TAU.GE.1.) TAU=0.9999
      F1=ARSECH(TAU)
      F2=SQRT(1.-TAU**2)
      ZE0X(I)=SUM2-F1*C(1)
      ZE0R=SUM3+BETA*F2/TAU*C(1)
      IF(ORDER .NE. 1) GO TO 1020
      ZE0=SUM1+XIMX1*(F2-F1)*C(1)
      ZE0XX=-1./(XIMX1*F2)*C(1)+SUM4
      ZE0XR=BETA/(XIMX1*TAU*F2)*C(1)+SUM5
      ZE0RR=-BETA**2/(XIMX1*TAU**2*F2)*C(1)+SUM6
 1020 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WRFLT
C
C***  WRITE FLIGHT CONDITION INPUTS
C
      COMMON /FLC/   AA(144)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C      
      DIMENSION NLNAME(6),IVNAME(45),LEN(11),IDIM(11),LOC(11)
C
      DATA NLNAME /  'F   ','L   ','T   ','C   ','O   ','N   '/
      DATA IVNAME /  'N   ','A   ','L   ','P   ','H   ','A   ','A   ',
     1 'L   ','P   ','H   ','A   ','B   ','E   ','T   ','A   ','P   ',
     2 'H   ','I   ','N   ','M   ','A   ','C   ','H   ','M   ','A   ',
     3 'C   ','H   ','A   ','L   ','T   ','R   ','E   ','N   ','V   ',
     4 'I   ','N   ','F   ','T   ','I   ','N   ','F   ','P   ','I   ',
     5 'N   ','F   '/
      DATA IDIM   / 1,20,1,1,1,20,20,20,20,20,20 /
      DATA LEN    / 6,5,4,3,5,4,3,3,4,4,4 /
      DATA LOC    / 1,2,22,23,24,25,45,65,85,105,125 /
C
      CALL NAMEW(KAND,6,NLNAME,6,IVNAME,45,LEN,11,IDIM,AA,144,LOC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCALP(ALPHA,CN,CAO,CADB)
C
C***  SUBROUTINE TO COMPUTE THE DRAG DUE TO LIFT FOR AXISYMMETRIC
C***  BODIES USING THE METHOD OF ALLEN AND PERKINS
C
C***  INPUTS
C
C  ALPHA -- ANGLE OF ATTACK, DEGREES
C     CN -- NORMAL FORCE COEFFICIENT AT ALPHA
C    CAO -- AXIAL FORCE COEFFICIENT AT ZERO NORMAL FORCE
C
C***  OUTPUT
C
C   CADB -- AXIAL FORCE AT ANGLE OF ATTACK (EXCLUDING CAO)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
C***  COMPUTE THE LIFT COEFFICIENT
C
      CL=(CN-CAO*SIN(ALPHA/RAD))/(COS(ALPHA/RAD)+SIN(ALPHA/RAD)**2)
C
C***  THE DRAG COEFFICIENT
C
      CD=CAO+CL*SIN(ALPHA/RAD)
C
C***  TOTAL AXIAL FORCE COEFFICIENT
C
      CA=CD*COS(ALPHA/RAD)-CL*SIN(ALPHA/RAD)
C
C***  AXIAL FORCE AT ANGLE OF ATTACK
C
      CADB=CA-CAO
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BUILD(MACH,RPUL,DEL,K,KK,NM,BDTYPE,HPROT,
     * WPROT,LPROT,OPROT,CDBILD)
C
C  WRITTEN BY K. DETERS, MCDONNELL DOUGLAS
C
      REAL MACH,BDTYPE(100),HPROT(100),WPROT(100),LPROT(100),
     * OPROT(100)
      CDTOT=0.0
      DO 10 I=1,NM
      K=K+1
      KK=KK+1
      ITYPE=BDTYPE(KK)
      IF (ITYPE .EQ. 1)
     * CALL CYL(MACH,RPUL,DEL,HPROT(K),WPROT(K),LPROT(K),OPROT(K),CDSUM)
      IF (ITYPE .EQ. 2)
     * CALL CIRC(MACH,DEL,HPROT(K),LPROT(K),OPROT(K),CDSUM)
      IF (ITYPE .EQ. 5)
     * CALL FLAT(MACH,DEL,HPROT(K),WPROT(K),LPROT(K),OPROT(K),CDSUM)
      CDTOT=CDTOT+CDSUM
 10   CONTINUE
      CDBILD=CDTOT
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CPCAL(MACH,DELTA,IBOAT,CPMDB)
C
C *** CALCULATES PRESSURE COEFFICIENT BASED ON PANEL FLOW
C *** DEFLECTION ANGLE AND EMPIRICAL PRESSURE METHODS
C *** LEESIDE = ACM EMPIRICAL
C *** WINDWARD = DAHLEM-BUCK EMPIRICAL
C
      COMMON /CONST/PI,RAD,UNUSED,KAND
C
      REAL MACH,LMACH
      DATA DELCHK/.3926990816/
      DATA DELCH1/.039537137/
      DATA RAD16/.2792526803/
C
      LMACH=ALOG(MACH)
      UPMACH=1.0/(MACH*MACH*RAD16)
      IF (DELTA.LE.0.0) GO TO 1030
      IF (DELTA.LE.DELCH1) GO TO 1000
      IF (DELTA.GE.DELCHK) GO TO 1010
      CP=1.0/SIN(4.0*DELTA)**0.75+1.0
      GO TO 1020
 1000 CONTINUE
      CP=5.0
      GO TO 1020
 1010 CONTINUE
      CP=2.0
 1020 CONTINUE
      SINDEL=SIN(DELTA)
      CALL SRATIO(MACH,LMACH,DELTA,RATIO,A2)
      CPMDB=CP*SINDEL*SINDEL*RATIO
      GO TO 1050
 1030 CONTINUE
      DELCRT=(4.*MACH-16.)/RAD
      IF (MACH.GT.4.) DELCRT=0.0
      IF (IBOAT.EQ.0) DELCRT=0.0
      IF (DELTA.LE.-RAD16+DELCRT) GO TO 1040
C
C **  HERE IF ABS(DELTA).LE.16-DELCRT DEG.
C
      CPMDB=(DELTA-DELCRT)*UPMACH
      IF (CPMDB.GT.0.0) CPMDB=0.0
      GO TO 1050
 1040 CONTINUE
C
C **  HERE IF ABS(DELTA).GT.16-DELCRT DEG
C
      CPMDB=-RAD16*UPMACH
 1050 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE DWRIT2(IM)
C      
C  REV 1/96 UPDATE - NEW SUBROUTINE
C
C***    SUBROUTINE TO PRINT DYNAMIC DERIVATIVES
C
C  WRITTEN BY W. BLAKE, WL/FIGC
C      
C***    INPUT
C      
C     IM=MACH NUMBER INDEX
C
      COMMON /CASEID/ CC(177),NOLAT,IR,IPAGE
      COMMON /DBODY/ BCNQ(20),BCMQ(20),BCAQ(20),BCYQ(20),
     1  BCLNQ(20),BCLLQ(20),BCNR(20),BCMR(20),BCAR(20),
     2  BCYR(20),BCLNR(20),BCLLR(20),BCNP(20),BCMP(20),
     3  BCAP(20),BCYP(20),BCLNP(20),BCLLP(20),
     4  BCNAD(20),BCMAD(20),CLLP,CYP,CNP1,CNP3,CNP5,CNPY5
C
      COMMON /DB1/ D1CNQ(20),D1CMQ(20),D1CAQ(20),D1CYQ(20),
     1  D1CLNQ(20),D1CLLQ(20),D1CNR(20),D1CMR(20),D1CAR(20),
     2  D1CYR(20),D1CLNR(20),D1CLLR(20),D1CNP(20),D1CMP(20),
     3  D1CAP(20),D1CYP(20),D1CLNP(20),D1CLLP(20),
     4  D1CNAD(20),D1CMAD(20)
C
      COMMON /DB12/ D2CNQ(20),D2CMQ(20),D2CAQ(20),D2CYQ(20),
     1  D2CLNQ(20),D2CLLQ(20),D2CNR(20),D2CMR(20),D2CAR(20),
     2  D2CYR(20),D2CLNR(20),D2CLLR(20),D2CNP(20),D2CMP(20),
     3  D2CAP(20),D2CYP(20),D2CLNP(20),D2CLLP(20),
     4  D2CNAD(20),D2CMAD(20)
C
      COMMON /DB123/ D3CNQ(20),D3CMQ(20),D3CAQ(20),D3CYQ(20),
     1  D3CLNQ(20),D3CLLQ(20),D3CNR(20),D3CMR(20),D3CAR(20),
     2  D3CYR(20),D3CLNR(20),D3CLLR(20),D3CNP(20),D3CMP(20),
     3  D3CAP(20),D3CYP(20),D3CLNP(20),D3CLLP(20),
     4  D3CNAD(20),D3CMAD(20)
C
      COMMON /DB1234/ D4CNQ(20),D4CMQ(20),D4CAQ(20),D4CYQ(20),
     1  D4CLNQ(20),D4CLLQ(20),D4CNR(20),D4CMR(20),D4CAR(20),
     2  D4CYR(20),D4CLNR(20),D4CLLR(20),D4CNP(20),D4CMP(20),
     3  D4CAP(20),D4CYP(20),D4CLNP(20),D4CLLP(20),
     4  D4CNAD(20),D4CMAD(20)
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,LDERRD,LPART,
     1               LDUM(4),LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,LDUM2(6),
     2               LELLB,LDUM3(3),LSPIN,LARBOD
      COMMON /FLC/ NALP,ALPHA(20),FLDUM(123)
      LOGICAL LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,LDERRD,LPART,LDUM3,
     1        LDUM,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,LDUM2,LSPIN,LELLB
      LOGICAL NDUM,NMF,NAF,NOLAT
      REAL NALP
      NALPHA=NALP+.5
C      
C***    IF OUTPUT IS TO BE IN DEGREES CONVERT FROM RADIANS
C      
      IF(.NOT.LDERRD) CALL DDCVRT
C      
C***   PRINT BODY ALONE DYNAMICS
C      
 1010 IF((LAXIS.OR.LELLB) .AND. (LPART.OR.LBUILD))GO TO 1020
      IF(.NOT. ((LAXIS.OR.LELLB) .AND. .NOT. LFIN1))GO TO 1160
 1020 CONTINUE
C
C  LONGITUDINAL
C
      CALL HEADR9
      WRITE(6,1300)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      IF(.NOT. LDERRD)WRITE(6,1350)
      IF(LDERRD)WRITE(6,1360)
      WRITE(6,1375)
      DO 1030 I=1,NALPHA
        WRITE(6,1382) ALPHA(I),BCNQ(I),BCMQ(I),BCAQ(I),BCNAD(I),
     1   BCMAD(I)
 1030 CONTINUE
      WRITE(6,1385)
      IF(NOLAT) GO TO 1035
C
C  LATERAL-DIRECTIONAL
C
      CALL HEADR9
      WRITE(6,1300)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      IF(.NOT. LDERRD)WRITE(6,1350)
      IF(LDERRD)WRITE(6,1360)
      WRITE(6,1377)
      DO 1032 I=1,NALPHA
        WRITE(6,1384) ALPHA(I),BCYR(I),BCLNR(I),BCLLR(I),BCYP(I),
     1      BCLNP(I),BCLLP(I)
 1032 CONTINUE
      WRITE(6,1387)
 1035 CONTINUE
C
C  MAGNUS DERIVATIVE CALCULATIONS FOR BODY ALONE
C
      IF(.NOT. LSPIN) GO TO 1160
      IF(.NOT. LDERRD)WRITE(6,1410)
      IF(LDERRD)WRITE(6,1420)
      WRITE(6,1430)
      WRITE(6,1440) CLLP,CYP,CNP1,CNP3,CNP5,CNPY5
      WRITE(6,1450)
      WRITE(6,1460)
C      
C       DETERMINE NUMBER OF FIN SETS DEFINED
C      
 1160 NFS=0
      IF(LFIN1)NFS=NFS+1
      IF(LFIN2)NFS=NFS+1
      IF(LFIN3)NFS=NFS+1
      IF(LFIN4)NFS=NFS+1
      IF(NFS.EQ.0 .OR. (.NOT.(LFIN1 .AND. (LAXIS.OR.LELLB))))GO TO 1250
      IF(LBUILD)GO TO 1170
      GO TO (1170,1190,1210,1230),NFS
C      
C***     PRINT BODY + 1 FINSET DYNAMICS
C      
 1170 CONTINUE
C
C  LONGITUDINAL
C
      CALL HEADR9
      WRITE(6,1310)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      IF(.NOT. LDERRD)WRITE(6,1350)
      IF(LDERRD)WRITE(6,1360)
      WRITE(6,1375)
      DO 1180 I=1,NALPHA
         WRITE(6,1382) ALPHA(I),D1CNQ(I),D1CMQ(I),D1CAQ(I),
     1   D1CNAD(I),D1CMAD(I)
 1180 CONTINUE
      WRITE(6,1385)
      IF(NOLAT) GO TO 1185
C
C  LATERAL-DIRECTIONAL
C
      CALL HEADR9
      WRITE(6,1310)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      IF(.NOT. LDERRD)WRITE(6,1350)
      IF(LDERRD)WRITE(6,1360)
      WRITE(6,1377)
      DO 1182 I=1,NALPHA
         WRITE(6,1384) ALPHA(I),D1CYR(I),D1CLNR(I),D1CLLR(I),
     1   D1CYP(I),D1CLNP(I),D1CLLP(I)
 1182 CONTINUE
      WRITE(6,1387)
 1185 CONTINUE
      IF(LBUILD)GO TO 1190
      GO TO 1250
C      
C***    PRINT BODY + 2 FINSET DYNAMICS
C      
 1190 IF(NFS .LE. 1)GO TO 1250
C
C  LONGITUDINAL
C
      CALL HEADR9
      WRITE(6,1320)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      IF(.NOT. LDERRD)WRITE(6,1350)
      IF(LDERRD)WRITE(6,1360)
      WRITE(6,1375)
      DO 1200 I=1,NALPHA
         WRITE(6,1382) ALPHA(I),D2CNQ(I),D2CMQ(I),D2CAQ(I),
     1   D2CNAD(I),D2CMAD(I)
 1200 CONTINUE
      WRITE(6,1385)
      IF(NOLAT) GO TO 1205
C
C  LATERAL-DIRECTIONAL
C
      CALL HEADR9
      WRITE(6,1320)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      IF(.NOT. LDERRD)WRITE(6,1350)
      IF(LDERRD)WRITE(6,1360)
      WRITE(6,1377)
      DO 1202 I=1,NALPHA
         WRITE(6,1384) ALPHA(I),D2CYR(I),D2CLNR(I),D2CLLR(I),
     1   D2CYP(I),D2CLNP(I),D2CLLP(I)
 1202 CONTINUE
      WRITE(6,1387)
 1205 CONTINUE
      IF(LBUILD)GO TO 1210
      GO TO 1250
C      
C***    PRINT BODY + 3 FINSET DYNAMICS
C      
 1210 IF(NFS .LE. 2)GO TO 1250
C
C  LONGITUDINAL
C
      CALL HEADR9
      WRITE(6,1330)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      IF(.NOT. LDERRD)WRITE(6,1350)
      IF(LDERRD)WRITE(6,1360)
      WRITE(6,1375)
      DO 1220 I=1,NALPHA
         WRITE(6,1382) ALPHA(I),D3CNQ(I),D3CMQ(I),D3CAQ(I),
     1   D3CNAD(I),D3CMAD(I)
 1220 CONTINUE
      WRITE(6,1385)
      IF(NOLAT) GO TO 1225
C
C  LATERAL-DIRECTIONAL
C
      CALL HEADR9
      WRITE(6,1300)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      IF(.NOT. LDERRD)WRITE(6,1350)
      IF(LDERRD)WRITE(6,1360)
      WRITE(6,1377)
      DO 1222 I=1,NALPHA
         WRITE(6,1384) ALPHA(I),D3CYR(I),D3CLNR(I),D3CLLR(I),
     1   D3CYP(I),D3CLNP(I),D3CLLP(I)
 1222 CONTINUE
      WRITE(6,1387)
 1225 CONTINUE
      IF(LBUILD)GO TO 1230
      GO TO 1250
C      
C***    PRINT BODY + 4 FINSET DYNAMICS
C      
 1230 IF(NFS.LE. 3)GO TO 1250
C
C  LONGITUDINAL
C
      CALL HEADR9
      WRITE(6,1340)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      IF(.NOT. LDERRD)WRITE(6,1350)
      IF(LDERRD)WRITE(6,1360)
      WRITE(6,1375)
      DO 1240 I=1,NALPHA
         WRITE(6,1382) ALPHA(I),D4CNQ(I),D4CMQ(I),D4CAQ(I),
     1   D4CNAD(I),D4CMAD(I)
 1240 CONTINUE
      WRITE(6,1385)
      IF(NOLAT) GO TO 1245
C
C  LATERAL-DIRECTIONAL
C
      CALL HEADR9
      WRITE(6,1340)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      IF(.NOT. LDERRD)WRITE(6,1350)
      IF(LDERRD)WRITE(6,1360)
      WRITE(6,1377)
      DO 1242 I=1,NALPHA
         WRITE(6,1384) ALPHA(I),D4CYR(I),D4CLNR(I),D4CLLR(I),
     1   D4CYP(I),D4CLNP(I),D4CLLP(I)
 1242 CONTINUE
      WRITE(6,1387)
 1245 CONTINUE
C      
 1250 CONTINUE
C      
 1300 FORMAT(4X,23X,'BODY ALONE DYNAMIC DERIVATIVES',/)
 1310 FORMAT(4X,20X,'BODY + 1 FIN SET DYNAMIC DERIVATIVES',/)
 1320 FORMAT(4X,20X,'BODY + 2 FIN SETS DYNAMIC DERIVATIVES',/)
 1330 FORMAT(4X,20X,'BODY + 3 FIN SETS DYNAMIC DERIVATIVES',/)
 1340 FORMAT(4X,20X,'BODY + 4 FIN SETS DYNAMIC DERIVATIVES',/)
 1350 FORMAT(4X,16X,'------------ DYNAMIC DERIVATIVES (PER',
     1 ' DEGREE) -----------')
 1360 FORMAT(4X,16X,'------------ DYNAMIC DERIVATIVES (PER',
     1 ' RADIAN) -----------')
 1375 FORMAT(4X,5X,'ALPHA',7X,'CNQ',8X,'CMQ',8X,'CAQ',7X,
     1  'CNAD',7X,'CMAD')
 1377 FORMAT(4X,5X,'ALPHA',7X,'CYR',7X,'CLNR',7X,'CLLR',8X,
     1  'CYP',7X,'CLNP',7X,'CLLP')
 1382 FORMAT(4X,F10.2,5(F11.3))
 1384 FORMAT(4X,F10.2,6(F11.3))
 1385 FORMAT(/,4X,'PITCH RATE DERIVATIVES NON-DIMENSIONALIZED',
     1  ' BY Q*LREF/2*V')
 1387 FORMAT(/,4X,'YAW AND ROLL RATE DERIVATIVES NON-DIMENSIONALIZED',
     2  ' BY R*LATREF/2*V')
C
 1410 FORMAT(/,4X,'---------------- MAGNUS DERIVATIVES',
     1 ' (PER DEGREE) ------------------')
 1420 FORMAT(/,4X,'---------------- MAGNUS DERIVATIVES',
     1 ' (PER RADIAN) ------------------')
 1430 FORMAT(/,7X,'CLLP',9X,'CYP',10X,'CNP1',9X,'CNP3',9X,'CNP5',9X,
     1 'CNPA-5')
 1440 FORMAT(/,1P,4X,E10.3,3X,E10.3,3X,E10.3,3X,E10.3,3X,E10.3,3X,
     1E10.3,3X,E10.3)
 1450 FORMAT(/,4X,'CNP/SIN(ALPHA)=CNP1+CNP3*(SIN(ALPHA))**2+CNP5*',
     1 '(SIN(ALPHA))**4',/)
 1460 FORMAT(4X,'CAUTION- DO NOT USE THIS POLYNOMIAL PAST THE FIRST',
     1 ' POSITIVE EXTREME.',/,4X,'CNP IS EXPECTED TO STAY POSITIVE',
     2 ' AT HIGHER ANGLES OF ATTACK.')
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FGEOM
C      
C***  SUBROUTINE EXECUTIVE FOR FIN GEOMETRY
C      
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /DESIG/  NACA(80,4)
      COMMON /GEOFS1/ GFIN1(188)
      COMMON /GEOFS2/ GFIN2(188)
      COMMON /GEOFS3/ GFIN3(188)
      COMMON /GEOFS4/ GFIN4(188)
      COMMON /FSET1/  FDATA1(399)
      COMMON /FSET2/  FDATA2(399)
      COMMON /FSET3/  FDATA3(399)
      COMMON /FSET4/  FDATA4(399)
      COMMON /F1WORK/ F1WK(290)
      COMMON /F2WORK/ F2WK(290)
      COMMON /F3WORK/ F3WK(290)
      COMMON /F4WORK/ F4WK(290)
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,
     4               LELLB,LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM
      CHARACTER*4 NACA
      LOGICAL LLER1,LLER2,LLER3,LLER4
C      
      LLER1=.FALSE.
      LLER2=.FALSE.
      LLER3=.FALSE.
      LLER4=.FALSE.
C      
C***  FIN SET NUMBER 1
C      
      IF(.NOT. LFIN1)GO TO 1060
C      
C   IF USER HAS INPUT LEADING EDGE RADII SET LLER1 TO TRUE
C      
      IF(FDATA1(364) .NE. UNUSED)LLER1=.TRUE.
C      
C  PLANFORM GEOMETRY CONSTANTS
C      
      CALL F1GEOM
C      
C  DEFINE AIRFOIL SECTION IF NECESSARY
C      
      CALL FOIL(1,FDATA1(1),GFIN1(178),FDATA1(2),FDATA1(12),
     1          FDATA1(22),FDATA1(62),FDATA1(364),F1WK(1),LNACA,
     2          NACA(1,1))
C      
C  SET UP SECTION IF NOT USER DEFINED COORDINATES
C      
      IF(FDATA1(1) .LT. 3.)CALL AIRFOL(1,NACA(1,1),FDATA1(113),
     1      FDATA1(263),FDATA1(313),FDATA1(213),FDATA1(163),
     2      GFIN1(184),F1WK(1),F1WK(2),GFIN1(185),F1WK(3),
     3      F1WK(268),F1WK(269),F1WK(270))
      IF (LLER1) THEN
C      
C***  AVERAGE LEADING EDGE RADIUS 
C          NOTE - THE METHOD DESCRIBED HERE IS USED FOR EACH FIN SET
C      
C        THIS LOOP DETERMINES HOW MANY SEMI SPANS ARE INPUT (AND THERFORE
C           HOW MANY LEADING EDGE RADII)
C
      DO 1020 I=1,10
         IF(FDATA1(I+1) .EQ. UNUSED)GO TO 1030
         J=I
 1020 CONTINUE
C
C     USE A LINEAR INTERPOLATION TO DETERMINE THE AVERAGE(EFFECTIVE) LEADING
C      EDGE RADIUS THIS IS DONE AT THE AVERAGE SEMI SPAN 
C
 1030 CALL LNTRP(FDATA1(2),FDATA1(364),J,GFIN1(178),F1WK(1))
      ENDIF
      IF(FDATA1(1) .EQ. 3.) THEN
C      
C  SET UP SECTION IF USER DEFINED COORDINATES
C      
            CALL USEFOL(1,FDATA1(113),
     1      FDATA1(263),FDATA1(313),FDATA1(213),FDATA1(163),
     2      F1WK(1),F1WK(2),GFIN1(185),F1WK(3))
C
      ENDIF 
      GFIN1(176)=F1WK(2)
      DO 1050 I=1,10
         GFIN1(I+150)=F1WK(2)
         FDATA1(I+363)=F1WK(1)
 1050 CONTINUE
C      
C***  FIN SET NUMBER 2
C      
 1060 IF(.NOT. LFIN2)GO TO 1120
C      
C  IF USER HAS INPUT LEADING EDGE RADII SET LLER2 TO TRUE
C      
      IF(FDATA2(364) .NE. UNUSED)LLER2=.TRUE.
C      
C  PLANFORM GEOMETRY CONSTANTS
C      
      CALL F2GEOM
C      
C  DEFINE AIRFOIL SECTION IF NECESSARY
C      
      CALL FOIL(2,FDATA2(1),GFIN2(178),FDATA2(2),FDATA2(12),
     1          FDATA2(22),FDATA2(62),FDATA2(364),F2WK(1),LNACA,
     2          NACA(1,2))
C      
C  SET UP SECTION IF NOT USER DEFINED COORDINATES
C      
      IF(FDATA2(1) .LT. 3.)CALL AIRFOL(2,NACA(1,2),FDATA2(113),
     1      FDATA2(263),FDATA2(313),FDATA2(213),FDATA2(163),
     2      GFIN2(184),F2WK(1),F2WK(2),GFIN2(185),F2WK(3),
     3      F2WK(268),F2WK(269),F2WK(270))
      IF(LLER2) THEN
C      
C  AVERAGE LEADING EDGE RADIUS
C      
      DO 1080 I=1,10
         IF(FDATA2(I+1) .EQ. UNUSED)GO TO 1090
         J=I
 1080 CONTINUE
 1090 CALL LNTRP(FDATA2(2),FDATA2(364),J,GFIN2(178),F2WK(1))
      ENDIF
      IF(FDATA2(1) .EQ. 3.) THEN
C      
C  SET UP SECTION IF USER DEFINED COORDINATES
C      
            CALL USEFOL(2,FDATA2(113),
     1      FDATA2(263),FDATA2(313),FDATA2(213),FDATA2(163),
     2      F2WK(1),F2WK(2),GFIN2(185),F2WK(3))
C      
      ENDIF
      GFIN2(176)=F2WK(2)
      DO 1110 I=1,10
         GFIN2(I+150)=F2WK(2)
         FDATA2(I+363)=F2WK(1)
 1110 CONTINUE
C      
C***  FIN SET NUMBER 3
C      
 1120 IF(.NOT. LFIN3)GO TO 1180
C      
C  IF USER HAS INPUT LEADING EDGE RADII SET LLER3 TO TRUE
C      
      IF(FDATA3(364) .NE. UNUSED)LLER3=.TRUE.
C      
C  PLANFORM GEOMETRY CONSTANTS
C      
      CALL F3GEOM
C      
C  DEFINE AIRFOIL SECTION IF NECESSARY
C      
      CALL FOIL(3,FDATA3(1),GFIN3(178),FDATA3(2),FDATA3(12),
     1          FDATA3(22),FDATA3(62),FDATA3(364),F3WK(1),LNACA,
     2          NACA(1,3))
C      
C  SET UP SECTION IF NOT USER DEFINED COORDINATES
C      
      IF(FDATA3(1) .LT. 3.)CALL AIRFOL(3,NACA(1,3),FDATA3(113),
     1      FDATA3(263),FDATA3(313),FDATA3(213),FDATA3(163),
     2      GFIN3(184),F3WK(1),F3WK(2),GFIN3(185),F3WK(3),
     3      F3WK(268),F3WK(269),F3WK(270))
      IF(LLER3) THEN
C      
C  AVERAGE LEADING EDGE RADIUS
C      
      DO 1140 I=1,10
         IF(FDATA3(I+1) .EQ. UNUSED)GO TO 1150
         J=I
 1140 CONTINUE
 1150 CALL LNTRP(FDATA3(2),FDATA3(364),J,GFIN3(178),F3WK(1))
      ENDIF
      IF(FDATA3(1) .EQ. 3.) THEN
C      
C  SET UP SECTION IF USER DEFINED COORDINATES
C      
            CALL USEFOL(3,FDATA3(113),
     1      FDATA3(263),FDATA3(313),FDATA3(213),FDATA3(163),
     2      F3WK(1),F3WK(2),GFIN3(185),F3WK(3))
C      
      ENDIF
      GFIN3(176)=F3WK(2)
      DO 1170 I=1,10
         GFIN3(I+150)=F3WK(2)
         FDATA3(I+363)=F3WK(1)
 1170 CONTINUE
C      
C***  FIN SET NUMBER 4
C      
 1180 IF(.NOT. LFIN4)GO TO 1240
C      
C  IF USER HAS INPUT LEADING EDGE RADII SET LLER4 TO TRUE
C      
      IF(FDATA4(364) .NE. UNUSED)LLER4=.TRUE.
C      
C  PLANFORM GEOMETRY CONSTANTS
C      
      CALL F4GEOM
C      
C  DEFINE AIRFOIL SECTION IF NECESSARY
C      
      CALL FOIL(4,FDATA4(1),GFIN4(178),FDATA4(2),FDATA4(12),
     1          FDATA4(22),FDATA4(62),FDATA4(364),F4WK(1),LNACA,
     2          NACA(1,4))
C      
C  SET UP SECTION IF NOT USER DEFINED COORDINATES
C      
      IF(FDATA4(1) .LT. 3.)CALL AIRFOL(4,NACA(1,4),FDATA4(113),
     1      FDATA4(263),FDATA4(313),FDATA4(213),FDATA4(163),
     2      GFIN4(184),F4WK(1),F4WK(2),GFIN4(185),F4WK(3),
     3      F4WK(268),F4WK(269),F4WK(270))
      IF(LLER4) THEN
C      
C  AVERAGE LEADING EDGE RADIUS
C      
 1190 DO 1200 I=1,10
         IF(FDATA4(I+1) .EQ. UNUSED)GO TO 1210
         J=I
 1200 CONTINUE
 1210 CALL LNTRP(FDATA4(2),FDATA4(364),J,GFIN4(178),F4WK(1))
      ENDIF
      IF(FDATA4(1) .EQ. 3.) THEN
C      
C  SET UP SECTION IF USER DEFINED COORDINATES
C      
            CALL USEFOL(4,FDATA4(113),
     1      FDATA4(263),FDATA4(313),FDATA4(213),FDATA4(163),
     2      F4WK(1),F4WK(2),GFIN4(185),F4WK(3))
C      
      ENDIF
      GFIN4(176)=F4WK(2)
      DO 1230 I=1,10
         GFIN4(I+150)=F4WK(2)
         FDATA4(I+363)=F4WK(1)
 1230 CONTINUE
C      
 1240 CONTINUE
C      
C***  COMPUTE X/C AT MAX THICKNESS FOR EACH FIN SET      
C      
      TOC1=FDATA1(213)
      GFIN1(188)=FDATA1(113)
      TOC2=FDATA2(213)
      GFIN2(188)=FDATA2(113)
      TOC3=FDATA3(213)
      GFIN3(188)=FDATA3(113)
      TOC4=FDATA4(213)
      GFIN4(188)=FDATA4(113)
      DO 1260 I=2,50
         IF(FDATA1(I+212).GT.TOC1) THEN
           GFIN1(188)=FDATA1(I+112)
           TOC1=FDATA1(I+212)
         ENDIF
         IF(FDATA2(I+212).GT.TOC2) THEN
           GFIN2(188)=FDATA2(I+112)
           TOC2=FDATA2(I+212)
         ENDIF
         IF(FDATA3(I+212).GT.TOC3) THEN
           GFIN3(188)=FDATA3(I+112)
           TOC3=FDATA3(I+212)
         ENDIF
         IF(FDATA4(I+212).GT.TOC4) THEN
           GFIN4(188)=FDATA4(I+112)
           TOC4=FDATA4(I+212)
         ENDIF
 1260 CONTINUE
C      
C***  COMPUTE SEMI-WEDGE ANGLE AT LEADING EDGE
C      
      GFIN1(186)=ATAN(FDATA1(214)/FDATA1(114))*RAD
      GFIN2(186)=ATAN(FDATA2(214)/FDATA2(114))*RAD
      GFIN3(186)=ATAN(FDATA3(214)/FDATA3(114))*RAD
      GFIN4(186)=ATAN(FDATA4(214)/FDATA4(114))*RAD
C      
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE GETETA(FR,MACH,ETA)
C
C***  SUBROUTINE TO COMPUTE THE SUBSONIC CROSS FLOW DRAG
C***  PROPORTIONALITY FACTOR USING GOLDSTEINS RESULTS
C***  AND THE TRANSONIC CORRELATION OF BAKER (AEDC-TR-75-124)
C
C***  INPUT
C
C     FR - OVERAL BODY FINENESS RATIO, LENGTH/DIAMETER
C   MACH - FREE STREAM MACH NUMBER
C
C***  OUTPUT
C
C    ETA - CROSS FLOW DRAG PROPORTIONALITY FACTOR
C
      DIMENSION AETA(9),ALD(9)
C
      REAL MACH
C
      DATA ALD/ 1.,2.,4.,6.,8.,12.,20.,30.,40. /
      DATA AETA/.530,.570,.613,.640,.665,.700,.765,.798,.820/
C
      ETA=1.0
      IF(MACH .GT. 1.4)GO TO 1030
C
C***  LINEARILY INTERPOLATE/EXTRAPOLATE
C
      CALL LNTRP(ALD,AETA,9,FR,ETA)
      IF(ETA .GT. 1.)ETA=1.
C
C     * IF MACH LIES BETWEEN 0.6 AND 1.4
           IF(MACH .GT. 0.6 .AND. MACH .LT. 1.4)GO TO 1000
           GO TO 1010
C     * THEN USE BAKERS TRANSONIC FAIRING
 1000      ETA=ETA+(1.-ETA)/2.*(1.+TANH((MACH-1.)*(15./MACH**4)))
           GO TO 1020
C     * ELSE CONTINUE
 1010      CONTINUE
 1020      CONTINUE
C     * ENDIF
C
 1030 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
       SUBROUTINE INZFIN(ICASE,SAVE)
C      
C***  INITIALIZE ALL FIN ARRAYS
C      
C***  FIN INPUTS
C      
      COMMON /FSET1/ SECTYP,SSPAN(10),LMAXU(10),LFLATU(10),LMAXL(10),
     1               LFLATL(10),CHORD(10),THICKU(10),THICKL(10),
     2               SWEEP(10),STA(10),XLE(10),NPANEL,
     3               XCORD(50),MEAN(50),THICK(50),YUPPER(50),
     4               YLOWER(50),FINPHI,LER(10),GAM(8),PHIF(8),
     5       	     CFOC(10)
C      
      REAL LER,LMAXU,LMAXL,LFLATU,LFLATL,NPANEL,MEAN
C      
      DIMENSION FDATA1(399)
      EQUIVALENCE (FDATA1(1),SECTYP)
C      
      COMMON /FSET2/ FDATA2(399)
      COMMON /FSET3/ FDATA3(399)
      COMMON /FSET4/ FDATA4(399)
C      
C***  FIN GEOMETRIC CONSTANTS
C      
      COMMON /GEOFS1/ SPLANF(10),CBAR(10),SWEPLE(10),SWEP25(10),
     1                SWEP50(10),SWEP75(10),SWEPTE(10),
     2                XMGCLE(10),XMGC25(10),
     3                XMGC50(10),XMGC75(10),XMGCTE(10),YMEANC(10),
     4                ASPCT(10),TAPER(10),TOVERC(10),XCENT(10),
     5                FINAR,FINTPR,FINSPN,FINSP,FINWET,TCEFF,
     6                FINXGC,FINYGC,SWAVLE,SWAV25,SWAV50,SWAV75,
     7                SWAVTE,FINCBR,DELTAY,DELTAD,XCENF,ALER
C      
      DIMENSION GFIN1(188)
      EQUIVALENCE (GFIN1(1),SPLANF(1))
C      
      COMMON /GEOFS2/ GFIN2(188)
      COMMON /GEOFS3/ GFIN3(188)
      COMMON /GEOFS4/ GFIN4(188)
C      
C***  FIN WORK ARRAYS
C      
      COMMON /F1WORK/ F1WK(290)
      COMMON /F2WORK/ F2WK(290)
      COMMON /F3WORK/ F3WK(290)
      COMMON /F4WORK/ F4WK(290)
      COMMON /DESIG/  NACA(80,4)
C      
C***  PROGRAM CONSTANTS
C      
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C      
      LOGICAL SAVE
C      
C***  INITIALIZE NACA IF PROGRAM GENERATED DESIGNATION
C      
      DO 1010 I=1,80
        IF(ICASE .EQ. 1)GO TO 1000
          IF(FDATA1(1) .NE. 1.) NACA(I,1)=UNUSED
          IF(FDATA2(1) .NE. 1.) NACA(I,2)=UNUSED
          IF(FDATA3(1) .NE. 1.) NACA(I,3)=UNUSED
          IF(FDATA4(1) .NE. 1.) NACA(I,4)=UNUSED
        GO TO 1010
 1000    NACA(I,1)=UNUSED
         NACA(I,2)=UNUSED
         NACA(I,3)=UNUSED
         NACA(I,4)=UNUSED
 1010 CONTINUE
      DO 1020 I=1,389
         FDATA1(I)=UNUSED
         FDATA2(I)=UNUSED
         FDATA3(I)=UNUSED
         FDATA4(I)=UNUSED
 1020 CONTINUE

C  SET DEFAULT VALUES FOR (FLAP CHORD/FIN CHORD)station i
C  (FLAP CHORD/FIN CHORD)station 1 DEFAULTS TO 1.
      FDATA1(390)=1.
      FDATA2(390)=1.
      FDATA3(390)=1.
      FDATA4(390)=1.
C  (FLAP CHORD/FIN CHORD)station i, where i=2,N, DEFAULTS TO 0.
      DO 1025 I=391,399
         FDATA1(I)=0.
         FDATA2(I)=0.
         FDATA3(I)=0.
         FDATA4(I)=0.
 1025 CONTINUE      

      DO 1030 I=1,188
         GFIN1(I)=UNUSED
         GFIN2(I)=UNUSED
         GFIN3(I)=UNUSED
         GFIN4(I)=UNUSED
 1030 CONTINUE
C      
      DO 1040 I=1,290
         F1WK(I)=UNUSED
         F2WK(I)=UNUSED
         F3WK(I)=UNUSED
         F4WK(I)=UNUSED
 1040 CONTINUE
C      
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PARAB(X,Y,Z,N,SL1,SLN)
C
C  SUBROUTINE TO FIT A SET OF INPUT DATA USING A PARABOLA
C  THE LEFT HAND AND RIGHT HAND SLOPES ARE USED IN THE FITTING
C
C  INPUTS
C
C      X -- INPUT X COORDINATES
C      Y -- INPUT Y COORDINATES
C   NPTS -- NUMBER OF POINTS TO FIT
C    SL1 -- BEGINNING SLOPE
C    SLN -- END SLOPE
C
C  OUTPUT
C
C      Z -- VALUES OF Z
C
C  ROUTINES CALLED -- NONE
C
      DIMENSION X(50),Y(50),Z(50),Q(50)
      IF(N.EQ.2)GO TO 1020
      GM=(2.+(X(3)-X(2))/(X(2)-X(1)))/(X(3)-X(1))
      DE=(X(2)-X(1))/(X(3)-X(2))/(X(3)-X(1))
      P=2./(X(2)-X(1))+GM
      Q(1)=-DE/P
      Z(1)=(SL1/2.+Y(1)*2./(X(2)-X(1))+Y(2)*(GM+DE))/P
      NM=N-1
      DO 1000 I=2,NM
         AL=(X(I+1)-X(I))/(X(I)-X(I-1))/(X(I+1)-X(I-1))
         BE=(2.+(X(I)-X(I-1))/(X(I+1)-X(I)))/(X(I+1)-X(I-1))
      IF(I.EQ.NM)GO TO 1000
         GM=(2.+(X(I+2)-X(I+1))/(X(I+1)-X(I)))/(X(I+2)-X(I))
         DE=(X(I+1)-X(I))/(X(I+2)-X(I+1))/(X(I+2)-X(I))
         P=AL*Q(I-1)+BE+GM
         Q(I)=-DE/P
         Z(I)=(Y(I)*(AL+BE)+Y(I+1)*(GM+DE)-AL*Z(I-1))/P
 1000 CONTINUE
      P=AL*Q(N-2)+BE+2./(X(N)-X(N-1))
      Z(N-1)=(Y(N-1)*(AL+BE)+Y(N)*2./(X(N)-X(N-1))-SLN/2.-AL*Z(N-2))/P
      NZ=N-2
      DO 1010 I=1,NZ
         IR=NM-I
         Z(IR)=Q(IR)*Z(IR+1)+Z(IR)
 1010 CONTINUE
      GO TO 1030
C
C   FOR N=2
C
 1020 Z(1)=(Y(2)+Y(1))/2.+(SL1-SLN)*(X(2)-X(1))/8.
 1030 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RFIN4(LFIN4, AA)
C
C***  READ FINSET4 INPUTS
C
C  WRITTEN BY S. STOY, MCDONNELL DOUGLAS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION AA(399),NLNAME(6),IVNAME(113),LEN(23),IDIM(23),LOC(23)
C
      LOGICAL LFIN4,IEOF
C
      DATA NLNAME /  'F   ','I   ','N   ','S   ','E   ','T   '/
      DATA IVNAME /  'S   ','E   ','C   ','T   ','Y   ','P   ','S   ',
     1 'S   ','P   ','A   ','N   ','L   ','M   ','A   ','X   ','U   ',
     2 'L   ','F   ','L   ','A   ','T   ','U   ','L   ','M   ','A   ',
     3 'X   ','L   ','L   ','F   ','L   ','A   ','T   ','L   ','C   ',
     4 'H   ','O   ','R   ','D   ','Z   ','U   ','P   ','P   ','E   ',
     5 'R   ','Z   ','L   ','O   ','W   ','E   ','R   ','S   ','W   ',
     6 'E   ','E   ','P   ','S   ','T   ','A   ','X   ','L   ','E   ',
     7 'N   ','P   ','A   ','N   ','E   ','L   ','X   ','C   ','O   ',
     8 'R   ','D   ','M   ','E   ','A   ','N   ','T   ','H   ','I   ',
     9 'C   ','K   ','Y   ','U   ','P   ','P   ','E   ','R   ','Y   ',
     A 'L   ','O   ','W   ','E   ','R   ','F   ','I   ','N   ','P   ',
     B 'H   ','I   ','L   ','E   ','R   ','G   ','A   ','M   ','P   ',
     C 'H   ','I   ','F   ','C   ','F   ','O   ','C   '/
      DATA IDIM   / 1,10,10,10,10,10,10,10,10,10,10,10,1,50,50,50,50,
     1              50,1,10,8,8,10 /
      DATA LEN    / 6,5,5,6,5,6,5,6,6,5,3,3,6,5,4,5,6,6,6,3,3,4,4 /
      DATA LOC    / 1,2,12,22,32,42,52,62,72,82,92,102,112,113,163,213,
     1              263,313,363,364,374,382,390 /
C
      LFIN4=.TRUE.
C
      CALL NAMER(KAND,2,NLNAME,6,IVNAME,113,LEN,23,IDIM,AA,399,LOC,
     1 IEOF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SUPBOD(IM)
C
C***  TOP LEVEL EXECUTIVE FOR BODY ALONE AT SUPERSONIC SPEEDS
C
C  MODIFIED BY W. BLAKE, WL/FIGC
C
C***  IM IS THE CURRENT MACH NUMBER INDEX
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     &                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
C
      COMMON /TOTALC/ BALPHA(20),BBETA(20),BPHI(20),ALPTOT(20)
C
      COMMON /REFQN/ SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,
     1                RHR
C
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     &                TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,POWER,
     &                DISCON(20),ELLDAT(103),DEXIT,BASE,BETAN,
     &                JMACH(20),PRAT(20),TRAT(20),PROTUB,ADUM(581)
C
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     &  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     &  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     &  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     &                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,GDUM(12)
C
      COMMON /SBODY/ CNB(20),CMB(20),CAB(20),CYB(20),CLNB(20),CLLB(20),
     &               CNAB(20),CMAB(20),CYBB(20),CNBB(20),CLBB(20)
C
      COMMON /BDWORK/  CNP(20),CMP(20),CNVIS(20),CMVIS(20),CAPR(20),
     &                 CAF(20),CABASE(20),ETA,CDC(20),CAPROT(20),
     &                 BOTDCA(20),BOTDCN(20),BOTDCM(20)
C
      COMMON /PARTF/ PART(19)
      LOGICAL PART
C
      COMMON /FSET1/ FIN1(399)
      COMMON /FSET2/ FIN2(399)
      COMMON /FSET3/ FIN3(399)
      COMMON /FSET4/ FIN4(399)
C
      REAL NALPHA,NMACH,MACH
      REAL LREF,LATREF
      REAL NX,LNOSE,LCENTR,LAFT
      REAL LTOTAL
      REAL FIN(4,399),JMACH
C
      LOGICAL TRUNC,BASE,NA,NM,ND,PROTUB
      LOGICAL IWARN1,IWARN2,IWARN3,IWARN4,IWARN5,
     &        IWARN6,IWARN7,IWARN8,IWARN9,IWAR10,
     &        IWAR11,IWAR12,IWAR13,IWAR14,IWARN
C
      DIMENSION PHIFIN(8)
      DIMENSION CPBASE(20),CABAS(20),PBASE(20),TBASE(20),
     &          XSEP(8),THSEP(8),SEPX(20,8),SEPTH(20,8)
      DIMENSION CAOPI(11),CAOM(11)
C
C***  CAO FOR BLUNT NOSED BODIES, FROM HOERNER
C***  REFERENCE AFFDL-TR-76-55, MARCH 1979, P. 84
C
      DATA CAOM / 0.,.6,.8,1.,1.2,1.4,1.6,1.8,2.2,2.6,3.0/
      DATA CAOPI/ .86,.86,.96,1.21,1.39,1.53,1.62,4*1.68/
C
C***  SET UP FIN ARRAY
      DO 20 I=1,4
        DO 10 J=1,399
          IF (I.EQ.1) FIN(I,J)=FIN1(J)
          IF (I.EQ.2) FIN(I,J)=FIN2(J)
          IF (I.EQ.3) FIN(I,J)=FIN3(J)
          IF (I.EQ.4) FIN(I,J)=FIN4(J)
 10     CONTINUE
 20   CONTINUE
C
C***  INITIALIZE WARNING FLAGS
      IWARN1=.FALSE.
      IWARN2=.FALSE.
      IWARN3=.FALSE.
      IWARN4=.FALSE.
      IWARN5=.FALSE.
      IWARN6=.FALSE.
      IWARN7=.FALSE.
      IWARN8=.FALSE.
      IWARN9=.FALSE.
      IWAR10=.FALSE.
      IWAR11=.FALSE.
      IWAR12=.FALSE.
      IWAR13=.FALSE.
      IWAR14=.FALSE.
      IWARN=.FALSE.
C
C***  CROSS FLOW DRAG PROPORTIONALITY FACTOR IS UNITY
C
      ETA=1.
C
C***  OBTAIN THE POTENTIAL AERODYNAMIC CHARACTERISTICS
C
      CALL SUPPOT(IM,CAP,CNALP,CMALP,CAAA)
C
      CALL CAFRIC(0.,MACH(IM),REN(IM),LTOTAL,ROUGH,BLAYER,SWET,SREF,
     1            1.1547,1.022,CAFO)
C
C*** PROTUBERANCE DRAG CALCULATION AT ZERO AOA
      CPRTZ=0.0
      IF (PROTUB) THEN
        IF (PART(6)) THEN
          CALL HEADR9
          WRITE(6,1230)
          CALL PRFLC9(IM,NA,NM,ND)
        ENDIF
        CALL CDPROT(MACH(IM),REN(IM),SREF,CPRTZ)
      END IF
C
C***  ANGLE OF ATTACK LOOP
C
      ALPLAS=0.
      NALP=NALPHA+0.5
      DFWD=DCENTR
      IF(LCENTR .LE. UNUSED)DFWD=DNOSE
C
C***  SET AXIAL LOCATION AT START OF BOATTAIL
      XB=LNOSE+LCENTR
C
C***     FIN LOCATIONS NEAR THE BASE
      NFIN=0
      DO 40 ISET=1,4
        IF ((FIN(ISET,102)+FIN(ISET,52)).GT.XB) THEN
          NFIN=INT(FIN(ISET,112)+0.5)
          DO 30 IFIN=1,NFIN
            PHIFIN(IFIN)=FIN(ISET,381+IFIN)
 30       CONTINUE
        END IF
 40   CONTINUE
C
      IF (BASE.AND.PART(6)) THEN
C
C***    OUTPUT HEADER
      CALL HEADR9
        WRITE(6,1000)
        CALL PRFLC9(IM,NA,NM,ND)
      END IF
C
      IAOA1=20
      IAOA2=0
      IERR=0
C
C***     BASE DRAG AT ZERO ANGLE OF ATTACK
C
         CALL BDCAB(DFWD,DBASE,DEXIT,LAFT,SREF,MACH(IM),CABASZ)
C
      DO 70 I=1,NALP
C
C***     FRICTION DRAG AT ANGLE OF ATTACK
C
C  REV 3/99  EXTRANEOUS FRICTION DRAG CALCULATION DELETED
C        CALL CAFRIC(ALPTOT(I),MACH(IM),REN(IM),LTOTAL,ROUGH,
C    1               BLAYER,SWET,SREF,1.1547,1.022,CAF(I))
C
C***     INVISCID CN AND CM
C
         CALL BDCNP(CNALP,ALPTOT(I),CNP(I))
         CALL BDCMP(CMALP,ALPTOT(I),CMP(I))
C
C***     VISCOUS CROSS FLOW DRAG COEFFICIENT
C
         CALL CDCS(ABS(ALPTOT(I)),REN(IM),DMAX,MACH(IM),CDC(I))
C
C***     VISCOUS NORMAL FORCE AND PITCHING MOMENT
C
         CALL BDCNV(ALPTOT(I),CDC(I),ETA,SPLAN,SREF,CNVIS(I))
         CALL BDCMV(ALPTOT(I),CDC(I),ETA,SPLAN,XCG-XO,XCENTP,SREF,
     1              LREF,CMVIS(I))
C
C***     BOATTAIL-JET PLUME INTERACTION, FLOW SEPARATION EFFECTS 
C
         BOTDCM(I)=0.0
         BOTDCN(I)=0.0
         BOTDCA(I)=0.0
C
C***     DETERMINE IF BASPRS IS TO BE USED
         IF (BASE) THEN
C
C***     CHECK VALIDITY OF INPUT CONDITIONS
         IF (IERR.EQ.1) GOTO 60
         IF (MACH(IM).LT.2.0) THEN
           IWARN1=.TRUE.
           IWARN=.TRUE.
         END IF
         IF (MACH(IM).GT.5.0) THEN
           IWARN2=.TRUE.
           IWARN=.TRUE.
         END IF
         IF (ALPTOT(I).LT.0.0) THEN
           IWARN3=.TRUE.
           IWARN=.TRUE.
         END IF
         IF (ALPTOT(I).GT.8.0) THEN
           IWARN4=.TRUE.
           IWARN=.TRUE.
         END IF
         IF ((PRAT(IM).LT.0.).OR.(PRAT(IM).GT.10.)) THEN
           IWARN5=.TRUE.
           IWARN=.TRUE.
         END IF
         IF ((TRAT(IM).LT.4.).OR.(TRAT(IM).GT.10.)) THEN
           IWARN6=.TRUE.
           IWARN=.TRUE.
         END IF
         IF (JMACH(IM).LT.(MACH(IM)-1.)) THEN
           IWARN7=.TRUE.
           IWARN=.TRUE.
         END IF
         IF (JMACH(IM).GT.(MACH(IM)+1.)) THEN
           IWARN8=.TRUE.
           IWARN=.TRUE.
         END IF
         IF (BETAN.LT.5.) THEN
           IWARN9=.TRUE.
           IWARN=.TRUE.
         END IF
         IF (BETAN.GT.25.) THEN
           IWAR10=.TRUE.
           IWARN=.TRUE.
         END IF
         IF (LAFT/DFWD.GT.2.0) THEN
           IWAR11=.TRUE.
           IWARN=.TRUE.
         END IF
         IF (LAFT.LE.UNUSED) THEN
           IF (ATAN((DFWD-DAFT)/LAFT)*RAD.GT.12.0) THEN
             IWAR12=.TRUE.
             IWARN=.TRUE.
           END IF
         END IF           
         IF (DAFT.GE.DFWD) THEN
           IF (PART(6)) WRITE(6,1130)
           IERR=1
           GOTO 60
         END IF
         IF (DEXIT.LE.UNUSED) THEN
           IF (PART(6)) WRITE(6,1140)
           IERR=1
           GOTO 60
         END IF
C
C***     DETERMINE BOATTAIL SHAPE OR CYLINDER SHAPE
         IF (LAFT.LE.UNUSED) THEN
           ISHAPE=1
           BASDIA=DFWD
         ELSE
           ISHAPE=INT(TAFT+2.5)
           BASDIA=DAFT
         END IF
         IF (DEXIT/BASDIA.LT.0.8) THEN
           IWAR13=.TRUE.
           IWARN=.TRUE.
         END IF
         IF (DEXIT/BASDIA.GT.0.95) THEN
           IWAR14=.TRUE.
           IWARN=.TRUE.
         END IF
         IF ((ISHAPE.NE.1).AND.(ISHAPE.NE.2).AND.(ISHAPE.NE.3)) THEN
           IF (PART(6)) WRITE(6,1210)
           IERR=1
           GOTO 60
         END IF
C
         IF (I.LT.IAOA1) IAOA1=I
         IF (I.GT.IAOA2) IAOA2=I
         CALL BASPRS(ISHAPE,XO,LAFT,DFWD,BASDIA,DEXIT,PRAT(IM),
     &        MACH(IM),JMACH(IM),BETAN,TRAT(IM),ALPTOT(I),XB,REN(IM),
     &        NFIN,PHIFIN,CPBASE(I),CABAS(I),PBASE(I),TBASE(I),
     &        XSEP,THSEP,BOTDCN(I),BOTDCM(I),BOTDCA(I))
C
         DO 50 IFIN=1,NFIN
           SEPX(I,IFIN)=XSEP(IFIN)
           SEPTH(I,IFIN)=THSEP(IFIN)
 50      CONTINUE
         END IF
C
 60      CONTINUE
C
C***     TOTAL FORCES AND MOMENT
C
C  REV 1/96  AXIAL FORCE SUMMATION MODIFIED FOR HIGH AOA
C
         ABSALP=ABS(ALPTOT(I))
         CAF(I)=CAFO*COS(ALPTOT(I)/RAD)*ABS(COS(ALPTOT(I)/RAD))
         CABASE(I)=CABASZ*COS(ALPTOT(I)/RAD)
         CAPROT(I)=CPRTZ*COS(ALPTOT(I)/RAD)*ABS(COS(ALPTOT(I)/RAD))
         CAPR(I)=CAP+CAAA*SIN(ALPTOT(I)/RAD)**2
C
C***  HIGH ANGLE OF ATTACK CORRECTION TO REMOVE PREDICTION DISCONTINUITY
C
         CAPR(I)=CAPR(I)*SQRT(ABS(COS(ALPTOT(I)/RAD)))
         CAB(I)=CAPR(I)+CAF(I)+BOTDCA(I)+CAPROT(I)
         IF(DEXIT .NE. UNUSED)CAB(I)=CAB(I)+CABASE(I)
C
C***  FOR ALPHAS GREATER THAN 90 DEGREES USE JORGENSEN
C***  BUT USE CAO FROM BLUNT-NOSED BODY DATA
C     
C  REV 1/96  CODE ADDED FOR FORWARD FACING BASE IF ABS(AOA) > 90
C***  ESTIMATE CAO AT ALPHA=180 DEGREES
C
         CALL LNTRP(CAOM,CAOPI,11,MACH(IM),CAPI)
         CAPI=CAPI*PI*DMAX**2/4./SREF
C
         IF(ABSALP.GE.90.) CAB(I)=CAPI*COS(ALPTOT(I)/RAD)*
     1                                 ABS(COS(ALPTOT(I)/RAD))
C   
C  REV 1/96   ALPHA > 90 AXIAL FORCE CHARGED TO BASE DRAG
C
         IF(ABSALP.GE.90.) CABASE(I)=CAB(I)-CAF(I)-CAPR(I)-
     1                               CAPROT(I)-BOTDCA(I)
C
         CNB(I)=(CNP(I)+CNVIS(I)+BOTDCN(I))*COS(BPHI(I)/RAD)
         CYB(I)=-(CNP(I)+CNVIS(I))*SIN(BPHI(I)/RAD)
         CMB(I)=(CMP(I)+CMVIS(I)+BOTDCM(I))*COS(BPHI(I)/RAD)
         CLNB(I)=-(CMP(I)+CMVIS(I))*SIN(BPHI(I)/RAD)*LREF/LATREF
C
 70   CONTINUE
C
      IF ((BASE).AND.(IERR.NE.1).AND.PART(6)) THEN
C***  OUTPUT BOATTAIL-JET PLUME INTERACTION FLOW PARAMETERS
C
C     WRITE WARNING MESSAGES
      IF (IWARN) WRITE(6,1220)
      IF (IWARN1) WRITE(6,1090)
      IF (IWARN2) WRITE(6,1100)
      IF (IWARN3) WRITE(6,1110)
      IF (IWARN4) WRITE(6,1120)
      IF (IWARN5) WRITE(6,1150)
      IF (IWARN6) WRITE(6,1160)
      IF (IWARN7) WRITE(6,1170)
      IF (IWARN8) WRITE(6,1180)
      IF (IWARN9) WRITE(6,1190)
      IF (IWAR10) WRITE(6,1200)
      IF (IWAR11) WRITE(6,1240)
      IF (IWAR12) WRITE(6,1250)
      IF (IWAR13) WRITE(6,1260)
      IF (IWAR14) WRITE(6,1270)
C
      WRITE(6,1010)
      DO 80 I=IAOA1,IAOA2
        WRITE(6,1020) ALPTOT(I),CPBASE(I),CABAS(I),TBASE(I),PBASE(I),
     &                BOTDCN(I),BOTDCM(I),BOTDCA(I)
 80   CONTINUE
C
C***  OUTPUT SEPARATION PARAMETER DATA IF NECESSARY
      IF (NFIN .GT. 0) THEN
      CALL HEADR9
        WRITE(6,1000)
        CALL PRFLC9(IM,NA,NM,ND)
        WRITE(6,1030)
      IF (NFIN .EQ. 1) THEN
        WRITE(6,1040) (IFIN,PHIFIN(IFIN),IFIN=1,1)
        DO 90 I=IAOA1,IAOA2
          WRITE(6,1050) ALPTOT(I),SEPX(I,1),SEPTH(I,1)
 90     CONTINUE
      ELSEIF (NFIN .EQ. 2) THEN
        WRITE(6,1060) (IFIN,PHIFIN(IFIN),IFIN=1,2)
        DO 100 I=IAOA1,IAOA2
          WRITE(6,1050) ALPTOT(I),(SEPX(I,IFIN),SEPTH(I,IFIN),IFIN=1,2)
 100    CONTINUE
      ELSEIF (NFIN .EQ. 3) THEN
        WRITE(6,1070) (IFIN,PHIFIN(IFIN),IFIN=1,3)
        DO 110 I=IAOA1,IAOA2
          WRITE(6,1050) ALPTOT(I),(SEPX(I,IFIN),SEPTH(I,IFIN),IFIN=1,3)
 110    CONTINUE
      ELSEIF (NFIN .EQ. 4) THEN
        WRITE(6,1080) (IFIN,PHIFIN(IFIN),IFIN=1,4)
        DO 120 I=IAOA1,IAOA2
          WRITE(6,1050) ALPTOT(I),(SEPX(I,IFIN),SEPTH(I,IFIN),IFIN=1,4)
 120    CONTINUE
      ELSEIF (NFIN .EQ. 5) THEN
        WRITE(6,1080) (IFIN,PHIFIN(IFIN),IFIN=1,4)
        DO 130 I=IAOA1,IAOA2
          WRITE(6,1050) ALPTOT(I),(SEPX(I,IFIN),SEPTH(I,IFIN),IFIN=1,4)
 130    CONTINUE
        WRITE(6,1040) (IFIN,PHIFIN(IFIN),IFIN=5,5)
        DO 140 I=IAOA1,IAOA2
          WRITE(6,1050) ALPTOT(I),SEPX(I,5),SEPTH(I,5)
 140    CONTINUE
      ELSEIF (NFIN .EQ. 6) THEN
        WRITE(6,1080) (IFIN,PHIFIN(IFIN),IFIN=1,4)
        DO 150 I=IAOA1,IAOA2
          WRITE(6,1050) ALPTOT(I),(SEPX(I,IFIN),SEPTH(I,IFIN),IFIN=1,4)
 150    CONTINUE
        WRITE(6,1060) (IFIN,PHIFIN(IFIN),IFIN=5,6)
        DO 160 I=IAOA1,IAOA2
          WRITE(6,1050) ALPTOT(I),(SEPX(I,IFIN),SEPTH(I,IFIN),IFIN=5,6)
 160    CONTINUE
      ELSEIF (NFIN .EQ. 7) THEN
        WRITE(6,1080) (IFIN,PHIFIN(IFIN),IFIN=1,4)
        DO 170 I=IAOA1,IAOA2
          WRITE(6,1050) ALPTOT(I),(SEPX(I,IFIN),SEPTH(I,IFIN),IFIN=1,4)
 170    CONTINUE
        WRITE(6,1070) (IFIN,PHIFIN(IFIN),IFIN=5,7)
        DO 180 I=IAOA1,IAOA2
          WRITE(6,1050) ALPTOT(I),(SEPX(I,IFIN),SEPTH(I,IFIN),IFIN=5,7)
 180    CONTINUE
      ELSE
        WRITE(6,1080) (IFIN,PHIFIN(IFIN),IFIN=1,4)
        DO 190 I=IAOA1,IAOA2
          WRITE(6,1050) ALPTOT(I),(SEPX(I,IFIN),SEPTH(I,IFIN),IFIN=1,4)
 190    CONTINUE
        WRITE(6,1080) (IFIN,PHIFIN(IFIN),IFIN=5,8)
        DO 200 I=IAOA1,IAOA2
          WRITE(6,1050) ALPTOT(I),(SEPX(I,IFIN),SEPTH(I,IFIN),IFIN=5,8)
 200    CONTINUE
C
      END IF
      END IF
      END IF
C
C***  FORMAT STATEMENTS
 1000 FORMAT(33X,'BASE-JET PLUME INTERACTION FLOW PARAMETERS',//)
 1010 FORMAT(//,15X,'----- BASE FLOW PARAMETERS -----',4X,
     &       '---- INCREMENTAL  DATA ----',/
     &       5X,'ALPHA',5X,'CP-BASE',2X,'CA-BASE',2X,'TB/TINF',2X,
     &       'PB/PINF',4X,'DEL CN',3X,'DEL CM',3X,'DEL CA',/)      
 1020 FORMAT(4X,F6.2,2X,4(F9.4),2X,3(F9.4))
 1030 FORMAT(10X,'--------- BOATTAIL SEPARATION PARAMETERS ',
     &              '---------')
 1040 FORMAT(/,12X,1('PANEL',I2,' PHI=',F5.1,4X),/,13X,1('X-SEP',2X,
     &       'MACH CONE',5X),/,' ALPHA',8X,1('(FT)',4X,'ANGLE',8X),/) 
 1050 FORMAT(F6.2,4(5X,F7.3,2X,F7.3))
 1060 FORMAT(/,12X,2('PANEL',I2,' PHI=',F5.1,4X),/,13X,2('X-SEP',2X,
     &       'MACH CONE',5X),/,' ALPHA',8X,2('(FT)',4X,'ANGLE',8X),/) 
 1070 FORMAT(/,12X,3('PANEL',I2,' PHI=',F5.1,4X),/,13X,3('X-SEP',2X,
     &       'MACH CONE',5X),/,' ALPHA',8X,3('(FT)',4X,'ANGLE',8X),/) 
 1080 FORMAT(/,12X,4('PANEL',I2,' PHI=',F5.1,4X),/,13X,4('X-SEP',2X,
     &       'MACH CONE',5X),/,' ALPHA',8X,4('(FT)',4X,'ANGLE',8X),/)
 1090 FORMAT(10X,'* FREESTREAM MACH NUMBER LESS THAN 2.0')
 1100 FORMAT(10X,'* FREESTREAM MACH NUMBER GREATER THAN 5.0')
 1110 FORMAT(10X,'* ANGLE OF ATTACK LESS THAN 0.0')
 1120 FORMAT(10X,'* ANGLE OF ATTACK GREATER THAN 8.0')
 1130 FORMAT(//,10X,'BASE-JET PLUME INTERACTION CANNOT BE CALCULATED',
     &       /,10X,'AFT BODY IS A FLARE')
 1140 FORMAT(//,10X,'BASE-JET PLUME INTERACTION CANNOT BE CALCULATED',
     &       /,10X,'JET EXIT DIAMETER IS NOT SPECIFIED')
 1150 FORMAT(10X,'* STATIC JET TO FREESTREAM PRESSURE RATIO OUTSIDE',
     &           ' THE 0 TO 10 RANGE')
 1160 FORMAT(10X,'* STAGNATION JET TO FREESTREAM TEMPERATURE RATIO',
     &       ' OUTSIDE THE 4 TO 10 RANGE')
 1170 FORMAT(10X,'* JET MACH NUMBER LESS THAN THE FREESTREAM',
     &           ' MACH NUMBER - 1.0') 
 1180 FORMAT(10X,'* JET MACH NUMBER GREATER THAN THE FREESTREAM',
     &           ' MACH NUMBER + 1.0')
 1190 FORMAT(10X,'* JET NOZZLE EXIT ANGLE LESS THAN 5.0')
 1200 FORMAT(10X,'* JET NOZZLE EXIT ANGLE GREATER THAN 25.0')
 1210 FORMAT(//,10X,'BASE-JET PLUME INTERACTION CANNOT BE CALCULATED',
     &       /,10X,'AFT BODY IS NOT CYLINDRICAL, CONICAL, OR',
     &      ' A TANGENT OGIVE')
 1220 FORMAT(/,10X,'WARNING EXTRAPOLATION WILL BE REQUIRED FOR THE ',
     &       'FOLLOWING CONDITIONS:',/) 
 1230 FORMAT(18X,'PROTUBERANCE OUTPUT',/)
 1240 FORMAT(10X,'* BOATTAIL FINENESS RATIO GREATER THAN 2.0')
 1250 FORMAT(10X,'* BOATTAIL TERMINAL ANGLE GREATER THAN 12.0')
 1260 FORMAT(10X,'* NOZZLE EXIT TO BASE DIAMETER RATIO ',
     &              'LESS THAN 0.8')
 1270 FORMAT(10X,'* NOZZLE EXIT TO BASE DIAMETER RATIO ',
     &              'GREATER THAN 0.95')
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WRITNL
C
C***  WRITE OUT NAMELISTS
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      IF(LFLT)CALL WRFLT
      IF(LREFQ)CALL WRREFQ
      IF(LAXIS)CALL WRAXIS
      IF(LFIN1)CALL WRFIN1
      IF(LFIN2)CALL WRFIN2
      IF(LFIN3)CALL WRFIN3
      IF(LFIN4)CALL WRFIN4
      IF(LDEFL)CALL WRDEFL
      IF(LTRIM)CALL WRTRIM
      IF(LELLB)CALL WELLB
      IF(LINLET)CALL WINLET
      IF(LARBOD)CALL WARBOD
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCAP1(DCENTR,DAFT,LAFT,MACH,LTHEO,CAPBT)
C
C***  THIS SUBROUTINE DETERMINES THE SUBSONIC-TRANSONIC PRESSURE
C***  DRAG COEFFICIENT (WITHOUT FRICTION) OF AXISYMMETRIC CONICAL
C***  BODIES USING THE METHOD OF PAYNE-DTNSRDC/ASED-80/10
C***  MAY,1980.  PAGE REFS 17-22.
C
C***  INPUTS
C
C***   DCENTR -- FORWARD BOATTAIL DIAMETER
C***     DAFT -- AFT BOATTAIL DIAMETER
C***     LAFT -- LENGTH OF BOATTAIL
C***     MACH -- FREESTREAM MACH NUMBER
C***    LTHEO -- THEORETICAL LENGTH OF BOATTAIL
C
C***  OUTPUT
C
C***    CAPBT -- PRESSURE DRAG COEFFICIENT INCREMENT TO AXIAL
C***             FORCE BASED ON MAXIMUM CROSS-SECTIONAL DIAMETER
C
      REAL MACH,LAFT,LTHEO
      DIMENSION TBMACH(7),BETATB(9), TABALL(693),DBODM2(11)
      DIMENSION TAB060(99),TAB080(99),TAB090(99),TAB100(99),
     *          TAB110(99),TAB120(99),TAB130(99)
      EQUIVALENCE (TAB060(1),TABALL(1)),(TAB080(1),TABALL(100)),
     *            (TAB090(1),TABALL(199)),(TAB100(1),TABALL(298)),
     *            (TAB110(1),TABALL(397)),(TAB120(1),TABALL(496)),
     *            (TAB130(1),TABALL(595))
      DATA TBMACH/.6,.8,.9,1.,1.1,1.2,1.3/
      DATA BETATB/0.,2.,4.,6.,8.,10.,12.,14.,16./
      DATA DBODM2/0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
      DATA TAB060/
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,
     *  .00580,  .00673,  .00839,  .00931,  .01057,  .00991,  .00959,
     *  .00814,  .00666,  .00400,  .00000,
     *  .01169,  .01458,  .01701,  .01793,  .01880,  .01891,  .01824,
     *  .01558,  .01253,  .00795,  .00000,
     *  .01799,  .02046,  .02288,  .02499,  .02623,  .02597,  .02569,
     *  .02224,  .01764,  .00988,  .00000,
     *  .02581,  .02750,  .02880,  .03205,  .03411,  .03500,  .03393,
     *  .03008,  .02430,  .01381,  .00000,
     *  .02739,  .02872,  .03272,  .03716,  .04038,  .04168,  .04100,
     *  .03715,  .02861,  .01618,  .00000,
     *  .02692,  .03027,  .03480,  .04014,  .04586,  .04842,  .04814,
     *  .04353,  .03367,  .01832,  .00000,
     *  .02693,  .03147,  .03759,  .04455,  .05106,  .05558,  .05452,
     *  .04911,  .03728,  .02069,  .00000,
     *  .02851,  .03344,  .03958,  .04891,  .05701,  .06235,  .06292,
     *  .05665,  .04244,  .02352,  .00000
     * /
      DATA TAB080/
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,
     *  .00752,  .00651,  .00754,  .00810,  .00830,  .00768,  .00752,
     *  .00773,  .00632,  .00459,  .00000,
     *  .01263,  .01323,  .01344,  .01403,  .01502,  .01604,  .01620,
     *  .01601,  .01304,  .00854,  .00000,
     *  .01580,  .02113,  .02411,  .02466,  .02568,  .02586,  .02567,
     *  .02433,  .02054,  .01329,  .00000,
     *  .02683,  .02940,  .03198,  .03375,  .03513,  .03574,  .03474,
     *  .03302,  .02802,  .01680,  .00000,
     *  .02882,  .03494,  .04144,  .04519,  .04738,  .04877,  .04700,
     *  .04325,  .03316,  .02078,  .00000,
     *  .03074,  .04102,  .04975,  .05650,  .06050,  .06143,  .05884,
     *  .05317,  .04039,  .02498,  .00000,
     *  .03188,  .04606,  .05791,  .06699,  .07257,  .07389,  .07054,
     *  .06249,  .04781,  .02847,  .00000,
     *  .03384,  .05269,  .06769,  .07793,  .08586,  .08795,  .08418,
     *  .07342,  .05559,  .03356,  .00000
     * /
      DATA TAB090/
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,
     *  .00358,  .00532,  .00624,  .00758,  .00849,  .00897,  .00865,
     *  .00831,  .00591,  .00308,  .00000,
     *  .00691,  .01113,  .01290,  .01548,  .01723,  .01855,  .01824,
     *  .01748,  .01424,  .00849,  .00000,
     *  .01025,  .01574,  .02080,  .02631,  .03013,  .03353,  .03404,
     *  .03204,  .02546,  .01433,  .00000,
     *  .03188,  .03903,  .04537,  .05003,  .05344,  .05682,  .05485,
     *  .04828,  .03628,  .02140,  .00000,
     *  .05393,  .06399,  .07157,  .07666,  .07840,  .07431,  .06774,
     *  .05743,  .04295,  .02387,  .00000,
     *  .07697,  .08763,  .09340,  .09672,  .09794,  .09173,  .08024,
     *  .06542,  .04690,  .02550,  .00000,
     *  .09835,  .10492,  .10989,  .11319,  .11235,  .10368,  .08888,
     *  .07035,  .04978,  .02510,  .00000,
     *  .12140,  .12342,  .12469,  .12510,  .12302,  .11398,  .09547,
     *  .07447,  .05019,  .02674,  .00000
     * /
      DATA TAB100/
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,
     *  .03112,  .02643,  .02292,  .02058,  .01904,  .01789,  .01713,
     *  .01519,  .01365,  .00778,  .00000,
     *  .06375,  .05317,  .04690,  .04300,  .04027,  .04030,  .03876,
     *  .03603,  .03134,  .02036,  .00000,
     *  .10150,  .08973,  .08425,  .08153,  .07880,  .07726,  .07257,
     *  .06591,  .05532,  .03176,  .00000,
     *  .13924,  .12865,  .12239,  .11888,  .11812,  .11500,  .10441,
     *  .08636,  .06358,  .04119,  .00000,
     *  .16873,  .16404,  .15974,  .15466,  .14761,  .13859,  .12329,
     *  .09697,  .06673,  .03334,  .00000,
     *  .19730,  .19494,  .19139,  .18470,  .17446,  .15674,  .12956,
     *  .09806,  .06695,  .03229,  .00000,
     *  .22723,  .22565,  .22093,  .21108,  .19336,  .17131,  .13862,
     *  .10121,  .06695,  .03190,  .00000,
     *  .25558,  .25558,  .24731,  .23392,  .21226,  .18273,  .14335,
     *  .10239,  .06734,  .03347,  .00000
     * /
      DATA TAB110/
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,
     *  .03475,  .03357,  .03122,  .02759,  .02522,  .02120,  .01800,
     *  .01479,  .01076,  .00631,  .00000,
     *  .07266,  .06904,  .06419,  .05893,  .05324,  .04633,  .04066,
     *  .03291,  .02438,  .01374,  .00000,
     *  .10647,  .10282,  .09962,  .09439,  .08706,  .07891,  .06869,
     *  .05559,  .04046,  .02281,  .00000,
     *  .14563,  .13913,  .13261,  .12489,  .11592,  .10572,  .09343,
     *  .07744,  .05694,  .03433,  .00000,
     *  .17861,  .17251,  .16601,  .15542,  .14560,  .13211,  .11692,
     *  .09437,  .06930,  .04091,  .00000,
     *  .21635,  .20812,  .19823,  .18674,  .17516,  .15747,  .13761,
     *  .10868,  .07929,  .04288,  .00000,
     *  .25075,  .24213,  .23266,  .21910,  .20545,  .18361,  .15875,
     *  .12321,  .08802,  .04537,  .00000,
     *  .28641,  .27571,  .26457,  .24978,  .23653,  .21097,  .18030,
     *  .13647,  .09629,  .05037,  .00000
     * /
      DATA TAB120/
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,
     *  .03324,  .02862,  .02521,  .02300,  .02041,  .01782,  .01603,
     *  .01423,  .01081,  .00620,  .00000,
     *  .06560,  .05936,  .05352,  .04727,  .04387,  .04047,  .03584,
     *  .03122,  .02417,  .01429,  .00000,
     *  .09756,  .09253,  .08588,  .08084,  .07299,  .06595,  .05970,
     *  .05103,  .04075,  .02319,  .00000,
     *  .13396,  .12651,  .11905,  .11159,  .10374,  .09426,  .08356,
     *  .07045,  .05288,  .03047,  .00000,
     *  .16470,  .15524,  .14777,  .13991,  .13246,  .12137,  .10460,
     *  .08421,  .06016,  .03450,  .00000,
     *  .19324,  .18777,  .18108,  .17238,  .16125,  .14649,  .12568,
     *  .09842,  .06832,  .03581,  .00000,
     *  .22391,  .21924,  .21215,  .20425,  .19232,  .17071,  .14182,
     *  .10931,  .07518,  .03824,  .00000,
     *  .25336,  .24950,  .24403,  .23531,  .22339,  .19491,  .15836,
     *  .12021,  .08164,  .04026,  .00000
     * /
      DATA TAB130/
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,
     *  .03230,  .02679,  .02416,  .02154,  .01770,  .01465,  .01286,
     *  .01107,  .00927,  .00499,  .00000,
     *  .06443,  .05892,  .05383,  .04915,  .04323,  .03649,  .03141,
     *  .02674,  .02122,  .01282,  .00000,
     *  .09247,  .08943,  .08352,  .07594,  .06798,  .06040,  .05325,
     *  .04446,  .03564,  .02190,  .00000,
     *  .12955,  .12241,  .11238,  .10438,  .09683,  .08679,  .07716,
     *  .06423,  .04842,  .02642,  .00000,
     *  .15925,  .15084,  .14205,  .13364,  .12445,  .11399,  .09941,
     *  .07991,  .05790,  .03015,  .00000,
     *  .18592,  .17802,  .16933,  .16182,  .15107,  .13907,  .11597,
     *  .09002,  .06486,  .03192,  .00000,
     *  .21385,  .20759,  .19890,  .19015,  .17941,  .16165,  .13157,
     *  .09947,  .06854,  .03397,  .00000,
     *  .24014,  .23471,  .22560,  .21645,  .20241,  .18218,  .14638,
     *  .10891,  .07389,  .03561,  .00000
     * /
C
      CAPBT = 0.
C
C***  USE MACH = 0.6 DATA FOR MACH .LT. 0.6
C
      AMACH = MACH
      IF(MACH.LT.0.6) AMACH = 0.6
C
      IF((LTHEO.EQ.0.).OR.(DCENTR.EQ.0.)) GO TO 1000
      IF(DCENTR.LT.DAFT) GO TO 1000
C
C***  CALCULATE BETA
C
      BETA = (ATAN(DCENTR/(LTHEO*2.)))*(45./(ATAN(1.)))
C
C***  SQUARE OF THE DIAMETER RATIO
C
      RDCTDA = (DAFT/DCENTR)**2
C
C***  INTERPOLATE
C
      CALL MVLOOK(7,9,11,693,TBMACH,BETATB,DBODM2,TABALL,
     *            RDCTDA,BETA,AMACH,CAPBT)
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CAFRIC(ALPHA,MACH,REN,LTOTAL,ROUGH,BLAYER,SWET,
     1 SREF,LAM3D,TUR3D,CAF)
C
C***  SUBROUTINE TO COMPUTE THE FRICTION COMPONENT OF AXIAL FORCE
C***  AT ANGLE OF ATTACK
C
C***  INPUTS
C
C  ALPHA -- ANGLE OF ATTACK, DEGREES
C   MACH -- MACH NUMBER
C    REN -- REYNOLDS NUMBER PER FOOT OF LENGTH (FREESTREAM)
C LTOTAL -- CHARACTERISTIC LENGTH
C  ROUGH -- SURFACE ROUGHNESS HEIGHT, INCHES
C BLAYER -- BOUNDARY LAYER TYPE
C           0.=TURBULENT, 1.=MIXED LAMINAR/TURBULENT
C   SWET -- WETTED SURFACE AREA, FEET SQUARED
C   SREF -- REFERENCE AREA, FEET SQUARED
C  LAM3D -- 3-DIMENSIONAL CORRECTION FACTOR FOR LAMINAR FLOW
C  TUR3D -- 3-DIMENSIONAL CORRECTION FACTOR FOR TURBULENT FLOW
C
C***  OUTPUT
C
C    CAF -- AXIAL FORCE CONTRIBUTION DUE TO FRICTION
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL MACH,LTOTAL,LAM3D
C
C***    SET CROSS FLOW MACH NUMBER AND REYNOLDS NUMBER
C
C  REV 1/96 UPDATE   USE ABS(COS(ALP)) INSTEAD OF COS(ABS(ALP))
C
        AMACHC=MACH*ABS(COS(ALPHA/RAD))
        RENC=REN*ABS(COS(ALPHA/RAD))
C
C     * IF THE AXIAL FLOW MACH NUMBER OR REYNOLDS NUMBER IS NOT ZERO
           IF(AMACHC .NE. 0. .AND. RENC .NE. 0.)GO TO 1000
           GO TO 1010
C       THEN COMPUTE THE SKIN FRICTION COEFFICIENT
 1000      CALL SKINF(AMACHC,RENC,LTOTAL,ROUGH,BLAYER,SWET,SREF,1.,
     1       LAM3D,TUR3D,CAF)
           GO TO 1020
C       ELSE SET IT TO ZERO
 1010      CAF=0.0
 1020      CONTINUE
C     * ENDIF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CPDIST(SALP,CALP,LAMDA,GAMMA,DELTA,CP,CPP)
C
C  COMPUTE THE PRESSURES AROUND THE BODY
C  USE EQUATION 28 OF DEJARNETTE
C  REFERENCE - DEJARNETTE (AIAA J. SPACECRAFT, NOV-DEC 1980, P.529)
C
C  INPUTS
C
C   SALP -- SINE OF THE ANGLE OF ATTACK
C   CALP -- COSINE OF THE ANGLE OF ATTACK
C  LAMDA -- D (P)/D(ALPHA)  AT PHI=ALPHA=0
C  GAMMA -- D2(P)/D(ALPHA)2 AT PHI=ALPHA=0
C  DELTA -- D2(P)/D(ALPHA)2 AT PHI=90. DEG, ALPHA=0
C     CP -- PRESSURE COEFFICIENT AT ZERO ANGLE OF ATTACK
C
C  OUTPUTS
C
C    CPP -- ARRAY OF PRESSURES ABOUT THE BODY AT THIS STATION
C
C  SUBROUTINES CALLED -- NONE
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL LAMDA
      DIMENSION CPP(7)
      DO 1000 K=1,7
         XK=7-K
         PHI=XK*PI/6.0
         CPH=COS(PHI)
         CP2=CPH**2
         T1=LAMDA*CPH*SALP*CALP*2.0
         T2=(GAMMA*CP2+DELTA*(1.0-CP2))
         CPP(K)=CP+T1+T2*SALP**2/2.0
 1000 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION DXCENP(NPTS,X,R)
C
C**  FUNCTION TO COMPUTE THE PLANFORM AREA CENTROID
C
C***  INPUTS
C
C  NPTS -- NUMBER OF INPUT POINTS
C     X -- X STATIONS
C     R -- RADII AT EACH X STATION
C
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION X(NPTS),R(NPTS)
C
      DXCENP=0.0
      SPTOT=0.0
      DO 1000 I=2,NPTS
         DX=X(I)-X(I-1)
         DELSP=DX*(R(I)+R(I-1))
         SPTOT=SPTOT+DELSP
         IF(R(I).GE.R(I-1))DXCP=X(I)-DX/3.*(2.*R(I-1)+R(I))/
     1     (R(I)+R(I-1))
         IF(R(I).LT.R(I-1))DXCP=X(I-1)+DX/3.*(2.*R(I)+R(I-1))/
     1     (R(I)+R(I-1))
         DXCENP=DXCENP+DXCP*DELSP
 1000 CONTINUE
      DXCENP=DXCENP/SPTOT
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FIG60B(BETA, BTANA, CNAA)
C ***
C *** INTERPOLATE DATCOM FIGURE 4.1.3.3-60B FOR FIN CNAA
C ***
C *** REFERENCE   DATCOM SECTION 4.1.3.3
C ***
C *** LIMITATIONS   SUPERSONIC FIN LEADING EDGE
C ***               ATTACHED SHOCK
C ***               STRAIGHT TAPERED FINS
C ***
C *** INPUT   BETA    MACH SIMILARITY PARAMETER, SQRT(MACH**2-1.0)
C ***         BTANA   BETA*TAN(ALPHA), ALPHA = ANGLE OF ATTACK
C ***
C *** OUTPUT  CNAA    CN PER SIN(ALPHA)**2,REFERENCED TO EXPOSED
C ***                 PLANFORM AREA OF TWO PANELS
C ***
C ***
      DIMENSION XA(13), YA(9), Z60B(117), BTA(13)
C ***
C *** CONSTANT DATA
C ***
      COMMON /CONST/PI,RAD,UNUSED,KAND
      DATA DUM / 1.0 /
C ***
C *** FIGURE 4.1.3.3-60B
C ***
      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. /
C
C ***
C *** CONSTRUCT CURVE OF CNAA VS BETA*TAN(ALPHA) AT INPUT BETA
C ***           XA   - CNAA CURVE
C ***           YA   - BETA CURVE
C ***           Z60B - BETA*TAN(ALPHA) VS CNAA AND BETA
C ***
      BTA(1) = 0.0
      DO 10 I=2,13
        CALL MVLOOK(1, 9, 13, 117, DUM, YA, XA, Z60B,
     *              XA(I), BETA, 1.0, BTA(I))
   10 CONTINUE
C ***
C *** LOOK-UP FOR CNAA
C ***
      BTAN = BTANA
      IF(BTAN .GT. BTA(13)) BTAN = BTA(13)
      CALL LNTRP(BTA, XA, 13, BTAN, CNAA)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE GETNLN(LOC,LEN,NC,NLNAME,NN,KOUNT,NAMORD,KOL,GO)
C
C***  SUBROUTINE TO READ NAMELIST CARDS AND DETERMINE TYPE
C
      COMMON /LOGIC/  LFLAG(28)
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C
      CHARACTER*4 NUM,IBLANK,KOL,KAND,NLNAME
C
      DIMENSION LOC(NC),LEN(NC),NLNAME(NN),NAMORD(300),KOL(80)
      DIMENSION NUM(10)
      LOGICAL GO,LFLAG
      DATA NUM/'1   ','2   ','3   ','4   ','5   ','6   ','7   ',
     1 '8   ','9   ','0   '/
      DATA IBLANK / '    ' /
C
C***  IF COLUMN 2 IS NOT KAND, IS CONTINUATION CARD
C
      IF(KOL(2).NE.KAND)GO TO 1080
C
C***  DECODE NAME
C
      DO 1010 I=1,NC
         JUMP=I
         LADD=LOC(I)
         LADDM1=LADD-1
         LLEN=LEN(I)
            DO 1000 J=1,LLEN
               JJ=J+LADDM1
               IF(KOL(J+2).NE.NLNAME(JJ))GO TO 1010
 1000       CONTINUE
C
C***  NAME FOUND
C
         GO TO 1040
C
 1010 CONTINUE
C
C***  NAME NOT FOUND
C
C
C***  CHECK IF REST OF CARD BLANK
C
      DO 1020 I=3,80
         IF(KOL(I).NE.IBLANK)GO TO 1030
 1020 CONTINUE
      GO TO 1040
C
C***  ERROR
C
 1030 CONTINUE
      GO=.FALSE.
      GO TO 1080
C
C***  NAME FOUND, SAVE SEQUENCE NUMBER
C
 1040 CONTINUE
C
C***  JUMP = 1 IS FOR $END, IGNORE
C
      IF(JUMP.EQ.1)GO TO 1080
      IF(JUMP.NE.5)GO TO 1070
C
C***  HERE FOR NAMELIST FINSET(N)
C
C***  DECODE VALUE FOR N AND ADD TO SEQUENCE
C
      DO 1050 I=1,10
          INUM=I
          IF(KOL(LLEN+3).EQ.NUM(I))GO TO 1060
 1050 CONTINUE
C
C***  ERROR
C
      GO TO 1030
 1060 JUMP=JUMP+100*INUM
C
C***  BLANK OUT FINSET NUMBER FOR NAMELIST READ
C
      IF(INUM.LE.4)KOL(LLEN+3)=IBLANK
 1070 CONTINUE
C
C***  SUBTRACT 1 TO ACCOUNT FOR FIRST NAMELIST NAME TESTED IS INVALID
C
      KOUNT=KOUNT+1
      NAMORD(KOUNT)=JUMP-1
 1080 CONTINUE
      IF(JUMP .EQ. 10)LFLAG(25)=.TRUE.
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE INZFLC
C
C***  INITIALIZE ALL FLIGHT CONDITIONS
C
C***  FLIGHT CONDITION INPUTS
C
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      REAL NALPHA,NMACH,MACH
C
      COMMON /TOTALC/ BALPHA(20),BBETA(20),BPHI(20),ALPTOT(20)
C
C***  INTERNAL COMPUTATION VALUES (CONFIGURATION INCREMENTING)
C
      COMMON /INC/ COREC(128),ZIP,ALP1(20),NAP
C
C***  PROGRAM CONSTANTS
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C
      NALPHA=UNUSED
      NAP=UNUSED
      BETA=UNUSED
      PHI=UNUSED
      NMACH=UNUSED
      DO 1000 I=1,20
         ALT(I)=UNUSED
         ALPHA(I)=UNUSED
         MACH(I)=UNUSED
         REN(I)=UNUSED
         VINF(I)=UNUSED
         TINF(I)=UNUSED
         PINF(I)=UNUSED
         BALPHA(I)=UNUSED
         BBETA(I)=UNUSED
         BPHI(I)=UNUSED
         ALPTOT(I)=UNUSED
         ALP1(I)=UNUSED
 1000 CONTINUE
C
C     SET INCREMENTING CONSTANTS TO UNUSED
C
      ZIP=0.
C
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PLATE(WH,CDPL)
C ****  2-D DRAG ON FLATE PLATE AS A FUNCTION OF W/H FIG.3.28  ****
C **              ( DATA FOR FLAT PLATE SUBROUTINE)              **
      REAL XARRAY(11),YARRAY(11)
      DATA (YARRAY(I), I=1,11) /1.98,1.79,1.6,1.46,1.36,1.31,1.24,
     * 1.2,1.18,1.18,1.18/
      DATA (XARRAY(I), I=1,11) /0.0,.02,.04,.06,.08,.1,.15,.2,.3,
     * .5,1.0/
      DATA NDIM,NAVAL,NXARR,NXVAL,IEXTRP /1,11,11,11,9/
      X=WH
      CALL TABLOK(NDIM,NAVAL,NXARR,NXVAL,XARRAY,YARRAY,X,Y,IEXTRP,
     * IERR)
      CDPL=Y
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RFINS(NSET,LFIN1,LFIN2,LFIN3,LFIN4,
     1                 FIN1,FIN2,FIN3,FIN4)
C
C***  FIN INPUTS
C
      DIMENSION FIN1(389),FIN2(389),FIN3(389),FIN4(389)
C
      LOGICAL LFIN1,LFIN2,LFIN3,LFIN4
C
      GO TO (1000, 1010, 1020, 1030), NSET
C
 1000 CALL RFIN1(LFIN1,FIN1)
      GO TO 1040
C
 1010 CALL RFIN2(LFIN2,FIN2)
      GO TO 1040
C
 1020 CALL RFIN3(LFIN3,FIN3)
      GO TO 1040
C
 1030 CALL RFIN4(LFIN4,FIN4)
C
 1040 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SUPPOT(IM,CAP,CNALP,CMALP,CAAA)
C
C***  SUBROUTINE TO COMPUTE THE POTENTIAL AERODYNAMIC CHARACTERISTICS
C***  OF BODIES AT SUPERSONIC SPEEDS (WAVE DRAG, CN AND CM)
C***  BASED ON THE USER SPECIFIED SREF, LREF AND XCG
C
C***  INPUT
C
C     IM -- MACH NUMBER INDEX
C
C***  OUTPUTS
C
C    CAP -- PRESSURE/WAVE AXIAL FORCE INCREMENT
C  CNALP -- NORMAL FORCE SLOPE, PER RADIAN
C  CMALP -- PITCHING MOMENT SLOPE, PER RADIAN
C   CAAA -- SECOND DERIVATIVE OF AXIAL FORCE WITH RESPECT TO
C           ANGLE OF ATTACK, PER RADIAN SQUARED
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /THERY/  LSOSE,PRESUR,LHYBRD,LHYPER
      COMMON /PARTF/ PARTS(19)
      LOGICAL LSOSE,PRESUR,LHYBRD,LHYPER,PARTS
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      REAL NALPHA,NMACH,MACH
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
C
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     1  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     2  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     3  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     4                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,GDUM(12)
C
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     1                TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,
     2                POWER,DISCON(20),ELLIP(50),H(50),
     3                ENOSE,ECENTR,EAFT,DEXIT,ADUM(644)
C
      REAL NX,LNOSE,LCENTR,LAFT
      LOGICAL TRUNC,LHYB
C
      DIMENSION XX(50),RR(50),NNN(20),IROUT(2)
      DATA ZERO/ 0.0 /
      DATA ONE / 1.0 /
C
      NNX=NX+0.5
C
      CAAA=0.
      CAAAT=0.
      CAPT=0.
      CAT=0.
      CAWT=0.
      CMWT=0.
      CNWT=0.
      XCPT=0.
C
      IPRINT=0
      IF(PARTS(1).OR.PRESUR.OR.LPLOT) IPRINT=2
      IF(IPRINT.EQ.2) WRITE(9,1150)
C
      IF(LHYPER)GO TO 1050
C
C***  CHANGE BODY COORDINATES TO CALIBERS
C
      II=0
      III=0
      NSTART=1
C
C ... FOR SPHERICALLY BLUNTED NOSES, START AT POINT 6
C
      IF(BNOSE .GT. UNUSED .AND. .NOT.TRUNC)NSTART=6

      DO 1000 I=NSTART,50
         IF(I .LE. NNX)II=II+1
         III=III+1
         IF(I .LE. NNX)XX(II)=(X(I)-XO)/DMAX
         IF(I .LE. NNX)RR(II)=R(I)/DMAX
         IF(I .GT. NNX)XX(III)=UNUSED
         IF(I .GT. NNX)RR(III)=UNUSED
 1000 CONTINUE
      IF(XX(1) .LT. 0.)XX(1)=0.
      NNX=II
C
C***  TYPE OF BODY SHAPE
C
      NBLUNT=0
      IF(R(1) .LE. UNUSED)R(1)=0.
      IF(BNOSE .GT. UNUSED .AND. TRUNC)NBLUNT=2
      IF(BNOSE .GT. UNUSED .AND. .NOT.TRUNC)NBLUNT=1
C
      II=0
      NSEG=1
      NNN(1)=NNX
      DO 1005 J=2,20
         NNN(J)=0
 1005 CONTINUE
      IF(DISCON(1) .EQ. NX .OR. DISCON(1) .LE. UNUSED)GO TO 1020
C
C***  SET NUMBER OF POINTS BETWEEN DISCONTINUOUS POINTS
C
      II=1
      NNN(II)=DISCON(1)+0.5
      IF(TRUNC) NNN(II)=DISCON(2)-DISCON(1)+1.5
      IF(NBLUNT.EQ.1) NNN(II)=NNN(II)-(NSTART-1)
      IDS=2
      IF(TRUNC)IDS=3
      DO 1010 I=IDS,20
         IF(DISCON(I) .EQ. UNUSED .OR. DISCON(I) .EQ. 0)GO TO 1020
         II=II+1
         IF(II .GT. 19) II=19
         IF(II .LT. 19) NNN(II)=DISCON(I)-DISCON(I-1)
         IF(II .EQ. 19) NNN(19)=NNN(19)+DISCON(I)-DISCON(I-1)
 1010 CONTINUE
C
 1020 CONTINUE
C
      IF(II .GT. 1)NSEG=II
C
C***  USE SOSE IF USER REQUESTED
C
      IERROR=0
      IF(LSOSE)GO TO 1030
C
C***  OTHERWISE, USE THE HYBRID THEORY OF VAN DYKE
C
      LHYBRD=.TRUE.
      BNOSER=0.
      IF(BNOSE .GT. UNUSED)BNOSER=BNOSE/DMAX
C
      RNFTM=REN(IM)/MACH(IM)
C
      IF(BNOSE .GT. UNUSED)LHYBRD=.FALSE.
      IF(BNOSE .GT. UNUSED)GO TO 1030
C
      CALL HYBRID(IPRINT,XX,RR,FRNOSE,MACH(IM),RNFTM,ONE/RAD,DMAX,
     1 NBLUNT,BNOSER,NNX,CAW,CNW,CMW,IERROR)
C
C***  IF AN ERROR IN HYBRID THEORY IS NOTED, USE SOSE
C
      IF(IERROR .NE. 0)LHYBRD=.FALSE.
      IF(IERROR .NE. 0)GO TO 1030
C
C***  CORRECT DERIVATIVES TO PER RADIAN MEASURE
C
      CAAA=0.
      CAP=CAW
      CNALP=CNW*RAD
      CMALP=CMW*RAD
      XCP=CMALP/CNALP
C
      GO TO 1040
C
 1030 CALL SOSE(ZERO,MACH(IM),XX,RR,NNX,NNN,IPRINT,
     1 NBLUNT,NSEG,CAP,XCP,CNALP,CMALP,CAAA,DMAX)
C
 1040 CONTINUE
C
C***  REFERENCE DATA TO USER SPECIFIED SREF AND LREF
C
      CAP=CAP*(PI*DMAX*DMAX/4.)/SREF
      CNALP=CNALP*(PI*DMAX*DMAX/4.)/SREF
      CMALP=CMALP*(PI*DMAX*DMAX*DMAX/4.)/(SREF*LREF)
      CAAA=CAAA*(PI*DMAX*DMAX/4.)/SREF
C
C***  REFERENCE CM TO XCG
C
      CMALP=CMALP+CNALP*(XCG-XO)/LREF
      GO TO 1060
C
C***  HYPERSONIC FLOW THEORY
C
 1050 CALL HYPERS(ONE,MACH(IM),X,R,NNX,SREF,LREF,XCG-XO,IPRINT,
     1 CAP,CNALP,CMALP)
      CNALP=CNALP*RAD
      CMALP=CMALP*RAD
C
 1060 IF((.NOT. PRESUR) .AND. (.NOT. LPLOT))GO TO 1080
C
C***  DUMP PRESSURE DISTRIBUTIONS
C
      NALP=NALPHA+0.5
      IPRINT=1
      IERRR=0
      LHYB=.FALSE.
      IF(LHYBRD)LHYB=.TRUE.
      DO 1070 I=1,NALP
         IF(ALPHA(I) .LT. 0.)GO TO 1070
         IF(ALPHA(I) .GT. 15. .AND. .NOT. LHYPER)GO TO 1080
         WRITE(10,1100) MACH(IM),ALPHA(I)
         WRITE(12,1170) MACH(IM)
         IF(LHYPER)CALL HYPERS(ALPHA(I),MACH(IM),X,R,NNX,SREF,LREF,
     1             XCG-XO,IPRINT,CAT,CNALPT,CMALPT)
         IF(LHYPER)GO TO 1070
C
         IF(.NOT. LHYB)
     1   CALL SOSE(ALPHA(I),MACH(IM),XX,RR,NNX,NNN,IPRINT,
     2          NBLUNT,NSEG,CAPT,XCPT,CNALPT,CMALPT,CAAAT,DMAX)
         IF(LHYB)
     1   CALL HYBRID(IPRINT,XX,RR,FRNOSE,MACH(IM),RNFTM,ALPHA(I)/RAD,
     2          DMAX,NBLUNT,BNOSER,NNX,CAWT,CNWT,CMWT,IERRR)
         IF(IERRR .NE. 0)LHYB=.FALSE.
 1070 CONTINUE
C
 1080 CONTINUE
 1100 FORMAT('ZONE T="BODY CP AT MACH=',F6.2,' ALPHA=',F6.2,'"')
 1150 FORMAT('ZONE T="BODY GEOMETRY IN FEET"')
 1170 FORMAT('ZONE T="BODY CP, MLOCAL AT MACH=',F6.2,' ALPHA= 0.0"')
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WRREFQ
C
C***  WRITE REFERENCE QUANTITY INPUTS
C
      COMMON /REFQN/ AA(9)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION NLNAME(4),IVNAME(39),LEN(9),IDIM(9),LOC(9)
C
      DATA NLNAME /  'R   ','E   ','F   ','Q   '/
      DATA IVNAME /  'S   ','R   ','E   ','F   ','L   ','R   ','E   ',
     1 'F   ','L   ','A   ','T   ','R   ','E   ','F   ','R   ','O   ',
     2 'U   ','G   ','H   ','X   ','C   ','G   ','Z   ','C   ','G   ',
     3 'S   ','C   ','A   ','L   ','E   ','B   ','L   ','A   ','Y   ',
     4 'E   ','R   ','R   ','H   ','R   '/
      DATA IDIM   / 1,1,1,1,1,1,1,1,1 /
      DATA LEN    / 4,4,6,5,3,3,5,6,3 /
      DATA LOC    / 1,2,3,4,5,6,7,8,9 /
C
      CALL NAMEW(KAND,6,NLNAME,4,IVNAME,39,LEN,9,IDIM,AA,9,LOC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCAP2(DCENTR,DAFT,LAFT,MACH,LTHEO,CAPBT)
C
C***  THIS SUBROUTINE DETERMINES THE SUBSONIC-TRANSONIC PRESSURE
C***  DRAG COEFFICIENT (WITHOUT FRICTION) OF AXISYMMETRIC OGIVAL
C***  BODIES USING THE METHOD OF PAYNE-DTNSRDC/ASED-80/10
C***  MAY,1980.  PAGE REFS 33-38.
C
C***  INPUTS
C
C***   DCENTR -- FORWARD BOATTAIL DIAMETER
C***     DAFT -- AFT BOATTAIL DIAMETER
C***     LAFT -- LENGTH OF BOATTAIL
C***     MACH -- FREESTREAM MACH NUMBER
C***    LTHEO -- THEORETICAL LENGTH OF BOATTAIL
C
C***  OUTPUT
C
C***    CAPBT -- PRESSURE DRAG INCREMENT TO AXIAL FORCE BASED ON
C***             MAXIMUM CROSS-SECTIONAL AREA
C
      REAL MACH,LAFT,LTHEO
      DIMENSION TBMACH(7),BETATB(9), TABALL(1323),DBODM2(21)
      DIMENSION TAB06A(105),TAB06B(84),TAB08A(105),TAB08B(84),
     *          TAB09A(105),TAB09B(84),TAB10A(105),TAB10B(84),
     *          TAB11A(105),TAB11B(84),TAB12A(105),TAB12B(84),
     *          TAB13A(105),TAB13B(84)
      DIMENSION TAB060(189),TAB080(189),TAB090(189),TAB100(189),
     *          TAB110(189),TAB120(189),TAB130(189)
      EQUIVALENCE (TAB06A(1),TAB060(1)),(TAB06B(1),TAB060(106)),
     *            (TAB08A(1),TAB080(1)),(TAB08B(1),TAB080(106)),
     *            (TAB09A(1),TAB090(1)),(TAB09B(1),TAB090(106)),
     *            (TAB10A(1),TAB100(1)),(TAB10B(1),TAB100(106)),
     *            (TAB11A(1),TAB110(1)),(TAB11B(1),TAB110(106)),
     *            (TAB12A(1),TAB120(1)),(TAB12B(1),TAB120(106)),
     *            (TAB13A(1),TAB130(1)),(TAB13B(1),TAB130(106))
      EQUIVALENCE (TAB060(1),TABALL(1)),(TAB080(1),TABALL(190)),
     *            (TAB090(1),TABALL(379)),(TAB100(1),TABALL(568)),
     *            (TAB110(1),TABALL(757)),(TAB120(1),TABALL(946)),
     *            (TAB130(1),TABALL(1135))
C
      DATA TBMACH/.6,.8,.9,1.,1.1,1.2,1.3/
      DATA BETATB/0.,2.,4.,6.,8.,12.,16.,20.,28./
      DATA DBODM2/0.,.05,.1,.15,.2,.25,.3,.35,.4,.45,.5,.55,.6,
     *            .65,.7,.75,.8,.85,.9,.95,1./
      DATA TAB06A /
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00184,  .00324,  .00464,  .00603,  .00661,  .00679,  .00696,
     *  .00715,  .00691,  .00710,  .00645,  .00623,  .00681,  .00700,
     *  .00677,  .00655,  .00671,  .00650,  .00627,  .00604,  .00000,
     *  .00468,  .00770,  .00910,  .01130,  .01268,  .01287,  .01386,
     *  .01405,  .01379,  .01440,  .01416,  .01392,  .01451,  .01429,
     *  .01446,  .01465,  .01441,  .01380,  .01316,  .00685,  .00000,
     *  .00873,  .01217,  .01437,  .01657,  .01837,  .01976,  .02077,
     *  .02053,  .02110,  .02129,  .02187,  .02122,  .02181,  .02200,
     *  .02258,  .02155,  .02171,  .01868,  .01519,  .00725,  .00000,
     *  .01239,  .01662,  .02086,  .02428,  .02648,  .02788,  .02967,
     *  .02946,  .03044,  .03062,  .03037,  .03015,  .03032,  .03010,
     *  .02988,  .02926,  .02738,  .02233,  .01560,  .00685,  .00000
     * /
      DATA TAB06B /
     *  .01156,  .01743,  .02329,  .02833,  .03296,  .03681,  .04063,
     *  .04324,  .04504,  .04604,  .04539,  .04435,  .04330,  .04147,
     *  .03759,  .03332,  .02821,  .02233,  .01560,  .00685,  .00000,
     *  .01390,  .01926,  .02503,  .03158,  .03693,  .04351,  .04968,
     *  .05423,  .05717,  .05852,  .05742,  .05554,  .05203,  .04774,
     *  .04222,  .03673,  .03039,  .02210,  .01577,  .00705,  .00000,
     *  .01228,  .01926,  .02543,  .03159,  .03895,  .04593,  .05249,
     *  .05906,  .06400,  .06816,  .06627,  .06196,  .05646,  .05016,
     *  .04384,  .03713,  .03080,  .02291,  .01617,  .00784,  .00000,
     *  .01270,  .01966,  .02624,  .03159,  .03895,  .04633,  .05251,
     *  .05988,  .06764,  .07542,  .07392,  .06802,  .06128,  .05417,
     *  .04625,  .03914,  .03242,  .02290,  .01536,  .00705,  .00000
     * /
      DATA TAB08A /
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00247,  .00013,  .00151,  .00411,  .00589,  .00684,  .00741,
     *  .00795,  .00767,  .00741,  .00713,  .00685,  .00657,  .00714,
     *  .00687,  .00701,  .00631,  .00604,  .00659,  .00426,  .00000,
     *  .00287,  .00547,  .00890,  .01109,  .01246,  .01384,  .01522,
     *  .01575,  .01589,  .01564,  .01536,  .01549,  .01480,  .01413,
     *  .01386,  .01440,  .01452,  .01590,  .01481,  .00837,  .00000,
     *  .00656,  .01163,  .01671,  .02013,  .02233,  .02370,  .02467,
     *  .02519,  .02534,  .02467,  .02523,  .02452,  .02548,  .02563,
     *  .02619,  .02673,  .02561,  .02412,  .01768,  .00838,  .00000,
     *  .00821,  .01328,  .01918,  .02343,  .02766,  .02986,  .03289,
     *  .03424,  .03438,  .03412,  .03427,  .03520,  .03616,  .03797,
     *  .03770,  .03659,  .03261,  .02740,  .01769,  .00837,  .00000
     * /
      DATA TAB08B /
     *  .00821,  .01493,  .02164,  .02712,  .03261,  .03644,  .04234,
     *  .04493,  .04795,  .04932,  .04988,  .04959,  .04931,  .04781,
     *  .04551,  .04152,  .03630,  .02699,  .01810,  .00836,  .00000,
     *  .00939,  .01773,  .02441,  .03112,  .03862,  .04409,  .04997,
     *  .05378,  .05801,  .06104,  .06322,  .06416,  .06185,  .05625,
     *  .04986,  .04301,  .03618,  .02814,  .01844,  .00874,  .00000,
     *  .01023,  .01608,  .02441,  .03194,  .03821,  .04571,  .05366,
     *  .05868,  .06621,  .07169,  .07388,  .07236,  .06840,  .06076,
     *  .05315,  .04506,  .03701,  .02813,  .01885,  .00875,  .00000,
     *  .00940,  .01732,  .02401,  .03152,  .03863,  .04572,  .05407,
     *  .06279,  .07154,  .08151,  .08207,  .07891,  .07168,  .06199,
     *  .05354,  .04505,  .03782,  .02812,  .01843,  .00874,  .00000
     * /
      DATA TAB09A /
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00041,  .00299,  .00555,  .00648,  .00783,  .00917,  .00932,
     *  .00945,  .00918,  .00931,  .00905,  .00919,  .00769,  .00786,
     *  .00800,  .00811,  .00783,  .00837,  .00729,  .00459,  .00000,
     *  .00405,  .00743,  .01040,  .01296,  .01470,  .01686,  .01821,
     *  .01917,  .01971,  .01943,  .01836,  .01810,  .01742,  .01675,
     *  .01567,  .01538,  .01634,  .01566,  .01457,  .01107,  .00000,
     *  .01255,  .01755,  .02134,  .02551,  .02605,  .02780,  .02793,
     *  .02849,  .02902,  .02834,  .02768,  .02741,  .02713,  .02687,
     *  .02824,  .02834,  .02968,  .02780,  .02226,  .01107,  .00000,
     *  .01621,  .02120,  .02498,  .02834,  .03090,  .03346,  .03522,
     *  .03657,  .03711,  .03684,  .03780,  .03751,  .03886,  .04184,
     *  .04482,  .04534,  .04143,  .03306,  .02266,  .01148,  .00000
     * /
      DATA TAB09B /
     *  .01943,  .02444,  .02821,  .03239,  .03615,  .04115,  .04371,
     *  .04871,  .05046,  .05383,  .05640,  .05776,  .05788,  .05762,
     *  .05412,  .04979,  .04223,  .03305,  .02307,  .01147,  .00000,
     *  .02300,  .02959,  .03534,  .04030,  .04606,  .05101,  .05556,
     *  .06134,  .06508,  .06964,  .07218,  .07271,  .07000,  .06448,
     *  .05694,  .05018,  .04223,  .03347,  .02270,  .01192,  .00000,
     *  .02422,  .03159,  .03817,  .04434,  .05049,  .05666,  .06444,
     *  .07101,  .07718,  .08293,  .08428,  .08198,  .07765,  .06972,
     *  .06097,  .05380,  .04344,  .03347,  .02270,  .01152,  .00000,
     *  .02582,  .03522,  .04260,  .05078,  .05856,  .06593,  .07535,
     *  .08312,  .08968,  .09626,  .09798,  .09246,  .08209,  .07133,
     *  .06176,  .05421,  .04303,  .03307,  .02270,  .01193,  .00000
     * /
      DATA TAB10A /
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00517,  .00650,  .00663,  .00796,  .00769,  .00784,  .00835,
     *  .00809,  .00822,  .00875,  .00847,  .00901,  .00956,  .00848,
     *  .00900,  .00914,  .00889,  .00821,  .00915,  .00730,  .00000,
     *  .01194,  .01407,  .01499,  .01672,  .01765,  .01740,  .01832,
     *  .01765,  .01897,  .01909,  .02002,  .02016,  .02108,  .01923,
     *  .02015,  .01989,  .01963,  .01816,  .01670,  .01207,  .00000,
     *  .01553,  .02042,  .02374,  .02627,  .02839,  .03012,  .03104,
     *  .03198,  .03250,  .03264,  .03235,  .03368,  .03423,  .03555,
     *  .03686,  .03700,  .03794,  .03648,  .03223,  .01962,  .00000,
     *  .02150,  .02600,  .03092,  .03622,  .03833,  .04326,  .04577,
     *  .04790,  .04802,  .04934,  .05105,  .05398,  .05731,  .06381,
     *  .06910,  .07083,  .06698,  .05678,  .03820,  .01923,  .00000
     * /
      DATA TAB10B /
     *  .03145,  .03794,  .04604,  .05374,  .05942,  .06635,  .07084,
     *  .07615,  .08145,  .08516,  .08807,  .09141,  .09313,  .09486,
     *  .09378,  .09033,  .07535,  .05679,  .03780,  .02003,  .00000,
     *  .04035,  .05085,  .06056,  .07149,  .08080,  .09133,  .09904,
     *  .10796,  .11446,  .11938,  .12350,  .12644,  .12458,  .11792,
     *  .10807,  .09384,  .07400,  .05536,  .03792,  .01929,  .00000,
     *  .05352,  .06763,  .07974,  .09346,  .10395,  .11648,  .12538,
     *  .13672,  .14282,  .14814,  .15104,  .14999,  .14017,  .12473,
     *  .11007,  .09303,  .07479,  .05577,  .03713,  .01888,  .00000,
     *  .08666,  .10278,  .11808,  .13300,  .14389,  .15681,  .16612,
     *  .17464,  .17795,  .17809,  .17344,  .16398,  .14934,  .13032,
     *  .11406,  .09542,  .07519,  .05656,  .03793,  .01889,  .00000
     * /
      DATA TAB11A /
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00895,  .00899,  .00983,  .00987,  .01031,  .01116,  .01119,
     *  .01122,  .01044,  .01007,  .01051,  .01055,  .01017,  .01021,
     *  .00902,  .00865,  .00868,  .00709,  .00712,  .00472,  .00000,
     *  .02075,  .02119,  .02203,  .02288,  .02332,  .02336,  .02502,
     *  .02424,  .02468,  .02431,  .02393,  .02397,  .02360,  .02241,
     *  .02163,  .02126,  .01925,  .01766,  .01485,  .01163,  .00000,
     *  .02766,  .03095,  .03424,  .03712,  .03918,  .04166,  .04210,
     *  .04132,  .03973,  .03936,  .03776,  .03861,  .03783,  .03827,
     *  .03831,  .03712,  .03593,  .03312,  .02909,  .02465,  .00000,
     *  .03783,  .04397,  .04929,  .05339,  .05790,  .06118,  .06366,
     *  .06166,  .05885,  .05563,  .05444,  .05610,  .05857,  .06309,
     *  .06841,  .07332,  .07457,  .07298,  .06732,  .04987,  .00000
     * /
      DATA TAB11B /
     *  .05776,  .06715,  .07695,  .08431,  .09126,  .09739,  .10027,
     *  .09949,  .09749,  .09590,  .09390,  .09475,  .09560,  .09807,
     *  .09973,  .09814,  .09532,  .08885,  .07668,  .05109,  .00000,
     *  .07703,  .09162,  .10459,  .11514,  .12527,  .13054,  .13297,
     *  .13297,  .13135,  .12973,  .12649,  .12446,  .12041,  .11676,
     *  .11189,  .10703,  .10014,  .09041,  .07622,  .04986,  .00000,
     *  .09649,  .11554,  .13135,  .14068,  .14919,  .15324,  .15608,
     *  .15527,  .15446,  .15203,  .14797,  .14351,  .13743,  .13054,
     *  .12203,  .11351,  .10500,  .09324,  .07581,  .05027,  .00000,
     *  .14311,  .15608,  .16824,  .17514,  .18081,  .18324,  .18284,
     *  .17959,  .17473,  .16946,  .16297,  .15568,  .14797,  .14027,
     *  .12851,  .11878,  .10703,  .09486,  .07622,  .05068,  .00000
     * /
      DATA TAB12A /
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00883,  .00892,  .00943,  .00912,  .00963,  .00933,  .00942,
     *  .00872,  .00961,  .00972,  .00862,  .00872,  .00882,  .00812,
     *  .00782,  .00792,  .00761,  .00691,  .00622,  .00553,  .00000,
     *  .02284,  .02255,  .02265,  .02275,  .02244,  .02214,  .02223,
     *  .02194,  .02244,  .02173,  .02145,  .02034,  .02043,  .02094,
     *  .01904,  .01792,  .01722,  .01653,  .01464,  .00993,  .00000,
     *  .03446,  .03537,  .03627,  .03597,  .03647,  .03736,  .03666,
     *  .03636,  .03645,  .03616,  .03506,  .03556,  .03485,  .03456,
     *  .03346,  .03276,  .03084,  .02935,  .02544,  .01714,  .00000,
     *  .04609,  .04818,  .05070,  .05199,  .05368,  .05379,  .05389,
     *  .05439,  .05369,  .05379,  .05509,  .05600,  .05689,  .05780,
     *  .05910,  .05960,  .05890,  .05298,  .03587,  .01674,  .00000
     * /
      DATA TAB12B /
     *  .06933,  .07583,  .08035,  .08484,  .08775,  .08985,  .09195,
     *  .09205,  .09255,  .09225,  .09115,  .09086,  .08814,  .08625,
     *  .08274,  .07723,  .07051,  .05579,  .03546,  .01675,  .00000,
     *  .08887,  .10322,  .11360,  .12120,  .12641,  .12965,  .13170,
     *  .13137,  .12906,  .12634,  .12205,  .11656,  .11068,  .10242,
     *  .09336,  .08430,  .07206,  .05548,  .03610,  .01753,  .00000,
     *  .10275,  .12384,  .13938,  .14897,  .15458,  .15821,  .15947,
     *  .15835,  .15563,  .15134,  .14466,  .13640,  .12734,  .11511,
     *  .10169,  .08668,  .07048,  .05547,  .03690,  .01793,  .00000,
     *  .13052,  .14962,  .16278,  .17118,  .17679,  .18043,  .18010,
     *  .17858,  .17468,  .16879,  .16133,  .15187,  .13963,  .12424,
     *  .10804,  .08986,  .07246,  .05547,  .03610,  .01753,  .00000
     * /
      DATA TAB13A /
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,  .00000,
     *  .00689,  .00701,  .00836,  .00804,  .00818,  .00829,  .00838,
     *  .00855,  .00864,  .00873,  .00846,  .00898,  .00872,  .00886,
     *  .00896,  .00947,  .00879,  .00849,  .00941,  .00829,  .00000,
     *  .01420,  .01436,  .01565,  .01537,  .01632,  .01644,  .01701,
     *  .01709,  .01761,  .01809,  .01863,  .01836,  .01891,  .01862,
     *  .01874,  .01802,  .01816,  .01827,  .01717,  .01319,  .00000,
     *  .02198,  .02333,  .02424,  .02557,  .02652,  .02786,  .02880,
     *  .02933,  .03069,  .03158,  .03169,  .03265,  .03278,  .03248,
     *  .03261,  .03272,  .03165,  .03170,  .02694,  .01360,  .00000,
     *  .03055,  .03269,  .03563,  .03821,  .04079,  .04211,  .04386,
     *  .04520,  .04572,  .04621,  .04715,  .04852,  .04950,  .05124,
     *  .05382,  .05513,  .05159,  .04152,  .02693,  .01401,  .00000
     * /
      DATA TAB13B /
     *  .04725,  .05551,  .06419,  .07123,  .07705,  .08286,  .08462,
     *  .08473,  .08405,  .08209,  .08060,  .07868,  .07598,  .07284,
     *  .06970,  .06410,  .05445,  .04110,  .02777,  .01402,  .00000,
     *  .06320,  .07879,  .09433,  .10706,  .11410,  .11908,  .12037,
     *  .11884,  .11736,  .11211,  .10691,  .10135,  .09333,  .08526,
     *  .07642,  .06675,  .05543,  .04249,  .02791,  .01457,  .00000,
     *  .07948,  .09833,  .11633,  .13028,  .13650,  .14189,  .14278,
     *  .14084,  .13771,  .13168,  .12484,  .11680,  .10676,  .09504,
     *  .08128,  .06836,  .05504,  .04125,  .02710,  .01417,  .00000,
     *  .10963,  .13053,  .14813,  .15715,  .16298,  .16633,  .16559,
     *  .16203,  .15852,  .15000,  .14113,  .13065,  .11939,  .10605,
     *  .08698,  .07322,  .05664,  .04167,  .02749,  .01375,  .00000
     * /
C
      CAPBT = 0.
C
C***  USE MACH = 0.6 DATA FOR MACH .LT. 0.6
C
      AMACH = MACH
      IF(MACH.LT.0.6) AMACH = 0.6
C
      IF(DCENTR.EQ.0.) GO TO 1000
      IF(DCENTR.LT.DAFT) GO TO 1000
C
C***  CALCULATE BETA (BODY SLOPE AT BASE)
C
      BETA = 0.
      IF(DCENTR.EQ.DAFT) GO TO 900
      BETA = (ATAN(LAFT/(SQRT(((LAFT**2+(DAFT**2+DCENTR**2)/4.
     *       -DAFT*DCENTR/2.)/(DCENTR-DAFT))**2-LAFT**2)))*
     *       (45./ATAN(1.)))
  900 CONTINUE
C
C***  SQUARE OF THE DIAMETER RATIO
C
      RDCTDA = (DAFT/DCENTR)**2
C
C***  INTERPOLATE
C
      CALL MVLOOK(7,9,21,1323,TBMACH,BETATB,DBODM2,TABALL,
     *            RDCTDA,BETA,AMACH,CAPBT)
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CAINC(ICASE,CAS,ICON,DUMMY)
C      
C     SUBROUTINE TO DETERMINE CA INCREMENTED TABLE AND INCREMENT CA
C      
C***  INPUT
C      
C     ICASE = CASE NUMBER OF A RUN
C     CAS   = ARRAY CONTAINING CA VALUES FROM SYNTHS
C     DUMMY = ARRAY THAT CONTAINS EXPERIMENTAL COEFFICIENTS AND WILL
C             CONTAIN UPDATED COEFFICIENTS CA = DUMMY 41 - 60
C     ICON  = CONFIGURATION TO BE ICREMENTED
C             ICON = 1     BODY ALONE
C             ICON = 2     BODY + 1 FIN SET
C             ICON = 3     BODY + 2 FIN SETS
C             ICON = 4     BODY + 3 FIN SETS
C             ICON = 5     BODY + 4 FIN SETS
C      
C***  OUTPUT
C      
C     CA = INCREMENTED CA VS. ALPHA ARRAY EQUIVALENT TO DUMMY 41 - 60
C      
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /FLC   / NA,ALPHA(20),FLDUM(123)
      COMMON /INC   / DUM(44),C(20),DIP(64),ZIP,ALP(20),NAP
      DIMENSION CA(20),CATH(20),CAEXP(20),DUMMY(120),CAS(20,5)
      REAL NA,NAP
C
C **  INITIALIZE WORKING ARRAYS
C      
      DO 1000 I=1,20
         CA(I)=UNUSED
         CATH(I)=UNUSED
         CAEXP(I)=UNUSED
 1000 CONTINUE
C      
      NAP1 = NAP + .5
      NALPHA= NA + .5
C      
C       DETERMINE WHICH CONFIGURATION IS TO BE INCREMENTED AND FILL
C         THE WORKING ARRAYS
C      
      DO 1010 I=1,NALPHA
         IF(ICON .EQ. 1)CATH(I) = CAS(I,5)
         IF(ICON .GT. 1)CATH(I) = CAS(I,ICON-1)
 1010 CONTINUE
      IF (ICASE .NE. 1)GO TO 1030
      IF (ZIP .EQ. 1.)GO TO 1030
C      
C       FILL CAEXP ARRAY WITH EXPERIMENTAL DATA BEING HELD IN
C            ARRAY DUMMY
C      
      DO 1020 I=1,NALPHA
         CAEXP(I) = DUMMY(I+40)
 1020 CONTINUE
C      
C       CALL CALIB TO GET A TABLE OF INCREMENTAL MULTIPLIERS
C      
      CALL CALIB(2,NALPHA,ALPHA,CAEXP,NALPHA,ALPHA,CATH,C)
 1030 CONTINUE
C      
C***  DETERMINE INCREMENTED CA VALUE USING INCREMENTALS IN ARRAY C
C       NEED TO INTERPOLATE FOR ALPHA OF INTEREST BECAUSE INCREMENTALS
C       WERE CALCULATED AT INITIAL CASE ALPHA'S
C      
      DO 1040 I=1,NALPHA
         CALL LNTRP(ALP,C,NAP1,ALPHA(I),CI)
         CA(I) = CI * CATH(I)
 1040 CONTINUE
C
C     PUT INCREMENTED CA INTO ARRAY DUMMY
C
      DO 1050 I=1,NALPHA
         DUMMY(I+40)=CA(I)
 1050 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CROSS(TRMACH,CD)
C
C*** SUBROUTINE TO RATIO FOR TRANSONIC EFFECT
C
C  WRITTEN BY K. DETERS, MCDONNELL DOUGLAS
C
      REAL XARRAY(20),YARRAY(20)
      DATA (YARRAY(I), I=1,20) /1.65,1.65,1.63,1.6,1.55,1.5,1.44,1.4,
     * 1.365,1.34,1.32,1.3,1.29,1.28,1.265,1.242,1.226,1.215,1.21,1.2/
      DATA (XARRAY(I), I=1,20) /1.,1.01,1.1,1.2,1.3,1.4,1.5,1.6,1.7,
     * 1.8,1.9,2.0,2.1,2.2,2.4,2.8,3.2,3.6,4.0,5.0/
      DATA NDIM,NAVAL,NXARR,NXVAL,IEXTRP /1,20,20,20,9/
      X=TRMACH
      CALL TABLOK(NDIM,NAVAL,NXARR,NXVAL,XARRAY,YARRAY,X,Y,IEXTRP,
     * IERR)
      CD=Y
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION DXCENV(NPTS,X,R)
C
C**  FUNCTION TO COMPUTE THE VOLUME CENTROID
C
C***  INPUTS
C
C  NPTS -- NUMBER OF INPUT POINTS
C     X -- X STATIONS
C     R -- RADII AT EACH X STATION
C
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION X(NPTS),R(NPTS)
C
      DXCENV=0.0
      VOLTOT=0.0
      DO 1000 I=2,NPTS
         DX=X(I)-X(I-1)
         DVOL=PI/3.*DX*(R(I-1)**2+R(I)**2+R(I)*R(I-1))
         VOLTOT=VOLTOT+DVOL
         IF(R(I).GE.R(I-1))DXCV=X(I)-DX/4.*(R(I)**2+2.*R(I)*R(I-1)
     1     +3.*R(I-1)**2)/(R(I)**2+R(I)*R(I-1)+R(I-1)**2)
         IF(R(I).LT.R(I-1))DXCV=X(I-1)+DX/4.*(R(I-1)**2+2.*R(I)*R(I-1)
     1     +3.*R(I)**2)/(R(I)**2+R(I)*R(I-1)+R(I-1)**2)
         DXCENV=DXCENV+DXCV*DVOL
 1000 CONTINUE
      DXCENV=DXCENV/VOLTOT
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FINCA(IM,NFIN)
C
C***  FIN ALONE AXIAL FORCE EXECUTIVE ROUTINE
C
      COMMON /GEOFS1/ GFIN1(188)
      COMMON /FSET1/  FDATA1(399)
      COMMON /F1WORK/ F1WK(290)
      COMMON /SFIN1/  CFIN1(220)
C
      COMMON /GEOFS2/ GFIN2(188)
      COMMON /FSET2/  FDATA2(399)
      COMMON /F2WORK/ F2WK(290)
      COMMON /SFIN2/  CFIN2(220)
C
      COMMON /GEOFS3/ GFIN3(188)
      COMMON /FSET3/  FDATA3(399)
      COMMON /F3WORK/ F3WK(290)
      COMMON /SFIN3/  CFIN3(220)
C
      COMMON /GEOFS4/ GFIN4(188)
      COMMON /FSET4/  FDATA4(399)
      COMMON /F4WORK/ F4WK(290)
      COMMON /SFIN4/  CFIN4(220)
C
C***  COMPUTE FINSET 1 AXIAL FORCE DATA
C
      IF(NFIN .EQ. 1)CALL FINXCA(1,IM,GFIN1,FDATA1,F1WK,CFIN1)
C
C***  COMPUTE FINSET 2 AXIAL FORCE DATA
C
      IF(NFIN .EQ. 2)CALL FINXCA(2,IM,GFIN2,FDATA2,F2WK,CFIN2)
C
C***  COMPUTE FINSET 3 AXIAL FORCE DATA
C
      IF(NFIN .EQ. 3)CALL FINXCA(3,IM,GFIN3,FDATA3,F3WK,CFIN3)
C
C***  COMPUTE FINSET 4 AXIAL FORCE DATA
C
      IF(NFIN .EQ. 4)CALL FINXCA(4,IM,GFIN4,FDATA4,F4WK,CFIN4)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HAACK(XO,TNOSE,DNOSE,BNOSE,TRUNC,LAC,
     &           DISCON,X,R,NX,AA)
C
C***  COMPUTE THE CHARACTERISTICS OF AN L-V HAACK
C***           OR VON KARMAN SEGMENT
C***  INPUTS
C
C        XO - LONGITUDINAL OFFSET OF NOSE TIP
C     TNOSE - NOSE TYPE: HAACK OR KARMAN
C     DNOSE - NOSE BASE DIAMETER
C     BNOSE - SPHERICAL NOSE BLUNTNESS RADIUS
C     TRUNC - TRUNCATED FLAG (.TRUE. IF TRUNCATED, NOT BLUNTED)
C       LAC - ACTUAL NOSE LENGTH (TIP TO BASE)
C
C***  OUTPUTS
C
C    DISCON - INDICES OF X STATIONS WHERE THE SURFACE
C             SLOPE IS DISCONTINUOUS
C         X - LONGITUDINAL LOCATIONS
C         R - RADIAL LOCATIONS AT EACH X STATION
C        NX - NUMBER OF X AND R POINTS
C        AA - ARRAY OF CHARACTERISTICS TO BE COMPUTED
C             AA(1)=PLANFORM AREA
C             AA(2)=WETTED AREA
C             AA(3)=VOLUME
C             AA(4)=VOLUME CENTROID
C             AA(5)=PLANFORM CENTROID
C             AA(6)=FINENESS RATIO
C             AA(7)=THEORITICAL LENGTH
C             AA(8)=THEORITICAL FINENESS RATIO
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND 
C
      DIMENSION AA(8),X(50),R(50),XX(101),RR(101),DISCON(20)
      REAL K,LTH,LAC,LCALC,NX
      LOGICAL TRUNC
C
C***  CONSTANTS
      NMAX=500
      LMAX=100
      EPS=0.001*BNOSE
      BR=0.5*DNOSE
C
C***  DECIDE IF NOSE TYPE IS L/V HAACK OR KARMAN
      K=0.0
      NTYPE=TNOSE+0.5
      IF (NTYPE.EQ.3) K=1./3.
C
C***  CHECK FOR VALIDITY OF USER INPUTS
      IF (BNOSE.GE.DNOSE/2.) THEN
        IF (TRUNC) THEN
          STOP 1234
        ELSE
C
C***  NOSE IS HEMISPHERICAL CAP
          BNOSE=DNOSE/2.
          LAC=BNOSE
          NX=0.0
          CALL SPHERE(AA,NX,X,R,DNOSE)
          GO TO 140
C***  END OF HEMISPHERICAL CAP CALCULATIONS
C
        ENDIF
      ELSEIF (BNOSE.GT.UNUSED) THEN
        IF (BNOSE.GT.LAC) BNOSE=LAC
      ENDIF
C
C***  CALCULATE GEOMETRY FOR TRUNCATED NOSES
      IF (TRUNC) THEN
      NPTS=101
C
C***  SET THEORETICAL LENGTH TO ACTUAL LENGTH
      LTH=LAC
C
C***  START OF ITERATION FOR THEORETICAL NOSE LENGTH
      ADD=0.0
      LOOP=0
      LCALC=LAC-EPS-1.
 10   IF (ABS(LAC-LCALC).GT.EPS) THEN
        LOOP=LOOP+1
C
C***    CHECK FOR MAXIMUM ITERATIONS
        IF (LOOP.GT.LMAX) THEN
          STOP 1234
        ENDIF
        LTH=LTH+ADD
C
C***    USE NEWTON-RAPHSON METHOD TO SOLVE FOR PHI
C***    MAKE INITIAL GUESS OF PHI
        PHI=ACOS(1.-2.*BNOSE/BR)
        DO 30 I=1,NMAX
          SPHI=SIN(PHI)
          CPHI=COS(PHI)
          S2PHI=SIN(2.*PHI)
          C2PHI=COS(2.*PHI)
          F=PHI-0.5*S2PHI+K*SPHI**3-PI*BNOSE**2/BR**2
          FPRIME=1.-C2PHI+3.*K*SPHI**2*CPHI
          PHINEW=PHI-F/FPRIME
          IF (ABS(PHINEW-PHI).LT.EPS) THEN
            X0=LTH*(1.-CPHI)/2.
            LCALC=LTH-X0
            ADD=LAC-LCALC
            GO TO 10
          ENDIF
          PHI=PHINEW
 30     CONTINUE
        STOP 1234
      ENDIF
C
C***  LONGITUDINAL AND RADIAL LOCATIONS ON HAACK SURFACE
      DO 40 I=1,NPTS
        XX(I)=X0+FLOAT(I-1)*(LTH-X0)/FLOAT(NPTS-1)
        IF (I.EQ.NPTS) THEN
          PHI=PI
        ELSE
          PHI=ACOS(1.-2.*XX(I)/LTH)
        ENDIF
        RR(I)=BR*SQRT((PHI-0.5*SIN(2.*PHI)+K*SIN(PHI)**3)/PI)
 40   CONTINUE
C
C***  SET DISCONTINUOUS POINT
C***  FIRST OF SEGMENT IS DISCONTINUOUS IF TRUNCATED
      DISCON(1)=1.0
      GO TO 110
      ENDIF
C***  END OF TRUNCATED NOSE CALCULATIONS
C
C***  CALCULATE GEOMETRY FOR SHARP NOSES
      IF (BNOSE.LE.UNUSED) THEN
C
C***  LONGITUDINAL AND RADIAL LOCATIONS ON HAACK SURFACE
      NPTS=101
      DO 50 I=1,NPTS
        XX(I)=FLOAT(I-1)*LAC/FLOAT(NPTS-1)
        IF (I.EQ.1) THEN
          PHI=0.0
        ELSEIF (I.EQ.NPTS) THEN
          PHI=PI
        ELSE
          PHI=ACOS(1.-2.*XX(I)/LAC)
        ENDIF
        RR(I)=BR*SQRT((PHI-0.5*SIN(2.*PHI)+K*SIN(PHI)**3)/PI)
 50   CONTINUE
      LTH=LAC
      X0=0.0
      GO TO 110
      ENDIF
C***  END OF SHARP NOSE CALCULATIONS
C
C***  CALCULATE GEOMETRY FOR BLUNTED NOSES
      NPTS=51
C
C***  SET THEORETICAL LENGTH TO ACTUAL LENGTH
      LTH=LAC
C
C***  START OF ITERATION FOR THEORETICAL NOSE LENGTH
      ADD=0.0
      LOOP=0
      LCALC=LAC-EPS-1.
  60  IF (ABS(LAC-LCALC).GT.EPS) THEN
        LOOP=LOOP+1
C
C***    CHECK FOR MAXIMUM ITERATIONS
        IF (LOOP.GT.LMAX) THEN
          STOP 1234
        ENDIF
        LTH=LTH+ADD
        FR=LTH/DNOSE
C
C***    USE NEWTON-RAPHSON METHOD TO SOLVE FOR PHI
C***    MAKE INITIAL GUESS OF PHI
        PHI=ACOS(1.-2.*BNOSE/BR)
        DO 80 I=1,NMAX
          SPHI=SIN(PHI)
          CPHI=COS(PHI)
          S2PHI=SIN(2.*PHI)
          C2PHI=COS(2.*PHI)
          F=PHI-0.5*S2PHI+SPHI**2/(PI*FR**2)
     &      *(1.+3.*K*CPHI+9.*K**2*CPHI**2/4.)
     &      +K*SPHI**3-PI*BNOSE**2/BR**2
          FPRIME=1.-C2PHI+S2PHI/(PI*FR**2)
     &      *(1.+3.*K*CPHI+9.*K**2*CPHI**2/4.)
     &      -SPHI**3/(PI*FR**2)*(3.*K+9.*K**2*CPHI/2.)
     &      +3.*K*SPHI**2*CPHI
          PHINEW=PHI-F/FPRIME
          IF (ABS(PHINEW-PHI).LT.EPS) THEN
            XT=LTH*(1.-CPHI)/2.
            YT=BR*SQRT((PHI-0.5*S2PHI+K*SPHI**3)/PI)
            DELTA=XT+SQRT(BNOSE**2-YT**2)
            X0=DELTA-BNOSE
            LCALC=LTH-X0
            ADD=LAC-LCALC
            GO TO 60
          ENDIF
          PHI=PHINEW
 80     CONTINUE
        STOP 1234
      ENDIF
C
C***  LONGITUDINAL AND RADIAL LOCATIONS ON SPHERICAL CAP
      DO 90 I=1,NPTS
        XX(I)=FLOAT(I-1)*(XT-X0)/FLOAT(NPTS-1)+X0
        IF (I.EQ.1) THEN
          RR(I)=0.0
        ELSE
          RR(I)=SQRT(BNOSE**2-(XX(I)-DELTA)**2)
        ENDIF
 90   CONTINUE
      ILAST=NPTS-1
C
C***  LONGITUDINAL AND RADIAL LOCATIONS ON HAACK SURFACE
      DO 100 I=1,NPTS
        J=I+ILAST
        XX(J)=XT+FLOAT(I-1)*(LTH-XT)/FLOAT(NPTS-1)
        IF ((1.-2.*XX(J)/LTH).LT.-1.0) THEN
          PHI=PI
        ELSE
          PHI=ACOS(1.-2.*XX(J)/LTH)
        ENDIF
        RR(J)=BR*SQRT((PHI-0.5*SIN(2.*PHI)+K*SIN(PHI)**3)/PI)
 100  CONTINUE
C
C***  END OF BLUNTED NOSE CALCULATIONS
C
C***  REMOVE X0 OFFSET (THEORETICAL LENGTH -ACTUAL LENGTH)
C***  AND ADD IN XO (USER SPECIFIED LONGITUDINAL OFFSET)
 110  DO 120 I=1,101
        XX(I)=XX(I)-X0+XO
 120  CONTINUE
C
C***  EXTRACT EVERY TENTH POINT FOR OUTPUT AND SUBSEQUENT CALCS
      J=0
      DO 130 I=1,101,10
        J=J+1
        X(J)=XX(I)
        R(J)=RR(I)
 130  CONTINUE
C
C***  UPDATE POINT TOTAL
      NX=FLOAT(J)
C
C***  PLANFORM AREA
      AA(1)=DSPLAN(101,XX,RR)
C
C***  WETTED AREA
      AA(2)=DSWET(101,XX,RR)
C
C***  VOLUME
      AA(3)=DVOL(101,XX,RR)
C
C***  VOLUME CENTROID
      AA(4)=DXCENV(101,XX,RR)
C
C***  PLANFORM AREA CENTROID
      AA(5)=DXCENP(101,XX,RR)
C
C***  FINENESS RATIO
      AA(6)=LAC/DNOSE
C
C***  THEORETICAL NOSE LENGTH
      AA(7)=LTH
C
C***  THEORETICAL FINENESS RATIO
      AA(8)=LTH/DNOSE
C
 140  RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE INZFLG(CASE,SAVE)
C
C***  INITIALIZE ALL PROGRAM FLAGS
C
C***  PROGRAM LOGIC FLAGS
C
      COMMON /LOGIC/  LFLAGS(28)
      COMMON /DFLAGS/ DFLGG(12)
      COMMON /DUMPF/  LDUMPF(37)
C
      LOGICAL DFLGG,LFLAGS,SAVE,LDUMPF
C
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),KASE,NOEXTR,NOLAT,
     1                IR,IPAGE
      LOGICAL NOEXTR,NOLAT
C
      COMMON /DESIG/  NNACA(80,4)
C
      COMMON /INC/ COREC(150)
C
C***  PROGRAM CONSTANTS
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C
      COMMON /THERY/  LSOSE,PRESUR,LHYBRD,LHYPER
C
      LOGICAL LSOSE,PRESUR,LHYBRD,LHYPER
C
      INTEGER CASE
      CHARACTER*4 IBLANK,IDCASE
C
      DATA IBLANK /'    '/
C
      DO 1000 I=1,28
C
C***  SKIP INITIALIZATION OF FLAGS 5,6,19,20,21,22 IF NOT FIRST CASE
C***  THESE ARE THE DERIVATIVE AND DIMENSION FLAGS, RESPECTIVELY
C***  ALSO, DO NOT RE-INITIALIZE FLAG 9 (PLOT CONTROL)
C
         IF(CASE .NE. 1 .AND. (I .EQ. 5 .OR. I .EQ. 6 .OR. I .EQ. 9
     1   .OR. I .EQ. 19 .OR. I .EQ. 20 .OR. I .EQ. 21 .OR. I .EQ. 22))
     2      GO TO 1000
C
C***  DO NOT RE-INITIALIZE FLAG 4 (NACA INPUTS) IF SAVE CASE
C
         IF(CASE .NE. 1 .AND. SAVE .AND. I .EQ. 4)GO TO 1000
C
C***  DO NOT RE-INITIALIZE FLAG 26 (INCREMENT CARD) UNLESS FIRST CASE
C
         IF(CASE .NE. 1 .AND. I .EQ. 26)GO TO 1000
C
         LFLAGS(I)=.FALSE.
C
 1000 CONTINUE
C
C
C***  FLAG 20 IS FOR DIMENSIONS OF FEET, DEFAULT TO TRUE
C
      IF(.NOT.(LFLAGS(19).OR.LFLAGS(21).OR.LFLAGS(22)))LFLAGS(20)=.TRUE.
C
      DO 1010 I=1,74
         IDCASE(I)=IBLANK
 1010 CONTINUE
      NOEXTR=.TRUE.
      NOLAT=.FALSE.
C
      IF(SAVE .AND. CASE .NE. 1)GO TO 1040
C
C***  INITIALIZE NACA CARD (ALSO INITIALIZED IN INZFIN)
C
      DO 1030 I=1,80
         DO 1020 J=1,4
            NNACA(I,J)=UNUSED
 1020    CONTINUE
 1030 CONTINUE
C
 1040 CONTINUE
C
C***  INITIALIZE DELETE NAMELIST FLAGS
C
      DO 1050 I=1,12
         DFLGG(I)=.FALSE.
 1050 CONTINUE
C
      DO 1060 I=1,37
         LDUMPF(I)=.FALSE.
 1060 CONTINUE
C
C***  DO NOT RE-INITIALIZE LSOSE OR LHYPER IF NOT FIRST CASE
C
      IF(CASE .EQ. 1)LSOSE=.FALSE.
      IF(CASE .EQ. 1)LHYPER=.FALSE.
C
      PRESUR=.FALSE.
C
      LHYBRD=.FALSE.
C
C***  INITIALIZE INCRMT COREC FACTORS IF CASE = 1
C
      IF(CASE.NE.1) GO TO 1080
      DO 1070 I=1,128
          COREC(I)=UNUSED
 1070 CONTINUE
 1080 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PLOT3(IC,IM,CN,CM,CA,CY,CLN,CLL)
C
C***  SUBROUTINE TO GENERATE A PLOT FILE ON TAPE UNIT 3
C***  FOR POST PROCESSING BY A PLOTTING PROGRAM
C
C  MODIFIED BY B. HEATH, WL/FIGC
C
C***  INPUTS
C
C     IM -- CURRENT VALUE OF MACH NUMBER (INTEGER VALUE)
C     CN -- ARRAY OF NORMAL FORCE DATA
C     CM -- ARRAY OF PITCHING MOMENT DATA
C     CA -- ARRAY OF AXIAL FORCE DATA
C     CY -- ARRAY OF SIDE FORCE DATA
C    CLN -- ARRAY OF YAW MOMENT DATA
C    CLL -- ARRAY OF ROLL MOMENT DATA
C
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),CASE,NOEXTR,NOLAT,
     1                IR,IPAGE
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      DIMENSION CN(20),CM(20),CA(20),CY(20),CLN(20),CLL(20)
C
      REAL NALPHA,NMACH,MACH,LREF,LATREF
      CHARACTER*4 PIN,PFT,PCM,PM,IPTYP
C
      DATA PIN / 'I   '/
      DATA PFT / 'F   '/
      DATA PCM / 'C   '/
      DATA PM  / 'M   '/
C
      IR=IR+1
      NALP=NALPHA+0.5
C
      IPTYP=PFT
      IF(LDIMIN)IPTYP=PIN
      IF(LDIMCM)IPTYP=PCM
      IF(LDIMM )IPTYP=PM
C
      CALL CVRTFT
C
C  REV 6/93 AND PRIOR VERSION
C  CODE COMMENTED OUT HERE
C
C     WRITE(3,1010)IR,NALP,IPTYP,IC,CASE
C     WRITE(3,1020)MACH(IM),REN(IM),PHI
C     WRITE(3,1030)SREF,LREF,XCG,LATREF,ZCG
C
C  TECPLOT COMMAND LINE
C
      WRITE(3,1100) MACH(IM)
C
      DO 1000 I=1,NALP
         WRITE(3,1040)ALPHA(I),CN(I),CM(I),CA(I),
     1                CY(I),CLN(I),CLL(I),0.
 1000 CONTINUE
C
C     WRITE(3,1050)
C
      CALL CVRTUS
C
 1010 FORMAT('RUN',I4,I3,2X,A1,A4,6X,'CASE ',I3)
 1020 FORMAT(F10.4,F10.0,F10.4)
 1030 FORMAT(5F10.4)
 1040 FORMAT(8F10.4)
 1050 FORMAT('R')
 1100 FORMAT('ZONE T="NO TRIM MACH=',F6.2,'"')
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RFLT(LFLT, AA)
C
C***  READ FLIGHT CONDITION INPUTS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION AA(125),NLNAME(6),IVNAME(45),LEN(11),IDIM(11),LOC(11)
C
      LOGICAL LFLT,IEOF
C
      DATA NLNAME /  'F   ','L   ','T   ','C   ','O   ','N   '/
      DATA IVNAME /  'N   ','A   ','L   ','P   ','H   ','A   ','A   ',
     1 'L   ','P   ','H   ','A   ','B   ','E   ','T   ','A   ','P   ',
     2 'H   ','I   ','N   ','M   ','A   ','C   ','H   ','M   ','A   ',
     3 'C   ','H   ','A   ','L   ','T   ','R   ','E   ','N   ','V   ',
     4 'I   ','N   ','F   ','T   ','I   ','N   ','F   ','P   ','I   ',
     5 'N   ','F   '/
      DATA IDIM   / 1,20,1,1,1,20,20,20,20,20,20 /
      DATA LEN    / 6,5,4,3,5,4,3,3,4,4,4 /
      DATA LOC    / 1,2,22,23,24,25,45,65,85,105,125 /
C
      LFLT=.TRUE.
C
      CALL NAMER(KAND,2,NLNAME,6,IVNAME,45,LEN,11,IDIM,AA,144,LOC,IEOF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SUPXY(THN,CAM,X,XU,XL,YU,YL,YUN,YLN,N)
C
C****  CALCULATE MEAN LINE AND THICKNESS DISTRIBUTION
C****  FROM X AND Y COORDINATES FOR SUPERSONIC AIRFOILS
C
      DIMENSION THN(50),CAM(50)
      DIMENSION X(50),XU(50),XL(50),YU(50),YL(50),YUN(50),YLN(50)
C
      DO 1000 I=1,N
      THN(I)=0.5*(YU(I)-YL(I))
      CAM(I)=0.5*(YU(I)+YL(I))
 1000 CONTINUE
 1010 THN(1)=0.0
      CAM(1)=0.0
      CAM(N)=0.0
      IN=0
C
C ... COMPUTE COORDINATES ALONG CHORD
C
      DO 1020 I=1,N
      IF(I .NE. N)DYDX=(CAM(I+1)-CAM(I))/(X(I+1)-X(I))
      IF(I .EQ. N)DYDX=(CAM(I-1)-CAM(I))/(X(I-1)-X(I))
      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 CONTINUE
      XU(1)=0.0
      XL(1)=0.0
      XU(N)=1.0
      XL(N)=1.0
      YUN(1)=0.0
      YLN(1)=0.0
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE WRTRIM
C
C***  WRITE TRIM INCIDENCE CONTROL INPUTS
C
      COMMON /TRIMIN/ AA(19)
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION NLNAME(4),IVNAME(59),LEN(12),IDIM(12),LOC(12)
C
      DATA NLNAME /  'T   ','R   ','I   ','M   '/
      DATA IVNAME /  'S   ','E   ','T   ','P   ','A   ','N   ','L   ',
     1 '1   ','P   ','A   ','N   ','L   ','2   ','P   ','A   ','N   ',
     2 'L   ','3   ','P   ','A   ','N   ','L   ','4   ','P   ','A   ',
     3 'N   ','L   ','5   ','P   ','A   ','N   ','L   ','6   ','P   ',
     4 'A   ','N   ','L   ','7   ','P   ','A   ','N   ','L   ','8   ',
     5 'D   ','E   ','L   ','M   ','I   ','N   ','D   ','E   ','L   ',
     6 'M   ','A   ','X   ','A   ','S   ','Y   ','M   '/
      DATA IDIM   / 1,-1,-1,-1,-1,-1,-1,-1,-1,1,1,-4 /
      DATA LEN    / 3,5,5,5,5,5,5,5,5,6,6,4 /
      DATA LOC    / 1,2,3,4,5,6,7,8,9,10,11,12 /
C
      CALL NAMEW(KAND,6,NLNAME,4,IVNAME,59,LEN,12,IDIM,AA,15,LOC)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCAPR(FR,CAF,CAPR)
C
C***  SUBROUTINE TO COMPUTE THE SUBSONIC PRESSURE DRAG FOR A BODY
C***  METHOD FROM DATCOM SECTION 4.2.3.1
C
C***  INPUTS
C
C     FR -- BODY FINENESS RATIO (LENGTH/MAX. DIAMETER)
C    CAF -- AXIAL FORCE DUE TO SKIN FRICTION
C
C***  OUTPUT
C
C   CAPR -- INCREMENT IN AXIAL FORCE DUE TO PRESSURE DRAG
C
C***  FORM FACTOR MULTIPLIER TO FRICTION DRAG METHOD USED
C
      FORM=1.+60./FR**3+0.0025*FR
C
      CAPR=(FORM-1.)*CAF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CALIB(ITYPE,NEXP,EALP,EXP,NPRED,PALP,PRED,CORR)
C
C***  CALIBRATE THE PREDICTIONS TO CORRESPOND TO THE EXPERIMENTAL
C***  DATA.  THE CALIBRATION FACTORS ARE BASED UPON LINEAR
C***  INTERPOLATION OF THE DATA.
C
C***  INPUTS
C  ITYPE - TYPE OF CORRECTION WANTED
C          -1=ADDER                        (CONSTANT AT ALPHA=0.)
C           1=ADDER                        (TABLE)
C          -2=MULTIPLIER                   (CONSTANT AT ALPHA=0.)
C           2=MULTIPLIER                   (TABLE)
C          -3=MULTIPLIER USING LOCAL SLOPE (CONSTANT AT ALPHA=0.)
C           3=MULTIPLIER USING LOCAL SLOPE (TABLE)
C           4=CORR IS THEORETICAL SLOPE AT ALPHA=0
C   NEXP - NUMBER OF EXPERIMENTAL DATA POINTS
C   EALP - EXPERIMENTAL ANGLE OF ATTACK TABLE
C    EXP - EXPERIMENTAL DATA
C  NPRED - NUMBER OF PREDICTED DATA POINTS
C   PALP - PREDICTED ANGLE OF ATTACK TABLE
C   PRED - PREDICTED DATA
C
C***  OUTPUTS
C
C   CORR - CORRECTION
C
      DIMENSION EALP(NEXP),EXP(NEXP),PALP(NPRED),PRED(NPRED),CORR(NPRED)
C
      IF(IABS(ITYPE) .EQ. 2)GO TO 1020
      IF(IABS(ITYPE) .EQ. 3)GO TO 1050
      IF(IABS(ITYPE) .EQ. 4)GO TO 1075
C
C***  ADDER CORRECTIONS
C
      IF(ITYPE .EQ. 1)GO TO 1000
C
C***  HERE FOR A CONSTANT AT ALPHA=0. (ITYPE=-1)
C
      CALL LNTRP(EALP,EXP ,NEXP ,0.,TEXP )
      CALL LNTRP(PALP,PRED,NPRED,0.,TPRED)
      CORR(1)=TEXP-TPRED
      GO TO 1080
C
C***  HERE FOR AN ADDER AS A FUNCTION OF ALPHA (ITYPE=1)
C
 1000 CONTINUE
      DO 1010 I=1,NPRED
         CALL LNTRP(EALP,EXP ,NEXP ,PALP(I),TEXP )
         CALL LNTRP(PALP,PRED,NPRED,PALP(I),TPRED)
         CORR(I)=TEXP-TPRED
 1010 CONTINUE
      GO TO 1080
C
C***  MULTIPLIER CORRECTIONS
C
 1020 CONTINUE
      IF(ITYPE .EQ. 2)GO TO 1030
C
C***  MULTIPLIER CONSTANT AT ALPHA=0. (ITYPE=-2)
C
      CALL LNTRP(EALP,EXP ,NEXP ,0.,TEXP )
      CALL LNTRP(PALP,PRED,NPRED,0.,TPRED)
      CORR(1)=TEXP/TPRED
      GO TO 1080
C
C***  HERE FOR AN MULTIPLIER AS A FUNCTION OF ALPHA (ITYPE=2)
C
 1030 CONTINUE
      DO 1040 I=1,NPRED
         CALL LNTRP(EALP,EXP ,NEXP ,PALP(I),TEXP )
         CALL LNTRP(PALP,PRED,NPRED,PALP(I),TPRED)
         IF(TPRED .EQ. 0.)CORR(I)=0.
         IF(TPRED .EQ. 0.)GO TO 1040
         CORR(I)=TEXP/TPRED
 1040 CONTINUE
      GO TO 1080
C
C***  HERE FOR MULTIPLIER AS A FUNCTION OF SLOPE
C
 1050 CONTINUE
      IF(ITYPE .EQ. 3)GO TO 1060
C
C***  HERE FOR MULTIPLIER BASED ON SLOPE AT ALPHA=0.
C
      CALL LNTRP(EALP,EXP ,NEXP ,0.,TEXP1 )
      CALL LNTRP(PALP,PRED,NPRED,0.,TPRED1)
      CALL LNTRP(EALP,EXP ,NEXP ,1.,TEXP2 )
      CALL LNTRP(PALP,PRED,NPRED,1.,TPRED2)
      TEXP=TEXP2-TEXP1
      TPRED=TPRED2-TPRED1
      CORR(1)=TEXP/TPRED
      GO TO 1080
C
C***  HERE FOR MULTIPLIER BASED ON LOCAL SLOPE
C
 1060 DO 1070 I=1,NPRED
         CALL LNTRP(EALP,EXP ,NEXP ,PALP(I)   ,TEXP1 )
         CALL LNTRP(PALP,PRED,NPRED,PALP(I)   ,TPRED1)
         CALL LNTRP(EALP,EXP ,NEXP ,PALP(I)+1.,TEXP2 )
         CALL LNTRP(PALP,PRED,NPRED,PALP(I)+1.,TPRED2)
         TEXP=TEXP2-TEXP1
         TPRED=TPRED2-TPRED1
         CORR(I)=TEXP/TPRED
 1070 CONTINUE
      GO TO 10 80
C
C*** HERE FOR SLOPE AT ZERO ALPHA
C
 1075 CONTINUE
      CALL LNTRP(PALP,PRED,NPRED,0.,TPRED1)
      CALL LNTRP(PALP,PRED,NPRED,1.,TPRED2)
      CORR(1)=TPRED2-TPRED1
C
C***  EXIT
C
 1080 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CSLINC(ICASE,CSLS,ICON,DUMMY)
C      
C     SUBROUTINE TO DETERMINE CSL INCREMENTAL TABLE AND INCREMENT CSL
C      
C***  INPUT
C      
C     ICASE = CASE NUMBER OF A RUN
C     CSLS  = ARRAY OF CSL VALUES FROM SYNTHS
C     DUMMY = ARRAY THAT CONTAINS EXPERIMENTAL COEFFICIENTS AND WILL
C             CONTAIN UPDATED COEFFICIENTS CSL = DUMMY 101 - 120
C     ICON  = CONFIGURATION TO BE ICREMENTED
C             ICON = 1     BODY ALONE
C             ICON = 2     BODY + 1 FIN SET
C             ICON = 3     BODY + 2 FIN SETS
C             ICON = 4     BODY + 3 FIN SETS
C             ICON = 5     BODY + 4 FIN SETS
C      
C***  OUTPUT
C      
C     CSL=INCREMENTED CSL VS. ALPHA ARRAY EQUIVALENT TO DUMMY 101 - 120
C         NOTE: IN THE FIRST CASE DUMMY ENTERS WITH EXPERIMENTAL VALUES
C               IT THEN RETURNS WITH INCREMENTED CSL
C      
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /FLC   / NA,ALPHA(20),FLDUM(123)
      COMMON /INC   / DUM(108),C(20),ZIP,ALP(20),NAP
      DIMENSION CSL(20),CSLTH(20),CSLEXP(20),DUMMY(120),CSLS(20,5)
      REAL NA,NAP
C
C **  INITIALIZE WORKING ARRAYS
C      
      DO 1000 I=1,20
         CSL(I)=UNUSED
         CSLTH(I)=UNUSED
         CSLEXP(I)=UNUSED
 1000 CONTINUE
C      
      NAP1 = NAP +.5
      NALPHA= NA + .5
C      
C       DETERMINE WHICH CONFIGURATION IS TO BE INCREMENTED AND FILL
C         THE WORKING ARRAYS
C      
      DO 1010 I=1,NALPHA
         IF(ICON .EQ. 1)CSLTH(I) = CSLS(I,5)
         IF(ICON .GT. 1)CSLTH(I) = CSLS(I,ICON-1)
 1010 CONTINUE
      IF (ICASE .NE. 1 .OR. ZIP .EQ. 1)GO TO 1030
C      
C       FILL CSLEXP ARRAY WITH EXPERIMENTAL DATA BEING HELD IN
C            ARRAY DUMMY
C      
      DO 1020 I=1,NALPHA
         CSLEXP(I) = DUMMY(I+100)
 1020 CONTINUE
C      
C       CALL CALIB TO GET A TABLE OF INCREMENTAL MULTIPLIERS
C      
      CALL CALIB(1,NALPHA,ALPHA,CSLEXP,NALPHA,ALPHA,CSLTH,C)
 1030 CONTINUE
C      
C***  DETERMINE INCREMENTED CSL VALUE USING INCREMENTALS IN ARRAY C
C      
      DO 1040 I=1,NALPHA
         CALL LNTRP(ALP,C,NAP1,ALPHA(I),CI)
         CSL(I) = CI + CSLTH(I)
 1040 CONTINUE
C
C     PLACE INCREMENTED CSL INTO ARRAY DUMMY
C
      DO 1050 I=1,NALPHA
         DUMMY(I+100)=CSL(I)
 1050 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION DXCNVE(NPTS,X,A,B)
C
C** FUNCTION TO COMPUTE THE VOLUME CENTROID OF AN ELLIPTICAL SEGMENT
C
C** INPUTS
C
C   NPTS -- NUMBER OF INPUT POINTS
C      X -- X STATION
C      A -- HORIZONTAL AXIS AT EACH X STATION
C      B -- VERTICAL AXIS AT EACH X STATION
C
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION TA(100), TB(100), TX(100), XMAJOR(50), XMINOR(50)
      DIMENSION X(NPTS),A(NPTS),B(NPTS),XSTA(50)
      LOGICAL SWITCH
C
C** STORE INPUT PARAMETERS TO BE MANIPULATED
C
      SWITCH=.FALSE.
C
      DO 1000 II=1,NPTS
         IF(A(II) .EQ. B(II))GO TO 1000
         IF(A(II) .LT. B(II))SWITCH=.TRUE.
         GO TO 1010
 1000 CONTINUE
C
 1010 CONTINUE
C
      DO 1020 II=1,NPTS
         IN=II*2-1
         TA(IN)=A(II)
         TB(IN)=B(II)
         IF(SWITCH)TA(IN)=B(II)
         IF(SWITCH)TB(IN)=A(II)
         TX(IN)=X(II)
         TA(IN+1)=-9999.
         TB(IN+1)=-9999.
         TX(IN+1)=-9999.
 1020 CONTINUE
      NPTS2=NPTS*2-1
C
C** LOOK FOR POSSIBLE MAJOR AXIS SHIFT (EX: HORIZ. AXIS TO VERT. AXIS)
C
      DO 1050 J=3,NPTS2,2
         IF(TB(J) .LE. TA(J)) GO TO 1050
C
C** COMPUTE A=B POINT AND PUT IN A DUMMY ARGUMENT (-9999.) LOCATION
C
 1030    SLOPE=(TB(J)-TB(J-2))/(TA(J)-TA(J-2))
         YINT=TB(J)-SLOPE*TA(J)
         XPOS=YINT/(1.-SLOPE)
         TA(J-1)=XPOS
         TB(J-1)=XPOS
         TX(J-1)=TX(J-2)+(TX(J)-TX(J-2))*ABS((TA(J-1)-TA(J-2))/
     1           (TA(J)-TA(J-2)))
C
C** SWITCH REST OF TA & TB PARAMETERS TO REFLECT AXIS SHIFT
C
        DO 1040 K=J,NPTS2,2
           TEMP=TA(K)
           TA(K)=TB(K)
           TB(K)=TEMP
 1040   CONTINUE
 1050 CONTINUE
C
C** REMOVE DUMMY ARRAY ELEMENTS (-9999.)
C
      NN=0
      DO 1060 M=1,NPTS2
         IF(TA(M) .EQ. -9999.) GO TO 1060
         NN=NN+1
         XMAJOR(NN)=TA(M)
         XMINOR(NN)=TB(M)
         XSTA(NN)=TX(M)
 1060 CONTINUE
C
C
      VOLTOT=0.0
      DXCNVE=0.0
      DCNV=0.0
C
      DO 1070 I=2,NN
         DVOLM=PI*(XSTA(I)-XSTA(I-1))*(XMAJOR(I)*XMINOR(I)
     1         -.5*((XMINOR(I)-XMINOR(I-1))*XMAJOR(I)+(XMAJOR(I)-
     2         XMAJOR(I-1))*XMINOR(I))+1./3.*(XMINOR(I)-XMINOR(I-1))*
     3         (XMAJOR(I)-XMAJOR(I-1)))
         VOLTOT=VOLTOT+DVOLM
         DCNV=PI/12.*(XSTA(I)-XSTA(I-1))**2*
     1        (6.*XMAJOR(I)*XMINOR(I)-2.*XMINOR(I)*
     2        (XMAJOR(I)-XMAJOR(I-1))-2.*XMAJOR(I)*
     3        (XMINOR(I)-XMINOR(I-1))+(XMAJOR(I)-XMAJOR(I-1))*
     4        (XMINOR(I)-XMINOR(I-1)))
         DXCNVE=DXCNVE+DCNV+DVOLM*XSTA(I-1)
 1070 CONTINUE
      DXCNVE=DXCNVE/VOLTOT
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FINCAB(MACH,SBASE,SREF,CABASE)
C
C***  COMPUTE THE BASE DRAG OF THE FIN TRAILING EDGE
C
C***  METHOD FROM MOORE, NWC TR-2796
C***  USES EMPIRICAL DATA FROM MACH 0. TO 3.1
C***       FROM MACH 0. TO 1.2, USE 3-D DATA
C***       FROM MACH 1.2 TO 3.1 USE 2-D DATA
C***       FOR MACH GREATER THAN 4.0, USE 1/MACH**2
C
C
C***  INPUTS
C
C   MACH -- MACH NUMBER
C  SBASE -- BASE AREA, SQ. FT.
C   SREF -- REFERENCE AREA, SQ. FT.
C
C***  OUTPUT
C
C CABASE -- BASE INCREMENT TO AXIAL FORCE
C
      DIMENSION CP2D(20),TMACH(20),IROUT(2)
      REAL MACH
C
      DATA TMACH/0.,.5,.7,.8,.85,.9,1.,1.05,1.1,1.2,1.3,1.5,1.7,
     1 1.9,2.1,2.3,2.5,2.8,3.1,4.0/
      DATA CP2D/.280,.293,.299,.310,.325,.345,.460,.466,.465,
     1 .440,.405,.337,.285,.245,.213,.186,.165,.135,.115,.0625/
C
C ... INTERPOLATE DUE TO MACH, IF LESS THAN 4.
C
      IF(MACH .LE. 4.)CALL LNTRP(TMACH,CP2D,20,MACH,CPBASE)
C
C ... USE 1/MACH**2 IF MACH GREATER THAN 4.
C
      IF(MACH .GT. 4.)CPBASE=1./MACH**2
C
C ... BASE AXIAL FORCE INCREMENT
C
      CABASE=CPBASE*SBASE/SREF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HEADR9
C
C***  FORTRAN 90 VERSION
C***  SUBROUTINE TO WRITE THE CASE HEADER ON DEMAND
C
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),CASE,NOEXTR,NOLAT,IR,
     1                IPAGE
C
      CHARACTER*4 IBLANK,IDCASE,ICASE
C
      INTEGER CASE
      DIMENSION ICASE(136)
      DATA IBLANK /'    '/
C
      IF(CASE .LE. 0)WRITE(6,1060)
      IF(CASE .LE. 0)GO TO 1040
C
      IPAGE=IPAGE+1
      WRITE(6,1050)CASE,IPAGE
C
C***   DETERMINE THE LENGTH OF THE IDENTIFICATION
C
      DO 1000 I=1,72
         II=72-I+1
         ICOUNT=II
         IF(IDCASE(II) .NE. IBLANK)GO TO 1010
 1000 CONTINUE
      IF(ICOUNT .EQ. 1)GO TO 1040
 1010 CONTINUE
C
C***   NOW CENTER CASE ID ON PAGE
C
      ISKIP=(72-ICOUNT)/2-2
C
C***   FILL BUFFER WITH BLANKS
C
      DO 1020 I=1,72
         ICASE(I)=IBLANK
 1020 CONTINUE
C
C***   FILL BUFFER WITH CASE ID
C
      DO 1030 I=1,ICOUNT
         JJ=I+ISKIP
         ICASE(JJ)=IDCASE(I)
 1030 CONTINUE
      WRITE(6,1070)(ICASE(I),I=1,72)
C
 1040 CONTINUE
C
 1050 FORMAT('1',8X,
     1    ' ***** THE USAF AUTOMATED MISSILE DATCOM * REV 3/99 *****',
     2    '     CASE',I4,/,
     3 9X,'      AERODYNAMIC METHODS FOR MISSILE CONFIGURATIONS     ',
     4    '     PAGE',I4)
 1060 FORMAT('1',8X,
     1    ' ***** THE USAF AUTOMATED MISSILE DATCOM * REV 3/99 *****',/,
     3 9X,'      AERODYNAMIC METHODS FOR MISSILE CONFIGURATIONS     ')
 1070 FORMAT(4X,72A1)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE INZIOM
C
C***  INITIALIZE ALL IOM DATA ARRAYS AND INTERNAL WORK ARRAYS
C
C  MODIFIED BY W. BLAKE, WL/FIGC
C
C***  OUTPUT DATA
C
C***  STATICS ...
C
      COMMON /SBODY/ CBOD(220)
      COMMON /SFIN1/ CFIN1(220)
      COMMON /SFIN2/ CFIN2(220)
      COMMON /SFIN3/ CFIN3(220)
      COMMON /SFIN4/ CFIN4(220)
      COMMON /SB1/   CB1(220)
      COMMON /SB12/  CB12(220)
      COMMON /SB123/ CB123(220)
      COMMON /SB1234/CB1234(220)
C
C***  DYNAMICS ...
C
C
      COMMON /DBODY/ EBODY(406)
C     COMMON /DDFIN1/ EFIN1(80)
C     COMMON /DDFIN2/ EFIN2(80)
C     COMMON /DDFIN3/ EFIN3(80)
C     COMMON /DDFIN4/ EFIN4(80)
      COMMON /DB1/   EB1(400)
      COMMON /DB12/  EB12(400)
      COMMON /DB123/ EB123(400)
      COMMON /DB1234/EB1234(400)
C
C***  INTERNAL WORK ARRAYS
C
      COMMON /BDWORK/ BDW(241)
C
C***  PROGRAM CONSTANTS
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C
      DO 1000 I=1,220
         CBOD(I)=UNUSED
         CFIN1(I)=UNUSED
         CFIN2(I)=UNUSED
         CFIN3(I)=UNUSED
         CFIN4(I)=UNUSED
         CB1(I)=UNUSED
         CB12(I)=UNUSED
         CB123(I)=UNUSED
         CB1234(I)=UNUSED
 1000 CONTINUE
C
C     DO 1005 I=1,80
C        EFIN1(I)=UNUSED
C        EFIN2(I)=UNUSED
C        EFIN3(I)=UNUSED
C        EFIN4(I)=UNUSED
C1005 CONTINUE
C
      DO 1010 I=1,400
         EBODY(I)=UNUSED
         EB1(I)=UNUSED
         EB12(I)=UNUSED
         EB123(I)=UNUSED
         EB1234(I)=UNUSED
 1010 CONTINUE
C
      DO 1015 I=1,46
         EBODY(360+I)=UNUSED
 1015 CONTINUE
C
      DO 1020 I=1,241
         BDW(I)=UNUSED
 1020 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PLTTRM(IM)
C
C***  SUBROUTINE TO GENERATE A PLOT FILE ON TAPE UNIT 3
C***  OF TRIMMING RESULTS FOR POST PROCESSING BY A PLOTTING PROGRAM
C
      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),CASE,NOEXTR,NOLAT,
     1                IR,IPAGE
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      COMMON /UTRIMD/CN(200),CM(200),CA(200),CY(200),
     1               CLN(200),CLL(200)
      COMMON /TRIMD/ DELTRM(20),CNTRM(20),CATRM(20),
     1               CYTRM(20),CLNTRM(20),CLLTRM(20)
      DIMENSION IC(10)
C
      REAL NALPHA,NMACH,MACH,LREF,LATREF
      INTEGER CASE
      CHARACTER*4 PIN,PFT,PCM,PM,IC,IPTYP
C
      DATA PIN / 'I   '/
      DATA PFT / 'F   '/
      DATA PCM / 'C   '/
      DATA PM  / 'M   '/
      DATA IC /'D1  ','D2  ','D3  ','D4  ','D5  ','D6  ','D7  ',
     1         'D8  ','D9  ','D10 '/
C
      NALP=NALPHA+0.5
C
      IPTYP=PFT
      IF(LDIMIN)IPTYP=PIN
      IF(LDIMCM)IPTYP=PCM
      IF(LDIMM )IPTYP=PM
C
      CALL CVRTFT
C
      IR=IR+1
C
C  REV 6/93 AND PRIOR VERSION CODE COMMENTED OUT
C  TECPLOT FORMAT USED FOR REV 5/97
C
C     WRITE(3,1030)IR,NALP,IPTYP,CASE
C     WRITE(3,1050)MACH(IM),REN(IM),PHI
C     WRITE(3,1060)SREF,LREF,XCG,LATREF,ZCG
      WRITE(3,1100) MACH(IM)
      DO 1000 I=1,NALP
      TCL=CNTRM(I)*COS(ALPHA(I)*PI/180.)-CATRM(I)*SIN(ALPHA(I)*PI/180.)
      TCD=CATRM(I)*COS(ALPHA(I)*PI/180.)+CNTRM(I)*SIN(ALPHA(I)*PI/180.)
         WRITE(3,1070)ALPHA(I),CNTRM(I),0.,CATRM(I),
     1                CYTRM(I),CLNTRM(I),CLLTRM(I),DELTRM(I),TCL,TCD
 1000 CONTINUE
C
C     WRITE(3,1080)
C
      DO 1020 IDELT=1,10
C
      IR=IR+1
C
C  REV 6/93 AND PRIOR VERSION CODE COMMENTED OUT
C
C     WRITE(3,1040)IR,NALP,IPTYP,IC(IDELT),CASE
C     WRITE(3,1050)MACH(IM),REN(IM),PHI
C     WRITE(3,1060)SREF,LREF,XCG,LATREF,ZCG
C
C     DO 1010 I=1,NALP
C        J=(IDELT-1)*20+I
C        WRITE(3,1070)ALPHA(I),CN(J),CM(J),CA(J),CY(J),CLN(J),CLL(J)
C1010 CONTINUE
C
C     WRITE(3,1080)
C
 1020 CONTINUE
C
      CALL CVRTUS
C
C1030 FORMAT('RUN',I4,I3,2X,A1,' TRIMMED',3X,'CASE ',I3)
C1040 FORMAT('RUN',I4,I3,2X,A1,A4,6X,'CASE ',I3)
C1050 FORMAT(F10.4,F10.0,F10.4)
C1060 FORMAT(5F10.4)
 1070 FORMAT(F7.2,9F10.4)
C1080 FORMAT('R')
 1100 FORMAT('ZONE T="TRIMMED MACH=',F6.2,'"')
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RINLET(LINLET,AA)
C
C***  READ INLET INPUTS
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION NLNAME(5),IVNAME(47),LEN(14),IDIM(14),LOC(14),AA(64)
C
      LOGICAL LINLET,IEOF
C
      DATA NLNAME /  'I   ','N   ','L   ','E   ','T   '/
      DATA IVNAME /  'N   ','I   ','N   ',
     1 'I   ','N   ','T   ','Y   ','P   ','E   ',
     2 'X   ','I   ','N   ','L   ','T   ',
     3 'X   ','D   ','I   ','V   ',
     4 'H   ','D   ','I   ','V   ',
     5 'L   ','D   ','I   ','V   ',
     6 'P   ','H   ','I   ',
     7 'X   ',
     8 'H   ',
     9 'W   ',
     A 'C   ','O   ','V   ','E   ','R   ',
     B 'R   ','A   ','M   ','P   ',
     C 'A   ','D   ','D   ',
     D 'M   ','F   ','R   '/
      DATA IDIM   / 1,1,1,1,1,1,20,5,5,5,-1,1,-1,20 /
      DATA LEN    / 3,6,5,4,4,4,3,1,1,1,5,4,3,3 /
      DATA LOC    / 1,2,3,4,5,6,7,27,32,37,42,43,44,45 /
C
      LINLET=.TRUE.
C
      CALL NAMER(KAND,2,NLNAME,5,IVNAME,47,LEN,14,IDIM,AA,64,LOC,IEOF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SVRINT(HR,VR,CDIH,SDIH,S,RL,TAPER,VRINT)
C **
C **  COMPUTES INTERFERENCE FACTOR FOR VORTEX INTERACTION WITH
C **  LIFTING SURFACE.
C **
C **  REFERENCE - NACA 1307, PITTS, NIELSEN, AND KAATARI (APPENDIX B)
C **
C **  LIMITATIONS -  STRIP AND SLENDER-BODY THEORY.
C **
C **  NOTE - UNITS ON HR,VR,S AND RL MUST BE CONSISTENT.
C **
C **  INPUT -
C **        HR    = HORIZONTAL POSITION OF VORTEX MEASURED FROM
C **                VEHICLE CENTERLINE
C **        VR    = VERTICAL POSITION OF VORTEX MEASURED FROM
C **                VEHICLE CENTERLINE
C **        CDIH  = COSINE OF LIFTING SURFACE DIHEDRAL ANGLE
C **        SDIH  = SINE OF LIFTING SURFACE DIHEDRAL ANGLE
C **        S     = LIFTING SURFACE MAXIMUM SEMISPAN (INCLUDES BODY)
C **        RL    = LOCAL BODY RADIUS AT LIFTING SURFACE
C **        TAPER = TIP TO ROOT CHORD TAPER RATIO
C **
C **  OUTPUT -
C **        VRINT = VORTEX INTERFERENCE FACTOR
C **
C
      REAL L
      DIMENSION L(4)
C
      I=1
      HOR=HR
      VOR=VR
C
C **  HORIZONTAL AND VERTICAL  DISTANCES OF RIGHT HAND VORTEX
C **  FROM RIGHT HAND LIFTING SURFACE.
C
 1000 F=HOR*CDIH+VOR*SDIH
      H=VOR*CDIH-HOR*SDIH
C
C **  CHECK FOR VORTEX ON WING TIP
C
      IF(F.NE.S.OR.H.NE.0.0) GO TO 1010
      VRINT=-1.E10
      GO TO 1040
 1010 CONTINUE
      A=((S-RL*TAPER)-F*(1.-TAPER))/(2.*(S-RL))
      A=A*ALOG((H*H+(F-S)**2)/(H*H+(F-RL)**2))
      HH=H
      IF(H.EQ.0.0) HH=0.0001
      FS=(F-S)/H
      FR=(F-RL)/H
      AA=1.0
      IF(FS.LT.0.0) AA=-AA
      B=S-RL+H*ATAN(ABS(FS))*AA
      AA=1.0
      IF(FR.LT.0.0) AA=-AA
      B=B-H*ATAN(ABS(FR))*AA
      B=B*(1.-TAPER)/(S-RL)
      L(I)=A-B
      IF(I.EQ.4) GO TO 1030
      IF(I.EQ.2) GO TO 1020
C
C **  HORIZONTAL AND VERTICAL DISTANCES OF LEFT HAND VORTEX
C **  FROM RIGHT HAND LIFTING SURFACE.
C
      H=HOR*SDIH+VOR*CDIH
      F=VOR*SDIH-HOR*CDIH
      I=I+1
      GO TO 1010
C
C **  LOCATION OF IMAGE VORTEX
C
 1020 Z2=VOR*VOR+HOR*HOR
      IF(Z2.EQ.0.0) Z2=.0001
      VOR=VOR*RL*RL/Z2
      HOR=HOR*RL*RL/Z2
      I=I+1
      GO TO 1000
 1030 VRINT=(L(1)-L(2)-L(3)+L(4))*2./(1.+TAPER)
C
 1040 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION XBAR(CNFIN,FMACH,AR,TR)
C***********************************************************************
C
C     XBAR  INTERPOLATES IN THE XBAR TABLES FOR ASPECT RATIO
C             AND TAPER RATIO.
C
C     INPUT:
C             CNFIN  -  FIN NORMAL FORCE COEFFICIENT
C             FMACH  -  MACH NUMBER
C             AR     -  ASPECT RATIO
C             TR     -  TAPER RATIO
C
C     OUTPUT:
C             XBAR   -  X CENTER OF PRESSURE
C
C***********************************************************************
      REAL XMACH(10),CN(10),XL(1),YL(1),T(1,1)
      REAL X12(10,10),X31(10,10),X32(10,10),X33(10,10),X42(10,10),
     *     X51(10,10),X52(10,10),X53(10,10),X62(10,10)
      DIMENSION NCN(9),DUM(1)
      DATA XMACH/0.6,0.8,0.9,1.2,1.5,2.0,2.5,3.0,3.5,4.5/
      DATA CN/0.0,0.2,0.4,0.6,0.8,1.0,1.2,1.4,1.6,1.8/
      DATA NCN/7,8,8,8,10,9,10,10,10/
      DATA DUM/1.0/
C
C  FIN 12       AR = 1/4   TR = 1/2
      DATA X12/
     *.4426,.4458,.4437,.4592,.4649,.4464,.4634,.4906,.5110,.5261,
     *.4955,.4996,.5021,.5137,.5226,.5458,.5685,.5839,.5908,.5903,
     *.5123,.5184,.5237,.5386,.5516,.5805,.5971,.6031,.6049,.6021,
     *.5105,.5192,.5262,.5506,.5652,.5823,.5898,.5937,.5943,.5935,
     *.5096,.5213,.5298,.5628,.5741,.5808,.5833,.5855,.5858,.5859,
     *.5109,.5258,.5356,.5755,.5796,.5813,.5804,.5810,.5803,.5797,
     *.5127,.5305,.5414,.5882,.5839,.5823,.5782,.5770,.5750,.5735,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000/
C  FIN 31       AR = 1/2   TR =  0
      DATA X31/
     *.6388,.6407,.6437,.6541,.6373,.6238,.6290,.6286,.6257,.6242,
     *.6305,.6372,.6425,.6582,.6601,.6671,.6609,.6577,.6551,.6606,
     *.6200,.6291,.6359,.6550,.6682,.6790,.6698,.6686,.6674,.6694,
     *.6108,.6210,.6291,.6541,.6667,.6710,.6658,.6663,.6654,.6648,
     *.6050,.6154,.6249,.6547,.6613,.6643,.6634,.6633,.6618,.6579,
     *.6016,.6109,.6218,.6513,.6558,.6609,.6608,.6594,.6575,.6505,
     *.5985,.6059,.6180,.6439,.6517,.6577,.6574,.6548,.6528,.6431,
     *.5954,.6009,.6140,.6351,.6479,.6543,.6540,.6502,.6481,.6363,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000/
C  FIN 32       AR = 1/2   TR = 1/2
      DATA X32/
     *.4150,.4042,.3864,.4032,.4058,.4410,.4580,.4644,.4640,.4728,
     *.4547,.4531,.4557,.4569,.4924,.5390,.5455,.5460,.5432,.5323,
     *.4739,.4758,.4818,.4904,.5401,.5835,.5815,.5772,.5709,.5585,
     *.4801,.4855,.4914,.5144,.5576,.5883,.5856,.5825,.5769,.5675,
     *.4819,.4916,.4992,.5359,.5649,.5854,.5845,.5852,.5817,.5751,
     *.4828,.4970,.5088,.5525,.5685,.5815,.5813,.5841,.5831,.5802,
     *.4838,.5025,.5201,.5643,.5707,.5772,.5747,.5770,.5779,.5777,
     *.4849,.5080,.5327,.5748,.5739,.5722,.5666,.5677,.5706,.5731,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000/
C  FIN 33       AR = 1/2   TR =  1
      DATA X33/
     *.1619,.1422,.1230,.1558,.1720,.2591,.2864,.3101,.3217,.3396,
     *.2602,.2491,.2381,.2244,.2852,.3812,.3802,.3881,.3942,.3966,
     *.3158,.3129,.3093,.2855,.3591,.4326,.4251,.4235,.4212,.4178,
     *.3403,.3441,.3475,.3388,.3894,.4365,.4320,.4319,.4288,.4203,
     *.3554,.3611,.3676,.3808,.4073,.4366,.4275,.4312,.4318,.4260,
     *.3648,.3717,.3785,.4101,.4228,.4356,.4202,.4232,.4255,.4257,
     *.3730,.3815,.3879,.4313,.4357,.4354,.4124,.4092,.4076,.4080,
     *.3812,.3914,.3973,.4503,.4451,.4367,.4046,.3931,.3864,.3844,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000/
C  FIN 42       AR =  1    TR = 1/2
      DATA X42/
     *.3813,.3652,.3434,.3862,.4545,.4620,.4971,.5114,.5196,.5222,
     *.4126,.4113,.4068,.4325,.5036,.5165,.5271,.5331,.5393,.5439,
     *.4324,.4395,.4456,.4728,.5348,.5470,.5493,.5494,.5518,.5536,
     *.4468,.4559,.4639,.5020,.5494,.5612,.5608,.5583,.5581,.5566,
     *.4660,.4794,.4829,.5222,.5562,.5702,.5694,.5647,.5635,.5606,
     *.4948,.5099,.5111,.5381,.5597,.5755,.5772,.5725,.5703,.5665,
     *.5185,.5340,.5402,.5505,.5650,.5765,.5817,.5810,.5788,.5756,
     *.5411,.5515,.5598,.5597,.5713,.5751,.5824,.5889,.5899,.5860,
     *.5637,.5690,.5775,.5711,.5771,.5735,.5819,.5963,.6027,.5967,
     *.5849,.5865,.5952,.5825,.5929,.5719,.5814,.6036,.6157,.6073/
C  FIN 51       AR =  2    TR =  0
      DATA X51/
     *.5854,.5894,.5880,.6396,.6170,.6225,.6249,.6224,.6186,.6123,
     *.5800,.5865,.5916,.6358,.6320,.6265,.6265,.6245,.6248,.6239,
     *.5734,.5831,.5924,.6288,.6361,.6320,.6332,.6319,.6324,.6321,
     *.5690,.5800,.5929,.6334,.6389,.6382,.6376,.6366,.6370,.6369,
     *.5696,.5765,.5899,.6363,.6452,.6457,.6417,.6402,.6407,.6406,
     *.5734,.5806,.5890,.6357,.6491,.6524,.6472,.6445,.6450,.6437,
     *.5742,.5982,.6037,.6335,.6491,.6557,.6530,.6490,.6486,.6456,
     *.5750,.6170,.6235,.6317,.6472,.6552,.6581,.6537,.6520,.6469,
     *.5758,.6357,.6425,.6357,.6450,.6542,.6632,.6584,.6554,.6482,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000/
C  FIN 52       AR =  2    TR = 1/2
      DATA X52/
     *.3467,.2893,.2037,.4114,.4870,.5366,.5340,.5397,.5375,.5348,
     *.3826,.3628,.3251,.4501,.4948,.5310,.5427,.5458,.5470,.5489,
     *.4219,.4210,.4147,.4819,.5026,.5307,.5483,.5527,.5562,.5576,
     *.4697,.4705,.4698,.5067,.5165,.5385,.5517,.5564,.5607,.5618,
     *.5124,.5155,.5131,.5250,.5327,.5461,.5539,.5576,.5614,.5633,
     *.5391,.5365,.5369,.5364,.5507,.5556,.5569,.5594,.5598,.5615,
     *.5655,.5459,.5489,.5463,.5643,.5657,.5616,.5622,.5584,.5587,
     *.5919,.5542,.5580,.5571,.5715,.5737,.5692,.5654,.5575,.5564,
     *.6127,.5625,.5670,.5690,.5738,.5786,.5766,.5687,.5567,.5545,
     *.6224,.5702,.5760,.5810,.5757,.5833,.5840,.5720,.5559,.5525/
C  FIN 53       AR =  2    TR =  1
      DATA X53/
     *.1355,.0595,.0000,.1781,.3550,.3966,.3996,.4059,.4098,.4063,
     *.1992,.1695,.0832,.2769,.3631,.4050,.4201,.4220,.4235,.4227,
     *.2718,.2696,.2613,.3406,.3701,.4092,.4300,.4320,.4340,.4330,
     *.3466,.3493,.3444,.3683,.3809,.4121,.4307,.4357,.4377,.4367,
     *.3845,.3898,.3917,.3839,.3948,.4111,.4254,.4339,.4371,.4390,
     *.3972,.4022,.4091,.3985,.4116,.4153,.4202,.4290,.4342,.4386,
     *.4063,.4116,.4164,.4184,.4267,.4249,.4204,.4248,.4297,.4351,
     *.4154,.4225,.4266,.4342,.4362,.4352,.4276,.4238,.4248,.4286,
     *.4237,.4334,.4378,.4438,.4417,.4430,.4371,.4255,.4206,.4202,
     *.4304,.4443,.4490,.4525,.4467,.4503,.4468,.4279,.4166,.4114/
C  FIN 62       AR =  4    TR = 1/2
      DATA X62/
     *.3765,.3866,.4433,.4427,.5330,.5547,.5509,.5478,.5465,.5436,
     *.3949,.3984,.4448,.4606,.5189,.5457,.5495,.5506,.5514,.5507,
     *.4227,.4234,.4455,.4789,.5065,.5416,.5526,.5560,.5570,.5548,
     *.4785,.4775,.4749,.5039,.5115,.5422,.5569,.5600,.5601,.5576,
     *.5122,.5139,.5095,.5279,.5290,.5453,.5555,.5599,.5617,.5609,
     *.5261,.5308,.5312,.5435,.5495,.5511,.5528,.5585,.5626,.5641,
     *.5370,.5425,.5456,.5541,.5655,.5602,.5545,.5582,.5625,.5656,
     *.5479,.5532,.5565,.5619,.5737,.5685,.5598,.5584,.5609,.5647,
     *.5584,.5635,.5670,.5689,.5760,.5739,.5662,.5596,.5597,.5628,
     *.5682,.5738,.5775,.5763,.5772,.5786,.5728,.5615,.5590,.5600/
C
      IF (AR.LE..5) THEN
        CALL MVLOOK(1,7,10,70,DUM,CN,XMACH,X12,FMACH,CNFIN,1.0,T12)
        CALL MVLOOK(1,8,10,80,DUM,CN,XMACH,X32,FMACH,CNFIN,1.0,T32)
        IF (TR.LE..5) THEN
C
C REGION I.      1/4 < AR < 1/2     0  < TR < 1/2
          CALL MVLOOK(1,8,10,80,DUM,CN,XMACH,X31,FMACH,CNFIN,1.0,T31)
          XBAR=T32 - 2.*(.5-TR)*(T32-T31) - 4.*(.5-AR)*(T32-T12)
        ELSE
C
C REGION II.     1/4 < AR < 1/2    1/2 < TR < 1
          CALL MVLOOK(1,8,10,80,DUM,CN,XMACH,X33,FMACH,CNFIN,1.0,T33)
          XBAR=T32 + 2.*(TR-.5)*(T33-T32) - 4.*(.5-AR)*(T32-T12)
        END IF
      ELSE IF (AR.LE.2.) THEN
        CALL MVLOOK(1,8,10,80,DUM,CN,XMACH,X32,FMACH,CNFIN,1.0,T32)
        CALL MVLOOK(1,10,10,100,DUM,CN,XMACH,X42,FMACH,CNFIN,1.0,T42)
        CALL MVLOOK(1,10,10,100,DUM,CN,XMACH,X52,FMACH,CNFIN,1.0,T52)
        IF (TR.LE..5) THEN
          CALL MVLOOK(1,8,10,80,DUM,CN,XMACH,X31,FMACH,CNFIN,1.0,T31)
          CALL MVLOOK(1,9,10,90,DUM,CN,XMACH,X51,FMACH,CNFIN,1.0,T51)
C
C REGION III.    1/2 < AR <  2      0  < TR < 1/2
          XBAR= ( T32-2.*(.5-TR)*(T32-T31)+2.*(AR-.5)*(T42-T32) )
     1         *(2.-AR)/1.5
     2         +( T52-2.*(.5-TR)*(T52-T51)-   (2.-AR)*(T52-T42) )
     3         *(AR-.5)/1.5
        ELSE
          CALL MVLOOK(1,8,10,80,DUM,CN,XMACH,X33,FMACH,CNFIN,1.0,T33)
          CALL MVLOOK(1,10,10,100,DUM,CN,XMACH,X53,FMACH,CNFIN,1.0,T53)
C
C REGION IV.     1/2 < AR <  2     1/2 < TR < 1
          XBAR= ( T32+2.*(TR-.5)*(T33-T32)+2.*(AR-.5)*(T42-T32) )
     1         *(2.-AR)/1.5
     2         +( T52+2.*(TR-.5)*(T53-T52)-   (2.-AR)*(T52-T42) )
     3         *(AR-.5)/1.5
        ENDIF
      ELSE
        CALL MVLOOK(1,10,10,100,DUM,CN,XMACH,X52,FMACH,CNFIN,1.0,T52)
        CALL MVLOOK(1,10,10,100,DUM,CN,XMACH,X62,FMACH,CNFIN,1.0,T62)
        IF (TR.LE..5) THEN
C
C REGION V.       2  < AR <  4       0  < TR < 1/2
          CALL MVLOOK(1,9,10,90,DUM,CN,XMACH,X51,FMACH,CNFIN,1.0,T51)
          XBAR=T52 - 2.*(.5-TR)*(T52-T51) + .5*(AR-2.)*(T62-T52)
        ELSE
C
C REGION VI.      2  < AR <  4      1/2 < TR < 1
          CALL MVLOOK(1,10,10,100,DUM,CN,XMACH,X53,FMACH,CNFIN,1.0,T53)
          XBAR=T52 + 2.*(TR-.5)*(T53-T52) + .5*(AR-2.)*(T62-T52)
        ENDIF
      ENDIF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCAWC(THEOFR,MACH,CAP)
C
C***  CALCULATE THE PRESSURE/WAVE DRAG INCREMENT OF A CONICAL NOSE
C***  CYLINDER AT TRANSONIC SPEEDS USING THE METHOD OF MOORE,
C***  NSWC-TR-80-346, P.29-30
C
C***  INPUTS
C
C THEOFR -- THEORETICAL CONICAL NOSE FINENESS RATIO
C   MACH -- FREESTREAM MACH NUMBER
C
C***  OUTPUT
C
C    CAP -- PRESSURE/WAVE DRAG INCREMENT
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL MACH
C
      DIMENSION DELTA(6),CAPO(6),CAPL(6),A(6)
C
      DATA DELTA / 0.,5.,10.,15.,20.,25. /
      DATA CAPO / 0.,0.00041,0.00780,0.02464,0.04871,0.08037 /
      DATA CAPL / 0.,1081.2,13.506,75.810,46.728,22.119 /
      DATA A / 100.,9.8,5.381,6.468,5.665,4.760 /
C
      SLOPE=ATAN(1./(2.*THEOFR))*RAD
      IF(SLOPE .GT. 25.)SLOPE=25.
      IF(SLOPE .LT. 0.)SLOPE=0.
C
           IF (SLOPE .GE. 0. .AND. SLOPE .LE. 5.)THEN
              SLOPE1=0.
              SLOPE2=5.
              CAPASO=0.068
              CAPBSO=0.000
              GOTO 100
C
      ELSE IF (SLOPE .GT. 5. .AND. SLOPE .LE. 10.)THEN
              SLOPE1=5.
              SLOPE2=10.
              CAPASO=0.180
              CAPBSO=0.068
              GOTO 100
C
      ELSE IF (SLOPE .GT. 10. .AND. SLOPE .LE. 15.)THEN
              SLOPE1=10.
              SLOPE2=15.
              CAPASO=0.291
              CAPBSO=0.180
              GOTO 100
C
      ELSE IF (SLOPE .GT. 15. .AND. SLOPE .LE. 20.)THEN
              SLOPE1=15.
              SLOPE2=20.
              CAPASO=0.455
              CAPBSO=0.291
              GOTO 100
C
      ELSE IF (SLOPE .GT. 20. .AND. SLOPE .LE. 25.)THEN
              SLOPE1=20.
              SLOPE2=25.
              CAPASO=0.58
              CAPBSO=0.455
      ENDIF
C
  100 CONTINUE
C
      CALL LNTRP(DELTA,CAPO,6,SLOPE1,CAP1)
      CALL LNTRP(DELTA,CAPL,6,SLOPE1,CAP2)
      CALL LNTRP(DELTA,A   ,6,SLOPE1,CAP3)
C
      CAPA=CAP1+CAP2*EXP(-CAP3/MACH)
C
C
      CALL LNTRP(DELTA,CAPO,6,SLOPE2,CAP4)
      CALL LNTRP(DELTA,CAPL,6,SLOPE2,CAP5)
      CALL LNTRP(DELTA,A   ,6,SLOPE2,CAP6)
C
      CAPB=CAP4+CAP5*EXP(-CAP6/MACH)
C
      CAP=CAPA+(CAPA-CAPB)*(SLOPE-SLOPE1)/(SLOPE1-SLOPE2)
C
      IF (MACH .GT. 1.)THEN
         SONICM=(CAP+1.71)/1.71
         IF (SONICM .LT. MACH)
     &    CAP=CAPASO+(CAPASO-CAPBSO)*(SLOPE-SLOPE1)/(SLOPE1-SLOPE2)        
C
      ENDIF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CARRYO(MACH,RADIUS,SSPAN,LESWP,TESWP,CR,TAPER,AR,CLA,
     1 DX,KWB,KBW,KKWB,KKBW,XCPBW,XCPWB)
C
C***  ROUTINE TO COMPUTE THE VALUES OF THE FIN-BODY AND BODY-FIN
C***  CARRY-OVER FACTORS DUE TO ANGLE OF ATTACK AND
C***  INCIDENCE.  THE FIN ALONE CLA MUST BE INPUT PER RADIAN.
C***  IT IS ASSUMED THAT TWO PANELS (ON OPPOSITE SIDES OF THE BODY)
C***  ARE PRESENT.
C
C***  INPUTS
C
C   MACH - MACH NUMBER
C RADIUS - BODY RADIUS AT LIFTING SURFACE
C  SSPAN - PANEL SEMI-SPAN (EXCLUDES BODY)
C  LESWP - PANEL LEADING EDGE SWEEP, DEG.
C  TESWP - PANEL TRAILING EDGE SWEEP, DEG.
C     CR - PANEL EXPOSED ROOT CHORD
C  TAPER - PANEL EXPOSED TAPER RATIO
C     AR - PANEL EXPOSED ASPECT RATIO
C    CLA - PANEL LIFT CURVE SLOPE, PER RADIAN
C     DX - DISTANCE FROM PANEL ROOT TRAILING EDGE TO BODY BASE
C
C***  OUTPUTS
C
C    KWB - CARRY-OVER TERM DUE TO ALPHA, KW(B)
C    KBW - CARRY-OVER TERM DUE TO ALPHA, KB(W)
C   KKWB - CARRY-OVER TERM DUE TO DEFLECTION, KKW(B)
C   KKBW - CARRY-OVER TERM DUE TO DEFLECTION, KKB(W)
C  XCPBW - CARRY-OVER CENTER OF PRESSURE, FRAC. ROOT CHORDS AFT
C                OF FIN ROOT L.E.
C  XCPWB - CARRY-OVER CENTER OF PRESSURE, FRAC. ROOT CHORDS AFT
C                OF FIN ROOT L.E. (FROM SLENDER BODY THEORY)
C
C***  REFERENCE - NACA REPORT 1307 (OTHER REFERENCES IN ROUTINE CARRYS)
C
      REAL M,MACH,LESWP,KWB,KBW,KKWB,KKBW,KWBI,KKWBI
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      ACOSH(U)=ALOG(U+SQRT(U*U-1.))
      ATANH(U)=0.5*(ALOG(1.+U)-ALOG(1.-U))
C
      IF(LESWP .NE. 0.)M=1./TAN(LESWP/RAD)
      IF(LESWP .EQ. 0.)M=1./UNUSED
      BETA=SQRT(ABS(MACH**2-1.))
      DOB=RADIUS/(SSPAN+RADIUS)
C
C***  XCPWB SAME AS FOR WING ALONE
C
      IF(LESWP .GE. 0.)
     * CALL FALCP(MACH,AR,LESWP,TAPER,XCPWB)
      IF(LESWP .LT. 0.)
     * CALL FWDXAC(MACH,AR,LESWP,TAPER,XCPWB)
C
C  XCPBW FROM DATCOM EQ. 4.3.2.2-C EXTENDED TO DOB = 1
C
      TSWPQR=TAN(LESWP/RAD)-(1-TAPER)/(AR*(1+TAPER))    
      T1=2.*PI*DOB**2+4.*DOB**2-PI*DOB-6.*DOB+2.
      IF(DOB.LT.0.5) T2=SQRT(1.-2.*DOB)*
     1            LOG( (SQRT(1.-2.*DOB)-DOB+1)/DOB )
      IF(DOB.GT.0.5) T2=-SQRT(2.*DOB-1.)*ACOS((1.-DOB)/DOB)
      IF(DOB.NE.0.5) BWFACT=-2.*DOB*((DOB**2+2.*DOB-1.)*T2+T1)/
     1                       (2.*DOB**2*T2+T1)
      IF(DOB.EQ.0.5) BWFACT=(PI-3.)/(4.-PI) 
      XCPBW=(CR/4.+(SSPAN+RADIUS)*TSWPQR*BWFACT)/CR
C***
C***  COMPUTE KWB AND KKWB FROM THE SLENDER BODY EQUATIONS
C***
      KWB=2.
      KKWB=1.
      IF(DOB.EQ.1.)GO TO 1000
      KWB=1.
      IF(DOB.EQ.0.)GO TO 1000
      T=1./DOB
      KWB=(PI/2.*((T**2-1.)/T)**2+((T**2+1.)/T)**2*
     1 ASIN((T**2-1.)/(T**2+1.))-2.*(T**2-1.)/T)/(PI*(T-1.)**2)
      KKWB=(PI**2/4.*((T+1.)/T)**2+PI*((T**2+1.)/(T*(T-1.)))**2*
     1 ASIN((T**2-1.)/(T**2+1.))-2.*PI*(T+1.)/(T*(T-1.))+
     2 (T**2+1.)**2/(T**2*(T-1.)**2)*(ASIN((T**2-1.)/(T**2+1.)))**2
     3 -4.*(T+1.)/(T*(T-1.))*ASIN((T**2-1.)/(T**2+1.))+
     4 8./(T-1.)**2*ALOG((T+1./T)/2.))/PI**2
 1000 CONTINUE
C***
C***  COMPUTE KBW SUBSONIC OR SUPERSONIC, WITH OR WITHOUT AFTERBODY
C***
      KBW=(1.+DOB)**2-KWB
      IF(KBW .EQ. 0.)KBW=UNUSED
      IF(DOB .EQ. 0.)GO TO 1010
      IF(MACH .LE. 1.0) GO TO 1010
C
C ... IF LEADING EDGE SWEEP IS ZERO, ADJUST TO NEAR ZERO
C
      ALESWP=LESWP
      IF(ABS(LESWP) .LE. UNUSED)ALESWP=0.01
C
C ... ASSURE TIP MACH LINE IS NOT ON ROOT CHORD
C
      FACTOR=SQRT(MACH**2-1.)*AR*(1.+TAPER)*(1.+1./(SQRT(MACH**2-1.)
     1       /TAN(ALESWP/RAD)))
      IF(FACTOR .LE. 4.)GO TO 1010
C***
C***  SUPERSONIC CARRY-OVER, USE ROUTINE CARRYS
C***
      CALL CARRYS(MACH,ALESWP,2.*RADIUS,CR,DX,ZKBW,XCPBW)
C
C ... COMPLETE THE CALCULATION FOR KBW
C
      KBW=ZKBW/(BETA*CLA*(1.+TAPER)*(1./DOB-1.))
C***
C***  COMPUTE KKBW
C***
 1010 KKBW=KWB-KKWB
C
      IF(TESWP.LE.0.)GO TO 1020
C***
C***  CORRECT THE LIFT FACTORS IF PANEL HAS TRAILING EDGE SWEEP
C***  METHOD FROM J. AIRCRAFT, VOL. 12, OCTOBER 1975
C***
      CRI=CR+SSPAN*TAN(TESWP/RAD)
      KBW=KBW*CR/CRI
      KWBI=1.+(KWB-1.)*CR/CRI
      KKWBI=1.+(KKWB-1.)*CR/CRI
      KKBW=(KWBI-KKWBI)*CR/CRI
      KWB=KWBI
      KKWB=KKWBI
C
 1020 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CSNINC(ICASE,CSNS,CMS,ICON,DUMMY,PHI)
C      
C        SUBROUTINE TO CALCULATE CSN INCREMENTALS AND TO COMPUTE
C     NEW CSN VALUES WITH THOSE INCREMENTALS. IF AERODYNAMIC ROLL IS
C     ZERO, AN INCREMENTAL IS DETERMINED FOR A CM TOTAL POTENTIAL AND
C     A TABLE OF MULTIPLIERS IS DETERMINED FOR THE VISCOUS CM TOTAL.
C     IF AERODYNAMIC ROLL IS NOT ZERO, A TABLE OF MULTIPLIERS IS CALCULA
C      
C***  INPUTS
C      
C     ICASE = RUN CASE NUMBER
C     CSNS  = ARRAY CONTAINING CSN VALUES FROM SYNTHS
C     CMS   = ARRAY CONTAINING CM  VALUES FROM SYNTHS
C     DUMMY = ARRAY THAT CONTAINS EXPERIMENTAL COEFFICIENTS THAT WILL
C             CONTAIN UPDATED COEFFICIENTS CSN = DUMMY 81-100
C     ICON  = CONFIGURATION TO BE INCREMETED
C             ICON = 1    BODY
C             ICON = 2    BODY + 1 FIN SET
C             ICON = 3    BODY + 2 FIN SETS
C             ICON = 4    BODY + 3 FIN SETS
C             ICON = 5    BODY + 4 FIN SETS
C     PHI   = BODY AXIS AERODYNAMIC  ROLL ANGLE
C      
C***  OUTPUT
C      
C     CSN = UPDATED CSN VALUES EQUIVALENT TO DUMMY 81-100
C           NOTE: FIRST CASE DUMMY ENTERS WITH EXPERIMENTAL VALUES OF CS
C                 THEN RETURNS WITH INCREMENTED CSN
C      
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /FLC   / NA,ALPHA(20),FLDUM(123)
      COMMON /INC   / DUMMEE(86),C1,C2(20),CM0T,DIP(20),ZIP,ALP(20),
     1                NAP
      DIMENSION CMTTH(20),CMTEXP(20),CMATTH(20),CSNTH(20),CSNEXP(20),
     1     CMATEX(20),CMPTTH(20),CMVTTH(20),CMPTEX(20),CMT(20),
     2     CSN(20),DUMMY(120),Z(20),CSNS(20,5),CMS(20,5)
      REAL NA,NAP
C
C **  INITIALIZE WORK ARRAYS
C      
      DO 1000 I=1,20
         CSNTH(I)=UNUSED
         CMTTH(I)=UNUSED
         CSNEXP(I)=UNUSED
         CMTEXP(I)=UNUSED
         CMPTTH(I)=UNUSED
         CMVTTH(I)=UNUSED
         CMPTEX(I)=UNUSED
         CSN(I)=UNUSED
         CMT(I)=UNUSED
 1000 CONTINUE
C      
      NAP1 = NAP+.5
      NALPHA = NA + .5
C      
C       USE APPROPRIATE IOM COMMON BLOCK TO FILL THE WORKING ARRAYS
C      
      DO 1020 I=1,NALPHA
          IF(ICON .GT. 1)GO TO 1010
          CSNTH(I)=CSNS(I,5)
          CMTTH(I)=SQRT(CMS(I,5)**2 + CSNS(I,5)**2)
         GO TO 1020
 1010     CSNTH(I)=CSNS(I,ICON-1)
          CMTTH(I)=SQRT(CMS(I,ICON-1)**2 + CSNS(I,ICON-1)**2)
 1020 CONTINUE
      IF(PHI .NE. 0.)GO TO 1040
C      
C      COMPUTE THEORETICAL SLOPE OF CM TOTAL VS. ALPHA TOTAL
C      
      DO 1030 I=1,NALPHA
         CALL POLINT(ALPHA,CMTTH,NALPHA,ALPHA(I),CMTTH(I),CMATTH(I))
 1030 CONTINUE
C      
C     ZIP=0  FIRST TIME THROUGH BETADR SO PHI IS AS INPUT
C     ZIP=1 SECOND TIME THROUGH BETADR SO PHI IS INCREMENTED BY 1 DEG.
C      
 1040 IF(ICASE .NE. 1 .OR. ZIP .EQ. 1)GO TO 1090
      IF(PHI .NE. 0.)GO TO 1160
C      
C       COMPUTE EXPERIMENTAL CM TOTAL
C      
      DO 1060 I=1,NALPHA
         CMTEXP(I)=SQRT(DUMMY(I+20)**2 + DUMMY(I+80)**2)
 1060 CONTINUE
C      
C      COMPUTE EXPERIMENTAL SLOPE OF CM TOTAL VS. ALPHA TOTAL
C      
      DO 1070 I=1,NALPHA
         CALL POLINT(ALPHA,CMTEXP,NALPHA,ALPHA(I),CMTEXP(I),CMATEX(I))
 1070 CONTINUE
C      
C       DETERMINE THE DIFFERENCE BETWEEN CM TOTAL EXPERIMENTAL AND CM
C          TOTAL THEORETICAL AT ALPHA = 0
C      
      CALL LNTRP(ALPHA,CMTEXP,NALPHA,0.,CMTEX0)
      CALL LNTRP(ALPHA,CMTTH,NALPHA,0.,CMTTH0)
      CM0T= CMTEX0 - CMTTH0
C      
C     SUBTRACT CM0T FROM THE EXPERIMENTAL CM TOTAL TO BRING THE CURVE DO
C     TO THE THEORETICAL CURVE
C      
      DO 1080 I=1,NALPHA
         CMTEXP(I) = CMTEXP(I) - CM0T
 1080 CONTINUE
C      
C       CALL SUBROUTINE CALIB TO DETERMINE THE POTENTIAL INCREMENTAL C1
C      
      CALL CALIB(-3,NALPHA,ALPHA,CMATEX,NALPHA,ALPHA,CMATTH,Z)
      C1=Z(1)
 1090 IF(PHI .NE. 0.)GO TO 1180
C      
C         CALCULATE THE THEORETICAL POTENTIAL CM TOTAL AND VISCOUS CM
C         TOTAL FROM CM TOTAL
C      
      DO 1100 I=1,NALPHA
         CMPTTH(I)=.5*CMATTH(I)*SIN(2.*ALPHA(I))*COS(ALPHA(I)/2.)
         CMVTTH(I)=CMTTH(I) - CMPTTH(I)
 1100 CONTINUE
C      
C        USE THE INCREMENTAL FACTOR C1 TO DETERMINE THE CORRECTED
C          POTENTIAL CM, WHICH IS THE EXPERIMENTAL CM TOTAL POTENTIAL
C      
      DO 1110 I=1,NALPHA
         CMPTEX(I)=C1*CMPTTH(I)
 1110 CONTINUE
      IF (ICASE .NE. 1 .OR. ZIP .EQ. 1)GO TO 1130
C      
C       DETERMINE THE VISCOUS INCREMENTAL BY TAKING THE RATIO OF
C         EXPERIMENTAL CM TOTAL VISCOUS TO THEORETICAL CM TOTAL VISCOUS
C      
      DO 1120 I=1,NALPHA
         IF(CMTTH(I) - CMPTTH(I) .EQ. 0.)C2(I)=1.
         IF(CMTTH(I) - CMPTTH(I) .EQ. 0.)GO TO 1120
         C2(I)=(CMTEXP(I) - CMPTEX(I))/(CMTTH(I) - CMPTTH(I))
 1120 CONTINUE
 1130 CONTINUE
C      
C***  COMPUTE THE INCREMENTED CM TOTAL FOR PHI = 0
C      
      DO 1140 I=1,NALPHA
         CALL LNTRP(ALP,C2,NAP1,ALPHA(I),C2I)
         CMT(I)=CMPTEX(I) + C2I * CMVTTH(I) + CM0T
 1140 CONTINUE
C      
C       USING INCREMENTED CM TOTAL AND INCREMENTED CM DETERMINE
C             INCREMENTED CSN
C      
      DO 1150 I=1,NALPHA
         SIGN=1.
         IF(CSNTH(I) .LT. -.0000001)SIGN=-1.
         CSN(I)=SIGN*SQRT(ABS(CMT(I)**2-DUMMY(I+20)**2))
 1150 CONTINUE
      GO TO 1200
C      
C***  FILL CSNEXP WITH EXPERIMENTAL VALUES THEN USE CALIB TO DETERMINE A
C     TABLE OF INCREMENTAL MULTIPLIERS WHEN PHI NOT ZERO
C      
 1160 DO 1170 I=1,NALPHA
         CSNEXP(I)=DUMMY(I+80)
 1170 CONTINUE
      CALL CALIB(2,NALPHA,ALPHA,CSNEXP,NALPHA,ALPHA,CSNTH,C2)
C      
C**   USE INCREMENTALS INTERPOLATED AT THE ANGLE OF ATTACK OF INTEREST T
C       INCREMENT CSN
C      
 1180 DO 1190 I=1,NALPHA
         CALL LNTRP(ALP,C2,NAP1,ALPHA(I),C2I)
         CSN(I)=CSNTH(I)*ABS(C2I)
 1190 CONTINUE
C      
C        UPDATE ARRAY DUMMY TO CONTAIN INCREMENTED CSN
C      
 1200 DO 1210 I=1,NALPHA
         DUMMY(I+80)=CSN(I)
 1210 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION ELLIP1(CAYSQ)
C
C***  COMPUTE THE COMPLETE ELLIPTIC INTEGRAL OF THE FIRST
C***  KIND USING A POLYNOMIAL EXPANSION
C
C***  INPUT
C
C   CAYSQ - VALUE FOR K SQUARED (MULTIPLIER TO SIN(PHI)**2)
C
C         FUNCTION INTEGRATED=1./SQRT(1.-CAYSQ*SIN(PHI)**2)
C               OVER THE RANGE OF PHI FROM 0 TO PI/2
C
C***  REFERENCE - HANDBOOK OF MATH FUNCTIONS
C                 BY ABRAMOVITZ AND STEGUN
C                 PAGE 591, EQUATION 17.3.34
C
      ELLIP1=1000.
C
      IF(CAYSQ .GE. 1.)GO TO 1000
C
      CAY=1.-CAYSQ
C
      ELLIP1=1.38629436112+.09666344259*CAY+.03590092383*CAY**2+
     1                     .03742563713*CAY**3+.01451196212*CAY**4+
     2       ALOG(1./CAY)*(.5+.12498593597*CAY+.06880248576*CAY**2+
     3                     .03328355346*CAY**3+.00441787012*CAY**4)
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FINCAP(AMACH,XOVC,TOC,CAF,CAP)
C
C***  FIN ALONE SUBSONIC PRESSURE DRAG
C***  METHOD FROM S.F. HOERNER, FLUID DYNAMIC DRAG
C
C***  INPUTS
C
C  MACH -- MACH NUMBER
C  XOVC -- POSITION OF MAXIMUM AIRFOIL THICKNESS, FRAC. C
C   TOC -- FIN MAXIMUM THICKNESS TO CHORD FRACTION
C   CAF -- SKIN FRICTION INCREMENT TO AXIAL FORCE
C
C***  OUTPUT
C
C   CAP -- SUBSONIC PRESSURE DRAG INCREMENT TO AXIAL FORCE
C
      XCMAX=XOVC
C
C***  XOVC MUST BE IN THE RANGE 0.3 TO 0.5
C
      IF(XOVC .LT. 0.3)XCMAX=0.3
      IF(XOVC .GT. 0.5)XCMAX=0.5
C
      AK=4.*(0.3-XCMAX)
      CAP=CAF*((2.+AK)*TOC+60.*TOC**4)
C
C***  VARY CAP BETWEEN MACH 1.0 AND 1.2 TO ZERO AT MACH 1.2
C
      IF(AMACH .LE. 1.0)GO TO 1000
C
      IF(AMACH .GE. 1.2)CAP=0.
      IF(AMACH .GE. 1.2)GO TO 1000
C
      CAP=5.*CAP*(1.2-AMACH)
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HEXCA(L, YP, B, XM, XW, CP, NF, DCA, FAIL)
C
C     CALCULATE CP AND D(CA)/DY ARROUND HEX AIRFOIL
C
C     INPUT VARIABLES
C          L - NUMBER OF POINTS ON NOSE CAP
C         YP - Y-POSITION ON FIN
C          B - SPAN OF TWO PANELS ALONE
C         XM - MACH NUMBER
C
C     INPUT VARIABLES FROM COMMON
C         XO - ROOT LOCATIONS OF SOSL
C         XT - TIP LOCATIONS OF SOSL
C
C     OUTPUT VARIABLES
C         XW - LOCATIONS OF PRESSURES
C         CP - PRESSURE COEFFICIENT AT XW
C         NF - NUMBER OF FINAL POINT ON AIRFOIL
C        DCA - D(CA)/DY
C
      COMMON /CAFD/  XO(60), XT(60), DZDXO(60), DZDXT(60), TGA(60),
     1               ETA(60), DZDX(60), NS, CPO
C
      LOGICAL FAIL
      DIMENSION XW(60), CP(60), DZ(60)
C     ...
C     ... CALCULATE AIRFOIL GEOMETRY
C     ...
      AJ  = 2.0*YP/B
      X11 = XO(L+1)+AJ*(XT(L+1)-XO(L+1))
      X12 = XO(L+2)+AJ*(XT(L+2)-XO(L+2))
      X13 = XO(L+3)+AJ*(XT(L+3)-XO(L+3))
      X14 = XO(L+4)+AJ*(XT(L+4)-XO(L+4))
      DXN = (X14-X11)/32.
      XL1 = X12-X11
      XL2 = X13-X12
      XL3 = X14-X13
      IF(XL2 .LT. 1.E-4) XL2 = 0.0
      IF(XL3 .LT. 1.E-4) XL3 = 0.0
      CALL NDIV(XL1, DXN, N1)
      CALL NDIV(XL2, DXN, N2)
      CALL NDIV(XL3, DXN, N3)
      DCA = 0.0
C     ...
C     ... FWD FLAT SURFACE CP AND DCA
C     ...
      DX = XL1/N1
      NI = L+2
      NF = NI+N1
      DO 10 I=NI,NF
        XW(I) = X11+(I-NI)*DX
        DZ(I) = DZDX(L+2)
        XP = XW(I)
        IF(I .EQ. NI) XP = X11+0.00001
        IF(I .EQ. NF) XP = X12-0.00001
        CALL CP3DW(XP, YP, B, XM, CP(I),FAIL)
        IF(FAIL)GO TO 60
   10 CONTINUE
      CALL SIMPW(CP, DZ, DX, NI, NF, DCA)
C     ...
C     ... CENTER SECTION CP
C     ...
      IF(N2 .EQ. 0) GO TO 30
        DX = XL2/N2
        NI = NF+1
        NF = NI+N2
        DO 20 I=NI,NF
          XW(I) = X12+(I-NI)*DX
          XP = XW(I)
          IF(I .EQ. NI) XP = X12+0.00001
          IF(I .EQ. NF) XP = X13-0.00001
          CALL CP3DW(XP, YP, B, XM, CP(I),FAIL)
          IF(FAIL)GO TO 60
   20   CONTINUE
   30 CONTINUE
C     ...
C     ... AFT WEDGE CP AND DCA
C     ...
      IF(N3 .EQ. 0) GO TO 50
        DX = XL3/N3
        NI = NF+1
        NF = NI+N3
        DO 40 I=NI,NF
          XW(I) = X13+(I-NI)*DX
          DZ(I) = DZDX(L+4)
          XP = XW(I)
          IF(I .EQ. NI) XP = X13+0.00001
          IF(I .EQ. NF) XP = X14-0.00001
          CALL CP3DW(XP, YP, B, XM, CP(I),FAIL)
          IF(FAIL)GO TO 60
   40   CONTINUE
        CALL SIMPW(CP, DZ, DX, NI, NF, DCA)
   50 CONTINUE
C
   60 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE INZREF
C
C***  INITIALIZE ALL REFERENCE QUANTITIES
C
C***  REFERENCE QUANTITY INPUTS
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
C
      REAL LREF,LATREF
C
C***  PROGRAM CONSTANTS
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C
      SREF=UNUSED
      LREF=UNUSED
      LATREF=UNUSED
      ROUGH=UNUSED
      XCG=UNUSED
      ZCG=UNUSED
      SCALE=UNUSED
      BLAYER=UNUSED
      RHR=UNUSED
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PLTUT9(IM,DELTAB,DELTA1,DELTA2,DELTA3,DELTA4,
     1 NSET,PANL1,PANL2,PANL3,PANL4)
C
C***  FORTRAN 90 VERSION
C
C***  PRINT UNTRIMMED STATIC AERODYNAMICS TO PLOT FILE (UNIT 3)
C
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      COMMON /UTRIMD/CNT(200),CMT(200),CAT(200),CYT(200),
     1               CLNT(200),CLLT(200)
C
      COMMON /FSET1/ FS1(111),APAN1,FS12(287)
      COMMON /FSET2/ FS2(111),APAN2,FS22(287)
      COMMON /FSET3/ FS3(111),APAN3,FS32(287)
      COMMON /FSET4/ FS4(111),APAN4,FS42(287)
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      DIMENSION DELTAB(10),DELTA1(8),DELTA2(8),DELTA3(8),DELTA4(8)
C
      REAL NALPHA,NMACH,MACH
C
      LOGICAL NA,NB,NC,PANL1,PANL2,PANL3,PANL4
C
      DATA I1,I2,I3,I4 / 1, 2, 3, 4 /
C
      NALP=NALPHA+0.5
C
      DO 1010 ID=1,10
         WRITE(3,1200) MACH(IM)
         DO 1000 I=1,NALP
         WRITE(3,1250)   ALPHA(I), CNT(I+(ID-1)*20),
     1           CMT(I+(ID-1)*20), CAT(I+(ID-1)*20),
     2           CYT(I+(ID-1)*20),CLNT(I+(ID-1)*20),
     3          CLLT(I+(ID-1)*20), DELTAB(ID)
 1000    CONTINUE
 1010 CONTINUE
C
 1200 FORMAT('ZONE T="UNTRIMMED MACH=',F6.2,'"')
 1250 FORMAT(F7.2,7F10.4)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RREFQ(LREFQ, AA)
C
C***  READ REFERENCE QUANTITY INPUTS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION AA(9),NLNAME(4),IVNAME(39),LEN(9),IDIM(9),LOC(9)
C
      LOGICAL LREFQ,IEOF
C
      DATA NLNAME /  'R   ','E   ','F   ','Q   '/
      DATA IVNAME /  'S   ','R   ','E   ','F   ','L   ','R   ','E   ',
     1 'F   ','L   ','A   ','T   ','R   ','E   ','F   ','R   ','O   ',
     2 'U   ','G   ','H   ','X   ','C   ','G   ','Z   ','C   ','G   ',
     3 'S   ','C   ','A   ','L   ','E   ','B   ','L   ','A   ','Y   ',
     4 'E   ','R   ','R   ','H   ','R   '/
      DATA IDIM   / 1,1,1,1,1,1,1,1,1 /
      DATA LEN    / 4,4,6,5,3,3,5,6,3 /
      DATA LOC    / 1,2,3,4,5,6,7,8,9 /
C
      LREFQ=.TRUE.
C
      CALL NAMER(KAND,2,NLNAME,4,IVNAME,39,LEN,9,IDIM,AA,9,LOC,IEOF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SVTRAK(ALPHA,DELTA,THETA,DIH,TES,XTEW,XHLW,XCPT,
     1                  FWRW,RL,HR,VR) 
C **
C **  COMPUTES WING VORTEX HORIZONTAL AND VERTICAL
C **    LOCATION AT THE TAIL CENTER OF PRESSURE.
C **
C **  LIMITATIONS  - STRAIGHT TAPERED WING
C **                 VORTEX IS SWEPT AFT ALONG VELOCITY VECTOR
C **
C **  NOTE  - UNITS ON XTEW,XHLW,XCPT,FWRW, AND RL MUST 
C **         BE CONSISTENT
C **
C **
C **  INPUT - 
C **
C **        ALPHA = ANGLE OF ATTACK, DEGREES 
C **        DELTA = WING DEFLECTION ANGLE, DEGREES 
C **        THETA = HINGE LINE SKEW ANGLE, DEGREES 
C **        DIH   = LIFTING SURFACE DIHEDRAL ANGLE, DEGREES
C **        TES   = TRAILING EDGE SWEEP ANGLE, DEGREES
C **        XTEW  = DISTANCE FROM NOSE TO WING TRAILING EDGE
C **        XHLW  = DISTANCE FROM NOSE TO WING HINGE LINE INTERSECTION
C **                WITH BODY 
C **        XCPT  = DISTANCE TO TAIL CENTER OF PRESSURE 
C **                MEASURED FROM NOSE
C **        FWRW  = VORTEX LATERAL LOCATION - BODY RADIUS AT THE WING 
C **        RL    = LOCAL BODY RADIUS AT WING HINGE LINE STATION
C **
C **  OUTPUT -
C **
C **        HR    = HORIZONTAL POSITION OF VORTEX MEASURED FROM 
C **                VEHICLE CENTERLINE
C **        VR    = VERTICAL POSITION OF VORTEX MEASURED FROM 
C **                VEHICLE CENTERLINE
C **
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C 
      PIO2=PI/2.
      DELTR=DELTA/RAD 
      ALPHR=ALPHA/RAD 
      THETR=THETA/RAD 
      SDIH=SIN(DIH/RAD)
      CDIH=COS(DIH/RAD)
      SDEL=SIN(DELTR*.5)
      CDEL=COS(DELTR*.5)
      TTES=TAN(TES/RAD)
C **
C **  CALCULATION OF DISTANCE BETWEEN VORTEX GENERATION POINT 
C **    AND WING HINGE LINE 
C **
      X2=XTEW+FWRW*TTES 
      PHI=ATAN2(FWRW,X2-XHLW) 
      S=SQRT((FWRW)**2+(X2-XHLW)**2)
      PSI=PIO2-THETR-PHI
      SSPAN=S*SIN(PSI)
C **
C **  CALCULATION OF VORTEX GENERATION POINT DEFLECTION DISTANCE
C **
      DEFD=2.*SSPAN*SDEL
C **
C **  CALCULATION OF VORTEX HORIZONTAL LOCATION AT TAIL 
C **
      HR=(RL+FWRW)*CDIH+DEFD*(SDEL*SIN(THETR)*CDIH+CDEL*SDIH)
C **
C **  CALCULATION OF VORTEX GENERATION POINT VERTICAL LOCATION
C **
      VOR=(RL+FWRW)*SDIH+DEFD*(SDEL*SIN(THETR)*SDIH-CDEL*CDIH)
C **
C **  CALCULATION OF VORTEX GENERATION POINT AXIAL LOCATION 
C **
      XGPT=(XTEW+FWRW*TTES)-DEFD*SDEL*COS(THETR)
      AFTL=XCPT-XGPT
C **
C **  CALCULATION OF VORTEX VERTICAL LOCATION AT TAIL 
C **
      VR=VOR+TAN(ALPHR)*AFTL
      RETURN
      END 
c *************************************
c *************************************
c *************************************
      FUNCTION YBAR(CNFIN,FMACH,AR,TR)
C***********************************************************************
C
C     YBAR  INTERPOLATES IN THE YBAR(MACH,CN) TABLES FOR ASPECT RATIO 
C             AND TAPER RATIO.
C
C     INPUT:  
C             CNFIN  -  FIN NORMAL FORCE COEFFICIENT
C             FMACH  -  MACH NUMBER
C             AR     -  ASPECT RATIO
C             TR     -  TAPER RATIO
C
C     OUTPUT: 
C             YBAR   -  Y CENTER OF PRESSURE
C
C
C  WRITTEN BY  NIELSEN ENGINEERING AND RESEARCH, 8-89 
C              (415) 968-9457 
C
C***********************************************************************
      REAL YMACH(10),CN(10)
      REAL Y12(10,10),Y31(10,10),Y32(10,10),Y33(10,10),Y42(10,10),
     *     Y51(10,10),Y52(10,10),Y53(10,10),Y62(10,10)
      DIMENSION NCN(9),DUM(1),IROUT(2) 
C
      DATA YMACH/0.6,0.8,0.9,1.2,1.5,2.0,2.5,3.0,3.5,4.5/
      DATA CN/0.0,0.2,0.4,0.6,0.8,1.0,1.2,1.4,1.6,1.8/
      DATA NCN/7,8,8,8,10,9,10,10,10/
      DATA DUM/1.0/
C
C  FIN 12       AR = 1/4   TR = 1/2
      DATA Y12/
     *.5051,.4803,.4768,.4611,.4442,.4531,.4475,.4395,.4532,.4266,
     *.4382,.4329,.4326,.4298,.4226,.4364,.4295,.4306,.4329,.4332,
     *.3838,.3872,.3881,.3898,.3902,.4077,.4143,.4211,.4253,.4283,
     *.3568,.3616,.3635,.3724,.3843,.4051,.4140,.4190,.4229,.4241,
     *.3511,.3556,.3592,.3748,.3971,.4124,.4163,.4191,.4207,.4219,
     *.3528,.3565,.3616,.3818,.4059,.4148,.4162,.4185,.4181,.4190,
     *.3556,.3579,.3641,.3888,.4113,.4142,.4152,.4174,.4152,.4159,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000/
C  FIN 31       AR = 1/2   TR =  0
      DATA Y31/
     *.4371,.3991,.4064,.4025,.3924,.3659,.3652,.3438,.3420,.2804,
     *.3349,.3302,.3269,.3333,.3284,.3321,.3256,.3227,.3210,.3173,
     *.2734,.2813,.2803,.2876,.2918,.3123,.3176,.3194,.3207,.3225,
     *.2543,.2631,.2673,.2789,.2878,.3000,.3167,.3185,.3193,.3166,
     *.2500,.2583,.2643,.2813,.2869,.2970,.3155,.3167,.3159,.3109,
     *.2479,.2550,.2626,.2815,.2843,.2973,.3125,.3129,.3112,.3050,
     *.2460,.2518,.2623,.2791,.2824,.2962,.3085,.3083,.3061,.2991,
     *.2441,.2486,.2624,.2762,.2809,.2947,.3045,.3037,.3010,.2940,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000/
C  FIN 32       AR = 1/2   TR = 1/2
      DATA Y32/
     *.4484,.4525,.4707,.4405,.4322,.4369,.4439,.4129,.4323,.4376,
     *.4825,.4752,.4862,.4736,.4827,.4748,.4526,.4459,.4445,.4418,
     *.4701,.4598,.4645,.4635,.4776,.4636,.4418,.4426,.4424,.4421,
     *.4424,.4315,.4346,.4348,.4389,.4333,.4279,.4316,.4334,.4349,
     *.4167,.4077,.4102,.4117,.4090,.4201,.4222,.4264,.4276,.4284,
     *.3965,.3920,.3942,.3990,.3994,.4168,.4196,.4228,.4239,.4250,
     *.3798,.3812,.3847,.3926,.4026,.4143,.4160,.4183,.4190,.4202,
     *.3640,.3708,.3769,.3873,.4070,.4103,.4117,.4133,.4137,.4148,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000/
C  FIN 33       AR = 1/2   TR =  1
      DATA Y33/
     *.4910,.4952,.4764,.4241,.4367,.4364,.4179,.4259,.4200,.4331,
     *.5318,.5319,.5360,.5024,.4820,.4718,.4604,.4625,.4551,.4445,
     *.5418,.5377,.5428,.5178,.5035,.4895,.4747,.4690,.4646,.4480,
     *.5278,.5211,.5234,.5023,.4933,.4804,.4732,.4680,.4630,.4520,
     *.5120,.5034,.5037,.4853,.4778,.4685,.4717,.4690,.4634,.4566,
     *.4969,.4863,.4846,.4717,.4667,.4620,.4701,.4690,.4654,.4607,
     *.4829,.4692,.4644,.4613,.4633,.4628,.4681,.4671,.4651,.4622,
     *.4690,.4522,.4442,.4519,.4606,.4649,.4658,.4643,.4632,.4622,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000/
C  FIN 42       AR =  1    TR = 1/2
      DATA Y42/
     *.4387,.4406,.4467,.4384,.4300,.4426,.4491,.4369,.4467,.4610,
     *.4598,.4618,.4599,.4549,.4483,.4381,.4496,.4503,.4512,.4620,
     *.4609,.4648,.4644,.4674,.4633,.4412,.4489,.4515,.4537,.4587,
     *.4447,.4443,.4464,.4599,.4549,.4348,.4420,.4453,.4478,.4514,
     *.4234,.4189,.4216,.4443,.4393,.4278,.4359,.4395,.4417,.4454,
     *.4024,.3992,.4010,.4287,.4249,.4225,.4316,.4349,.4366,.4398,
     *.3863,.3931,.3968,.4166,.4130,.4176,.4285,.4319,.4322,.4350,
     *.3709,.3917,.3980,.4061,.4058,.4116,.4252,.4295,.4288,.4312,
     *.3555,.3903,.3992,.4015,.3996,.4052,.4217,.4278,.4261,.4279,
     *.3410,.3889,.4004,.3969,.3934,.3988,.4182,.4260,.4235,.4247/
C  FIN 51       AR =  2    TR =  0
      DATA Y51/
     *.4322,.4371,.4450,.4033,.3787,.4177,.4007,.3919,.3912,.3692,
     *.3895,.3934,.3992,.3908,.3755,.3740,.3685,.3657,.3640,.3638,
     *.3615,.3653,.3678,.3732,.3605,.3469,.3484,.3510,.3540,.3600,
     *.3412,.3451,.3492,.3564,.3375,.3284,.3356,.3417,.3465,.3526,
     *.3150,.3152,.3238,.3376,.3206,.3223,.3286,.3345,.3393,.3441,
     *.2846,.2841,.2926,.3187,.3105,.3208,.3245,.3289,.3330,.3362,
     *.2574,.2762,.2813,.3046,.3049,.3185,.3220,.3244,.3271,.3290,
     *.2304,.2803,.2873,.2969,.3024,.3145,.3199,.3203,.3214,.3220,
     *.2034,.2852,.2946,.2966,.3002,.3103,.3179,.3162,.3157,.3150,
     *.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000,.0000/
C  FIN 52       AR =  2    TR = 1/2
      DATA Y52/
     *.4417,.4494,.4230,.4212,.4194,.4208,.4217,.4228,.4246,.4230,
     *.4300,.4279,.4277,.4258,.4237,.4250,.4280,.4331,.4340,.4338,
     *.4144,.4100,.4259,.4298,.4262,.4275,.4325,.4413,.4452,.4430,
     *.3986,.3963,.4054,.4306,.4227,.4278,.4350,.4464,.4518,.4486,
     *.3961,.4051,.3951,.4255,.4195,.4268,.4349,.4465,.4511,.4515,
     *.4033,.4199,.4110,.4215,.4160,.4240,.4324,.4445,.4467,.4494,
     *.4107,.4250,.4192,.4168,.4122,.4206,.4293,.4412,.4412,.4452,
     *.4181,.4260,.4123,.4115,.4105,.4165,.4262,.4361,.4361,.4401,
     *.4278,.4270,.4032,.4078,.4093,.4118,.4227,.4298,.4311,.4342,
     *.4423,.4304,.3941,.4044,.4081,.4071,.4192,.4233,.4263,.4283/
C  FIN 53       AR =  2    TR =  1
      DATA Y53/
     *.4509,.4554,.4418,.4459,.4526,.4666,.4528,.4588,.4562,.4644,
     *.4651,.4655,.4603,.4471,.4470,.4477,.4492,.4559,.4619,.4619,
     *.4768,.4794,.4825,.4607,.4502,.4480,.4576,.4641,.4685,.4601,
     *.4783,.4805,.4850,.4665,.4509,.4510,.4647,.4692,.4723,.4663,
     *.4732,.4773,.4810,.4689,.4547,.4548,.4667,.4703,.4738,.4697,
     *.4651,.4697,.4745,.4701,.4596,.4576,.4668,.4710,.4747,.4744,
     *.4566,.4637,.4681,.4724,.4639,.4600,.4670,.4717,.4756,.4782,
     *.4481,.4598,.4628,.4727,.4664,.4621,.4673,.4716,.4749,.4780,
     *.4394,.4561,.4577,.4679,.4664,.4631,.4673,.4702,.4731,.4755,
     *.4304,.4524,.4563,.4620,.4658,.4639,.4671,.4683,.4710,.4729/
C  FIN 62       AR =  4    TR = 1/2
      DATA Y62/
     *.4342,.4481,.4661,.4330,.4200,.4268,.4242,.4168,.4111,.4173,
     *.4291,.4398,.4544,.4260,.4206,.4139,.4120,.4114,.4162,.4162,
     *.4192,.4262,.4333,.4171,.4166,.4132,.4179,.4202,.4220,.4152,
     *.4083,.4092,.4113,.4112,.4138,.4233,.4291,.4284,.4277,.4213,
     *.4036,.4016,.4003,.4097,.4135,.4283,.4341,.4333,.4334,.4280,
     *.4016,.4011,.3999,.4107,.4149,.4263,.4338,.4374,.4389,.4364,
     *.3999,.3993,.4010,.4113,.4155,.4241,.4316,.4389,.4428,.4436,
     *.3982,.3976,.3995,.4074,.4138,.4214,.4285,.4367,.4427,.4448,
     *.3965,.3963,.3972,.4014,.4096,.4167,.4244,.4325,.4400,.4446,
     *.3947,.3950,.3949,.3956,.4048,.4115,.4201,.4279,.4362,.4426/
C
      IF (AR.LE..5) THEN
        CALL MVLOOK(1,7,10,70,DUM,CN,YMACH,Y12,FMACH,CNFIN,1.0,T12)
        CALL MVLOOK(1,8,10,80,DUM,CN,YMACH,Y32,FMACH,CNFIN,1.0,T32)
        IF (TR.LE..5) THEN
C
C REGION I.      1/4 < AR < 1/2     0  < TR < 1/2
          CALL MVLOOK(1,8,10,80,DUM,CN,YMACH,Y31,FMACH,CNFIN,1.0,T31)
          YBAR=T32 - 2.*(.5-TR)*(T32-T31) - 4.*(.5-AR)*(T32-T12)
        ELSE
C
C REGION II.     1/4 < AR < 1/2    1/2 < TR < 1
          CALL MVLOOK(1,8,10,80,DUM,CN,YMACH,Y33,FMACH,CNFIN,1.0,T33)
          YBAR=T32 + 2.*(TR-.5)*(T33-T32) - 4.*(.5-AR)*(T32-T12)
        END IF
      ELSE IF (AR.LE.2.) THEN
        CALL MVLOOK(1,8,10,80,DUM,CN,YMACH,Y32,FMACH,CNFIN,1.0,T32)
        CALL MVLOOK(1,10,10,100,DUM,CN,YMACH,Y42,FMACH,CNFIN,1.0,T42)
        CALL MVLOOK(1,10,10,100,DUM,CN,YMACH,Y52,FMACH,CNFIN,1.0,T52)
        IF (TR.LE..5) THEN
          CALL MVLOOK(1,8,10,80,DUM,CN,YMACH,Y31,FMACH,CNFIN,1.0,T31)
          CALL MVLOOK(1,9,10,90,DUM,CN,YMACH,Y51,FMACH,CNFIN,1.0,T51)
C
C REGION III.    1/2 < AR <  2      0  < TR < 1/2
          YBAR= ( T32-2.*(.5-TR)*(T32-T31)+2.*(AR-.5)*(T42-T32) )
     1         *(2.-AR)/1.5
     2         +( T52-2.*(.5-TR)*(T52-T51)-   (2.-AR)*(T52-T42) )
     3         *(AR-.5)/1.5
        ELSE
          CALL MVLOOK(1,8,10,80,DUM,CN,YMACH,Y33,FMACH,CNFIN,1.0,T33)
          CALL MVLOOK(1,10,10,100,DUM,CN,YMACH,Y53,FMACH,CNFIN,1.0,T53)
C
C REGION IV.     1/2 < AR <  2     1/2 < TR < 1
          YBAR= ( T32+2.*(TR-.5)*(T33-T32)+2.*(AR-.5)*(T42-T32) )
     1         *(2.-AR)/1.5
     2         +( T52+2.*(TR-.5)*(T53-T52)-   (2.-AR)*(T52-T42) )
     3         *(AR-.5)/1.5
        ENDIF
      ELSE
        CALL MVLOOK(1,10,10,100,DUM,CN,YMACH,Y52,FMACH,CNFIN,1.0,T52)
        CALL MVLOOK(1,10,10,100,DUM,CN,YMACH,Y62,FMACH,CNFIN,1.0,T62)
        IF (TR.LE..5) THEN
C
C REGION V.       2  < AR <  4       0  < TR < 1/2
          CALL MVLOOK(1,9,10,90,DUM,CN,YMACH,Y51,FMACH,CNFIN,1.0,T51)
          YBAR=T52 - 2.*(.5-TR)*(T52-T51) + .5*(AR-2.)*(T62-T52)
        ELSE
C
C REGION VI.      2  < AR <  4      1/2 < TR < 1
          CALL MVLOOK(1,10,10,100,DUM,CN,YMACH,Y53,FMACH,CNFIN,1.0,T53)
          YBAR=T52 + 2.*(TR-.5)*(T53-T52) + .5*(AR-2.)*(T62-T52)
        ENDIF
      ENDIF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCAWF(DCENTR,DAFT,LAFT,MACH,CAWFL)
C
C*** THIS SUBROUTINE DETERMINES THE SUBSONIC-TRANSONIC WAVE DRAG
C*** COEFFICIENT OF AXISYMMETRIC CONICAL FLARES USING THE CURVES
C*** IN AMCP 706-280, FIGURE 8-33A-D, PAGE 8-49
C
C*** INPUTS
C
C***   DCENTR -- FOREWARD FLARE DIAMETER
C***     DAFT -- AFT FLARE DIAMETER
C***     LAFT -- LENGTH OF FLARE
C***     MACH -- FREE STREAM MACH NUMBER
C
C*** OUTPUT
C
C***    CAWFL -- WAVE DRAG COEFFICIENT INCREMENT TO AXIAL FORCE
C***             DUE TO FLARE (BASED ON AREA OF FORWARD DIAMETER)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL MACH,LAFT
      DIMENSION TBMACH(5),THETAF(4),TABALL(120),DCODF(6)
      DIMENSION TAB050(24),TAB090(24),TAB100(24),TAB120(24),TAB130(24)
      EQUIVALENCE (TAB050(1),TABALL(1)),(TAB090(1),TABALL(25)),
     *            (TAB100(1),TABALL(49)),(TAB120(1),TABALL(73)),
     *            (TAB130(1),TABALL(97))
      DATA TBMACH /.5,.9,1.0,1.2,1.3/
      DATA THETAF /0.,5.,7.5,10./
      DATA DCODF /0.,.2,.4,.6,.8,1./
      DATA TAB050 /
     *  .0000, .0000, .0000, .0000, .0000, .0000,
     *  .0000, .0000, .0000, .0000, .0000, .0000,
     *  .0000, .0000, .0000, .0000, .0000, .0000,
     *  .0000, .0000, .0000, .0000, .0000, .0000/
      DATA TAB090/
     *  .0000, .0000, .0000, .0000, .0000, .0000,
     *  .0064, .0064, .0052, .0048, .0044, .0000,
     *  .0248, .0228, .0200, .0172, .0120, .0000,
     *  .0488, .0480, .0448, .0400, .0280, .0000/
      DATA TAB100/
     *  .0000, .0000, .0000, .0000, .0000, .0000,
     *  .0132, .0132, .0128, .0116, .0076, .0000,
     *  .0416, .0416, .0400, .0352, .0220, .0000,
     *  .0844, .0840, .0832, .0748, .0488, .0000/
      DATA TAB120/
     *  .0000, .0000, .0000, .0000, .0000, .0000,
     *  .0480, .0480, .0472, .0440, .0292, .0000,
     *  .0692, .0692, .0688, .0684, .0540, .0000,
     *  .1172, .1168, .1148, .1060, .0800, .0000/
      DATA TAB130/
     *  .0000, .0000, .0000, .0000, .0000, .0000,
     *  .0332, .0332, .0328, .0324, .0248, .0000,
     *  .0652, .0652, .0648, .0628, .0516, .0000,
     *  .1196, .1196, .1192, .1120, .0828, .0000/
C
      CAWFL=0.
C
C*** CHECK FOR VALID MACH NUMBER RANGE
C
      AMACH=MACH
      IF(MACH.LT.0.5) AMACH=0.5
      IF(MACH.GT.1.3) AMACH=1.3
C
      IF((LAFT.EQ.0.).OR.(DCENTR.EQ.0.)) GO TO 1000
      IF(DCENTR.GT.DAFT) GO TO 1000
C
C*** CALCULATE THETA
C
C
C  REV 8/99 CORRECT THETA CALCULATION
C
C     THETA = ATAN((DAFT-DCENTR)/LAFT)*RAD
      THETA = ATAN((DAFT-DCENTR)/(2.*LAFT))*RAD
C
C*** CALCULATE DIAMETER RATIO
C
      DIARAT = DCENTR/DAFT
C
C*** INTERPOLATE
C
      CALL MVLOOK(5,4,6,120,TBMACH,THETAF,DCODF,TABALL,
     *            DIARAT,THETA,AMACH,CAWFL)
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CARRYS(MACH,SWEEP,DIAM,CROOT,DX,KBW,XBW)
C
C***  SUPERSONIC FIN-BODY CARRY OVER WITH FINITE AFTERBODIES
C
C  INPUTS
C
C   MACH -- FREE STREAM MACH NUMBER
C  SWEEP -- FIN L.E. SWEEP ANGLE, DEG.
C   DIAM -- BODY DIAMETER AT FIN, FEET
C  CROOT -- FIN EXPOSED ROOT CHORD, FEET
C     DX -- LENGTH OF BODY AFT OF FIN T.E., FEET
C
C  OUTPUTS
C
C    KBW -- LIFT CARRY OVER FACTOR
C           (MUST BE DIVIDED BY BETA*CLA*(1+TAPER)*(S/R-1)
C            TO GET AERODYNAMIC FACTOR FOR USE)
C    XBW -- CENTER OF PRESSURE OF FIN IN PRESENCE OF BODY
C           (EXPOSED ROOT CHORDS AFT OF FIN ROOT L.E.)
C
C***  REFERENCES
C
C     THE FOLLOWING REFERENCES ARE APPLICABLE -
C     (1) AIAA JOURNAL, VOL. 19, NO. 5, MAY 1981, P. 661
C     (2) AIAA JOURNAL, VOL. 20, NO. 6, JUN 1982, P. 855
C     (3) AIAA JOURNAL, VOL. 20, NO. 8, AUG 1982, P. 1144
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL MACH,KBW,MBW
C
      ATANH(X)=0.5*(ALOG(1.+X)-ALOG(1.-X))
      ACOSH(X)=ALOG(X+SQRT(X*X-1.))
C
C ... CONSTANTS (SEE REF 2 OR REF 3)
C
      BETA=SQRT(ABS(MACH**2-1.))
      B=BETA/TAN(ABS(SWEEP)/RAD)
      D=BETA*DIAM/CROOT
      P=DX/(BETA*DIAM)
      IF(P .EQ. 0.)P=0.00001
      IF(P .GT. 1.)P=1.
      IF(P .LT. -2.)P=-2.
      R=P+1./D
C
      IF(P .LE. 0.)GO TO 1010
C
C***  POSITIVE AFTERBODY LENGTHS
C
      IF(B .GE. 1.)GO TO 1000
C
C***  SUBSONIC LEADING EDGE
C
C ... R .LT. 1
C
      KBW=16.*SQRT(B)*D/(PI*(B+1.))*(B**1.5/(D**2*(1.+B))*
     1 (SQRT((B+(1.+B)*P*D)/B)-2.)-B/(1.+B)/SQRT(D)*(B*R+P)**1.5+
     2 B*(1.+B)*R**2*ATAN(SQRT(1./(D*(B*R+P)))))
      MBW=(-4.*D**2*R**2/(3.*(B+1.)*SQRT(B))
     1 *(B**2+B*P/2./R-(B+3.)*P**2/4./R**2)*SQRT(D*(B*R+P))
     2 +SQRT(B**2+B*(B+1.)*P*D)/(9.*B*(B+1.)**3)*((8.*B+24.)*B**2
     3 +(14.*B+6.)*(B+1.)*B*P*D+3.*(B-3.)*(B+1.)**2*D**2*P**2)
     4 -(8.*B+24.)*B**3/(9.*B*(B+1.)**3)+4./3.*D**3*R**3*B**1.5
     5 *ATAN(SQRT(1./(D*(B*R+P))))-(3.-B)*P**3*D**3/3./B
     6 *(ATANH(SQRT(B/D/(B*R+P)))-ACOSH(SQRT((B*R+P)/(P*(1.+B))))))
C
      XBW=MBW*8./(PI*D*KBW)
C
      IF(R .LT. 1.)GO TO 1030
C
C ...  R .GE. 1
C
      KBW=KBW+16.*SQRT(B)*D/(PI*(1.+B))*((1.+B*R)*SQRT((R-1.)*(B*R+1.))
     1 -(1.+B)/SQRT(B)*ATANH(SQRT((B*R-B)/(B*R+1.)))
     2 -B*(1.+B)*R**2*ATAN(SQRT((R-1.)/(B*R+1.))))
      MBW=MBW+(4.*D**3*R**2/(3.*(1.+B)*SQRT(B))
     1 *(B**2+B/2./R-(B+3.)/4./R**2)*SQRT((R-1.)*(B*R+1.))
     2 -4./3.*D**3*R**3*B**1.5*ATAN(SQRT((R-1.)/(B*R+1.)))
     3 +(3.-B)*D**3/3./B*ATANH(SQRT((B*R-B)/(B*R+1.))))
C
      XBW=MBW*8./(PI*D*KBW)
C
      GO TO 1030
C
C***  SUPERSONIC LEADING EDGE
C
C ... R .LT. 1
C
 1000 KBW=8.*D/(PI*SQRT(B**2-1.))*((-B/(1.+B))*(B*R+P)**2
     1 *ACOS((R+B*P)/(B*R+P))+B/D**2*SQRT(B**2-1.)/(1.+B)*
     2 (SQRT(1.+2.*P*D)-1.)-B**2/(D**2*(1.+B))*ACOS(1./B)
     3 +B*R**2*SQRT(B**2-1.)*ACOS(P/R))
      MBW=(SQRT(1.+2.*D*P)*((2.*B+5.)/3./(1.+B)**2
     1 +D*P/(3.*(B+1.))-D**2*P**2/B)-(2.*B+5.)/(3.*(1.+B)**2)
     2 +1./SQRT(B**2-1.)*(D**3*R**3*(1.-2.*B)-1./(1.+B)**2-
     3 3.*P*D**3*R**2)*ACOS((R+B*P)/(B*R+P))-1./SQRT(B**2-1.)*
     4 (1.-1./(1.+B)**2)*ACOS(1./B)+2.*D**3*R**3*ACOS(P/R)
     5 +P**2*D**3/B*SQRT(R**2-P**2))
C
      XBW=MBW*8.*B/(3.*PI*D*KBW)
C
      IF(R .LT. 1.)GO TO 1030
C
C ...  R .GE. 1
C
      KBW=KBW+8.*D/(PI*SQRT(B**2-1.))*((B*R+1.)**2*
     1 ACOS((R+B)/(B*R+1.))-SQRT(B**2-1.)*ACOSH(R)
     2 +B*R**2*SQRT(B**2-1.)*(ASIN(1./R)-PI/2.))
      MBW=MBW+(D**3*R**3/SQRT(B**2-1.)*
     1 (2.*B+3./R-1./B**2/R**3)*ACOS((B+R)/(B*R+1.))+2.*D**3*R**3
     2 *(ASIN(1./R)-PI/2.)-D**3/B*SQRT(R**2-1.)+D**3/B**2*ACOSH(R))
C
      XBW=MBW*8.*B/(3.*PI*D*KBW)
C
      GO TO 1030
C
C***  NEGATIVE AFTERBODY LENGTHS
C
 1010 CONTINUE
C
C ... CUT-OFF FOR BASE AHEAD OF MACH LINE ACROSS BODY
C
      KBW=0.
      XBW=0.
      IF(P .LE. -1./D)GO TO 1030
C
      IF(B .GE. 1.)GO TO 1020
C
C ... SUBSONIC LEADING EDGE
C
C ... R .LT. 1
C
      KBW=16.*B*R/(PI*(1.+B))*(SQRT(B)*(1.+B)*ATAN(SQRT(1./B))-B)
     1 *(1.+D*P)
      XBW=2./3.*(1.+D*P)
C
      IF(R .LT. 1.)GO TO 1030
C
C ...  R .GE. 1
C
      KBW=KBW+16.*SQRT(B)/(PI*(B+1.)*R)*((B*R+1.)*SQRT((R-1.)*(B*R+1.))
     1 -(B+1.)/SQRT(B)*ATANH(SQRT((B*R-B)/(B*R+1.)))
     2 -B*(1.+B)*R**2*ATAN(SQRT((R-1.)/(B*R+1.))))*(1.+D*P)
      XBW=XBW+32.*R/(3.*PI*KBW)*(-B**1.5*ATAN(SQRT((R-1.)/(B*R+1.)))
     1 +1./((1.+B)*R*SQRT(B))*(B**2+B/2./R-(B+3.)/4./R**2)
     2 *SQRT((R-1.)*(B*R+1.))+(3.-B)/4./B/R**3*ATANH(SQRT((B*R-B)/
     3 (B*R+1.))))*(1.+D*P)
C
      GO TO 1030
C
C***  SUPERSONIC LEADING EDGE
C
C ... R .LT. 1
C
 1020 KBW=8.*B*R/(PI*SQRT(B**2-1.))*(SQRT(B**2-1.)*PI/2.
     1 -B*ACOS(1./B))*(1.+D*P)
      XBW=2./3.*(1.+D*P)
C
      IF(R .LT. 1.)GO TO 1030
C
C ...  R .GE. 1
C
      KBW=KBW+8./(PI*SQRT(B**2-1.)*R)*((B*R+1.)**2*ACOS((R+B)/(B*R+1.))
     1 -SQRT(B**2-1.)*ACOSH(R)+B*R**2*SQRT(B**2-1.)*(ASIN(1./R)-PI/2.))
     2 *(1.+D*P)
      XBW=XBW+8.*B*R/(3.*PI*KBW)*(2.*(ASIN(1./R)-PI/2.)
     1 +1./SQRT(B**2-1.)*(2.*B+3./R-1./B**2*R**3)*ACOS((B+R)/(B*R+1.))
     2 -SQRT(R**2-1.)/B/R**3+ACOSH(R)/B**2/R**3)*(1.+D*P)
C
 1030 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CUBIC(X,X1,X2,Y1,Y2,DY1,DY2,Y)
C***  THIS PROGRAM FAIRS BETWEEN TWO POINTS USING A
C***  CUBIC SPLINE
C
C***  CALCULATE COEFFICIENTS
      A=(DY1+DY2)/(X1-X2)**2-2.*(Y1-Y2)/(X1-X2)**3
      B=(DY1-DY2)/(2.*(X1-X2))-1.5*(X1+X2)*A
      C=DY1-2.*B*X1-3.*A*X1**2
      D=Y1-C*X1-B*X1**2-A*X1**3
C
C***  CALCULATE Y AS A FUNCTION OF X
      Y=A*X**3+B*X**2+C*X+D
      RETURN
      END

c *************************************
c *************************************
c *************************************
      FUNCTION ELLIP2(CAYSQ)
C
C***  COMPUTE THE COMPLETE ELLIPTIC INTEGRAL OF THE SECOND
C***  KIND USING A POLYNOMIAL EXPANSION
C
C***  INPUT
C
C   CAYSQ - VALUE FOR K SQUARED (MULTIPLIER TO SIN(PHI)**2)
C
C         FUNCTION INTEGRATED=SQRT(1.-CAYSQ*SIN(PHI)**2)
C              OVER THE RANGE OF PHI FROM 0 TO PI/2
C
C***  REFERENCE - HANDBOOK OF MATH FUNCTIONS
C                 BY ABRAMOVITZ AND STEGUN
C                 PAGE 592, EQUATION 17.3.36
C
      ELLIP2=1.
C
      IF(CAYSQ .GE. 1.)GO TO 1000
C
      CAY=1.-CAYSQ
C
      ELLIP2=1.           +.44325141463*CAY+.06260601220*CAY**2+
     1                     .04757383546*CAY**3+.01736506451*CAY**4+
     2       ALOG(1./CAY)*(   .24998368310*CAY+.09200180037*CAY**2+
     3                     .04069697526*CAY**3+.00526449639*CAY**4)
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION FINCEN(SPAN,SWEEP0,CROOT,TAPER)
C
C***  FUNCTION TO COMPUTE THE CENTROID OF AREA FOR A STRAIGHT TAPERED
C***  FIN OR FIN SECTION, MEASURED FROM THE ROOT CHORD LEADING EDGE
C
C***  INPUTS
C
C   SPAN -- PANEL EXPOSED SPAN (TIP-TO-TIP) FOR TWO PANELS
C           JOINED AT THEIR EXPOSED ROOT CHORDS
C SWEEP0 -- PANEL LEADING EDGE SWEEP ANGLE IN DEGREES
C  CROOT -- PANEL EXPOSED ROOT CHORD
C  TAPER -- PANEL TIP CHORD DIVIDED BY EXPOSED ROOT CHORD
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      SIGMA=ASPECT(SPAN,CROOT,TAPER)/4.*(1.+TAPER)*TAN(SWEEP0/RAD)
C
      FINCEN=CROOT/3.*(TAPER+SIGMA+(1.+TAPER*SIGMA)/(1.+TAPER))
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HINGEM(IM,NSETS,NFIN,RADW,DELTAW,DREF,XCG,XHINGE,
     1                  SKEW,SSPAN,YCP,XCPWA)
C
C*** ROUTINE TO COMPUTE AND PRINT PANEL HINGE MOMENT DATA
C
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /PARTF/ PARTS(19)
C
      COMMON /PAERO/  AKBW(4),AKWB(4),AKKBW(4),AKKWB(4),XCPBW(4),
     1                XCPWB(4),DAQ(8,20,4),WAQ(8,20,4),
     2                CNW(8,20,4),CLW(8,20,4),CNWB(20,4),CMWB(20,4),
     3                CAWB(20,4),CYWB(20,4),CSNWB(20,4),CSLWB(20,4),
     4                CNBW(20,4),CMBW(20,4),CABW(20,4),CYBW(20,4),
     5                CSNBW(20,4),CSLBW(20,4),CN(20,4),CM(20,4),
     6                CA(20,4),CY(20,4),CSN(20,4),CSL(20,4)
C
      DIMENSION HING(8,20,4),RADW(4),DELTAW(8,4),XHINGE(4),NFIN(4),
     1   SKEW(4),SSPAN(4),YCP(20,4),XCPWA(4),BEND(8,20,4)
C
      REAL NALPHA,MACH
C
      LOGICAL NDUM,PARTS
C
      NDUM=.FALSE.
C
      NALP=NALPHA+.5
C
      IF(.NOT. PARTS(13))GO TO 1050
C***
C*** COMPUTE BENDING MOMENTS AND PRINT
C***
      DO 1020 ISET=1,NSETS
         NFINS=NFIN(ISET)
         DO 1010 IFIN=1,NFINS
            DO 1000 I=1,NALP
               BEND(IFIN,I,ISET)=0.
               IF(CNW(IFIN,I,ISET) .NE. 0.)
     1         BEND(IFIN,I,ISET)=YCP(I,ISET)*SSPAN(ISET)/DREF*
     2            CNW(IFIN,I,ISET)
 1000       CONTINUE
 1010    CONTINUE
 1020 CONTINUE
C
      DO 1040 ISET=1,NSETS
         NFINS=NFIN(ISET)
         CALL HEADR9
         WRITE(6,1120)ISET
         CALL PRFLC9(IM,NDUM,NDUM,NDUM)
         WRITE(6,1150)
         WRITE(6,1190)
C
         DO 1030 I=1,NALP
              WRITE(6,1170)ALPHA(I),(BEND(IFIN,I,ISET),IFIN=1,NFINS)
 1030    CONTINUE
 1040 CONTINUE
C
 1050 CONTINUE
      IF(.NOT. PARTS(14))GO TO 1110
C***
C*** COMPUTE HINGE MOMENTS AND PRINT
C***
      DO 1080 ISET=1,NSETS
         NFINS=NFIN(ISET)
         DO 1070 IFIN=1,NFINS
            DO 1060 I=1,NALP
C
C   REV 3/99 CALCULATE FIN C.P. FROM TRI-SERVICE DATA BASE
C   CORRELATIONS DEVELOPED BY NIELSEN ENGNEERING AND RESEARCH
C
            CALL HMCP(ISET,MACH(IM),
     1                ABS(CNW(IFIN,I,ISET)),XCPWA(ISET),XCPNR)
               ARM=(XHINGE(ISET)-XCPNR
     1             +YCP(1,ISET)*SSPAN(ISET)*SIN(SKEW(ISET)/RAD))
     1             *COS(SKEW(ISET)/RAD)
               HING(IFIN,I,ISET)=CNW(IFIN,I,ISET)*ARM/DREF
 1060       CONTINUE
 1070    CONTINUE
 1080 CONTINUE
C
      DO 1100 ISET=1,NSETS
         NFINS=NFIN(ISET)
         CALL HEADR9
         WRITE(6,1130)ISET
         CALL PRFLC9(IM,NDUM,NDUM,NDUM)
         WRITE(6,1150)
         WRITE(6,1190)
C
         DO 1090 I=1,NALP
            WRITE(6,1170)ALPHA(I),(HING(IFIN,I,ISET),IFIN=1,NFINS)
 1090    CONTINUE
 1100 CONTINUE
C
 1110 CONTINUE
C
      RETURN
C***
C***  FORMATS
C***
 1120 FORMAT(8X,'FIN SET ',I1,' PANEL BENDING MOMENTS (ABOUT',
     1 ' EXPOSED ROOT CHORD)',/)
 1130 FORMAT(12X,'FIN SET ',I1,' PANEL HINGE MOMENTS (ABOUT',
     1 ' HINGE LINE)',/)
 1150 FORMAT(3X,'ALPHA',3X,'PANL 1',3X,'PANL 2',3X,'PANL 3',3X,
     1 'PANL 4',3X,'PANL 5',3X,'PANL 6',3X,'PANL 7',3X,'PANL 8')
 1170 FORMAT(3X,F5.1,1P,8(1X,E9.2))
 1180 FORMAT(20X,F9.4,5X,1P,E12.5,4X,E12.5,4X,E12.5,4X,E12.5/
     1 (34X,E12.5,4X,E12.5,4X,E12.5,4X,E12.5))
 1190 FORMAT(' ')
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE INZTRM
C
C***  INITIALIZE ALL TRIM ARRAYS
C
C***  INCIDENCE CONTROL DEVICES
C
      COMMON /INCID/ DELTA1(8),DELTA2(8),DELTA3(8),DELTA4(8),XHINGE(4),
     1               SKEW(4)
C
C***  TRIM INCIDENCE CONTROL
C
      COMMON /TRIMIN/ SET,PANL1,PANL2,PANL3,PANL4,PANL5,PANL6,PANL7,
     1                PANL8,DELMIN,DELMAX,ASYM(8)
      LOGICAL PANL1,PANL2,PANL3,PANL4,PANL5,PANL6,PANL7,PANL8,ASYM
C
      COMMON /UTRIMD/ DATAX(1200)
      COMMON /TRIMD/  TTRIM(120)
C
C***  TRIMMING DATA
C
C***  PROGRAM CONSTANTS
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C
      SET=UNUSED
      PANL1=.FALSE.
      PANL2=.FALSE.
      PANL3=.FALSE.
      PANL4=.FALSE.
      PANL5=.FALSE.
      PANL6=.FALSE.
      PANL7=.FALSE.
      PANL8=.FALSE.
      DELMIN=UNUSED
      DELMAX=UNUSED
C
      XHINGE(1)=UNUSED
      XHINGE(2)=UNUSED
      XHINGE(3)=UNUSED
      XHINGE(4)=UNUSED
C
      SKEW(1)=UNUSED
      SKEW(2)=UNUSED
      SKEW(3)=UNUSED
      SKEW(4)=UNUSED
C
      DO 1000 I=1,8
         DELTA1(I)=UNUSED
         DELTA2(I)=UNUSED
         DELTA3(I)=UNUSED
         DELTA4(I)=UNUSED
         ASYM(I)=.FALSE.
 1000 CONTINUE
C
C     DO NOT INITIALIZE COMMON UTRIMD IF USING CONFIGURATION INCREMENTING
C
      DO 1010 I=1,1200
         DATAX(I)=UNUSED
 1010 CONTINUE
C
      DO 1020 I=1,120
         TTRIM(I)=UNUSED
 1020 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE POLINT(X,Y,NPT,XVAL,YVAL,DYDX)
C
C***  INTERPOLATES WITHIN THE Y VERSUS X CURVE AT XVAL FOR
C***  YVAL USING A THIRD ORDER POLYNOMINAL INTERPOLATION OR
C***  EXTRAPOLATION.
C***
C***  METHOD --
C***
C***  NPT .GE. 3 - A THIRD ORDER POLYNOMINAL IS DETERMINED
C***      FOR EACH INTERVAL BETWEEN DATA POINTS USING THE
C***      INTERVAL END POINT COORDINATES AND SLOPES.  SECOND
C***      ORDER POLYNOMINALS ARE DETERMINED FOR THE LEFT OR
C***      RIGHT ENDS OF THE CURVE USING THE END POINT COORDINATES
C***      AND THE ADJACENT INTERIOR POINT COORDINATES AND SLOPE.
C***      THE RESULTING INTERPOLATED CURVE AND ITS DERIVATIVES
C***      ARE CONTINUOUS.
C***
C***  NPT .EQ. 2 - A LINEAR CURVE IS DEFINED BY THE TWO POINTS
C***      AND CAN BE INTERPOLATED OR EXTRAPOLATED FOR ALL ABSCISSA
C***      VALUES.
C***
C***  NPT .EQ. 1 - YVAL IS SET TO Y(1).  DYDX IS SET TO 0.0.
C***
C***  REFERENCES -  NONE
C***
C***  LIMITATIONS -  Y VERSUS X MUST BE SINGLE VALUED
C***
C***  INPUTS
C***      X   - ARRAY OF ABSCISSA VALUES
C***      Y   - ARRAY OF ORDINATE VALUES
C***      NPT - NUMBER OF POINTS IN X-Y ARRAYS
C***
C***  OUTPUTS
C***      YVAL- INTERPOLATED ORDINATE VALUE
C***      DYDX- FIRST DERIVATIVE OF Y AT XVAL
C
      INTEGER RP
      DIMENSION X(NPT),Y(NPT),YP(2)
      IF(NPT.GT.2)GO TO 1000
      GO TO (1090,1080),NPT
C
C***  HERE FOR MORE THAN TWO POINTS
C
 1000 CONTINUE
      NP1=NPT-1
      NP2=NPT-2
      IF(XVAL.LT.X(2)) GO TO 1020
      IF(XVAL.GE.X(NP1)) GO TO 1030
C
C***  HERE IF XVAL IS BRACKETTED BY TWO POINTS ON BOTH SIDES
C
      DO 1010 J=2,NP2
         K=J+1
      IF(XVAL.GE.X(K)) GO TO 1010
         LOCATE=2
      GO TO 1040
 1010 CONTINUE
      GO TO 1030
C
C***  HERE IF XVAL.LT.X(2)
C
 1020 J=2
      K=3
      LOCATE=1
      GO TO 1040
C
C***  HERE IF XVAL.GE.X(NPT-1)
C
 1030 J=NP1
      K=NPT
      LOCATE=3
C
C***  HERE TO COMPUTE LEFT AND RIGHT SLOPES
C
 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))
         YP(N)=TAN((ATAN(SR)+ATAN(SL))*0.5)
      GO TO (1060,1050,1060),LOCATE
 1050 CONTINUE
C
C***  HERE TO DETERMINE POLYNOMIAL
C
      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)
C
      TW=2.
      TH=3.
      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)
      GO TO 1070
C
 1060 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))
 1070 YVAL=(((A*XVAL+B)*XVAL)+C)*XVAL+D
      DYDX=(3.0*A*XVAL+2.0*B)*XVAL+C
      GO TO 1100
 1080 CONTINUE
C
C***  HERE IF NPT .EQ. 2
C
      YVAL=Y(1)+(XVAL-X(1))*(Y(2)-Y(1))/(X(2)-X(1))
      DYDX=(Y(2)-Y(1))/(X(2)-X(1))
      GO TO 1100
 1090 CONTINUE
C
C***  HERE IF NPT .EQ. 1
C
      YVAL=Y(1)
      DYDX=0.0
C
 1100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RTRIM(LTRIM, AA)
C
C***  READ TRIM INCIDENCE CONTROL INPUTS
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C      
      CHARACTER*4 KAND,NLNAME,IVNAME
C
      DIMENSION AA(15),NLNAME(4),IVNAME(59),LEN(12),IDIM(12),LOC(12)
C
      LOGICAL LTRIM,IEOF
C
      DATA NLNAME /  'T   ','R   ','I   ','M   '/
      DATA IVNAME /  'S   ','E   ','T   ','P   ','A   ','N   ','L   ',
     1 '1   ','P   ','A   ','N   ','L   ','2   ','P   ','A   ','N   ',
     2 'L   ','3   ','P   ','A   ','N   ','L   ','4   ','P   ','A   ',
     3 'N   ','L   ','5   ','P   ','A   ','N   ','L   ','6   ','P   ',
     4 'A   ','N   ','L   ','7   ','P   ','A   ','N   ','L   ','8   ',
     5 'D   ','E   ','L   ','M   ','I   ','N   ','D   ','E   ','L   ',
     6 'M   ','A   ','X   ','A   ','S   ','Y   ','M   '/
      DATA IDIM   / 1,-1,-1,-1,-1,-1,-1,-1,-1,1,1,-4 /
      DATA LEN    / 3,5,5,5,5,5,5,5,5,6,6,4 /
      DATA LOC    / 1,2,3,4,5,6,7,8,9,10,11,12 /
C
      LTRIM=.TRUE.
C
      CALL NAMER(KAND,2,NLNAME,4,IVNAME,59,LEN,12,IDIM,AA,15,LOC,IEOF)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION SWEEPN(STAM,SWEEPM,STAN,SPAN,CROOT,TAPER)
C
C***  FUNCTION TO COMPUTE THE SWEEP ANGLE OF A STRAIGHT TAPERED FIN
C***  OR FIN SECTION AT STATION N (STAN) WHEN THE SWEEP AT STATION M
C***  (STAM) IS KNOWN
C
C***  INPUTS
C
C   STAM -- PANEL CHORD STATION OF KNOWN SWEEP
C           (0.0 IS THE LEADING EDGE AND 1.0 IS THE TRAILING EDGE)
C SWEEPM -- SWEEP ANGLE (IN DEGREES) AT STATION M
C   STAN -- PANEL CHORD STATION WHERE SWEEP ANGLE IS DESIRED
C   SPAN -- PANEL EXPOSED SPAN (TIP-TO-TIP) FOR TWO PANELS
C           JOINED AT THEIR EXPOSED ROOT CHORDS
C  CROOT -- PANEL EXPOSED ROOT CHORD
C  TAPER -- PANEL TIP CHORD DIVIDED BY EXPOSED ROOT CHORD
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      TANN=TAN(SWEEPM/RAD)-4./ASPECT(SPAN,CROOT,TAPER)*
     1     (STAN-STAM)*(1.-TAPER)/(1.+TAPER)
C
      SWEEPN=ATAN(TANN)*RAD
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE YCP(AR,TR,FM,CNF,YCPS) 
C***********************************************************************
C
C  THIS ROUTINE ESTIMATES THE FIN SPANWISE CENTER OF PRESSURE 
C
C   DESCRIPTION OF DATA BASE: 
C
C     1.  FIN DESIGNATIONS AND GEOMETRIES
C
C                  AR\TR \  0.0  \  0.5  \  1.0  \
C                 --------------------------------
C                   0.25 \   I       12      II
C                   0.50 \   31      32      33
C                   1.00 \  III      42      IV
C                   2.00 \   51      52      53
C                   4.00 \   V       62      VI
C
C            NUMBERS INDICATE FIN DESIGNATIONS AND THE ROMAN
C            NUMERALS INDICATE REGIONS OF INTERPOLATION.
C
C     2.  MACH NUMBER, ANGLE OF ATTACK AND FIN ORIENTATION ANGLE RANGES
C
C            MACH  = 0.6,0.8,0.9,1.2,1.5,2.0,2.5,3.0,3.5,4.5
C            ALPHA = 0,2,5,10,15,20,25,30*,35,40,45
C
C            * MAXIMUM ALPHA FOR: 
C                1) MACH LESS THAN 0.8
C                2) MACH LESS THAN 1.2 IF AR < 1.0
C
C  INPUT: 
C     AR     -  ASPECT RATIO OF WING ALONE
C     TR     -  FIN TAPER RATIO
C     FM     -  FREESTREAM MACH NUMBER
C     CNF    -  FIN NORMAL FORCE COEFFICIENT, REFERENCED TO THE
C               WING ALONE AREA
C
C  OUTPUT:  
C     YCPS   -  FIN SPANWISE CENTER-OF-PRESSURE LOCATION FOR NO FIN 
C               DEFLECTION MEASURED OUTBOARD FROM THE ROOT CHORD AND
C               IS GIVEN AS A FRACTION OF THE EXPOSED SEMISPAN.
C
C  SUBPROGRAMS USED:  YBAR
C
C  WRITTEN BY  NIELSEN ENGINEERING AND RESEARCH, 8-89 
C              (415) 968-9457 
C
C***********************************************************************
      DIMENSION AXY(11),FMACH(10),YS(11,10),IROUT(2)
      REAL YSN(2)
C
      DATA AXY/0.,0.2,0.4,0.6,0.8,1.0,1.2,1.4,1.6,1.8,2.0/
      DATA FMACH/.6,.8,.9,1.2,1.5,2.,2.5,3.,3.5,4.5/
C
C DETERMINE MACH NUMBER RANGE OF STABILITY DATA
      IM2=10
      DO 110 I=2,10
        IF (FM.LE.FMACH(I)) THEN
          IM2=I
          GOTO 10
        ENDIF
  110 CONTINUE
   10 IM1=IM2-1
      AM = (FM-FMACH(IM1))/(FMACH(IM2)-FMACH(IM1))
C
C DETERMINE FIN NORMAL FORCE RANGE OF STABILITY DATA
      JN2=11
      DO 120 J=2,11
        IF (CNF.LE.AXY(J)) THEN
          JN2=J
          GOTO 20
        ENDIF
  120 CONTINUE
   20 JN1=JN2-1
      AN = (CNF-AXY(JN1))/(AXY(JN2)-AXY(JN1))
C
C CALCULATE STABILITY YCP 
      K=0
      DO 210 I=IM1,IM2
        K=K+1
        DO 220 J=JN1,JN2
          YS(J,I) =YBAR(AXY(J),FMACH(I),AR,TR)
  220   CONTINUE
        YSN(K)  = YS(JN1,I) + AN*(YS(JN2,I)-YS(JN1,I))
  210 CONTINUE
      YCPS = YSN(1) + AM*(YSN(2)-YSN(1))
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCAWN(BLUNT,LOD,MACH,CDW)
C
C***  SUBROUTINE TO DETERMINE THE NOSE WAVE DRAG AT TRANSONIC
C***  SPEEDS USING THE RESULTS OF CHAUSSEE, UNSTEADY EULER
C***  SOLUTION, FROM NSWC TR 80-346, P.28
C***  VALID IN THE MACH RANGE 0.8 TO 1.2.  FROM MACH 0.5 TO 0.8
C***  THE VALUE AT 0.8 IS QUADRATICALLY REDUCED TO ZERO AT
C***  MACH 0.5.  VALUE IS ZERO BELOW MACH 0.5.
C
C***  INPUTS
C
C  BLUNT -- NOSE BLUNTNESS RATIO, RMAX/RTIP
C    LOD -- NOSE FINENESS RATIO, LENGTH/DIAMETER
C   MACH -- FREESTREAM MACH NUMBER
C
C***  OUTPUT
C
C    CDW -- NOSE WAVE/PRESSURE DRAG (NEGLECTING FRICTION)
C
      REAL MACH,LNORB,LOD
      DIMENSION RNORB(11),LNORB(8),AMACH(4),TCDW(352)
      DIMENSION TAB080(88),TAB095(88),TAB105(88),TAB120(88)
      EQUIVALENCE (TCDW(1),  TAB080(1)), (TCDW(89), TAB095(1)),
     1            (TCDW(177),TAB105(1)), (TCDW(265),TAB120(1))
C
      DATA RNORB/0.,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
      DATA LNORB/1.5,2.0,2.5,3.0,4.0,6.0,8.0,10.0/
      DATA AMACH/0.8,0.95,1.05,1.2/
      DATA TAB080/
     1 .040,.038,.037,.035,.032,.028,.023,.018,.015,.030,.092,
     2 .025,.022,.016,.010,.005,.002,.000,.000,.000,.012,.092,
     3 .010,.006,.004,.002,.001,.000,.000,.000,.002,.015,.092,
     4 .000,.000,.000,.000,.000,.000,.000,.001,.005,.019,.092,
     5 .000,.000,.000,.000,.000,.000,.002,.007,.012,.028,.092,
     6 .000,.000,.000,.000,.000,.000,.002,.008,.023,.045,.092,
     7 .000,.000,.000,.002,.005,.010,.015,.022,.037,.055,.092,
     8 .000,.000,.000,.002,.005,.010,.010,.024,.042,.062,.092/
      DATA TAB095/
     1 .160,.197,.203,.203,.198,.189,.180,.167,.154,.150,.279,
     2 .080,.137,.145,.138,.130,.118,.103,.085,.070,.122,.279,
     3 .040,.080,.090,.089,.075,.070,.063,.047,.038,.110,.279,
     4 .015,.052,.062,.062,.050,.042,.034,.028,.033,.116,.279,
     5 .000,.015,.027,.027,.020,.015,.012,.008,.050,.132,.279,
     6 .000,.000,.005,.002,.002,.003,.010,.027,.075,.152,.279,
     7 .000,.000,.002,.002,.004,.015,.018,.055,.088,.160,.279,
     8 .000,.000,.000,.002,.009,.015,.025,.055,.090,.164,.279/
      DATA TAB105/
     1 .280,.333,.335,.333,.329,.322,.313,.300,.285,.270,.405,
     2 .200,.268,.272,.268,.262,.252,.238,.221,.207,.249,.405,
     3 .155,.220,.225,.222,.213,.201,.185,.170,.162,.248,.405,
     4 .135,.165,.175,.175,.167,.152,.135,.130,.157,.249,.405,
     5 .110,.130,.133,.130,.122,.111,.100,.102,.161,.252,.405,
     6 .078,.080,.076,.070,.064,.062,.070,.105,.170,.257,.405,
     7 .055,.050,.045,.043,.047,.055,.070,.105,.177,.262,.405,
     8 .036,.032,.025,.027,.037,.050,.070,.105,.182,.267,.405/
      DATA TAB120/
     1 .419,.457,.468,.470,.468,.460,.448,.458,.418,.414,.550,
     2 .331,.383,.397,.393,.379,.364,.348,.335,.328,.388,.550,
     3 .283,.338,.332,.318,.300,.286,.275,.275,.290,.387,.550,
     4 .247,.280,.273,.260,.245,.231,.223,.232,.285,.387,.550,
     5 .194,.205,.190,.175,.160,.155,.165,.204,.280,.387,.550,
     6 .108,.102,.092,.087,.086,.102,.135,.190,.278,.387,.550,
     7 .065,.060,.050,.048,.063,.095,.130,.185,.275,.387,.550,
     8 .038,.038,.038,.045,.059,.090,.130,.185,.273,.387,.550/
C
      RMACH=MACH
C
C*** CDW=0. IF MACH LESS THAN 0.5
C
      CDW=0.
      IF(MACH.LT.0.5) GO TO 1000
      IF(MACH.LE.0.8) RMACH=0.8
      CALL MVLOOK(4,8,11,352,AMACH,LNORB,RNORB,TCDW,BLUNT,2.*LOD,
     1            RMACH,CDANS)
      CDW=CDANS
C
C*** VARY CDW TO ZERO QUADRATICALLY AT MACH 0.5
C
      IF(MACH.LT.0.8) CDW=CDANS*((1./.09)*(MACH**2-MACH)+0.25/.09)
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CCARD(ISEQ,END,KOL)
C
C***  SUBROUTINE TO TEST FOR LEGAL CONTROL CARDS
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /PARTF/  PARTS(19)
      LOGICAL PARTS
      DIMENSION KOL(80), PART(4), IDIM(3), IDIMT(8), NMLIST(8)
      DIMENSION BUILD(5), NACA(4), DERD(9), DERR(9), KASE(6)
      DIMENSION ISOSE(4),IPRESR(9),IEXTRA(12)
      DIMENSION IWRIE(6),IFORMT(6),INOLAT(6),ICRMT(6),ISPIN(4)
      DIMENSION SAVE(4), NEXT(9), IDMP(5), IDMC(4), TRIM(4), IHYPER(5)
      DIMENSION DAMP(4), NACAT(4), PLOT(4)
      DIMENSION KEYDP(144),  NDP(39)
      DIMENSION KEYARY(40), NDPARY(10)
      DIMENSION KEYINP(39), NDPINP(10)
      DIMENSION KEYIOM(65), NDPIOM(19)
      EQUIVALENCE (KEYDP(  1),KEYARY(1)), (NDP( 1),NDPARY(1))
      EQUIVALENCE (KEYDP( 41),KEYINP(1)), (NDP(11),NDPINP(1))
      EQUIVALENCE (KEYDP( 80),KEYIOM(1)), (NDP(21),NDPIOM(1))
      CHARACTER*4 BUILD, DERD, DERR, SAVE, TRIM, DAMP, PART, PLOT
      CHARACTER*4 IRGEOM,IRAERO,IRTYPE,ISOSE,IEXTRA,IWRIE,IFORMT
      CHARACTER*4 INOLAT,NACA,NACAT,IDIM,IDIMT,NMLIST,KASE,KOL
      CHARACTER*4 IDMP,IDMC,IBLNK,IHYPER,ICRMT,ISPIN,KOMMA,KEYDP
      CHARACTER*4 KEYINP,KEYARY,KEYIOM,IBLANK,NEXT,IPRESR,KAND
      LOGICAL NMTEST,END,DELNMS
C
      DIMENSION IRGEOM(10),IRAERO(10),IRTYPE(47),IRLEN(11)
      DATA IRLEN / 1,5,9,13,17,21,26,32,36,40,45 /
      DATA IRGEOM /
     1 'P   ','R   ','I   ','N   ','T   ','    ',
     2 'G   ','E   ','O   ','M   '/
      DATA IRAERO /
     1 'P   ','R   ','I   ','N   ','T   ','    ',
     2 'A   ','E   ','R   ','O   '/
      DATA IRTYPE /
     1 'B   ','O   ','D   ','Y   ',
     2 'F   ','I   ','N   ','1   ',
     3 'F   ','I   ','N   ','2   ',
     4 'F   ','I   ','N   ','3   ',
     5 'F   ','I   ','N   ','4   ',
     6 'I   ','N   ','L   ','E   ','T   ',
     7 'S   ','Y   ','N   ','T   ','H   ','S   ',
     8 'T   ','R   ','I   ','M   ',
     9 'B   ','E   ','N   ','D   ',
     A 'H   ','I   ','N   ','G   ','E   ','+   ','-   ','*   '/
      DATA ISOSE /'S   ','O   ','S   ','E   '/
      DATA IEXTRA/'P   ','R   ','I   ','N   ','T   ','    ',
     1 'E   ','X   ','T   ','R   ','A   ','P   '/
      DATA IPRESR / 'P   ','R   ','E   ','S   ','S   ',
     1 'U   ','R   ','E   ','S   '/
      DATA IWRIE / 'W   ','R   ','I   ','T   ','E   ','    ' /
      DATA IFORMT/ 'F   ','O   ','R   ','M   ','A   ','T   ' /
      DATA INOLAT/ 'N   ','O   ','    ','L   ','A   ','T   ' /
      DATA BUILD  /'B   ', 'U   ', 'I   ', 'L   ', 'D   ' /
      DATA NACA   /'N   ', 'A   ', 'C   ', 'A   ' /
      DATA NACAT  /'1   ', '2   ', '3   ', '4   '/
      DATA DERD   /'D   ','E   ','R   ','I   ','V   ','    ',
     1             'D   ','E   ','G   '/
      DATA DERR   /'D   ','E   ','R   ','I   ','V   ','    ',
     1             'R   ','A   ','D   '/
      DATA PART   /'P   ','A   ','R   ','T   '/
      DATA IDIM   /'D   ','I   ','M   ' /
      DATA IDIMT  /'F   ','T   ','I   ','N   ','M   ','    ',
     1             'C   ','M   '/
      DATA NMLIST /'N   ','A   ','M   ','E   ','L   ',
     1             'I   ','S   ','T   '/
      DATA KASE   /'C   ','A   ','S   ','E   ','I   ','D   '/
      DATA SAVE   /'S   ','A   ','V   ','E   ' /
      DATA NEXT   /'N   ','E   ','X   ','T   ','    ','C   ','A   ',
     1             'S   ','E   '/
      DATA IDMP   /'D   ','U   ','M   ','P   ','    '/
      DATA IDMC   /'C   ','A   ','S   ','E   '/
      DATA IBLNK  /'    '/,KOMMA /',   '/
      DATA TRIM   /'T   ','R   ','I   ','M   '/
      DATA DAMP   /'D   ','A   ','M   ','P   '/
      DATA PLOT   /'P   ','L   ','O   ','T   '/
      DATA IHYPER /'H   ','Y   ','P   ','E   ','R   '/
      DATA ICRMT  /'I   ','N   ','C   ','R   ','M   ','T   '/
      DATA ISPIN  /'S   ','P   ','I   ','N   '/
C
      DATA NLN / 39 /
C
      DATA KEYARY  /
     1       'G   ','E   ','O   ','B   ','F   ','1   ','G   ','M   ',
     2       'F   ','2   ','G   ','M   ','F   ','3   ','G   ','M   ',
     3       'F   ','4   ','G   ','M   ','A   ','T   ','M   ','P   ',
     4       'B   ','D   ','W   ','K   ','F   ','L   ','C   ','T   ',
     5       'O   ','I   ','N   ','L   ','I   ','N   ','L   ','D   '/
      DATA NDPARY / 10*4 /
C
      DATA KEYINP  /
     1       'I   ','N   ','P   ','T   ','F   ','L   ','T   ','R   ',
     2       'E   ','F   ','Q   ','B   ','D   ','I   ','N   ','F   ',
     3       '1   ','I   ','N   ','F   ','2   ','I   ','N   ','F   ',
     4       '3   ','I   ','N   ','F   ','4   ','I   ','N   ','I   ',
     5       'N   ','L   ','I   ','D   ','I   ','V   ','I   '/
      DATA NDPINP / 4,3,8*4 /
C
      DATA KEYIOM  /
     1       'I   ','O   ','M   ','S   ','B   ','O   ','D   ','S   ',
     2       'F   ','1   ','S   ','F   ','2   ','S   ','F   ','3   ',
     3       'S   ','F   ','4   ','S   ','B   ','1   ','S   ','B   ',
     4       '1   ','2   ','S   ','B   ','1   ','3   ','S   ','B   ',
     5       '1   ','4   ','D   ','B   ','O   ','D   ','D   ','F   ',
     6       '1   ','D   ','F   ','2   ','D   ','F   ','3   ','D   ',
     7       'F   ','4   ','D   ','B   ','1   ','D   ','B   ','1   ',
     8       '2   ','D   ','B   ','1   ','3   ','D   ','B   ','1   ',
     9       '4   '/
      DATA NDPIOM / 3,4,5*3,4*4,5*3,3*4 /
C
      DATA IBLANK / '    ' /
C
      NA = 0
      NB = 0
      ND = 0
C
C***  TEST FOR DELETE CONTROL CARD
C
         IF(DELNMS(KOL,0,ND))GO TO 1620
C
C***  TEST FOR - NEXT CASE
C
      DO 1000 I=1,9
         IF(KOL(I) .NE. NEXT(I)) GO TO 1010
 1000 CONTINUE
         IF(.NOT.END .AND. PARTS(17))WRITE(6,1690)KAND
         IF(.NOT.END)WRITE(8,1700)KAND,(IBLANK,I=1,75)
         IF(.NOT.END)END=.TRUE.
      GO TO 1620
C
C***  TEST FOR - DUMP
C
 1010 DO 1020 I=1,5
         IF(KOL(I) .NE. IDMP(I)) GO TO 1110
 1020 CONTINUE
C
C***  TEST FOR - DUMP CASE
C
      J=1
      DO 1030 L=6,9
         IF(KOL(L) .NE. IDMC(J)) GO TO 1050
      J=J+1
 1030 CONTINUE
C
C***  TEST FOR COLUMNS 10-80 BLANK
C
      DO 1040 I=10,80
         IF(KOL(I) .NE. IBLNK) GO TO 1050
 1040 CONTINUE
      GO TO 1620
C
C***  TEST FOR ARRAY NAMES
C
 1050 I=5
 1060 I=I+1
         IF(I.GT.80) GO TO 1620
         IF(KOL(I) .EQ. IBLNK .OR. KOL(I) .EQ. KOMMA)GO TO 1060
      NS=I
      NCHAR=1
 1070 I=I+1
         IF(I.GT.80)GO TO 1620
         IF(KOL(I) .EQ. IBLNK .OR. KOL(I) .EQ. KOMMA) GO TO 1080
      NCHAR=NCHAR+1
      GO TO 1070
 1080 IF(NCHAR .LT. 7) GO TO 1090
      NA = NA+1
      GO TO 1060
 1090 LOC = 1
      DO 1100 J=1,NLN
         IF(J .GT. 1) LOC = LOC+NDP(J-1)
         IF(NDP(J) .NE. NCHAR) GO TO 1100
         IF(NMTEST(KOL(NS),KEYDP(LOC),NDP(J))) GO TO 1060
 1100 CONTINUE
      NA = NA+1
      GO TO 1060
C
C***  TEST FOR - SAVE
C
 1110 DO 1120 I=1,4
         IF(KOL(I) .NE. SAVE(I)) GO TO 1130
 1120 CONTINUE
      GO TO 1620
C
C***  TEST FOR - CASEID
C
 1130 DO 1140 I=1,6
         IF(KOL(I) .NE. KASE(I)) GO TO 1150
 1140 CONTINUE
      GO TO 1620
C
C***  TEST FOR - TRIM
C
 1150 DO 1160 I=1,4
         IF(KOL(I) .NE. TRIM(I)) GO TO 1170
 1160 CONTINUE
      GO TO 1620
C
C***  TEST FOR - DAMP
C
 1170 DO 1180 I=1,4
         IF(KOL(I) .NE. DAMP(I)) GO TO 1190
 1180 CONTINUE
      GO TO 1620
C
C***  TEST FOR - SPIN
C
 1190 DO 1200 I=1,4
         IF(KOL(I) .NE. ISPIN(I))GO TO 1210
 1200 CONTINUE
      GO TO 1620
C
C***  TEST FOR - BUILD
C
 1210 DO 1220 I=1,5
         IF(KOL(I) .NE. BUILD(I)) GO TO 1230
 1220 CONTINUE
      GO TO 1620
C
C***  TEST FOR - NACA
C
 1230 DO 1240 I=1,4
         IF(KOL(I) .NE. NACA(I)) GO TO 1260
 1240 CONTINUE
      DO 1250 I=1,4
         IF(KOL(6) .EQ. NACAT(I)) GO TO 1620
 1250 CONTINUE
      NB = 1
      GO TO 1620
C
C***  TEST FOR - DERIV DEG
C
 1260 DO 1270 I=1,9
         IF(KOL(I) .NE. DERD(I)) GO TO 1280
 1270 CONTINUE
      GO TO 1620
C
C***  TEST FOR - DERIV RAD
C
 1280 DO 1290 I=1,9
         IF(KOL(I) .NE. DERR(I)) GO TO 1300
 1290 CONTINUE
      GO TO 1620
C
C***  TEST FOR - PART
C
 1300 DO 1310 I=1,4
         IF(KOL(I) .NE. PART(I)) GO TO 1320
 1310 CONTINUE
      GO TO 1620
C
C***  TEST FOR DIMENSION CARD
C
 1320 DO 1330 I=1,3
         IF(KOL(I) .NE. IDIM(I)) GO TO 1340
 1330 CONTINUE
         IF((KOL(5) .EQ. IDIMT(1) .AND. KOL(6) .EQ. IDIMT(2)) .OR.
     1   (KOL(5) .EQ. IDIMT(3) .AND. KOL(6) .EQ. IDIMT(4)) .OR.
     2   (KOL(5) .EQ. IDIMT(5) .AND. KOL(6) .EQ. IDIMT(6)) .OR.
     3   (KOL(5) .EQ. IDIMT(7) .AND. KOL(6) .EQ. IDIMT(8)))
     4   GO TO 1620
C
C***  TEST FOR NAMELIST CARD
C
 1340 DO 1350 I=1,8
         IF(KOL(I) .NE. NMLIST(I)) GO TO 1360
 1350 CONTINUE
      GO TO 1620
C
C***  TEST FOR PLOT CARD
C
 1360 DO 1370 I=1,4
         IF(KOL(I) .NE. PLOT(I)) GO TO 1380
 1370 CONTINUE
      GO TO 1620
C
C***  TEST FOR SOSE CONTROL CARD
C
 1380 DO 1390 I=1,4
         IF(KOL(I) .NE. ISOSE(I)) GO TO 1400
 1390 CONTINUE
      GO TO 1620
C
C***  CHECK FOR PRESSURES CONTROL CARD
C
 1400 DO 1410 I=1,9
         IF(KOL(I) .NE. IPRESR(I)) GO TO 1420
 1410 CONTINUE
      GO TO 1620
C
C***  PRINT EXTRAPOLATION MESSAGES FLAG
C
 1420 DO 1430 I=1,12
         IF(KOL(I) .NE. IEXTRA(I))GO TO 1440
 1430 CONTINUE
      GO TO 1620
C
C***  WRITE CONTROL CARD
C
 1440 DO 1450 I=1,6
         IF(KOL(I) .NE. IWRIE(I))GO TO 1460
 1450 CONTINUE
      GO TO 1620
C
C
 1460 DO 1470 I=1,6
         IF(KOL(I) .NE. IFORMT(I))GO TO 1480
 1470 CONTINUE
      GO TO 1620
C
C***  NOLAT CONTROL CARD
C
 1480 DO 1490 I=1,6
         IF(KOL(I) .NE. INOLAT(I))GO TO 1500
 1490 CONTINUE
      GO TO 1620
C
C***  CHECK FOR INCRMT CONTROL CARD
C
 1500 DO 1510 I=1,6
         IF(KOL(I) .NE. ICRMT(I))GO TO 1520
 1510 CONTINUE
      GO TO 1620
C
C***  CHECK FOR HYPER CONTROL CARD
C
 1520 DO 1530 I=1,5
         IF(KOL(I) .NE. IHYPER(I))GO TO 1540
 1530 CONTINUE
      GO TO 1620
C
C*** CHECK FOR PRINT GEOM CARD
C
 1540 DO 1550 I=1,10
         IF(KOL(I) .NE. IRGEOM(I))GO TO 1560
 1550 CONTINUE
      IMAX=6
      GO TO 1580
C
C*** CHECK FOR PRINT AERO CARD
C
 1560 DO 1570 I=1,10
         IF(KOL(I) .NE. IRAERO(I))GO TO 1610
 1570 CONTINUE
      IMAX=10
C
 1580 CONTINUE
      DO 1600 I=1,IMAX
         IR1=12
         IR2=IR1+IRLEN(I+1)-IRLEN(I)-1
         DO 1590 II=IR1,IR2
            IND=IRLEN(I)+II-IR1
            IF(KOL(II) .NE. IRTYPE(IND))GO TO 1600
 1590    CONTINUE
         GO TO 1620
 1600 CONTINUE
C
C***  CARD NOT FOUND, CHECK FOR SPECIAL PRINT **** CARDS
C
C ... PRINT AERO + OR PRINT GEOM + SUPPRESSES CONERR OUTPUT
C ... UPON DETECTION STOPS ALL CONERR OUTPUT
C ... NORMALLY SET EXTERNAL TO CONERR
C
      IF(KOL(12).EQ.IRTYPE(45))PARTS(17)=.FALSE.
      IF(KOL(12).EQ.IRTYPE(45))GO TO 1620
C
C ... PRINT AERO - OR PRINT GEOM - SUPPRESSES INPUT LISTING
C
      IF(KOL(12).EQ.IRTYPE(46))PARTS(18)=.FALSE.
      IF(KOL(12).EQ.IRTYPE(46))GO TO 1620
C
C ... PRINT AERO * OR PRINT GEOM * SUPPRESSES ALL NORMAL OUTPUT
C
      IF(KOL(12).EQ.IRTYPE(47))PARTS(19)=.FALSE.
      IF(KOL(12).EQ.IRTYPE(47))GO TO 1620
C
 1610 IF(PARTS(17))WRITE(6,1640) ISEQ,(KOL(I),I=1,80)
      GO TO 1630
C
C***  CARD FOUND
C
 1620 NC = NA+NB
         IF(NA .GT. 0 .AND. PARTS(17))
     1   WRITE(6,1650) ISEQ,(KOL(I),I=1,80), NA
         IF(ND .GT. 0 .AND. PARTS(17))
     1   WRITE(6,1710) ISEQ,(KOL(I),I=1,80), ND
         IF(NB .GT. 0 .AND. PARTS(17))WRITE(6,1660) ISEQ,(KOL(I),I=1,80)
         IF(NC .EQ. 0 .AND. PARTS(17))WRITE(6,1670) ISEQ,(KOL(I),I=1,80)
      WRITE(8,1680) (KOL(I),I=1,80)
C
 1630 CONTINUE
C
      RETURN
C***  FORMAT CONTROL CARD
 1640 FORMAT(1X,I3,1X,80A1,/,
     1 8X,'** ERROR ** UNKNOWN CONTROL CARD - IGNORED')
 1650 FORMAT(1X,I3,1X,80A1,/,8X,'** ERROR **',I4,
     1                  ' INCORRECT ARRAY NAMES')
 1660 FORMAT(1X,I3,1X,80A1,/,8X,'** ERROR ** INCORRECT LIFTING',
     1       ' SURFACE DESIGNATION ON NACA CARD')
 1670 FORMAT(1X,I3,1X,80A1)
 1680 FORMAT(80A1)
 1690 FORMAT(6X,A1,'END',18X,'** MISSING NAMELIST TERMINATION ADDED')
 1700 FORMAT(1X,A1,'END',75A1)
 1710 FORMAT(1X,I3,1X,80A1,/,8X,'** ERROR **',I4,
     1                  ' INCORRECT NAMELIST NAMES')
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CVRBOD(ISIGN)
C
C***  ROUTINE TO CONVERT THE DATA IN THE BODY ALONE
C***  DATA BLOCKS BETWEEN THE USER AND FOOT SYSTEM OF UNITS
C
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,TRUNC,
     1                LCENTR,DCENTR,TAFT,LAFT,DAFT,POWER,DISCON(20),
     2                ELLIP(50),H(50),ENOSE,ECENTR,EAFT,DEXIT,
     3                BASE,BETAN,JMACH(20),PRAT(20),TRAT(20),
     4                PROTUB,NPROT,PTYPE(20),XPROT(20),NLOC(20),
     5                BLDMEM(20),BLDTYP(100),LPROT(100),WPROT(100),
     6                HPROT(100),OPROT(100)
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     1  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     2  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     3  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     4                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,
     5  BPNOSE,BCPNOS,BPCENT,BCPCEN,BPAFT,BCPAFT,BPLAN,
     6  BCENTP,ECSPN,ECSPC,ECSPA,ECSPT
C
      REAL    NX,LNOSE,LCENTR,LAFT,LTOTAL,NPROT,NLOC,LPROT,JMACH
      LOGICAL TRUNC,BASE,PROTUB
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHIROL(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      REAL NIN,INTYPE,LDIV
      LOGICAL ICOVER
C
C      
C***  CONVERT BODY INPUTS
C
      CALL CONVRT(XO,1,ISIGN*1)
      CALL CONVRT(X,50,ISIGN*1)
      CALL CONVRT(R,50,ISIGN*1)
      CALL CONVRT(LNOSE,1,ISIGN*1)
      CALL CONVRT(DNOSE,1,ISIGN*1)
      CALL CONVRT(BNOSE,1,ISIGN*1)
      CALL CONVRT(LCENTR,1,ISIGN*1)
      CALL CONVRT(DCENTR,1,ISIGN*1)
      CALL CONVRT(LAFT,1,ISIGN*1)
      CALL CONVRT(DAFT,1,ISIGN*1)
      CALL CONVRT(H,50,ISIGN*1)
      CALL CONVRT(DEXIT,1,ISIGN*1)
      CALL CONVRT(XPROT,20,ISIGN*1)
      CALL CONVRT(LPROT,100,ISIGN*1)
      CALL CONVRT(WPROT,100,ISIGN*1)
      CALL CONVRT(HPROT,100,ISIGN*1)
      CALL CONVRT(OPROT,100,ISIGN*1)
C
C***  CONVERT INLET INPUTS
C
      CALL CONVRT(XINLT,1,ISIGN*1)
      CALL CONVRT(XI,5,ISIGN*1)
      CALL CONVRT(HI,5,ISIGN*1)
      CALL CONVRT(WI,5,ISIGN*1)
C
C***  CONVERT DIVERTER INPUTS
C
      CALL CONVRT(XDIV,1,ISIGN*1)
      CALL CONVRT(HDIV,1,ISIGN*1)
      CALL CONVRT(LDIV,1,ISIGN*1)
C
C
C***  CONVERT CALCULATED BODY DATA
C
      CALL CONVRT(SPNOSE,1,ISIGN*2)
      CALL CONVRT(SWNOSE,1,ISIGN*2)
      CALL CONVRT(VOLNOS,1,ISIGN*3)
      CALL CONVRT(XCVNOS,1,ISIGN*1)
      CALL CONVRT(XCPNOS,1,ISIGN*1)
      CALL CONVRT(THEOLN,1,ISIGN*1)
      CALL CONVRT(SPCENT,1,ISIGN*2)
      CALL CONVRT(SWCENT,1,ISIGN*2)
      CALL CONVRT(VOLCEN,1,ISIGN*3)
      CALL CONVRT(XCVCEN,1,ISIGN*1)
      CALL CONVRT(XCPCEN,1,ISIGN*1)
      CALL CONVRT(THEOLC,1,ISIGN*1)
      CALL CONVRT(SPAFT ,1,ISIGN*2)
      CALL CONVRT(SWAFT ,1,ISIGN*2)
      CALL CONVRT(VOLAFT,1,ISIGN*3)
      CALL CONVRT(XCVAFT,1,ISIGN*1)
      CALL CONVRT(XCPAFT,1,ISIGN*1)
      CALL CONVRT(THEOLA,1,ISIGN*1)
      CALL CONVRT(SPLAN ,1,ISIGN*2)
      CALL CONVRT(SWET  ,1,ISIGN*2)
      CALL CONVRT(VOL   ,1,ISIGN*3)
      CALL CONVRT(XCENTV,1,ISIGN*1)
      CALL CONVRT(XCENTP,1,ISIGN*1)
      CALL CONVRT(DBASE,1,ISIGN*1)
      CALL CONVRT(SBASE,1,ISIGN*2)
      CALL CONVRT(DMAX,1,ISIGN*1)
      CALL CONVRT(SMAX,1,ISIGN*2)
      CALL CONVRT(LTOTAL,1,ISIGN*1)
      CALL CONVRT(BPNOSE,1,ISIGN*2)
      CALL CONVRT(BCPNOS,1,ISIGN*1)
      CALL CONVRT(BPCENT,1,ISIGN*2)
      CALL CONVRT(BCPCEN,1,ISIGN*1)
      CALL CONVRT(BPAFT,1,ISIGN*2)
      CALL CONVRT(BCPAFT,1,ISIGN*1)
      CALL CONVRT(BPLAN,1,ISIGN*2)
      CALL CONVRT(BCENTP,1,ISIGN*1)
      CALL CONVRT(ECSPN,1,ISIGN*1)
      CALL CONVRT(ECSPC,1,ISIGN*1)
      CALL CONVRT(ECSPA,1,ISIGN*1)
      CALL CONVRT(ECSPT,1,ISIGN*1)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE ELLKWB(BEXP,TLES,TTES,CR,TAPER,A,B,PHI,DBE,
     1                  KEWCNL)
C **
C **  COMPUTES THE RATIO OF ELLIPTIC WING-BODY TO EQUIVALENT
C **  AREA CIRCULAR WING-BODY LINEAR FORCE COEFFICIENTS.
C **
C **  REFERENCE --
C **        JORGENSEN,NASA TN D-7228, EQUATIONS (13)-(18)
C **
C **  LIMITATIONS --
C **        SLENDER BODY THEORY-LINEAR CN
C **
C **  NOTE --
C **        INPUT UNITS ON BEXP,CR,A,B,DBE MUST BE CONSISTENT
C **
C **  INPUT --
C **        BEXP  = EXPOSED SPAN (2 PANELS)
C **        TLES  = TANGENT OF LEADING EDGE SWEEP ANGLE
C **        TTES  = TANGENT OF TRAILING EDGE SWEEP ANGLE
C **        CR    = ROOT CHORD AT WING-BODY JUNCTION
C **        TAPER = WING TAPER RATIO
C **        A     = BODY ELLIPSE MAJOR AXIS LENGTH
C **        B     = BODY ELLIPSE MINOR AXIS LENGTH
C **        PHI   = ELLIPSE ORIENTATION (BETWEEN 0 AND 90-DEG)
C **              = 0.0 FOR MAJOR AXIS PERPENDICULAR TO CROSSFLOW
C **                VELOCITY VECTOR
C **              = 90.0 FOR MAJOR AXIS PARALLEL TO CROSSFLOW
C **                VELOCITY VECTOR
C **        DBE   = EQUIVALENT CIRCULAR BODY DIAMETER
C **
C **  OUTPUT --
C **        KEWCNL  = ELLIPTIC BODY-WING LINEAR CN CORRECTION
C **                  FACTOR (FACTOR MULTIPLIES WING CN IN
C **                  PRESENCE OF EQUIVALENT CIRCULAR BODY)
C **
      REAL K,K12,K1,KEWCNL,K2,K22,INTRPL
C **
C ** FUNCTIONS
C **
      RATSCI(S,S2,R,R2)=(S*S2/(3.0*R2)-(R2/S)
     1-S+5.0*R/3)/(S-R)
      RATSBI(A,B,K,S,P)=((1./((S-A)*4.*K**4*A*B))*((K**4+(A+B)**4)
     1*(2./3.*(S**3-A**3)-P*S*K*K+P*A*K*K)+2.*(K**4-(A+B)**4)
     2*(1./3.*((S*S-P*K*K)**1.5-(A*A-P*K*K)**1.5))
     3-(2.*(A+B)**2*(S-A)*K**4)))+A/B
      INTRPL(X1,X2,Y1,Y2,X)=(Y2-Y1)/(X2-X1)*(X-X1)+Y1
      AVE(X1,X2,RAT1,RAT2)=(X1*RAT1+X2*RAT2)/(RAT1+RAT2)
      RATSBC(S2,R2)=S2/R2+R2/S2-1.0
      RATSB(A,B,K12,A2)=(K12+A2)/(A*B)
      AK(SIG1,A,B)=SIG1-(A+B)**2/(4.0*SIG1)
      SIGMA(S,S2,A2,B2)=0.5*(S+SQRT(S2-A2+B2))
C
      KEWCNL=1.
      IF(A .EQ. B .OR. (A. EQ. 0. .OR. B .EQ. 0.))GO TO 1060
C **
C **  SET UP VARIABLES FOR CALCULATIONS
C **
      RBE=0.5*DBE
      SBEXP=0.5*BEXP
      SA=A*0.5
      SB=B*0.5
      RBE2=RBE*RBE
      K=SQRT(SA*SA-SB*SB)
      A2=SA*SA
      B2=SB*SB
      RSBE9=0.0
      RSBEZ=0.0
      RSBE9I=0.0
      RSBEZI=0.0
C **
C **  COMPUTE WING CHORD SEGMENT LENGTHS
C **
      CLEAD=SBEXP*TLES
      CTRAIL=SBEXP*ABS(TTES)
      CMID=CR-CLEAD-CTRAIL
      IF(TTES.LE.0.0) GO TO 1010
C **
C **  HERE IF WING TRAILING EDGE SWEPT AFT
C **
      CT=TAPER*CR
      CMID=CT-CTRAIL
      IF(CMID.LE.0.0) GO TO 1000
C **
C **  HERE IF WING TRAILING EDGE ORIGIN IS BEHIND WING
C **  TIP ORIGIN.
C **
      CTRAIL=0.0
      GO TO 1010
 1000 CONTINUE
C **
C **  HERE IF WING TRAILING EDGE ORIGIN IS FORWARD OF
C **  WING TIP ORIGIN.
C **
      CMID=0.0
      CLEAD=CR
      CTRAIL=0.0
      SBEXP=CR/TLES
C **
 1010 CONTINUE
C **
      CX=CLEAD+CTRAIL
      S=SBEXP+SA
      S2=S*S
      SCIRC=RBE+SBEXP
      SCIRC2=SCIRC*SCIRC
      S90=SBEXP+SB
      S902=S90*S90
      APHI=ABS(PHI)
      ATAPER=ABS(TAPER)
      IF(ATAPER.LT.0.01) GO TO 1030
C **
C **  COMPUTE CONSTANT SPAN PORTION OF CN RATIO
C **
      RSBC=RATSBC(SCIRC2,RBE2)
      IF(APHI.LE.0.1) GO TO 1020
C **
C **  HERE IF PHI IS NOT ZERO
C **
      SIG2=SIGMA(S90,S902,B2,A2)
      K2=AK(SIG2,SB,SA)
      K22=K2*K2
      RSBE9=RATSB(SB,SA,K22,B2)/RSBC
      IF(APHI.GE.89.9) GO TO 1030
 1020 CONTINUE
C **
C **  HERE IF PHI IS NOT 90 DEG.
C **
      SIG1=SIGMA(S,S2,A2,B2)
      K1=AK(SIG1,SA,SB)
      K12=K1*K1
      RSBEZ=RATSB(SA,SB,K12,A2)/RSBC
 1030 CONTINUE
C **
C **  HERE IF WING IS SWEPT
C **
      RSBCI=RATSCI(SCIRC,SCIRC2,RBE,RBE2)
      IF(APHI.LE.0.1) GO TO 1040
C **
C **  HERE IF PHI IS NOT ZERO
C **
      RSBE9I=RATSBI(SB,SA,K,S90,-1.0)/RSBCI
      IF(APHI.GE.89.9) GO TO 1050
 1040 CONTINUE
C **
C **  HERE IF PHI IS NOT 90 DEG.
C **
      RSBEZI=RATSBI(SA,SB,K,S,1.0)/RSBCI
 1050 CONTINUE
C **
C **  COMBINE FACTORS FOR SWEPT AND CONSTANT SPAN PORTIONS
C **   OF WING
C **
      RSBE9=AVE(RSBE9,RSBE9I,CMID,CX)
      RSBEZ=AVE(RSBEZ,RSBEZI,CMID,CX)
C **
C **  COMBINE FACTORS FOR ORIENTATION OF ELLIPSE
C **
      KEWCNL=INTRPL(90.0,0.0,RSBE9,RSBEZ,PHI)
C **
 1060 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FINCM (IM,NFIN)
C      
C***  EXECUTIVE SUBROUTINE TO COMPUTE FIN ALONE PITCHING MOMENT
C      
C***  REFERENCE      NACA TR 1307
C      
C***  INPUT          IM       MACH NUMBER INDEX
C***                 NFIN     FIN SET INDEX
C***  OUTPUT         CMFX     FIN ALONE PITCHING MOMENT WITH RESPECT
C***                          TO XCG AND REFERENCED TO SREF,LREF
C***                             (LABELED COMMON SFINX)
C      
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
C      
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      REAL NALPHA,NMACH,MACH
C      
      COMMON /TOTALC/ BALPHA(20),BBETA(20),BPHI(20),ALPTOT(20)
C      
      COMMON /ABODIN/ BDIN(881)
C      
      COMMON /GEOFC/ FINAR,FINTPR,FINSPN,FINSP,FINWET,TCEFF,
     1               FINXGC,FINYGC,SWAVLE,SWAV25,SWAV50,SWAV75,
     2               SWAVTE,FINCBR,DELTAY,DELTAD,FINPHI,NPANEL,
     3               XLEF,XCENF,CROOT
      REAL NPANEL
C      
      COMMON /F1WORK/ RHO1,TMAX1,KSHAR1,CCLA1(20),XAC1(20),CMCO41(20),
     1                CNALF1,CNAAF1(20),CNLF1(20),CNNLF1(20),CNF1AT(20),
     2                XCPL1,XCPNL1,CMFL1(20),CMFNL1(20),CMF1AT(20),
     3                CAOF1,CANLF1(20),ALPTF1(20),CNFIT1(20),AI1,ALO1,
     4                CLI1,CLM1(20)
      COMMON /F2WORK/ RHO2,TMAX2,KSHAR2,CCLA2(20),XAC2(20),CMCO42(20),
     1                CNALF2,CNAAF2(20),CNLF2(20),CNNLF2(20),CNF2AT(20),
     2                XCPL2,XCPNL2,CMFL2(20),CMFNL2(20),CMF2AT(20),
     3                CAOF2,CANLF2(20),ALPTF2(20),CNFIT2(20),AI2,ALO2,
     4                CLI2,CLM2(20)
      COMMON /F3WORK/ RHO3,TMAX3,KSHAR3,CCLA3(20),XAC3(20),CMCO43(20),
     1                CNALF3,CNAAF3(20),CNLF3(20),CNNLF3(20),CNF3AT(20),
     2                XCPL3,XCPNL3,CMFL3(20),CMFNL3(20),CMF3AT(20),
     3                CAOF3,CANLF3(20),ALPTF3(20),CNFIT3(20),AI3,ALO3,
     4                CLI3,CLM3(20)
      COMMON /F4WORK/ RHO4,TMAX4,KSHAR4,CCLA4(20),XAC4(20),CMCO44(20),
     1                CNALF4,CNAAF4(20),CNLF4(20),CNNLF4(20),CNF4AT(20),
     2                XCPL4,XCPNL4,CMFL4(20),CMFNL4(20),CMF4AT(20),
     3                CAOF4,CANLF4(20),ALPTF4(20),CNFIT4(20),AI4,ALO4,
     4                CLI4,CLM4(20)
C
      COMMON /SFIN1/ CNF1(20),CMF1(20),CAF1(20),CYF1(20),CLNF1(20),
     1               CLLF1(20),CNAF1(20),CMAF1(20),CYBF1(20),
     2               CNBF1(20),CLBF1(20)
      COMMON /SFIN2/ CNF2(20),CMF2(20),CAF2(20),CYF2(20),CLNF2(20),
     1               CLLF2(20),CNAF2(20),CMAF2(20),CYBF2(20),
     2               CNBF2(20),CLBF2(20)
      COMMON /SFIN3/ CNF3(20),CMF3(20),CAF3(20),CYF3(20),CLNF3(20),
     1               CLLF3(20),CNAF3(20),CMAF3(20),CYBF3(20),
     2               CNBF3(20),CLBF3(20)
      COMMON /SFIN4/ CNF4(20),CMF4(20),CAF4(20),CYF4(20),CLNF4(20),
     1               CLLF4(20),CNAF4(20),CMAF4(20),CYBF4(20),
     2                CNBF4(20),CLBF4(20)
      COMMON /GEOFS1/ DM11(170),FNAR1,DM12(8),SWV251,DM13(8)
      COMMON /GEOFS2/ DM21(170),FNAR2,DM22(8),SWV252,DM23(8)
      COMMON /GEOFS3/ DM31(170),FNAR3,DM32(8),SWV253,DM33(8)
      COMMON /GEOFS4/ DM41(170),FNAR4,DM42(8),SWV254,DM43(8)
C      
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C      
      DIMENSION IROUT(2),X(20),R(20)
C      
      EQUIVALENCE (X(1),BDIN(3)),(R(1),BDIN(53))
C      
C***  DETERMINE BODY RADIUS AT FIN ROOT LEADING EDGE
C      
      NX = BDIN(1) + 0.5
      RBOD=0.
      XO=BDIN(2)
      IF(BDIN(1).GT.UNUSED) CALL LNTRP(X,R,NX,XLEF+XO,RBOD)
C      
C***  COMPUTE LINEAR FIN ALONE CENTER OF PRESSURE LOCATION
C      
      IF(SWAVLE .GE. 0.)
     1 CALL FALCP(MACH(IM),2.*FINAR,SWAVLE,FINTPR,XCPFLR)
      IF(SWAVLE .LT. 0.)
     1 CALL FWDXAC(MACH(IM),2.*FINAR,SWAVLE,FINTPR,XCPFLR)
      XCPFL = XLEF+XCPFLR*CROOT
C      
C***  NONLINEAR FIN ALONE CENTER OF PRESSURE LOCATION
C***   (ASSUMED AT GEOMETRIC CENTROID)
C      
      XCPFNL = XLEF+XCENF
C      
C***  COMPUTE LINEAR AND NONLINEAR MOMENT ARMS
C     
      DXL = (XCG-XO)-XCPFL
      DXNL = (XCG-XO)-XCPFNL
C      
C***  ANGLE OF ATTACK LOOP
C      
      NALP = NALPHA + 0.5
C      
      DO 1130 I=1,NALP
C      
C***  GET LINEAR AND NONLINEAR NORMAL FORCE CONTRIBUTIONS
C***  AND CORRECT THE SECTIONAL CMO FOR 3-D EFFECTS AS PER
C***  DATCOM EQ 4.1.4.1-A
C      
      GO TO (1000,1010,1020,1030), NFIN
C      
 1000 CNL = CNLF1(I)
      CNNL= CNNLF1(I)
      CMCO4T=CMCO41(IM)*(FNAR1*(COS(SWV251/RAD))**2/(FNAR1+2
     1       *COS(SWV251/RAD)))
      GO TO 1040
C      
 1010 CNL = CNLF2(I)
      CNNL= CNNLF2(I)
      CMCO4T=CMCO42(IM)*(FNAR2*(COS(SWV252/RAD))**2/(FNAR2+2
     1       *COS(SWV252/RAD)))
      GO TO 1040
C      
 1020 CNL = CNLF3(I)
      CNNL= CNNLF3(I)
      CMCO4T=CMCO43(IM)*(FNAR3*(COS(SWV253/RAD))**2/(FNAR3+2
     1       *COS(SWV253/RAD)))
      GO TO 1040
C      
 1030 CNL = CNLF4(I)
      CNNL= CNNLF4(I)
      CMCO4T=CMCO44(IM)*(FNAR4*(COS(SWV254/RAD))**2/(FNAR4+2
     1       *COS(SWV254/RAD)))
C      
 1040 CONTINUE
C      
C***  COMPUTE FIN ALONE PITCHING MOMENT COEFFICIENT
C      
      CMFL = CNL*DXL/LREF
      CMFNL= CNNL*DXNL/LREF
      CMF  = CMFL + CMFNL + CMCO4T*2.*FINSP*FINCBR/(SREF*LREF)
C      
C***     STORE MOMENT COEFFICIENTS IN WORK ARRAYS
C      
         GO TO (1050,1070,1090,1110),NFIN
C           HERE IF FIN SET 1
 1050    IF(I .NE. 1) GO TO 1060
         XCPL1 = XCPFL
         XCPNL1 = XCPFNL
 1060    CMFL1(I) = CMFL
         CMFNL1(I)= CMFNL
         CMF1AT(I)= CMF
         GO TO 1130
C           HERE IF FIN SET 2
 1070    IF(I .NE. 1) GO TO 1080
         XCPL2 = XCPFL
         XCPNL2= XCPFNL
 1080    CMFL2(I) = CMFL
         CMFNL2(I)= CMFNL
         CMF2AT(I)= CMF
         GO TO 1130
C           HERE IF FIN SET 3
 1090    IF(I .NE. 1) GO TO 1100
         XCPL3 = XCPFL
         XCPNL3= XCPFNL
 1100    CMFL3(I) = CMFL
         CMFNL3(I)= CMFNL
         CMF3AT(I)= CMF
         GO TO 1130
C           HERE IF FIN SET 4
 1110    IF(I .NE. 1) GO TO 1120
         XCPL4 = XCPFL
         XCPNL4= XCPFNL
 1120    CMFL4(I) = CMFL
         CMFNL4(I)= CMFNL
         CMF4AT(I)= CMF
C      
 1130 CONTINUE
C      
C***  INTERPOLATE ALPHA TOTAL DERIVED CURVE AT BODY
C***  ANGLE OF ATTACK FOR STORAGE AND PRINTOUT
C      
      DO 1180 I=1,NALP
         GO TO (1140,1150,1160,1170),NFIN
 1140    CALL LNTRP(ALPTOT,CMF1AT,NALP,BALPHA(I),CMF1(I))
         GO TO 1180
 1150    CALL LNTRP(ALPTOT,CMF2AT,NALP,BALPHA(I),CMF2(I))
         GO TO 1180
 1160    CALL LNTRP(ALPTOT,CMF3AT,NALP,BALPHA(I),CMF3(I))
         GO TO 1180
 1170    CALL LNTRP(ALPTOT,CMF4AT,NALP,BALPHA(I),CMF4(I))
C      
 1180 CONTINUE
C      
      IF(.NOT. PARTS(NFIN+6))GO TO 1190
C      
C***  FIN SET PARTIAL OUTPUT RESULTS
C      
      IF(NFIN .EQ. 1)CALL FPART9(IM,1,NALP,BALPHA,XCPL1,XCPNL1,
     1   XCG,LREF,CMFL1,CMFNL1,CMF1,XO,
     2   CNALF1,CNLF1,CNNLF1,CNF1AT)
      IF(NFIN .EQ. 2)CALL FPART9(IM,2,NALP,BALPHA,XCPL2,XCPNL2,
     1   XCG,LREF,CMFL2,CMFNL2,CMF2,XO,
     2   CNALF2,CNLF2,CNNLF2,CNF2AT)
      IF(NFIN .EQ. 3)CALL FPART9(IM,3,NALP,BALPHA,XCPL3,XCPNL3,
     1   XCG,LREF,CMFL3,CMFNL3,CMF3,XO,
     2   CNALF3,CNLF3,CNNLF3,CNF3AT)
      IF(NFIN .EQ. 4)CALL FPART9(IM,4,NALP,BALPHA,XCPL4,XCPNL4,
     1   XCG,LREF,CMFL4,CMFNL4,CMF4,XO,
     2   CNALF4,CNLF4,CNNLF4,CNF4AT)
C      
 1190 CONTINUE
C      
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HMCP(NSET,FMI,CNI,XCPDH,XCP) 
C***********************************************************************
C
C  THIS ROUTINE ESTIMATES THE FIN CHORDWISE CENTER OF PRESSURE 
C
C   DESCRIPTION OF DATA BASE: 
C
C     1.  FIN DESIGNATIONS AND GEOMETRIES
C
C                  AR\TR \  0.0  \  0.5  \  1.0  \
C                 --------------------------------
C                   0.25 \   I       12      II
C                   0.50 \   31      32      33
C                   1.00 \  III      42      IV
C                   2.00 \   51      52      53
C                   4.00 \   V       62      VI
C
C            NUMBERS INDICATE FIN DESIGNATIONS AND THE ROMAN
C            NUMERALS INDICATE REGIONS OF INTERPOLATION.
C
C     2.  MACH NUMBER, ANGLE OF ATTACK AND FIN ORIENTATION ANGLE RANGES
C
C            MACH  = 0.6,0.8,0.9,1.2,1.5,2.0,2.5,3.0,3.5,4.5
C            ALPHA = 0,2,5,10,15,20,25,30*,35,40,45
C
C            * MAXIMUM ALPHA FOR: 
C                1) MACH LESS THAN 0.8
C                2) MACH LESS THAN 1.2 IF AR < 1.0
C
C  INPUT VARIABLES:
C    NSET    -  FIN SET INDEX
C     FMI    -  FREESTREAM MACH NUMBER
C     CNI    -  FIN NORMAL FORCE COEFFICIENT
C   XCPDH    -  CENTER OF PRESSURE FROM DATCOM HANDBOOK METHOD,
C               USED IF T.E. SWEEP IS NOT EQUAL TO ZERO
C               MEASURED IN CALIBERS FROM C.G. 
C
C  OTHER REQUIRED VARIABLES:
C     AR     -  ASPECT RATIO OF WING ALONE
C     TR     -  FIN TAPER RATIO
C     SP     -  FIN PLANFORM AREA
C  TESWP     -  FIN TRAILING EDGE SWEEP
C    CNF     -  FIN NORMAL FORCE COEFFICIENT REF. TO WING AREA
C
C  CALCULATED:  
C     XCPS   -  FIN CHORDWISE CENTER-OF-PRESSURE LOCATION 
C               MEASURED AFT OF THE LEADING EDGE APEX AND
C               GIVEN AS A FRACTION OF THE ROOT CHORD 
C  OUTPUT:
C     XCP    -  FIN CHORDWISE CENTER-OF-PRESSURE LOCATION MEASURED FROM
C               ORIGIN OF MISSILE COORDINATE SYSTEM
C
C  SUBPROGRAMS USED:  XBAR
C
C  WRITTEN BY  NIELSEN ENGINEERING AND RESEARCH, 8-89 
C              (415) 968-9457 
C
C  REV 3/99 TRI-SERVICE DATA BASE METHOD FOR FIN C.P.
C
C***********************************************************************
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /ABODIN/ BDIN(881)
      COMMON /FSET1/  FDATA1(399)
      COMMON /FSET2/  FDATA2(399)
      COMMON /FSET3/  FDATA3(399)
      COMMON /FSET4/  FDATA4(399)
      COMMON /GEOFS1/  GFIN1(188)
      COMMON /GEOFS2/  GFIN2(188)
      COMMON /GEOFS3/  GFIN3(188)
      COMMON /GEOFS4/  GFIN4(188)
C
      DIMENSION AXY(11),FMACH(10),XS(11,10)
      REAL XSN(2),LREF
C
      DATA AXY/0.,0.2,0.4,0.6,0.8,1.0,1.2,1.4,1.6,1.8,2.0/
      DATA FMACH/.6,.8,.9,1.2,1.5,2.,2.5,3.,3.5,4.5/
C
C  COMPUTE FIN GEOMETRY PARAMETERS
C 
      IF(NSET.EQ.1) THEN
         AR=2.*GFIN1(171)
         TR=   GFIN1(172)
         CR=  FDATA1(52)
         XLE= FDATA1(102)
         TESWP=GFIN1(183)
         SP=   GFIN1(174)
      ELSEIF(NSET.EQ.2) THEN
         AR=2.*GFIN2(171)
         TR=   GFIN2(172)
         CR=  FDATA2(52)
         XLE= FDATA2(102)
         TESWP=GFIN2(183)
         SP=   GFIN2(174)
      ELSEIF(NSET.EQ.3) THEN
         AR=2.*GFIN3(171)
         TR=   GFIN3(172)
         CR=  FDATA3(52)
         XLE= FDATA3(102)
         TESWP=GFIN3(183)
         SP=   GFIN3(174)
      ELSEIF(NSET.EQ.4) THEN
         AR=2.*GFIN4(171)
         TR=   GFIN4(172)
         CR=  FDATA4(52)
         XLE= FDATA4(102)
         TESWP=GFIN4(183)
         SP=   GFIN4(174)
      ENDIF
      XO=BDIN(2)
      CNF=CNI*SREF/(2.*SP)
C
C  SKIP CALCULATIONS IF TRAILING EDGE NOT UNSWEPT
C
      IF(ABS(TESWP).GT.1.) XCP=XCPDH*LREF+XCG
      IF(ABS(TESWP).GT.1.) GO TO 500
C
C DETERMINE MACH NUMBER RANGE OF STABILITY DATA
C
      FM=FMI
      IF(FM.LT.0.4) FM=0.4
      IM2=10
      DO 110 I=2,10
        IF (FM.LE.FMACH(I)) THEN
          IM2=I
          GOTO 10
        ENDIF
  110 CONTINUE
   10 IM1=IM2-1
      AM = (FM-FMACH(IM1))/(FMACH(IM2)-FMACH(IM1))
C
C DETERMINE FIN NORMAL FORCE RANGE OF STABILITY DATA
C
      JN2=11
      DO 120 J=2,11
        IF (CNF.LE.AXY(J)) THEN
          JN2=J
          GOTO 20
        ENDIF
  120 CONTINUE
   20 JN1=JN2-1
      AN = (CNF-AXY(JN1))/(AXY(JN2)-AXY(JN1))
C
C CALCULATE STABILITY XCP 
C
      K=0
      DO 210 I=IM1,IM2
        K=K+1
        DO 220 J=JN1,JN2
          XS(J,I) =XBAR(AXY(J),FMACH(I),AR,TR)
  220   CONTINUE
        XSN(K)  = XS(JN1,I) + AN*(XS(JN2,I)-XS(JN1,I))
  210 CONTINUE
      XCPS = XSN(1) + AM*(XSN(2)-XSN(1))
C
      XCP=XLE+XCPS*CR+XO
  500 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE JAS26(XBI,BETA,RBJM1,XBJM1,XXI,RBI,TAU,F1,F2,CJ,
     1 SUM1,SUM2,SUM3,SUM4,SUM5,SUM6,SIGN,NTERM)
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  ORIGINAL ROUTINE WRITTEN BY F. MOORE, NSWC
C  MODIFIED BY J. JENKINS, WL/FIGC
C
C***  SOLUTION OF J.A.S. EQUATIONS 26
C
      XXI=XBI+BETA*RBJM1-XBJM1
      TAU=BETA*RBI/XXI
      IF(TAU .GE. 1.)TAU=.9999
      F1=ARSECH(TAU)
      F2=SQRT(1.-TAU**2)
      SUM1=SUM1+SIGN*CJ*XXI**2*((1.+.5*TAU**2)*F1-1.5*F2)
      SUM2=SUM2+SIGN*2.*CJ*XXI*(F1-F2)
      SUM3=SUM3-SIGN*BETA*CJ*XXI*(F2/TAU-TAU*F1)
      IF(NTERM .GT. 0 .AND. NTERM .LT. 6)GO TO 1000
      SUM4=SUM4+SIGN*2.*CJ*F1
      SUM5=SUM5-SIGN*2.*BETA*CJ*F2/TAU
      SUM6=SUM6+SIGN*BETA**2*CJ*(F2/TAU**2+F1)
 1000 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE POTAR1(ALP,BET,CNPP,CYPP,CMPP,CLNPP)
C***********************************************************************
C
C     THIS SUBROUTINE TRANSFERS ALPHA AND BETA IN BODY COORDINATES
C     INTO INLET ALPHA AND BETA FOR TOP MOUNTED 2-D INLET.  IT THEN
C     USES THESE LOCAL ANGLES TO CALCULATE INLET AERODYNAMICS.  THE
C     FORCES AND MOMENTS IN INLET COORDINATES ARE THEN TRANSFERRED
C     BACK TO THE BODY COORDINATE SYSTEM.
C
C***********************************************************************
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      DIMENSION DCN(20),DCY(20),DCM(20),DCLN(20),CNI(20),CYI(20)
      DIMENSION CNIXCP(20),CYIXCP(20),CYD(20),CYDXCP(20)
      DIMENSION ALPI(20),BETAI(20)
C
      NUMI=NIN+0.5
      DO 10 I=1,NUMI
        ALPI(I)=-ALP*COS(PHI(I)/RAD)+BET*SIN(PHI(I)/RAD)
        BETAI(I)=-ALP*SIN(PHI(I)/RAD)-BET*COS(PHI(I)/RAD)
  10  CONTINUE
C
      CALL CNPTWO(ALPI,CNI,CNIXCP)
      CALL CYPTWO(BETAI,CYI,CYIXCP)
      IF(HDIV .GT. 0.0)THEN
         CALL CYPDIV(BETAI,CYD,CYDXCP)
      ELSE
         DO 15 I=1,20
           CYD(I) = 0.0
           CYDXCP(I) = 0.0
   15    CONTINUE
      ENDIF
C
      DO 20 I=1,NUMI
        DCN(I)=-CNI(I)*COS(PHI(I)/RAD)+(CYI(I)+CYD(I))*SIN(PHI(I)/RAD)
        DCY(I)=-(CYI(I)+CYD(I))*COS(PHI(I)/RAD)-CNI(I)*SIN(PHI(I)/RAD)
        DCM(I)= CNI(I)*COS(PHI(I)/RAD)*CNIXCP(I)/LREF-
     &          CYI(I)*SIN(PHI(I)/RAD)*CYIXCP(I)/LREF-
     &          CYD(I)*SIN(PHI(I)/RAD)*CYDXCP(I)/LREF
        DCLN(I)=CYI(I)*COS(PHI(I)/RAD)*CYIXCP(I)/BREF+
     &          CNI(I)*SIN(PHI(I)/RAD)*CNIXCP(I)/BREF+
     &          CYD(I)*COS(PHI(I)/RAD)*CYDXCP(I)/BREF
  20  CONTINUE
C
      CNPP=0.0
      CYPP=0.0
      CMPP=0.0
      CLNPP=0.0
      DO 30 I=1,NUMI
        CNPP=CNPP+DCN(I)*KWA(I)
        CYPP=CYPP+DCY(I)*KWB(I)
        CMPP=CMPP+DCM(I)*KWA(I)
        CLNPP=CLNPP+DCLN(I)*KWB(I)
   30 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE RVALUE(KOL,L,NDML,NF,BLANK,COMMA,NUMBER)
C
C***  SUBROUTINE TO TEST FOR REAL VALUES AND SYNTAX
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      DIMENSION KOL(80), NUMBER(15)
      INTEGER FIRST, POWR
      LOGICAL END, SIGN, EXP, STAR, DEC, FLAG
      CHARACTER*4 KOL,BLANK,COMMA,NUMBER,KAND
C
 1000 CONTINUE
      END  = .FALSE.
      SIGN = .FALSE.
      EXP  = .FALSE.
      STAR = .FALSE.
      DEC  = .FALSE.
      MULT = 0
      POWR = 0
 1010 CONTINUE
      FIRST = L
      IF(L .GE. 81) GO TO 1130
      IF(KOL(L) .NE. BLANK) GO TO 1020
        L = L+1
        GO TO 1010
 1020 CONTINUE
      DO 1030 J=1,15
      IF(KOL(L) .EQ. NUMBER(J)) GO TO 1040
 1030 CONTINUE
      J = 16
 1040 CONTINUE
      IF(J .GT. 10) GO TO 1050
        IF(.NOT. STAR) MULT = 10*MULT+J-1
        IF(EXP)        POWR = 10*POWR+J-1
        GO TO 1110
 1050 CONTINUE
      IF(J .GT. 12) GO TO 1060
        IF(SIGN) NF = NF+1
        FLAG = (L .EQ. FIRST) .OR. (KOL(L-1) .EQ. NUMBER(15)) .OR.
     1         (KOL(L-1) .EQ. NUMBER(14))
        IF(.NOT. FLAG) NF = NF+1
        SIGN = .TRUE.
        GO TO 1110
 1060 CONTINUE
      IF(J .GT. 13) GO TO 1070
        IF(DEC) NF = NF+1
        IF(EXP) NF = NF+1
        DEC = .TRUE.
        GO TO 1110
 1070 CONTINUE
      IF(J .GT. 14) GO TO 1080
        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 1110
 1080 CONTINUE
      IF(J .GT. 15 .OR. L .EQ. FIRST) GO TO 1090
        IF(.NOT. DEC) NF = NF+1
        IF(EXP)       NF = NF+1
        EXP  = .TRUE.
        SIGN = .FALSE.
        GO TO 1110
 1090 CONTINUE
      IF(KOL(L) .NE. BLANK) GO TO 1100
        NF = NF+1
        GO TO 1110
 1100 CONTINUE
      IF(KOL(L) .EQ. KAND .AND. L .EQ. FIRST) GO TO 1130
      IF(KOL(L) .NE. COMMA .AND. KOL(L) .NE. KAND) GO TO 1130
        END = .TRUE.
C
C***  NUMERIC CHARACTER FOUND
C
 1110 CONTINUE
      IF(L .EQ. FIRST .AND. EXP) GO TO 1130
      IF(END) GO TO 1120
        L = L+1
        GO TO 1020
 1120 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 1130
        L = L+1
        GO TO 1000
C
C***  NON-NUMERIC CHARACTER FOUND OR END OF CARD
C
 1130 CONTINUE
      IF(NDML .EQ. 0) NF = NF+1
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SYNPAR(IM,NA,ALP,NSETS,NFIN,XCPWA,YCPFIN,AFACT)
C
C***  PRINT CONFIGURATION SYNTHESIS PARTIAL OUTPUT DATA
C
      COMMON /PAERO/  AKBW(4),AKWB(4),AKKBW(4),AKKWB(4),XCPBW(4),
     1                XCPWB(4),DAQ(8,20,4),WAQ(8,20,4),
     2                CNW(8,20,4),CLW(8,20,4),CNWB(20,4),CMWB(20,4),
     3                CAWB(20,4),CYWB(20,4),CSNWB(20,4),CSLWB(20,4),
     4                CNBW(20,4),CMBW(20,4),CABW(20,4),CYBW(20,4),
     5                CSNBW(20,4),CSLBW(20,4),CN(20,4),CM(20,4),
     6                CA(20,4),CY(20,4),CSN(20,4),CSL(20,4)
C
      LOGICAL NDUM,NMF,NAF
      DIMENSION NFIN(4),ALP(NA),XCPWA(4),YCPFIN(20,4),AFACT(20,4)
C***
C***  FINS IN PRESENCE OF THE BODY AERODYNAMICS
C***
      DO 1020 ISET=1,NSETS
         CALL HEADR9
         WRITE(6,1060)
         CALL PRFLC9(IM,NDUM,NMF,NAF)
         NFINS=NFIN(ISET)
         WRITE(6,1070)ISET
         WRITE(6,1080)
         DO 1010 I=1,NA
            IFIN=1
            WRITE(6,1100) ALP(I),CNWB(I,ISET),CMWB(I,ISET),CAWB(I,ISET),
     1         CYWB(I,ISET),CSNWB(I,ISET),CSLWB(I,ISET)
 1010    CONTINUE
 1020 CONTINUE
C
C***  INDIVIDUAL PANEL ALPHA-EQUIVALENT AND NORMAL FORCE VALUES
C
      DO 1040 ISET=1,NSETS
         CALL HEADR9
         WRITE(6,1060)
         CALL PRFLC9(IM,NDUM,NMF,NAF)
         WRITE(6,1075)ISET
         WRITE(6,1090)
         DO 1045 II=1,NA
            DO 1000 IFIN=1,NFINS
               WRITE(6,1110) ALP(II),IFIN,WAQ(IFIN,II,ISET),
     1                       CNW(IFIN,II,ISET)
 1000       CONTINUE
      WRITE(6,*)
 1045    CONTINUE
 1040 CONTINUE
C***
C***  CARRYOVER INTERFERENCE FACTORS AND PANEL CENTERS OF PRESSSURE
C***
      DO 1050 ISET=1,NSETS
      CALL HEADR9
      WRITE(6,1060)
      CALL PRFLC9(IM,NDUM,NMF,NAF)
      WRITE(6,1190) ISET
      WRITE(6,1200)
         DO 1055 I=1,NA
            AKWBA=AKWB(ISET)*AFACT(I,ISET)
            WRITE(6,1210) ALP(I),AKWBA,AKBW(ISET),AKKWB(ISET),
     1      AKKBW(ISET),XCPWB(ISET),XCPBW(ISET),YCPFIN(I,ISET)
 1055    CONTINUE
 1050 CONTINUE
      WRITE(6,1300)
C***
C***  FORMATS
C***
 1060 FORMAT(17X,'AERODYNAMIC FORCE AND MOMENT SYNTHESIS',/)
 1070 FORMAT(10X,'---------------FIN SET ',I1,
     1 ' IN PRESENCE OF THE BODY----------------',/)
 1075 FORMAT(10X,'---------------FIN SET ',I1,
     1 ' PANEL CHARACTERISTICS------------------',/)
 1080 FORMAT(6X,'ALPHA',7X,'CN',9X,'CM',9X,'CA',9X,'CY',
     1 9X,'CLN',8X,'CLL',/)
 1090 FORMAT(6X,'ALPHA',6X,'PANEL',4X,'AEQ (PANEL AXIS SYS.)',
     1       4X,'PANEL CN',/)
 1100 FORMAT(4X,F7.2,6F11.4)
 1110 FORMAT(4X,F7.2,7X,I2,9X,F11.4,6X,F11.4)
 1190 FORMAT(4X,9X,'CARRYOVER INTERFERENCE FACTORS - FIN SET',I2,/)
 1200 FORMAT(6X,'ALPHA',3X,'K-W(B)',3X,'K-B(W)',2X,'KK-W(B)',2X,
     1 'KK-B(W)',2X,'XCP-W(B)',1X,'XCP-B(W)',1X,'Y-CP/(B/2)',/)
 1210 FORMAT(4X,F7.2,7F9.4)
 1300 FORMAT(/,4X,'NOTE - XCP-W(B) USED FOR STABILITY ONLY',
     1       ' DIFFERENT VALUES USED FOR HINGE MOMENTS') 
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE YCPAIL(AR,TAPER,MACH,SWEEP,SSPAN,CFOC,YUP,CLD,YCP)
C
C  SUBROUTINE TO COMPUTE LATERAL C.P. WITH FLAP DEFLECTION
C  METHOD USES DATCOM SECTION 6.2.1.1 
C
C  WRITTEN BY W. BLAKE, WL/FIGC
C
C  VARIABLES
C
C  MACH  - MACH NUMBER
C  AR    - FIN ASPECT RATIO
C  TAPER - FIN TAPER RATIO
C  SWEEP - FIN LEADING EDGE SWEEP
C  SSPAN - FIN SEMI-SPAN STATIONS (10)
C  CFOC  - FLAP CHORD RATIO VALUES AT EACH SEMI-SPAN STATION (10)
C  YUP   - AIRFOIL SURFACE COORDINATES (50)
C  CLD   - FLAP LIFT EFFECTIVENESS DERIVATIVE
C  YCP   - LATERAL CENTER OF PRESSURE WITH FLAP DEFLECTION
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      REAL MACH
      DIMENSION SSPAN(10),CFOC(10),YUP(50)
      DIMENSION X11123(3),X21123(4),X31123(11),X41123(3),
     1          F21123(3),Y1(44),Y2(44),Y3(44),Y4(44),Y5(44),Y6(44),
     2          Y7(44),Y8(44),Y9(44),YA(132),YB(132),YC(132)
      EQUIVALENCE (Y1(1),YA(1)),(Y2(1),YA(45)),(Y3(1),YA(89)),
     1            (Y4(1),YB(1)),(Y5(1),YB(45)),(Y6(1),YB(89)),
     2            (Y7(1),YC(1)),(Y8(1),YC(45)),(Y9(1),YC(89))
C
C                  FIGURE 6.2.1.1-23A-C
C
      DATA X31123
     1 / 0., .1, .2, .3,  .4, .5, .6, .7, .8, .9, 1. /
      DATA X21123
     1 / -40., 0., 40., 60. /
      DATA X11123
     1 / 2., 4., 8. /
      DATA X41123
     1 / 0., 0.5, 1. /
      DATA Y1
     1 / 0.000,  0.005,  0.014,  0.030,  0.055,  0.087,  0.126,
     2   0.163,  0.197,  0.222,  0.245,
     3   0.000,  0.005,  0.017,  0.036,  0.063,  0.100,  0.144,
     4   0.185,  0.224,  0.262,  0.282,
     5   0.000,  0.005,  0.017,  0.036,  0.064,  0.103,  0.149,
     6   0.192,  0.230,  0.264,  0.282,
     7   0.000,  0.005,  0.017,  0.036,  0.062,  0.098,  0.136,
     8   0.178,  0.215,  0.243,  0.259 /
      DATA Y2
     1 / 0.000,  0.007,  0.027,  0.054,  0.097,  0.145,  0.197,
     2   0.243,  0.292,  0.333,  0.363,
     3   0.000,  0.008,  0.029,  0.064,  0.113,  0.173,  0.235,
     4   0.300,  0.363,  0.414,  0.445,
     5   0.000,  0.008,  0.029,  0.064,  0.119,  0.180,  0.245,
     6   0.313,  0.374,  0.417,  0.443,
     7   0.000,  0.008,  0.029,  0.063,  0.108,  0.163,  0.220,
     8   0.273,  0.319,  0.350,  0.363 /
      DATA Y3
     1 / 0.000,  0.006,  0.032,  0.080,  0.145,  0.212,  0.275,
     2   0.336,  0.394,  0.446,  0.485,
     3   0.000,  0.012,  0.043,  0.093,  0.165,  0.255,  0.354,
     4   0.445,  0.525,  0.587,  0.627,
     5   0.000,  0.013,  0.045,  0.106,  0.189,  0.280,  0.375,
     6   0.465,  0.542,  0.592,  0.612,
     7   0.000,  0.013,  0.045,  0.106,  0.187,  0.258,  0.327,
     8   0.390,  0.443,  0.475,  0.485 /
      DATA Y4
     1 / 0.000,  0.006,  0.017,  0.038,  0.066,  0.100,  0.142,
     2   0.185,  0.232,  0.273,  0.293,
     3   0.000,  0.007,  0.023,  0.048,  0.079,  0.114,  0.154,
     4   0.200,  0.249,  0.284,  0.311,
     5   0.000,  0.007,  0.023,  0.048,  0.079,  0.114,  0.154,
     6   0.198,  0.240,  0.276,  0.304,
     7   0.000,  0.007,  0.023,  0.043,  0.072,  0.106,  0.148,
     8   0.190,  0.232,  0.264,  0.286 /
      DATA Y5
     1 / 0.000,  0.006,  0.025,  0.060,  0.100,  0.151,  0.214,
     2   0.294,  0.370,  0.430,  0.479,
     3   0.000,  0.009,  0.033,  0.075,  0.125,  0.185,  0.259,
     4   0.348,  0.427,  0.491,  0.538,
     5   0.000,  0.009,  0.033,  0.075,  0.125,  0.185,  0.259,
     6   0.340,  0.413,  0.472,  0.515,
     7   0.000,  0.008,  0.026,  0.065,  0.113,  0.170,  0.231,
     8   0.294,  0.350,  0.398,  0.432 /
      DATA Y6
     1 / 0.000,  0.007,  0.034,  0.072,  0.125,  0.187,  0.270,
     2   0.371,  0.480,  0.580,  0.662,
     3   0.000,  0.014,  0.052,  0.108,  0.180,  0.275,  0.390,
     4   0.510,  0.620,  0.718,  0.800,
     5   0.000,  0.014,  0.052,  0.113,  0.190,  0.280,  0.385,
     6   0.485,  0.578,  0.658,  0.729,
     7   0.000,  0.014,  0.052,  0.103,  0.163,  0.234,  0.308,
     8   0.379,  0.445,  0.504,  0.554 /
      DATA Y7
     1 / 0.000,  0.003,  0.015,  0.037,  0.065,  0.103,  0.147,
     2   0.190,  0.237,  0.280,  0.306,
     3   0.000,  0.004,  0.020,  0.045,  0.079,  0.118,  0.159,
     4   0.205,  0.252,  0.291,  0.315,
     5   0.000,  0.004,  0.020,  0.045,  0.079,  0.114,  0.156,
     6   0.200,  0.246,  0.286,  0.310,
     7   0.000,  0.004,  0.020,  0.045,  0.073,  0.108,  0.147,
     8   0.187,  0.230,  0.268,  0.291 /
      DATA Y8
     1 / 0.000,  0.008,  0.033,  0.063,  0.108,  0.162,  0.225,
     2   0.303,  0.389,  0.453,  0.500,
     3   0.000,  0.008,  0.033,  0.072,  0.122,  0.187,  0.260,
     4   0.348,  0.437,  0.504,  0.558,
     5   0.000,  0.008,  0.033,  0.072,  0.122,  0.187,  0.258,
     6   0.335,  0.413,  0.474,  0.522,
     7   0.000,  0.008,  0.033,  0.070,  0.110,  0.165,  0.229,
     8   0.290,  0.347,  0.400,  0.445 /
      DATA Y9
     1 / 0.000,  0.010,  0.035,  0.070,  0.118,  0.192,  0.291,
     2   0.405,  0.520,  0.626,  0.721,
     3   0.000,  0.014,  0.049,  0.104,  0.179,  0.275,  0.393,
     4   0.520,  0.653,  0.768,  0.850,
     5   0.000,  0.014,  0.050,  0.109,  0.186,  0.284,  0.393,
     6   0.505,  0.602,  0.690,  0.763,
     7   0.000,  0.014,  0.040,  0.094,  0.155,  0.230,  0.306,
     8   0.380,  0.458,  0.519,  0.578 /
C      
      IBEGIN=0
      IEND=10
      NSTA=1
      BETA=SQRT(1.-MACH**2)
      BAR=BETA*AR
      TANC4=TAN(SWEEP/RAD)-1./AR*(1.-TAPER)/(1.+TAPER)
      SWEEPB=ATAN(TANC4/BETA)*RAD
      TANPHE=(YUP(45)-YUP(49))/2./0.09
C
C     DETERMINE THE NUMBER OF SPAN STATIONS INPUT
C     AND CALCULATE THE INBOARD AND OUTBOARD FLAP POSITIONS
C      
      DO 1000 I=1,10
        IF(SSPAN(I) .NE. UNUSED)NSTA = I
 1000 CONTINUE
      BOVER2 = SSPAN(NSTA) - SSPAN(1)
      DO 1100 I=1,NSTA
        IF(CFOC(I) .GT. UNUSED .AND. IBEGIN .EQ. 0)IBEGIN=I
        IF(CFOC(I) .GT. UNUSED .AND. IBEGIN .NE. 0)IEND = I
 1100 CONTINUE
      ETAI=(SSPAN(IBEGIN)-SSPAN(1))/BOVER2
      ETAO=(SSPAN(IEND)-SSPAN(1))/BOVER2
C
C  ROLLING MOMENT CALCULATIONS
C
      T=0.
 2000 CONTINUE
      ETA=ETAI
      IF(T.EQ.1.) ETA=ETAO
C
C  TAPER RATIO = 0 TABLE LOOK-UP
C
      CALL MVLOOK(3,4,11,132,X11123,X21123,X31123,YA,
     1            ETA,SWEEPB,BAR,ANSD)
C
C  TAPER RATIO = 0.5 TABLE LOOK-UP
C
      CALL MVLOOK(3,4,11,132,X11123,X21123,X31123,YB,
     1            ETA,SWEEPB,BAR,ANS5)
C
C  TAPER RATIO = 1 TABLE LOOK=UP
C
      CALL MVLOOK(3,4,11,132,X11123,X21123,X31123,YC,
     1            ETA,SWEEPB,BAR,ANS1)
C
C  INBOARD SEGMENT
C
      IF(T.EQ.1.) GO TO 2100
         IF(TAPER.LT.0.5) ANSI=ANSD+(ANSD-ANS5)*TAPER/0.5
         IF(TAPER.GE.0.5) ANSI=ANS5+(ANS1-ANS5)*(TAPER-0.5)/0.5
      T=1.
      GO TO 2000
C
C  OUTBOARD SEGMENT
C
 2100 CONTINUE
         IF(TAPER.LT.0.5) ANSO=ANSD+(ANSD-ANS5)*TAPER/0.5
         IF(TAPER.GE.0.5) ANSO=ANS5+(ANS1-ANS5)*(TAPER-0.5)/0.5
C
C  CALCULATE EFFECTIVE CFOC, 2-D FLAP EFFECTIVENESS
C
      TOP=TAPER+(1.-TAPER)*(1.-(SSPAN(IEND)-SSPAN(1))/BOVER2)
      BOT=TAPER+(1.-TAPER)*(1.-(SSPAN(IBEGIN)-SSPAN(1))/BOVER2)
      FTAP=TOP/BOT
      CFOCE=(CFOC(IBEGIN)+FTAP*CFOC(IEND)) / (1.+FTAP)
      CALL FLAP2(CFOCE,TANPHE,ADEL)
      CLDPRM=(ANSO-ANSI)/BETA
      CLDEL=CLDPRM*ABS(ADEL)
C
C  YCP = CL-DELTA (ROLL) / CL-DELTA (LIFT)
C
      CLDL=0.5*CLD
      YCP=CLDEL/CLDL
      IF(YCP.GT.0.95) YCP=0.95
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCDRV(TAFT,DCENTR,DAFT,LAFT,MACH,LTHEO,CAPBT)
C
C***   THIS ROUTINE CONTROLS CALCULATION OF SUBSONIC/TRANSONIC
C***   BOATTAIL PRESSURE DRAG.
C
C***   INPUTS
C
C***       TAFT -- SHAPE PARAMETER.
C***               .EQ. 0.    USE CONICAL METHOD
C***               .NE. 0.    USE OGIVAL METHOD
C***     DCENTR -- FORWARD BOATTAIL DIAMETER
C***       DAFT -- AFT BOATTAIL DIAMETER
C***       LAFT -- LENGTH OF AFTERBODY
C***       MACH -- FREESTREAM MACH NUMBER
C***      LTHEO -- THEORETICAL LENGTH OF BOATTAIL
C
C***   OUTPUT
C
C***      CAPBT -- PRESSURE DRAG INCREMENT TO AXIAL FORCE BASED ON
C***               MAXIMUM CROSS-SECTIONAL AREA
C
      REAL MACH,LAFT,LTHEO
C
C***  SELECT CONICAL METHOD
C
      IF(TAFT.EQ.0.) CALL BDCAP1(DCENTR,DAFT,LAFT,MACH,LTHEO,CAPBT)
C
C***  SELECT OGIVAL METHOD
C
      IF(TAFT.NE.0.) CALL BDCAP2(DCENTR,DAFT,LAFT,MACH,LTHEO,CAPBT)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CDCS(ALPHA,RE,CHARL,MACH,CDC)
C
C***  SUBROUTINE TO CALCULATE CROSSFLOW DRAG COEFFICIENT
C***  USING THE METHOD OF JORGENSEN (NASA TN D-6996, FIGS. 1,2,3)
C
C***  BAKER REPORT AEDC-TR-75-124 USED AS GUIDE IN DATA FAIRING
C
C***  INPUTS
C
C ALPHA - ANGLE OF ATTACK, DEG.
C    RE - REYNOLDS NUMBER PER FOOT
C CHARL - CHARACTERISTIC LENGTH, FEET
C  MACH - FREESTREAM MACH NUMBER
C
C***  OUTPUT
C
C   CDC - CROSS FLOW DRAG COEFFICIENT
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
C
      REAL MACHC,MACH
C
      DIMENSION X1(20),TAB1(20),X4(6),TAB4(6),X2(12),TAB2(12),
     1          X3(10),TAB3(10,5),TMACH(5)
C
C ... DATA FOR FIGURE 1, UPPER CURVE (CDC VERSUS CROSS FLOW MACH)
C     DATA IN MACH RANGE .8 TO 1.5 ALTERED TO REFLECT BAKER CORRELATION
C
      DATA X1/0.,.4,.5,.6,.7,.8,.9,1.,1.1,1.2,1.3,1.4,1.5,1.6,
     1        1.8,2.0,2.2,2.8,4.0,4.8/
      DATA TAB1/1.2,1.29,1.36,1.50,1.50,1.50,1.41,1.35,1.32,1.28,
     1          1.25,1.23,1.21,1.20,1.20,1.20,1.20,1.20,1.20,1.20/
C
C ... DATA FOR FIGURE 1, LOWER CURVE (CDC VERSUS CROSS FLOW MACH)
C     ALTERED TO REFLECT BAKER AND MARTIN CORRELATIONS
C
      DATA X4/0.,.1,.2,.3,.4,.5/
      DATA TAB4/.28,.38,.48,.74,1.0,1.36/
C
C ... DATA FOR FIGURE 2 (CDC VERSUS LOG10 REYNOLDS NUMBER)
C
      DATA X2/4.0,4.5441,4.9542,5.1761,5.5563,5.6021,5.6990,5.7782,
     1        5.8451,5.9542,6.0,7.0/
      DATA TAB2/1.2,1.2,1.22,1.22,.72,.63,.26,.25,.26,.28,.29,.64/
C
C ... DATA FOR FIGURE 3 (CDC VERSUS LOG10 REYNOLDS NUMBER)
C
      DATA X3/6.0,6.301,6.4771,6.6021,6.699,6.7782,6.8451,6.9031,
     1        6.9542,7.0/
      DATA TAB3/.20,.45,.54,.59,.60,.59,.58,.55,.53,.52,
     1          .20,.45,.54,.59,.60,.59,.58,.55,.53,.52,
     2          .30,.48,.56,.60,.62,.61,.605,.60,.59,.58,
     3          .30,.45,.53,.60,.64,.69,.70,.64,.62,.60,
     4          .50,.53,.57,.60,.64,.69,.76,.88,.67,.63/
      DATA TMACH/0.00,0.25,0.30,0.35,0.40/
C
      MACHC=MACH*SIN(ABS(ALPHA)/RAD)
      REC=RE*CHARL*SIN(ABS(ALPHA)/RAD)
C
C***  CURVE SELECTION LOGIC
C
C     IF(MACHC-0.4)1000,1000,1030
C1000 IF(REC-1.E+4) 1060,1060,1010
C1010 IF(REC-1.E+6) 1070,1070,1020
C1020 IF(REC-1.E+7) 1080,1080,1040
C1030 IF(MACHC-0.5)1050,1050,1040
C
      IF(BLAYER.EQ.1.) GO TO 1030
C
C  TURBULENT BOUNDARY LAYER, INTERPOLATE DATA FOR FIGURE 1
C
      CALL LNTRP(X1,TAB1,20,MACHC,CDC1)
      CALL LNTRP(X4,TAB4,6,MACHC,CDC2)
      IF(MACHC.GE.0.5) CDC=CDC1
      IF(MACHC.LT.0.5) CDC=CDC2+0.5*(CDC1-CDC2)
      GO TO 1090
 1030 CONTINUE
C
C  NATURAL TRANSITION, USE MACHC AND REC CHARTS
C
      IF(MACHC.LE.0.4) GO TO 1000
      IF(MACHC.LT.0.5.AND.REC.GT.1.E+5) GO TO 1050
C
C ... MACHC > 0.5,  USING DATA FOR FIGURE 1, UPPER
C
 1040 CALL LNTRP(X1,TAB1,20,MACHC,CDC)
      GO TO 1090
C
C ... 0.4 < MACHC < 0.5, USING DATA FOR FIGURE 1, LOWER
C
 1050 CALL LNTRP(X4,TAB4,6,MACHC,CDC)
      GO TO 1090
C
C ... MACHC < 0.4, USE REC FOR CDC CALCULATION
C
 1000 IF(REC.GT.1.E+4.AND.REC.LE.1.E+6) GO TO 1070
      IF(REC.GT.1.E+6) GO TO 1080
C
C ... REC < 1.E+4, SHORT CIRCUIT FIGURE 2, USE CDC=1.2
C
 1060 CDC=1.2
      GO TO 1090
C
C ... 1E+4 < REC < 1E+6, USING DATA FOR FIGURE 2
C
 1070 CALL LNTRP(X2,TAB2,12,ALOG10(REC),CDC)
      GO TO 1090
C
C ... REC > 1E+6, USING DATA FOR FIGURE 3
C
 1080 IF(REC.GT.1.E+7) GO TO 1040
      CALL MVLOOK(1,5,10,50,0.,TMACH,X3,TAB3,ALOG10(REC),MACHC,0.,CDC)
C
 1090 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CVRFIN(ISIGN)
C
C***  ROUTINE TO CONVERT THE DATA IN THE FIN ALONE
C***  DATA BLOCKS BETWEEN THE USER AND FOOT SYSTEM OF UNITS
C
      COMMON /FSET1/  FDATA(399)
      COMMON /FSET2/  FDATA2(399)
      COMMON /FSET3/  FDATA3(399)
      COMMON /FSET4/  FDATA4(399)
C
      COMMON /GEOFS1/ GFIN(188)
      COMMON /GEOFS2/ GFIN2(188)
      COMMON /GEOFS3/ GFIN3(188)
      COMMON /GEOFS4/ GFIN4(188)
C
      COMMON /INCID/  DELTAS(32),XHINGE(4),SKEW(4)
C
      DIMENSION SSPAN(10),LMAXU(10),LFLATU(10),LMAXL(10),
     1          LFLATL(10),CHORD(10),THICKU(10),THICKL(10),
     2          SWEEP(10),STA(10),XLE(10),
     3          XCORD(50),MEAN(50),THICK(50),YUPPER(50),
     4          YLOWER(50),LER(10)
C
      REAL LER,LMAXU,LMAXL,LFLATU,LFLATL,NPANEL,MEAN
C
      EQUIVALENCE (FDATA(1),SECTYP),(FDATA(2),SSPAN(1)),
     1            (FDATA(12),LMAXU(1)),(FDATA(22),LFLATU(1)),
     2            (FDATA(32),LMAXL(1)),(FDATA(42),LFLATL(1)),
     3            (FDATA(52),CHORD(1)),(FDATA(62),THICKU(1)),
     4            (FDATA(72),THICKL(1)),(FDATA(82),SWEEP(1)),
     5            (FDATA(92),STA(1)),(FDATA(102),XLE(1)),
     6            (FDATA(112),NPANEL),(FDATA(113),XCORD(1)),
     7            (FDATA(163),MEAN(1)),(FDATA(213),THICK(1)),
     8            (FDATA(263),YUPPER(1)),(FDATA(313),YLOWER(1)),
     9            (FDATA(363),FINPHI),(FDATA(364),LER(1))
C
      DIMENSION SPLANF(10),CBAR(10),SWEPLE(10),SWEP25(10),
     1          SWEP50(10),SWEP75(10),SWEPTE(10),
     2          XMGCLE(10),XMGC25(10),
     3          XMGC50(10),XMGC75(10),XMGCTE(10),YMEANC(10),
     4          ASPCT(10),TAPER(10),TOVERC(10),XCENT(10)
C
      EQUIVALENCE (GFIN(1),SPLANF(1)),(GFIN(11),CBAR(1)),
     1            (GFIN(21),SWEPLE(1)),(GFIN(31),SWEP25(1)),
     2            (GFIN(41),SWEP50(1)),(GFIN(51),SWEP75(1)),
     3            (GFIN(61),SWEPTE(1)),(GFIN(71),XMGCLE(1)),
     4            (GFIN(81),XMGC25(1)),(GFIN(91),XMGC50(1)),
     5            (GFIN(101),XMGC75(1)),(GFIN(111),XMGCTE(1)),
     6            (GFIN(121),YMEANC(1)),(GFIN(131),ASPCT(1)),
     7            (GFIN(141),TAPER(1)),(GFIN(151),TOVERC(1)),
     8            (GFIN(161),XCENT(1)),(GFIN(171),FINAR),
     9            (GFIN(172),FINTPR),(GFIN(173),FINSPN),
     A            (GFIN(174),FINSP),(GFIN(175),FINWET),
     B            (GFIN(176),TCEFF),(GFIN(177),FINXGC),
     C            (GFIN(178),FINYGC),(GFIN(179),SWAVLE),
     D            (GFIN(180),SWAV25),(GFIN(181),SWAV50),
     E            (GFIN(182),SWAV75),(GFIN(183),SWAVTE),
     F            (GFIN(184),FINCBR),(GFIN(185),DELTAY),
     G            (GFIN(186),DELTAD),(GFIN(187),XCENF),(GFIN(188),XOVC)
C
C***  CONVERT FIN DATA
C
      CALL CONVRT(FDATA(2),10,ISIGN*1)
      CALL CONVRT(FDATA(52),10,ISIGN*1)
      CALL CONVRT(FDATA(102),10,ISIGN*1)
      CALL CONVRT(FDATA(364),10,ISIGN*1)
      CALL CONVRT(GFIN(1),10,ISIGN*2)
      CALL CONVRT(GFIN(11),10,ISIGN*1)
      CALL CONVRT(GFIN(71),60,ISIGN*1)
      CALL CONVRT(GFIN(161),10,ISIGN*1)
      CALL CONVRT(GFIN(173),1,ISIGN*1)
      CALL CONVRT(GFIN(174),2,ISIGN*2)
      CALL CONVRT(GFIN(177),2,ISIGN*1)
      CALL CONVRT(GFIN(184),1,ISIGN*1)
      CALL CONVRT(GFIN(187),1,ISIGN*1)
      CALL CONVRT(FDATA2(2),10,ISIGN*1)
      CALL CONVRT(FDATA2(52),10,ISIGN*1)
      CALL CONVRT(FDATA2(102),10,ISIGN*1)
      CALL CONVRT(FDATA2(364),10,ISIGN*1)
      CALL CONVRT(GFIN2(1),10,ISIGN*2)
      CALL CONVRT(GFIN2(11),10,ISIGN*1)
      CALL CONVRT(GFIN2(71),60,ISIGN*1)
      CALL CONVRT(GFIN2(161),10,ISIGN*1)
      CALL CONVRT(GFIN2(173),1,ISIGN*1)
      CALL CONVRT(GFIN2(174),2,ISIGN*2)
      CALL CONVRT(GFIN2(177),2,ISIGN*1)
      CALL CONVRT(GFIN2(184),1,ISIGN*1)
      CALL CONVRT(GFIN(187),1,ISIGN*1)
      CALL CONVRT(FDATA3(2),10,ISIGN*1)
      CALL CONVRT(FDATA3(52),10,ISIGN*1)
      CALL CONVRT(FDATA3(102),10,ISIGN*1)
      CALL CONVRT(FDATA3(364),10,ISIGN*1)
      CALL CONVRT(GFIN3(1),10,ISIGN*2)
      CALL CONVRT(GFIN3(11),10,ISIGN*1)
      CALL CONVRT(GFIN3(71),60,ISIGN*1)
      CALL CONVRT(GFIN3(161),10,ISIGN*1)
      CALL CONVRT(GFIN3(173),1,ISIGN*1)
      CALL CONVRT(GFIN3(174),2,ISIGN*2)
      CALL CONVRT(GFIN3(177),2,ISIGN*1)
      CALL CONVRT(GFIN3(184),1,ISIGN*1)
      CALL CONVRT(GFIN(187),1,ISIGN*1)
      CALL CONVRT(FDATA4(2),10,ISIGN*1)
      CALL CONVRT(FDATA4(52),10,ISIGN*1)
      CALL CONVRT(FDATA4(102),10,ISIGN*1)
      CALL CONVRT(FDATA4(364),10,ISIGN*1)
      CALL CONVRT(GFIN4(1),10,ISIGN*2)
      CALL CONVRT(GFIN4(11),10,ISIGN*1)
      CALL CONVRT(GFIN4(71),60,ISIGN*1)
      CALL CONVRT(GFIN4(161),10,ISIGN*1)
      CALL CONVRT(GFIN4(173),1,ISIGN*1)
      CALL CONVRT(GFIN4(174),2,ISIGN*2)
      CALL CONVRT(GFIN4(177),2,ISIGN*1)
      CALL CONVRT(GFIN4(184),1,ISIGN*1)
      CALL CONVRT(GFIN(187),1,ISIGN*1)
      CALL CONVRT(XHINGE(1),4,ISIGN*1)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE EQN44(GAM,PT,P,AMX)
C
C  COMPUTE MACH NUMBER FROM EQUATION 44 OF NACA 1135
C
C
C  INPUTS
C
C    GAM -- RATIO OF SPECIFIC HEATS FOR THE GAS
C     PT -- TOTAL PRESSURE
C      P -- STATIC PRESSURE
C
C  OUTPUT
C
C    AMX -- MACH NUMBER
C
C  SUBROUTINES CALLED -- NONE
C
      AMX=SQRT(2./(GAM-1.)*((PT/P)**((GAM-1.)/GAM)-1.))
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FINCN (IM,NFIN)
C      
C***  EXECUTIVE SUBROUTINE TO COMPUTE FIN ALONE NORMAL FORCE
C      
C***  REFERENCE      DATCOM EQUATION 4.1.3.3-A
C      
C***  INPUT          IM       MACH NUMBER INDEX
C***                 NFIN     FIN SET INDEX
C***  OUTPUT         CNFX     FIN ALONE NORMAL FORCE REFERENCED TO
C***                          SREF (LABELED COMMON SFINX)
C      
C  MODIFIED BY K. DETERS, MCDONNELL DOUGLAS
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C      
      COMMON /REFQN/ SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,
     1               RHR
      REAL LREF,LATREF
C      
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      REAL NALPHA,NMACH,MACH
C      
      COMMON /TOTALC/ BALPHA(20),BBETA(20),BPHI(20),ALPTOT(20)
C      
      COMMON /GEOFC/ FINAR,FINTPR,FINSPN,FINSP,FINWET,TCEFF,
     1               FINXGC,FINYGC,SWAVLE,SWAV25,SWAV50,SWAV75,
     2               SWAVTE,FINCBR,DELTAY,DELTAD,FINPHI,NPANEL,
     3               XLEF,XCENF,CROOT
      REAL NPANEL
C      
      COMMON /FSET1/  FSS1(373),GAM1(8),PHIF1(8),CFOC1(10)
      COMMON /FSET2/  FSS2(373),GAM2(8),PHIF2(8),CFOC2(10)
      COMMON /FSET3/  FSS3(373),GAM3(8),PHIF3(8),CFOC3(10)
      COMMON /FSET4/  FSS4(373),GAM4(8),PHIF4(8),CFOC4(10)
C      
      COMMON /F1WORK/ RHO1,TMAX1,KSHAR1,CCLA1(20),XAC1(20),CMCO41(20),
     1                CNALF1,CNAAF1(20),CNLF1(20),CNNLF1(20),CNF1AT(20),
     2                XCPL1,XCPNL1,CMFL1(20),CMFNL1(20),CMF1AT(20),
     3                CAOF1,CANLF1(20),ALPTF1(20),CNFIT1(20),AI1,ALO1,
     4                CLI1,CLM1(20)
      COMMON /F2WORK/ RHO2,TMAX2,KSHAR2,CCLA2(20),XAC2(20),CMCO42(20),
     1                CNALF2,CNAAF2(20),CNLF2(20),CNNLF2(20),CNF2AT(20),
     2                XCPL2,XCPNL2,CMFL2(20),CMFNL2(20),CMF2AT(20),
     3                CAOF2,CANLF2(20),ALPTF2(20),CNFIT2(20),AI2,ALO2,
     4                CLI2,CLM2(20)
      COMMON /F3WORK/ RHO3,TMAX3,KSHAR3,CCLA3(20),XAC3(20),CMCO43(20),
     1                CNALF3,CNAAF3(20),CNLF3(20),CNNLF3(20),CNF3AT(20),
     2                XCPL3,XCPNL3,CMFL3(20),CMFNL3(20),CMF3AT(20),
     3                CAOF3,CANLF3(20),ALPTF3(20),CNFIT3(20),AI3,ALO3,
     4                CLI3,CLM3(20)
      COMMON /F4WORK/ RHO4,TMAX4,KSHAR4,CCLA4(20),XAC4(20),CMCO44(20),
     1                CNALF4,CNAAF4(20),CNLF4(20),CNNLF4(20),CNF4AT(20),
     2                XCPL4,XCPNL4,CMFL4(20),CMFNL4(20),CMF4AT(20),
     3                CAOF4,CANLF4(20),ALPTF4(20),CNFIT4(20),AI4,ALO4,
     4                CLI4,CLM4(20)
C      
      COMMON /SFIN1/ CNF1(20),CMF1(20),CAF1(20),CYF1(20),CLNF1(20),
     1               CLLF1(20),CNAF1(20),CMAF1(20),CYBF1(20),
     2               CNBF1(20),CLBF1(20)
      COMMON /SFIN2/ CNF2(20),CMF2(20),CAF2(20),CYF2(20),CLNF2(20),
     1               CLLF2(20),CNAF2(20),CMAF2(20),CYBF2(20),
     2               CNBF2(20),CLBF2(20)
      COMMON /SFIN3/ CNF3(20),CMF3(20),CAF3(20),CYF3(20),CLNF3(20),
     1               CLLF3(20),CNAF3(20),CMAF3(20),CYBF3(20),
     2               CNBF3(20),CLBF3(20)
      COMMON /SFIN4/ CNF4(20),CMF4(20),CAF4(20),CYF4(20),CLNF4(20),
     1               CLLF4(20),CNAF4(20),CMAF4(20),CYBF4(20),
     2               CNBF4(20),CLBF4(20)
C      
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,
     4               LELLB,LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,
     4               LELLB,LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C      
      DIMENSION IROUT(2),RTRANS(7),ALPTFX(20),PHIF(8)
C      
C***  GET APPROPRIATE SECTION CLA AND FOR SUBSONIC CASES GET ALO
C      
      GO TO (1000,1010,1020,1030), NFIN
C      
 1000 SECCLA = CCLA1(IM)*RAD
      CLM = CLM1(IM)
      ALO=0.0
      IF (MACH(IM) .LE. 0.8) ALO=ALO1
      GO TO 1040
 1010 SECCLA = CCLA2(IM)*RAD
      CLM = CLM2(IM)
      ALO=0.0
      IF (MACH(IM) .LE. 0.8) ALO=ALO2
      GO TO 1040
 1020 SECCLA = CCLA3(IM)*RAD
      CLM = CLM3(IM)
      ALO=0.0
      IF (MACH(IM) .LE. 0.8) ALO=ALO3
      GO TO 1040
 1030 SECCLA = CCLA4(IM)*RAD
      CLM = CLM4(IM)
      ALO=0.0
      IF (MACH(IM) .LE. 0.8) ALO=ALO4
C      
 1040 CONTINUE
C
C***  NORMAL FORCE CURVE SLOPE - CNA
C      
      CALL FCNA(MACH(IM),FINAR*2.,FINTPR,SWAVLE,SWAV50,SWAVTE,
     1          DELTAD,SECCLA,FINSP*2.,SREF,CNA)
C      
C***  STORE CNA IN WORK ARRAY
C      
      GO TO (1050,1070,1090,1110), NFIN
C      
 1050  CNALF1=CNA/2.
       DO 1060 IP=1,8
          PHIF(IP)=PHIF1(IP)
 1060  CONTINUE
       GO TO 1130
 1070  CNALF2=CNA/2.
       DO 1080 IP=1,8
          PHIF(IP)=PHIF2(IP)
 1080  CONTINUE
       GO TO 1130
 1090  CNALF3=CNA/2.
       DO 1100 IP=1,8
          PHIF(IP)=PHIF3(IP)
 1100  CONTINUE
       GO TO 1130
 1110  CNALF4=CNA/2.
       DO 1120 IP=1,8
          PHIF(IP)=PHIF4(IP)
 1120  CONTINUE
C      
 1130 CONTINUE
C
C***  
      XBETA=SQRT(ABS(MACH(IM)**2-1.))
      AR=FINAR*2.
C      
C***  ANGLE OF ATTACK LOOP
C      
      NALP=NALPHA+0.5
      NPAN = NPANEL + 0.5
      DO 1250 I=1,NALP
C      
C***     INITIALIZE PANEL SUMMATION TERMS
C      
       CNFAT=0.
       CNFI=0.
       CNLSUM=0.
       CNNLSM=0.
C      
C***     PANEL SUMMATION LOOP (FIN SET NORMAL FORCE
C***     IS SUM OF INDIVIDUAL PANEL CONTRIBUTIONS)
C      
C      
C***     CORRECT ALPTOT AND ALPEQ FOR ALO FOR SUBSONIC CASES
C      
         TEMP1=ALPTOT(I)
         ALPT=TEMP1-ALO
C      
         DO 1190 IPAN=1,NPAN
C      
         FPHI=PHIF(IPAN)
         FPHIC = FPHI
         IF(FPHIC.GT.180.0 .AND. FPHIC.LT.360.0) FPHIC=FPHIC-180.
         IF(FPHIC.LT.0.0 .AND. FPHIC.GT.-180.0)  FPHIC=ABS(FPHIC)
C      
C***     COMPUTE ALPHA EQUIVALENT (NO INTERFERENCE)
C      
C  REV 3/99 MODIFIED TO GIVE CORRECT RESULT FOR AOA>90 OR AOA<-90
C  ABS(COS(ALPT)) ADDED.
C
         ALPEQ = ATAN(SIN(ALPT/RAD)/ABS(COS(ALPT/RAD))
     1                *SIN(FPHIC/RAD))*RAD
         TEMP2=ALPEQ
C      
C***     COMPUTE THE FIN NORMAL FORCE FOR ALPTOT GREATER THAN ALO
C      
         IF (ALPT .LT. ALO) GO TO 1160
C      
C***     COMPUTE LINEAR CN TERM - CNL (1 PANEL)
C      
         CNL=(CNA/2.)*RAD/2.*SIN(2.*ALPEQ/RAD)
C      
C***     NONLINEAR COEFFICIENT - CNAA
C
         CALL FCNAA(MACH(IM),FINAR*2.,DELTAY,SWAVLE,SWAVTE,FINTPR,
     1              ALPEQ,CNA,FINSPN*2.,SECCLA,
     2              FINSP*2.,SREF,CLM,CNAA)
         CNAA=CNAA/2.
C      
         CALL FCNAA(MACH(IM),FINAR*2.,DELTAY,SWAVLE,SWAVTE,FINTPR,
     1              ALPT,CNA,FINSPN*2.,SECCLA,
     2              FINSP*2.,SREF,CLM,CNAAT)
         CNAAT=CNAAT/2.
C      
C***     COMPUTE NONLINEAR CN TERM - CNNL (1 PANEL)
C      
         CNNL=CNAA*SIN(ALPEQ/RAD)*ABS(SIN(ALPT/RAD))
C
         GO TO 1170
C      
 1160 CONTINUE
C      
C***     HERE FOR ALPTOT LESS THAN ALO
C      
         ALPEQ=ABS(ALPEQ)
         ALPT=ABS(ALPT)
C***     COMPUTE LINEAR CN TERM - CNL (1 PANEL)
C      
         CNL=-(CNA/2.)*RAD/2.*SIN(2.*ALPEQ/RAD)
C      
C***     NONLINEAR COEFFICIENT - CNAA
C      
         CALL FCNAA(MACH(IM),FINAR*2.,DELTAY,SWAVLE,SWAVTE,FINTPR,
     1              ALPEQ,CNA,FINSPN*2.,SECCLA,
     2              FINSP*2.,SREF,CLM,CNAA)
         CNAA=-CNAA/2.
C      
         CALL FCNAA(MACH(IM),FINAR*2.,DELTAY,SWAVLE,SWAVTE,FINTPR,
     1              ALPT,CNA,FINSPN*2.,SECCLA,
     2              FINSP*2.,SREF,CLM,CNAAT)
         CNAAT=-CNAAT/2.
C      
C***     COMPUTE NONLINEAR CN TERM - CNNL (1 PANEL)
C      
         CNNL=CNAA*SIN(ALPEQ/RAD)*ABS(SIN(ALPT/RAD))
         ALPT=TEMP1-ALO
 1170 CONTINUE
         ALPEQ=TEMP2
C
C***  LUCERO'S METHOD LIMITATIONS
      SUBLE=MACH(IM)*COS(SWAVLE/RAD)
        XSWP=0.0
        XRECT=0.0
        IF(FINTPR.GT.0.5 .OR.  SWAVLE.EQ.0.) XRECT=XBETA*AR
        IF(FINTPR.LE.0.5 .AND. SWAVLE.NE.0.) XSWP=XBETA/TAN(SWAVLE/RAD)
      IF(MACH(IM) .GE. 2.5 .AND. XRECT .LE. 1.35 .AND. 
     &  XSWP .LE. 1.35 .AND. SWAVLE .GE. 0. .AND. SUBLE
     &  .GT. 1.)THEN
C
C***    SUBROUTINE CALL STATEMENTS 
          IF(SWAVLE .EQ. 0.)THEN
          XTERM=1./(XBETA*AR)
          CALL SPLN2(XTERM,XMULT)
          ELSE IF(FINTPR .EQ. 0.)THEN
          XTERM=TAN(SWAVLE/RAD)/XBETA
          CALL SPLN2(XTERM,XMULT)
          ELSE
          XTERM1=1./(XBETA*AR)
          CALL SPLN2(XTERM1,XMULT1)
          XTERM2=TAN(SWAVLE/RAD)/XBETA
          CALL SPLN2(XTERM2,XMULT2)
          XMULT=XMULT1*FINTPR+XMULT2*(1.-FINTPR)
          ENDIF
       CNNL=CNNL*XMULT
       ENDIF
C      
C***     COMPUTE TOTAL PANEL NORMAL FORCE
C      
         CNFI   = (CNL + CNNL)*ABS(SIN(FPHIC/RAD))
C      
C***     SUM COMPONENTS (1 PANEL AT ALPHA TOTAL)
C      
         CNLSUM = CNLSUM + CNL*ABS(SIN(FPHIC/RAD))
         CNNLSM = CNNLSM + CNNL*ABS(SIN(FPHIC/RAD))
         CNFAT  = CNFAT + CNFI
C      
 1190  CONTINUE
C      
C***     STORE COEFFICIENTS IN WORK ARRAYS
C***     NOTE: STORED COEFF'S ARE SINGLE PANEL VALUES
C      
         GO TO (1210,1220,1230,1240),NFIN
C      
C           HERE IF FIN SET 1
C      
 1210    CNLF1(I)=CNLSUM
         CNAAF1(I)=CNAAT
         CNNLF1(I)=CNNLSM
         CNF1AT(I)=CNFAT
         GO TO 1250
C      
C           HERE IF FIN SET 2
C      
 1220    CNLF2(I)=CNLSUM
         CNAAF2(I)=CNAAT
         CNNLF2(I)=CNNLSM
         CNF2AT(I)=CNFAT
         GO TO 1250
C      
C           HERE IF FIN SET 3
C      
 1230    CNLF3(I)=CNLSUM
         CNAAF3(I)=CNAAT
         CNNLF3(I)=CNNLSM
         CNF3AT(I)=CNFAT
         GO TO 1250
C      
C           HERE IF FIN SET 4
C      
 1240    CNLF4(I)=CNLSUM
         CNAAF4(I)=CNAAT
         CNNLF4(I)=CNNLSM
         CNF4AT(I)=CNFAT
C      
 1250 CONTINUE
C      
C***  INTERPOLATE ALPHA TOTAL DERIVED CURVE AT BODY
C***  ANGLE OF ATTACK FOR STORAGE AND PRINTOUT
C      
      DO 1300 I=1,NALP
         GO TO (1260,1270,1280,1290),NFIN
 1260    CALL LNTRP(ALPTOT,CNF1AT,NALP,BALPHA(I),CNF1(I))
         GO TO 1300
 1270    CALL LNTRP(ALPTOT,CNF2AT,NALP,BALPHA(I),CNF2(I))
         GO TO 1300
 1280    CALL LNTRP(ALPTOT,CNF3AT,NALP,BALPHA(I),CNF3(I))
         GO TO 1300
 1290    CALL LNTRP(ALPTOT,CNF4AT,NALP,BALPHA(I),CNF4(I))
C      
 1300 CONTINUE
C      
C***  COMPUTE FIN PANEL LOADS AT FIXED RANGE OF ALPHAS
C      
      DO 1310 I=1,11
         ALPTFX(I)=FLOAT(I-1)*2.
 1310 CONTINUE
      DO 1320 I=12,20
         ALPTFX(I)=FLOAT(I-11)*4.+20.
 1320 CONTINUE
C      
      DO 1370 I=1,20
         CALL FCNAA(MACH(IM),FINAR*2.,DELTAY,SWAVLE,SWAVTE,FINTPR,
     1              ALPTFX(I),CNA,FINSPN*2.,SECCLA,
     2              FINSP*2.,SREF,CLM,CNAA)
         CNAA=CNAA/2.
C      
         CNL=(CNA/2.)*RAD/2.*SIN(2.*ALPTFX(I)/RAD)
C
         CNNL=CNAA*SIN(ALPTFX(I)/RAD)*ABS(SIN(ALPTFX(I)/RAD))    
C
C***  LUCERO'S METHOD LIMITATIONS
      SUBLE=MACH(IM)*COS(SWAVLE/RAD)
        XSWP=0.
        XRECT=0.
        IF(FINTPR.GT.0.5 .OR.  SWAVLE.EQ.0.) XRECT=XBETA*AR
        IF(FINTPR.LE.0.5 .AND. SWAVLE.NE.0.) XSWP=XBETA/TAN(SWAVLE/RAD)
      IF(MACH(IM) .GE. 2.5 .AND. XRECT .LE. 1.35 .AND. 
     &  XSWP .LE. 1.35 .AND. SWAVLE .GE. 0. .AND. SUBLE
     &  .GT. 1.)THEN
C
C***    SUBROUTINE CALL STATEMENTS 
          IF(SWAVLE .EQ. 0.)THEN
          XTERM=1./(XBETA*AR)
          CALL SPLN2(XTERM,XMULT)
          ELSE IF(FINTPR .EQ. 0.)THEN
          XTERM=TAN(SWAVLE/RAD)/XBETA
          CALL SPLN2(XTERM,XMULT)
          ELSE
          XTERM1=1./(XBETA*AR)
          CALL SPLN2(XTERM1,XMULT1)
          XTERM2=TAN(SWAVLE/RAD)/XBETA
          CALL SPLN2(XTERM2,XMULT2)
          XMULT=XMULT1*FINTPR+XMULT2*(1.-FINTPR)
          ENDIF
       CNNL=CNNL*XMULT
       ENDIF
C      
         CNFI   = CNL + CNNL
         GO TO (1330,1340,1350,1360),NFIN
 1330    ALPTF1(I)=ALPTFX(I)
         CNFIT1(I)=CNFI
         GO TO 1370
 1340    ALPTF2(I)=ALPTFX(I)
         CNFIT2(I)=CNFI
         GO TO 1370
 1350    ALPTF3(I)=ALPTFX(I)
         CNFIT3(I)=CNFI
         GO TO 1370
 1360    ALPTF4(I)=ALPTFX(I)
         CNFIT4(I)=CNFI
C      
 1370 CONTINUE
C      
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HSOSL(CR, CT, B, TR, TT, RLER, RLET, RTER,
     1                 RTET, SWP1, CR1, CR2, CT1, CT2, MACH,
     2                 XM, ZM, XU, ZU, L, FAIL)
C
C     CONSTRUCT ROOT AND TIP LOCATIONS OF SOURCE OR SINK LINES
C     (SOSL), SURFACE SLOPES, AND ASSOCIATED GEOMETRY FOR
C     HEX AIRFOILS
C
C     INPUT VARIABLES
C            CR - ROOT CHORD
C            CT - TIP CHORD
C             B - SPAN OF TWO PANELS ALONE
C            TR - ROOT THICKNESS
C            TT - TIP THICKNESS
C          RLER - ROOT L.E. RADIUS
C          RLET - TIP L.E. RADIUS
C          RTER - ROOT T.E. RADIUS
C          RTET - TIP T.E. RADIUS
C          SWP1 - L.E. SWEEP, DEG.
C           CR1 - ROOT CHORD OF FWD WEDGE
C           CR2 - ROOT CHORD OF AFT WEDGE
C           CT1 - TIP CHORD OF FWD WEDGE
C           CT2 - TIP CHORD OF AFT WEDGE
C          MACH - MACH NUMBER
C
C     OUTPUT VARIABLES
C            XM - X-LOCATIONS OF INTERSECTION OF RLE AND FWD WEDGE
C            ZM - Z-LOCATIONS OF INTERSECTION OF RLE AND FWD WEDGE
C            XU - X-LOCATIONS ON RLE WHERE SLOPE IS 15 DEG.
C            ZU - Z-LOCATIONS ON RLE WHERE SLOPE IS 15 DEG.
C             L - NUMBER OF SOSL POINTS ON BLUNT L.E.
C
C     OUTPUT VARIABLES - COMMON /CAFD/
C            XO - ROOT LOCATIONS OF SOSL
C            XT - TIP LOCATIONS OF SOSL
C         DZDXO - ROOT SURFACE SLOPES FWD OF XO
C         DZDXT - TIP SURFACE SLOPES FWD OF XT
C           TGA - TAN OF SOSL SWEEP BACK
C           ETA - TGA/BETA WHERE BETA = SQRT(MACH**2-1)
C            NS - NUMBER OF SOSL POINTS
C
      REAL MACH
      DIMENSION XM(2), ZM(2), XU(2), ZU(2)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /CAFD/  XO(60), XT(60), DZDXO(60), DZDXT(60), TGA(60),
     1               ETA(60), DZDX(60), NS, CPO
C
      LOGICAL FAIL
C
C     ...
C     ... SET FIN GEOMETRIC CONSTANTS
C     ...
      B2   = B/2.0
      SWP4 = (B2*TAN(SWP1/RAD)+CT-CR)/B2
      SWP4 = RAD*ATAN(SWP4)
      CS1  = COS(SWP1/RAD)
      RLE  = (RLER+RLET)/2.0
      XT1  = B2*TAN(SWP1/RAD)
      IF(RLE .GE. 1.E-4) GO TO 10
C       ...
C       ... SHARP L.E. AT ROOT AND TIP
C       ...
        XO(1) = 0.0
        XO(2) = CR1
        XT(1) = XT1
        XT(2) = XT(1)+CT1
        XM(1) = 0.0
        ZM(1) = 0.0
        XM(2) = 0.0
        ZM(2) = 0.0
        XU(1) = 0.0
        ZU(1) = 0.0
        XU(2) = 0.0
        ZU(2) = 0.0
        DZDXO(1) = 0.0
        DZDXO(2) = (TR/2.0)/CR1
        DZDXT(1) = 0.0
        DZDXT(2) = (TT/2.0)/CT1
C
        L  = 0
   10 CONTINUE
      IF(RLE .LT. 1.E-4) GO TO 30
C       ...
C       ... BLUNT L.E. AT ROOT AND/OR TIP
C       ...
        IF(RLER .LT. 1.E-4) RLER = 1.E-4
        IF(RLET .LT. 1.E-4) RLET = 1.E-5
        CALL HXZU(RLER, TR, CR1, SWP1, XU(1), ZU(1), DZDXUR,
     1            XM(1), ZM(1))
        CALL HXZU(RLET, TT, CT1, SWP1, XU(2), ZU(2), DZDXUT,
     1            XM(2), ZM(2))
C
        DELR = RAD*ATAN(DZDXUR)
        DELT = RAD*ATAN(DZDXUT)
C
        LR = 17.0-DELR
        LT = 17.0-DELT
        L  = LR
        IF(LT .GT. LR) L = LT
        IF(L .LE. 1) FAIL=.TRUE.
        IF(FAIL .AND. PARTS(18)) WRITE(6,80)
        IF(FAIL) GO TO 70
        N1 = L+1
        XO(1)    = XM(1)-ZM(1)**2/(CS1*(RLER-XM(1)*CS1))
        XT(1)    = XM(2)-ZM(2)**2/(CS1*(RLET-XM(2)*CS1))
     1             +B2*TAN(SWP1/RAD)
        DZDXO(1) = 0.0
        DZDXT(1) = 0.0
        DZDXO(2) = TAN(15.0/RAD)
        DZDXT(2) = DZDXO(2)
        DO 20 I=2,N1
          DELTA = 17-I
C         ...
C         ... ROOT
C         ...
          TAND = TAN(DELTA/RAD)
          IF(DELTA .LT. DELR) TAND = DZDXUR
          GG       = SQRT(TAND*TAND/(CS1*CS1+TAND*TAND))
          XO(I)    = RLER*(1.0-GG)/CS1
          DZDXO(I+1) = TAND
C         ...
C         ... TIP
C         ...
          TAND = TAN(DELTA/RAD)
          IF(DELTA .LT. DELT) TAND = DZDXUT
          GG       = SQRT(TAND*TAND/(CS1*CS1+TAND*TAND))
          XT(I)    = XT1+RLET*(1.0-GG)/CS1
          DZDXT(I+1) = TAND
   20   CONTINUE
        XO(L+2) = CR1
        XT(L+2) = B2*TAN(SWP1/RAD)+CT1
   30 CONTINUE
C     ...
C     ... REMAINDER OF AIRFOIL
C     ...
      XO(L+3) = CR-CR2
      XT(L+3) = XT(L+2)+(CT-CT1-CT2)
      IF(XO(L+3) .LT. XO(L+2)) XO(L+3) = XO(L+2)
      IF(XT(L+3) .LT. XT(L+2)) XT(L+3) = XT(L+2)
      DZDXO(L+3) = 0.0
      DZDXT(L+3) = 0.0
C
      RTE = (RTER+RTET)/2.0
      IF(CR2 .GT. 0.)GO TO 35
         XO(L+4)    = CR
         XT(L+4)    = CT+B2*TAN(SWP1/RAD)
         DZDXO(L+4) = 0.0
         DZDXT(L+4) = 0.0
         DZDXO(L+5) = 0.0
         DZDXT(L+5) = 0.0
         NS = L+4
   35 CONTINUE
      IF(RTE .GE. 1.E-4 .OR. CR2 .LE. 0.0) GO TO 40
C       ...
C       ... SHARP T.E.
C       ...
        XO(L+4) = CR
        XT(L+4) = CT+B2*TAN(SWP1/RAD)
        DZDXO(L+4) = -(TR/2.0)/CR2
        DZDXT(L+4) = -(TT/2.0)/CT2
        DZDXO(L+5) = 0.0
        DZDXT(L+5) = 0.0
        NS = L+4
   40 CONTINUE
      IF(RTE .LT. 1.E-4 .OR. CR2 .LE. 0.0) GO TO 50
C       ...
C       ... BLUNT T.E.
C       ...
        IF(RTER .LT. 1.E-4) RTER = 1.E-4
        IF(RTET .LT. 1.E-4) RTET = 1.E-4
        CALL HXZU(RTER, TR, CR2, SWP4, XUT, ZUT, DZDXUR,
     1            XMT, ZMT)
        XO(L+4) = CR-XUT
        IF(DZDXUR .GT. 0.0) XO(L+5) = CR-XUT+ZUT/DZDXUR
        IF(DZDXUR .LE. 0.0) XO(L+5) = CR
        DZDXO(L+4) = -DZDXUR
        DZDXO(L+4) = -DZDXUR
        DZDXO(L+5) = -DZDXUR
        DZDXO(L+6) = 0.0
C
        CALL HXZU(RTET, TT, CT2, SWP4, XUT, ZUT, DZDXUT,
     1            XMT, ZMT)
        XT(L+4) = CT+B2*TAN(SWP1/RAD)-XUT
        IF(DZDXUT .GT. 0.0) XT(L+5) = XT(L+4)+ZUT/DZDXUT
        IF(DZDXUT .LE. 0.0) XT(L+5) = XT(L+4)+XUT
        DZDXT(L+4) = -DZDXUT
        DZDXT(L+5) = -DZDXUT
        DZDXT(L+6) = 0.0
C
        NS = L+5
   50 CONTINUE
C     ...
C     ... CONSTRUCT TGA AND ETA
C     ...
      BETA = SQRT(MACH**2-1.0)
      DO 60 I=1,NS
        TGA(I) = (XT(I)-XO(I))/B2
        ETA(I) = TGA(I)/BETA
   60 CONTINUE
C
   70 CONTINUE
C
   80 FORMAT(4X,'FIN POTENTIAL FLOW METHOD FAILING.  NOSE CAP/',
     1 ' WEDGE ANGLE > THAN 15 DEGREES.')
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE KWBNEW(MACH,ALPHA,RADF,SSPAN,KWBSBT,FACTOR)
C
C***  MODIFIED AUGUST 8, 1996
C
C***  SUBROUTINE TO DETERMINE THE RATIO K-W(B)/K-W(B)SBT
C***  DUE TO ANGLE OF ATTACK
C
C***  THIS METHOD IS AN EMPIRICAL CORRELATION OF TEST DATA
C***  DERIVED FROM THE MDA/NASA FIN-BODY WIND TUNNEL TEST DATA.
C
C***  INPUT
C
C  MACH   - MACH NUMBER
C  ALPHA  - ANGLE OF ATTACK, DEG.
C  RADF   - BODY RADIUS AT FIN STATION
C  KWBSBT - SLENDER BODY THEORY K-W(B)
C  SSPAN  - FIN SEMI-SPAN (EXCLUDES BODY)
C
C***  OUTPUT
C
C  FACTOR - RATIO OF K-W(B) TO THAT FROM THEORY (K-W(B)SBT)
C
       DIMENSION MACHTAB(10),AOASBT(10),RSTAB(5),DELTAB(5)
       REAL MACH,MACHTAB,KWBSBT,KWB
C
C***   PREVIOUS ALPHA CORRECTION FACTORS ************************
C
C       DATA ALPTAB / 0.,2.,4.,6.,8.,10.,12.,14.,16.,18.,20.,
C     1              22.,24.,90.,156.,158.,160.,162.,164.,166.,
C     2              168.,170.,172.,174.,176.,178.,180./
C
C       DATA KWBTAB/  1.0,1.0,1.0,0.985,0.940,0.875,0.825,
C     1              0.790,0.770,0.770,0.770,0.770,0.770,
C     2              0.770,0.770,0.770,0.770,0.770,0.770,
C     3              0.790,0.825,0.875,0.950,0.985,1.0,1.0,1.0/
C      DATA KWBTAB / 27*1.0 /
C
C*****************************************************************
C
      DATA MACHTAB / 0.0,0.6,0.9,1.2,1.6,2.0,2.3,2.96,3.95,5.0 /
      DATA AOASBT / 11.169,11.169,11.285,9.848,8.083,8.825,8.285,
     &              7.681,7.889,7.889 /
      DATA RSTAB / 0.0,0.25,0.3333,0.5,1.0 /
      DATA DELTAB / 0.0,0.094,0.103,0.099,0.0 /
C      
      RS=RADF/(SSPAN+RADF)
C
      IF ((RS.GT.0.0).AND.(RS.LT.1.0)) THEN
C
C***    FIND AOA WHERE KWB=KWB(SBT)
        CALL LNTRP(MACHTAB,AOASBT,10,MACH,ASBT)
C***    FIND KWB(0)-KWB(SBT)
        CALL LNTRP(RSTAB,DELTAB,5,RS,DELTA)
C***    CALCULATE COEFFICIENT A
        A=DELTA+KWBSBT-1.0
C***    CALCULATE COEFFICIENT B
        B=(1.0/ASBT**1.5)*LOG(DELTA/(KWBSBT-1.0)+1.0)
C
C***    CALCULATE KWB(ALPHA)
        KWB=A*EXP(-B*ABS(ALPHA)**1.5)+1.0
C
C***    CALCULATE RATIO OF KWB/KWBSBT
        FACTOR=KWB/KWBSBT
C
      ELSE
C
        FACTOR=1.0
C
      ENDIF   
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE POTAR2(ALP,BET,CNPP,CYPP,CMPP,CLNPP)
C***********************************************************************
C
C     THIS SUBROUTINE TRANSFERS ALPHA AND BETA IN BODY COORDINATES
C     INTO INLET ALPHA AND BETA FOR A SIDE MOUNTED 2-D INLET.  IT
C     THEN USES THESE LOCAL ANGLES TO CALCULATE INLET AERODYNAMICS.
C     THE FORCES AND MOMENTS IN INLET COORDINATES ARE THEN TRANS-
C     FERRED BACK TO THE BODY COORDINATE SYSTEM.
C
C***********************************************************************
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      DIMENSION DCN(20),DCY(20),DCM(20),DCLN(20),CNI(20),CYI(20)
      DIMENSION CNIXCP(20),CYIXCP(20),CYD(20),CYDXCP(20)
      DIMENSION ALPI(20),BETAI(20),BETAD(20)
C
      NUMI=NIN+0.5
      DO 10 I=1,NUMI
        IF (PHI(I).GE.360.) PHI(I)=PHI(I)-360.0
        IF((PHI(I).GE.0.0).AND.(PHI(I).LT.180.0))THEN
          ALPI(I)=ALP*SIN(PHI(I)/RAD)+BET*COS(PHI(I)/RAD)
          BETAI(I)=-ALP*COS(PHI(I)/RAD)+BET*SIN(PHI(I)/RAD)
        ELSE
          ALPI(I)=-ALP*SIN(PHI(I)/RAD)-BET*COS(PHI(I)/RAD)
          BETAI(I)=ALP*COS(PHI(I)/RAD)-BET*SIN(PHI(I)/RAD)
        ENDIF
        BETAD(I)=-ALP*SIN(PHI(I)/RAD)-BET*COS(PHI(I)/RAD)
  10  CONTINUE
C
      CALL CNPTWO(ALPI,CNI,CNIXCP)
      CALL CYPTWO(BETAI,CYI,CYIXCP)
      IF(HDIV .GT. 0.0)THEN
        CALL CYPDIV(BETAD,CYD,CYDXCP)
      ELSE
         DO 15 I=1,20
           CYD(I) = 0.0
           CYDXCP(I) = 0.0
   15    CONTINUE
      ENDIF
C
      DO 20 I=1,NUMI
        IF((PHI(I).GE.0.0).AND.(PHI(I).LT.180.0))THEN
          DCN(I) =CNI(I)*SIN(PHI(I)/RAD)+CYI(I)*COS(PHI(I)/RAD)+
     &            CYD(I)*SIN(PHI(I)/RAD)
          DCY(I) =-CNI(I)*COS(PHI(I)/RAD)+CYI(I)*SIN(PHI(I)/RAD)-
     &             CYD(I)*COS(PHI(I)/RAD)
          DCM(I) =-CNI(I)*SIN(PHI(I)/RAD)*CNIXCP(I)/LREF
     &            -CYI(I)*COS(PHI(I)/RAD)*CYIXCP(I)/LREF
     &            -CYD(I)*SIN(PHI(I)/RAD)*CYDXCP(I)/LREF
          DCLN(I)= CNI(I)*COS(PHI(I)/RAD)*CNIXCP(I)/BREF
     &            -CYI(I)*SIN(PHI(I)/RAD)*CYIXCP(I)/BREF
     &            +CYD(I)*COS(PHI(I)/RAD)*CYDXCP(I)/BREF
        ELSE
          DCN(I) =-CNI(I)*SIN(PHI(I)/RAD)-CYI(I)*COS(PHI(I)/RAD)+
     &            CYD(I)*SIN(PHI(I)/RAD)
          DCY(I) =CNI(I)*COS(PHI(I)/RAD)-CYI(I)*SIN(PHI(I)/RAD)-
     &             CYD(I)*COS(PHI(I)/RAD)
          DCM(I) =CNI(I)*SIN(PHI(I)/RAD)*CNIXCP(I)/LREF
     &            +CYI(I)*COS(PHI(I)/RAD)*CYIXCP(I)/LREF
     &            -CYD(I)*SIN(PHI(I)/RAD)*CYDXCP(I)/LREF
          DCLN(I)=-CNI(I)*COS(PHI(I)/RAD)*CNIXCP(I)/BREF
     &            +CYI(I)*SIN(PHI(I)/RAD)*CYIXCP(I)/BREF
     &            +CYD(I)*COS(PHI(I)/RAD)*CYDXCP(I)/BREF
        ENDIF
  20  CONTINUE
C
      CNPP=0.0
      CYPP=0.0
      CMPP=0.0
      CLNPP=0.0
      DO 30 I=1,NUMI
        CNPP=CNPP+DCN(I)*KWA(I)
        CYPP=CYPP+DCY(I)*KWB(I)
        CMPP=CMPP+DCM(I)*KWA(I)
        CLNPP=CLNPP+DCLN(I)*KWB(I)
   30 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SAVEF
C      
C***  SAVE USER DEFINED DATA TO TAPE3
C      
C  MODIFIED BY W. BLAKE, WL/FIGC
C
      COMMON /CASEID/ IDCASE(180)
      COMMON /THERY/  LTHERY(4)
      COMMON /CONST/  CONS(4)
      COMMON /TRACE/  TTRACE(21)
      COMMON /LOGIC/  LFLAGS(28)
      COMMON /DUMPF/  LDUMPF(37)
      COMMON /DFLAGS/ ADELF(12)
      COMMON /DESIG/  NNACA(320)
      COMMON /FLC/    FLTC(144)
      COMMON /TOTALC/ ATOTAL(80)
      COMMON /REFQN/  REFS(9)
      COMMON /ABODIN/ BDIN(881)
      COMMON /FSET1/  FDATA1(399)
      COMMON /FSET2/  FDATA2(399)
      COMMON /FSET3/  FDATA3(399)
      COMMON /FSET4/  FDATA4(399)
      COMMON /INCID/  DELTAS(40)
      COMMON /GEOBOD/ BDGEO(47)
      COMMON /BDWORK/ BDW(241)
      COMMON /F1WORK/ F1WK(290)
      COMMON /F2WORK/ F2WK(290)
      COMMON /F3WORK/ F3WK(290)
      COMMON /F4WORK/ F4WK(290)
      COMMON /GEOFS1/ GFIN1(188)
      COMMON /GEOFS2/ GFIN2(188)
      COMMON /GEOFS3/ GFIN3(188)
      COMMON /GEOFS4/ GFIN4(188)
      COMMON /SBODY/  CBODY(220)
      COMMON /SFIN1/  CFIN1(220)
      COMMON /SFIN2/  CFIN2(220)
      COMMON /SFIN3/  CFIN3(220)
      COMMON /SFIN4/  CFIN4(220)
      COMMON /SB1/    CBF1(220)
      COMMON /SB12/   CBF2(220)
      COMMON /SB123/  CBF1F2(220)
      COMMON /DBODY/  EBODY(406)
      COMMON /DDFIN1/  EFIN1(80)
      COMMON /DDFIN2/  EFIN2(80)
      COMMON /DB1/    EBF1(400)
      COMMON /DB12/   EBF2(400)
      COMMON /DB123/  EBF1F2(400)
      COMMON /DB1234/ EB1234(400)
      COMMON /TRIMIN/ DTRIM(19)
      COMMON /UTRIMD/ DATAX(1200)
      COMMON /TRIMD/  TTRIM(120)
      COMMON /INPCON/ ACONS(78)
      COMMON /PAERO/  PAER(4024)
      COMMON /SB1234/ CB1234(220)
      COMMON /DDFIN3/  EFIN3(80)
      COMMON /DDFIN4/  EFIN4(80)
      COMMON /INLETN/ INLE(64)
      COMMON /INLTD/  DINLET(120)
C      
      REAL INLE
      LOGICAL LTHERY,LFLAGS,LDUMPF,ADELF
C
      CHARACTER*4 IFORM,IBLOCK,LEFT,IBLANK,ISET
      CHARACTER*4 ISET1,ISET2,ISET3,ISET4,ISET5
C      
      DIMENSION IBLOCK(74),IFORM(74),ISET1(66),ISET2(66),ISET3(66),
     1          ISET4(66),ISET5(54),ISET(318),LASTV(53)
C      
      EQUIVALENCE (ISET1(1),ISET(1)),(ISET2(1),ISET(67)),
     1            (ISET3(1),ISET(133)),(ISET4(1),ISET(199)),
     2            (ISET5(1),ISET(265))
C      
      DATA LEFT   /'(   '/
      DATA IBLANK /'    '/
      DATA IFORM  /'(   ','8   ','F   ','1   ','0   ','.   ',
     1             '4   ',')   ',66*'    '/
C      
      DATA LASTV / 180,4,4,21,28,37,12,320,144,80,9,881,4*399,
     1 40,47,241,4*290,4*188,8*220,406,80,80,4*400,
     2 19,1200,120,78,881,4024,220,80,80,64,100 /
C      
      DATA ISET1 /
     1  'C   ','A   ','S   ','E   ','I   ','D   ',
     2  'T   ','H   ','E   ','R   ','Y   ','    ',
     3  'C   ','O   ','N   ','S   ','T   ','    ',
     4  'T   ','R   ','A   ','C   ','E   ','    ',
     5  'L   ','O   ','G   ','I   ','C   ','    ',
     6  'D   ','U   ','M   ','P   ','F   ','    ',
     7  'D   ','F   ','L   ','A   ','G   ','S   ',
     8  'D   ','E   ','S   ','I   ','G   ','    ',
     9  'F   ','L   ','C   ','    ','    ','    ',
     A  'T   ','O   ','T   ','A   ','L   ','C   ',
     B  'R   ','E   ','F   ','Q   ','N   ','    '/
C
      DATA ISET2 /
     1  'A   ','B   ','O   ','D   ','I   ','N   ',
     2  'F   ','S   ','E   ','T   ','1   ','    ',
     3  'F   ','S   ','E   ','T   ','2   ','    ',
     4  'F   ','S   ','E   ','T   ','3   ','    ',
     5  'F   ','S   ','E   ','T   ','4   ','    ',
     6  'I   ','N   ','C   ','I   ','D   ','    ',
     7  'G   ','E   ','O   ','B   ','O   ','D   ',
     8  'B   ','D   ','W   ','O   ','R   ','K   ',
     9  'F   ','1   ','W   ','O   ','R   ','K   ',
     A  'F   ','2   ','W   ','O   ','R   ','K   ',
     B  'F   ','3   ','W   ','O   ','R   ','K   '/
      DATA ISET3 /
     1  'F   ','4   ','W   ','O   ','R   ','K   ',
     2  'G   ','E   ','O   ','F   ','S   ','1   ',
     3  'G   ','E   ','O   ','F   ','S   ','2   ',
     4  'G   ','E   ','O   ','F   ','S   ','3   ',
     5  'G   ','E   ','O   ','F   ','S   ','4   ',
     6  'S   ','B   ','O   ','D   ','Y   ','    ',
     7  'S   ','F   ','I   ','N   ','1   ','    ',
     8  'S   ','F   ','I   ','N   ','2   ','    ',
     9  'S   ','F   ','I   ','N   ','3   ','    ',
     A  'S   ','F   ','I   ','N   ','4   ','    ',
     B  'S   ','B   ','1   ','    ','    ','    '/
      DATA ISET4 /
     1  'S   ','B   ','1   ','2   ','    ','    ', 
     2  'S   ','B   ','1   ','2   ','3   ','    ', 
     3  'D   ','B   ','O   ','D   ','Y   ','    ',
     4  'D   ','F   ','I   ','N   ','1   ','    ',
     5  'D   ','F   ','I   ','N   ','2   ','    ',
     6  'D   ','B   ','1   ','    ','    ','    ',
     7  'D   ','B   ','1   ','2   ','    ','    ',
     8  'D   ','B   ','1   ','2   ','3   ','    ',
     9  'D   ','B   ','1   ','2   ','3   ','4   ',
     A  'T   ','R   ','I   ','M   ','I   ','N   ',
     B  'U   ','T   ','R   ','I   ','M   ','D   '/
       DATA ISET5 /
     1  'T   ','R   ','I   ','M   ','D   ','    ',
     2  'I   ','N   ','P   ','C   ','O   ','N   ',
     3  'E   ','B   ','O   ','D   ','I   ','N   ',
     4  'P   ','A   ','E   ','R   ','O   ','    ',
     5  'S   ','B   ','1   ','2   ','3   ','4   ',
     6  'D   ','F   ','I   ','N   ','3   ','    ',
     7  'D   ','F   ','I   ','N   ','4   ','    ',
     8  'I   ','N   ','L   ','E   ','T   ','N   ',
     9  'I   ','N   ','L   ','T   ','D   ','    '/
C      
      REWIND 7
C      
C***  READ STATEMENT FOR FORTRAN-IV
C      
C1000 READ(7,1010)(IBLOCK(I),I=1,74)
C     IF(EOF(7))1680,1020
C      
C***  READ STATEMENT FOR FORTRAN-V OR IBM
C      
 1000 READ(7,1010,END=1680)(IBLOCK(I),I=1,74)
 1010 FORMAT(74A1)
C      
C***  SHIFT OUT BLANKS
C      
 1020 DO 1030 I=1,74
         KK=I
         IF(IBLOCK(I) .NE. IBLANK)GO TO 1040
 1030 CONTINUE
C      
C***  BLANK CARD
C      
      GO TO 1000
C      
 1040 DO 1050 I=KK,74
         ICOL=I-KK+1
         IBLOCK(ICOL)=IBLOCK(I)
 1050 CONTINUE
      ICOL=ICOL+1
      DO 1060 I=ICOL,74
         IF(ICOL .GT. 74)GO TO 1060
         IBLOCK(I)=IBLANK
 1060 CONTINUE
C      
      IF(IBLOCK(1) .EQ. LEFT)GO TO 1660
C      
C***  DECODE BLOCK NAME AND RANGE
C      
      CALL DDECOD(IBLOCK,LENGTH,IFIRST,ILAST)
C      
      WRITE(4,1070)(IBLOCK(I),I=1,6),IFIRST,ILAST
 1070 FORMAT(4X,'CONTENTS OF ',6A1,' FROM',I5,' TO',I5)
C      
      IF(IFIRST.LE.0 .OR. ILAST.LT.IFIRST)GO TO 1000
C      
       DO 1090 I=1,318,6
         DO 1080 K=1,LENGTH
            IF(ISET(I+K-1) .NE. IBLOCK(K))GO TO 1090
 1080    CONTINUE
C      
C***  BLOCK NAME FOUND
C      
      GO TO 1100
C      
 1090 CONTINUE
C      
C***  BLOCK NAME NOT FOUND
C      
      GO TO 1000
C      
C***  JUMP TO APPROPIATE WRITE STATEMENT
C      
 1100 JUMP=(I+5)/6
C      
      IF(ILAST .GT. LASTV(JUMP))ILAST=LASTV(JUMP)
C      
      IF(JUMP.LT.1 .OR. JUMP.GT.53)GO TO 1000
C      
      GO TO (1110,1120,1130,1140,1150,1160,1170,1180,1190,1200,
     1       1210,1220,1230,1240,1250,1260,1270,1280,1290,1300,
     2       1310,1320,1330,1340,1350,1360,1370,1380,1390,1400,
     3       1410,1420,1430,1440,1450,1460,1470,1480,1490,1500,
     4       1510,1520,1530,1540,1550,1560,1570,1580,1590,1600,
     5       1610,1630,1650), JUMP
C      
 1110 WRITE(4,IFORM)(IDCASE(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1120 WRITE(4,IFORM)(LTHERY(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1130 WRITE(4,IFORM)(CONS(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1140 WRITE(4,IFORM)(TTRACE(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1150 WRITE(4,IFORM)(LFLAGS(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1160 WRITE(4,1690)(LDUMPF(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1170 WRITE(4,IFORM)(ADELF(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1180 WRITE(4,IFORM)(NNACA(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1190 WRITE(4,IFORM)(FLTC(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1200 WRITE(4,IFORM)(ATOTAL(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1210 WRITE(4,IFORM)(REFS(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1220 WRITE(4,IFORM)(BDIN(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1230 WRITE(4,IFORM)(FDATA1(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1240 WRITE(4,IFORM)(FDATA2(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1250 WRITE(4,IFORM)(FDATA3(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1260 WRITE(4,IFORM)(FDATA4(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1270 WRITE(4,IFORM)(DELTAS(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1280 WRITE(4,IFORM)(BDGEO(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1290 WRITE(4,IFORM)(BDW(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1300 WRITE(4,IFORM)(F1WK(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1310 WRITE(4,IFORM)(F2WK(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1320 WRITE(4,IFORM)(F3WK(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1330 WRITE(4,IFORM)(F4WK(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1340 WRITE(4,IFORM)(GFIN1(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1350 WRITE(4,IFORM)(GFIN2(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1360 WRITE(4,IFORM)(GFIN3(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1370 WRITE(4,IFORM)(GFIN4(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1380 WRITE(4,IFORM)(CBODY(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1390 WRITE(4,IFORM)(CFIN1(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1400 WRITE(4,IFORM)(CFIN2(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1410 WRITE(4,IFORM)(CFIN3(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1420 WRITE(4,IFORM)(CFIN4(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1430 WRITE(4,IFORM)(CBF1(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1440 WRITE(4,IFORM)(CBF2(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1450 WRITE(4,IFORM)(CBF1F2(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1460 WRITE(4,IFORM)(EBODY(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1470 WRITE(4,IFORM)(EFIN1(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1480 WRITE(4,IFORM)(EFIN2(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1490 WRITE(4,IFORM)(EBF1(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1500 WRITE(4,IFORM)(EBF2(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1510 WRITE(4,IFORM)(EBF1F2(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1520 WRITE(4,IFORM)(EB1234(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1530 WRITE(4,IFORM)(DTRIM(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1540 WRITE(4,IFORM)(DATAX(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1550 WRITE(4,IFORM)(TTRIM(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1560 WRITE(4,IFORM)(ACONS(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1570 WRITE(4,IFORM)(BDIN(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1580 WRITE(4,IFORM)(PAER(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1590 WRITE(4,IFORM)(CB1234(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1600 WRITE(4,IFORM)(EFIN3(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1610 WRITE(4,IFORM)(EFIN4(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1630 WRITE(4,IFORM)(INLE(KK),KK=IFIRST,ILAST)
      GO TO 1000
 1650 WRITE(4,IFORM)(DINLET(KK),KK=IFIRST,ILAST)
      GO TO 1000
C      
 1660 DO 1670 I=1,74
         IFORM(I)=IBLOCK(I)
 1670 CONTINUE
C      
      GO TO 1000
C      
 1680 CONTINUE
C      
      RETURN
 1690 FORMAT(' ',L1,1X,L1,1X,L1,1X,L1,1X,L1,1X,L1,1X,L1,1X,L1)
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SYNTHS(IM,TOTC,IFLAGA,DFLAG)
C      
C***  AERODYNAMIC CONFIGURATION SYNTHESIS
C      
      COMMON /SBODY/  BCN(20),BCM(20),BCA(20),BCY(20),BCSN(20),BCSL(20)
     1                ,BCNA(20),BCMA(20),SBDUM(60)
      COMMON /SB1/    CN1(20),CM1(20),CA1(20),CY1(20),CSN1(20),
     1                CSL1(20),CNA1(20),CMA1(20),CYB1(20),CLNB1(20),
     2                CLLB1(20)
      COMMON /SB12/   CN12(20),CM12(20),CA12(20),CY12(20),CSN12(20),
     1                CSL12(20),CNA12(20),CMA12(20),CYB12(20),
     2                CLNB12(20),CLLB12(20)
      COMMON /SB123/  CN13(20),CM13(20),CA13(20),CY13(20),CSN13(20),
     1                CSL13(20),CNA13(20),CMA13(20),CYB13(20),
     2                CLNB13(20),CLLB13(20)
      COMMON /SB1234/ CN14(20),CM14(20),CA14(20),CY14(20),CSN14(20),
     1                CSL14(20),CNA14(20),CMA14(20),CYB14(20),
     2                CLNB14(20),CLLB14(20)
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /FLC/    FL(144)
      COMMON /REFQN/  REF(9)
      COMMON /ABODIN/ BDIN(881)
      COMMON /GEOBOD/ GEOB(47)
      COMMON /BDWORK/ BDWK(241)
      COMMON /FSET1/  FDATA1(399)
      COMMON /FSET2/  FDATA2(399)
      COMMON /FSET3/  FDATA3(399)
      COMMON /FSET4/  FDATA4(399)
      COMMON /GEOFS1/ GFIN1(188)
      COMMON /GEOFS2/ GFIN2(188)
      COMMON /GEOFS3/ GFIN3(188)
      COMMON /GEOFS4/ GFIN4(188)
      COMMON /F1WORK/ F1WK(290)
      COMMON /F2WORK/ F2WK(290)
      COMMON /F3WORK/ F3WK(290)
      COMMON /F4WORK/ F4WK(290)
      COMMON /INCID/  DEL1(8),DEL2(8),DEL3(8),DEL4(8),XHINGE(4),
     1                SKEW(4)
      COMMON /PARTF/  PARTS(19)
      COMMON /CASEID/ DUMEE(175),ICASE,NOEXTR,NOLAT,IR,IPAGE
      COMMON /LOGIC/  LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1                LDERRD,LPART,LNAME,LPLOT,
     2                LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3                LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4                LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      COMMON /PAERO/  AKBW(4),AKWB0(4),AKKBW(4),AKKWB(4),XCPBW(4),
     1                XCPWB(4),DAQ(8,20,4),WAQ(8,20,4),
     2                CNW(8,20,4),CLW(8,20,4),CNWB(20,4),CMWB(20,4),
     3                CAWB(20,4),CYWB(20,4),CSNWB(20,4),CSLWB(20,4),
     4                CNBW(20,4),CMBW(20,4),CABW(20,4),CYBW(20,4),
     5                CSNBW(20,4),CSLBW(20,4),CN(20,4),CM(20,4),
     6                CA(20,4),CY(20,4),CSN(20,4),CSL(20,4)
      COMMON /INC  /  COREC(128),ZIP,ALP1(20),NAP
      COMMON /FFINDL/ DSYN1(8),DSYN2(8),DSYN3(8),DSYN4(8),CLD(4)
      COMMON /THERY/  LSOSE,PRESUR,LHYBRD,LHYPER
C
      REAL NAP
      LOGICAL PARTS,LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,LDERRD,
     1        LPART,LNAME,LPLOT,LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,
     2        LFIN4,LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     3        LINLET,LEXPR,LICRMT
      LOGICAL LFINL,LSOSE,PRESUR,LHYBRD,LHYPER
C      
      DIMENSION IFLAGA(3,4),IFOUND(6),FACTH(4),FACTV(4),AFACT(20,4)
C      
      REAL NX,MACH,LES,LODB,LODN,LATREF,LBODY
C      
      DIMENSION TOTC(80),FINAX(20,4),XB(50),RB(50),LES(4),LFINL(4),
     1          TES(4),SPAN(4),SSPAN(4),XLE(4),CR(4),NFINS(4),
     2          TAPER(4),AR(4),RADF(4),PHISET(4),AREAF(4),
     3          GAM(8,4),DELTA(8,4),CNF(20,4),AT(20,4),NT(4),PHIF(8,4),
     4          CLA(4),DUMMY(120),ALO(4),CMOT(4)
      DIMENSION AKWB(4),XCPWA(4),XCPWD(4),CNA(20,4),CMA(20,4)
      DIMENSION IROUT(2),YCPFIN(20,4)
C      
      EQUIVALENCE (DSYN1,DELTA(1,1)),(DSYN2,DELTA(1,2)),
     1            (DSYN3,DELTA(1,3)),(DSYN4,DELTA(1,4))
      EQUIVALENCE (SREF,REF(1)),(DREF,REF(2)),(LATREF,REF(3)),
     1            (XCG,REF(5)),(ZCG,REF(6))
      EQUIVALENCE (NX,BDIN(1)),(XB(1),BDIN(3)),(RB(1),BDIN(53))
C      
C***   
C***  ENTRY POINT/TRACEBACK
C***   
C***   
C***  VALID CONFIGURATION?
C***   
      IF(.NOT. (LAXIS .OR. LELLB))GO TO 1470
      IF(.NOT. (LFIN1.OR.LFIN2.OR.LFIN3.OR.LFIN4))GO TO 1470
C      
C***  SET VALUES FOR ARRAY IFLAGA TO ZERO
C     THIS ARRAY IS USED TO DETERMINE WHICH LATERAL COEFFICIENTS
C     THERE ARE EXPERIMENTAL INPUTS FOR
C      
      DO 1010 JZ1=1,4
         DO 1000 IZ1=1,3
            IFLAGA(IZ1,JZ1)=0
 1000    CONTINUE
 1010 CONTINUE
      DO 1020 K=1,4
         DO 1025 I=1,20
            CN(I,K)=UNUSED
            CM(I,K)=UNUSED
            CA(I,K)=UNUSED
            CY(I,K)=UNUSED
            CSN(I,K)=UNUSED
            CSL(I,K)=UNUSED
            CNA(I,K)=UNUSED
            CMA(I,K)=UNUSED
 1025    CONTINUE
 1020 CONTINUE
C***   
C***  THE FOLLOWING CONSTANTS ARE FIXED BY THE DIMENSION STATEMENTS
C***  IN THIS ROUTINE.  THEY CANNOT BE ARBITRARILY CHANGED.
C***   
      LFINL(1)=LFIN1
      LFINL(2)=LFIN2
      LFINL(3)=LFIN3
      LFINL(4)=LFIN4
C      
      IF(LFIN1)MAXSET=1
      IF(LFIN1 .AND. LFIN2)MAXSET=2
      IF(LFIN1 .AND. LFIN2 .AND. LFIN3)MAXSET=3
      IF(LFIN1 .AND. LFIN2 .AND. LFIN3 .AND. LFIN4)MAXSET=4
C      
      MAXPAN=8
C      
      MAXALP=20
C***   
C***  SET UP DATA FOR ALL POSSIBLE CONFIGURATIONS
C***   
      LBODY=GEOB(35)
      RADN=BDIN(105)/2.
      WNOSE=BDIN(105)
      HNOSE=BDIN(234)*WNOSE
      IF(LELLB)RADN=SQRT(WNOSE*HNOSE)/2.
      BLUNT=BDIN(106)/RADN
      LODN=GEOB(6)
      LODB=GEOB(30)
      PHIB=FL(23)
      IF(ABS(PHIB) .LE. UNUSED)PHIB=0.
C      
      NALPHA=FL(1)+.5
      MACH=FL(IM+24)
      RENN=FL(IM+64)
C      
      LES(1)=GFIN1(179)
      LES(2)=GFIN2(179)
      LES(3)=GFIN3(179)
      LES(4)=GFIN4(179)
C      
      TES(1)=GFIN1(183)
      TES(2)=GFIN2(183)
      TES(3)=GFIN3(183)
      TES(4)=GFIN4(183)
C      
      NFINS(1)=FDATA1(112)+0.5
      NFINS(2)=FDATA2(112)+0.5
      NFINS(3)=FDATA3(112)+0.5
      NFINS(4)=FDATA4(112)+0.5
C      
      SPAN(1)=2.*GFIN1(173)
      SPAN(2)=2.*GFIN2(173)
      SPAN(3)=2.*GFIN3(173)
      SPAN(4)=2.*GFIN4(173)
C      
      XLE(1)=FDATA1(102)
      XLE(2)=FDATA2(102)
      XLE(3)=FDATA3(102)
      XLE(4)=FDATA4(102)
C      
      TAPER(1)=GFIN1(172)
      TAPER(2)=GFIN2(172)
      TAPER(3)=GFIN3(172)
      TAPER(4)=GFIN4(172)
C      
      CR(1)=FDATA1(52)
      CR(2)=FDATA2(52)
      CR(3)=FDATA3(52)
      CR(4)=FDATA4(52)
C      
      AREAF(1)=2.*GFIN1(174)
      AREAF(2)=2.*GFIN2(174)
      AREAF(3)=2.*GFIN3(174)
      AREAF(4)=2.*GFIN4(174)
C      
      AR(1)=2.*GFIN1(171)
      AR(2)=2.*GFIN2(171)
      AR(3)=2.*GFIN3(171)
      AR(4)=2.*GFIN4(171)
C      
      PHISET(1)=FDATA1(363)
      PHISET(2)=FDATA2(363)
      PHISET(3)=FDATA3(363)
      PHISET(4)=FDATA4(363)
C      
      IF(PHISET(1) .EQ. UNUSED)PHISET(1)=0.
      IF(PHISET(2) .EQ. UNUSED)PHISET(2)=0.
      IF(PHISET(3) .EQ. UNUSED)PHISET(3)=0.
      IF(PHISET(4) .EQ. UNUSED)PHISET(4)=0.
C      
      DO 1030 I=1,MAXPAN
         GAM(I,1)=FDATA1(I+373)
         GAM(I,2)=FDATA2(I+373)
         GAM(I,3)=FDATA3(I+373)
         GAM(I,4)=FDATA4(I+373)
         PHIF(I,1)=FDATA1(I+381)
         PHIF(I,2)=FDATA2(I+381)
         PHIF(I,3)=FDATA3(I+381)
         PHIF(I,4)=FDATA4(I+381)
 1030 CONTINUE
C      
C***  CHECK FOR USER DEFINED FIN POSITIONS AND PHI ANGLES
C      
      DO 1090 I=1,MAXSET
         MAXP=NFINS(I)
         IF(MAXP .EQ. 0)MAXP=1
         DO 1040 J=1,MAXP
            IF(GAM(J,I) .EQ. UNUSED)GO TO 1040
            GO TO 1060
 1040    CONTINUE
         DO 1050 J=1,MAXP
            GAM(J,I)=0.
 1050    CONTINUE
 1060    DO 1070 J=1,MAXP
            IF(PHIF(J,I) .EQ. UNUSED)GO TO 1070
            GO TO 1090
 1070    CONTINUE
         DELGAM=360./FLOAT(MAXP)
         DO 1080 J=1,MAXP
            PHIF(J,I)=FLOAT(J-1)*DELGAM
 1080    CONTINUE
 1090 CONTINUE
C      
      DO 1100 I=1,MAXPAN
         PHIF(I,1)=PHIF(I,1)+PHISET(1)
         PHIF(I,2)=PHIF(I,2)+PHISET(2)
         PHIF(I,3)=PHIF(I,3)+PHISET(3)
         PHIF(I,4)=PHIF(I,4)+PHISET(4)
 1100 CONTINUE
C      
      NT(1)=20
      NT(2)=20
      NT(3)=20
      NT(4)=20
C      
C***  ASSIGN VALUES TO ALPHA, CN AND CA FOR EACH SET OF FINS
C      
      DO 1110 K=1,20
C      
C     FIN SET 1
C      
         AT(K,1)=F1WK(K+227)
         CNF(K,1)=2.*F1WK(K+247)
         FINAX(K,1)=F1WK(K+207)+F1WK(207)
         ALO(1)=F1WK(269)
C      
C     FIN SET 2
C      
         AT(K,2)=F2WK(K+227)
         CNF(K,2)=2.*F2WK(K+247)
         FINAX(K,2)=F2WK(K+207)+F2WK(207)
         ALO(2)=F2WK(269)
C      
C     FIN SET 3
C      
         AT(K,3)=F3WK(K+227)
         CNF(K,3)=2.*F3WK(K+247)
         FINAX(K,3)=F3WK(K+207)+F3WK(207)
         ALO(3)=F3WK(269)
C      
C     FIN SET 4
C      
         AT(K,4)=F4WK(K+227)
         CNF(K,4)=2.*F4WK(K+247)
         FINAX(K,4)=F4WK(K+207)+F4WK(207)
         ALO(4)=F4WK(269)
 1110 CONTINUE
C      
      DO 1130 I=1,MAXSET
         DO 1120 J=1,MAXPAN
            IF(ABS(PHIF(J,I)) .LE. UNUSED)PHIF(J,I)=0.
            IF(PHIF(J,I) .GE. 360.)PHIF(J,I)=PHIF(J,I)-360.
            IF(PHIF(J,I) .LE.-360.)PHIF(J,I)=PHIF(J,I)+360.
 1120    CONTINUE
         IF(ABS(SKEW(I)) .LE. UNUSED)SKEW(I)=0.
         IF(XHINGE(I).EQ.UNUSED)XHINGE(I)=BDIN(2)+XLE(I)+CR(I)/2.
         SSPAN(I)=SPAN(I)/2.
 1130 CONTINUE
C      
      NNX=NX+0.5
C      
      DO 1140 K=1,MAXSET
         CALL LNTRP(BDIN(3),BDIN(53),NNX,XHINGE(K),RADF(K))
 1140 CONTINUE
C***   
C***  COMPUTE CORRECTION TO PANEL NORMAL FORCE FOR BODY ELLIPTICITY
C***   
         DO 1150 KB=1,4
            FACTH(KB)=1.
            FACTV(KB)=1.
 1150    CONTINUE
         IF(.NOT. LELLB)GO TO 1170
         DO 1160 K=1,MAXSET
            CALL LNTRP(BDIN(3),BDIN(53),NNX,XHINGE(K),AWIDTH)
            CALL LNTRP(BDIN(3),BDIN(184),NNX,XHINGE(K),AHEIGH)
            AMAJX=2.*AHEIGH
            AMINX=2.*AWIDTH
            IF(AWIDTH .GT. AHEIGH)AMAJX=2.*AWIDTH
            IF(AWIDTH .GT. AHEIGH)AMINX=2.*AHEIGH
            RADF(K)=SQRT(AMAJX*AMINX)/2.

C
C***        DETERMINE CORRECTION FACTOR FOR FIN ON AN ELLIPSE.
C           FACTH IS THE CORRECTION FOR A PANEL IN THE HORZONTAL (90 DEG.)
C           POSITION.
C           FACTV IS THE CORRECTION FOR A PANEL IN THE VERTICAL POSTION.
C           CALLING ELLKWB DETERMINES THE CORRECTION FOR A PANEL AT 90
C           DEGREES FROM TOP VERTICAL CENTER FOR AN ELLIPSE WHOSE ORIENTATION
C           IS GIVEN BY BPHI. THE ELLIPSE IS IN THE HORIZONTAL POSITION WHEN 
C           BPHI=0.
C
            IF(AWIDTH .GE. AHEIGH)BPHI=90.
            IF(AWIDTH .LT. AHEIGH)BPHI=0.
            CALL ELLKWB(SPAN(K),TAN(LES(K)/RAD),TAN(TES(K)/RAD),CR(K),
     1         TAPER(K),AMAJX,AMINX,BPHI,2.*RADF(K),FACTV(K))
            IF(AWIDTH .GE. AHEIGH)BPHI=0.
            IF(AWIDTH .LT. AHEIGH)BPHI=90.
            CALL ELLKWB(SPAN(K),TAN(LES(K)/RAD),TAN(TES(K)/RAD),CR(K),
     1         TAPER(K),AMAJX,AMINX,BPHI,2.*RADF(K),FACTH(K))
 1160    CONTINUE
 1170 CONTINUE
C***   
C***  INITIALIZE DEFLECTION ANGLES IF NOT INPUT
C***   
      DO 1190 K=1,MAXSET
         DO 1180 I=1,MAXPAN
            IF(ABS(DELTA(I,K)) .EQ. UNUSED)DELTA(I,K)=0.
 1180    CONTINUE
 1190 CONTINUE
C***   
C***  CARRYOVER INTERFERENCE AND CENTER OF PRESSURE
C***   
      DO 1200 K=1,MAXSET
C      
C***  ACORR EQUALS THE ZERO LIFT ANGLE OF ATTACK FOR THE KTH FIN SET - A
C      
         ACORR=ALO(K)
         CALL SPLINE(AT(1,K),CNF(1,K),NT(K),2,2,0.,0.,ACORR,1,XX,CLA(K))
         CLA(K)=CLA(K)*RAD*SREF/AREAF(K)
         DX=LBODY-XLE(K)-CR(K)
         CALL CARRYO(MACH,RADF(K),SSPAN(K),LES(K),TES(K),CR(K),TAPER(K),
     1      AR(K),CLA(K),DX,AKWB(K),AKBW(K),AKKWB(K),AKKBW(K),XCPBW(K),
     2      XCPWB(K))
         IF(LHYPER) AKWB(K)=1.0
         IF(LHYPER) AKBW(K)=0.0
C      
C ...    REFERENCE TO CG
C      
         XCPWB(K)=(XCPWB(K)*CR(K)+XLE(K)+BDIN(2)-XCG)/DREF
         XCPBW(K)=(XCPBW(K)*CR(K)+XLE(K)+BDIN(2)-XCG)/DREF
C      
C ...    PANEL ALONE XCP SAME AS IN PRESENCE OF BODY
C      
         XCPWA(K)=XCPWB(K)
C      
C ...    INCIDENCE XCP SAME AS IN PRESENCE OF BODY
C      
         XCPWD(K)=XCPWB(K)
 1200 CONTINUE
C      
C ... SAVE NON-CORRECTED INTERFERENCE FACTOR FOR REFERENCE
C      
      DO 1210 K=1,MAXSET
          AKWB0(K)=AKWB(K)
 1210 CONTINUE
C***   
C***  CLEAR WORKING ARRAYS
C***   
      DO 1240 K=1,MAXSET
         DO 1230 I=1,MAXALP
            DO 1220 II=1,MAXPAN
               DAQ(II,I,K)=0.
               WAQ(II,I,K)=0.
 1220       CONTINUE
 1230    CONTINUE
 1240 CONTINUE
C***   
C***  LOOP FROM FRONT TO BACK ON THE CONFIGURATION
C***   
      DO 1420 K=1,MAXSET
         ICONF=K+5
         IF(.NOT. LFINL(K))GO TO 1420
         NFK=NFINS(K)
C      
C***COMPUTE THE CMO FOR EACH FIN SET FROM THE PANEL ALONE CMO'S
C      
            CMOT(K)=0.
         DO 1290 J=1,NFK
C      
C    COMPUTE THE ROLL ANGLE OF THE JTH PANEL IN THE FIN SET
C      
            PHI=PHIB+PHIF(J,K)+GAM(J,K)
C      
C    COMPUTE THE CMO OF THE JTH PANEL CORRECTED FOR PHI
C      CORRECTED IN VERSION 4/91A TO ACCOUNT FOR 2-D TO 3-D
C      EFFECTS AND REFERENCE QUANTITIES 
C  
            IF (K .NE. 1) GO TO 1250
C      
            CMCO4=F1WK(43+IM)*GFIN1(171)*(COS(GFIN1(180)/RAD))**2/
     1            (GFIN1(171)+2*COS(GFIN1(180)/RAD))
            CMO=CMCO4*ABS(SIN(PHI/RAD))*GFIN1(174)*GFIN1(184)/SREF/DREF
            GO TO 1280
C      
 1250 CONTINUE
C    
            IF (K .NE. 2) GO TO 1260
C      
            CMCO4=F2WK(43+IM)*GFIN2(171)*(COS(GFIN2(180)/RAD))**2/
     1            (GFIN2(171)+2*COS(GFIN2(180)/RAD))
            CMO=CMCO4*ABS(SIN(PHI/RAD))*GFIN2(174)*GFIN2(184)/SREF/DREF
            GO TO 1280
C      
 1260 CONTINUE
C      
            IF (K .NE. 3) GO TO 1270
C      
            CMCO4=F3WK(43+IM)*GFIN3(171)*(COS(GFIN3(180)/RAD))**2/
     1            (GFIN3(171)+2*COS(GFIN3(180)/RAD))
            CMO=CMCO4*ABS(SIN(PHI/RAD))*GFIN3(174)*GFIN3(184)/SREF/DREF
            GO TO 1280
C      
 1270 CONTINUE
C      
            CMCO4=F4WK(43+IM)*GFIN4(171)*(COS(GFIN4(180)/RAD))**2/
     1            (GFIN4(171)+2*COS(GFIN4(180)/RAD))
            CMO=CMCO4*ABS(SIN(PHI/RAD))*GFIN4(174)*GFIN4(184)/SREF/DREF
C      
 1280 CONTINUE
C      
C*** ADD THE JTH PANEL'S CMO TO THE KTH FINSET TOTAL
C      
            CMOT(K)=CMOT(K)+CMO
C      
 1290 CONTINUE
C      
C***   
C***     ANGLE OF ATTACK LOOP
C***   
         DO 1370 I=1,NALPHA
            AA=TOTC(I+60)
            PHIB=TOTC(I+40)
            IF(ABS(PHIB) .LE. UNUSED)PHIB=0.
            CDC=BDWK(I+141)
C***   
C***        PANEL IN PRESENCE OF BODY CHARACTERISTICS
C***   
C ...       K-F(B) VARIATION WITH ANGLE OF ATTACK
C      
C  TEST ROUTINES FOR NEW KWB METHOD
C
C           CALL KWBALP(AA,RADF(K),SSPAN(K),FACTOR)
            CALL KWBNEW(MACH,AA,RADF(K),SSPAN(K),AKWB0(K),FACTOR)
            IF(LHYPER) FACTOR=1.0
            AFACT(I,K)=FACTOR
c           DO 1300 II=1,MAXSET
c              AKWB(II)=AKWB0(II)*FACTOR
c1300       CONTINUE
            AKWB(K)=AKWB0(K)*FACTOR
            KSET=K
            CALL PANLCN(AA,MACH,CDC,PHIB,PHIF(1,K),GAM(1,K),ALO(K),
     1         NT(K),AT(1,K),CNF(1,K),XLE(K),SPAN(K)+2.0*RADF(K),AR(K),
     2         TAPER(K),CR(K),LODN,RADN,RADF(K),DREF,DELTA(1,K),NFK,
     3         DAQ(1,I,K),AKWB(K),AKKWB(K),BLUNT,LES(K),
     4         AREAF(K)/2.,YCPF,CNW(1,I,K),CNWING,CYWING,CLW(1,I,K),
     5         CLWING,WAQ(1,I,K),FACTH(K),FACTV(K),KSET,DFLAG)
            YCPFIN(I,K)=YCPF
C***   
C***        BODY/FIN INCREMENTALS
C***   
C ...       DO ONLY FOR BODY+FIN 1
C      
            IF(K .GT. 1)GO TO 1320
C      
            CNWB(I,K)=CNWING
            CNBW(I,K)=CNWING*AKBW(K)/AKWB(K)
            CMWB(I,K)=-CNWING*XCPWA(K)+CMOT(K)
            CMBW(I,K)=-CNBW(I,K)*XCPBW(K)
            CYWB(I,K)=CYWING
            CYBW(I,K)=CYWING*AKBW(K)/AKWB(K)
            CSNWB(I,K)=-CYWING*XCPWA(K)
            CSNBW(I,K)=-CYBW(I,K)*XCPBW(K)
            CSLWB(I,K)=CLWING
            CSLBW(I,K)=0.
C      
C ...       BODY-WING CONFIGURATION
C      
            CN(I,K)=BCN(I)+CNWB(I,K)+CNBW(I,K)
            CM(I,K)=BCM(I)+CMWB(I,K)+CMBW(I,K)
            CY(I,K)=BCY(I)+CYWB(I,K)+CYBW(I,K)
            CSN(I,K)=BCSN(I)*LATREF/DREF+CSNWB(I,K)+CSNBW(I,K)
            CSL(I,K)=BCSL(I)*LATREF/DREF+CSLWB(I,K)+CSLBW(I,K)
C
C ...       AXIAL FORCE COEFFICIENT
C      
            WINGCA=0.
            DO 1310 IW=1,NFK
               IF(ABS(ALO(K)) .LE. UNUSED) THEN
                  CALL POLINT(FL(2),FINAX(1,K),NALPHA,ABS(WAQ(IW,I,K)),
     1                       CAWALP,CAA)
               ELSE
                  AEQ = WAQ(IW,I,K)+ALO(K)
                  IF(PHIF(IW,K) .GT. 180 .OR. PHIF(IW,K) .LT. 0.0)
     1               AEQ = -WAQ(IW,I,K)+ALO(K)
                  CALL POLINT(FL(2),FINAX(1,K),NALPHA,AEQ,
     1                       CAWALP,CAA)
               ENDIF
               CAWDEL = CAWALP*COS(DELTA(IW,K)/RAD)+
     1                  CNW(IW,I,K)*SIN(DELTA(IW,K)/RAD)
               WINGCA=WINGCA+CAWDEL
 1310       CONTINUE
            CAWB(I,K)=WINGCA
            CABW(I,K)=0.
            CA(I,K)=BCA(I)+CAWB(I,K)+CABW(I,K)
C***   
C***        NEXT FIN IN-LINE AERODYNAMICS
C***   
C ...       SKIP IF ON FIRST FIN SET
C      
 1320       IF(K .EQ. 1)GO TO 1370
C      
C ...       ON NEXT IN-LINE FIN SETS (2 THROUGH 4)
C ...       LOOP FOR INTERFERENCE DUE TO FORWARD FIN VORTICES
C      
            KM1=K-1
            NFKK=NFINS(K)
C      
C ...       LOOP ON ALL FIN SETS, FROM THE FRONT OF THE VEHICLE
C      
            DO 1350 ISET=1,KM1
               NFI=NFINS(ISET)
C
C   REV 3/99 CHANGE TO ALLOW MULTIPLE FIN SETS AT SAME LOCATION.
C   PREVENTS VORTEX INTERFERENCE CALCULATIONS
C
               IF((XLE(ISET)+CR(ISET)) .GE. XLE(K)) GO TO 1345
C      
C ...          LOOP ON ALL PANELS IN THIS SET
C      
               DO 1340 IW=1,NFI
                  PHIW=PHIB+PHIF(IW,ISET)
                  IF(PHIW .GT. 360.)PHIW=PHIW-360.0
                  IF(PHIW .LT.-360.)PHIW=PHIW+360.0
                  DELWW=DELTA(IW,ISET)
                  IF(PHIW .GE. 180. .OR. PHIW .LT. 0.)DELWW=-DELWW
                  SK=SKEW(ISET)
                  CALL DIHED(PHIW,DIHW)
C      
C ...             TRACK VORTEX FROM THIS PANEL TO NEXT IN-LINE FIN SET
C      
                  CALL SFWRW(MACH,AR(ISET),TAPER(ISET),LES(ISET),
     1               TES(ISET),FWRW)
                  CALL SVTRAK(AA,DELWW,SK,DIHW,TES(ISET),(XLE(ISET)+
     1               CR(ISET)),XHINGE(ISET)-BDIN(2),(XCPWA(K)*DREF+
     2               XCG-BDIN(2)),FWRW*SSPAN(ISET),RADF(ISET),HRW,VRW)
C      
C ...             CORRECT VORTEX POSITION DUE TO DIHEDRAL OF FIN
C      
                  GAMW=GAM(IW,ISET)
                  IF(PHIW .GT. 180. .AND. PHIW .LT. 360.)GAMW=-GAMW
                  TOTANW=DIHW-GAMW
                  IF(ABS(GAMW) .GT. UNUSED)
     1               HRW=HRW+SSPAN(ISET)*FWRW*(COS(TOTANW/RAD)-
     2                  COS(DIHW/RAD))
                  IF(ABS(GAMW) .GT. UNUSED)
     1               VRW=VRW-SSPAN(ISET)*FWRW*(SIN(TOTANW/RAD)-
     2                  SIN(DIHW/RAD))
C      
C ...             COMPUTE STRENGTH OF VORTEX FROM THIS FIN
C      
                  TAUW=2.0*CNW(IW,I,ISET)*SREF/(8.0*PI*SSPAN(K)*
     1               SSPAN(ISET)*FWRW)*RAD
                  IF(PHIW .GE. 180. .AND. PHIW .LT. 360.)HRW=-HRW
                  IF(HRW .LT. 0.)TAUW=-TAUW
C      
C ...             LOOP THROUGH ALL TAIL SURFACES
C      
                  DO 1330 IT=1,NFKK
                     PHIT=PHIB+PHIF(IT,K)
                     IF(PHIT .GT. 360.)PHIT=PHIT-360.0
                     IF(PHIT .LT.-360.)PHIT=PHIT+360.0
C      
C ...                VORTEX EFFECTS ON AFT SURFACES
C ...                FIRST CORRECT FOR AFT PANEL DIHEDRAL
C      
                     HRT=HRW
                     VRT=VRW
                     CALL DIHED(PHIT,DIHT)
                     GAMT=GAM(IT,K)
                     IF(PHIT .GT. 180. .AND. PHIT .LT. 360.)GAMT=-GAMT
                     TOTANT=DIHT-GAMT
                     IF(ABS(GAMT).GT.UNUSED .AND. HRW.GT.0.)
     1                  HRT=HRW-SSPAN(K)*FWRW*(COS(TOTANT/RAD)-
     2                     COS(DIHT/RAD))
                     IF(ABS(GAMT).GT.UNUSED .AND. HRW.LT.0.)
     1                  HRT=HRW+SSPAN(K)*FWRW*(COS(TOTANT/RAD)-
     2                     COS(DIHT/RAD))
                     IF(ABS(GAMT) .GT. UNUSED)
     1                  VRT=VRW+SSPAN(K)*FWRW*(SIN(TOTANT/RAD)-
     2                     SIN(DIHT/RAD))
                     CALL VRINTS(HRT,VRT,PHIT,RADF(K),TAPER(K),
     1                  SSPAN(ISET),VRINT)
C      
C ...                SUM VORTEX INFLUENCE WITH OTHER VORTICES
C      
                     DAQ(IT,I,K)=DAQ(IT,I,K)+TAUW*VRINT
 1330             CONTINUE
 1340          CONTINUE
 1345          CONTINUE
 1350       CONTINUE
C***   
C***        NOW COMPUTE AFT FIN PANEL LOADS DUE TO VORTICES
C***   
            KSET=K
            CALL PANLCN(AA,MACH,CDC,PHIB,PHIF(1,K),GAM(1,K),ALO(K),
     1         NT(K),AT(1,K),CNF(1,K),XLE(K),SPAN(K)+2.0*RADF(K),
     2         AR(K),TAPER(K),CR(K),LODN,RADN,RADF(K),DREF,
     3         DELTA(1,K),NFKK,DAQ(1,I,K),AKWB(K),AKKWB(K),BLUNT,
     4         LES(K),AREAF(K)/2.,YCPF,CNW(1,I,K),CNWING,CYWING,
     5         CLW(1,I,K),CLWING,WAQ(1,I,K),FACTH(K),FACTV(K),KSET,
     6         DFLAG)
            YCPFIN(I,K)=YCPF
C      
C ...       TAIL IN PRESENCE OF THE BODY
C      
            CNWB(I,K)=CNWING
            CNBW(I,K)=CNWING*AKBW(K)/AKWB(K)
            CMWB(I,K)=-CNWING*XCPWA(K)+CMOT(K)
            CMBW(I,K)=-CNBW(I,K)*XCPBW(K)
            CYWB(I,K)=CYWING
            CYBW(I,K)=CYWING*AKBW(K)/AKWB(K)
            CSNWB(I,K)=-CYWING*XCPWA(K)
            CSNBW(I,K)=-CYBW(I,K)*XCPBW(K)
            CSLWB(I,K)=CLWING
            CSLBW(I,K)=0.
C      
C ...       TOTAL CONFIGURATION DATA
C      
            CN(I,K)=CN(I,KM1)+CNWB(I,K)+CNBW(I,K)
            CM(I,K)=CM(I,KM1)+CMWB(I,K)+CMBW(I,K)
            CY(I,K)=CY(I,KM1)+CYWB(I,K)+CYBW(I,K)
            CSN(I,K)=CSN(I,KM1)+CSNWB(I,K)+CSNBW(I,K)
            CSL(I,K)=CSL(I,KM1)+CSLWB(I,K)+CSLBW(I,K)
C
C ...       AXIAL FORCE COEFFICIENT
C      
            TAILCA=0.
            DO 1360 IT=1,NFKK
               IF((ALO(K)) .LE. UNUSED) THEN
                  CALL POLINT(FL(2),FINAX(1,K),NALPHA,ABS(WAQ(IT,I,K)),
     1                       CAWALP,CAA)
               ELSE
                  AEQ = WAQ(IT,I,K)+ALO(K)
                  IF(PHIF(IT,K) .GT. 180 .OR. PHIF(IT,K) .LT. 0.0)
     1               AEQ = -WAQ(IT,I,K)+ALO(K)
                  CALL POLINT(FL(2),FINAX(1,K),NALPHA,AEQ,
     1                       CAWALP,CAA)
               ENDIF
               CAWDEL = CAWALP*COS(DELTA(IT,K)/RAD)+
     1                  CNW(IT,I,K)*SIN(DELTA(IT,K)/RAD)
               TAILCA=TAILCA+CAWDEL
 1360       CONTINUE
            CAWB(I,K)=TAILCA
            CABW(I,K)=0.
            CA(I,K)=CA(I,KM1)+CAWB(I,K)+CABW(I,K)
 1370    CONTINUE
         DO 1380 JK=1,120
            DUMMY(JK)=UNUSED
 1380    CONTINUE
C      
C      CHECK TO SEE IF CONFIGURATION INCREMENTING IS TO BE USED
C      
         IF(.NOT. LICRMT)GO TO 1390
C      
C      CHECK TO SEE IF FULL CONFIGURATION IS CURRENTLY BEING SYNTHESISED
C      IF LOOP IS ON FULL CONFIGURATION DO INCREMENTING
C      IF NOT CONTINUE CONFIGURATION SYNTHESIS
C      
         IF( K .NE. MAXSET)GO TO 1420
C      
C      IF THIS IS THE INITIAL CASE CALL SUBROUTINE SUBEXP TO GET
C         EXPERIMENTAL DATA
C      
         IF(ICASE .EQ. 1 .AND. ZIP .EQ. 0.)
     1      CALL SUBEXP(IFOUND,MACH,ICONF,DUMMY)
C      
C      CALL SUBROUTINES TO PERFORM CONFIGURATION INCREMENTING IF
C         EXPERIMENTAL DATA HAS BEEN INPUT FOR THAT COEFFICIENT
C      
         IF( DUMMY(1)  .NE. UNUSED .OR. COREC(2) .NE. UNUSED)
     1     CALL CNINC(ICASE,CN,K+1,DUMMY,PHIB)
         IF( DUMMY(21) .NE. UNUSED .OR. COREC(24) .NE. UNUSED)
     1     CALL CMINC(ICASE,CM,K+1,DUMMY,PHIB)
         IF( DUMMY(41) .NE. UNUSED .OR. COREC(45) .NE. UNUSED)
     1     CALL CAINC(ICASE,CA,K+1,DUMMY)
         IF( DUMMY(61) .NE. UNUSED .OR. COREC(66) .NE. UNUSED)
     1     CALL CYINC(ICASE,CY,CN,K+1,DUMMY,PHIB)
         IF( DUMMY(81) .NE. UNUSED .OR. COREC(88) .NE. UNUSED)
     1     CALL CSNINC(ICASE,CSN,CM,K+1,DUMMY,PHIB)
         IF(DUMMY(101) .NE. UNUSED .OR. COREC(109).NE. UNUSED)
     1     CALL CSLINC(ICASE,CSL,K+1,DUMMY)
         ZIP=1.
         GO TO 1400
 1390    CALL SUBEXP(IFOUND,MACH,ICONF,DUMMY)
C      
C      IF A COEFFICIENT HAS EXPERIMENTAL INPUT OR HAS BEEN INCREMENTED
C         UPDATE THE APPROPRIATE ARRAY
C      
 1400    CONTINUE
         DO 1410 I=1,NALPHA
            IF(DUMMY(I    ) .NE. UNUSED)CN (I,K)=DUMMY(I    )
            IF(DUMMY(I+20 ) .NE. UNUSED)CM (I,K)=DUMMY(I+20 )
            IF(DUMMY(I+40 ) .NE. UNUSED)CA (I,K)=DUMMY(I+40 )
            IF(DUMMY(I+60 ) .NE. UNUSED)CY (I,K)=DUMMY(I+60 )
            IF(DUMMY(I+80 ) .NE. UNUSED)CSN(I,K)=DUMMY(I+80 )
            IF(DUMMY(I+100) .NE. UNUSED)CSL(I,K)=DUMMY(I+100)
 1410    CONTINUE
C      
C***     THIS SETS FLAGS FOR CALL TO SUBROUTINE BLKLDD
C        TO DETERMINE WHICH LATERAL DIRECTIONAL COEFFICIENTS
C        HAVE EXPERIMENTAL INPUTS FOR WHICH CONFIGURATION
C      
         IF ( DUMMY(61) .NE. UNUSED) IFLAGA(1,ICONF-5) = 1
         IF ( DUMMY(81) .NE. UNUSED) IFLAGA(2,ICONF-5) = 1
         IF ( DUMMY(101).NE. UNUSED) IFLAGA(3,ICONF-5) = 1
 1420 CONTINUE
C      
C***  CHANGE ZCG FOR BODY ALONE AND BODY PLUS FINS
C   
      IF(ABS(ZCG) .LE. UNUSED)GO TO 1440
         DO 1430 I=1,NALPHA
            CALL ADDZCG(ZCG,DREF,BCA(I),BCM(I))
            CALL ADDZCG(ZCG,LATREF,BCY(I),BCSL(I))
            DO 1435 K=1,MAXSET
               CALL ADDZCG(ZCG,DREF,CA(I,K),CM(I,K))
               CALL ADDZCG(ZCG,LATREF,CY(I,K),CSL(I,K))
 1435       CONTINUE
 1430    CONTINUE
 1440 CONTINUE
C***   
C***  DIFFERENTIATE CN AND CM AND CHANGE LAT-DIR REFERENCE LENGTH
C***   
      DO 1450 K=1,MAXSET
      DO 1455 I=1,NALPHA
         CALL POLINT(FL(2),CN(1,K),NALPHA,FL(I+1),CNI,CNA(I,K))
         CALL POLINT(FL(2),CM(1,K),NALPHA,FL(I+1),CMI,CMA(I,K))
         CSNWB(I,K)=CSNWB(I,K)*DREF/LATREF
         CSNBW(I,K)=CSNBW(I,K)*DREF/LATREF
         CSN(I,K)=CSN(I,K)*DREF/LATREF
         CSLWB(I,K)=CSLWB(I,K)*DREF/LATREF
         CSLBW(I,K)=CSLBW(I,K)*DREF/LATREF
         CSL(I,K)=CSL(I,K)*DREF/LATREF
 1455    CONTINUE
 1450 CONTINUE
C***   
C***  SAVE CALCULATED DATA IN APPROPIATE COMMON BLOCKS
C***   
      DO 1460 I=1,20
         CN1  (I)=CN (I,1)
         CN12 (I)=CN (I,2)
         CN13 (I)=CN (I,3)
         CN14 (I)=CN (I,4)
         CM1  (I)=CM (I,1)
         CM12 (I)=CM (I,2)
         CM13 (I)=CM (I,3)
         CM14 (I)=CM (I,4)
         CA1  (I)=CA (I,1)
         CA12 (I)=CA (I,2)
         CA13 (I)=CA (I,3)
         CA14 (I)=CA (I,4)
         CY1  (I)=CY (I,1)
         CY12 (I)=CY (I,2)
         CY13 (I)=CY (I,3)
         CY14 (I)=CY (I,4)
         CSN1 (I)=CSN(I,1)
         CSN12(I)=CSN(I,2)
         CSN13(I)=CSN(I,3)
         CSN14(I)=CSN(I,4)
         CSL1 (I)=CSL(I,1)
         CSL12(I)=CSL(I,2)
         CSL13(I)=CSL(I,3)
         CSL14(I)=CSL(I,4)
         CNA1 (I)=CNA(I,1)
         CNA12(I)=CNA(I,2)
         CNA13(I)=CNA(I,3)
         CNA14(I)=CNA(I,4)
         CMA1 (I)=CMA(I,1)
         CMA12(I)=CMA(I,2)
         CMA13(I)=CMA(I,3)
         CMA14(I)=CMA(I,4)
 1460 CONTINUE
C***   
C***  PRINT PARTIAL OUTPUT IF REQUESTED
C***   
      IF(PARTS(11))CALL SYNPAR(IM,NALPHA,FL(2),MAXSET,NFINS,XCPWA,
     1   YCPFIN,AFACT)
C***   
C***  PRINT HINGE AND/OR BENDING MOMENT RESULTS
C***   
      IF(PARTS(13) .OR. PARTS(14))
     1  CALL HINGEM(IM,MAXSET,NFINS,RADF,DELTA,DREF,XCG,XHINGE,
     2  SKEW,SSPAN,YCPFIN,XCPWA)
C***   
C***  EXIT
C***   
 1470 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION YMGC(SPAN,CROOT,TAPER)
C
C***  FUNCTION TO COMPUTE THE LATERAL POSITION OF THE FIN
C***  MEAN GEOMETRIC CHORD MEASURED FROM ROOT CHORD
C
C***  INPUTS
C
C   SPAN -- PANEL EXPOSED SPAN (TIP-TO-TIP) FOR TWO PANELS
C           JOINED AT THEIR EXPOSED ROOT CHORDS
C  CROOT -- PANEL EXPOSED ROOT CHORD
C  TAPER -- PANEL TIP CHORD DIVIDED BY EXPOSED ROOT CHORD
C
C***  SECTION MEAN GEOMETRIC CHORD
C
      CBAR=FINMGC(CROOT,TAPER)
C
C***  LATERAL POSITION OF M.G.C. FROM ROOT CHORD
C
      YMGC=SPAN/2.*(1.+2.*TAPER)/(3.*(1.+TAPER))
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCMP(CMALP,ALPHA,CMP)
C
C***  SUBROUTINE TO COMPUTE THE POTENTIAL PITCHING MOMENT FOR BODIES
C***  METHOD OF ALLEN AND PERKINS
C
C  MODIFIED BY W. BLAKE, WL/FIGC
C
C***  INPUTS
C
C  CMALP -- PITCHING MOMENT SLOPE, PER RADIAN
C  ALPHA -- ANGLE OF ATTACK, DEGREES
C
C***  OUTPUT
C
C    CMP -- POTENTIAL PITCHING MOMENT COEFFICIENT AT ANGLE OF ATTACK
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
C  REV 3/99 CORRECT CALCULATION FOR ALPHA > 90 OR < -90
C
      ALP=ALPHA
      IF(ALPHA.GT.90.)  ALP=ALPHA-180.
      IF(ALPHA.LT.-90.) ALP=180.-ALPHA
      CMP=CMALP/2.*SIN(2.*ALP/RAD)*COS(ALP/RAD/2.)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CDPRES (NX,X,R,SREF,MACH,FRNOSE,
     1                   VOLNOS,LNOSE,MSUB,CDPO,CDTOT)
C     ****************************************************************
C
C             THIS SUBROUTINE CALCULATES THE WAVE DRAG COEFFICIENT 
C             OF ARBITRARY AXISYMMETRIC BODIES FOR TRANSONIC AND 
C             SUPERSONIC FLOW.  SUPERSONICALLY, THE AREA RULE IS 
C             USED.  IN ORDER TO DETERMINE THE TRANSONIC VALUES,
C             A CUBIC SPLINE IS FIT TO CONNECT THE SUBSONIC AND 
C             SUPERSONIC REGIMES.  THE DRAG RISE IS THEN CAPTURED
C             IN THE TRANSONIC RANGE.
C
C     ****************************************************************
C
C  MODIFIED BY W. BLAKE, WL/FIGC
C
C     THE INPUT DATA REQUIRED CONSISTS OF:
C         NX     = NUMBER OF STEPS ALONG THE LONGITUDINAL AXIS
C         X(I)   = LONGITUDINAL STATIONS (DOES NOT HAVE TO
C                  CORRESPOND TO X=0 AT THE NOSE)
C         R(I)   = RADIUS ASSOCIATED WITH EACH X LOCATION
C         SREF   = REFERENCE AREA                          
C         MACH   = MACH NUMBER AT WHICH THE WAVE DRAG IS TO BE 
C                   CALCULATED   
C         FRNOSE = NOSE FINENESS RATIO
C         VOLNOS = VOLUME OF THE NOSE
C         LNOSE  = LENGTH OF THE NOSE
C         MSUB   = MACH NUMBER AT WHICH FLOW IS CONSIDERED SUBSONIC
C         CDPO   = INCOMPRESSIBLE PRESSURE DRAG AT MSUB
C                                       
C     OUTPUT:
C         CDTOT  = TRANSONIC PRESSURE/WAVE DRAG COEFFICIENT
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      DIMENSION R(50),X(50)                               
      PARAMETER (NMAX=100)
      DIMENSION XNOSE(NMAX), CRDIUS(NMAX), CAREA(NMAX), 
     1          XU(NMAX), XL(NMAX), AREA(NMAX), PHI1(NMAX), 
     2          PHI2(NMAX), C1(NMAX), C2(NMAX), C3(NMAX),
     3          XPNT(NMAX),RPNT(NMAX)
      REAL LNOSE, NX, MACH, MA, K1, K2, MSUB, MSUP, K1TRAN, K2TRAN       
C                                    
C           FUNCTIONS USED IN CALCULATING THE TERMS OF THE INTEGRAL
C           FOR THE FOURIER COEFFICIENTS.  A FOURIER SINE SERIES 
C           EXPRESSION IS USED TO SOLVE THE INTEGRAL FOR THE WAVE DRAG.
C           THESE FUNCTIONS ARE USED ONLY WHEN THE AREA RULE MUST BE
C           CALCULATED.
C
C     INTEGRAL OF SIN(N*PHI)
      FIS(N,FEE)=-COS(N*FEE)/N
C
C     INTEGRAL OF SIN(N*PHI)*COS(PHI)
      FISC(N,FEE)=-COS((N-1)*FEE)/(2.*(N-1))-COS((N+1)*FEE)/(2.*(N+1))
C
C     INTEGRAL OF SIN(N*PHI)*COS(PHI) FOR N=1
      FISC1(FEE)=SIN(FEE)**2/2.
C
C     INTEGRAL OF SIN(N*PHI)*COS(PHI)**2
      FISC2(N,FEE)=-1.*((N**2-2.*N)*COS((N+2)*FEE)+(2.*N**2-8.)*
     1             COS(N*FEE)+(N**2+2.*N)*COS((N-2)*FEE))/
     2             (4.*N**3-16.*N)
C
C     INTEGRAL OF SIN(N*PHI)*COS(PHI)**2 FOR N=1 
      FISC21(FEE)=-1./3.*COS(FEE)**3
C
C     INTEGRAL OF SIN(N*PHI)*COS(PHI)**2 FOR N=2
      FISC22(FEE)=-1./2.*COS(FEE)**4
C           
C     ASSIGN INTEGER VALUE FOR NX
      INX = NX
C
C  INITIALIZE ROUTINE SPECIFIC ARRAYS TO ZERO
C  REV 1/96 FIX FOR 64 BIT COMPILERS
C
      DO 40 I=1,100
         XNOSE(I)=0.
         CRDIUS(I)=0.
         CAREA(I)=0.
         XU(I)=0.
         XL(I)=0.
         AREA(I)=0.
         PHI1(I)=0.
         PHI2(I)=0.
         C1(I)=0.
         C2(I)=0.
         C3(I)=0.
         XPNT(I)=0.
         RPNT(I)=0.
  40  CONTINUE
C
C     ONLY THE NOSE COORDINATES ARE NEEDED
      JNX = 0
      DO 50 I=1,INX
         JNX = JNX + 1
         IF (X(I) .EQ. (X(1)+LNOSE)) GOTO 75
         IF (X(I) .GT. (X(1)+LNOSE+0.00001)) THEN
            JNX = JNX - 1
            GOTO 75
         ENDIF
   50 CONTINUE
C
   75 CONTINUE
C
C     TRANSFER X COORDINATES TO CORRESPOND TO X=0 AT THE NOSE
      DO 100 I=1,JNX
         XNOSE(I)=ABS(X(I)-X(1))
  100 CONTINUE                              
C
C     CALCULATE CUBIC SPLINE COEFFICIENTS FOR THE BODY RADIUS CONTOUR
      CALL SPLIN2(JNX,XNOSE,R,CRDIUS)
C
C     GENERATE 20 POINTS TO DEFINE THE NOSE
      IX = 0
      IF (JNX .LT. 20) THEN
C
         XPNT(1)  = 0.
         XPNT(20) = XNOSE(JNX)
         RPNT(1)  = 0.
         RPNT(20) = R(JNX)
         IX = 20
         DO 200 I=2,19
            XPNT(I) = XNOSE(JNX)/20.*I
            CALL EVAL(JNX,XNOSE,XPNT(I),R,RPNT(I),CRDIUS)
  200    CONTINUE
C
      ELSE
         DO 250 I=1,JNX
            XPNT(I) = XNOSE(I)
            RPNT(I) = R(I)
            IX = IX+1
  250    CONTINUE
C
      ENDIF
C
C     VOLUME CALCULATIONS TO BE USED IN CORRECTION FOR 
C     ARBITRARY BODY.  CODE IS CALIBRATED TO IMPROVE THE 
C     RESULTS FOR BODIES WHICH HAVE SHAPES THAT ARE NOT 
C     CONDUCIVE TO SLENDER BODY THEORY.
C
C     CALCULATE VOLUME OF A CONE WITH THE SAME LENGTH AND BASE RADIUS
      VCONE=PI*R(JNX)**2*LNOSE/3.                                     
C                     
C     CALCULATE VOLUME OF A TANGENT OGIVE WITH THE SAME LENGTH
C     AND BASE RADIUS         
      R1=(LNOSE**2+R(JNX)**2)/(2.*R(JNX))
      R2=R1-R(JNX)                                  
      VTNOGV=PI*LNOSE**3*(R1**2/LNOSE**2*(1.0-R2/LNOSE*
     1       ASIN(LNOSE/R1))-1./3.)
C
C     SET TRANSONIC CALCULATION FLAG TO OFF
      ICHECK=0.0
C
C     SET THE TRANSONIC BOUNDARY MACH NUMBERS
      MSUP=1.20                         
C
      CDMACH=MACH
      IF (MACH.LT.MSUP) CDMACH=MSUP
C
C***  START OF SUPERSONIC CALCULATIONS
  400 CONTINUE
C
C     THIS PORTION OF THE SUBROUTINE CALCULATES THE
C     SUPERSONIC WAVE DRAG USING THE AREA RULE.
C
C     OUTER LOOP FOR MACH NUMBER DEPENDENCE.
C     IF MACH NUMBER IS GREATER THAN ONE, OBLIQUE AREA 
C     DISTRIBUTIONS ARE CALCULATED.
      IF (CDMACH .GT. 1.) THEN
C                              
         MA=ASIN(1./CDMACH)         
         BTA=SQRT(CDMACH**2-1.)
C
C        CALCULATE X STATION WHERE THE MACH LINE  
C        INTERSECTS THE LOWER RADIUS CONTOUR
         DO 500 I=1,1000
C     
C           ADD CYLINDRICAL MIDBODY TO ALLOW THE MACH LINE TO
C           COMPLETE THE FULL LENGTH OF THE NOSE
            IF (I .GT. IX) XPNT(I)=XPNT(I-1)+XPNT(IX)/IX
C
C           INITIALIZE BISECTION STARTING VALUES
            XLE=XPNT(1)
            XR=XPNT(I)
  600       T=(XLE+XR)/2.                          
C         
C           IF MACH LINE INTERSECTION IS AT THE NOSE 
C           THEN GO TO NEXT PT.
            IF (T .LT. 0.0001) GOTO 700   
C
C           FIND THE RADIUS CORRESPONDING TO THE 
C           CURRENT X-VALUE (T)
            IF (T .LT. XPNT(IX)) THEN
               CALL EVAL(IX,XPNT,T,RPNT,RE,CRDIUS)
            ELSE
               RE=R(JNX)
            ENDIF
C
C           CHECK IF R CORRESPONDS TO THE RADIUS AT THE INTERSECTION
            H=(XPNT(I)-T)*TAN(MA)
            IF (ABS(H-RE) .LT. 0.0001) GOTO 700                 
C
C           CONTINUE WITH BISECTION IF NECESSARY
            IF (H .LT. RE) THEN
               XR=T
            ELSE
               XLE=T
            ENDIF
            GOTO 600  
C
C           X STATION WHERE THE MACH LINE INTERSECTS 
C           THE LOWER RADIUS CONTOUR
  700       XL(I)=T     
C
C           IF X LOWER HAS PASSED THE BODY THEN STOP
            IF (XL(I) .GT. XPNT(IX)) THEN 
               IF (ICHECK .EQ. 500) XPNT(I+1)=0.
               NUM=I
               GOTO 800 
            ENDIF
  500    CONTINUE                                   
C
C        CALCULATE X STATION WHERE THE MACH LINE  
C        INTERSECTS THE UPPER RADIUS CONTOUR
  800    DO 900 I=1,NUM 
C
C           ESTABLISH CENTERBODY
            XCYL=LNOSE*2.
C            
C           INITIALIZE BISECTION STARTING VALUES
            XLE=XPNT(I)
            XR=XCYL
 1000       T=(XLE+XR)/2. 
C
C           ENSURE ADEQUATE CENTERBODY LENGTH
            IF ((XCYL-T) .LT. 0.01) THEN
               XCYL=XCYL*2.
               XR=XCYL
               GOTO 1000
            ENDIF                            
C
C           FIND THE RADIUS CORRESPONDING TO THE 
C           CURRENT X-VALUE (T)
            IF (T .LE. XPNT(IX)) THEN
               CALL EVAL(IX,XPNT,T,RPNT,RE,CRDIUS)
            ELSE
               RE=R(JNX)
            ENDIF 
C
C           CHECK IF R CORRESPONDS TO THE RADIUS AT THE INTERSECTION
            H=(T-XPNT(I))*TAN(MA)
            IF (ABS(H-RE) .LT. 0.0001) GO TO 1100
C
C           CONTINUE WITH BISECTION 
            IF (H .LT. RE) THEN                  
               XLE=T
            ELSE
               XR=T
            ENDIF
           GOTO 1000
C                           
C           X UPPER HAS BEEN FOUND
 1100       XU(I)=T          
  900    CONTINUE  
C
C         CALCULATION OF MACH LINE INTERSECTION IS NOT NECESSARY (MACH=1)
          ELSE
             NUM=IX
          ENDIF
C
C     CALCULATE AREA OF EACH OBLIQUE PLANE USING SIMPSON'S RULE
      DO 1200 I=1,NUM
C
C        USE FRONTAL PROJECTIONS FOR M > 1
         IF (CDMACH .GT. 1.) THEN          
C
C           INITIALIZE STARTING VALUES
            ATEMP=XL(I)
            BTEMP=XU(I)
            M=10
            H=(BTEMP-ATEMP)/(2.*M)         
            XI0=0.
            XI1=0.
            XI2=0.                    
            DO 1300 J=1,2*M-1
               TEMP=ATEMP+J*H                        
               IF (TEMP .LE. XPNT(IX)) THEN
                  CALL EVAL(IX,XPNT,TEMP,RPNT,RTEMP,CRDIUS) 
               ELSE
                  RTEMP=R(JNX)
               ENDIF
C
C              CHECK TO ENSURE RDIFF IS POSITIVE
               RDIFF=BTA**2*RTEMP**2-(TEMP-XPNT(I))**2
               RDIFF=MAX(RDIFF,0.)              
               IF (MOD(J,2) .EQ. 0) THEN
                  XI2=XI2+SQRT(RDIFF)
               ELSE
                  XI1=XI1+SQRT(RDIFF)
               ENDIF
 1300       CONTINUE      
C                        
C           SUM UP XI'S TO GET AREA(I)
            AREA(I)=H*(XI0+2.*XI2+4.*XI1)/3.*2./BTA**2  
C
C        SUM UP AREAS FOR M=1 CASE
         ELSE
            AREA(I)=PI*RPNT(I)**2         
         ENDIF
 1200 CONTINUE 
C
C     SPLINE FIT AREA DISTRIBUTION                      
      CALL SPLIN2(NUM,XPNT,AREA,CAREA)                 
C
C     LOOP TO DETERMINE CONSTANTS FOR INTEGRATION
      XPNT(NUM+1)=0.0
      DO 1400 J=1,NUM      
C
C        DETERMINE PHI AT EACH SUBINTERVAL ENDPOINT
         PHI2(J)=ACOS(2.*XPNT(J)/XPNT(NUM)-1.)
         PHI1(J)=ACOS(2.*XPNT(J+1)/XPNT(NUM)-1.)                 
C
C        EQUIVALENT X-VALUE AT EACH PHI
         XPHI2=XPNT(J)
         XPHI1=XPNT(J+1)
C
C        DETERMINE VALUE OF THE FUNCTION AT EACH ENDPOINT
         F1=AREA(J+1)
         F2=AREA(J)                         
C
C        SLOPE OF FUNCTION AT EACH ENDPOINT
         K2=CAREA(J)
         K1=CAREA(J+1)              
C
C        CALCULATE COEFFICIENTS OF THE CUBIC
         A1=6.*XPHI1*XPHI2*(F1-F2)/(XPHI2-XPHI1)**3+
     1      (K1*(XPHI2**2+2.*XPHI1*XPHI2)+K2*
     2      (2.*XPHI1*XPHI2+XPHI1**2))/(XPHI2-XPHI1)**2
         A2=3.*(XPHI2+XPHI1)*(F2-F1)/(XPHI2-XPHI1)**3-
     1      (K1*(2.*XPHI2+XPHI1)+K2*(XPHI2+2.*XPHI1))/
     2      (XPHI2-XPHI1)**2
         A3=2.*(F1-F2)/(XPHI2-XPHI1)**3+(K1+K2)/(XPHI2-XPHI1)**2
C
C        GROUP THE CONSTANTS OF INTEGRATION  
         C1(J)=A1+A2*XPNT(NUM)+3./4.*A3*XPNT(NUM)**2
         C2(J)=A2*XPNT(NUM)+3./2.*A3*XPNT(NUM)**2
         C3(J)=3./4.*A3*XPNT(NUM)**2 
 1400 CONTINUE
C
C     CALCULATE 25 FOURIER COEFFICIENTS USING EXACT SOLUTION
      ICOUNT=25
      CD=0.
      DO 1500 I=1,ICOUNT
         FOFX=0.
C
C        INNER LOOP TO DETERMINE THE VALUE OF THE FUNCTION
         DO 1600 J=1,NUM-1                      
C
C           CALCULATE THE THREE TERMS OF THE INTEGRAL  
            TERM1=C1(J)*(FIS(I,PHI2(J))-FIS(I,PHI1(J)))
            IF (I .EQ. 1) THEN
               TERM2=C2(J)*(FISC1(PHI2(J))-FISC1(PHI1(J)))
               TERM3=C3(J)*(FISC21(PHI2(J))-FISC21(PHI1(J)))
            ELSE IF (I .EQ. 2) THEN
               TERM2=C2(J)*(FISC(I,PHI2(J))-FISC(I,PHI1(J)))
               TERM3=C3(J)*(FISC22(PHI2(J))-FISC22(PHI1(J))) 
            ELSE
               TERM2=C2(J)*(FISC(I,PHI2(J))-FISC(I,PHI1(J)))
               TERM3=C3(J)*(FISC2(I,PHI2(J))-FISC2(I,PHI1(J)))
            ENDIF       
C
C           SUM THE TERMS 
            FOFX=FOFX+TERM1+TERM2+TERM3 
 1600    CONTINUE
C
C        DETERMINE THE FOURIER COEFFICIENTS 
         ASUBN=FOFX*2./PI
         CD=CD+I*ASUBN**2
 1500 CONTINUE                            
C
C     CALCULATE CD TOTAL 
      CDTOT=CD*PI/(4.*SREF)*FRCOR(FRNOSE,VOLNOS,VCONE,VTNOGV)
C
C***  END OF SUPERSONIC CALCULATIONS
C
C***  START OF TRANSONIC CALCULATIONS
      IF (MACH.LT.MSUP) THEN
        IF (CDMACH.EQ.MSUP) THEN
C
C         CALCULATE VALUE AT MACH + 0.10 TO ALLOW FOR
C         A SLOPE TO BE DETERMINED.
          F2TRAN=CDTOT            
          CDTOT=0.
          ICHECK=500
C
C         SINCE THE SLOPE OF THE CURVE AT MACH NUMBER 1.2 IS NEEDED,
C         THE WAVE DRAG COEFFICIENT MUST BE CALCULATED ONCE MORE.  A 
C         FINITE DIFFERENCE IS USED BETWEEN MACH NUMBERS 1.2 AND 1.3
C         TO DETERMINE THE SLOPE, K2.
          CDMACH=CDMACH+0.10
          GOTO 400 
        ENDIF
C
C       SLOPE IS DETERMINED FOR USE IN TRANSONIC CALCULATION.
        K2TRAN=(F2TRAN - CDTOT)/0.1 
C
C       THIS PORTION OF THE SUBROUTINE CALCULATES THE
C       TRANSONIC PRESSURE DRAG.  A CUBIC SPLINE WILL
C       CONNECT THE SUBSONIC AND SUPERSONIC REGIMES.
C       THIS WILL ENABLE THE TRANSONIC DRAG RISE TO BE
C       CALCULATED.
C
C       THE VALUE (F1TRAN) AND SLOPE (K1TRAN) OF THE CURVE FIT
C       IS DETERMINED FOR THE TRANSONIC RANGE.
        F1TRAN = CDPO/SQRT(1.-MSUB**2)
        K1TRAN = CDPO*MSUB*(1.-MSUB**2)**(-1.5)
C                         
C       CALCULATE COEFFICIENTS OF THE CUBIC
        A0=(F1TRAN*(MSUP**3-3.*MSUB*MSUP**2)+F2TRAN*(3.*MSUB**2*MSUP-
     1      MSUB**3))/(MSUP-MSUB)**3-(K1TRAN*MSUB*MSUP**2+K2TRAN*MSUB**
     2      2*MSUP)/(MSUP-MSUB)**2
        A1=6.*MSUB*MSUP*(F1TRAN-F2TRAN)/(MSUP-MSUB)**3+
     1      (K1TRAN*(MSUP**2+2.*MSUB*MSUP)+K2TRAN*
     2      (2.*MSUB*MSUP+MSUB**2))/(MSUP-MSUB)**2
        A2=3.*(MSUP+MSUB)*(F2TRAN-F1TRAN)/(MSUP-MSUB)**3-
     1      (K1TRAN*(2.*MSUP+MSUB)+K2TRAN*(MSUP+2.*MSUB))/
     2      (MSUP-MSUB)**2
        A3=2.*(F1TRAN-F2TRAN)/(MSUP-MSUB)**3+(K1TRAN+K2TRAN)/
     1      (MSUP-MSUB)**2                           
C                        
C       TRANSONIC VALUE IS COMPUTED
        CDTOT = A0 + A1*MACH + A2*MACH**2 + A3*MACH**3
      ENDIF
C
C***  END OF TRANSONIC CALCULATIONS
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CVRFLT(ISIGN)
C
C***  ROUTINE TO CONVERT THE DATA IN THE FLIGHT CONDITIONS
C***  DATA BLOCKS BETWEEN THE USER AND FOOT SYSTEM OF UNITS
C
C ISIGN=+1 CONVERTS FROM FT-LB SYSTEM TO USER SYSTEM
C ISIGN=-1 CONVERTS FROM USER SYSTEM TO FT-LB SYSTEM
C
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C
      REAL NALPHA,NMACH,MACH
      COMMON /LOGIC/  LFLAGS(18),LDIMIN,LDIMFT,LDIMCM,LDIMM,LDUM2(6)
C
      LOGICAL         LFLAGS    ,LDIMIN,LDIMFT,LDIMCM,LDIMM
C
      IF(LDIMIN .OR. LDIMFT)GO TO 1020
      IF(.NOT. (LDIMCM .OR. LDIMM))GO TO 1020
C
C***  CONVERT ALTITUDE,
C             VELOCITY, TEMPERATURE, REYNOLDS NUMBER AND PRESSURE
C
         DO 1010 I=1,20
         IF(ISIGN .LT. 0 .AND. ALT(I) .NE. UNUSED) ALT(I)=ALT(I)*3.28
         IF(ISIGN .GT. 0 .AND. ALT(I) .NE. UNUSED) ALT(I)=ALT(I)/3.28
            IF(ISIGN.LT.0 .AND. VINF(I).NE.UNUSED) VINF(I)=VINF(I)*3.28
            IF(ISIGN.GT.0 .AND. VINF(I).NE.UNUSED) VINF(I)=VINF(I)/3.28
            IF(ISIGN.LT.0 .AND. REN(I).NE.UNUSED) REN(I)=REN(I)/3.28
            IF(ISIGN.GT.0 .AND. REN(I).NE.UNUSED) REN(I)=REN(I)*3.28
            IF(ISIGN .LT. 0 .AND. PINF(I) .NE. UNUSED)
     1         PINF(I)=PINF(I)/47.88
            IF(ISIGN .LT. 0 .AND. TINF(I) .NE. UNUSED)
     1         TINF(I)=TINF(I)*9./5.
            IF(ISIGN .GT. 0 .AND. PINF(I) .NE. UNUSED)
     1         PINF(I)=PINF(I)*47.88
            IF(ISIGN .GT. 0 .AND. TINF(I) .NE. UNUSED)
     1         TINF(I)=TINF(I)*5./9.
 1010    CONTINUE
 1020 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE EVAL(NUM,X,XVAL,Y,YVAL,C)
      PARAMETER (NMAX=100)
      DIMENSION C(NMAX),X(NMAX),Y(NMAX)
C
C     THIS SUBROUTINE EVALUATES THE VALUE OF F AND F' AT ARBITRARY
C     VALUES OF ETA GIVEN THE SPLINE COEFFICIENTS
C
C  WRITTEN BY A. JENN, MCDONNELL DOUGLAS
C
C     FIND THE INDEX WHERE XVAL FALLS IN THE DATA
      IL = 1
      IH= NUM
      DO 10 J=1,50
         I = (IL + IH) / 2
         IF (XVAL .GE. X(I)) THEN
            IL = I
         ELSE
            IH = I
         END IF            
         IF ((IH - IL) .EQ. 1) THEN
            I = IH
            GOTO 20
         END IF
   10 CONTINUE
C
C     EVALUATE THE VALUES OF F
   20 CONTINUE
C
         XI=X(I)
         XIM1=X(I-1)
         YI=Y(I)
         YIM1=Y(I-1)
C
C ***    C(I) SELECTED BASED UPON THE SEGMENT WE ARE IN
C
         CI=C(I)
         CIM1=C(I-1)
C
         DXI=XI-XIM1
         T=(XVAL-XIM1)/DXI
         TBAR=1.-T
         DYI=YI-YIM1
         DI=DYI/DXI
C
C ***  YVAL IS THE Y VALUE FROM THE SPLINE
       YVAL=T*YI+TBAR*YIM1+DXI*((CIM1-DI)*TBAR**2*T-(CI-DI)*T**2*TBAR)
C
 1010 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FINDCH(KOL, CHAR, KCOL)
C
C***  SKIP TO CHARACTER CHAR IN ARRAY KOL, KCOL POINTS TO THE COLUMN
C***  THAT THE CHARACTER RESIDES.  IF THE CHARACTER IS NOT FOUND,
C***  KCOL IS SET TO 81.
C
      CHARACTER*4 KOL,CHAR
C
      DIMENSION KOL(80)
C
 1000 IF(KOL(KCOL) .EQ. CHAR)GO TO 1010
      KCOL=KCOL+1
C
      IF(KCOL .LT. 81)GO TO 1000
C
 1010 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HXZU(RLE, T, C1, SWP, XU, ZU, DZDX, XM, ZM)
C
C     CALCULATE THE INTERSECTION POINT OF THE ELLIPTICAL NOSE
C     CAP AND WEDGE SURFACE AND LOCATION OF POINT WHERE LOCAL
C      SLOPE IS 15 DEG.
C
C     INPUT VARIABLES
C         RLE - L.E. RADIUS
C           T - THICKNESS
C          C1 - CHORD OF WEDGE
C         SWP - SWEEP ANGLE, DEG.
C
C     OUTPUT VARIABLES
C          XU - X-LOCATION OF INTERSECTION
C          ZU - Z-LOCATION OF INTERSECTION
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      CS = COS(SWP/RAD)
      CP = C1*CS/RLE
      TP = 0.5*T/RLE
      A  = (1.0-CP)**2+TP**2
      B  = 2.0*(CP*(1.0-CP)-TP**2)
      C  = CP**2
      XP = -B-SQRT(B**2-4.0*A*C)
      XP = XP/(2.0*A)
      ZP = SQRT(2.0*XP-XP**2)
      XU = XP*RLE/CS
      ZU = ZP*RLE
      DZDX = (T/2.0-ZU)/(C1-XU)
C
      TM = TAN(15.0/RAD)
      F  = CS*CS/(TM*TM+CS*CS)
      G  = SQRT(1.0-F)
      XM = RLE*(1.0-G)/CS
      ZM = RLE*CS*G/TM
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE LINFOR(CNALIN,CYBLIN)
C***********************************************************************
C
C     THIS SUBROUTINE CALCULATES A CONTRIBUTION TO THE INLET LINEAR
C     AERODYNAMICS BASED ON ASPECT RATIO.  THE CN-ALPHA AND CY-BETA
C     IS CALCULATED AS A FUNCTION OF INLET SPAN IN THE APPLICABLE FLIGHT
C     PLANE AND BODY DIAMETER.  THE PROGRAM ALSO CALCULATES THE ASPECT
C     RATIO OF THE INLETS (SPAN**2/S PLAN).
C
C***********************************************************************
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
      COMMON /GEOBOD/ DUM(32),DMAX,SMAX,LBOD,GDUM(12)
      REAL LBOD,LEMAX,LOMAX
      RBOD=DMAX/2.0
C
      RIMAX = RBOD
      LEMAX = RBOD
      UPMAX = RBOD
      LOMAX = RBOD
      DBOD  = 2.*RBOD
C
      NUMI=NIN+0.5
      DO 10 INLET = 1,NUMI
        IF (SIN(PHI(INLET)/RAD).GE.0.0) THEN
          IF (RA2(INLET).GT.RIMAX) RIMAX = RA2(INLET)
        ELSEIF (SIN(PHI(INLET)/RAD).LT.0.0)THEN
          IF (RA2(INLET).GT.LEMAX) LEMAX = RA2(INLET)
        ENDIF
        IF (COS(PHI(INLET)/RAD).GE.0.0) THEN
          IF (RB2(INLET).GT.RIMAX) UPMAX = RB2(INLET)
        ELSEIF (COS(PHI(INLET)/RAD).LT.0.0)THEN
          IF (RB2(INLET).GT.LEMAX) LOMAX = RB2(INLET)
        ENDIF
   10 CONTINUE
      DA2 = RIMAX + LEMAX
      DB2 = UPMAX + LOMAX
C
      CNALIN = PI/(2*SREF)*(DA2-DBOD)**2
      IF (DA2.LT.DBOD) CNALIN = 0.0
      CYBLIN = PI/(2*SREF)*(DB2-DBOD)**2
      IF (DB2.LT.DBOD) CYBLIN = 0.0
C
      ARA = (DA2-DBOD)/XI(5)
      ARB = (DB2-DBOD)/XI(5)
C
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE POTAR3(ALP,BET,CNPP,CYPP,CMPP,CLNPP)
C***********************************************************************
C
C     THIS SUBROUTINE TRANSFERS ALPHA AND BETA IN BODY COORDINATES
C     INTO INLET ALPHA AND BETA FOR AN AXISYMMETRIC INLET.  IT THEN
C     USES THESE LOCAL ANGLES TO CALCULATE INLET AERODYNAMICS.  THE
C     FORCES AND MOMENTS IN INLET COORDINATES ARE THEN TRANSFERRED
C     BACK TO THE BODY COORDINATE SYSTEM.
C
C***********************************************************************
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      DIMENSION DCN(4),DCY(4),DCM(4),DCLN(4)
      DIMENSION CYD(20),CYDXCP(20),BETAD(20)
C
      NUMI=NIN+0.5
      DO 10 I=1,NUMI
          BETAD(I)=-ALP*SIN(PHI(I)/RAD)-BET*COS(PHI(I)/RAD)
  10  CONTINUE
C
      CALL CNPAXI(ALP,CNI,CMI)
      CALL CYPAXI(BET,CYI,CLNI)
      IF(HDIV .GT. 0.0)THEN
        CALL CYPDIV(BETAD,CYD,CYDXCP)
      ELSE
         DO 15 I=1,20
           CYD(I) = 0.0
           CYDXCP(I) = 0.0
   15    CONTINUE
      ENDIF
C
      DO 20 I=1,NUMI
        DCN(I)=CNI+CYD(I)*SIN(PHI(I)/RAD)
        DCY(I)=CYI-CYD(I)*COS(PHI(I)/RAD)
        DCM(I)=CMI-(CYD(I)*SIN(PHI(I)/RAD)*CYDXCP(I))/LREF
        DCLN(I)=CLNI+(CYD(I)*COS(PHI(I)/RAD)*CYDXCP(I))/BREF
  20  CONTINUE
C
      CNPP=0.0
      CYPP=0.0
      CMPP=0.0
      CLNPP=0.0
      DO 30 I=1,NUMI
        CNPP=CNPP+DCN(I)*KWA(I)
        CYPP=CYPP+DCY(I)*KWB(I)
        CMPP=CMPP+DCM(I)*KWA(I)
        CLNPP=CLNPP+DCLN(I)*KWB(I)
   30 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SETGEO(KN,M,XB,NBLUNT,X,Y,Z,NPTS,B,RO,XT,YT,ZT,SLL,SLR)
C
C  SUBROUTINE TO PREPARE THE INPUT COORDINATES FOR PARABOLIC
C  INTERPOLATION
C
C  INPUTS
C
C     KN -- ARRAY OF POINTS DEFINING THE DISCONTINUITIES
C      M -- TOTAL NUMBER OF BODY SEGMENTS
C     XB -- FIRST X COORDINATE TO BE INVESTIGATED
C NBLUNT -- TYPE OF NOSE BLUNTNESS
C           0=SHARP, 1=BLUNTED, 2=TRUNCATED
C      X -- ARRAY OF X COORDINATES
C      Y -- ARRAY OF BODY RADII
C   NPTS -- TOTAL NUMBER OF BODY POINTS
C
C  OUTPUTS
C
C      Z -- VALUES USED IN PARABOLIC INTERPOLATION ROUTINE
C      B -- NOSE BLUNTNESS FACTOR IN CONIC REPRESENTATION
C     RO -- NOSE BLUNTNESS FACTOR IN CONIC REPRESENTATION
C     XT -- INTERPOLATED X VALUES FOR SEGMENT
C     YT -- INTERPOLATED Y VALUES FOR SEGMENT
C     ZT -- INTERPOLATED Z VALUES FOR SEGMENT
C    SLL -- LEFT HAND SLOPES OF EACH SEGMENT
C    SLR -- RIGHT HAND SLOPES FOR EACH SEGMENT
C
C  ROUTINES CALLED -- PARAB
C
      DIMENSION X(50),Y(50),Z(50),XT(50),YT(50),ZT(50),
     1 KN(20),NN(20),SLL(20),SLR(20)
      N=NPTS
      ND=1
      KL=0
      DRB=0.
      IF(NBLUNT.EQ.1)ND=0
      NN(1)=1
      DO 1000 KD=2,19
         KL=KL+KN(KD-1)
         IF(KN(KD).EQ.0)GO TO 1000
         IF(KD.EQ.3 .AND. KN(3).EQ.2)GO TO 1000
         ND=ND+1
         NN(ND)=KL
 1000 CONTINUE
      IF(KN(1).EQ.0)DRB=0.
      B=0.
      RO=0.
      NU=KN(1)
      NL=1
      IF(KN(1).EQ.0)NU=1
      IF(KN(1).EQ.0)GO TO 1030
      IF(KN(1).EQ.2)GO TO 1010
      GO TO 1020
 1010 DRB=(Y(NU)-Y(NL))/(X(NU)-X(NL))
 1020 IF(NBLUNT.EQ.0)GO TO 1040
      IF(X(1).EQ.0.)GO TO 1030
      X1=X(1)
      X2=X(2)
      Y1=Y(1)
      Y2=Y(2)
      CALL BLUNTN(X1,Y1,X2,Y2,XB,B,RO,R,RX,RXX,DEL,SD,CD)
      XB=.003*RO
      GO TO 1040
 1030 SQ=SQRT(1.+DRB*DRB)
      RO=Y(1)*SQ
      IF(NBLUNT.EQ.2)GO TO 1035
      B=-1.
      GO TO 1040
 1035 B=RO
      RO=0.
 1040 DO 1050 I=1,20
         KN(I)=NN(I)
 1050 CONTINUE
      NS=1
      MM=ND
      M=MM+1
      IF(ND.EQ.0)GO TO 1070
      IF(NN(1).EQ.1)GO TO 1080
      DO 1060 J=2,M
         MJ2=M-J+2
         MJ1=M-J+1
         NN(MJ2)=NN(MJ1)
 1060 CONTINUE
 1070 MM=ND+1
      M=MM+1
      NS=0
      NN(1)=1
 1080 NN(M)=N
      DO 1090 L=1,20
         KN(L)=NN(L)
 1090 CONTINUE
      DO 1110 J=2,M
            L=NN(J)
            NPT=L-NN(J-1)+1
            DY1=Y(L-1)-Y(L)
            DX1=X(L-1)-X(L)
         IF(NPT.EQ.2)GO TO 1100
            DY2=Y(L-2)-Y(L)
            DX2=X(L-2)-X(L)
            DE=1./DX1-1./DX2
            SLL(J)=(DY1/DX1**2-DY2/DX2**2)/DE
            GO TO 1110
 1100    SLL(J)=DY1/DX1
 1110 CONTINUE
C
C    COMPUTE RIGHT HAND SLOPES
C
      DO 1160 J=1,MM
            L=NN(J)
            NPT=NN(J+1)-L+1
            DY1=Y(L+1)-Y(L)
            DX1=X(L+1)-X(L)
         IF(NPT.EQ.2)GO TO 1120
            DY2=Y(L+2)-Y(L)
            DX2=X(L+2)-X(L)
            DE=1./DX1-1./DX2
            SLR(J)=(DY1/DX1**2-DY2/DX2**2)/DE
         GO TO 1130
 1120    SLR(J)=DY1/DX1
 1130    IF(J.EQ.1.AND.NS.EQ.0)SLR(1)=Y(1)/X(1)-RO/Y(1)
C
C    COMPUTE PARABOLIC FIT
C
         DO 1140 I=1,NPT
            LI=L+I-1
            XT(I)=X(LI)
            YT(I)=Y(LI)
 1140    CONTINUE
         NM=NPT-1
         CALL PARAB(XT,YT,ZT,NPT,SLR(J),SLL(J+1))
         DO 1150 I=1,NM
            LI=I+L-1
            Z(LI)=ZT(I)
 1150    CONTINUE
 1160 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE TABLOK(NDIM,NAVAL,NXARR,NXVAL,XARRAY,YARRAY,
     1                  X,Y,IEXTRP,IERR)
C
C  WRITTEN BY A. JENN, MCDONNELL DOUGLAS
C
C     THIS ROUTINE PERFORMS A TABLE LOOKUP ON A N-DIMENSIONAL TABLE.
C     THE VALUE OF N IS LIMITED ONLY BY THE PARAMETER NDIMM.  NDIMM
C     MUST BE AT LEAST AS LARGE AS THE NUMBER OF DIMENSIONS USED FOR
C     THE ARRAY OF DEPENDENT VALUES.  ALL INTERPOLATIONS ARE LINEAR.
C
C     INPUTS:
C
C     NDIM   - NUMBER OF INDEPENDENT VARIABLES
C
C     NAVAL  - 1-D ARRAY OF THE DIMENSIONED SIZE OF THE DEPENDENT
C              VARIABLE ARRAY, YARRAY, IN THE CALLING ROUTINE,
C              NAVAL(1...NDIM).  NAVAL WILL BE A SCALAR IF NDIM=1.
C
C     NXARR  - FIRST DIMENSION IN THE XARRAY FROM THE CALLING ROUTINE
C
C     NXVAL  - 1-D ARRAY OF NUMBER OF VALUES FOR EACH OF THE
C              INDEPENDENT VARIABLES, NXVAL(1...NDIM).  NXVAL WILL
C              BE A SCALAR IF NDIM=1.
C
C     XARRAY - 2-D ARRAY OF THE VALUES OF THE INDEPENDENT VARIABLES
C              CORRESPONDING TO THE VALUES IN THE DEPENDENT VALUE 
C              ARRAY, XARRAY(1...MAX(NXVAL),1...NDIM).  XARRAY WILL
C              BE A 1-D ARRAY IF NDIM=1.
C
C     YARRAY - NDIM-D ARRAY OF THE DEPENDENT VARIABLE VALUES,
C              YARRAY(1...NXVAL(1),1...NXVAL(2),...,1...NXVAL(NDIM)).
C
C     X      - 1-D ARRAY OF DEPENDENT VALUES AT WHICH A VALUE IS
C              TO BE LOOKED UP OUT OF THE TABLE, X(1...NDIM).  X WILL
C              BE A SCALAR IF NDIM=1.
C
C     IEXTRP - 1-D ARRAY OF EXTRAPOLATION OPTIONS, IEXTRP(1...NDIM),
C              CORRESPONDING TO EACH INDEPENDENT VARIABLE. EXTRAPOLATION 
C              OF AN INDEPENDENT VARIABLE IS ALLOWED BASED ON THE VALUE
C              OF IEXTRP FOR THAT INDEPENDENT VARIABLE.
C
C              IEXTRP(I) = 0 ==> LOW AND HIGH END EXTRAPOLATION ALLOWED
C              IEXTRP(I) = 1 ==> LOW END EXTRAPOLATION ALLOWED ONLY
C              IEXTRP(I) = 2 ==> HIGH END EXTRAPOLATION ALLOWED ONLY
C              IEXTRP(I) = ANYTHING ELSE ==> NO EXTRAPOLATION ALLOWED
C
C              IF EXTRAPOLATION IS NOT ALLOWED AND THE INDEPENDENT 
C              VARIABLE IS OUT OF RANGE, THE INDEPENDENT VARIABLE IS 
C              CLIPPED TO THE APPROPRIATE EDGE OF THE INDEPENDENT 
C              VARIABLE ARRAY, AND THE ERROR FLAG, IERR, IS SET.
C                
C
C     OUTPUTS:
C
C     Y      - VALUE OF DEPENDENT VARIABLE BASED ON X(1...NDIM)
C
C     IERR   - ERROR FLAG TO INDICATE IF INDEPENDENT VARIABLE CLIPPING 
C              HAS OCCURRED.  IERR=0 FOR NO CLIPPING OR IERR=IDIM WHERE 
C              IDIM IS THE INDEX OF THE FIRST INDEPENDENT VARIABLE WHICH 
C              REQUIRED CLIPPING.  IF THE NUMBER OF INDEPENDENT 
C              VARIABLES IS TOO LARGE FOR THE CURRENT ARRAY DIMENSIONS, 
C              IERR=-1 WILL BE RETURNED.  IF THIS OCCURS, THIS 
C              SUBROUTINE MUST BE RECOMPILED WITH THE VALUE OF NDIMM AT 
C              LEAST AS LARGE AS THE NUMBER OF INDEPENDENT VARIABLES.
C
C     PARAMETER FOR THE MAXIMUM NUMBER OF INDEPENDENT VARIABLES.  THIS
C     PARAMETER MUST BE AT LEAST AS LARGE AS THE NUMBER OF INDEPENDENT
C     VARIABLES USED IN THE PROBLEM.  IF NDIMM IS TOO SMALL, ITS VALUE
C     MUST SIMPLY BE INCREASED TO THE APPROPRIATE SIZE.
      PARAMETER (NDIMM = 10)
C
C     PARAMETER FOR THE MAXIMUM SIZE OF THE WORK ARRAY
      PARAMETER (NWORKM = 2**NDIMM-1)
C
      INTEGER NXVAL(1), NAVAL(1), IEXTRP(1), IXSAV(NDIMM), INCR(NDIMM), 
     1        IBIT(NDIMM)
C
      REAL XARRAY(1), YARRAY(1), X(1), WORK(NWORKM), XL(NDIMM)
C
      DIMENSION XM(NDIMM),X1M(NDIMM),XNM(NDIMM)
C
C     CHECK IF ARRAY DIMENSIONS ARE LARGE ENOUGH TO HANDLE PROBLEM
      IF (NDIM .GT. NDIMM) THEN
C
C        ARRAY DIMENSIONS ARE TOO SMALL
         IERR = -1
         GOTO 180
C
      ELSE
C
C        INITIALIZE THE ERROR FLAG
         IERR = 0
C
      END IF
      IM=0
C
C     PLACE THE X ARRAY IN LOCAL STORAGE IN CASE VALUES NEED TO
C     BE CLIPPED DUE TO EXTRAPOLATION
      DO 90 IDIM = 1, NDIM
         XL(IDIM) = X(IDIM)
   90 CONTINUE
C
C     LOOP TO FIND THE INTERVAL IN THE INDEPENDENT VARIABLE ARRAY,
C     XARRAY, IN WHICH EACH INDEPENDENT VARIABLE FALLS
      DO 110 IDIM = 1, NDIM
C
C        LOOP FOR EACH INDEPENDENT VARIABLE
         DO 100 IXVAL = 1, NXVAL(IDIM)-1
C
C           CHECK IF THE INDEPENDENT VARIABLE VALUE FALLS IN THIS INTERVAL
            ILO = IXVAL + (IDIM - 1) * NXARR
            IHI = ILO + 1
            IF (XL(IDIM) .GE. XARRAY(ILO) .AND.
     1         XL(IDIM) .LE. XARRAY(IHI)) THEN
C
C              STORE THE INTERVAL FOR THIS INDEPENDENT VARIABLE
               IXSAV(IDIM) = IXVAL
               GOTO 110
C
            END IF
C
  100    CONTINUE
C
C        HERE IF INDEPENDENT VARIABLE IS OUT OF RANGE.  CHECK IF 
C        THE VALUE IS TOO LARGE OR TOO SMALL
         ILO = 1 + (IDIM - 1) * NXARR
         IF (XL(IDIM) .LT. XARRAY(ILO)) THEN
C                                 
C           STORE THE FIRST INTERVAL
            IXSAV(IDIM) = 1
C
C           CHECK IF EXTRAPOLATION IS PROHIBITED
            IF (IEXTRP(IDIM) .EQ. 0 .OR. IEXTRP(IDIM) .EQ. 1) THEN
              IM=IM+1
              XM(IM)=XL(IDIM)
              X1M(IM)=XARRAY(ILO)
              XNM(IM)=XARRAY(IHI)
            ELSE
C
C              CLIP THE X VARIABLE
               XL(IDIM) = XARRAY(ILO)
C
C              SET THE ERROR FLAG TO INDICATE CLIPPING OCCURRED
               IERR = IDIM
C
            END IF
C
         ELSE
C
C           STORE THE LAST INTERVAL
            IXSAV(IDIM) = NXVAL(IDIM) - 1
C
C           CHECK IF EXTRAPOLATION IS PROHIBITED
            IF (IEXTRP(IDIM) .EQ. 0 .OR. IEXTRP(IDIM) .EQ. 2) THEN
              IM=IM+1
              XM(IM)=XL(IDIM)
              X1M(IM)=XARRAY(ILO)
              XNM(IM)=XARRAY(IHI)
            ELSE
C
C              CLIP THE X VARIABLE
               IHI = NXVAL(IDIM) + (IDIM - 1) * NXARR
               XL(IDIM) = XARRAY(IHI)
C
C              SET THE ERROR FLAG TO INDICATE CLIPPING OCCURRED
               IERR = IDIM
C
            END IF
C
         END IF
C
  110 CONTINUE
C
C     DETERMINE THE INCREMENTAL VALUES NEED TO DETERMINE POINTERS
C     FOR THE DEPENDENT VALUE ARRAY
      INCR(1) = 1
      DO 120 IDIM = 2, NDIM
         INCR(IDIM) = INCR(IDIM-1) * NAVAL(IDIM-1)
  120 CONTINUE
C
C     DEFINE NUMBER OF INTERPOLATIONS REQUIRED ON FIRST PASS
      NFIRST = 2**(NDIM-1) - 1
C
C     LOOP TO LOAD THE WORK ARRAY
      DO 150 IFIRST = NFIRST, 0, -1
C
C        REVERSE THE LOOP INDEX
         IREV = NFIRST - IFIRST
C
C        DETERMINE THE COMBINATIONS OF ZEROS AND ONES REQUIRED TO
C        DETERMINE THE DEPENDENT ARRAY POINTER
         DO 130 IDIM = NDIM, 2, -1
C
C           DETERMINE THE POWER OF TWO
            IMULT = 2**(IDIM-2)
C
C           SET THE BIT IF IVAL IS LARGER THAN IMULT
            IBIT(IDIM) = IREV / IMULT
C
C           CALCULATE THE REMAINDER
            IREV = IREV - IMULT * IBIT(IDIM)
C
  130    CONTINUE
C
C        INITIALIZE SUMMING VARIABLE TO DETERMINE POINTER
         ISPOT = IXSAV(1)
C
C        LOOP TO DETERMINE DEPENDENT ARRAY POINTER
         DO 140 IDIM = 2, NDIM
C
C           ADD THE INCREMENT DUE TO EACH INDEPENDENT VARIABLE TO
C           THE POINTER VALUE
            ISPOT = ISPOT + (IXSAV(IDIM)-IBIT(IDIM)) * INCR(IDIM)
C
  140    CONTINUE
C
C        DETERMINE STORAGE LOCATIONS IN THE WORK ARRAY
         ISPOT1 = ISPOT  + 1
         IWORK  = IFIRST * 2 + 1
         IWORK1 = IWORK  + 1
C
C        LOAD THE DEPENDENT VALUES INTO THE WORK ARRAY
         WORK(IWORK)  = YARRAY(ISPOT)
         WORK(IWORK1) = YARRAY(ISPOT1)
C
  150 CONTINUE
C
C     BEGIN LOOP TO REDUCE WORK ARRAY TO A SINGLE VALUE THROUGH A
C     SERIES OF LINEAR INTERPOLATIONS
      DO 170 IDIM = NDIM, 1, -1
C
C        DETERMINE THE INDICES OF THE INDEPENDENT VARIABLE BOUNDS FOR 
C        THE INTERPOLATION
         IREV = NDIM - IDIM + 1
         IX1  = IXSAV(IREV) + (IREV - 1) * NXARR
         IX2  = IX1 + 1
C
C        DETERMINE THE INDEPENDENT VARIABLE BOUNDS FOR THE INTERPOLATION
         X1 = XARRAY(IX1)
         X2 = XARRAY(IX2)
         DELX = X2 - X1
         XINC = XL(IREV) - X1 
C
C        DETERMINE THE NUMBER OF INTERPOLATIONS REQUIRED FOR THIS LEVEL
         NINTRP = 2**(IDIM-1)
C
C        LOOP FOR EACH INTERPOLATION
         DO 160 IINTRP = 1, NINTRP
C
C           DETERMINE THE INDICES OF THE DEPENDENT VARIABLE BOUNDS IN
C           THE WORK ARRAY FOR THIS INTERPOLATION
            IY1 = (IINTRP - 1) * 2 + 1
            IY2 = IY1 + 1
C
C           DETERMINE THE DEPENDENT VARIABLE BOUNDS FOR THE INTERPOLATION
            Y1 = WORK(IY1)
            Y2 = WORK(IY2)
C
C           PERFORM THE LINEAR INTERPOLATION AND PLACE THE RESULT BACK
C           IN THE WORK ARRAY
            DELY = Y2 - Y1
            WORK(IINTRP) = Y1 + DELY / DELX * XINC
C
  160    CONTINUE
C
  170 CONTINUE
C
C     ASSIGN THE FINAL RESULT TO THE RETURN VARIABLE
      Y = WORK(1)
C
C     WRITE EXTRAPOLATION MESSAGES
c     DO 175 IM=1,NDIM
c       CALL MESSG(XM(IM),Y,X1M(IM),XNM(IM),0.0,0.0,1)
c 175 CONTINUE
C
  180 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCMV(ALPHA,CDC,ETA,SPLAN,XCG,XCENTP,SREF,
     1   LREF,CMVIS)
C
C***  SUBROUTINE TO COMPUTE THE VISCOUS PITCHING MOMENT FOR BODIES
C***  ABOUT THE USER SPECIFIED CENTER OF GRAVITY
C***  METHOD OF ALLEN AND PERKINS
C
C***  INPUTS
C
C  ALPHA -- ANGLE OF ATTACK, DEGREES
C    CDC -- CROSS FLOW DRAG COEFFICIENT
C    ETA -- CROSS FLOW DRAG PROPORTIONALITY FACTOR
C  SPLAN -- PLANFORM AREA, FEET SQUARED
C    XCG -- LOCATION OF LONGITUDINAL CENTER OF GRAVITY, FEET FROM NOSE
C XCENTP -- LOCATION OF PLANFORM AREA CENTROID OF BODY, FEET FROM NOSE
C   SREF -- REFERENCE AREA, FEET SQUARED
C   LREF -- REFERENCE LENGTH, FEET
C
C***  OUTPUT
C
C  CMVIS -- VISCOUS PITCHING MOMENT COEFFICIENT
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL LREF
C
      SINALP=SIN(ALPHA/RAD)
      CMVIS=CDC*ETA*SPLAN*(XCG-XCENTP)/LREF*SINALP*ABS(SINALP)/SREF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CDPROT(MACH,RPUL,SREF,CDTOT)
C
C  WRITTEN BY K. DETERS, MCDONNELL DOUGLAS
C
      COMMON /ABODIN/ DUM(300),NUM,PTYPE(20),XPROT(20),NLOC(20),
     1 BDMEM(20),BDTYPE(100),LPROT(100),WPROT(100),HPROT(100),
     2 OPROT(100)
      COMMON /PARTF/ PART(19)
      COMMON /LOGIC/ LDUM(18),LDIMIN,LDIMFT,LDIMCM,LDIMM,LDUM2(6)
      LOGICAL LDUM,LDIMIN,LDIMFT,LDIMCM,LDIMM,PART
      REAL MACH,CDP(20),LPROT,NUM,NLOC
      DIMENSION NMEM(20)
      CHARACTER*19 NAME(7),TNAME(20)
C
C***  SET UP INTEGER VALUES 
      NPROT=NUM+0.5
      DO 10 I=1,20
        NMEM(I)=BDMEM(I)+0.5
 10   CONTINUE
C
C***  CALCULATE TOTAL NUMBER OF MEMBERS
      JB=0
      MEM=0
      DO 20 I=1,NPROT
        IF (PTYPE(I).EQ.3) THEN
          MEM=MEM+4
        ELSEIF (PTYPE(I).EQ.4) THEN
          MEM=MEM+3
        ELSEIF (PTYPE(I).EQ.7) THEN
          JB=JB+1
          MEM=MEM+NMEM(JB)
        ELSE
          MEM=MEM+1
        ENDIF
 20   CONTINUE
C***  CHECK IF NUMBER OF MEMBERS EXCEEDS ARRAY DIMENSION
      IF (MEM.GT.100) THEN
        IF (PART(6)) WRITE(6,80)
        GOTO 200
      ENDIF
C
      CDTOT=0.0
      J=0
      K=0
      KK=0
      DO 30 I=1,NPROT
      XB=XPROT(I)
      RNUM=RPUL*XB
      DEL=.37*XB/(RNUM**.2)
C***
C     CIRCULAR/ELLIPTICAL CYLINDERS (CROSS FLOW)
      IF (PTYPE(I) .EQ. 1) THEN
      K=K+1      
      CALL CYL(MACH,RPUL,DEL,HPROT(K),WPROT(K),LPROT(K),OPROT(K),CDPR)
      ENDIF
C***
C     CIRCULAR CYLINDERS (IN FLOW DIRECTION)
      IF (PTYPE(I) .EQ. 2) THEN
      K=K+1
      CALL CIRC(MACH,DEL,HPROT(K),LPROT(K),OPROT(K),CDPR)
      ENDIF
C***
C     LAUNCH LUGS (4- MEMBERS)
      IF (PTYPE(I) .EQ. 3) THEN
      NM=4
      CALL LUGSHO(MACH,DEL,K,NM,HPROT,WPROT,LPROT,OPROT,CDPR)
      ENDIF
C***
C     LAUNCH SHOES (3-MEMBERS)
      IF (PTYPE(I) .EQ. 4) THEN
      NM=3
      CALL LUGSHO(MACH,DEL,K,NM,HPROT,WPROT,LPROT,OPROT,CDPR)
      ENDIF
C***
C     FLAT PLATE
      IF (PTYPE(I) .EQ. 5) THEN
      K=K+1
      CALL FLAT(MACH,DEL,HPROT(K),WPROT(K),LPROT(K),OPROT(K),CDPR)
      ENDIF
C***
C     FAIRINGS (STREAMLINE HALF BODIES)
      IF (PTYPE(I) .EQ. 6) THEN
      K=K+1
      CALL STREAM(MACH,RPUL,DEL,XB,HPROT(K),WPROT(K),LPROT(K),CDPR)
      ENDIF
C***
C     COMPONENT BUILD-UP (MAX=5)
      IF (PTYPE(I) .EQ. 7) THEN
      J=J+1
      NM=NMEM(J)
      CALL BUILD(MACH,RPUL,DEL,K,KK,NM,BDTYPE,HPROT,WPROT,LPROT,
     1 OPROT,CDPR)   
      ENDIF
C***
C     INDIVIDUAL PROTUBERANCE DRAG COEFF.
      CDP(I)=CDPR*NLOC(I)/SREF
      CDTOT=CDTOT+CDP(I)
  30  CONTINUE
C
C***  SET UP PROTUBERANCE TYPE NAMES 
      NAME(1)=' VERTICAL CYLINDER '
      NAME(2)='HORIZONTAL CYLINDER'
      NAME(3)='    LAUNCH LUG     '
      NAME(4)='    LAUNCH SHOE    '
      NAME(5)='FLAT PLATE OR BLOCK'
      NAME(6)='      FAIRING      '
      NAME(7)='COMPONENT BUILD-UP '
C
      IF (PART(6)) THEN
C
C***  PRINT OUTPUT
C
      CALL HEADR9
      WRITE(6,400)
 400  FORMAT(28X,'PROTUBERANCE OUTPUT',/)
      CALL PRFLC9(IM,NA,NM,ND)
C
      WRITE(6,90)
      WRITE(6,100)
      IF (LDIMIN) WRITE(6,110)
      IF (LDIMFT) WRITE(6,111)
      IF (LDIMCM) WRITE(6,112)
      IF (LDIMM) WRITE(6,113)
      CALL CONVRT(XPROT,20,1)
      DO 40 I=1,NPROT
        IF (PTYPE(I).EQ.1) TNAME(I)=NAME(1)
        IF (PTYPE(I).EQ.2) TNAME(I)=NAME(2)
        IF (PTYPE(I).EQ.3) TNAME(I)=NAME(3)
        IF (PTYPE(I).EQ.4) TNAME(I)=NAME(4)
        IF (PTYPE(I).EQ.5) TNAME(I)=NAME(5)
        IF (PTYPE(I).EQ.6) TNAME(I)=NAME(6)
        IF (PTYPE(I).EQ.7) TNAME(I)=NAME(7)
        WRITE(6,120) I,TNAME(I),XPROT(I),INT(NLOC(I)+0.5),
     1     CDP(I)/NLOC(I),CDP(I)
  40  CONTINUE
      WRITE(6,130) CDTOT
      CALL CONVRT(XPROT,20,-1)
C
      ENDIF
C
  80  FORMAT(/,4X,'WARNING: THERE IS A DISCREPANCY IN THE ',
     1       'INPUTS. ',/,4X,'         THE TOTAL NUMBER OF ',
     2       'MEMBERS FOR ALL ',/,4X,'         PROTUBERANCES ',
     3       'EXCEEDS THE DIMENSION OF 100.',/,4X,'         THE ',
     4       'PROTUBERANCE CALCULATIONS WILL BE SKIPPED.',/)
  90  FORMAT(4X,'PROTUBERANCE AXIAL FORCE COEFFICIENT IS',
     1          ' CALCULATED AT ZERO ANGLE OF',
     2     /,4X,'ATTACK AND ASSUMED CONSTANT FOR ALL ANGLES',
     3          ' OF ATTACK.  PROTUBERANCES ',
     4     /,4X,'ARE CONSIDERED PART OF THE BODY WHEN',
     4          ' CALCULATING TOTAL AXIAL FORCE.',
     5     /,4X,'PROTUBERANCE AXIAL FORCE IS INCLUDED',
     7          ' IN THE TOTAL CONFIGURATION RESULTS.',/)
 100  FORMAT(4X,'--------------- PROTUBERANCE ',
     1       ' CALCULATIONS ---------------')
 110  FORMAT(/,35X,'LONG.',5X,'NUMBER',2X,'INDIVIDUAL',4X,'TOTAL',/,
     1   4X,'NUMBER',8X,'TYPE',10X,'LOCATION (IN)',12X,'CA',10X,'CA')
 111  FORMAT(/,35X,'LONG.',5X,'NUMBER',2X,'INDIVIDUAL',4X,'TOTAL',/,
     1   4X,'NUMBER',8X,'TYPE',10X,'LOCATION (FT)',12X,'CA',10X,'CA')
 112  FORMAT(/,35X,'LONG.',5X,'NUMBER',2X,'INDIVIDUAL',4X,'TOTAL',/,
     1   4X,'NUMBER',8X,'TYPE',10X,'LOCATION (CM)',12X,'CA',10X,'CA')
 113  FORMAT(/,35X,'LONG.',5X,'NUMBER',2X,'INDIVIDUAL',4X,'TOTAL',/,
     1   4X,'NUMBER',8X,'TYPE',10X,'LOCATION (M) ',12X,'CA',10X,'CA')
 120  FORMAT(5X,I2,4X,A19,4X,F7.3,6X,I2,4X,F8.4,4X,F8.4)
 130  FORMAT(/,4X,'TOTAL CA DUE TO PROTUBERANCES =',F8.4,/)
C
 200  CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CVRREF(ISIGN)
C
C***  ROUTINE TO CONVERT THE DATA IN THE REFERENCE QUANTITIES
C***  DATA BLOCKS BETWEEN THE USER AND FOOT SYSTEM OF UNITS
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
C
C***  CONVERT REFERENCE QUANTITIES
C
      CALL CONVRT(SREF,1,ISIGN*2)
      CALL CONVRT(LREF,1,ISIGN*1)
      CALL CONVRT(LATREF,1,ISIGN*1)
      CALL CONVRT(XCG,1,ISIGN*1)
      CALL CONVRT(ZCG,1,ISIGN*1)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE EXPAND(GAM,TH,AM1,P1,AM2,P2,ICOMP)
C
C  SUBROUTINE TO CALCULATE THE FLOW CONDITIONS AFTER AN EXPANSION
C
C  INPUTS
C
C    GAM -- RATIO OF SPECIFIC HEATS FOR A GAS
C     TH -- THE TURNING ANGLE IN RADIANS
C    AM1 -- MACH NUMBER UPSTREAM OF THE CORNER
C     P1 -- PRESSURE UPSTREAM OF THE CORNER
C
C  OUTPUTS
C
C    AM2 -- EXPANSION MACH NUMBER
C     P2 -- EXPANSION PRESSURE
C  ICOMP -- RETURN A VALUE OF 1 IF COMPRESSIVE FLOW
C
C  SUBROUTINES CALLED -- NONE
C
C
C FUNCTION DESCRIBING THE PRANDTL-MEYER EXPANSION ANGLE
C
      AN(AS)=SQRT((GAM+1.)/(GAM-1.))*ATAN(SQRT((AS-1.)*(GAM-1.)
     1       /(GAM+1.)))-ATAN(SQRT(AS-1.))
      ICOMP=1
      AS=AM1**2
      AN1=AN(AS)
      F=-TH
C
C  GET MACH NUMBER FROM EXPANSION ANGLE THROUGH ITERATION
C
      DO 1000 JK=1,10
         DER=SQRT(AS-1.)/(2.*AS*(1.+(GAM-1.)/2.*AS))
         DEA=-F/DER
         AS=AS+DEA
         IF(AS.LT.1.0)GO TO 1020
         F=AN(AS)-AN1-TH
         IF(ABS(F).LT.1.E-4)GO TO 1010
 1000 CONTINUE
C
C  FINALLY GET EXPANSION MACH NUMBER
C
 1010 AM2=SQRT(AS)
C
C  GET PRESSURE AFTER EXPANSION
C
      P2=P1*((1.+(GAM-1.)/2.*AM1**2)/(1.+(GAM-1.)/2.*AM2**2))
     1   **(GAM/(GAM-1.))
      ICOMP=0
 1020 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FINDVN(NUMVN, LENVN, INAME, VNAME, DVNAME, NVN, FOUND)
C
C***  FIND MATCHING VARIABLE NAME
C
C***  INPUTS
C
C  NUMVN - NUMBER OF VARIABLE NAMES TO SEARCH
C  LENVN - ARRAY THAT DEFINES THE LENGTH OF EACH VARIABLE NAME
C  INAME - ARRAY THAT DEFINES THE NAME TO COMPARE
C  VNAME - ARRAY THAT CONTAINS ALL OF THE VARIABLE NAMES
C DVNAME - DIMENSION OF VNAME ARRAY
C
C***  OUTPUTS
C
C    NVN - NUMBER OF VARIABLE FOR WHICH THERE IS A MATCH
C  FOUND - .TRUE. IF VARIABLE NAME MATCH FOUND
C
      INTEGER DVNAME
C
      LOGICAL FOUND
      CHARACTER*4 BLANK,INAME,VNAME
C
      DIMENSION LENVN(NUMVN),INAME(80),VNAME(DVNAME)
C
      DATA BLANK / '    ' /
C
      FOUND=.FALSE.
C
      INDX=1
C
      DO 1020 NVN=1,NUMVN
C
         IF(NVN .GT. 1)INDX=INDX+MAXC
C
         MAXC=LENVN(NVN)
C
         DO 1000 I=1,MAXC
            IF(INAME(I) .NE. VNAME(I+INDX-1))GO TO 1020
 1000    CONTINUE
C
C ... MAKE SURE REST OF NAME IS BLANK, ELSE NOT RIGHT ONE
C
         J=MAXC+1
         DO 1010 I=J,80
            IF(INAME(I) .NE. BLANK)GO TO 1020
 1010    CONTINUE
C
         FOUND=.TRUE.
         GO TO 1030
C
 1020 CONTINUE
C
      NVN=0
C
 1030 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HYBG1(N4,N3,IERROR,BETA,RP,X,R,N,NSHAPE,N1,N2,
     1 NN1,NN2,NN3,NN,VOVS,DRB)
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  ORIGINAL ROUTINE WRITTEN BY F. MOORE, NSWC
C  MODIFIED BY J. JENKINS, WL/FIGC
C
C***  THIS ROUTINE FOR CONFIGURATIONS HAVING POINTED NOSES
C
C***  INPUT PARAMETERS
C       BETA   - MACH PARAMETER, SQRT(M**2-1)
C       X      - ARRAY OF BODY X COORDINATES REFERED TO SHIFTED
C                ORIGIN
C       R      - ARRAY OF BODY RADIAL COORDINATES
C       N      - NUMBER OF LONGITUDINAL STATIONS
C       NSHAPE - EQUALS 1 FOR NOSE ALONE
C              - EQUALS 2 FOR NOSE + BODY
C              - EQUALS 3 FOR NOSE + TAIL
C              - EQUALS 4 FOR NOSE + BODY + TAIL
C       N1     - NUMBER OF STATIONS FROM NOSE TIP TO END OF NOSE SEGMENT
C       N2     - NUMBER OF STATIONS FROM NOSE TIP TO END OF BODY SEGMENT
C       N3     - EQUALS 1 FOR CONICAL TAIL SEGMENT
C              - EQUALS 2 FOR OGIVAL TAIL SEGMENT
C       N4     - EQUALS 0 FOR CONICAL NOSE SEGMENT
C              - EQUALS 1 FOR ALL OTHER NOSE SEGMENTS
C       VOVS   - MACH NUMBER
C       DRB    - SLOPE OF MERIDIAN CURVE AT NOSE TIP
C
C***  OUTPUT VARIABLES
C       IERROR - EQUALS 0, IF NO ERRORS ENCOUNTERED
C              - EQUALS 1, IF NOSE TIP ANGLE .GT. MACH ANGLE
C       RP     - SLOPE AT TIP OF NOSE
C       NN1    - NUMBER OF GRID POINTS FROM NOSE TIP TO END OF
C                NOSE SEGMENT
C       NN2    - NUMBER OF GRID POINTS FROM NOSE TIP TO END OF
C                BODY SEGMENT
C       NN3    - NUMBER OF GRID POINTS FROM NOSE TIP TO END OF
C                TAIL SEGMENT
C       NN     - TOTAL NUMBER OF GRID POINTS
C
C
      COMMON /PARTF/ PARTS(19)
      COMMON /VDARY/ XB(220),RB(220),RBP(220),C(220),C1(220),RB1(220),
     1  RBP1(220),B(220),PSI(220),ZE0X(220),PSIR(220),PHIX(220)
      DIMENSION X(50),R(50)
      LOGICAL PARTS,FLAG
C
      NN1=0
      NN2=0
      NN3=0
      IERROR=0
      BETA=SQRT(VOVS**2-1.0)
      C2=0.9
      C4=20.0
      C3=C2/C4
      CZE=BETA**3
      BET1=BETA
      IF(BET1 .GT. 1.0) BET1=1.
      IF(CZE .GT. 10.) CZE=10.
C
C***  TEST FOR NOSE ANGLE .LE. MACH ANGLE
C
      IF(DRB .LE. TAN(ASIN(1./VOVS))) GO TO 1000
        IF(PARTS(18))WRITE(6,1130)
        IERROR=1
        GO TO 1120
C
C***  HERE FOR NOSE SEGMENT
C
 1000   IF(N4 .NE. 0.) GO TO 1020
C
C***  HERE FOR POINTED CONE
C
          XB(1)=X(1)
          RB(1)=R(1)
          RBP(1)=DRB
          RP=DRB
          DLX=X(N1)/10.
          DLR=R(N1)/10.
          K=0
 1010     CONTINUE
          K=K+1
          XB(K+1)=XB(K)+DLX
          RB(K+1)=RB(K)+DLR
          RBP(K+1)=DRB
          IF(XB(K+1) .LT. (X(N1)-.0001)) GO TO 1010
          XB(K+1)=X(N1)
          RB(K+1)=R(N1)
          NN=K+1
          NN1=K+1
          GO TO 1060
C
C***  HERE FOR POINTED NOSE OF GENERAL SHAPE
C
 1020     XB(1)=X(1)
          RB(1)=R(1)
          RBP(1)=DRB
          RP=DRB
          RHOB=ABS((1.+DRB**2)**1.5/DRB)
          XB(2)=XB(1)+.025*RHOB/BETA**1.5
          IF(XB(2) .GT. (X(N1)/5.))  XB(2)=X(N1)/5.
          K=2
 1030     CONTINUE
          CALL INTERP(X,R,XB(K),RB(K),N1,3)
          CALL FDP5(X,R,XB(K),RBP(K),N1,1)
          XB(K+1)=XB(K)+C2*BET1*(RB(K)-RB(1))
      IF(XB(K+1) .GE. (X(N1)-.0001)) GO TO 1040
            CALL LOOP(K,100,FLAG)
        GO TO 1050
C
 1040       FLAG=.FALSE.
 1050     CONTINUE
          IF(FLAG) GO TO 1030
          XB(K+1)=X(N1)
          RB(K+1)=R(N1)
          CALL FDP5(X,R,XB(K+1),RBP(K+1),N1,1)
          NN=K+1
          NN1=K+1
 1060   CONTINUE
        IF(NSHAPE .EQ. 1 .OR. NSHAPE .EQ. 3) GO TO 1090
C
C***  HERE FOR CYLINDRICAL BODY SEGMENT
C
          XB(K+2)=XB(K+1)
          RB(K+2)=RB(K+1)
          RBP(K+2)=0.
          XB(K+3)=XB(K+2)+C3*BET1*RB(K+2)
          RB(K+3)=RB(K+2)
          RBP(K+3)=0.
          IJ=1
 1070     CONTINUE
          K=K+1
          IJ=IJ+1
          A=IJ
          C5=A*C3
          XB(K+3)=XB(K+2)+C5*BET1*RB(K+2)
          IF((XB(K+3)-X(N2)) .LT. 2.) GO TO 1080
            DX2=BETA*RB(K+2)
            IF(DX2 .GT. 0.5) DX2=0.5
            XB(K+3)=XB(K+2)+DX2
            DX1=XB(K+2)-XB(K+1)
            AR=DX2/DX1
            IF(AR .GT. 1.25) XB(K+3)=XB(K+2)+1.25*DX1
 1080     CONTINUE
          RB(K+3)=RB(K+2)
          RBP(K+3)=0.
          IF(XB(K+3) .LT. (X(N2)-.0001)) GO TO 1070
          XB(K+3)=X(N2)
          RB(K+3)=R(N2)
          NN=K+3
          NN2=K+3
 1090   CONTINUE
        IF(NSHAPE .EQ. 1 .OR. NSHAPE .EQ. 2) GO TO 1120
C
C***  HERE FOR TAIL SEGMENT
C
          IF(N3 .EQ. 2) GO TO 1100
C
C***  HERE FOR CONICAL TAIL SEGMENT
C
            IF(NSHAPE .EQ. 4) K=K+2
            XB(K+2)=XB(K+1)
            RB(K+2)=RB(K+1)
            RBP(K+2)=(R(N)-RB(K+2))/(X(N)-XB(K+2))
            XB(K+3)=X(N)
            RB(K+3)=R(N)
            RBP(K+3)=RBP(K+2)
            NN=K+3
            NN3=K+3
            GO TO 1120
C
C***  HERE FOR TAIL SEGMENT OF GENERAL SHAPE
C
 1100       IF(NSHAPE .EQ. 3) NA=N1
            IF(NSHAPE .EQ. 4) NA=N2
            IF(NSHAPE .EQ. 4) K=K+2
            XB(K+2)=XB(K+1)
            RB(K+2)=RB(K+1)
            CALL FDP5(X,R,XB(K+2),RBP(K+2),N,NA)
            XB(K+3)=XB(K+2)+C3*BET1*RB(K+2)
            CALL INTERP (X,R,XB(K+3),RB(K+3),N,NA)
            CALL FDP5(X,R,XB(K+3),RBP(K+3),N,NA)
            IJ=1
 1110       CONTINUE
            K=K+1
            IJ=IJ+1
            A=IJ
            C5=A*C3
            XB(K+3)=XB(K+2)+C5/CZE*BET1*RB(K+2)
            CALL INTERP (X,R,XB(K+3),RB(K+3),N,NA)
            CALL FDP5(X,R,XB(K+3),RBP(K+3),N,NA)
            IF(XB(K+3) .LT. (X(N)-.0001)) GO TO 1110
            XB(K+3)=X(N)
            RB(K+3)=R(N)
            CALL FDP5(X,R,XB(K+3),RBP(K+3),N,NA)
            NN=K+3
            NN3=K+3
 1120 CONTINUE
C
 1130 FORMAT(4X,'*** NOSE TIP ANGLE GREATER THAN MACH ANGLE,',
     1 ' HYBRID THEORY INVALID',/,8X,'SECOND ORDER SHOCK EXPANSION',
     2 ' TO BE USED',/)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE LINXCP(IMACH,XCPA,XCPB)
C***********************************************************************
C
C     THIS SUBROUTINE CALCULATES CENTER OF PRESSURE LOCATION IN THE
C     LONGITUDINAL DIRECTION.  RESULTS PRESENTED IN CHARTS 10 & 11
C     OF NACA REPORT 1307, FOR XCP AT BOTH SUBSONIC AND SUPERSONIC,
C     ARE USED.
C
C***********************************************************************
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      BETARA = SQRT(ABS(MACH(IMACH)**2.-1.))*ARA
      BETARB = SQRT(ABS(MACH(IMACH)**2.-1.))*ARB
C
      IF (MACH(IMACH).GT.1.0) THEN
        IF ((BETARA.GE.0.0).AND.(BETARA.LT.1.5)) XCPA =
     1     -0.11429*BETARA**2.+0.45143*BETARA+0.0014286
        IF ((BETARB.GE.0.0).AND.(BETARB.LT.1.5)) XCPB =
     1     -0.11429*BETARB**2.+0.45143*BETARB+0.0014286
        IF ((BETARA.GE.1.5).AND.(BETARA.LT.3.5)) XCPA =
     1     -0.01122*BETARA**2.+0.07837*BETARA+0.33188
        IF ((BETARB.GE.1.5).AND.(BETARB.LT.3.5)) XCPA =
     1     -0.01122*BETARB**2.+0.07837*BETARB+0.33188
        IF (BETARA.GE.3.5) XCPA = 0.00511*BETARA + 0.45211
        IF (BETARB.GE.3.5) XCPB = 0.00511*BETARB + 0.45211
      ELSEIF (MACH(IMACH).LE.1.0) THEN
        IF (BETARA.LT.2.0) XCPA = 0.05921*BETARA**3.-
     1                              0.27959*BETARA**2.+
     1                               0.44650*BETARA+0.0033737
        IF (BETARA.GE.2.0) XCPA = 0.250
        IF (BETARB.LT.2.0) XCPB = 0.05921*BETARB**3.-
     1                              0.27959*BETARB**2.+
     1                               0.44650*BETARB+0.0033737
        IF (BETARB.GE.2.0) XCPB = 0.250
      ENDIF
C
      XCPA = XCPA*XI(5)
      XCPB = XCPB*XI(5)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE POWR(AA,NX,X,R,BNOSE,TRUNC,LENGTH,DIAM,EXP,DISCON)
C
C***  COMPUTE THE CHARACTERISTICS OF A POWER SEGMENT
C
C***  INPUTS
C
C     NX -- NUMBER OF INPUT POINTS
C      X -- X STATIONS
C      R -- RADII AT EACH X STATION
C  BNOSE -- FORWARD RADIUS OF SECTION
C  TRUNC -- TRUNCATED FLAG (.TRUE. IF TRUNCATED NOT BLUNTED)
C LENGTH -- SECTION LENGTH
C   DIAM -- SECTION BASE DIAMETER
C    EXP -- EXPONENT OF POWER SHAPE
C
C***  OUTPUTS
C
C     AA -- ARRAY OF CHARACTERISTICS TO BE COMPUTED
C           AA(1)=PLANFORM AREA
C           AA(2)=WETTED AREA
C           AA(3)=VOLUME
C           AA(4)=VOLUME CENTROID
C           AA(5)=PLANFORM CENTROID
C           AA(6)=FINENESS RATIO
C           AA(7)=THEORETICAL LENGTH
C           AA(8)=THEORETICAL FINENESS RATIO
C DISCON -- ELEMENTS WHICH HAVE DISCONTINUOUS SLOPES
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION AA(8),X(50),R(50),XX(101),RR(101),DISCON(20)
C
      REAL NX,LENGTH
      LOGICAL TRUNC
C
C***  SKIP PRIMARY CALCULATIONS FOR HEMISPHERICAL CAP
C
      IF(2.*BNOSE .GE. DIAM .AND. .NOT. TRUNC)GO TO 1050
C
C***  COMPUTE GEOMETRY AT 101 POINTS
C
      NPTS=101
C
      FR=LENGTH/DIAM
      IF(DIAM .LE. 2.*BNOSE)FR=LENGTH/(2.*BNOSE)
C
C  DO NOT DUPLICATE LAST POINT FOR THIS SEGMENT
C
      IF(NX .GT. UNUSED)NX=NX-1.
      NNX=NX+0.5
      XO=0.
      IF(NX .GT. UNUSED)XO=X(NNX+1)
C
      XT=0.
C
C  THEORETICAL LENGTH OF POWER
C
      THEOL=LENGTH
      FF=THEOL/DIAM
C
C***  SURFACE X AND R COORDINATES
C
      DO 1000 I=1,NPTS
         XI=FLOAT(I-1)*LENGTH/FLOAT(NPTS-1)
         XX(I)=XI
         RR(I)=DIAM/2.*(XI/LENGTH)**EXP
         XX(I)=XX(I)+XO
 1000 CONTINUE
C
C***  EXTRACT EVERY TENTH POINT FOR OUTPUT AND SUBSEQUENT CALCS.
C
      II=0
      DO 1010 I=1,NPTS,10
         II=II+1
         L=II+NNX
         X(L)=XX(I)
         R(L)=RR(I)
 1010 CONTINUE
C
C  UPDATE POINT TOTAL
C
      NX=NX+FLOAT(II)
C
C  PLANFORM AREA
C
      SP=DSPLAN(NPTS,XX,RR)
C
C  WETTED AREA
C
      SW=DSWET(NPTS,XX,RR)
C
C  VOLUME
C
      VOL=DVOL(NPTS,XX,RR)
C
C  VOLUME CENTROID
C
      XCENV=DXCENV(NPTS,XX,RR)
C
C  PLANFORM AREA CENTROID
C
      XCENP=DXCENP(NPTS,XX,RR)
C
C  STORE FOR RETURN TO CALLING ROUTINE
C
      AA(1)=SP
      AA(2)=SW
      AA(3)=VOL
      AA(4)=XCENV
      AA(5)=XCENP
      AA(6)=FR
      AA(7)=THEOL
      AA(8)=FF
C
C  SET DISCONTINUOUS POINTS
C
      IF (TRUNC) DISCON(1)=1.0
      DO 1020 I=1,20
         JJ=I
         IF(DISCON(I).EQ.UNUSED)GO TO 1030
 1020 CONTINUE
      GO TO 1040
C
C  END OF SEGMENT IS DISCONTINUOUS
C
 1030    DISCON(JJ)=NX
 1040 CONTINUE
C
      GO TO 1060
C
C***  HERE FOR SPHERICAL CAP
C
 1050 CONTINUE
C
      IF(LENGTH .GT. BNOSE)LENGTH=BNOSE
C
      CALL SPHERE(AA,NX,X,R,DIAM)
C
 1060 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SFWRW(M,AR,TAPER,LES,TES,FWRW)
C
C **  COMPUTES SURFACE VORTEX LATERAL POSITION FOR LIFTING
C **  SURFACE/BODY VORTEX INTERFERENCES.
C **  REFERENCE - NACA TR-1307, PITTS, NIELSEN, AND KAATARI.
C **  LIMITATIONS -  SLENDER BODY THEORY.  NO FORWARD SWEPT LEADING
C **                EDGE AND NO TRAILING EDGE SWEEP.  TAPER RATIO
C **                MUST FALL IN THE INTERVAL 0.-1.0.
C **  INPUT -
C **          M = MACH NO.
C **          AR = WING ALONE ASPECT RATIO
C **          TAPER = TIP TO ROOT CHORD TAPER RATIO
C **          LES = LEADING EDGE SWEEP ANGLE
C **          TES = TRAILING EDGE SWEEP ANGLE
C **  OUTPUT -
C **          FWRW = PARAMETER FOR LATERAL LOCATION OF SURFACE VORTEX.
C **               = (VORTEX LATERAL LOCATION-BODY RADIUS AT WING)/
C **                 (WING TOTAL SEMISPAN-BODY RADIUS AT WING)
C **               = (FW-RW)/(SW-RW)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      REAL M,LES
      DIMENSION Z3(3),TX3(7),TY3(21),C(12),IROUT(2)
      DATA KG3,KC3,KP3,KD3/1,3,7,21/
      DATA G3/1./
C
C **  Z3 CORRESPONDS TO TAPER FROM CHART 6C.
C
      DATA Z3/0.,.5,1./
C
C **  TX3 CORRESPONDS TO BETA*AR FROM CHART 6C.
C
      DATA TX3/0.,1.,1.4,2.,4.,6.,8./
C
C **  TY3 - VALUES OF CHART 6C ORDINATE.
C **       COLUMNS CORRESPOND TO TX3.
C **       ROWS CORRESPOND TO Z3.
C
      DATA TY3/
     1.7844,.7891,.7893,.7913,.7934,.7022,.6608,
     2.7844,.7804,.7650,.8021,.8457,.8218,.8174,
     3.7844,.7891,.7782,.7543,.8891,.9326,.9478/
C
C **  COEFFICIENTS FOR CURVE FIT OF CHART 5C.
C
      DATA C/ .7874,-.0058,-.0020, .000110,
     1        -.0014,.0241,.0017,-.000029,
     2        -.0014,-.0140,.0027,-.000317/
      DATA AN/1.0/
C
      TLES=TAN(LES/RAD)
      TTES=TAN(TES/RAD)
      BETA=SQRT(ABS(M*M-1.0))
      BAR=BETA*AR
      IF(M.GT.0.8) GO TO 1000
C
C **  SUBSONIC FWRW FROM CHART 5C; NACA TR-1307.
C
      FWRW=FIT(C,BAR,TAPER,3,4)
      GO TO 1010
C
C **  SUPERSONIC FWRW FROM CHART 6C; NACA TR-1307.
C
 1000 CALL MVLOOK(KG3,KC3,KP3,KD3,G3,Z3,TX3,TY3,BAR,TAPER,AN,FWRW)
 1010 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION TCEFFT(NPTS,SSPAN,CHORD,TOVERC,FINSP)
C
C***  FUNCTION TO COMPUTE THE EFFECTIVE THICKNESS-TO-CHORD RATIO
C***  FOR A FIN PANEL
C
C***  INPUTS
C
C   NPTS -- NUMBER OF INPUT SPAN STATIONS
C  SSPAN -- SEMISPAN STATIONS
C  CHORD -- LOCAL CHORD AT EACH SEMISPAN STATION
C TOVERC -- THICKNESS-TO-CHORD AT EACH SEMISPAN STATION
C  FINSP -- FIN PANEL AREA
C
C***  OUTPUT
C
C TCEFFT -- EFFECTIVE THICKNESS-TO-CHORD RATIO
C
      DIMENSION SSPAN(10),CHORD(10),TOVERC(10),T(10)
C
C*** FUNCTIONS TO INTEGRATE C*(T/C)**2
C
C  IF CHORD LENGTH IS CONSTANT
C
      TOCF1(YY)=(A**2*YY**3+3.*A*B*YY**2+3.*B**2*YY)/(3.*D)
C
C  IF CHORD LENGTH VARIES LINEARLY BUT DOES NOT GO TO ZERO
C
      TOCF2(YY)=(A**2*.5*YY**2/C)+((2.*A*B/C)-(A**2*D/C**2))*YY+
     1((B**2/C)+(A**2*D**2/C**3)-(2.*A*B*D/C**2))*ALOG(C*YY+D)
C
C  IF CHORD LENGTH VARIES LINEARLY AND DOES GO TO ZERO
C
      TOCF3(YY)=(A**2/C)*(YY**2/2+D/C*YY)
C
      TCEFFT=0.0
C
C*** THICKNESS AT EACH SEMISPAN STATION
C
      DO 1000 I=1,NPTS
         T(I)=TOVERC(I)*CHORD(I)
 1000 CONTINUE
C
C*** WORK ACROSS THE SPAN
C
      DO 1020 I=2,NPTS
         II=I
C
C***     ASSUMING A LINEAR VARIATION OF THICKNESS AND CHORD OVER SEMISPA
C
C        THICKNESS =A*Y+B
C
         A=(T(II)-T(II-1))/(SSPAN(II)-SSPAN(II-1))
         B=T(II-1)-A*SSPAN(II-1)
C
C        CHORD=C*Y+B
C
         C=(CHORD(II)-CHORD(II-1))/(SSPAN(II)-SSPAN(II-1))
         D=CHORD(II-1)-C*SSPAN(II-1)
C
C***     CHECK IF CHORD LENGTH GOES TO ZERO
C
         IF(CHORD(II).EQ.0.0.OR.CHORD(II-1).EQ.0.0)GO TO 1010
C
C***     INTEGRATION OF THIS SECTION FOR CHORD NOT GOING TO ZERO
C
C     IF CHORD LENGTH IS CONSTANT
C
         IF(C.EQ.0.)TCEFFT=TCEFFT+TOCF1(SSPAN(II))-TOCF1(SSPAN(II-1))
C
C     IF CHORD LENGTH VARIES LINEARLY BUT DOES NOT GO TO ZERO
C
         IF(C.NE.0.)TCEFFT=TCEFFT+TOCF2(SSPAN(II))-TOCF2(SSPAN(II-1))
         GO TO 1020
C
C***     INTEGRATION OF THIS SECTION FOR CHORD THAT DOES GO TO ZERO
C
C     IF CHORD LENGTH VARIES LINEARLY AND DOES GO TO ZERO
C
 1010    CONTINUE
         TCEFFT=TCEFFT+TOCF3(SSPAN(II))-TOCF3(SSPAN(II-1))
C
 1020 CONTINUE
C
C***  FINALIZE THE CALCULATION
C
      TCEFFT=SQRT(TCEFFT/FINSP)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCNAB(MACH,DBASE,DMAX,CNAB)
C
C***  SUBROUTINE TO COMPUTE THE INCREMENTAL NORMAL FORCE SLOPE
C***  DUE TO A CONICAL BOATTAIL ON AXISYMMETRIC BODIES
C***  METHOD FROM NSWC-TR-81-156, P.110 (EMPIRICAL CORRELATION)
C
C***  INPUTS
C
C   MACH -- FREE STREAM MACH NUMBER
C  DBASE -- BODY BASE DIAMETER
C   DMAX -- MAXIMUM BODY DIAMETER
C
C***  OUTPUT
C
C   CNAB -- INCREMENTAL NORMAL FORCE SLOPE, PER RADIAN
C
      DIMENSION TCNASB(10),TCNASP(10),BETASB(10),BETASP(10)
C
      REAL MACH
C
      DATA TCNASB /3.35,3.48,3.60,3.65,3.50,2.60,1.75,1.46,
     1             1.35,1.28/
      DATA TCNASP /3.35,3.00,2.56,2.25,1.83,1.30,1.02,0.95,
     1             0.85,0.75/
      DATA BETASB/0.,.10,.20,.30,.45,.60,.75,.85,.925,1.00/
      DATA BETASP/0.,.25,.50,.65,.82,1.00,1.25,1.50,2.00,2.50/
C
C***    COMPUTE BETA (MACH SIMILARITY PARAMETER)
C
        BETA=SQRT(ABS(MACH**2-1.))
C
C***    SELECT SUBSONIC OR SUPERSONIC TABLE
C
C     * IF THE MACH NUMBER IS GREATER THAN UNITY
           IF(MACH .GT. 1.)GO TO 1000
           GO TO 1010
C       THEN LINEARILY INTERPOLATE SUPERSONIC TABLE
 1000      CONTINUE
           CALL LNTRP(BETASP,TCNASP,10,BETA,CNAF)
           GO TO 1020
C       ELSE LINEARILY INTERPOLATE SUBSONIC TABLE
 1010      CONTINUE
           CALL LNTRP(BETASB,TCNASB,10,BETA,CNAF)
 1020   CONTINUE
C     * ENDIF
C
C***    MULTIPLY BY -(1.-(DBASE/DMAX)**2) TO GET CNAB
C
        CNAB=CNAF*((DBASE/DMAX)**2-1.)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CHKEND(KOL,KAND,END)
C
C***  SUBROUTINE TO CHECK IF LAST NAMELIST COMPLETE
C
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      DIMENSION KOL(80)
      LOGICAL END
      CHARACTER*4 IBLANK,KAND,KOL
      DATA IBLANK / '    ' /
C
      IF(KOL(2).EQ.KAND.AND.(.NOT.END).AND.PARTS(17))
     1 WRITE(6,1000)KAND
      IF(KOL(2).EQ.KAND.AND.(.NOT.END))WRITE(8,1010)KAND,(IBLANK,
     1 J=1,75)
      IF(KOL(2).EQ.KAND.AND.(.NOT.END))END=.TRUE.
 1000 FORMAT(2X,A1,'END',8X,'** MISSING NAMELIST TERMINATION',
     1 ' ADDED **')
 1010 FORMAT(1X,A1,'END',75A1)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CVRTFT
C
C***  ROUTINE TO CONVERT ALL INPUT AND DATA ARRAYS FROM
C***  UNITS THAT ARE FEET TO UNITS THAT ARE USER DEFINED
C
C ... FLIGHT CONDITIONS
C
      CALL CVRFLT(+1)
C
C ... REFERENCE QUANTITIES
C
      CALL CVRREF(+1)
C
C ... BODY DATA
C
      CALL CVRBOD(+1)
C
C ... FIN DATA
C
      CALL CVRFIN(+1)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE EXTRST(KOL, FROM, TO, STRING)
C
C***  EXTRACT A STRING IN ARRAY KOL AND PUT IN ARRAY STRING.
C***  EXTRACT FROM-TO.
C
      INTEGER FROM,TO
      CHARACTER*4 KOL,STRING
C
      DIMENSION KOL(80),STRING(80)
C
      II=0
      DO 1000 I=FROM,TO
          II=II+1
          STRING(II)=KOL(I)
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FINFIN(MACH,AR,CR,SPAN,TAPER,RADF,ISURF,A14,A24,
     1                  A34,A44,L12,L24)
C
C  SUBROUTINE TO DETERMINE DELTA-ALPHA-EQUIVALENT OF A DEFLECTED
C  FIN IN THE PRESENCE OF ADJACENT CRUCIFORM FINS
C  NOTE: THE FIN IS ASSUMED TO HAVE NO TRAILING EDGE SWEEP
C
C  METHOD FROM NEAR TR 125
C
C  REV 3/99 ROUTINE REVISED TO CORRECT L12 CALCULATION
C
C *** INPUTS ***
C   MACH - FREESTREAM MACH NUMBER
C     AR - EXPOSED FIN ASPECT RATIO
C     CR - FIN EXPOSED ROOT CHORD
C   SPAN - SPAN OF TWO FINS (INCLUDES BODY)
C  TAPER - FIN EXPOSED TAPER RATIO
C   RADF - BODY RADIUS AT FIN
C  ISURF - TYPE OF SURFACES: 1=PLANAR, 2=CRUCIFORM
C
C *** OUTPUTS ***
C
C    A14 - DELTA ALPHA EQUIVALENT FOR FIN #1 DUE TO FIN #4
C    A24 - DELTA ALPHA EQUIVALENT FOR FIN #2 DUE TO FIN #4
C    A34 - DELTA ALPHA EQUIVALENT FOR FIN #3 DUE TO FIN #4
C    A44 - DELTA ALPHA EQUIVALENT FOR FIN #4 DUE TO FIN #4
C
      REAL MACH,L12,L24,MU
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION TDB(11),T14(11),T24(11),T34(11),T44(11),IROUT(2)
C
      DATA TDB/0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./
      DATA T14/-.275,-.230,-.188,-.149,-.112,-.0784,-.0498,
     1         -.0272,-.0115,-.0027,0./
      DATA T24/-.0789,-.0731,-.0658,-.0567,-.0460,-.0343,-.0230,-.0130,
     1         -.00566,-.00134,0./
      DATA T34/-.275,-.230,-.188,-.149,-.112,-.0784,-.0498,
     1         -.0272,-.0115,-.0027,0./
      DATA T44/.921,.890,.878,.879,.889,.905,.925,.946,.966,
     1         .984,1./
C
      ACOSH(U)=ALOG(U+SQRT(U*U-1.))
      ASINH(U)=ALOG(U+SQRT(U*U+1.))
C
      DOB=2.*RADF/SPAN
      L12=1.0
      L24=1.0
C
C  SKIP CALCULATIONS IF SUBSONIC
C
      IF(MACH.LE.1.) GO TO 1030
C
C  DETERMINE ADJACIENT FIN FACTOR, L12
C
      IF(ISURF .LE. 1) GO TO 1020
C
C  CHECK FOR NO INTERFERENCE
C
      L12=0.
      BETA=SQRT(MACH**2-1.)
      C=PI/2.-1.
      IF((CR/(BETA*RADF)-1.).LT.C) GO TO 1020
C
C  PARTIAL INTERFERENCE
C
      SM    = SPAN/2.
      XSTAR = RADF*BETA*(1.+SQRT((SM/RADF-1.)**2+C**2))
C
C  CHECK FOR LEADING EDGE INTERSECTION
C
      IF(XSTAR.GT.0..AND.XSTAR.LT.((1.-TAPER)*CR)) THEN
      XU=BETA*RADF*(1.+SQRT(1.-(1.-C**2)*(1.-BETA**2*RADF**2*
     1 (SM/RADF-1.)**2/(CR**2*(1.-TAPER)**2))))/(1.-BETA**2*RADF**2
     2 *(SM/RADF-1.)**2/(CR**2*(1.-TAPER)**2))
      ETAU=XU/(BETA*RADF)-1.
      L12=1.-XU**2*AR/(4.*CR*(1.-TAPER)*(SM-RADF))+BETA*AR
     1 /(4.*(SM/RADF-1.)**2)*(ETAU*SQRT(ETAU**2-C**2)-C**2*
     2 ACOSH(ETAU/C))
C
C  CHECK FOR TIP INTERSECTION
C
      ELSEIF(XSTAR.GE.((1.-TAPER)*CR).AND.XSTAR.LE.CR) THEN
      L12=BETA*AR/(2.*(SM/RADF-1.)**2)*(.5*((SM/RADF-1.)*
     1 SQRT((SM/RADF-1.)**2+C**2)-C**2*ASINH((SM/RADF-1.)/C))+
     2 (SM/RADF-1.)*((CR/(BETA*RADF)-1.)-SQRT((SM/RADF-1.)**2+C**2)))
C
C  OTHERWISE HAVE TRAILING EDGE INTERSECTION
C
      ELSEIF(CR.GT.XSTAR) THEN
      L12=BETA*AR/(4.*(SM/RADF-1.)**2)*((CR/(BETA*RADF)-1.)*
     1 SQRT((CR/(BETA*RADF)-1.)**2-C**2)-C**2*ACOSH((CR/(BETA*RADF)-
     2 1.)/C))
      ENDIF
C
 1020 CONTINUE
C
C  DETERMINE OPPOSING FIN FACTOR, L24
C
      CALL BETAU(CR,RADF,C,SM,TAPER,ISURF,BU)
      MU = SQRT(BU*BU+1.0)
      L24= (MU-MACH)/(MU-1.0)
C
      IF(L12 .LT. 0.0) L12=0.0
      IF(L24 .LT. 0.0) L24=0.0
C
C  SPLINE INTERFERENCE TABLES
C
 1030 CONTINUE
      CALL SPLINE(TDB,T14,11,2,2,0.,0.,DOB,1,A14,DUM)
      CALL SPLINE(TDB,T24,11,2,2,0.,0.,DOB,1,A24,DUM)
      CALL SPLINE(TDB,T34,11,2,2,0.,0.,DOB,1,A34,DUM)
      CALL SPLINE(TDB,T44,11,2,2,0.,0.,DOB,1,A44,DUM)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HYBG2(N3,IERROR,BETA,RP,X,R,N,NSHAPE,N1,N2,NN1,
     1 NN2,NN3,NN,VOVS,BR,DRB)
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  ORIGINAL ROUTINE WRITTEN BY F. MOORE, NSWC
C  MODIFIED BY J. JENKINS, WL/FIGC
C
C***  THIS ROUTINE FOR CONFIGURATIONS HAVING BLUNTED NOSES
C
C***  INPUT PARAMETERS
C       BETA   - MACH PARAMETER, SQRT(M**2-1)
C       X      - ARRAY OF BODY X COORDINATES REFERED TO SHIFTED
C                ORIGIN
C       R      - ARRAY OF BODY RADIAL COORDINATES
C       N      - NUMBER OF LONGITUDINAL STATIONS
C       NSHAPE - EQUALS 1 FOR NOSE ALONE
C              - EQUALS 2 FOR NOSE + BODY
C              - EQUALS 3 FOR NOSE + TAIL
C              - EQUALS 4 FOR NOSE + BODY + TAIL
C       N1     - NUMBER OF POINTS FROM NOSE TIP TO END OF NOSE SEGMENT
C       N2     - NUMBER OF POINTS FROM NOSE TIP TO END OF BODY SEGMENT
C       N3     - EQUALS 0, IF NO TAIL SEGMENT
C              - EQUALS 1, IF TAIL SEGMENT IS CONICAL
C              - EQUALS 2, IF TAIL SEGMENT IS OGIVAL
C       VOVS   - MACH NUMBER
C       BR     - NOSE BLUNTNESS RATIO
C       DRB    - SLOPE OF MERIDIAN CURVE AT NOSE TIP
C
C***  OUTPUT VARIABLES
C       IERROR - EQUALS 0, IF NO ERRORS ENCOUNTERED
C              - EQUALS 1, IF ANY ERRORS ENCOUNTERED
C       RP     - SLOPE AT FIRST STATION
C       NN1    - NUMBER OF GRID POINTS ALONG NOSE
C       NN2    - NUMBER OF GRID POINTS ALONG BODY SEGMENT
C       NN3    - NUMBER OF GRID POINTS ALONG TAIL SEGMENT
C       NN     - TOTAL NUMBER OF GRID POINTS
C
      COMMON /VDARY/ XB(220),RB(220),RBP(220),C(220),C1(220),RB1(220),
     1  RBP1(220),B(220),PSI(220),ZE0X(220),PSIR(220),PHIX(220)
      DIMENSION X(50),R(50)
C
      NN1=0
      NN2=0
      NN3=0
      IERROR=0
      BETA=SQRT(VOVS**2-1.0)
      C2=.05
      C4=1.0
      C3=C2/C4
      CZE=BETA**3
      BET1=BETA
      IF(BET1 .GT. 1.0) BET1=1.
      IF(CZE .GT. 10.) CZE=10.
C
C***  GENERATE PSEUDO-NOSE CAP
C
      CALL BLUNT(BETA,IERROR,RP,X,R,NN1,VOVS,K,BR,DRB)
      IF(IERROR .EQ. 1) GO TO 1060
C
***   NOW FINISH NOSE
C
        XB(K+2)=X(1)
        RB(K+2)=R(1)
        CALL FDP5(X,R,XB(K+2),RBP(K+2),N1,1)
        XB(K+3)=XB(K+2)+C3*BET1*RB(K+2)
        CALL INTERP(X,R,XB(K+3),RB(K+3),N1,3)
        CALL FDP5(X,R,XB(K+3),RBP(K+3),N1,1)
        IJ=1
 1000   CONTINUE
        K=K+1
        IJ=IJ+1
        A=IJ
        C5=A*C3
        XB(K+3)=XB(K+2)+C5*BET1*RB(K+2)
        IF(NSHAPE .EQ. 1 .AND. XB(K+3) .GT. X(N1)) XB(K+3)=X(N1)
        CALL INTERP(X,R,XB(K+3),RB(K+3),N1,3)
        CALL FDP5(X,R,XB(K+3),RBP(K+3),N1,1)
        IF(XB(K+3) .LT. (X(N1)-.0001)) GO TO 1000
        XB(K+3)=X(N1)
        RB(K+3)=R(N1)
        CALL FDP5(X,R,XB(K+3),RBP(K+3),N1,1)
        NN1=K+3
        NN=K+3
        IF(NSHAPE .EQ. 1) GO TO 1060
          IF(NSHAPE .EQ. 3) GO TO 1030
C
C***  HERE FOR CYLINDRICAL BODY SEGMENT
C
            XB(K+4)=XB(K+3)
            RB(K+4)=RB(K+3)
            RBP(K+4)=0.
            XB(K+5)=XB(K+4)+C3*BET1*RB(K+4)
            RB(K+5)=RB(K+4)
            RBP(K+5)=0.
            IJ=1
 1010       CONTINUE
            K=K+1
            IJ=IJ+1
            A=IJ
            C5=A*C3
            XB(K+5)=XB(K+4)+C5*BET1*RB(K+4)
            IF((XB(K+5)-X(N2)).LT.2.) GO TO 1020
              DX2=BETA*RB(K+4)
              IF(DX2.GT..5) DX2=.5
              XB(K+5)=XB(K+4)+DX2
              DX1=XB(K+4)-XB(K+3)
              AR=DX2/DX1
              IF(AR.GT.1.25) XB(K+5)=XB(K+4)+1.25*DX1
 1020       CONTINUE
            RB(K+5)=RB(K+4)
            RBP(K+5)=0.
            IF(XB(K+5) .LT. (X(N2)-.0001)) GO TO 1010
            XB(K+5)=X(N2)
            RB(K+5)=R(N2)
            NN2=K+5
            NN=K+5
 1030     CONTINUE
          IF(NSHAPE .EQ. 2) GO TO 1060
C
C***  HERE FOR TAIL SEGMENT
C
            IF(N3 .EQ. 2) GO TO 1040
C
C***  HERE FOR CONICAL TAIL SEGMENT
C
              IF(NSHAPE .EQ. 4) K=K+2
              XB(K+4)=XB(K+3)
              RB(K+4)=RB(K+3)
              RBP(K+4)=(R(N)-RB(K+4))/(X(N)-XB(K+4))
              XB(K+5)=X(N)
              RB(K+5)=R(N)
              RBP(K+5)=RBP(K+4)
              NN3=K+5
              NN=K+5
              GO TO 1060
C
C***  HERE FOR TAIL SEGMENT OF GENERAL SHAPE
C
 1040         IF(NSHAPE .EQ. 3) NA=N1
              IF(NSHAPE .EQ. 4) NA=N2
              IF(NSHAPE .EQ. 4) K=K+2
              XB(K+4)=XB(K+3)
              RB(K+4)=RB(K+3)
              CALL FDP5(X,R,XB(K+4),RBP(K+4),N,NA)
              XB(K+5)=XB(K+4)+C3*BET1*RB(K+4)
              CALL INTERP (X,R,XB(K+5),RB(K+5),N,NA)
              CALL FDP5(X,R,XB(K+5),RBP(K+5),N,NA)
              IJ=1
 1050         CONTINUE
              K=K+1
              IJ=IJ+1
              A=IJ
              C5=A*C3
              XB(K+5)=XB(K+4)+C5/CZE*BET1*RB(K+4)
              CALL INTERP (X,R,XB(K+5),RB(K+5),N,NA)
              CALL FDP5(X,R,XB(K+5),RBP(K+5),N,NA)
              IF(XB(K+5) .LT. (X(N)-.0001)) GO TO 1050
              XB(K+5)=X(N)
              RB(K+5)=R(N)
              CALL FDP5(X,R,XB(K+5),RBP(K+5),N,NA)
              NN3=K+5
              NN=K+5
 1060 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE LIPCOR(CAINL,MACH)
C
C *** TEMPORARY SUBROUTINE TO CORRECT DIVERTER MODEL BASED ON
C *** NASA MEMO 1-10-59E, SEPT 1958.
C *** THIS CORRECTS A SPECIFIC INLET FOR OFF DESIGN, COWL-LIP
C *** DRAG  (THIS IS NOT GENERALIZED YET)
C
      DIMENSION DCAL(4),TMACH(4)
      REAL MACH
      DATA DCAL/.02286,.02487,.02712,.02893/
      DATA TMACH/2.5,2.95,3.5,3.95/
C
      DO 1000 I=1,4
      IF (ABS(MACH-TMACH(I)).GT..1) GO TO 1000
      IM=I
      GO TO 1010
 1000 CONTINUE
 1010 CONTINUE
C     CAINL=CAINL-DCAL(IM)
C
C *** C WITH ABOVE LINE NULLS OUT CORRECTION
C *** ON DESIGN OPERATION IS ASSUMED
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PRFLC9(IM,NDUM,NMF,NAF)
C
C***  FORTRAN 90 VERSION
C***  SUBROUTINE TO PRINT FLIGHT CONDITIONS HEADER
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
C
      REAL NALPHA,NMACH,MACH,LREF,LATREF
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
C
      CALL CVRTFT
C
      IF(IM .LE. 0)IM=1
      IF(IM .GT. 20)IM=20
C
C  REPLACE STATIC PRESSURE WITH DYNAMIC PRESSURE IN 1995 REVISION
C
      DP=PINF(IM)
      IF(PINF(IM).NE.-UNUSED) DP=0.5*1.4*PINF(IM)*(MACH(IM))**2
      WRITE(6,900)
  900 FORMAT(4X,'   ******* FLIGHT CONDITIONS AND REFERENCE',
     1      ' QUANTITIES *******')
C
C  ENGLISH UNITS - FEET
C
      IF(LDIMFT) THEN
         WRITE(6,1000) MACH(IM),REN(IM)
         IF(ALT(IM).NE.UNUSED) WRITE(6,1010) ALT(IM),DP
         WRITE(6,1020) BETA,PHI
         WRITE(6,1030) SREF,XCG
         WRITE(6,1040) LREF,LATREF
 1000 FORMAT(4X,' MACH NO  = ',F10.2,'                REYNOLDS NO = ',
     1      1PE9.3,' /FT')
 1010 FORMAT(4X,' ALTITUDE = ',F10.1,' FT        DYNAMIC PRESSURE = ',
     1        F9.2,' LB/FT**2')
 1020 FORMAT(4X,' SIDESLIP = ',F10.2,' DEG                   ROLL = ',
     1        F9.2,' DEG     ')
 1030 FORMAT(4X,' REF AREA = ',F10.3,' FT**2        MOMENT CENTER = ',
     1        F9.3,' FT') 
 1040 FORMAT(4X,' REF LENGTH = ',F8.2,' FT          LAT REF LENGTH = ',
     1        F9.2,' FT'/) 
      ENDIF
C
C  ENGLISH UNITS - INCHES
C
      IF(LDIMIN) THEN
         WRITE(6,1100) MACH(IM),REN(IM)
         IF(ALT(IM).NE.UNUSED) WRITE(6,1110) ALT(IM),DP
         WRITE(6,1120) BETA,PHI
         WRITE(6,1130) SREF,XCG
         WRITE(6,1140) LREF,LATREF
 1100 FORMAT(4X,' MACH NO  = ',F10.2,'                REYNOLDS NO = ',
     1      1PE9.3,' /FT')
 1110 FORMAT(4X,' ALTITUDE = ',F10.1,' FT        DYNAMIC PRESSURE = ',
     1        F9.2,' LB/FT**2')
 1120 FORMAT(4X,' SIDESLIP = ',F10.2,' DEG                   ROLL = ',
     1        F9.2,' DEG     ')
 1130 FORMAT(4X,' REF AREA = ',F10.3,' IN**2        MOMENT CENTER = ',
     1        F9.3,' IN') 
 1140 FORMAT(4X,' REF LENGTH = ',F8.2,' IN          LAT REF LENGTH = ',
     1        F9.2,' IN'/) 
      ENDIF
C
C  METRIC UNITS - METERS
C
      IF(LDIMM) THEN
         WRITE(6,1200) MACH(IM),REN(IM)
         IF(ALT(IM).NE.UNUSED) WRITE(6,1210) ALT(IM),DP
         WRITE(6,1220) BETA,PHI
         WRITE(6,1230) SREF,XCG
         WRITE(6,1240) LREF,LATREF
 1200 FORMAT(4X,' MACH NO  = ',F10.2,'                REYNOLDS NO = ',
     1      1PE9.3,' /M')
 1210 FORMAT(4X,' ALTITUDE = ',F10.1,' M         DYNAMIC PRESSURE = ',
     1        F9.2,' N/M**2')
 1220 FORMAT(4X,' SIDESLIP = ',F10.2,' DEG                   ROLL = ',
     1        F9.2,' DEG     ')
 1230 FORMAT(4X,' REF AREA = ',F10.3,' M**2         MOMENT CENTER = ',
     1        F9.3,' M') 
 1240 FORMAT(4X,' REF LENGTH = ',F8.2,' M           LAT REF LENGTH = ',
     1        F9.2,' M'/) 
      ENDIF
C
C  METRIC UNITS - CENTIMETERS
C
      IF(LDIMCM) THEN
         WRITE(6,1300) MACH(IM),REN(IM)
         IF(ALT(IM).NE.UNUSED) WRITE(6,1310) ALT(IM),DP
         WRITE(6,1320) BETA,PHI
         WRITE(6,1330) SREF,XCG
         WRITE(6,1340) LREF,LATREF
 1300 FORMAT(4X,' MACH NO  = ',F10.2,'                REYNOLDS NO = ',
     1      1PE9.3,' /M')
 1310 FORMAT(4X,' ALTITUDE = ',F10.1,' M         DYNAMIC PRESSURE = ',
     1        F9.2,' N/M**2')
 1320 FORMAT(4X,' SIDESLIP = ',F10.2,' DEG                   ROLL = ',
     1        F9.2,' DEG     ')
 1330 FORMAT(4X,' REF AREA = ',F10.3,' CM**2        MOMENT CENTER = ',
     1        F9.3,' CM') 
 1340 FORMAT(4X,' REF LENGTH = ',F8.2,' CM          LAT REF LENGTH = ',
     1        F9.2,' CM'/) 
      ENDIF
C
      CALL CVRTUS
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SHOCK(GAM,AM,SD2,P2,PC,AMX,PT)
C
C  COMPUTE PRESSURE AND MACH NUMBER BEHIND A CONICAL SHOCK
C  REFERENCE - DEJARNETTE (AIAA J. SPACECRAFT, NOV-DEC 1980, P.529)
C
C
C  INPUTS
C
C    GAM -- RATIO OF SPECIFIC HEATS FOR THE GAS
C     AM -- MACH NUMBER
C    SD2 -- SINE SQUARED OF THE DEFLECTION ANGLE
C     P2 -- PRESSURE BEHIND THE SHOCK
C     PC -- CONICAL PRESSURE
C
C  OUTPUTS
C
C    AMX -- MACH NUMBER BEHIND THE SHOCK
C     PT -- TOTAL PRESSURE BEHIND THE SHOCK
C
C
C  SUBROUTINES CALLED -- NONE
C
      ST2=(GAM+1.)/2.*SD2+1./AM**2
      IF(ST2.GT.1.0)ST2=1.0
      T1=ST2*AM**2
C
C  COMPUTE (P/PT)**(1/GAM), NACA 1135 EQUATION 93 TO THE 1./GAM POWER
C
      T2=((GAM+1.)/(2.*GAM*T1-(GAM-1.)))**(1./GAM)
      T3=(GAM+1.)/(GAM-1.)*T1*(AM**2+2./(GAM-1.))/(2./(GAM-1.))
     1   /(T1+2./(GAM-1.))
      AMX=SQRT((T2*T3/PC**((GAM-1.)/GAM)-1.)/((GAM-1.)/2.))
C
C  COMPUTE TOTAL PRESSURE
C
      PT=P2*(1.+(GAM-1.)/2.*AMX**2)**(GAM/(GAM-1.))
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE TESTOR(ISEQ,GO,END,KOL,L,NAM,K,IER,LEN,LDM,NUM,NAMES,
     1 NNAM,SUBED)
C
C***  SUBROUTINE TO TEST CORRECT SPELLING OF NAMELIST VARIABLES
C***  AND TO CHECK SYNTAX
C
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /PARTF/  PARTS(19)
      LOGICAL PARTS
      DIMENSION KOL(80), LEN(NUM), LDM(NUM), NAMES(NNAM)
      DIMENSION NUMBER(15), TRUE(4), FALSE(5)
      LOGICAL END, FLAG, ARRAY, FOUND, NMTEST, GO, SUBED
C
      CHARACTER*4 KAND,NUMBER,TRUE,FALSE,BLANK,EQUAL,COMMA,KOL,NAMES
C
      DATA NUMBER / '0   ','1   ','2   ','3   ','4   ',
     1       '5   ','6   ','7   ','8   ','9   ','+   ','-   ',
     2       '.   ','*   ','E   '/
      DATA TRUE  / 'T   ','R   ','U   ','E   '/
      DATA FALSE / 'F   ','A   ','L   ','S   ','E   '/
      DATA BLANK / '    '/
      DATA EQUAL / '=   '/
      DATA COMMA / ',   '/
C
      NA = 0
      NB = 0
      NC = 0
      ND = 0
      NE = 0
      NF = 0
C
C ... IF VARIABLE SUBSTITUTED, INHIBIT REPRINTING OF INPUT CARD
C ... THIS OPTION CAN BE REACTIVITATED BY REMOVING THE C IN
C ... COLUMN 1 OF THE CARD BELOW AND THE FORMAT 1260
C
C       IF(SUBED.AND.PARTS(17))WRITE(6,1260) (KOL(J),J=1,80)
C
C***  UNKNOWN NAMELIST NAME - WRITE CARD AND RETURN
C
      IF(IER .EQ. 0) GO TO 1000
        IF(PARTS(17))WRITE(6,1180) ISEQ,(KOL(J),J=1,80)
        GO TO 1175
 1000 CONTINUE
C
C***  END CARD - WRITE CARD AND RETURN
C
      IF(NAM .GE. 2) GO TO 1010
        IF(PARTS(17))WRITE(6,1190) ISEQ,(KOL(J),J=1,80)
        END = .TRUE.
        GO TO 1170
 1010 CONTINUE
C
C***  INSERT END CARD IF REQUIRED
C
      FLAG = (K .EQ. 1) .AND. (.NOT. END)
      IF(.NOT. FLAG) GO TO 1020
        IF(PARTS(17))WRITE(6,1200)  KAND
        WRITE(8,1210) KAND, (BLANK,J=1,75)
        END = .TRUE.
 1020 CONTINUE
C
C***  FIRST CARD DOES NOT CONTAIN NAMELIST NAME - WRITE CARD AND RETURN
C
      FLAG = (K .EQ. 2) .AND. END
      IF(.NOT. FLAG) GO TO 1030
        IF(PARTS(17))WRITE(6,1220) ISEQ,(KOL(J),J=1,80), KAND
        GO TO 1170
 1030 CONTINUE
C
C***  TEST FOR VALID VARIABLE NAME STARTING IN KOL(L)
C
      IF(K .EQ. 1) END = .FALSE.
      IF(KOL(L) .NE. BLANK) GO TO 1040
        L = L+1
        IF(L .GE. 81) GO TO 1160
        GO TO 1030
 1040 CONTINUE
      IF(KOL(L) .EQ. KAND) END = .TRUE.
      IF(END) GO TO 1160
      CALL VNAME(KOL,L,LEN,NUM,NAMES,NNAM,I,FOUND,ARRAY,NDMS,NF,NUMBER,
     1           BLANK,EQUAL)
      IF(FOUND) GO TO 1110
C
C***  NAME NOT FOUND, IF K=2 CHECK FOR NUMBER CONTINUATION
C***                  IF K=1 SEARCH FOR NEXT NAME
C
      IF(K .EQ. 1) GO TO 1060
        NDMS = NDML
        NDML = 0
        DO 1050 J=1,14
        IF(KOL(L) .EQ. NUMBER(J)) GO TO 1140
 1050   CONTINUE
 1060 CONTINUE
      IS = I
      NA = NA+1
 1070 CONTINUE
      IF(L .GE. 81) GO TO 1160
      IF(KOL(L) .EQ. KAND) GO TO 1040
      FLAG = (KOL(L) .EQ. BLANK) .OR. (KOL(L) .EQ. EQUAL) .OR.
     1       (KOL(L) .EQ. COMMA)
      IF(FLAG) GO TO 1080
        L = L+1
        GO TO 1070
 1080 CONTINUE
      IF(L .GE. 81) GO TO 1160
      DO 1090 J=1,15
      IF(KOL(L) .EQ. NUMBER(J)) GO TO 1100
 1090 CONTINUE
      FLAG = (KOL(L) .EQ. BLANK) .OR. (KOL(L) .EQ. EQUAL) .OR.
     1       (KOL(L) .EQ. COMMA)
      IF(FLAG) GO TO 1100
      IF(NMTEST(KOL(L),TRUE,4)) L = L+3
      IF(NMTEST(KOL(L),TRUE,4)) GO TO 1100
      IF(NMTEST(KOL(L),FALSE,5)) L = L+4
      IF(NMTEST(KOL(L),FALSE,5)) GO TO 1100
      IF(KOL(L-1) .EQ. NUMBER(15)) L = L-1
      GO TO 1030
 1100 CONTINUE
      L = L+1
      GO TO 1080
C
C***  NAME FOUND - SET UP ARRAY DESIGNATION AND CHECK NAME DELIMITERS
C
 1110 CONTINUE
      IS = I
      NDM = IABS(LDM(I))
      NDML = 0
      FLAG = ARRAY .AND. (NDM .EQ. 1)
      IF (.NOT. FLAG) GO TO 1120
        ARRAY = .FALSE.
        NC = NC+1
 1120 CONTINUE
      IF(L .GE. 80) GO TO 1130
      IF(KOL(L) .NE. BLANK) GO TO 1130
        L = L+1
        GO TO 1120
 1130 CONTINUE
      IF(KOL(L) .NE. EQUAL) NB = NB+1
      IF(KOL(L) .EQ. EQUAL) L = L+1
C
C***  CHECK NUMERICAL INPUT AND THE NUMBER OF ARRAY
C***  ELEMENTS INPUT
C
 1140 CONTINUE
      I = IS
      IF(I .EQ. 0) GO TO 1070
      IF(L .GE. 81) GO TO 1160
      IF(KOL(L) .NE. BLANK) GO TO 1150
        L = L+1
        GO TO 1140
 1150 CONTINUE
      IF(LDM(I) .LT. 0) CALL LVALUE(KOL,L,NDML,NF,BLANK,
     1                             COMMA,NUMBER)
      IF(LDM(I) .GT. 0) CALL RVALUE(KOL,L,NDML,NF,BLANK,
     1                             COMMA,NUMBER)
C
C***  CHECK THE NUMBER OF VALUES LOADED TO THE VARIABLE DIMENSION
C
      IF(NDML .EQ. 0) GO TO 1080
      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 1030
C
C***  END OF CARD OR END OF INPUT ENCOUNTERED
C
 1160 CONTINUE
      NERR = NA+NB+NC+ND+NE+NF
      IF(NERR .EQ. 0 .AND. .NOT.SUBED .AND. PARTS(17))
     1 WRITE(6,1190)ISEQ,(KOL(J),J=1,80)
      IF(NERR .NE. 0 .AND. PARTS(17))
     1 WRITE(6,1230)ISEQ,(KOL(J),J=1,80), NA, NB,
     2                              NC, ND, NE, NF
      IF(NA.NE.0 .OR. NB.NE.0 .OR. NC.NE.0 .OR.
     1   ND.NE.0 .OR. NE.NE.0)GO=.FALSE.
      IF((NA.NE.0 .OR. NB.NE.0 .OR. NC.NE.0 .OR.
     1   ND.NE.0 .OR. NE.NE.0) .AND. PARTS(17))WRITE(6,1250)
 1170 WRITE(8,1240) (KOL(J),J=1,80)
C
 1175 CONTINUE
C
      SUBED=.FALSE.
C
C***  FORMATS
C
 1180 FORMAT(1X,I3,1X,80A1,/,8X,'** ERROR ** UNKNOWN NAMELIST NAME')
 1190 FORMAT(1X,I3,1X,80A1)
 1200 FORMAT(6X,A1,'END',18X,'** MISSING NAMELIST TERMINATION',
     1       ' ADDED **')
 1210 FORMAT(1X,A1,'END',75A1)
 1220 FORMAT(1X,I3,1X,80A1,/,8X,'** ERROR ** NO NAMELIST NAME',
     1  ' FOLLOWING',A2)
 1230 FORMAT(1X,I3,1X,80A1,/,8X,'** ERROR **',I3,'*A',I3,'*B',
     1       I3,'*C',I3,'*D',I3,'*E',I3,'*F')
 1240 FORMAT(80A1)
 1250 FORMAT(8X,'* FATAL ERROR *')
C1260 FORMAT(5X,80A1,/,8X,'** REVISED CARD IMAGE')
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCNAF(DFWD,DAFT,CNAF)
C
C  COMPUTE THE INCREMENTAL NORMAL FORCE COEFFICIENT SLOPE
C  DUE TO A FLARE AT SUBSONIC/TRANSONIC SPEEDS
C
C  METHOD FROM AMC PAMPHLET AMCP 706-280, JULY 1968
C
C***  INPUTS
C
C  DFWD - DIAMETER OF THE FORWARD END OF THE FLARE
C  DAFT - DIAMETER OF THE BASE OF THE FLARE
C
***  OUTPUT
C
C  CNAF - FLARE NORMAL FORCE SLOPE INCREMENT, PER RADIAN
C         BASED OF FORWARD AREA OF FLARE
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION DCDF(6),DCNA(6),IROUT(2)
      DATA DCDF / 0.,.2,.4,.6,.8,1./
      DATA DCNA / 2.,1.94,1.68,1.26,0.72,0./
C
      CALL LNTRP(DCDF,DCNA,6,DFWD/DAFT,DCNAF)
C
      CNAF=DCNAF*DAFT**2/DFWD**2
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CIRC(MACH,DEL,H,L,OFF,CDCIR)
      REAL L,LD,MACH,MSUB,MSUP
C
C  WRITTEN BY K. DETERS, MCDONNELL DOUGLAS
C
      PI=3.14159
      MSUB=.6
      MSUP=1.
      G=1.4
      S=(PI/4.)*H**2
      HTOT=H+OFF
      TMACH=0.0
      IF(MACH.GT.MSUB) GO TO 115
C
C*** SUBSONIC DRAG CALCULATION
 110  LD=L/H
        IF (LD .LT. .6) THEN
        CD=1.18
        ELSE IF (LD .GT. 1.4) THEN 
        CD=.82
        ELSE
        CD=(1.16-.36*LD)/.8
        ENDIF
      CD=CD/(SQRT(1.0-MACH**2))
      IF(TMACH.EQ.0.) GO TO 145
      GO TO 120
 115  IF(MACH.LT.MSUP) GO TO 125
C
C*** SUPERSONIC DRAG CALCULATION
 130  RMACH=5.
      EQ1=(((G+1.))**2*RMACH**2)/((4.0*G*RMACH**2)-2.0*(G-1.0))
      EQ2=(1.0-G+(2.0*G*RMACH**2))/(G+1.0)
      CPMAX=(2.0/(G*RMACH**2))*((EQ1**(G/(G-1.0)))*EQ2-1.0)
      CD=CPMAX
      CALL CROSS(MACH,CDT)
      CD=CD*(CDT/1.2)
      IF(TMACH.EQ.0.) GO TO 145
      GO TO 140
 125  CONTINUE
C
C*** TRANSONIC DRAG CALCULATION 
      TMACH=MACH
      MACH=MSUB
      GO TO 110
 120  CDSUB=CD
      SUBM=CD*1.172
      MACH=MSUP
      GO TO 130
 140  CDSUP=CD
      SUPM=0.
      CALL CUBIC(TMACH,MSUB,MSUP,CDSUB,CDSUP,SUBM,SUPM,CDTR)
      MACH=TMACH
      CD=CDTR 
 145  CONTINUE
C
C*** FINAL CALCULATION OF DRAG COEEFICIENT
        IF (OFF .EQ. 0.) THEN
          IF (H .GT. DEL) THEN
          CD=CD*(1.0-.25*(DEL/H))
          ELSE
          CD=CD*(.75*((H/DEL)**(1./3.)))
          ENDIF
        ELSE
          IF (OFF .GE. DEL) THEN
          CD=CD
          ELSE
            IF (HTOT .LE. DEL) THEN
            HAVG1=(HTOT+OFF)/2.
            CD=CD*((HAVG1/DEL)**(1./3.))
            ELSE
            HAVG2=(DEL+OFF)/2.
            CD=CD*(((HTOT-DEL)/H)+((DEL-OFF)/H)*((HAVG2/DEL)**(1./3.)))
            ENDIF
          ENDIF
        ENDIF
      CDCIR=CD*S
      RETURN
      END               
c *************************************
c *************************************
c *************************************
      SUBROUTINE CVRTUS
C
C***  ROUTINE TO CONVERT ALL INPUT AND DATA ARRAYS FROM
C***  UNITS THAT ARE USER DEFINED TO UNITS OF FEET
C
C ... FLIGHT CONDITIONS
C
      CALL CVRFLT(-1)
C
C ... REFERENCE QUANTITIES
C
      CALL CVRREF(-1)
C
C ... BODY DATA
C
      CALL CVRBOD(-1)
C
C ... FIN DATA
C
      CALL CVRFIN(-1)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE F1GEOM
C
C***  SUBROUTINE TO COMPUTE THE GEOMETRIC CHARACTERISTICS OF A
C***  FIN
C
      COMMON /FSET1/  FDATA(399)
C
      COMMON /GEOFS1/ GFIN(188)
C
      DIMENSION SSPAN(10),LMAXU(10),LFLATU(10),LMAXL(10),
     1          LFLATL(10),CHORD(10),THICKU(10),THICKL(10),
     2          SWEEP(10),STA(10),XLE(10),
     3          XCORD(50),MEAN(50),THICK(50),YUPPER(50),
     4          YLOWER(50),LER(10)
C
      REAL LER,LMAXU,LMAXL,LFLATU,LFLATL,NPANEL,MEAN
C
      EQUIVALENCE (FDATA(1),SECTYP),(FDATA(2),SSPAN(1)),
     1            (FDATA(12),LMAXU(1)),(FDATA(22),LFLATU(1)),
     2            (FDATA(32),LMAXL(1)),(FDATA(42),LFLATL(1)),
     3            (FDATA(52),CHORD(1)),(FDATA(62),THICKU(1)),
     4            (FDATA(72),THICKL(1)),(FDATA(82),SWEEP(1)),
     5            (FDATA(92),STA(1)),(FDATA(102),XLE(1)),
     6            (FDATA(112),NPANEL),(FDATA(113),XCORD(1)),
     7            (FDATA(163),MEAN(1)),(FDATA(213),THICK(1)),
     8            (FDATA(263),YUPPER(1)),(FDATA(313),YLOWER(1)),
     9            (FDATA(363),FINPHI),(FDATA(364),LER(1))
C
      DIMENSION SPLANF(10),CBAR(10),SWEPLE(10),SWEP25(10),
     1          SWEP50(10),SWEP75(10),SWEPTE(10),
     2          XMGCLE(10),XMGC25(10),
     3          XMGC50(10),XMGC75(10),XMGCTE(10),YMEANC(10),
     4          ASPCT(10),TAPER(10),TOVERC(10),XCENT(10)
C
      EQUIVALENCE (GFIN(1),SPLANF(1)),(GFIN(11),CBAR(1)),
     1            (GFIN(21),SWEPLE(1)),(GFIN(31),SWEP25(1)),
     2            (GFIN(41),SWEP50(1)),(GFIN(51),SWEP75(1)),
     3            (GFIN(61),SWEPTE(1)),(GFIN(71),XMGCLE(1)),
     4            (GFIN(81),XMGC25(1)),(GFIN(91),XMGC50(1)),
     5            (GFIN(101),XMGC75(1)),(GFIN(111),XMGCTE(1)),
     6            (GFIN(121),YMEANC(1)),(GFIN(131),ASPCT(1)),
     7            (GFIN(141),TAPER(1)),(GFIN(151),TOVERC(1)),
     8            (GFIN(161),XCENT(1)),(GFIN(171),FINAR),
     9            (GFIN(172),FINTPR),(GFIN(173),FINSPN),
     A            (GFIN(174),FINSP),(GFIN(175),FINWET),
     B            (GFIN(176),TCEFF),(GFIN(177),FINXGC),
     C            (GFIN(178),FINYGC),(GFIN(179),SWAVLE),
     D            (GFIN(180),SWAV25),(GFIN(181),SWAV50),
     E            (GFIN(182),SWAV75),(GFIN(183),SWAVTE),
     F            (GFIN(184),FINCBR),(GFIN(185),DELTAY),
     G            (GFIN(186),DELTAD),(GFIN(187),XCENF),(GFIN(188),XOVC)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
C***  CALCULATE CHARACTERISTICS USING COMMON FUNCTIONS
C
C***  DO ONLY FOR SEGMENTS WHERE SPAN STATIONS ARE NOT ZERO OR
C***  UNUSED
C
C***  SET DEFAULTS
C
      IF(SECTYP.EQ.UNUSED .OR. SECTYP.LT.0. .OR. SECTYP.GT.3.)SECTYP=0.
C
      IF(NPANEL .LE. UNUSED)NPANEL=4.
      IF(FINPHI .EQ. UNUSED)FINPHI=0.
C
      DO 1000 I=1,10
         IF(I .GT. 1 .AND. SSPAN(I) .LE. UNUSED)GO TO 1010
         IF(STA(I) .EQ. UNUSED)STA(I)=1.
         IF(THICKU(I) .EQ. UNUSED)THICKU(I)=0.025
         IF(THICKL(I) .EQ. UNUSED)THICKL(I)=THICKU(I)
         IF(NPANEL .EQ. UNUSED)NPANEL=2.
         IF(LMAXU(I) .EQ. UNUSED)LMAXU(I)=0.5
         IF(LMAXL(I) .EQ. UNUSED)LMAXL(I)=LMAXU(I)
         IF(LFLATU(I) .EQ. UNUSED)LFLATU(I)=0.
         IF(LFLATL(I) .EQ. UNUSED)LFLATL(I)=LFLATU(I)
         IF(LER(I) .EQ. UNUSED)LER(I)=0.
C
 1000 CONTINUE
C
C
 1010 CONTINUE
      FINSP=0.0
      FINSPN=0.0
      FINAR=0.0
      FINTPR=0.0
      FINWET=0.0
      SWAVLE=0.0
      SWAV25=0.0
      SWAV50=0.0
      SWAV75=0.0
      SWAVTE=0.0
      XCENF=0.0
      FINXGC=0.0
      FINYGC=0.0
      FINCBR=0.0
C
      DO 1020 I=1,9
C
         II=I
C
         TOVERC(I)=THICKU(I)+THICKL(I)
C
         IF(SSPAN(I+1) .EQ. UNUSED .OR. SSPAN(I+1) .EQ. 0.)GO TO 1030
C
            SPAN=2.*(SSPAN(I+1)-SSPAN(I))
C
            TAPER(I)=CHORD(I+1)/CHORD(I)
C
            IF(SWEEP(I) .EQ. UNUSED)SWEEP(I)=ATAN((XLE(I+1)-
     1         XLE(I)+ CHORD(I+1)-CHORD(I) )/(SPAN/2.))*RAD
C
            ASPCT(I)=ASPECT(SPAN,CHORD(I),TAPER(I))/2.
C
            SWEPLE(I)=SWEEPN(STA(I),SWEEP(I),0.00,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEP25(I)=SWEEPN(STA(I),SWEEP(I),0.25,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEP50(I)=SWEEPN(STA(I),SWEEP(I),0.50,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEP75(I)=SWEEPN(STA(I),SWEEP(I),0.75,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEPTE(I)=SWEEPN(STA(I),SWEEP(I),1.00,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SPLANF(I)=FINPLN(SPAN,CHORD(I),TAPER(I))/2.
C
            CBAR(I)=FINMGC(CHORD(I),TAPER(I))
C
            YMEANC(I)=YMGC(SPAN,CHORD(I),TAPER(I))
C
            IF(I .GT. 1 .AND. XLE(I) .EQ. UNUSED)XLE(I)=XLE(I-1)+
     1        (SSPAN(I)-SSPAN(I-1))*TAN(SWEPLE(I-1)/RAD)
C
            XMGCLE(I)=XLE(I)-XLE(1)+YMEANC(I)*TAN(SWEPLE(I)/RAD)
C
            XMGC25(I)=XMGCLE(I)+0.25*CBAR(I)
C
            XMGC50(I)=XMGCLE(I)+0.50*CBAR(I)
C
            XMGC75(I)=XMGCLE(I)+0.75*CBAR(I)
C
            XMGCTE(I)=XMGCLE(I)+CBAR(I)
C
            YMEANC(I)=YMEANC(I)+SSPAN(I)
C
            XCENT(I)=XLE(I)-XLE(1)+FINCEN(SPAN,SWEPLE(I),CHORD(I),
     1               TAPER(I))
C
            FINSPN=FINSPN+SPAN/2.
C
            FINSP=FINSP+SPLANF(I)
C
 1020 CONTINUE
C
 1030 CONTINUE
C
C***  TOTAL FIN RESULTS
C
      FINAR=(2.*FINSPN)**2/(2.*FINSP)/2.
C
      FINTPR=CHORD(II)/CHORD(1)
C
      FINWET=2.*FINSP
C
C
      DO 1040 I=1,II
C
         SWAVLE=SWAVLE+SWEPLE(I)*SPLANF(I)/FINSP
C
         SWAV25=SWAV25+SWEP25(I)*SPLANF(I)/FINSP
C
         SWAV50=SWAV50+SWEP50(I)*SPLANF(I)/FINSP
C
         SWAV75=SWAV75+SWEP75(I)*SPLANF(I)/FINSP
C
         SWAVTE=SWAVTE+SWEPTE(I)*SPLANF(I)/FINSP
C
         FINXGC=FINXGC+XMGCLE(I)*SPLANF(I)/FINSP
C
         FINYGC=FINYGC+YMEANC(I)*SPLANF(I)/FINSP
C
         FINCBR=FINCBR+CBAR(I)*SPLANF(I)/FINSP
C
         XCENF=XCENF+XCENT(I)*SPLANF(I)/FINSP
C
 1040 CONTINUE
C
      TCEFF=TCEFFT(II,SSPAN,CHORD,TOVERC,FINSP)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION FINMGC(CROOT,TAPER)
C
C***  FUNCTION TO COMPUTE THE MEAN GEOMETRIC CHORD OF A STRAIGHT
C***  TAPERED FIN OR FIN SEGMENT MEASURED FROM ROOT CHORD LEADING EDGE
C
C***  INPUTS
C
C  CROOT -- EXPOSED ROOT CHORD OF PANEL
C  TAPER -- PANEL TIP CHORD DIVIDED BY EXPOSED ROOT CHORD
C
      FINMGC=2./3.*CROOT*(1.+TAPER+TAPER**2)/(1.+TAPER)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HYBINZ
C
C***  ROUTINE TO INITIALIZE THE I.O.M. ARRAYS USED FOR HYBRID THEORY
C
      COMMON /VDARY/ XB(220),RB(220),RBP(220),C(220),C1(220),RB1(220),
     1  RBP1(220),B(220),PSI(220),ZE0X(220),PSIR(220),PHIX(220)
      COMMON /VANVAR/ PHIR(220),ZE1(220),ZE1X(220),ZE1R(220),
     1              T(100),AK(100),AE(100),C3
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DO 1000 I=1,220
         XB(I)=UNUSED
         RB(I)=UNUSED
         RBP(I)=UNUSED
         C(I)=UNUSED
         C1(I)=UNUSED
         RB1(I)=UNUSED
         RBP1(I)=UNUSED
         B(I)=UNUSED
         PSI(I)=UNUSED
         ZE0X(I)=UNUSED
         PSIR(I)=UNUSED
         PHIX(I)=UNUSED
         PHIR(I)=UNUSED
         ZE1(I)=UNUSED
         ZE1X(I)=UNUSED
         ZE1R(I)=UNUSED
 1000 CONTINUE
C
      DO 1010 I=1,100
         T(I)=UNUSED
         AK(I)=UNUSED
         AE(I)=UNUSED
 1010 CONTINUE
C
      C3=UNUSED
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE LNTRP(ABSC,ORD,N,X,Y)
C
C***  SUBROUTINE TO LINEARILY INTERPOLATE A FUNCTION
C
C***  INPUTS
C
C   ABSC -- VALUES OF CURVE ABSCISSA (X-AXIS)
C    ORD -- VALUES OF CURVE ORDINATE (Y-AXIS)
C      N -- NUMBER OF POINTS IN CURVE
C      X -- ABSCISSA (X) VALUE TO BE INTERPOLATED
C
C***  OUTPUT
C
C      Y -- INTERPOLATED VALUE OF ORDINATE (Y)
C
      DIMENSION ABSC(N),ORD(N)
      LOGICAL ASCEND
C
      Y=ORD(1)
      IF(N .LE. 1)GO TO 1020
C
      IF(ABSC(1) .EQ. ABSC(2))GO TO 1020
C
      ASCEND=.TRUE.
C
C***  CHECK FOR DECENDING ABSC SEQUENCE
C
      IF(ABSC(2) .LT. ABSC(1))ASCEND=.FALSE.
C
C***  DETERMINE INTERVAL WHICH BRACKETS DESIRED X VALUE
C
      DO 1000 J=2,N
         I=J
         IF(.NOT. ASCEND)I=N-J+2
         IF(X .LT. ABSC(I))GO TO 1010
 1000 CONTINUE
C
 1010 CONTINUE
C
      IF(.NOT. ASCEND)I=I+1
      IF(I .LE. 1)I=2
      IF(I .GT. N)I=N
C
C***  LINEARILY INTERPOLATE/EXTRAPOLATE
C
      Y=ORD(I)
      IF((ABSC(I)-ABSC(I-1)) .EQ. 0.)GO TO 1020
C
      Y=ORD(I)-(ORD(I)-ORD(I-1))*(ABSC(I)-X)/(ABSC(I)-ABSC(I-1))
C
c     IF(X .LT. ABSC(1) .OR. X .GT. ABSC(N))CALL MESSG(X,Y,
c    1 ABSC(1),ABSC(N),ORD(1),ORD(N),1)
C
C
 1020 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PRIAXI(ITYPE)
C
C***  SUBROUTINE TO PRINT THE AXISYMMETRIC BODY GEOMETRY DATA
C
      DIMENSION ICONE(2),IOGIV(2),IPOWR(2),IHACK(2),IKARM(2)
      DIMENSION KAST(50),ICYL(2)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /LOGIC/ LFLAGS(18),LDIMIN,LDIMFT,LDIMCM,LDIMM,LDUM2(6)
      LOGICAL        LFLAGS    ,LDIMIN,LDIMFT,LDIMCM,LDIMM
      LOGICAL ASTFLG
C
C
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     1  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     2  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     3  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     4                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,GDUM(12)
C
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,
     1                TRUNC,LCENTR,DCENTR,TAFT,LAFT,DAFT,
     2                POWER,DISCON(20),ADUM(748)
      REAL NX,LNOSE,LCENTR,LAFT,LTOTAL
C
      CHARACTER*4 IDASH,ICONE,ICYL,IOGIV,IPOWR,IHACK,IKARM,
     1  IUNIT1,IUNIT2,IUNIT3,IUNIT4,IBLANK,IAST,KAND,
     2  NAM1,NAM2,NAM3,NAM4,NAM5,NAM6,IAXIS,KAST
C
      LOGICAL TRUNC
C
      DATA IDASH/'----'/
      DATA ICONE/'   C','ONIC'/
      DATA ICYL /'CYLI','NDER'/
      DATA IOGIV/'   O','GIVE'/
      DATA IPOWR/'   P','OWER'/
      DATA IHACK/'LV-H','AACK'/
      DATA IKARM/'VONK','ARMN'/
C
      DATA IUNIT1/'  IN'/
      DATA IUNIT2/'  FT'/
      DATA IUNIT3/'  CM'/
      DATA IUNIT4/'   M'/
      DATA IBLANK/'    '/
      DATA IAST  /'*   '/
      ASTFLG=.FALSE.
C
      NNX=NX+0.5
C
      NAM1=IDASH
      NAM2=IDASH
      NAM3=IDASH
      NAM4=IDASH
      NAM5=IDASH
      NAM6=IDASH
C
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 0.)NAM1=ICONE(1)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 0.)NAM2=ICONE(2)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 1.)NAM1=IOGIV(1)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 1.)NAM2=IOGIV(2)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 2.)NAM1=IPOWR(1)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 2.)NAM2=IPOWR(2)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 3.)NAM1=IHACK(1)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 3.)NAM2=IHACK(2)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 4.)NAM1=IKARM(1)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 4.)NAM2=IKARM(2)
      IF(LCENTR .GT. UNUSED)NAM3=ICONE(1)
      IF(LCENTR .GT. UNUSED)NAM4=ICONE(2)
      IF(LCENTR .GT. UNUSED .AND. DNOSE.EQ.DCENTR)NAM3=ICYL(1)
      IF(LCENTR .GT. UNUSED .AND. DNOSE.EQ.DCENTR)NAM4=ICYL(2)
      IF(LAFT .GT. UNUSED .AND. TAFT .EQ. 0.)NAM5=ICONE(1)
      IF(LAFT .GT. UNUSED .AND. TAFT .EQ. 0.)NAM6=ICONE(2)
      IF(LAFT .GT. UNUSED .AND. TAFT .EQ. 1.)NAM5=IOGIV(1)
      IF(LAFT .GT. UNUSED .AND. TAFT .EQ. 1.)NAM6=IOGIV(2)
C
      CALL HEADR9
C
      WRITE(6,1050)
      IF(ITYPE .EQ. 2)WRITE(6,1060)
C
      IAXIS=IUNIT2
      IF(LDIMIN)IAXIS=IUNIT1
      IF(LDIMCM)IAXIS=IUNIT3
      IF(LDIMM)IAXIS=IUNIT4
C
C  TYPE 2 INPUTS
C
      IF(ITYPE .EQ. 1)GO TO 1010
C
      WRITE(6,1070)NAM1,NAM2,NAM3,NAM4,NAM5,NAM6
      WRITE(6,1080)LNOSE,LCENTR,LAFT,LTOTAL,IAXIS
      WRITE(6,1090)FRNOSE,FRCENT,FRAFT,FR
      WRITE(6,1100)SPNOSE,SPCENT,SPAFT,SPLAN,IAXIS
      WRITE(6,1110)XCPNOS,XCPCEN,XCPAFT,XCENTP,IAXIS
      WRITE(6,1120)SWNOSE,SWCENT,SWAFT,SWET,IAXIS
      WRITE(6,1130)VOLNOS,VOLCEN,VOLAFT,VOL,IAXIS
      WRITE(6,1140)XCVNOS,XCVCEN,XCVAFT,XCENTV,IAXIS
      GO TO 1020
C
C  TYPE 1 INPUTS
C
 1010 CONTINUE
      WRITE(6,1180)LTOTAL,FR,SPLAN,XCENTP,SWET,VOL,XCENTV,IAXIS
C
 1020 CONTINUE
C
      IF(LNOSE .GT. UNUSED)BRATIO=BNOSE/(DNOSE/2.)
      IF(LNOSE .GT. UNUSED .AND. .NOT.TRUNC .AND. BNOSE .GT. UNUSED)
     1  WRITE(6,1200)BRATIO
C
      WRITE(6,1150)
C
C  IDENTIFY DISCONTINUOUS POINTS
C
      DO 1030 I=1,NNX
         IF(R(I) .LE. UNUSED)R(I)=0.
         KAST(I)=IBLANK
 1030 CONTINUE
C
      DO 1040 I=1,20
         IF(DISCON(I) .EQ. UNUSED)GO TO 1040
         ASTFLG=.TRUE.
         JJ=DISCON(I)+0.5
         KAST(JJ)=IAST
 1040 CONTINUE
C
      WRITE(6,1160)(X(I),KAST(I),I=1,NNX)
      WRITE(6,1170)(R(I),KAST(I),I=1,NNX)
      IF(ASTFLG)WRITE(6,1190)
C
 1050 FORMAT(24X,'AXISYMMETRIC BODY DEFINITION',/)
 1060 FORMAT(29X,'NOSE',3X,'CENTERBODY',5X,
     1 'AFT BODY',8X,'TOTAL')
 1070 FORMAT(4X,'SHAPE           ',5X,2A4,5X,2A4,5X,2A4)
 1080 FORMAT(4X,'LENGTH          ',4F13.3,A4)
 1090 FORMAT(4X,'FINENESS RATIO  ',4F13.3)
 1100 FORMAT(4X,'PLANFORM AREA   ',4F13.3,A4,'**2')
 1110 FORMAT(4X,'AREA CENTROID   ',4F13.3,A4)
 1120 FORMAT(4X,'WETTED AREA     ',4F13.3,A4,'**2')
 1130 FORMAT(4X,'VOLUME          ',4F13.3,A4,'**3')
 1140 FORMAT(4X,'VOL. CENTROID   ',4F13.3,A4,/)
C
 1150 FORMAT(30X,'MOLD LINE CONTOUR',/)
 1160 FORMAT(4X,' LONGITUDINAL STATIONS',5(F10.4,A1),/,4X,
     1  7(F10.4,A1),/,4X,7(F10.4,A1),/,4X,7(F10.4,A1),/,
     2  4X,7(F10.4,A1),/,4X,7(F10.4,A1),/,4X,7(F10.4,A1),
     3  /,4X,3(F10.4,A1))
 1170 FORMAT(/,4X,'            BODY RADII',5(F10.4,A1),/,4X,
     1  7(F10.4,A1),/,4X,7(F10.4,A1),/,4X,7(F10.4,A1),/,
     2  4X,7(F10.4,A1),/,4X,7(F10.4,A1),/,4X,7(F10.4,A1),
     3  /,4X,3(F10.4,A1))
 1180 FORMAT(4X,'LENGTH         ',F13.4,
     1       4X,'FINENESS RATIO ',F13.4,
     2       4X,'PLANFORM AREA  ',F13.4,
     3       4X,'AREA CENTROID  ',F13.4,
     4       4X,'WETTED AREA    ',F13.4,
     5       4X,'VOLUME         ',F13.4,
     6       4X,'VOLUME CENTROID',F13.4,'UNITS ARE IN',A4,/)
 1190 FORMAT(4X,'NOTE - * INDICATES SLOPE DISCONTINUOUS POINTS')
 1200 FORMAT(4X,'NOSE IS SPHERICALLY BLUNTED, BLUNTNESS RATIO =',F6.4)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SIMP(CPV,JA,JB,RR,SUM1,SUM2,SUM3)
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  ORIGINAL ROUTINE WRITTEN BY F. MOORE, NSWC
C  MODIFIED BY J. JENKINS, WL/FIGC
C
      COMMON /VDARY/ XB(220),RB(220),RBP(220),C(220),C1(220),RB1(220),
     1  RBP1(220),B(220),PSI(220),ZE0X(220),PSIR(220),PHIX(220)
      DIMENSION CPV(220,7)
      DIMENSION F1(220),G(220),G1(220)
      DO 1000 I=JA,JB
      A1=CPV(I,1)+2.*(CPV(I,3)+CPV(I,5))+CPV(I,7)
      A2=4.*(CPV(I,2)+CPV(I,4)+CPV(I,6))
      F1(I)=0.17454*(A1+A2)*RB(I)
      B1=CPV(I,1)-CPV(I,7)+2.*(CPV(I,3)-CPV(I,5))*0.5
      B2=4.*(CPV(I,2)-CPV(I,6))*0.8667
      G(I)=0.17454*(B1+B2)*RB(I)
      G1(I)=G(I)*XB(I)
 1000 CONTINUE
      IF(JA.NE.JB) GO TO 1010
      SUM1=0.
      SUM2=0.
      SUM3=0.
      GO TO 1050
 1010 JBB=JB-1
      DO 1040 I=JA,JBB
      H=(RB(I+1)-RB(I))/6.
      X12=(XB(I+1)+XB(I))/2.
      IF((JB-JA).LT.5) GO TO 1020
      J=JA+2
      CALL INTERP(XB,F1,X12,F12,JB,J)
      CALL INTERP(XB,G,X12,G12,JB,J)
      CALL INTERP(XB,G1,X12,G112,JB,J)
      GO TO 1030
 1020 F12=(F1(I)+F1(I+1))/2.
      G12=(G(I)+G(I+1))/2.
      G112=(G1(I)+G1(I+1))/2.
      IF(JB.GT.2) GO TO 1030
      F1(3)=F1(2)
      G(3)=G(2)
      G1(2)=2./3.*G1(2)
      G1(3)=G1(2)
      G112=2./3.*G112
 1030 SUM1=SUM1+H*(F1(I)+4.*F12+F1(I+1))
      H1=(XB(I+1)-XB(I))/6.
      SUM2=SUM2+H1*(G(I)+4.*G12+G(I+1))
      SUM3=SUM3+H1*(G1(I)+4.*G112+G1(I+1))
 1040 CONTINUE
      SUM3=SUM3+SUM2*RR
 1050 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE THEORY(NACA,NM,MACH,REN,IFIN,RHO,TMAX,DELTAY,CBARR,
     1 X0,THN,CAM,CLA,XAC,CMCO4,ALPHAI,ALPHAO,CLIDL,CLM)
C      
C***  MAIN ROUTINE FOR CALCULATING AIRFOIL SECTION AERODYNAMICS
C***  METHOD USES A WEBER ANALYSIS OF THE CROSS-SECTION AT SUBSONIC
C***  SPEEDS TO THE POINT THAT A SHOCK IS FORMED ON THE SURFACE
C
C  ROUTINE ADAPTED FROM DIGITAL DATCOM
C  ORIGINAL ROUTINE WRITTEN BY D. KINSEY, D. BOWERS, AFFDL
C  MODIFIED BY S.R. VUKELICH, MCDONNELL DOUGLAS
C  FURTHER MODIFIED BY W. BLAKE, WL/FIGC
C      
C***  INPUTS
C      
C   NACA -- NACA CONTROL CARD FOR FOIL
C     NM -- NUMBER OF MACH NUMBERS
C   MACH -- ARRAY OF MACH NUMBERS
C    REN -- ARRAY OF REYNOLDS NUMBERS PER FOOT
C   IFIN -- FIN SET BEING ANALYIZED
C    RHO -- FIN LEADING EDGE RADIUS
C   TMAX -- FIN MAXIMUM THICKNESS
C DELTAY -- FIN DELTA-Y PARAMETER
C     X0 -- ARRAY OF CHORD STATIONS DEFINING THE FOIL
C    THN -- ARRAY OF THICKNESSES DEFINING THE FOIL
C    CAM -- ARRAY OF CAMBER LINE STATIONS DEFINING THE FOIL
C ALPHAI -- IDEAL ANGLE OF ATTACK FROM NACA DESIGNATION
C ALPHAO -- ZERO-LIFT ANGLE OF ATTACK
C  CLIDL -- IDEAL LIFT COEFFICIENT FROM NACA DESIGNATION
C    CLM -- MAXIMUM LIFT COEFFICIENT
C      
C***  OUTPUTS
C      
C    CLA -- SECTION LIFT CURVE SLOPE, PER DEGREE
C    XAC -- SECTION AERODYNAMIC CENTER
C  CMCO4 -- FOIL CMO ABOUT THE QUARTER-CHORD
C      
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /ASMVAR/ CBAR,A0,XC,MCC,CLCC,AI,ALO,CLI,ASEP,CLA0,
     1                M,ZTNU(32),ZCNU(32),ST1NU(32),ST2NU(32),
     2                ST3NU(32),ST4NU(32),ST5NU(32),X(32),THNU(32),
     3                THMU(32),VXOVU(32),VXOVL(32),CPUM(32),
     4                CPLM(32),BO(32),CPI(32)
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      DIMENSION NACA(80),MACH(20),REN(20),CLA(20),XAC(20),X0(50),
     1 THN(50),CAM(50),IROUT(2),CMCO4(20),CLM(20)
      CHARACTER*4 NACA
      LOGICAL CRIT,FLAG,SKIP
      REAL NM,MACH,MCC
C      
      AI=ALPHAI
      ALO=ALPHAO
      CLI=CLIDL
      CMCO4O=0.
      CLA0=2.*PI/RAD
C      
      CBAR=CBARR
      RHOOC=RHO/CBAR
C
      NMACH=NM + 0.5
      DO 1000 I=1,NMACH
         CLA(I)=2.*PI/RAD
         XAC(I)=0.25
         CMCO4(I)=0.
 1000 CONTINUE
C      
      DO 1010 I=2,50
         IF(X0(I) .LE. X0(I-1))GO TO 1020
         IF(THN(I).GT.THN(I-1)) XTMAX=X0(I)
         M=I
 1010 CONTINUE
C      
 1020 CONTINUE
C      
C  REV 1/96 UPDATE FOR BLUNTED T.E. SECTION
C
      IF(PARTS(IFIN+1))CALL HEADR9
      IF(PARTS(IFIN+1))WRITE(6,1060)IFIN
      SKIP=.FALSE.
      IF(THN(M) .NE. 0.)SKIP=.TRUE.
      IF(SKIP)GO TO 1050
C      
C***  SHARP TRAILING EDGES - WEBER'S METHOD REF AFFDL-TR-71-87
C
C***  CALCULATE THE SECTION AERODYNAMICS AT ZERO MACH
C      
      CALL IDEAL(NACA,RHOOC,X0,THN,CAM)
      AMACH = 0.0
      RENN = 0.0
      CALL SLOPE(RHOOC,AMACH,CLA0,RENN,XACO,CMCO4O)
      IF(PARTS(IFIN+1))WRITE(6,1070)AI,ALO,CLI,CMCO4O,CLA0,
     1     RHOOC,TMAX,DELTAY
C      
C***  CALCULATE THE LIFT CURVE SLOPE, CMO AND XAC AT MACH NUMBER
C      
      CRIT=.FALSE.
      DO 1040 I=1,NMACH
         AMACH=MACH(I)
         RENN=REN(I)*CBAR
         IF(AMACH .GE. MCC) CRIT=.TRUE.
         IF(AMACH .GE. MCC) CLA(I)=CLCC
         IF(CRIT) GO TO 1040
         CALL SLOPE(RHOOC,AMACH,CLA(I),RENN,XAC(I),CMCO4(I))
         IF(PARTS(IFIN+1))WRITE(6,1080) AMACH,CLA(I),XAC(I),CLM(I)
 1040 CONTINUE
      IF(CRIT.AND.PARTS(IFIN+1))WRITE(6,1090) MCC,XC,CLCC
      GO TO 1200
C
C  REV 1/96 UPDATE BLUNT TRAILING EDGES
C  EMPIRICAL METHOD FOR MCC,CLA,XAC WITH PRANDTL-GLAUERT MACH EFFECT
C
 1050 CONTINUE
      IF(PARTS(IFIN+1))WRITE(6,1070)AI,ALO,CLI,CMCO4O,CLA0,
     1                 RHOOC,TMAX,DELTAY
      CRIT=.FALSE.
      DO 1100 I=1,NMACH
         AMACH=MACH(I)
         TMCC=TMAX
         IF(TMCC.LT.0.02) TMCC=0.02
         MCC=1.-(SQRT(TMCC)+0.262*(SQRT(TMCC)-SQRT(0.06)))
         CLAT=2.*PI/RAD
         IF(AMACH .LT. MCC) THEN
            CLA(I)=CLAT/SQRT(1.-AMACH**2)
            XAC(I)=0.25
            IF(PARTS(IFIN+1)) WRITE(6,1080) AMACH,CLA(I),XAC(I),CLM(I)
         ELSE
            CRIT=.TRUE.
            IC=I
            CLA(I)=CLAT/SQRT(1.-MCC**2)
            XAC(I)=0.25
         ENDIF
 1100 CONTINUE
         IF(CRIT.AND.PARTS(IFIN+1)) WRITE(6,1090) MCC,XTMAX,CLA(IC)
C
 1200 CONTINUE
C
         ALPHAO=ALO
         ALPHAI=AI
         CLIDL=CLI
      RETURN
C
 1060 FORMAT(4X,23X,'FIN SET ',I1,' SECTION AERODYNAMICS',/)
 1070 FORMAT(
     1 4X,15X,'     IDEAL ANGLE OF ATTACK =',F10.4,' DEG.',/,
     1 4X,15X,' ZERO LIFT ANGLE OF ATTACK =',F10.4,' DEG.',/,
     2 4X,15X,'    IDEAL LIFT COEFFICIENT =',F10.4,/,
     3 4X,4X,'ZERO LIFT PITCHING MOMENT COEFFICIENT =',F10.4,/,
     4 4X,15X,'MACH ZERO LIFT-CURVE-SLOPE =',F10.4,' /DEG.',/,
     5 4X,15X,'       LEADING EDGE RADIUS =',F10.4,' FRACTION CHORD',/,
     6 4X,15X,' MAXIMUM AIRFOIL THICKNESS =',F10.4,' FRACTION CHORD',/,
     7 4X,15X,'                   DELTA-Y =',F10.4,' PERCENT CHORD',//)
 1080 FORMAT(4X,'MACH =',F6.3,3X,'CL-ALPHA =',F7.4,
     1   ' /DEG.',3X,'XAC =',F7.4,3X,'CL MAX =',F7.4,/)
 1090 FORMAT(4X,15X,'*** CREST CRITICAL MACH NUMBER EXCEEDED ***',//,
     1 4X,15X,'        CREST CRITICAL MACH =',F10.4,/,
     2 4X,15X,'                   LOCATION =',F10.4,' FRACTION CHORD',/,
     3 4X,15X,'           LIFT-CURVE-SLOPE =',F10.4,' /DEG.')
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCNAN(TNOSE,MACH,FNOSE,FCENTR,CNA)
C
C***  SUBROUTINE TO INTERPOLATE THE NORMAL FORCE COEFFICENT SLOPE
C***  DATA FOR CONE-CYLINDERS OR OGIVE-CYLINDERS IN THE TRANSONIC
C***  MACH REGIME
C
C***  DATA FROM MBB REPORT TN WE 2 - 97/69 AND WE 12 - 88/70
C
C***  VALID RANGES - MACH NUMBER 0.8 TO 1.2 (0.8 DATA USED AT LOWER M)
C***                 FNOSE         0. TO 2.5 (CONES)
C***                               .5 TO 3.5 (OGIVES)
C***                 FCENTR        6. TO 15. (CONES)
C***                               6. TO 18./20. (OGIVES)
C***  NOTE - SPHERICAL NOSE BLUNTNESS ASSUMED NEGLIGIBLE
C
C***  INPUTS
C
C  TNOSE -- NOSE TYPE, 0=CONICAL, 1=OGIVAL
C   MACH -- FREESTREAM MACH NUMBER
C  FNOSE -- NOSE THEORETICAL FINENESS RATIO (LENGTH/DMAX)
C  FCENTR-- CYLINDRICAL SECTION FINENESS RATIO
C
C***  OUTPUT
C
C    CNA -- NORMAL FORCE CURVE SLOPE (/RADIAN)
C
      REAL MACH
C
      DIMENSION CONE00(15),CONE05(27),CONE15(18),CONE25(27)
      DIMENSION OGIV05(36),OGIV15(36),OGIV25(36),OGIV35(36)
      DIMENSION TMACH(9),TFA1(3),TFA2(4),TFA3(4)
      DIMENSION IROUT(2),XX(6),YY(6)
C
      DATA TMACH / 0.80,0.85,0.90,0.95,1.00,1.05,1.10,1.15,1.20 /
      DATA TFA1 / 6., 10., 15. /
      DATA TFA2 / 6., 10., 15., 20. /
      DATA TFA3 / 6., 10., 15., 18. /
C
C***  FOLLOWING DATA IS CNA+.4*FCENTR
C
      DATA CONE00 /
     * 5.40000, 5.45000, 5.65000, 6.10000, 5.90000, 7.75000, 7.75000,
     * 7.80000, 8.20000, 8.05000,10.45000,10.50000,10.60000,10.70000,
     *10.60000
     * /
      DATA CONE05 /
     * 5.17295, 5.56423, 5.48328, 4.64549, 4.40330, 4.58352, 4.86291,
     * 4.72004, 4.45241, 7.44285, 7.89589, 7.95166, 6.98941, 6.34994,
     * 6.57998, 6.63590, 6.74118, 6.75955,10.02525,10.16792,10.14935,
     * 8.72775, 8.73401, 8.92619, 9.32973, 9.21215, 8.72136
     * /
      DATA CONE15 /
     * 4.76328, 4.74995, 4.73657, 4.77251, 4.87005, 5.01683, 6.60941,
     * 6.54678, 6.52113, 6.59403, 6.75313, 6.91225, 8.78772, 8.78669,
     * 8.83495, 8.96941, 9.10390, 9.12750
     * /
      DATA CONE25 /
     * 4.77778, 4.77778, 4.81481, 4.87654, 4.96296, 5.01235, 5.03704,
     * 4.98765, 4.92593, 6.51852, 6.55556, 6.60494, 6.69136, 6.81481,
     * 6.92593, 7.00000, 7.18519, 7.28395, 8.65432, 8.66667, 8.72840,
     * 8.93827, 9.19753, 9.24691, 9.00000, 8.88889, 8.87654
     * /
      DATA OGIV05 /
     * 4.79312, 4.77880, 4.76424, 4.76179, 4.80891, 4.95475, 5.05099,
     * 4.93747, 4.81064, 6.64784, 6.59600, 6.50741, 6.55456, 6.70013,
     * 6.80896, 6.76925, 6.65597, 6.59107, 9.01237, 9.12120, 9.09429,
     * 9.06715, 9.11403, 9.17277, 9.19597, 9.13155, 9.05456,11.20467,
     *11.14027,11.08869,11.20960,11.36704,11.47635,11.43763,11.37320,
     *11.38259
     * /
      DATA OGIV15 /
     * 4.74936, 4.76565, 4.79449, 4.86044, 4.93854, 5.01673, 5.05781,
     * 5.02484, 4.94220, 6.47118, 6.52469, 6.57821, 6.69332, 6.78396,
     * 6.81269, 6.94015, 6.95664, 6.91103, 8.77492, 8.86525, 8.96823,
     * 9.08335, 9.18622, 9.26432, 9.25603, 9.22316, 9.14073,11.07846,
     *11.13197,11.22231,11.32508,11.44030,11.50626,11.54743,11.53935,
     *11.49373
     * /
      DATA OGIV25 /
     * 4.74415, 4.78649, 4.82872, 4.88352, 4.90060, 4.93036, 4.92219,
     * 4.92669, 4.91829, 6.49922, 6.52887, 6.59625, 6.70134, 6.83170,
     * 6.92434, 6.89090, 6.84533, 6.76149, 8.77173, 8.82641, 8.93162,
     * 9.04918, 9.19211, 9.25937, 9.28937, 9.20574, 9.10944,10.21065,
     *10.26545,10.34529,10.46296,10.59320,10.74859,10.90421,11.02199,
     *11.01370
     * /
      DATA OGIV35 /
     * 4.64001, 4.64461, 4.68674, 4.79139, 4.83351, 4.77558, 4.95516,
     * 4.90951, 4.75120, 6.63578, 6.59047, 6.54482, 6.66187, 6.84167,
     * 6.70848, 6.66283, 6.64254, 6.57165, 8.65858, 8.70059, 8.76749,
     * 8.93468, 9.06434, 9.10635, 9.08605, 9.04041, 9.00727, 9.98984,
     *10.03196,10.04884,10.11575,10.37047,10.56289,10.64242,10.69693,
     *10.61388
     * /
C
      AMACH=MACH
      IF(MACH .LT. 0.8)AMACH=0.8
C
C***  DETERMINE NOSE TYPE
C
      IF(TNOSE .NE. 0.)GO TO 1000
C
C***  HERE FOR CONICAL NOSES
C
C***  INTERPOLATE AT EACH NOSE FINENESS RATIO
C
      CALL MVLOOK(1,3,5,15,0.0,TFA1,TMACH,CONE00,AMACH,FCENTR,0.0,CNA00)
      CALL MVLOOK(1,3,9,27,0.5,TFA1,TMACH,CONE05,AMACH,FCENTR,0.5,CNA05)
      CALL MVLOOK(1,3,6,18,1.5,TFA1,TMACH,CONE15,AMACH,FCENTR,1.5,CNA15)
      CALL MVLOOK(1,3,9,27,2.5,TFA1,TMACH,CONE25,AMACH,FCENTR,2.5,CNA25)
C
C***  NOW LINEARILY INTERPOLATE AT FNOSE
C
      XX(1)=0.0
      XX(2)=0.5
      XX(3)=1.5
      XX(4)=2.5
      XX(5)=10.
C
C ... REMOVE .4*FCENTR FROM DATA
C
      YY(1)=CNA00-.4*FCENTR
      YY(2)=CNA05-.4*FCENTR
      YY(3)=CNA15-.4*FCENTR
      YY(4)=CNA25-.4*FCENTR
      YY(5)=2.
      CALL LNTRP(XX,YY,5,FNOSE,CNA)
C
      GO TO 1010
 1000 CONTINUE
C
C***  OGIVAL (AND OTHER) SHAPES
C
C***  INTERPOLATE AT EACH NOSE FINENESS RATIO
C
      CALL MVLOOK(1,3,5,15,0.0,TFA1,TMACH,CONE00,AMACH,FCENTR,0.0,CNA00)
      CALL MVLOOK(1,4,9,36,0.5,TFA2,TMACH,OGIV05,AMACH,FCENTR,0.5,CNA05)
      CALL MVLOOK(1,4,9,36,1.5,TFA2,TMACH,OGIV15,AMACH,FCENTR,1.5,CNA15)
      CALL MVLOOK(1,4,9,36,2.5,TFA3,TMACH,OGIV25,AMACH,FCENTR,2.5,CNA25)
      CALL MVLOOK(1,4,9,36,3.5,TFA3,TMACH,OGIV35,AMACH,FCENTR,3.5,CNA35)
C
C***  NOW LINEARILY INTERPOLATE AT FNOSE
C
      XX(1)=0.0
      XX(2)=0.5
      XX(3)=1.5
      XX(4)=2.5
      XX(5)=3.5
      XX(6)=10.
C
C ... REMOVE .4*FCENTR FROM DATA
C
      YY(1)=CNA00-.4*FCENTR
      YY(2)=CNA05-.4*FCENTR
      YY(3)=CNA15-.4*FCENTR
      YY(4)=CNA25-.4*FCENTR
      YY(5)=CNA35-.4*FCENTR
      YY(6)=2.
      CALL LNTRP(XX,YY,6,FNOSE,CNA)
C
 1010 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      BLOCK DATA CKDAT
C
C     THIS ROUTINE INITIALIZES ALL OF THE COMMON BLOCKS CONTAINING THE
C     TABULATED DATA FROM THE CHAPMAN-KORST RUNS AND ADDITIONAL DATA
C     NEEDED TO RUN THE TABLE LOOK-UP ROUTINE.
C
C  WRITTEN BY A. JENN, MCDONNELL DOUGLAS
C
C     ARRAYS FOR THE CHAPMAN-KORST DATA
      COMMON /CKDATA/ CKPR(5,5,5,5,5), CKFM(5,5,5,5,5), CKJM(5,5,5,5,5),
     1                CKBN(5,5,5,5,5), CKTR(5,5,5,5,5), CKDJ(5,5,5,5,5),
     2                XPR(5,5), XFM(5,5), XJM(5,5), XBN(5,5), XTR(5,5),
     3                XDJ(5,5), PNOM
C
C     ARRAYS FOR THE TABLE LOOK-UP ROUTINE
      COMMON /INTERPP/ NAVALP(5), NAVALF(5), NAVALJ(5), NAVALB(5), 
     1                NAVALT(5), NAVALD(5), NXVALP(5), NXVALF(5),
     2                NXVALJ(5), NXVALB(5), NXVALT(5), NXVALD(5),
     3                IEXTRP(5), NDIM, NXARR
C
C     INDEPENDENT VARIABLE ARRAY FOR THE JET PRESSURE RATIO
      DATA XPR / 1.000,  2.000,  3.000,  0.000,  0.000,
     1           1.000,  2.000,  3.000,  4.000,  0.000,
     2           0.000,  1.000,  2.000,  0.000,  0.000,
     3           0.000,  4.000,  8.000, 12.000,  0.000,
     4           0.000,  1.000,  2.000,  5.000, 10.000/
C
C     INDEPENDENT VARIABLE ARRAY FOR THE FREESTREAM MACH NUMBER
      DATA XFM / 1.000,  2.000,  3.000,  0.000,  0.000,
     1           1.000,  2.000,  3.000,  4.000,  0.000,
     2           0.000,  1.000,  2.000,  0.000,  0.000,
     3           0.000,  4.000,  8.000, 12.000,  0.000,
     4           2.000,  3.000,  4.000,  5.000,  0.000/
C
C     INDEPENDENT VARIABLE ARRAY FOR THE JET MACH NUMBER DELTA
      DATA XJM / 1.000,  2.000,  3.000,  0.000,  0.000,
     1           1.000,  2.000,  3.000,  4.000,  0.000,
     2           0.000,  1.000,  2.000,  0.000,  0.000,
     3           0.000,  4.000,  8.000, 12.000,  0.000,
     4          -1.000,  0.000,  1.000,  0.000,  0.000/
C
C     INDEPENDENT VARIABLE ARRAY FOR THE NOZZLE EXIT ANGLE
      DATA XBN / 1.000,  2.000,  3.000,  0.000,  0.000,
     1           1.000,  2.000,  3.000,  4.000,  0.000,
     2           0.000,  1.000,  2.000,  0.000,  0.000,
     3           0.000,  4.000,  8.000, 12.000,  0.000,
     4           5.000, 10.000, 15.000, 20.000, 25.000/
C
C     INDEPENDENT VARIABLE ARRAY FOR THE JET TEMPERATURE RATIO
      DATA XTR / 1.000,  2.000,  3.000,  0.000,  0.000,
     1           1.000,  2.000,  3.000,  4.000,  0.000,
     2           0.000,  1.000,  2.000,  0.000,  0.000,
     3           0.000,  4.000,  8.000, 12.000,  0.000,
     4           4.000,  6.000,  8.000, 10.000,  0.000/
C
C     INDEPENDENT VARIABLE ARRAY FOR THE JET DIAMETER RATIO
      DATA XDJ / 1.000,  2.000,  3.000,  0.000,  0.000,
     1           1.000,  2.000,  3.000,  4.000,  0.000,
     2           0.000,  1.000,  2.000,  0.000,  0.000,
     3           0.000,  4.000,  8.000, 12.000,  0.000,
     4           0.800,  0.850,  0.900,  0.950,  0.000/
C
C     NOMINAL JET TO FREESTREAM PRESSURE RATIO
      DATA PNOM /2.000/
C
C     DIMENSIONED SIZE OF THE DEPENDENT VARIABLE ARRAYS
      DATA NAVALP /5, 5, 5, 5, 5/
      DATA NAVALF /5, 5, 5, 5, 5/
      DATA NAVALJ /5, 5, 5, 5, 5/
      DATA NAVALB /5, 5, 5, 5, 5/
      DATA NAVALT /5, 5, 5, 5, 5/
      DATA NAVALD /5, 5, 5, 5, 5/
C
C     NUMBER OF INDEPENDENT VARIABLE VALUES
      DATA NXVALP /3, 4, 3, 4, 5/
      DATA NXVALF /3, 4, 3, 4, 4/
      DATA NXVALJ /3, 4, 3, 4, 3/
      DATA NXVALB /3, 4, 3, 4, 5/
      DATA NXVALT /3, 4, 3, 4, 4/
      DATA NXVALD /3, 4, 3, 4, 4/
C
C     NUMBER OF INDEPENDENT VARIABLES, FIRST DIMENSION OF THE INDEPENDENT
C     VARIABLE ARRAY, AND EXTRAPOLATION FLAG
      DATA IEXTRP /3, 3, 2, 2, 0/
      DATA NDIM, NXARR /5, 5/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CYLINDER                              *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(1,I,1,1,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(1,I,1,1,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(1,I,1,1,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(1,I,1,1,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(1,I,1,1,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(1,I,1,1,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CONE, L/D=0, BETA=0 (CYLINDER)        *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(2,I,1,1,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(2,I,1,1,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(2,I,1,1,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(2,I,1,1,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(2,I,1,1,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(2,I,1,1,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CONE, L/D=0, BETA=4 (CYLINDER)        *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(2,I,1,2,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(2,I,1,2,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(2,I,1,2,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(2,I,1,2,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(2,I,1,2,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(2,I,1,2,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CONE, L/D=0, BETA=8 (CYLINDER)        *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(2,I,1,3,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(2,I,1,3,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(2,I,1,3,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(2,I,1,3,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(2,I,1,3,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(2,I,1,3,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CONE, L/D=0, BETA=12 (CYLINDER)       *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(2,I,1,4,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(2,I,1,4,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(2,I,1,4,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(2,I,1,4,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(2,I,1,4,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C           
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(2,I,1,4,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CONE, L/D=1, BETA=0 (CYLINDER)        *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(2,I,2,1,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(2,I,2,1,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(2,I,2,1,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(2,I,2,1,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(2,I,2,1,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(2,I,2,1,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CONE, L/D=1, BETA=4                   *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(2,I,2,2,J), J=1,5), I=1,4)
     1    /1.000, 2.530, 2.409, 2.263, 2.179,
     2     0.467, 0.595, 0.821, 1.226, 1.640,
     3     0.581, 0.740, 1.021, 1.525, 2.040,
     4     3.147, 3.147, 3.147, 3.147, 3.147/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(2,I,2,2,J), J=1,4), I=1,4)
     1    /2.248, 2.409, 2.455, 2.502,
     2     1.128, 0.821, 0.646, 0.558,
     3     1.283, 1.021, 0.884, 0.842,
     4     2.148, 3.147, 4.239, 5.361/
C
C     JET MACH NUMBER
      DATA ((CKJM(2,I,2,2,J), J=1,3), I=1,4)
     1    /2.823, 2.409, 2.175,
     2     1.006, 0.821, 0.721,
     3     1.252, 1.021, 0.897,
     4     3.147, 3.147, 3.147/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(2,I,2,2,J), J=1,5), I=1,4)
     1    /2.387, 2.402, 2.409, 2.410, 2.376,
     2     0.498, 0.637, 0.821, 1.085, 1.591,
     3     0.620, 0.792, 1.021, 1.350, 1.979,
     4     3.147, 3.147, 3.147, 3.147, 3.147/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(2,I,2,2,J), J=1,4), I=1,4)
     1    /1.991, 2.409, 2.773, 3.075,
     2     0.777, 0.821, 0.860, 0.891,
     3     0.966, 1.021, 1.070, 1.109,
     4     3.147, 3.147, 3.147, 3.147/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(2,I,2,2,J), J=1,4), I=1,4)
     1    /2.416, 2.415, 2.409, 2.403,
     2     0.681, 0.748, 0.821, 0.900,
     3     0.848, 0.931, 1.021, 1.120,
     4     3.147, 3.147, 3.147, 3.147/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CONE, L/D=1, BETA=8                   *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(2,I,2,3,J), J=1,5), I=1,4)
     1    /1.000, 2.523, 2.408, 2.263, 2.179,
     2     0.488, 0.593, 0.819, 1.222, 1.207,
     3     0.741, 0.901, 1.245, 1.856, 2.251,
     4     3.283, 3.283, 3.283, 3.283, 3.425/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(2,I,2,3,J), J=1,4), I=1,4)
     1    /2.245, 2.408, 2.482, 2.515,
     2     1.141, 0.819, 0.646, 0.549,
     3     1.445, 1.245, 1.193, 1.245,
     4     2.151, 3.283, 4.475, 5.737/
C
C     JET MACH NUMBER
      DATA ((CKJM(2,I,2,3,J), J=1,3), I=1,4)
     1    /2.823, 2.408, 2.167,
     2     1.001, 0.819, 0.723,
     3     1.520, 1.245, 1.098,
     4     3.283, 3.283, 3.283/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(2,I,2,3,J), J=1,5), I=1,4)
     1    /2.391, 2.402, 2.408, 2.405, 2.371,
     2     0.479, 0.621, 0.819, 1.125, 1.357,
     3     0.727, 0.943, 1.245, 1.709, 2.218,
     4     3.283, 3.283, 3.283, 3.283, 3.333/
C         
C     JET TEMPERATURE RATIO
      DATA ((CKTR(2,I,2,3,J), J=1,4), I=1,4)
     1    /1.986, 2.408, 2.773, 3.076,
     2     0.774, 0.819, 0.859, 0.891,
     3     1.175, 1.245, 1.304, 1.353,
     4     3.283, 3.283, 3.283, 3.283/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(2,I,2,3,J), J=1,4), I=1,4)
     1    /2.417, 2.413, 2.408, 2.422,
     2     0.685, 0.750, 0.819, 0.897,
     3     1.041, 1.139, 1.245, 1.363,
     4     3.283, 3.283, 3.283, 3.283/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CONE, L/D=1, BETA=12                  *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(2,I,2,4,J), J=1,5), I=1,4)
     1    /1.000, 2.520, 2.416, 2.305, 2.272,
     2     0.473, 0.549, 0.757, 1.134, 1.239,
     3     0.847, 0.984, 1.355, 2.031, 2.220,
     4     3.396, 3.396, 3.396, 3.396, 3.396/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(2,I,2,4,J), J=1,4), I=1,4)
     1    /2.267, 2.416, 2.484, 2.515,
     2     1.048, 0.757, 0.590, 0.495,
     3     1.475, 1.355, 1.429, 1.664,
     4     2.197, 3.396, 4.695, 6.116/
C
C     JET MACH NUMBER
      DATA ((CKJM(2,I,2,4,J), J=1,3), I=1,4)
     1    /2.838, 2.416, 2.203,
     2     0.927, 0.757, 0.676,
     3     1.660, 1.355, 1.210,
     4     3.396, 3.396, 3.396/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(2,I,2,4,J), J=1,5), I=1,4)
     1    /2.376, 2.404, 2.416, 2.413, 2.379,
     2     0.525, 0.568, 0.757, 1.062, 1.031,
     3     0.940, 1.017, 1.355, 1.902, 2.302,
     4     3.396, 3.396, 3.396, 3.396, 3.552/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(2,I,2,4,J), J=1,4), I=1,4)
     1    /1.990, 2.416, 2.788, 3.107,
     2     0.713, 0.757, 0.796, 0.830,
     3     1.277, 1.355, 1.426, 1.486,
     4     3.396, 3.396, 3.396, 3.396/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(2,I,2,4,J), J=1,4), I=1,4)
     1    /2.421, 2.417, 2.416, 2.444,
     2     0.646, 0.701, 0.757, 0.823,
     3     1.157, 1.254, 1.355, 1.473,
     4     3.396, 3.396, 3.396, 3.396/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CONE, L/D=2, BETA=0 (CYLINDER)        *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(2,I,3,1,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(2,I,3,1,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(2,I,3,1,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(2,I,3,1,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(2,I,3,1,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(2,I,3,1,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CONE, L/D=2, BETA=4                   *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(2,I,3,2,J), J=1,5), I=1,4)
     1    /1.000, 2.526, 2.405, 2.257, 2.173,
     2     0.512, 0.623, 0.860, 1.283, 1.717,
     3     0.587, 0.715, 0.987, 1.472, 1.970,
     4     3.092, 3.092, 3.092, 3.092, 3.092/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(2,I,3,2,J), J=1,4), I=1,4)
     1    /2.238, 2.405, 2.447, 2.499,
     2     1.172, 0.860, 0.680, 0.589,
     3     1.250, 0.987, 0.847, 0.801,
     4     2.042, 3.092, 4.166, 5.269/
C
C     JET MACH NUMBER
      DATA ((CKJM(2,I,3,2,J), J=1,3), I=1,4)
     1    /2.825, 2.405, 2.169,
     2     1.048, 0.860, 0.759,
     3     1.202, 0.987, 0.871,
     4     3.092, 3.092, 3.092/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(2,I,3,2,J), J=1,5), I=1,4)
     1    /2.389, 2.398, 2.405, 2.409, 2.376,
     2     0.525, 0.669, 0.860, 1.135, 1.659,
     3     0.602, 0.767, 0.987, 1.302, 1.903,
     4     3.092, 3.092, 3.092, 3.092, 3.092/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(2,I,3,2,J), J=1,4), I=1,4)
     1    /1.988, 2.405, 2.775, 3.069,
     2     0.814, 0.860, 0.901, 0.933,
     3     0.934, 0.987, 1.034, 1.070,
     4     3.092, 3.092, 3.092, 3.092/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(2,I,3,2,J), J=1,4), I=1,4)
     1    /2.410, 2.417, 2.405, 2.402,
     2     0.714, 0.784, 0.860, 0.943,
     3     0.819, 0.900, 0.987, 1.082,
     4     3.092, 3.092, 3.092, 3.092/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CONE, L/D=2, BETA=8                   *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(2,I,3,3,J), J=1,5), I=1,4)
     1    /1.000, 2.507, 2.383, 2.236, 2.153,
     2     0.506, 0.688, 0.948, 1.413, 1.733,
     3     0.593, 0.807, 1.111, 1.657, 2.140,
     4     3.107, 3.107, 3.107, 3.107, 3.142/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(2,I,3,3,J), J=1,4), I=1,4)
     1    /2.219, 2.383, 2.437, 2.486,
     2     1.285, 0.948, 0.754, 0.653,
     3     1.336, 1.111, 1.026, 1.052,
     4     2.025, 3.107, 4.235, 5.420/
C
C     JET MACH NUMBER
      DATA ((CKJM(2,I,3,3,J), J=1,3), I=1,4)
     1    /2.811, 2.383, 2.146,
     2     1.135, 0.948, 0.851,
     3     1.331, 1.111, 0.998,
     4     3.107, 3.107, 3.107/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(2,I,3,3,J), J=1,5), I=1,4)
     1    /2.367, 2.382, 2.383, 2.387, 2.354,
     2     0.561, 0.724, 0.948, 1.293, 1.778,
     3     0.658, 0.849, 1.111, 1.517, 2.129,
     4     3.107, 3.107, 3.107, 3.107, 3.107/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(2,I,3,3,J), J=1,4), I=1,4)
     1    /1.968, 2.383, 2.745, 3.043,
     2     0.897, 0.948, 0.992, 1.028,
     3     1.052, 1.111, 1.163, 1.205,
     4     3.107, 3.107, 3.107, 3.107/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(2,I,3,3,J), J=1,4), I=1,4)
     1    /2.389, 2.394, 2.383, 2.380,
     2     0.795, 0.868, 0.948, 1.034,
     3     0.932, 1.018, 1.111, 1.212,
     4     3.107, 3.107, 3.107, 3.107/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     CONE, L/D=2, BETA=12                  *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(2,I,3,4,J), J=1,5), I=1,4)
     1    /1.000, 2.472, 2.362, 2.212, 2.116,
     2     0.417, 0.829, 1.131, 1.677, 2.413,
     3     0.363, 0.741, 1.012, 1.497, 2.045,
     4     2.925, 2.925, 2.925, 2.925, 2.925/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(2,I,3,4,J), J=1,4), I=1,4)
     1    /2.165, 2.362, 2.407, 2.454,
     2     1.490, 1.131, 0.894, 0.775,
     3     1.221, 1.012, 0.935, 1.007,
     4     1.871, 2.925, 4.033, 5.228/
C
C     JET MACH NUMBER
      DATA ((CKJM(2,I,3,4,J), J=1,3), I=1,4)
     1    /2.808, 2.362, 2.110,
     2     1.314, 1.131, 1.048,
     3     1.172, 1.012, 0.937,
     4     2.925, 2.925, 2.925/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(2,I,3,4,J), J=1,5), I=1,4)
     1    /2.325, 2.339, 2.362, 2.364, 2.331,
     2     0.817, 0.865, 1.131, 1.556, 2.140,
     3     0.737, 0.774, 1.012, 1.389, 1.913,
     4     2.925, 2.925, 2.925, 2.925, 2.925/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(2,I,3,4,J), J=1,4), I=1,4)
     1    /1.947, 2.362, 2.693, 3.004,
     2     1.071, 1.131, 1.084, 1.225,
     3     0.958, 1.012, 1.055, 1.093,
     4     2.925, 2.925, 2.925, 2.925/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(2,I,3,4,J), J=1,4), I=1,4)
     1    /2.349, 2.356, 2.362, 2.367,
     2     0.979, 1.053, 1.131, 1.219,
     3     0.877, 0.941, 1.012, 1.086,
     4     2.925, 2.925, 2.925, 2.925/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     OGIVE, L/D=0, BETA=0 (CYLINDER)       *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(3,I,1,1,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(3,I,1,1,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(3,I,1,1,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(3,I,1,1,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(3,I,1,1,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(3,I,1,1,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     OGIVE, L/D=0, BETA=4 (CYLINDER)       *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(3,I,1,2,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(3,I,1,2,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(3,I,1,2,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(3,I,1,2,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(3,I,1,2,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(3,I,1,2,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     OGIVE, L/D=0, BETA=8 (CYLINDER)       *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(3,I,1,3,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(3,I,1,3,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(3,I,1,3,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(3,I,1,3,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(3,I,1,3,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(3,I,1,3,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     OGIVE, L/D=0, BETA=12 (CYLINDER)      *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(3,I,1,4,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(3,I,1,4,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(3,I,1,4,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(3,I,1,4,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(3,I,1,4,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C           
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(3,I,1,4,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     OGIVE, L/D=1, BETA=0 (CYLINDER)       *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(3,I,2,1,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(3,I,2,1,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(3,I,2,1,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(3,I,2,1,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(3,I,2,1,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(3,I,2,1,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     OGIVE, L/D=1, BETA=4                  *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(3,I,2,2,J), J=1,5), I=1,4)
     1    /1.000, 2.536, 2.414, 2.265, 2.197,
     2     0.445, 0.576, 0.795, 1.186, 1.584,
     3     0.582, 0.753, 1.040, 1.551, 2.072,
     4     3.180, 3.180, 3.180, 3.180, 3.180/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(3,I,2,2,J), J=1,4), I=1,4)
     1    /2.254, 2.414, 2.475, 2.518,
     2     1.093, 0.795, 0.628, 0.538,
     3     1.304, 1.040, 0.906, 0.857,
     4     2.113, 3.180, 4.279, 5.410/
C
C     JET MACH NUMBER
      DATA ((CKJM(3,I,2,2,J), J=1,3), I=1,4)
     1    /2.825, 2.414, 2.181,
     2     0.979, 0.795, 0.696,
     3     1.280, 1.040, 0.910,
     4     3.180, 3.180, 3.180/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(3,I,2,2,J), J=1,5), I=1,4)
     1    /2.396, 2.407, 2.414, 2.426, 2.432,
     2     0.514, 0.641, 0.795, 0.985, 1.246,
     3     0.672, 0.838, 1.040, 1.288, 1.629,
     4     3.180, 3.180, 3.180, 3.180, 3.180/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(3,I,2,2,J), J=1,4), I=1,4)
     1    /1.991, 2.414, 2.780, 3.083,
     2     0.751, 0.795, 0.833, 0.864,
     3     0.982, 1.040, 1.089, 1.130,
     4     3.180, 3.180, 3.180, 3.180/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(3,I,2,2,J), J=1,4), I=1,4)
     1    /2.424, 2.421, 2.414, 2.410,
     2     0.661, 0.725, 0.795, 0.872,
     3     0.864, 0.948, 1.040, 1.140,
     4     3.180, 3.180, 3.180, 3.180/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     OGIVE, L/D=1, BETA=8                  *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(3,I,2,3,J), J=1,5), I=1,4)
     1    /1.000, 2.530, 2.407, 2.260, 2.192,
     2     0.490, 0.596, 0.822, 1.228, 1.502,
     3     0.844, 1.026, 1.417, 2.116, 2.190,
     4     3.370, 3.370, 3.370, 3.370, 3.255/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(3,I,2,3,J), J=1,4), I=1,4)
     1    /2.268, 2.407, 2.461, 2.518,
     2     1.135, 0.822, 0.647, 0.555,
     3     1.617, 1.417, 1.368, 1.453,
     4     2.226, 3.370, 4.584, 5.874/
C
C     JET MACH NUMBER
      DATA ((CKJM(3,I,2,3,J), J=1,3), I=1,4)
     1    /2.821, 2.407, 2.174,
     2     1.008, 0.822, 0.723,
     3     1.736, 1.417, 1.245,
     4     3.370, 3.370, 3.370/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(3,I,2,3,J), J=1,5), I=1,4)
     1    /2.386, 2.401, 2.407, 2.417, 2.424,
     2     0.533, 0.663, 0.822, 1.017, 1.286,
     3     0.918, 1.143, 1.417, 1.753, 2.216,
     4     3.370, 3.370, 3.370, 3.370, 3.370/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(3,I,2,3,J), J=1,4), I=1,4)
     1    /1.988, 2.407, 2.772, 3.074,
     2     0.777, 0.822, 0.861, 0.893,
     3     1.340, 1.417, 1.484, 1.538,
     4     3.370, 3.370, 3.370, 3.370/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(3,I,2,3,J), J=1,4), I=1,4)
     1    /2.414, 2.418, 2.407, 2.401,
     2     0.682, 0.750, 0.822, 0.901,
     3     1.176, 1.292, 1.417, 1.553,
     4     3.370, 3.370, 3.370, 3.370/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     OGIVE, L/D=1, BETA=12                 *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(3,I,2,4,J), J=1,5), I=1,4)
     1    /1.000, 2.524, 2.402, 2.255, 2.187,
     2     0.533, 0.619, 0.855, 1.171, 1.381,
     3     1.236, 1.435, 1.981, 2.269, 2.221,
     4     3.578, 3.578, 3.578, 3.452, 3.322/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(3,I,2,4,J), J=1,4), I=1,4)
     1    /2.263, 2.402, 2.448, 2.498,
     2     1.115, 0.855, 0.671, 0.578,
     3     1.851, 1.981, 2.158, 2.640,
     4     2.324, 3.578, 4.932, 6.427/
C
C     JET MACH NUMBER
      DATA ((CKJM(3,I,2,4,J), J=1,3), I=1,4)
     1    /2.815, 2.402, 2.168,
     2     1.008, 0.855, 0.754,
     3     2.301, 1.981, 1.748,
     4     3.567, 3.578, 3.578/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(3,I,2,4,J), J=1,5), I=1,4)
     1    /2.382, 2.396, 2.402, 2.412, 2.419,
     2     0.556, 0.691, 0.855, 1.032, 1.138,
     3     1.288, 1.601, 1.981, 2.297, 2.261,
     4     3.578, 3.578, 3.578, 3.549, 3.469/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(3,I,2,4,J), J=1,4), I=1,4)
     1    /1.984, 2.402, 2.766, 3.066,
     2     0.808, 0.855, 0.895, 0.927,
     3     1.874, 1.981, 2.074, 2.149,
     4     3.578, 3.578, 3.578, 3.578/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(3,I,2,4,J), J=1,4), I=1,4)
     1    /2.407, 2.410, 2.402, 2.399,
     2     0.710, 0.779, 0.855, 0.937,
     3     1.645, 1.806, 1.981, 2.173,
     4     3.578, 3.578, 3.578, 3.578/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     OGIVE, L/D=2, BETA=0 (CYLINDER)       *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(3,I,3,1,J), J=1,5), I=1,4)
     1    /1.000, 2.528, 2.420, 2.271, 2.206,
     2     0.423, 0.558, 0.773, 1.153, 1.540,
     3     0.423, 0.558, 0.773, 1.153, 1.540,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(3,I,3,1,J), J=1,4), I=1,4)
     1    /2.282, 2.420, 2.484, 2.520,
     2     1.061, 0.773, 0.612, 0.523,
     3     1.061, 0.773, 0.612, 0.523,
     4     2.000, 3.000, 4.000, 5.000/
C
C     JET MACH NUMBER
      DATA ((CKJM(3,I,3,1,J), J=1,3), I=1,4)
     1    /2.824, 2.420, 2.178,
     2     0.955, 0.773, 0.673,
     3     0.955, 0.773, 0.673,
     4     3.000, 3.000, 3.000/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(3,I,3,1,J), J=1,5), I=1,4)
     1    /2.402, 2.411, 2.420, 2.427, 2.437,
     2     0.499, 0.622, 0.773, 0.958, 1.214,
     3     0.499, 0.622, 0.773, 0.958, 1.214,
     4     3.000, 3.000, 3.000, 3.000, 3.000/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(3,I,3,1,J), J=1,4), I=1,4)
     1    /1.995, 2.420, 2.783, 3.086,
     2     0.730, 0.773, 0.809, 0.840,
     3     0.730, 0.773, 0.809, 0.840,
     4     3.000, 3.000, 3.000, 3.000/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(3,I,3,1,J), J=1,4), I=1,4)
     1    /2.429, 2.422, 2.420, 2.429,
     2     0.641, 0.704, 0.773, 0.849,
     3     0.641, 0.704, 0.773, 0.849,
     4     3.000, 3.000, 3.000, 3.000/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     OGIVE, L/D=2, BETA=4                  *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(3,I,3,2,J), J=1,5), I=1,4)
     1    /1.000, 2.530, 2.409, 2.263, 2.179,
     2     0.486, 0.591, 0.815, 1.217, 1.629,
     3     0.608, 0.740, 1.021, 1.525, 2.040,
     4     3.151, 3.151, 3.151, 3.151, 3.151/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(3,I,3,2,J), J=1,4), I=1,4)
     1    /2.250, 2.409, 2.465, 2.518,
     2     1.120, 0.815, 0.644, 0.552,
     3     1.284, 1.021, 0.886, 0.837,
     4     2.088, 3.151, 4.243, 5.366/
C
C     JET MACH NUMBER
      DATA ((CKJM(3,I,3,2,J), J=1,3), I=1,4)
     1    /2.823, 2.409, 2.174,
     2     1.000, 0.815, 0.716,
     3     1.253, 1.021, 0.897,
     4     3.151, 3.151, 3.151/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(3,I,3,2,J), J=1,5), I=1,4)
     1    /2.390, 2.402, 2.409, 2.417, 2.426,
     2     0.528, 0.658, 0.815, 1.009, 1.275,
     3     0.662, 0.824, 1.021, 1.263, 1.597,
     4     3.151, 3.151, 3.151, 3.151, 3.151/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(3,I,3,2,J), J=1,4), I=1,4)
     1    /1.991, 2.409, 2.773, 3.075,
     2     0.771, 0.815, 0.854, 0.885,
     3     0.966, 1.021, 1.069, 1.109,
     4     3.151, 3.151, 3.151, 3.151/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(3,I,3,2,J), J=1,4), I=1,4)
     1    /2.416, 2.415, 2.409, 2.402,
     2     0.677, 0.743, 0.815, 0.894,
     3     0.848, 0.931, 1.021, 1.119,
     4     3.151, 3.151, 3.151, 3.151/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     OGIVE, L/D=2, BETA=8                  *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(3,I,3,3,J), J=1,5), I=1,4)
     1    /1.000, 2.525, 2.402, 2.254, 2.170,
     2     0.465, 0.632, 0.872, 1.302, 1.496,
     3     0.719, 0.977, 1.347, 2.011, 2.195,
     4     3.294, 3.294, 3.294, 3.294, 3.259/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(3,I,3,3,J), J=1,4), I=1,4)
     1    /2.231, 2.402, 2.448, 2.495,
     2     1.198, 0.872, 0.687, 0.593,
     3     1.548, 1.347, 1.289, 1.365,
     4     2.164, 3.294, 4.487, 5.750/
C
C     JET MACH NUMBER
      DATA ((CKJM(3,I,3,3,J), J=1,3), I=1,4)
     1    /2.821, 2.402, 2.166,
     2     1.061, 0.872, 0.772,
     3     1.639, 1.347, 1.192,
     4     3.294, 3.294, 3.294/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(3,I,3,3,J), J=1,5), I=1,4)
     1    /2.386, 2.396, 2.402, 2.412, 2.417,
     2     0.569, 0.706, 0.872, 1.077, 1.357,
     3     0.879, 1.090, 1.347, 1.663, 2.096,
     4     3.294, 3.294, 3.294, 3.294, 3.294/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(3,I,3,3,J), J=1,4), I=1,4)
     1    /1.983, 2.402, 2.770, 3.065,
     2     0.825, 0.872, 0.913, 0.946,
     3     1.275, 1.347, 1.411, 1.461,
     4     3.294, 3.294, 3.294, 3.294/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(3,I,3,3,J), J=1,4), I=1,4)
     1    /2.406, 2.411, 2.402, 2.399,
     2     0.725, 0.796, 0.872, 0.956,
     3     1.119, 1.229, 1.347, 1.477,
     4     3.294, 3.294, 3.294, 3.294/
C
C********************************************
C     CHAPMAN-KORST RUN RESULTS             *
C     OGIVE, L/D=2, BETA=12                 *
C********************************************
C
C     JET PRESSURE RATIO
      DATA ((CKPR(3,I,3,4,J), J=1,5), I=1,4)
     1    /1.000, 2.514, 2.387, 2.240, 2.156,
     2     0.347, 0.690, 0.952, 1.243, 1.314,
     3     0.643, 1.278, 1.762, 2.254, 2.214,
     4     3.420, 3.420, 3.420, 3.405, 3.354/
C
C     FREESTREAM MACH NUMBER
      DATA ((CKFM(3,I,3,4,J), J=1,4), I=1,4)
     1    /2.217, 2.387, 2.442, 2.494,
     2     1.289, 0.952, 0.750, 0.647,
     3     1.823, 1.762, 1.872, 2.227,
     4     2.222, 3.420, 4.719, 6.141/
C
C     JET MACH NUMBER
      DATA ((CKJM(3,I,3,4,J), J=1,3), I=1,4)
     1    /2.812, 2.387, 2.149,
     2     1.143, 0.952, 0.851,
     3     2.116, 1.762, 1.575,
     4     3.420, 3.420, 3.420/
C
C     JET NOZZLE ANGLE
      DATA ((CKBN(3,I,3,4,J), J=1,5), I=1,4)
     1    /2.370, 2.377, 2.387, 2.396, 2.401,
     2     0.625, 0.774, 0.952, 1.171, 1.226,
     3     1.157, 1.433, 1.762, 2.168, 2.241,
     4     3.420, 3.420, 3.420, 3.420, 3.411/
C
C     JET TEMPERATURE RATIO
      DATA ((CKTR(3,I,3,4,J), J=1,4), I=1,4)
     1    /1.964, 2.387, 2.733, 3.045,
     2     0.900, 0.952, 0.993, 1.030,
     3     1.667, 1.762, 1.839, 1.908,
     4     3.420, 3.420, 3.420, 3.420/
C
C     JET TO BASE DIAMETER RATIO
      DATA ((CKDJ(3,I,3,4,J), J=1,4), I=1,4)
     1    /2.394, 2.395, 2.387, 2.382,
     2     0.792, 0.868, 0.952, 1.044,
     3     1.467, 1.608, 1.762, 1.932,
     4     3.420, 3.420, 3.420, 3.420/
C
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CYINC(ICASE,CYS,CNS,ICON,DUMMY,PHI)
C      
C        SUBROUTINE TO CALCULATE CY INCREMENTALS AND TO COMPUTE NEW CY
C     VALUES WITH THOSE INCREMENTALS.  IF AERODYNAMIC ROLL ANGLE IS
C     ZERO, INCREMENTALS ARE COMPUTED FOR CN TOTAL POTENTIAL AND CN TOTA
C     VISCOUS.  THEN USING THE INCREMENTED CN TOTAL AND THE INCREMENTED
C     THE INCREMENTED CY IS DETERMINED.  IF AERODYNAMIC ROLL ANGLE IS NO
C     ZERO, A TABLE OF MULTIPLIERS IS USED.
C      
C***  INPUTS
C      
C     ICASE = RUN CASE NUMBER
C     CYS   = ARRAY OF CY VALUES FROM SYNTHS
C     CNS   = ARRAY OF CN VALUES FROM SYNTHS
C     DUMMY = ARRAY THAT CONTAINS EXPERIMENTAL COEFFICIENTS AND WILL
C             CONTAIN UPDATED COEFFICIENTS CY = DUMMY 61-80
C     ICON  = CONFIGURATION TO BE INCREMETED
C             ICON = 1    BODY
C             ICON = 2    BODY + 1 FIN SET
C             ICON = 3    BODY + 2 FIN SETS
C             ICON = 4    BODY + 3 FIN SETS
C             ICON = 5    BODY + 4 FIN SETS
C     PHI   = BODY AXIS ROLL ANGLE
C      
C***  OUTPUT
C      
C     CY = UPDATED CY VALUES EQUIVALENT TO DUMMY 61-80
C          NOTE: ONE THE FIRST TIME THROUGH DUMMY ENTERS THE ROUTINE
C                WITH EXPERIMENTAL VALUES. IT RETURNS WITH INCREMENTED
C                CY VALUES
C      
      COMMON /FLC   / NA,ALPHA(20),FLDUM(123)
      COMMON /INC   / DUMMEE(64),C1,C2(20),CN0T,DIP(42),ZIP,ALP(20),
     1                NAP
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      DIMENSION CNTTH(20),CNTEXP(20),CNATTH(20),CYTH(20),CYEXP(20),
     1     CNATEX(20),CNPTTH(20),CNVTTH(20),CNPTEX(20),CNT(20),
     2     CY(20),DUMMY(120),CNS(20,5),CYS(20,5),Z(20)
      REAL NA,NAP
C
C ** INITIALIZE ARRAYS
C      
      DO 1000 I=1,20
         CYTH(I)=UNUSED
         CNTTH(I)=UNUSED
         CYEXP(I)=UNUSED
         CNTEXP(I)=UNUSED
         CNVTTH(I)=UNUSED
         CNPTEX(I)=UNUSED
         CY(I)=UNUSED
         CNT(I)=UNUSED
 1000 CONTINUE
C      
      NALPHA = NA + .5
      NAP1 = NAP + .5
C      
C       USE APPROPRIATE IOM COMMON BLOCK TO FILL THE WORKING ARRAYS
C       AND DETERMINE CN TOTAL
C      
      DO 1020 I=1,NALPHA
          IF(ICON .GT. 1)GO TO 1010
          CYTH(I)=CYS(I,5)
          CNTTH(I)=SQRT(CNS(I,5)**2 + CYS(I,5)**2)
          GO TO 1020
 1010     CYTH(I)=CYS(I,ICON-1)
          CNTTH(I)=SQRT(CNS(I,ICON-1)**2 + CYS(I,ICON-1)**2)
 1020 CONTINUE
      IF(PHI .NE. 0.)GO TO 1040
C      
C     COMPUTE THEORETICAL SLOPE OF CN TOTAL VS. ALPHA
C      
      DO 1030 I=1,NALPHA
         CALL POLINT(ALPHA,CNTTH,NALPHA,ALPHA(I),CNTTH(I),CNATTH(I))
 1030 CONTINUE
 1040 IF(ICASE .NE. 1 .OR. ZIP .EQ. 1)GO TO 1090
      IF(PHI .NE. 0.)GO TO 1160
C      
C       COMPUTE EXPERIMENTAL CN TOTAL
C      
      DO 1060 I=1,NALPHA
         CNTEXP(I)=SQRT(DUMMY(I)**2 + DUMMY(I+60)**2)
 1060 CONTINUE
C      
C      COMPUTE EXPERIMENTAL SLOPE OF CN TOTAL VS. ALPHA
C      
      DO 1070 I=1,NALPHA
         CALL POLINT(ALPHA,CNTEXP,NALPHA,ALPHA(I),CNTEXP(I),CNATEX(I))
 1070 CONTINUE
C      
C       DETERMINE THE DIFFERENCE BETWEEN CN TOTAL EXPERIMENTAL AND CN
C          TOTAL THEORETICAL AT ALPHA = 0
C      
      CALL LNTRP(ALPHA,CNTEXP,NALPHA,0.,CNTEX0)
      CALL LNTRP(ALPHA,CNTTH,NALPHA,0.,CNTTH0)
      CN0T= CNTEX0 - CNTTH0
C      
C      SUBTRACT CNOT FROM THE EXPERIMENTAL CN TOTAL TO BRING THE CURVE
C        DOWN TO CN THEORETICAL
C      
      DO 1080 I=1,NALPHA
         CNTEXP(I)=CNTEXP(I) - CN0T
 1080 CONTINUE
C      
C     USE CALIB TO DETERMINE THE POTENTIAL INCREMENTAL C1,A SACALAR MULT
C      
      CALL CALIB(-3,NALPHA,ALPHA,CNATEX,NALPHA,ALPHA,CNATTH,Z)
      C1=Z(1)
 1090 IF(PHI .NE. 0.)GO TO 1180
C      
C     CALCULATE THE THEORETICAL POTENTIAL CN TOTAL AND VISCOUS CN
C       TOTAL FROM CN TOTAL
C      
      DO 1100 I=1,NALPHA
         CNPTTH(I)=.5*CNATTH(I)*SIN(2.*ALPHA(I))*COS(ALPHA(I)/2.)
         CNVTTH(I)=CNTTH(I) - CNPTTH(I)
 1100 CONTINUE
C      
C        USE THE INCREMENTAL FACTOR C1 TO DETERMINE THE CORRECTED
C          POTENTIAL CN, WHICH IS THE EXPERIMENTAL CN POTENTIAL
C      
      DO 1110 I=1,NALPHA
         CNPTEX(I)=C1*CNPTTH(I)
 1110 CONTINUE
C      
C     ONLY ON THE FIRST CASE THE FIRST TIME THROUGH ARE INCREMENTALS
C        DETERMINED
C      
      IF (ICASE .NE. 1 .OR. ZIP .EQ. 1)GO TO 1130
C      
C       DETERMINE THE VISCOUS INCREMENTAL BY TAKING THE RATIO OF
C         EXPERIMENTAL CN TOTAL VISCOUS TO THEORETICAL CN TOTAL VISCOUS
C      
      DO 1120 I=1,NALPHA
         IF(CNTTH(I)-CNPTTH(I) .EQ. 0.)C2(I)=1.
         IF(CNTTH(I)-CNPTTH(I) .EQ. 0.)GO TO 1120
         C2(I)=(CNTEXP(I) - CNPTEX(I))/(CNTTH(I) - CNPTTH(I))
 1120 CONTINUE
 1130 CONTINUE
C      
C***  COMPUTE THE INCREMENTED CN TOTAL FOR PHI = 0
C      
      DO 1140 I=1,NALPHA
         CALL LNTRP(ALP,C2,NAP1,ALPHA(I),C2I)
         CNT(I)=CNPTEX(I) + C2I * CNVTTH(I) + CN0T
 1140 CONTINUE
C      
C       USING INCREMENTED CN TOTAL AND INCREMENTED CN DETERMINE
C             INCREMENTED CY
C      
      DO 1150 I=1,NALPHA
         SIGN=1.
         IF(CYTH(I) .LT. -.0000001)SIGN=-1.
         CY(I)=SIGN*SQRT(ABS(CNT(I)**2-DUMMY(I)**2))
 1150 CONTINUE
      GO TO 1200
C      
C**** HERE FOR AERODYNAMIC ROLL ANGLE NOT ZERO
C      
 1160 DO 1170 I=1,NALPHA
         CYEXP(I)=DUMMY(I+60)
 1170 CONTINUE
C      
C     USE CALIB TO DETERMINE TABLE OF MULTIPLIERS FOR CY INCRMENTALS
C      
      CALL CALIB(2,NALPHA,ALPHA,CYEXP,NALPHA,ALPHA,CYTH,C2)
C      
C***  INCREMENT CY USING INCREMENTALS INTERPOLATED FOR THE ALPHA OF INTE
C      
 1180 DO 1190 I=1,NALPHA
         CALL LNTRP(ALP,C2,NAP1,ALPHA(I),C2I)
         CY(I)=CYTH(I)*ABS(C2I)
 1190 CONTINUE
C      
C        UPDATE ARRAY DUMMY TO CONTAIN INCREMENTED CY
C      
 1200 DO 1210 I=1,NALPHA
         DUMMY(I+60)=CY(I)
 1210 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE F2GEOM
C
C***  SUBROUTINE TO COMPUTE THE GEOMETRIC CHARACTERISTICS OF A
C***  FIN
C
      COMMON /FSET2/  FDATA(399)
C
      COMMON /GEOFS2/ GFIN(188)
C
      DIMENSION SSPAN(10),LMAXU(10),LFLATU(10),LMAXL(10),
     1          LFLATL(10),CHORD(10),THICKU(10),THICKL(10),
     2          SWEEP(10),STA(10),XLE(10),
     3          XCORD(50),MEAN(50),THICK(50),YUPPER(50),
     4          YLOWER(50),LER(10)
C
      REAL LER,LMAXU,LMAXL,LFLATU,LFLATL,NPANEL,MEAN
C
      EQUIVALENCE (FDATA(1),SECTYP),(FDATA(2),SSPAN(1)),
     1            (FDATA(12),LMAXU(1)),(FDATA(22),LFLATU(1)),
     2            (FDATA(32),LMAXL(1)),(FDATA(42),LFLATL(1)),
     3            (FDATA(52),CHORD(1)),(FDATA(62),THICKU(1)),
     4            (FDATA(72),THICKL(1)),(FDATA(82),SWEEP(1)),
     5            (FDATA(92),STA(1)),(FDATA(102),XLE(1)),
     6            (FDATA(112),NPANEL),(FDATA(113),XCORD(1)),
     7            (FDATA(163),MEAN(1)),(FDATA(213),THICK(1)),
     8            (FDATA(263),YUPPER(1)),(FDATA(313),YLOWER(1)),
     9            (FDATA(363),FINPHI),(FDATA(364),LER(1))
C
      DIMENSION SPLANF(10),CBAR(10),SWEPLE(10),SWEP25(10),
     1          SWEP50(10),SWEP75(10),SWEPTE(10),
     2          XMGCLE(10),XMGC25(10),
     3          XMGC50(10),XMGC75(10),XMGCTE(10),YMEANC(10),
     4          ASPCT(10),TAPER(10),TOVERC(10),XCENT(10)
C
      EQUIVALENCE (GFIN(1),SPLANF(1)),(GFIN(11),CBAR(1)),
     1            (GFIN(21),SWEPLE(1)),(GFIN(31),SWEP25(1)),
     2            (GFIN(41),SWEP50(1)),(GFIN(51),SWEP75(1)),
     3            (GFIN(61),SWEPTE(1)),(GFIN(71),XMGCLE(1)),
     4            (GFIN(81),XMGC25(1)),(GFIN(91),XMGC50(1)),
     5            (GFIN(101),XMGC75(1)),(GFIN(111),XMGCTE(1)),
     6            (GFIN(121),YMEANC(1)),(GFIN(131),ASPCT(1)),
     7            (GFIN(141),TAPER(1)),(GFIN(151),TOVERC(1)),
     8            (GFIN(161),XCENT(1)),(GFIN(171),FINAR),
     9            (GFIN(172),FINTPR),(GFIN(173),FINSPN),
     A            (GFIN(174),FINSP),(GFIN(175),FINWET),
     B            (GFIN(176),TCEFF),(GFIN(177),FINXGC),
     C            (GFIN(178),FINYGC),(GFIN(179),SWAVLE),
     D            (GFIN(180),SWAV25),(GFIN(181),SWAV50),
     E            (GFIN(182),SWAV75),(GFIN(183),SWAVTE),
     F            (GFIN(184),FINCBR),(GFIN(185),DELTAY),
     G            (GFIN(186),DELTAD),(GFIN(187),XCENF),(GFIN(188),XOVC)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
C***  CALCULATE CHARACTERISTICS USING COMMON FUNCTIONS
C
C***  DO ONLY FOR SEGMENTS WHERE SPAN STATIONS ARE NOT ZERO OR
C***  UNUSED
C
C***  SET DEFAULTS
C
      IF(SECTYP.EQ.UNUSED .OR. SECTYP.LT.0. .OR. SECTYP.GT.3.)SECTYP=0.
C
      IF(NPANEL .LE. UNUSED)NPANEL=4.
      IF(FINPHI .EQ. UNUSED)FINPHI=0.
C
      DO 1000 I=1,10
         IF(I .GT. 1 .AND. SSPAN(I) .LE. UNUSED)GO TO 1010
         IF(STA(I) .EQ. UNUSED)STA(I)=1.
         IF(THICKU(I) .EQ. UNUSED)THICKU(I)=0.025
         IF(THICKL(I) .EQ. UNUSED)THICKL(I)=THICKU(I)
         IF(NPANEL .EQ. UNUSED)NPANEL=2.
         IF(LMAXU(I) .EQ. UNUSED)LMAXU(I)=0.5
         IF(LMAXL(I) .EQ. UNUSED)LMAXL(I)=LMAXU(I)
         IF(LFLATU(I) .EQ. UNUSED)LFLATU(I)=0.
         IF(LFLATL(I) .EQ. UNUSED)LFLATL(I)=LFLATU(I)
         IF(LER(I) .EQ. UNUSED)LER(I)=0.
C
 1000 CONTINUE
C
C
 1010 CONTINUE
      FINSP=0.0
      FINSPN=0.0
      FINAR=0.0
      FINTPR=0.0
      FINWET=0.0
      SWAVLE=0.0
      SWAV25=0.0
      SWAV50=0.0
      SWAV75=0.0
      SWAVTE=0.0
      XCENF=0.0
      FINXGC=0.0
      FINYGC=0.0
      FINCBR=0.0
C
      DO 1020 I=1,9
C
         II=I
C
         TOVERC(I)=THICKU(I)+THICKL(I)
C
         IF(SSPAN(I+1) .EQ. UNUSED .OR. SSPAN(I+1) .EQ. 0.)GO TO 1030
C
            SPAN=2.*(SSPAN(I+1)-SSPAN(I))
C
            TAPER(I)=CHORD(I+1)/CHORD(I)
C
            IF(SWEEP(I) .EQ. UNUSED)SWEEP(I)=ATAN((XLE(I+1)-
     1         XLE(I) + CHORD(I+1) - CHORD(I) )/(SPAN/2.))*RAD
C
            ASPCT(I)=ASPECT(SPAN,CHORD(I),TAPER(I))/2.
C
            SWEPLE(I)=SWEEPN(STA(I),SWEEP(I),0.00,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEP25(I)=SWEEPN(STA(I),SWEEP(I),0.25,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEP50(I)=SWEEPN(STA(I),SWEEP(I),0.50,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEP75(I)=SWEEPN(STA(I),SWEEP(I),0.75,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEPTE(I)=SWEEPN(STA(I),SWEEP(I),1.00,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SPLANF(I)=FINPLN(SPAN,CHORD(I),TAPER(I))/2.
C
            CBAR(I)=FINMGC(CHORD(I),TAPER(I))
C
            YMEANC(I)=YMGC(SPAN,CHORD(I),TAPER(I))
C
            IF(I .GT. 1 .AND. XLE(I) .EQ. UNUSED)XLE(I)=XLE(I-1)+
     1        (SSPAN(I)-SSPAN(I-1))*TAN(SWEPLE(I-1)/RAD)
C
            XMGCLE(I)=XLE(I)-XLE(1)+YMEANC(I)*TAN(SWEPLE(I)/RAD)
C
            XMGC25(I)=XMGCLE(I)+0.25*CBAR(I)
C
            XMGC50(I)=XMGCLE(I)+0.50*CBAR(I)
C
            XMGC75(I)=XMGCLE(I)+0.75*CBAR(I)
C
            XMGCTE(I)=XMGCLE(I)+CBAR(I)
C
            YMEANC(I)=YMEANC(I)+SSPAN(I)
C
            XCENT(I)=XLE(I)-XLE(1)+FINCEN(SPAN,SWEPLE(I),CHORD(I),
     1               TAPER(I))
C
            FINSPN=FINSPN+SPAN/2.
C
            FINSP=FINSP+SPLANF(I)
C
 1020 CONTINUE
C
 1030 CONTINUE
C
C***  TOTAL FIN RESULTS
C
      FINAR=(2.*FINSPN)**2/(2.*FINSP)/2.
C
      FINTPR=CHORD(II)/CHORD(1)
C
      FINWET=2.*FINSP
C
C
      DO 1040 I=1,II
C
         SWAVLE=SWAVLE+SWEPLE(I)*SPLANF(I)/FINSP
C
         SWAV25=SWAV25+SWEP25(I)*SPLANF(I)/FINSP
C
         SWAV50=SWAV50+SWEP50(I)*SPLANF(I)/FINSP
C
         SWAV75=SWAV75+SWEP75(I)*SPLANF(I)/FINSP
C
         SWAVTE=SWAVTE+SWEPTE(I)*SPLANF(I)/FINSP
C
         FINXGC=FINXGC+XMGCLE(I)*SPLANF(I)/FINSP
C
         FINYGC=FINYGC+YMEANC(I)*SPLANF(I)/FINSP
C
         FINCBR=FINCBR+CBAR(I)*SPLANF(I)/FINSP
C
         XCENF=XCENF+XCENT(I)*SPLANF(I)/FINSP
C
 1040 CONTINUE
C
      TCEFF=TCEFFT(II,SSPAN,CHORD,TOVERC,FINSP)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      FUNCTION FINPLN(SPAN,CROOT,TAPER)
C
C***  FUNCTION TO COMPUTE THE PLANFORM AREA OF A STRAIGHT TAPERED
C***  FIN OR FIN SEGMENT
C
C***  INPUTS
C
C   SPAN -- PANEL EXPOSED SPAN (TIP-TO-TIP) FOR TWO PANELS
C           JOINED AT THEIR EXPOSED ROOT CHORDS
C  CROOT -- PANEL EXPOSED ROOT CHORD
C  TAPER -- PANEL TIP CHORD DIVIDED BY EXPOSED ROOT CHORD
C
      FINPLN=SPAN/2.*CROOT*(1.+TAPER)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HYBRID(IPRINT,XX,RR,LNOS,VOVS,RN,AL,DIA,NBLUNT,
     1 BR,N,CAW,CNW,CMW,IERROR)
C
C***  MASTER ROUTINE FOR CONTROL OF VAN DYKE HYBRID THEORY
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  ORIGINAL ROUTINE WRITTEN BY F. MOORE, NSWC
C  MODIFIED BY J. JENKINS, WL/FIGC
C
      DIMENSION XX(50),RR(50),X(50),R(50)
C
      REAL LNOS
C
      CALL HYBINZ
C
      XO=0.
      IF(NBLUNT .EQ. 1)XO=XX(1)
C
      DO 1000 II=1,N
         X(II)=XX(II)-XO
         R(II)=RR(II)
 1000 CONTINUE
C
      NP1=N+1
C
      DO 1010 II=NP1,50
         X(II)=0.
         R(II)=0.
 1010 CONTINUE
C
      IERROR=0
C
      CALL HYBSET(X,R,XO,LNOS,BR,NSHAPE,N1,N2,N,N3,N4,DRB)
C
      IF(NBLUNT .EQ. 0)CALL HYBG1(N4,N3,IERROR,BETA,RP,X,R,N,
     1 NSHAPE,N1,N2,NN1,NN2,NN3,NN,VOVS,DRB)
      IF(NBLUNT .NE. 0)CALL HYBG2(N3,IERROR,BETA,RP,X,R,N,
     1 NSHAPE,N1,N2,NN1,NN2,NN3,NN,VOVS,BR,DRB)
C
      IF(IERROR .EQ. 1)GO TO 1020
C
      CALL VANDYK(IPRINT,BETA,RN,DIA,RP,R,N,NSHAPE,N2,NN1,NN2,
     1  NN3,NN4,NFL,NBLUNT,NN,NNI,VOVS,AL,XM,XINT,BR,IERROR,
     2  RREF,CAW,CNW,CMW)
C
 1020 CONTINUE
C
      CALL HYBINZ
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE LOADF(AMS,EXETA,SDL,CDL,LAMDA2,GAMMA2,DELTA2,
     1 LAMDA1,GAMMA1,DELTA1,F2MF1)
C
C  PRESSURE LOADING FUNCTIONS
C
C  SEE DEJARNETTE FOR THE EXACT DEFINITION OF THESE LOADING TERMS
C  REFERENCE - DEJARNETTE (AIAA J. SPACECRAFT, NOV-DEC 1980, P.529)
C    LAMDA = D (P)/D(ALPHA)  AT PHI=ALPHA=0
C    GAMMA = D2(P)/D(ALPHA)2 AT PHI=ALPHA=0
C    DELTA = D2(P)/D(ALPHA)2 AT PHI=90. DEG, ALPHA=0
C
C  INPUTS
C
C    AMS -- SQUARE OF THE FREESTREAM MACH NUMBER
C  EXETA -- EXP(ETA)
C    SDL -- SINE OF DEFLECTION OR PANEL ANGLE
C    CDL -- COSINE OF DEFLECTION OR PANEL ANGLE
C LAMDA2 -- LAMDA AT STATION 2
C GAMMA2 -- GAMMA AT STATION 2
C DELTA2 -- DELTA AT STATION 2
C
C  OUTPUTS
C
C LAMDA1 -- LAMDA AT STATION 1
C GAMMA1 -- GAMMA AT STATION 1
C DELTA1 -- DELTA AT STATION 1
C  F2MF1 -- DIFFERENCE BETWEEN FUNCTIONS F1 AND F2
C           (SEE MAIN CODE FOR CALCULATIONS OF F1 AND F2)
C
C  SUBROUTINES CALLED -- NONE
C
      REAL LAMDA1,LAMDA2
C
C
C  USE FORM OF EQUATION 29 TO GET THE CP DISTRIBUTION ALONG
C  THE FRUSTRUM
C
      B1=2.-1./SQRT(AMS-1.)
      IF(B1.LT.1.)B1=1.
      B2=6.-2.*B1
      LAMDA1=(1.0-EXETA)*2.0*SDL*CDL+EXETA*LAMDA2
      F2MF1=2.0*B1*(1.0-2.0*SDL**2)
      GAMMA1=(1.0-EXETA)*F2MF1+EXETA*GAMMA2
      DELTA1=(1.0-EXETA)*(F2MF1-2.0*B2*CDL**2)+EXETA*DELTA2
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PRIELL(ITYPE)
C
C***  SUBROUTINE TO PRINT THE AXISYMMETRIC BODY GEOMETRY DATA
C
      DIMENSION ICONE(2),IOGIV(2),IPOWR(2),IHACK(2),IKARM(2)
      DIMENSION KAST(50),ICYL(2)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /LOGIC/ LFLAGS(18),LDIMIN,LDIMFT,LDIMCM,LDIMM,LDUM2(6)
      LOGICAL        LFLAGS    ,LDIMIN,LDIMFT,LDIMCM,LDIMM
      LOGICAL ASTFLG
C
C
      COMMON /ABODIN/ NX,XO,X(50),R(50),TNOSE,LNOSE,WNOSE,BNOSE,
     1                TRUNC,LCENTR,WCENTR,TAFT,LAFT,WAFT,
     2                POWER,DISCON(20),ELLIP(50),HEIGHT(50),ENOSE,
     3                ECENTR,EAFT,ADUM(645)
C
      COMMON /GEOBOD/ SPNOSE,SWNOSE,VOLNOS,XCVNOS,XCPNOS,FRNOSE,
     1  THEOLN,THEOFN,SPCENT,SWCENT,VOLCEN,XCVCEN,XCPCEN,FRCENT,
     2  THEOLC,THEOFC,SPAFT ,SWAFT ,VOLAFT,XCVAFT,XCPAFT,FRAFT ,
     3  THEOLA,THEOFA,SPLAN ,SWET  ,VOL   ,XCENTV,XCENTP,FR    ,
     4                DBASE ,SBASE ,DMAX  ,SMAX  ,LTOTAL,
     5  BPNOSE,BCPNOS,BPCENT,BCPCEN,BPAFT,BCPAFT,BPLAN,
     6  BCENTP,GDUM(4)
      REAL NX,LNOSE,LCENTR,LAFT,LTOTAL
C
      CHARACTER*4 IDASH,ICONE,ICYL,IOGIV,IPOWR,IHACK,IKARM,
     1  IUNIT1,IUNIT2,IUNIT3,IUNIT4,IBLANK,IAST,KAND,
     2  NAM1,NAM2,NAM3,NAM4,NAM5,NAM6,IAXIS,KAST
C
      LOGICAL TRUNC
C
      DATA IDASH/'----'/
      DATA ICONE/'   C','ONIC'/
      DATA ICYL /'CYLI','NDER'/
      DATA IOGIV/'   O','GIVE'/
      DATA IPOWR/'   P','OWER'/
      DATA IHACK/'LV-H','AACK'/
      DATA IKARM/'VONK','ARMN'/
C
      DATA IUNIT1/'  IN'/
      DATA IUNIT2/'  FT'/
      DATA IUNIT3/'  CM'/
      DATA IUNIT4/'   M'/
      DATA IBLANK/'    '/
      DATA IAST  /'*   '/
      ASTFLG=.FALSE.
C
      NNX=NX+0.5
C
      NAM1=IDASH
      NAM2=IDASH
      NAM3=IDASH
      NAM4=IDASH
      NAM5=IDASH
      NAM6=IDASH
C
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 0.)NAM1=ICONE(1)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 0.)NAM2=ICONE(2)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 1.)NAM1=IOGIV(1)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 1.)NAM2=IOGIV(2)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 2.)NAM1=IPOWR(1)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 2.)NAM2=IPOWR(2)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 3.)NAM1=IHACK(1)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 3.)NAM2=IHACK(2)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 4.)NAM1=IKARM(1)
      IF(LNOSE .GT. UNUSED .AND. TNOSE .EQ. 4.)NAM2=IKARM(2)
      IF(LCENTR .GT. UNUSED)NAM3=ICONE(1)
      IF(LCENTR .GT. UNUSED)NAM4=ICONE(2)
      IF(LCENTR .GT. UNUSED .AND. WNOSE.EQ.WCENTR)NAM3=ICYL(1)
      IF(LCENTR .GT. UNUSED .AND. WNOSE.EQ.WCENTR)NAM4=ICYL(2)
      IF(LAFT .GT. UNUSED .AND. TAFT .EQ. 0.)NAM5=ICONE(1)
      IF(LAFT .GT. UNUSED .AND. TAFT .EQ. 0.)NAM6=ICONE(2)
      IF(LAFT .GT. UNUSED .AND. TAFT .EQ. 1.)NAM5=IOGIV(1)
      IF(LAFT .GT. UNUSED .AND. TAFT .EQ. 1.)NAM6=IOGIV(2)
C
      CALL HEADR9
C
      WRITE(6,1050)
      IF(ITYPE .EQ. 2)WRITE(6,1060)
C
      IAXIS=IUNIT2
      IF(LDIMIN)IAXIS=IUNIT1
      IF(LDIMCM)IAXIS=IUNIT3
      IF(LDIMM)IAXIS=IUNIT4
C
C  TYPE 2 INPUTS
C
      IF(ITYPE .EQ. 1)GO TO 1010
C
      WRITE(6,1070)NAM1,NAM2,NAM3,NAM4,NAM5,NAM6
      WRITE(6,1080)LNOSE,LCENTR,LAFT,LTOTAL,IAXIS
      WRITE(6,1090)FRNOSE,FRCENT,FRAFT,FR
      WRITE(6,1100)SPNOSE,SPCENT,SPAFT,SPLAN,IAXIS
      WRITE(6,1110)BPNOSE,BPCENT,BPAFT,BPLAN,IAXIS
      WRITE(6,1120)XCPNOS,XCPCEN,XCPAFT,XCENTP,IAXIS
      WRITE(6,1130)BCPNOS,BCPCEN,BCPAFT,BCENTP,IAXIS
      WRITE(6,1140)SWNOSE,SWCENT,SWAFT,SWET,IAXIS
      WRITE(6,1150)VOLNOS,VOLCEN,VOLAFT,VOL,IAXIS
      WRITE(6,1160)XCVNOS,XCVCEN,XCVAFT,XCENTV,IAXIS
      GO TO 1020
C
C  TYPE 1 INPUTS
C
 1010 CONTINUE
      WRITE(6,1220)LTOTAL,FR,SPLAN,XCENTP,SWET,VOL,XCENTV,IAXIS
C
 1020 CONTINUE
C
      IF(LNOSE .GT. UNUSED)BRATIO=BNOSE/(WNOSE/2.)
      IF(LNOSE .GT. UNUSED .AND. .NOT.TRUNC .AND. BNOSE .GT. UNUSED)
     1  WRITE(6,1240)BRATIO
C
      WRITE(6,1170)
C
C  IDENTIFY DISCONTINUOUS POINTS
C
      DO 1030 I=1,NNX
         IF(R(I) .LE. UNUSED)R(I)=0.
         IF(HEIGHT(I) .LE. UNUSED)HEIGHT(I)=0.
         KAST(I)=IBLANK
 1030 CONTINUE
C
      DO 1040 I=1,20
         IF(DISCON(I) .EQ. UNUSED)GO TO 1040
         ASTFLG=.TRUE.
         JJ=DISCON(I)+0.5
         KAST(JJ)=IAST
 1040 CONTINUE
C
      WRITE(6,1180)(X(I),KAST(I),I=1,NNX)
      WRITE(6,1190)(R(I),KAST(I),I=1,NNX)
      WRITE(6,1200)(HEIGHT(I),KAST(I),I=1,NNX)
      WRITE(6,1210)(ELLIP(I),KAST(I),I=1,NNX)
      IF(ASTFLG)WRITE(6,1230)
C
 1050 FORMAT(24X,'ELLIPTICAL BODY DEFINITION',/)
 1060 FORMAT(29X,'NOSE',3X,'CENTERBODY',5X,
     1 'AFT BODY',8X,'TOTAL')
 1070 FORMAT(4X,'SHAPE           ',5X,2A4,5X,2A4,5X,2A4)
 1080 FORMAT(4X,'LENGTH          ',4F13.3,A4)
 1090 FORMAT(4X,'FINENESS RATIO  ',4F13.3)
 1100 FORMAT(4X,'HOR. PLAN. AREA ',4F13.3,A4,'**2')
 1110 FORMAT(4X,'VERT. PLAN. AREA',4F13.3,A4,'**2')
 1120 FORMAT(4X,'HOR. PLAN. CENT.',4F13.3,A4)
 1130 FORMAT(4X,'VERT. PLAN. CEN.',4F13.3,A4)
 1140 FORMAT(4X,'WETTED AREA     ',4F13.3,A4,'**2')
 1150 FORMAT(4X,'VOLUME          ',4F13.3,A4,'**3')
 1160 FORMAT(4X,'VOL. CENTROID   ',4F13.3,A4,/)
C
 1170 FORMAT(30X,'MOLD LINE CONTOUR',/)
 1180 FORMAT(4X,' LONGITUDINAL STATIONS',5(F10.4,A1),/,4X,
     1  7(F10.4,A1),/,4X,7(F10.4,A1),/,4X,7(F10.4,A1),/,
     2  4X,7(F10.4,A1),/,4X,7(F10.4,A1),/,4X,7(F10.4,A1),
     3  /,4X,3(F10.4,A1))
 1190 FORMAT(/,4X,'            BODY WIDTH',5(F10.4,A1),/,4X,
     1  7(F10.4,A1),/,4X,7(F10.4,A1),/,4X,7(F10.4,A1),/,
     2  4X,7(F10.4,A1),/,4X,7(F10.4,A1),/,4X,7(F10.4,A1),
     3  /,4X,3(F10.4,A1))
 1200 FORMAT(/,4X,'           BODY HEIGHT',5(F10.4,A1),/,4X,
     1  7(F10.4,A1),/,4X,7(F10.4,A1),/,4X,7(F10.4,A1),/,
     2  4X,7(F10.4,A1),/,4X,7(F10.4,A1),/,4X,7(F10.4,A1),
     3  /,4X,3(F10.4,A1))
 1210 FORMAT(/,4X,'           ELLIPTICITY',5(F10.4,A1),/,4X,
     1  7(F10.4,A1),/,4X,7(F10.4,A1),/,4X,7(F10.4,A1),/,
     2  4X,7(F10.4,A1),/,4X,7(F10.4,A1),/,4X,7(F10.4,A1),
     3  /,4X,3(F10.4,A1))
 1220 FORMAT(4X,'LENGTH         ',F13.4,
     1       4X,'FINENESS RATIO ',F13.4,
     2       4X,'PLANFORM AREA  ',F13.4,
     3       4X,'AREA CENTROID  ',F13.4,
     4       4X,'WETTED AREA    ',F13.4,
     5       4X,'VOLUME         ',F13.4,
     6       4X,'VOLUME CENTROID',F13.4,'UNITS ARE IN',A4,/)
 1230 FORMAT(4X,'NOTE - * INDICATES SLOPE DISCONTINUOUS POINTS')
 1240 FORMAT(4X,'NOSE IS SPHERICALLY BLUNTED, BLUNTNESS RATIO =',F6.4)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SIMPW(CP, DZDX, DX, NI, NF, DCA)
C
C      SIMPSONS RULE INTEGRATION OF CP*DZDX, SUM INTO DCA
C
C      INPUT VARIABLES
C          CP - PRESSURE COEFFICIENT
C        DZDX - SURFACE SLOPE
C          DX - DISTANCE BETWEEN POINTS
C          NI - INITIAL POINT IN CP ARRAY
C          NF - FINAL POINT IN CP ARRAY
C
C      OUTPUT VARIABLE
C         DCA - INCREMENTAL AXIAL FORCE, INTEGRATION OF CP*DZDX
C
      DIMENSION CP(60), DZDX(60)
C
      F1 = CP(NI)*DZDX(NI)
      N1 = NI+1
      DO 10 I=N1,NF,2
        F2  = CP(I)*DZDX(I)
        F3  = 0.
        IF((I+1) .LE. NF)F3  = CP(I+1)*DZDX(I+1)
        DCA = DCA+DX*(F1+4.0*F2+F3)/3.0
        F1  = F3
   10 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE TODEC(ALPHA, ANS, IERR)
C
C***  CONVERT AN ALPHANUMERIC STRING INTO A FLOATING POINT CONSTANT
C
C***  INPUTS
C
C  ALPHA - ALPHANUMERIC STRING (MUST BE INTEGER)
C
C***  OUTPUTS
C
C    ANS - FLOATING POINT RESULT
C   IERR - ERROR CODE, 0=NO ERROR OR 1=CONSTANT NOT CORRECT TYPE
C
C**********************************************************************
C***  NOTE - INTEGER ARITHMETIC USED TO INCREASE NUMERICAL ACCURACY ***
C**********************************************************************
C
C     INTEGER ALPHA,PLUS,PERIOD,EE,BLANK,POWER,SIGNP,PTEN,RVALUE
      INTEGER POWER,SIGNP,PTEN,RVALUE
      CHARACTER*4 NUM,PLUS,MINUS,PERIOD,EE,BLANK,ALPHA
C
      DIMENSION ALPHA(80),NUM(10)
C
      LOGICAL FRAC
C
      DATA NUM / '0   ','1   ','2   ','3   ','4   ','5   ','6   ',
     1           '7   ','8   ','9   '/
      DATA PLUS, MINUS, PERIOD, EE, BLANK
     1  / '+   ','-   ','.   ','E   ','    '/
C
C*****************************************
C***  INITIALIZE (DEFAULT ANSWER = 0.) ***
C*****************************************
C
      IERR=0
      FRAC=.FALSE.
      LVALUE=0
      RVALUE=0
      POWER=0
      SIGNV=0.
      SIGNP=0
      PTEN=0
C
C*********************
C***  GET MANTISSA ***
C*********************
C
      DO 1070 I=1,80
C
         ICOL=I
C
C ...    SKIP BLANKS
C
         IF(ALPHA(I) .EQ. BLANK)GO TO 1070
C
C ...    IF E IS DETECTED, START EXPONENT
C
         IF(ALPHA(I) .EQ. EE)GO TO 1080
C
C ...    CHECK FOR + SIGN ON NUMBER
C
         IF(ALPHA(I) .NE. PLUS)GO TO 1000
C
C ...    IF ALREADY DEFINED, EXIT
C
         IF(SIGNV .NE. 0.)GO TO 1130
C
C ...    SET PLUS SIGN
C
         SIGNV=1.
         GO TO 1070
C
C ...    CHECK FOR MINUS SIGN ON NUMBER
C
 1000    IF(ALPHA(I) .NE. MINUS)GO TO 1010
C
C ...    IF ALREADY DEFINED, EXIT
C
         IF(SIGNV .NE. 0.)GO TO 1130
C
C ...    SET MINUS SIGN
C
         SIGNV=-1.
         GO TO 1070
C
C ...    IF PERIOD, MUST DO FRACTIONAL PART OF NUMBER
C
 1010    IF(ALPHA(I) .NE. PERIOD)GO TO 1020
C
         FRAC=.TRUE.
         GO TO 1070
C
 1020    IF(FRAC)GO TO 1040
C
C ...    DECODE NUMBERS TO LEFT OF DECIMAL POINT
C
         DO 1030 J=1,10
            IF(LVALUE .GT. 99999999)GO TO 1070
            IF(ALPHA(I) .EQ. NUM(J))LVALUE=10*LVALUE+J-1
            IF(ALPHA(I) .EQ. NUM(J))GO TO 1070
 1030    CONTINUE
C
C ...    ERROR, CONSTANT NOT REAL OR INTEGER
C
         IERR=1
C
         GO TO 1130
C
C ...    DECODE NUMBERS TO RIGHT OF DECIMAL POINT
C
 1040    DO 1050 J=1,10
            IF(RVALUE .GT. 99999999)GO TO 1070
            IF(ALPHA(I) .EQ. NUM(J))RVALUE=10*RVALUE+J-1
            IF(ALPHA(I) .EQ. NUM(J))GO TO 1060
 1050    CONTINUE
C
C ...    ERROR, CONSTANT NOT REAL OR INTEGER
C
         IERR=1
C
         GO TO 1130
C
C ...    COUNT NUMBER OF DIGITS RIGHT OF DECIMAL POINT
C
 1060    PTEN=PTEN+1
C
 1070 CONTINUE
C
      GO TO 1130
C
C*********************
C***  GET EXPONENT ***
C*********************
C
 1080 ICOL=ICOL+1
      IF(ICOL .GT. 80)GO TO 1130
C
      DO 1120 I=ICOL,80
C
C ...    CHECK FOR PLUS SIGN ON EXPONENT
C
         IF(ALPHA(I) .NE. PLUS)GO TO 1090
C
C ...    IF ALREADY DEFINED, EXIT
C
         IF(SIGNP .NE. 0)GO TO 1130
C
C ...    SET POSITIVE EXPONENT
C
         SIGNP=1
         GO TO 1120
C
C ...    CHECK FOR NEGATIVE SIGN ON EXPONENT
C
 1090    IF(ALPHA(I) .NE. MINUS)GO TO 1100
C
C ...    IF ALREADY DEFINED, EXIT
C
         IF(SIGNP .NE. 0)GO TO 1130
C
C ...    SET NEGATIVE EXPONENT
C
         SIGNP=-1
         GO TO 1120
C
C ...    DECODE EXPONENT
C
 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
C
         GO TO 1130
C
 1120 CONTINUE
C
C***********************
C***  CONVERT NUMBER ***
C***********************
C
C ... VERIFY SIGN FOR MANTISSA AND EXPONENT DEFINED
C
 1130 IF(SIGNV .EQ. 0.)SIGNV=1.
      IF(SIGNP .EQ. 0 )SIGNP=1
C
      ANS=SIGNV*(FLOAT(LVALUE)+FLOAT(RVALUE)*10.**(-PTEN))
     1    *10.**(SIGNP*POWER)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCNP(CNALP,ALPHA,CNP)
C
C***  SUBROUTINE TO COMPUTE THE POTENTIAL NORMAL FORCE FOR BODIES
C***  METHOD OF ALLEN AND PERKINS
C
C  MODIFIED BY W. BLAKE, WL/FIGC
C
C***  INPUTS
C
C  CNALP -- POTENTIAL NORMAL FORCE SLOPE, PER RADIAN
C  ALPHA -- ANGLE OF ATTACK, DEGREES
C
C***  OUTPUT
C
C    CNP -- POTENTIAL NORMAL FORCE COEFFICIENT AT ALPHA
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
C  REV 1/96 CORRECT CALCULATION FOR ALPHA > 90 OR < -90
C
      ALP=ABS(ALPHA)
      IF(ALP.GT.90.) ALP=180.-ALP
      CNP=CNALP/2.*SIN(2.*ALP/RAD)*COS(ALP/RAD/2.)
      IF(ALPHA.LT.0.) CNP=-CNP
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CLMAX(CBAR, DELTAY, XO, THN, CAM, XNM, REN, SCLMAX)
C ***
C ***
C *** CALCULATE SUBSONIC SECTION MAXIMUM LIFT 
C ***
C *** REFERENCE   DATCOM SECTION 4.1.1.4
C ***
C *** INPUT   CBAR    WING MEAN AERODYNAMIC CHORD
C ***         DELTAY  DIFFERENCE IN AIRFOIL ORDINATE BETWEEN
C ***                 .15% AND 6% CHORD,PER CENT CHORD
C ***         XO      AIRFOIL CHORD STATIONS
C ***         THN     AIRFOIL THICKNESS DISTRIBUTION
C ***         CAM     AIRFOIL CAMBER LINE
C ***         XNM     NUMBER OF MACH NUMBERS
C ***         REN     REYNOLDS NUMBER PER FOOT
C ***
C *** OUTPUT  SCLMAX  SECTION MAXIMUM LIFT COEFFICIENT
C ***
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
C ***
      DIMENSION SCLMAX(20), XO(50), THN(50), CAM(50), REN(20)
      DIMENSION PARM58(26), EVAL58(52), PARM59(30), EVAL59(160),
     1          PARM60(20), EVAL60(30), PARM61(16), EVAL61(32),
     2          PARM62(8),  EVAL62(8),  IROUT(2)
      LOGICAL   CAMBER
C
C    DATCOM FIGURE 4.1.1.4-5
C
      DATA PARM58 /0.,1.,1.1,1.25,1.50,2.00,2.25,2.50,3.00,3.50,4.00,
     1    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    1.42,2*.8,.81,.85,.98,1.2,1.31,1.43,1.51,1.52,1.48,1.41,1.41,
     2    2*.8,.81,.85,.98,1.2,1.31,1.39,1.44,1.45,1.43,1.35,1.35,
     3    2*.8,.81,.85,.98,1.2,1.29,1.33,1.35,1.35,1.35,1.35,1.35/
C
C    DATCOM FIGURE 4.1.1.4-6
C
      DATA PARM59 /0.,1.,1.5,2.,2.5,3.,3.5,4.,4.5,5.,0.,.02,.04,.06,
     1    6*0.,.15,.30,.40,.50,6*0./
      DATA EVAL59 /10*0.,
     1 0.,.12,.23,.32,.23,.12,.07,.07,.06,.03,
     2 0.,.27,.36,.40,.30,.16,3*.1,.06,
     3 0.,.27,.36,.40,.30,.16,3*.1,.06,
     4 10*0.,
     5 2*0.,.17,.22,.25,.15,.08,.06,.08,.02,
     6 0.,.15,.27,.40,.33,.18,.08,.06,.07,.01,
     7 0.,.53,.64,.56,.38,.22,.10,2*.06,0.,
     8 10*0.,
     9 2*0.,.05,.19,.23,.14,.07,2*.06,.02,
     A 0.,.16,.27,.37,.34,.19,.10,.07,.09,.05,
     B 0.,.39,.50,.50,.40,.25,.13,.10,.13,.09,
     C 10*0.,
     D 2*0.,.04,.10,.15,.14,.09,.07,.10,.08,
     E 0.,.10,.19,.27,.30,.22,.15,.13,.18,.12,
     F 0.,.26,.36,.43,.45,.30,.21,.20,.23,.20 /
C
C    DATCOM FIGURE 4.1.1.4-7A
C
      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,
     1             0.,.16,.19,.20,.18,.08,.05,.03,.04,.02,
     2             0.,.16,.19,.20,.18,.08,.08,.10,.12,.08 /
C
C    DATCOM FIGURE 4.1.1.4-7B
C
      DATA PARM61 /0.,1.,1.5,2.,2.5,3.,3.5,4.,3.E06,6.E06,9.E06,2.5E07,
     1    4*0./
      DATA EVAL61 /0.,-.09,2*-.13,-.09,-.11,-.20,-.24,
     1             2*0.,-.08,-.07,2*-.03,-.07,-.10,
     2             8*0.,0.,.12,.14,.07,.01,.11,.18,.20 /
C
C    DATCOM FIGURE 4.1.1.4-8A
C
      DATA PARM62 /0.,1.,1.5,2.,2.5,3.,3.5,4./
      DATA EVAL62 /2*0.,-.19,-.37,-.46,3*-.5/
      DATA DUM    /1.0/
C
C  CALCULATE AIRFOIL GEOMETRIC PARAMETERS
C
      XOVC = UNUSED
      COVC = UNUSED
      CXVC = UNUSED
      DO 10 I=2,50
        IF(XO(I) .LE. UNUSED) GO TO 20
        IF(THN(I) .GT. THN(I-1)) XOVC = XO(I)
        IF(CAM(I) .GT. CAM(I-1)) COVC = CAM(I)
        IF(CAM(I) .GT. CAM(I-1)) CXVC = XO(I)
   10 CONTINUE
   20 CONTINUE
      CAMBER = COVC .GT. UNUSED
      NMACH  = XNM + 0.5
C
C  CLMAX BASE
C
      IF(ABS(XOVC-.3) .LE. 1.E-5) XOVC = .3
      CALL MVLOOK(1, 4, 13, 52, DUM, PARM58(14), PARM58(1), EVAL58,
     1            DELTAY, XOVC, 1.0, CLBASE)
C
C  DELTA CLMAX
C
      DEL1=0.0
      DEL2=0.0
      IF(.NOT.CAMBER) GO TO 1000
      CALL MVLOOK(4, 4, 10, 160, PARM59(21), PARM59(11), PARM59(1),
     1            EVAL59, DELTAY, COVC, CXVC, DEL1)
      IF(XOVC .EQ. 0.30) GO TO 1000
      CALL MVLOOK(1, 3, 10, 30, DUM, PARM60(11), PARM60(1), EVAL60,
     1            DELTAY, COVC, 1.0, DEL2)
 1000 CONTINUE
      IN=0
      DO 1010 I=1,NMACH
         RN = REN(I)*CBAR
         IF(RN .LT. 1.0) RN = 9.0E6
         CALL MVLOOK(1, 4, 8, 32, DUM, PARM61(9), PARM61(1), EVAL61,
     1               DELTAY, RN, 1.0, DEL3)
         CALL LNTRP(PARM62, EVAL62, 8, DELTAY, DEL4)
         CLMAX0=CLBASE+DEL1+DEL2+DEL3
         SCLMAX(I)=CLMAX0
 1010 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CYL(MACH,RPUL,DEL,H,W,L,OFF,CDCYL)
      REAL MACH,L,MSUB,MSUP
C
C  WRITTEN BY K. DETERS, MCDONNELL DOUGLAS
C
      MSUB=.6
      MSUP=1.
      G=1.4
      S=W*H
      HTOT=H+OFF
      TMACH=0.0
      IF(MACH.GT.MSUB) GO TO 215
C
C*** SUBSONIC DRAG CALCULATION
 210  REL=RPUL*L
      CF=.074/(REL**.2)
      CDF=CF*(4.0+2.0*(L/W)+120.0*(W/L)**2)
      DH=W/H
      CALL ARCOR(DH,CDCIR)
      CD0=(CDF/1.2)*CDCIR
      CD=CD0/(SQRT(1.0-MACH**2))
      IF(TMACH.EQ.0.) GO TO 245
      GO TO 220
 215  IF(MACH.LT.MSUP) GO TO 225
C
C*** SUPERSONIC DRAG CALCULATION
C
C***  NUMBER OF X INCREMENTS
 230  NX=200
C
C***  CONSTANTS
      PI=3.141593
C
C***  INITIALIZE SUMMING VARIABLES
      CDCUM=0.0
C
C***  CALCULATE THE ELLIPSE PARAMETERS
      A=L/2.0
      B=W/2.0
C
C***  INITIALIZE XPREV AND YPREV
      XPREV=0.0
      YPREV=B
C
C***  CALCULATE THE X INCREMENTS
      DELX=A/FLOAT(NX)
      DO 200 I=1,NX
        X=XPREV+DELX
        XT=(XPREV+X)/2.0
        IF (X.GT.A) THEN
          X=A
          XT=(XPREV+X)/2.0
          DELX=X-XPREV
        ENDIF
        Y=B*SQRT(1.-(X/A)**2)
        THETA=ATAN(B*XT/A**2/SQRT(1.-(XT/A)**2))
        DELS=SQRT(DELX**2+(YPREV-Y)**2)
        CDD=(SIN(THETA))**3*DELS
        CDCUM=CDCUM+CDD
        YPREV=Y
        XPREV=X
 200  CONTINUE
      RMACH=5.
      EQ1=(((G+1.))**2*RMACH**2)/((4.0*G*RMACH**2)-2.0*(G-1.0))
      EQ2=(1.0-G+(2.0*G*RMACH**2))/(G+1.0)
      CPMAX=(2.0/(G*RMACH**2))*((EQ1**(G/(G-1.0)))*EQ2-1.0)
      CD=CDCUM*CPMAX/B
      CALL CROSS(MACH,CDT)
      CD=CD*(CDT/1.2)
      IF(TMACH.EQ.0.) GO TO 245
      GO TO 240
 225  CONTINUE
C
C*** TRANSONIC DRAG CALCULATION
      TMACH=MACH
      MACH=MSUB
      GO TO 210
 220  CDSUB=CD
      SUBM=CD*1.172
      MACH=MSUP
      GO TO 230
 240  CDSUP=CD
      SUPM=0.0
      CALL CUBIC(TMACH,MSUB,MSUP,CDSUB,CDSUP,SUBM,SUPM,CDTR)
      MACH=TMACH
      CD=CDTR
 245  CONTINUE 
C
C***  FINAL CALCULATION OF DRAG COEFFICIENT
        IF (OFF .EQ. 0.) THEN
          IF (H .GT. DEL) THEN
          CD=CD*(1.0-.25*(DEL/H))
          ELSE
          CD=CD*(.75*((H/DEL)**(1./3.)))
          ENDIF
        ELSE
          IF (OFF .GE. DEL) THEN
          CD=CD
          ELSE
            IF (HTOT .LE. DEL) THEN
            HAVG1=(HTOT+OFF)/2.
            CD=CD*((HAVG1/DEL)**(1./3.))
            ELSE
            HAVG2=(DEL+OFF)/2.
            CD=CD*(((HTOT-DEL)/H)+((DEL-OFF)/H)*((HAVG2/DEL)**(1./3.)))
            ENDIF
          ENDIF
        ENDIF
      CDCYL=CD*S
      RETURN
      END

c *************************************
c *************************************
c *************************************
      SUBROUTINE F3GEOM
C
C***  SUBROUTINE TO COMPUTE THE GEOMETRIC CHARACTERISTICS OF A
C***  FIN
C
C  WRITTEN BY S. STOY, MCDONNELL DOUGLAS
C
      COMMON /FSET3/  FDATA(399)
C
      COMMON /GEOFS3/ GFIN(188)
C
      DIMENSION SSPAN(10),LMAXU(10),LFLATU(10),LMAXL(10),
     1          LFLATL(10),CHORD(10),THICKU(10),THICKL(10),
     2          SWEEP(10),STA(10),XLE(10),
     3          XCORD(50),MEAN(50),THICK(50),YUPPER(50),
     4          YLOWER(50),LER(10)
C
      REAL LER,LMAXU,LMAXL,LFLATU,LFLATL,NPANEL,MEAN
C
      EQUIVALENCE (FDATA(1),SECTYP),(FDATA(2),SSPAN(1)),
     1            (FDATA(12),LMAXU(1)),(FDATA(22),LFLATU(1)),
     2            (FDATA(32),LMAXL(1)),(FDATA(42),LFLATL(1)),
     3            (FDATA(52),CHORD(1)),(FDATA(62),THICKU(1)),
     4            (FDATA(72),THICKL(1)),(FDATA(82),SWEEP(1)),
     5            (FDATA(92),STA(1)),(FDATA(102),XLE(1)),
     6            (FDATA(112),NPANEL),(FDATA(113),XCORD(1)),
     7            (FDATA(163),MEAN(1)),(FDATA(213),THICK(1)),
     8            (FDATA(263),YUPPER(1)),(FDATA(313),YLOWER(1)),
     9            (FDATA(363),FINPHI),(FDATA(364),LER(1))
C
      DIMENSION SPLANF(10),CBAR(10),SWEPLE(10),SWEP25(10),
     1          SWEP50(10),SWEP75(10),SWEPTE(10),
     2          XMGCLE(10),XMGC25(10),
     3          XMGC50(10),XMGC75(10),XMGCTE(10),YMEANC(10),
     4          ASPCT(10),TAPER(10),TOVERC(10),XCENT(10)
C
      EQUIVALENCE (GFIN(1),SPLANF(1)),(GFIN(11),CBAR(1)),
     1            (GFIN(21),SWEPLE(1)),(GFIN(31),SWEP25(1)),
     2            (GFIN(41),SWEP50(1)),(GFIN(51),SWEP75(1)),
     3            (GFIN(61),SWEPTE(1)),(GFIN(71),XMGCLE(1)),
     4            (GFIN(81),XMGC25(1)),(GFIN(91),XMGC50(1)),
     5            (GFIN(101),XMGC75(1)),(GFIN(111),XMGCTE(1)),
     6            (GFIN(121),YMEANC(1)),(GFIN(131),ASPCT(1)),
     7            (GFIN(141),TAPER(1)),(GFIN(151),TOVERC(1)),
     8            (GFIN(161),XCENT(1)),(GFIN(171),FINAR),
     9            (GFIN(172),FINTPR),(GFIN(173),FINSPN),
     A            (GFIN(174),FINSP),(GFIN(175),FINWET),
     B            (GFIN(176),TCEFF),(GFIN(177),FINXGC),
     C            (GFIN(178),FINYGC),(GFIN(179),SWAVLE),
     D            (GFIN(180),SWAV25),(GFIN(181),SWAV50),
     E            (GFIN(182),SWAV75),(GFIN(183),SWAVTE),
     F            (GFIN(184),FINCBR),(GFIN(185),DELTAY),
     G            (GFIN(186),DELTAD),(GFIN(187),XCENF),(GFIN(188),XOVC)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
C***  CALCULATE CHARACTERISTICS USING COMMON FUNCTIONS
C
C***  DO ONLY FOR SEGMENTS WHERE SPAN STATIONS ARE NOT ZERO OR
C***  UNUSED
C
C***  SET DEFAULTS
C
      IF(SECTYP.EQ.UNUSED .OR. SECTYP.LT.0. .OR. SECTYP.GT.3.)SECTYP=0.
C
      IF(NPANEL .LE. UNUSED)NPANEL=4.
      IF(FINPHI .EQ. UNUSED)FINPHI=0.
C
      DO 1000 I=1,10
         IF(I .GT. 1 .AND. SSPAN(I) .LE. UNUSED)GO TO 1010
         IF(STA(I) .EQ. UNUSED)STA(I)=1.
         IF(THICKU(I) .EQ. UNUSED)THICKU(I)=0.025
         IF(THICKL(I) .EQ. UNUSED)THICKL(I)=THICKU(I)
         IF(NPANEL .EQ. UNUSED)NPANEL=2.
         IF(LMAXU(I) .EQ. UNUSED)LMAXU(I)=0.5
         IF(LMAXL(I) .EQ. UNUSED)LMAXL(I)=LMAXU(I)
         IF(LFLATU(I) .EQ. UNUSED)LFLATU(I)=0.
         IF(LFLATL(I) .EQ. UNUSED)LFLATL(I)=LFLATU(I)
         IF(LER(I) .EQ. UNUSED)LER(I)=0.
C
 1000 CONTINUE
C
C
 1010 CONTINUE
      FINSP=0.0
      FINSPN=0.0
      FINAR=0.0
      FINTPR=0.0
      FINWET=0.0
      SWAVLE=0.0
      SWAV25=0.0
      SWAV50=0.0
      SWAV75=0.0
      SWAVTE=0.0
      XCENF=0.0
      FINXGC=0.0
      FINYGC=0.0
      FINCBR=0.0
C
      DO 1020 I=1,9
C
         II=I
C
         TOVERC(I)=THICKU(I)+THICKL(I)
C
         IF(SSPAN(I+1) .EQ. UNUSED .OR. SSPAN(I+1) .EQ. 0.)GO TO 1030
C
            SPAN=2.*(SSPAN(I+1)-SSPAN(I))
C
            TAPER(I)=CHORD(I+1)/CHORD(I)
C
            IF(SWEEP(I) .EQ. UNUSED)SWEEP(I)=ATAN((XLE(I+1)-
     1         XLE(I) + CHORD(I+1) - CHORD(I) )/(SPAN/2.))*RAD
C
            ASPCT(I)=ASPECT(SPAN,CHORD(I),TAPER(I))/2.
C
            SWEPLE(I)=SWEEPN(STA(I),SWEEP(I),0.00,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEP25(I)=SWEEPN(STA(I),SWEEP(I),0.25,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEP50(I)=SWEEPN(STA(I),SWEEP(I),0.50,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEP75(I)=SWEEPN(STA(I),SWEEP(I),0.75,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEPTE(I)=SWEEPN(STA(I),SWEEP(I),1.00,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SPLANF(I)=FINPLN(SPAN,CHORD(I),TAPER(I))/2.
C
            CBAR(I)=FINMGC(CHORD(I),TAPER(I))
C
            YMEANC(I)=YMGC(SPAN,CHORD(I),TAPER(I))
C
            IF(I .GT. 1 .AND. XLE(I) .EQ. UNUSED)XLE(I)=XLE(I-1)+
     1        (SSPAN(I)-SSPAN(I-1))*TAN(SWEPLE(I-1)/RAD)
C
            XMGCLE(I)=XLE(I)-XLE(1)+YMEANC(I)*TAN(SWEPLE(I)/RAD)
C
            XMGC25(I)=XMGCLE(I)+0.25*CBAR(I)
C
            XMGC50(I)=XMGCLE(I)+0.50*CBAR(I)
C
            XMGC75(I)=XMGCLE(I)+0.75*CBAR(I)
C
            XMGCTE(I)=XMGCLE(I)+CBAR(I)
C
            YMEANC(I)=YMEANC(I)+SSPAN(I)
C
            XCENT(I)=XLE(I)-XLE(1)+FINCEN(SPAN,SWEPLE(I),CHORD(I),
     1               TAPER(I))
C
            FINSPN=FINSPN+SPAN/2.
C
            FINSP=FINSP+SPLANF(I)
C
 1020 CONTINUE
C
 1030 CONTINUE
C
C***  TOTAL FIN RESULTS
C
      FINAR=(2.*FINSPN)**2/(2.*FINSP)/2.
C
      FINTPR=CHORD(II)/CHORD(1)
C
      FINWET=2.*FINSP
C
C
      DO 1040 I=1,II
C
         SWAVLE=SWAVLE+SWEPLE(I)*SPLANF(I)/FINSP
C
         SWAV25=SWAV25+SWEP25(I)*SPLANF(I)/FINSP
C
         SWAV50=SWAV50+SWEP50(I)*SPLANF(I)/FINSP
C
         SWAV75=SWAV75+SWEP75(I)*SPLANF(I)/FINSP
C
         SWAVTE=SWAVTE+SWEPTE(I)*SPLANF(I)/FINSP
C
         FINXGC=FINXGC+XMGCLE(I)*SPLANF(I)/FINSP
C
         FINYGC=FINYGC+YMEANC(I)*SPLANF(I)/FINSP
C
         FINCBR=FINCBR+CBAR(I)*SPLANF(I)/FINSP
C
         XCENF=XCENF+XCENT(I)*SPLANF(I)/FINSP
C
 1040 CONTINUE
C
      TCEFF=TCEFFT(II,SSPAN,CHORD,TOVERC,FINSP)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FINS(IM,NFIN)
C
C***  TOP LEVEL EXECUTIVE FOR FIN ALONE AERODYNAMICS
C
C***  IM IS THE CURRENT MACH NUMBER INDEX
C***  NFIN IS THE CURRENT FIN SET INDEX
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      REAL LREF,LATREF
C
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      REAL NALPHA,NMACH,MACH
C
      COMMON /TOTALC/ BALPHA(20),BBETA(20),BPHI(20),ALPTOT(20)
C
      COMMON /GEOFS1/ GFIN1(188)
      COMMON /GEOFS2/ GFIN2(188)
      COMMON /GEOFS3/ GFIN3(188)
      COMMON /GEOFS4/ GFIN4(188)
C
      COMMON /FSET1/  FDATA1(399)
      COMMON /FSET2/  FDATA2(399)
      COMMON /FSET3/  FDATA3(399)
      COMMON /FSET4/  FDATA4(399)
C
      COMMON /GEOFC/  GFINC(21)
C
      COMMON /SFIN1/ CNF1(20),CMF1(20),CAF1(20),CYF1(20),CLNF1(20),
     1               CLLF1(20),CNAF1(20),CMAF1(20),CYBF1(20),
     2               CNBF1(20),CLBF1(20)
      COMMON /SFIN2/ CNF2(20),CMF2(20),CAF2(20),CYF2(20),CLNF2(20),
     1               CLLF2(20),CNAF2(20),CMAF2(20),CYBF2(20),
     2               CNBF2(20),CLBF2(20)
      COMMON /SFIN3/ CNF3(20),CMF3(20),CAF3(20),CYF3(20),CLNF3(20),
     1               CLLF3(20),CNAF3(20),CMAF3(20),CYBF3(20),
     2               CNBF3(20),CLBF3(20)
      COMMON /SFIN4/ CNF4(20),CMF4(20),CAF4(20),CYF4(20),CLNF4(20),
     1               CLLF4(20),CNAF4(20),CMAF4(20),CYBF4(20),
     2               CNBF4(20),CLBF4(20)
C
      COMMON /F1WORK/ RHO1,TMAX1,KSHAR1,CCLA1(20),XAC1(20),CMCO41(20),
     1                CNALF1,CNAAF1(20),CNLF1(20),CNNLF1(20),CNF1AT(20),
     2                XCPL1,XCPNL1,CMFL1(20),CMFNL1(20),CMF1AT(20),
     3                CAOF1,CANLF1(20),ALPTF1(20),CNFIT1(20),AI1,ALO1,
     4                CLI1,CLM1(20)
      COMMON /F2WORK/ RHO2,TMAX2,KSHAR2,CCLA2(20),XAC2(20),CMCO42(20),
     1                CNALF2,CNAAF2(20),CNLF2(20),CNNLF2(20),CNF2AT(20),
     2                XCPL2,XCPNL2,CMFL2(20),CMFNL2(20),CMF2AT(20),
     3                CAOF2,CANLF2(20),ALPTF2(20),CNFIT2(20),AI2,ALO2,
     4                CLI2,CLM2(20)
      COMMON /F3WORK/ RHO3,TMAX3,KSHAR3,CCLA3(20),XAC3(20),CMCO43(20),
     1                CNALF3,CNAAF3(20),CNLF3(20),CNNLF3(20),CNF3AT(20),
     2                XCPL3,XCPNL3,CMFL3(20),CMFNL3(20),CMF3AT(20),
     3                CAOF3,CANLF3(20),ALPTF3(20),CNFIT3(20),AI3,ALO3,
     4                CLI3,CLM3(20)
      COMMON /F4WORK/ RHO4,TMAX4,KSHAR4,CCLA4(20),XAC4(20),CMCO44(20),
     1                CNALF4,CNAAF4(20),CNLF4(20),CNNLF4(20),CNF4AT(20),
     2                XCPL4,XCPNL4,CMFL4(20),CMFNL4(20),CMF4AT(20),
     3                CAOF4,CANLF4(20),ALPTF4(20),CNFIT4(20),AI4,ALO4,
     4                CLI4,CLM4(20)
C
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      DIMENSION IROUT(2),RTRANS(7)
C
C***  ACCESS FIN GEOMETRY AND DEFINE CURRENT FIN GEOMETRY
C***  FOR TRANSFER IN LABELED COMMON GEOFC.  FIN CHARACTERISTICS
C***  ARE FOR SINGLE PANEL.  TEMPORARY FIX FOR DELTAD OF
C***  FINS 1 AND 2 (USE GEOMETRY COMPUTED VALUE IN THE FUTURE
C***  AND DELETE THESE LINES)
C
      DO 1040 I=1,16
       J=170+I
       GO TO (1000,1010,1020,1030),NFIN
C
 1000   GFINC(I)=GFIN1(J)
        IF(I .NE. 16) GO TO 1040
        GFINC(17) = FDATA1(363)
        GFINC(18) = FDATA1(112)
        GFINC(19) = FDATA1(102)
        GFINC(20) = GFIN1(187)
        GFINC(21) = FDATA1(52)
        GO TO 1040
 1010   GFINC(I)=GFIN2(J)
        IF(I .NE. 16) GO TO 1040
        GFINC(17) = FDATA2(363)
        GFINC(18) = FDATA2(112)
        GFINC(19) = FDATA2(102)
        GFINC(20) = GFIN2(187)
        GFINC(21) = FDATA2(52)
        GO TO 1040
 1020   GFINC(I)=GFIN3(J)
        IF(I .NE. 16) GO TO 1040
        GFINC(17) = FDATA3(363)
        GFINC(18) = FDATA3(112)
        GFINC(19) = FDATA3(102)
        GFINC(20) = GFIN3(187)
        GFINC(21) = FDATA3(52)
        GO TO 1040
 1030   GFINC(I)=GFIN4(J)
        IF(I .NE. 16) GO TO 1040
        GFINC(17) = FDATA4(363)
        GFINC(18) = FDATA4(112)
        GFINC(19) = FDATA4(102)
        GFINC(20) = GFIN4(187)
        GFINC(21) = FDATA4(52)
C
 1040 CONTINUE
        GFINC(16)=RAD*ATAN(GFINC(15)/5.85)
C
C***  COMPUTE NORMAL FORCE
C
      CALL FINCN(IM,NFIN)
C
C***  COMPUTE AXIAL FORCE
C
      CALL FINCA(IM,NFIN)
C
C***  COMPUTE PITCHING MOMENT
C
      CALL FINCM(IM,NFIN)
C
C***  DIFFERENTIATE CN AND CM CURVES
C
      NALP=NALPHA+0.5
      DO 1090 I=1,NALP
       GO TO (1050,1060,1070,1080),NFIN
 1050    CALL POLINT(ALPHA,CNF1,NALP,ALPHA(I),CNFINT,CNAF1(I))
         CALL POLINT(ALPHA,CMF1,NALP,ALPHA(I),CMFINT,CMAF1(I))
         GO TO 1090
 1060    CALL POLINT(ALPHA,CNF2,NALP,ALPHA(I),CNFINT,CNAF2(I))
         CALL POLINT(ALPHA,CMF2,NALP,ALPHA(I),CMFINT,CMAF2(I))
         GO TO 1090
 1070    CALL POLINT(ALPHA,CNF3,NALP,ALPHA(I),CNFINT,CNAF3(I))
         CALL POLINT(ALPHA,CMF3,NALP,ALPHA(I),CMFINT,CMAF3(I))
         GO TO 1090
 1080    CALL POLINT(ALPHA,CNF4,NALP,ALPHA(I),CNFINT,CNAF4(I))
         CALL POLINT(ALPHA,CMF4,NALP,ALPHA(I),CMFINT,CMAF4(I))
C
 1090 CONTINUE
C
C***  DIRECTIONAL DERIVATIVES (BLANK OUT FIELDS)
C
      DO 1100 I=1,20
         CYF1(I)=-UNUSED
         CLNF1(I)=-UNUSED
         CLLF1(I)=-UNUSED
         CYBF1(I)=-UNUSED
         CNBF1(I)=-UNUSED
         CLBF1(I)=-UNUSED
         CYF2(I)=-UNUSED
         CLNF2(I)=-UNUSED
         CLLF2(I)=-UNUSED
         CYBF2(I)=-UNUSED
         CNBF2(I)=-UNUSED
         CLBF2(I)=-UNUSED
         CYF3(I)=-UNUSED
         CLNF3(I)=-UNUSED
         CLLF3(I)=-UNUSED
         CYBF3(I)=-UNUSED
         CNBF3(I)=-UNUSED
         CLBF3(I)=-UNUSED
         CYF4(I)=-UNUSED
         CLNF4(I)=-UNUSED
         CLLF4(I)=-UNUSED
         CYBF4(I)=-UNUSED
         CNBF4(I)=-UNUSED
         CLBF4(I)=-UNUSED
 1100 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HYBSET(XX,RR,XO,LNOS,BR,NSHAPE,N1,N2,N,N3,N4,DRB)
C
C***  THIS ROUTINE SETS UP PARAMETERS REQUIRED FOR EXECUTION OF
C***  SUBROUTINES HYBGEO AND VANDYK
C
C  ROUTINE ADAPTED FROM NSWC AEROPREDICTION CODE
C  MODIFIED BY J. JENKINS, WL/FIGC
C
C***  INPUT PARAMETERS
C       XX     - ARRAY OF BODY XX OORDINATES, REFERED TO SHIFTED
C                ORIGIN
C       RR     - ARRAY OF BODY RR COORDINATES
C       LNOS   - (LNOSE/DMAX)
C       BR     - NOSE BLUNTNESS RATIO (BNOSE/DMAX)
C       N      - NUMBER OF LONGITUDINAL STATIONS
C
C***  OUTPUT VARIABLES
C       BR     - SET TO ZERO IF NOSE IS POINTED
C       N1     - NUMBER OF STATIONS FROM NOSE TIP TO END OF NOSE
C                SEGMENT
C       N2     - NUMBER OF STATIONS FROM NOSE TIP TO END OF CYLINDRICAL
C                BODY SEGMENT
C       N3     - EQUALS 1 FOR CONICAL TAIL
C              - EQUALS 2 FOR OGIVAL TAIL
C       N4     - EQUALS 0 FOR CONICAL NOSE
C              - EQUALS 1 FOR ALL OTHER NOSES
C       NSHAPE - EQUALS 1 FOR NOSE ALONE
C              - EQUALS 2 FOR NOSE + BODY
C              - EQUALS 3 FOR NOSE + TAIL
C              - EQUALS 4 FOR NOSE + BODY + TAIL
C       NTAIL  - EQUALS 1 FOR BOATTAIL
C              - EQUALS 2 FOR FLARE
C       DRB    - SLOPE OF MERIDIAN CURVE AT NOSE STATION NR. 1
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
      COMMON /ABODIN/ NX,X0,X(50),R(50),TNOSE,LNOSE,DNOSE,BNOSE,TRUNC,
     1                LCENTR,DCENTR,TAFT,LAFT,DAFT,POWER,DISCON(20),
     2                ADUM(748)
      DIMENSION XX(50),RR(50)
      LOGICAL TRUNC,FLAG
      REAL NX,LNOS,LNOSE,LCENTR,LAFT
C
C***  INITIALIZE
C
      N1=0
      N2=0
      NSHAPE=0
      IF(LNOSE.GT.UNUSED .AND. LCENTR.LE.UNUSED .AND. LAFT.LE.UNUSED)
     1 NSHAPE=1
      IF(LNOSE.GT.UNUSED .AND. LCENTR.GT.UNUSED .AND. LAFT.LE.UNUSED)
     1 NSHAPE=2
      IF(LNOSE.GT.UNUSED .AND. LCENTR.LE.UNUSED .AND. LAFT.GT.UNUSED)
     1 NSHAPE=3
      IF(LNOSE.GT.UNUSED .AND. LCENTR.GT.UNUSED .AND. LAFT.GT.UNUSED)
     1 NSHAPE=4
C
C***  COUNT STATIONS TO END OF NOSE SEGMENT
C
        I=1
 1010    CONTINUE
        IF(XX(I) .GE. (LNOS-XO-.00001)) GO TO 1020
          CALL LOOP(I,N,FLAG)
          GO TO 1030
C
 1020     FLAG=.FALSE.
 1030   CONTINUE
        IF(FLAG) GO TO 1010
        N1=I
        IF(NSHAPE .EQ. 1 .OR. NSHAPE .EQ. 3) GO TO 1080
C
C***  COUNT STATIONS TO END OF BODY SEGMENT
C
 1040     CONTINUE
          IF(ABS(RR(I)-RR(N1)) .GT. .000001) GO TO 1050
            CALL LOOP(I,N,FLAG)
            GO TO 1060
C
 1050       FLAG=.FALSE.
 1060     CONTINUE
          IF(FLAG) GO TO 1040
          N2=I-1
C
C***  INITIALIZE N3,N4
C
 1080   N3=0
        IF(TAFT .EQ. 0) N3=1
        IF(TAFT .EQ. 1) N3=2
        N4=1
        IF(TNOSE .EQ.0) N4=0
C
C***  COMPUTE SLOPE OF MERIDAN CURVE AT FIRST STATION
C
        IF(N1 .NE. 0) GO TO 1090
          DRB=0.
          GO TO 1110
C
 1090     IF(N1 .EQ. 2) GO TO 1100
            CALL FDP5(XX,RR,XX(1),DRB,N1,1)
            GO TO 1110
C
 1100       DRB=(RR(N1)-RR(1))/(XX(N1)-XX(1))
 1110 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE LOOP(I,IMAX,FLAG)
C
C***  THIS ROUTINE INCREMENTS THE LOOP INDEX AND SETS THE LOOP FLAG
C***  FOR A LOOP WHICH HAS A BRANCH OUTSIDE OF THE RANGE OF THE LOOP
C
C***  INPUT PARAMETERS
C       I=CURRENT VALUE OF LOOP INDEX
C       IMAX=UPPER LIMIT OF LOOP INDEX
C
C***  OUTPUT VARIABLES
C       I=UPDATED LOOP INDEX, I=I+1
C       FLAG=.TRUE. IF ( I.LE.IMAX)
C
      LOGICAL FLAG
      I=I+1
      IF(I.LE.IMAX) GO TO 1000
        FLAG=.FALSE.
        GO TO 1010
C
 1000   FLAG=.TRUE.
 1010 CONTINUE
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PRIF1
C
C***  SUBROUTINE TO PRINT THE RESULTS FOR FIN SET 1
C
      COMMON /FSET1/  FDATA(399)
C
      COMMON /GEOFS1/ GFIN(188)
C
      DIMENSION SSPAN(10),LMAXU(10),LFLATU(10),LMAXL(10),
     1          LFLATL(10),CHORD(10),THICKU(10),THICKL(10),
     2          SWEEP(10),STA(10),XLE(10),
     3          XCORD(50),MEAN(50),THICK(50),YUPPER(50),
     4          YLOWER(50),LER(10)
C
      REAL LER,LMAXU,LMAXL,LFLATU,LFLATL,NPANEL,MEAN
C
      EQUIVALENCE (FDATA(1),SECTYP),(FDATA(2),SSPAN(1)),
     1            (FDATA(12),LMAXU(1)),(FDATA(22),LFLATU(1)),
     2            (FDATA(32),LMAXL(1)),(FDATA(42),LFLATL(1)),
     3            (FDATA(52),CHORD(1)),(FDATA(62),THICKU(1)),
     4            (FDATA(72),THICKL(1)),(FDATA(82),SWEEP(1)),
     5            (FDATA(92),STA(1)),(FDATA(102),XLE(1)),
     6            (FDATA(112),NPANEL),(FDATA(113),XCORD(1)),
     7            (FDATA(163),MEAN(1)),(FDATA(213),THICK(1)),
     8            (FDATA(263),YUPPER(1)),(FDATA(313),YLOWER(1)),
     9            (FDATA(363),FINPHI),(FDATA(364),LER(1))
C
      DIMENSION SPLANF(10),CBAR(10),SWEPLE(10),SWEP25(10),
     1          SWEP50(10),SWEP75(10),SWEPTE(10),
     2          XMGCLE(10),XMGC25(10),
     3          XMGC50(10),XMGC75(10),XMGCTE(10),YMEANC(10),
     4          ASPCT(10),TAPER(10),TOVERC(10),XCENT(10)
C
      EQUIVALENCE (GFIN(1),SPLANF(1)),(GFIN(11),CBAR(1)),
     1            (GFIN(21),SWEPLE(1)),(GFIN(31),SWEP25(1)),
     2            (GFIN(41),SWEP50(1)),(GFIN(51),SWEP75(1)),
     3            (GFIN(61),SWEPTE(1)),(GFIN(71),XMGCLE(1)),
     4            (GFIN(81),XMGC25(1)),(GFIN(91),XMGC50(1)),
     5            (GFIN(101),XMGC75(1)),(GFIN(111),XMGCTE(1)),
     6            (GFIN(121),YMEANC(1)),(GFIN(131),ASPCT(1)),
     7            (GFIN(141),TAPER(1)),(GFIN(151),TOVERC(1)),
     8            (GFIN(161),XCENT(1)),(GFIN(171),FINAR),
     9            (GFIN(172),FINTPR),(GFIN(173),FINSPN),
     A            (GFIN(174),FINSP),(GFIN(175),FINWET),
     B            (GFIN(176),TCEFF),(GFIN(177),FINXGC),
     C            (GFIN(178),FINYGC),(GFIN(179),SWAVLE),
     D            (GFIN(180),SWAV25),(GFIN(181),SWAV50),
     E            (GFIN(182),SWAV75),(GFIN(183),SWAVTE),
     F            (GFIN(184),FINCBR),(GFIN(185),DELTAY),
     G            (GFIN(186),DELTAD),(GFIN(187),XCENF),(GFIN(188),XOVC)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      CHARACTER*4 IFT,ICM,IM,IIN,IUNIT
C
      DATA IFT/'  FT'/
      DATA ICM/'  CM'/
      DATA IM /'   M'/
      DATA IIN/'  IN'/
C
      IUNIT=IFT
      IF(LDIMCM)IUNIT=ICM
      IF(LDIMM)IUNIT=IM
      IF(LDIMIN)IUNIT=IIN
C
      ISET=1
C
      WRITE(6,1030)ISET
      WRITE(6,1040)
      WRITE(6,1050)
      WRITE(6,1060)
      IF(LDIMFT) WRITE(6,1082) IUNIT
      IF(LDIMIN) WRITE(6,1084)
      IF(LDIMM)  WRITE(6,1086)
      IF(LDIMCM) WRITE(6,1088)
C
      NSEG=1
C
C***  FIND LAST SPAN STATION
C
      DO 1000 I=2,10
          IF(SSPAN(I) .EQ. UNUSED .OR. SSPAN(I) .EQ. 0.)GO TO 1010
          NSEG=I-1
 1000 CONTINUE
C
 1010 CONTINUE
C
C***  PRINT RESULTS FOR EACH FIN SEGMENT
C
      DO 1020 ISEG=1,NSEG
         WRITE(6,1090)ISEG,SPLANF(ISEG),ASPCT(ISEG),TAPER(ISEG),
     1   SWEPLE(ISEG),SWEPTE(ISEG),CBAR(ISEG),TOVERC(ISEG)
 1020 CONTINUE
C
      WRITE(6,1100)FINSP,FINAR,FINTPR,SWAVLE,SWAVTE,FINCBR,TCEFF
C
 1030 FORMAT(29X,'FIN SET NUMBER ',I2)
 1040 FORMAT(26X,'(DATA FOR ONE PANEL ONLY)',/)
 1050 FORMAT(4X,'SEGMENT',3X,'PLAN',8X,'ASPECT',4X,'TAPER',5X,
     1 'L.E.',5X,'T.E.',4X,'M.A.C.',4X,'T/C')
 1060 FORMAT(4X,'NUMBER',4X,'AREA',8X,'RATIO',5X,'RATIO',4X,'SWEEP',
     1 4X,'SWEEP',4X,'CHORD',4X,'RATIO')
 1082 FORMAT(4X,A4,6X,'FT**2',27X,'DEG',6X,'DEG',7X,'FT')
 1084 FORMAT(4X,A4,6X,'IN**2',27X,'DEG',6X,'DEG',7X,'IN')
 1086 FORMAT(4X,A4,6X,' M**2',27X,'DEG',6X,'DEG',7X,' M')
 1088 FORMAT(4X,A4,6X,'CM**2',27X,'DEG',6X,'DEG',7X,'CM')
 1090 FORMAT(4X,1X,I2,2X,F10.4,4X,6F9.3)
 1100 FORMAT(4X, 'TOTAL',F10.4,4X,6F9.3)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SKINF(M,REN,LCFT,K,BLAYER,SWET,SREF,FORM,
     1    LAM3D,TUR3D,CDF)
C
C***  COMPUTES SKIN FRICTION DRAG USING VAN DRIEST METHOD II
C***  FOR TURBULENT FLOW AND BLASIUS FOR LAMINAR FLOW
C***  EMPIRICAL CORRELATIONS ARE USED FOR THE TRANSITION
C***  AND SURFACE ROUGHNESS CALCULATIONS
C***
C***  REFERENCES -
C***  (1) MDAC-WEST AERODYNAMIC HANDBOOK(M 8.080-CD) -- VAN DRIEST II
C***      TURBULENT FRICTION COEFFICIENT, FLAT INSULATED PLATE,
C***      INCLUDES PARTIALLY LAMINAR FLOW WITH NATURAL TRANSITION POINT
C***
C***  (2) USAF DATCOM -- EFFECT OF UNIFORMLY DISTRIBUTED SURFACE ROUGH-
C***      NESS (SECTION 4.1.5.1)
C***
C***  (3) FLUID-DYNAMIC DRAG(HOERNER) -- LAMINAR FRICTION COEFFICIENT,
C***      COMPRESSIBILITY
C***
C***  LIMITATIONS -
C***      MACH NO. MUST FALL BETWEEN 0.0-10.0
C***      REYNOLDS NO. MUST FALL BETWEEN 1E4-1E9
C***
C***  NOTE -  INPUT UNITS ON SWET AND SREF MUST BE CONSISTENT.
C***
C***   INPUTS
C***         M    - MACH NO.
C***         REN  - REYNOLDS NUMBER PER FOOT
C***         LCFT - CHARACTERISTIC LENGTH, FEET
C***         K    - ROUGHNESS HEIGHT, INCHES
C***        BLAYER- BOUNDARY LAYER TYPE
C***                0.=TURBULENT, 1.=NATURAL TRANSITIONING
C***         SWET - WETTED SURFACE AREA
C***         SREF - REFERENCE AREA
C***         FORM - SHAPE CORRECTION FACTOR
C***        LAM3D - 3-D LAMINAR FLOW CORRECTION FACTOR
C***        TUR3D - 3-D TURBULENT CORRECTION FACTOR
C***
C***   OUTPUT
C***         CDF  - SKIN FRICTION DRAG BASED ON SREF
C
      REAL K,LCFT,L,M,LAM3D
C
      DATA RTREF /1.E6/
C
C***  DEFINE REYNOLDS NUMBERS
C
      L=LCFT
      RNU=REN
      RX=RNU*L
C
C***  INITIALIZE
C
      CFLAM=0.
      CFTURB=0.
      IF(RNU .LE. 0.1 .OR. RX .LT. 0.1)GO TO 1060
C
C***  CHECK FOR FULLY TURBULENT FLOW
C***   (0.=TURBULENT,1.=NATURAL)
C
      IF(BLAYER .EQ. 0.)GO TO 1010
C
C     **********************************************
C     *  NATURAL TRANSITION - COMPUTE FLOW REGIONS *
C     *        (REF 1 - PG 2-129)                  *
C     **********************************************
C
      RTRAN=RTREF*EXP(.22*M)
      XTRAN=RTRAN/RNU
      A=.036-.00128*M-.00072*M**2
      IF(M .GT. 3.) A=.02568
      IF(M .LT. 1.) A=.034
      RLAM=RTRAN*(1.-(.67/A)**1.25/RTRAN**.375)
      XLAM=RLAM/RNU
      XTURB= L-XTRAN
      DXTRAN=XTRAN-XLAM
      XPTURB=L-XLAM
C
C     ************************************************
C     *  COMPUTE LAMINAR FRICTION COEFFICIENT        *
C     *    (REF 3 - BLASIUS-EQUA 23, PG 2-4)         *
C     *    (REF 3 - COMPRESSIBILITY-EQUA 12, PG 17-4)*
C     ************************************************
C
      CFLAMI=1.328/SQRT(RX)
      CFLAM=CFLAMI/(1.+.045*M**2)**.25
C
C***  FULLY LAMINAR FLOW
C
      IF(L.GT.XLAM) GO TO 1000
      CFTURB=0.
      GO TO 1060
C
C***  PARTIAL TRANSITION
C
 1000 CONTINUE
      IF(L.GT.XTRAN) GO TO 1010
         XTURB=0.
         DXTRAN=L-XLAM
C
C     ********************************************
C     *  COMPUTE TURBULENT FRICTION COEFFICIENT  *
C     ********************************************
C
 1010 CONTINUE
      IF(BLAYER .EQ. 1.)GO TO 1020
         XLAM=0.0
         XPTURB=L
         XTURB=L
         DXTRAN=0.0
         CFLAM=0.
 1020 CONTINUE
C
C***  ADMISSABLE ROUGHNESS HEIGHT
C***  (REF (2) - FIGURE 4.1.5.1-27)
C
      IF(K.EQ.0.) GO TO 1030
         A=3.60679+.2018*M+.12045*M**2
         AK=12.*L/EXP((ALOG(RX)-A)/1.0483)
         IF(K.GE.AK) RX=EXP(A+1.0483*ALOG(12.*L/K))
C
C***  VAN DRIEST II (REF 1 - PG 2-130)
C
 1030 CONTINUE
      E=.2*M**2
      TWTD=1.+.89*E
      A=E/TWTD
      B=-1.+(1.+E)/TWTD
      AL=(2.*A-B)/SQRT(4.*A+B*B)
      BE=B/SQRT(4.*A+B*B)
      C=0.5*(1.+2.*.76)*ALOG10(TWTD)
      D=.242*(ASIN(AL)+ASIN(BE))/SQRT(E)
C
C ... USING SCHONHERR AS FIRST APPROXIMATION
C
      CFI=.455/(ALOG10(RX))**2.58
C
C ... ITERATE UNTIL CONVERGENCE
C
 1040 CONTINUE
         CF=(D/(ALOG10(CFI*RX)-C))**2
         ERR=CF-CFI
         IF(ABS(ERR).LT.1.E-5) GO TO 1050
         CFI=CFI+ERR/2.0
      GO TO 1040
C
C     ********************************************
C     *  COMPUTE SKIN FRICTION DRAG COEFFICIENT  *
C     ********************************************
C
 1050 CONTINUE
      CFTURB=CF*(XTURB+DXTRAN)/L
      CFLAM=CFLAM*XLAM/L
C
C***  TOTAL CF
C
 1060 CONTINUE
      CFTOT=LAM3D*CFLAM+TUR3D*CFTURB
C
C***  TOTAL CDF BASED ON REFERENCE AREA
C
      CDF=CFTOT*FORM*SWET/SREF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE TOHOLL(VALUE,NDEC,N,IHOLL)
C
C***  CONVERT A REAL NUMBER TO HOLLERITH
C
C***  INPUTS
C
C  VALUE -- REAL VALUE OF THE NUMBER
C   NDEC -- NUMBER OF DECIMAL PLACES TO BE RETAINED
C      N -- DIMENSION OF IHOLL ARRAY
C
C***  OUTPUT
C
C   IHOLL-- ARRAY FOR THE HOLLERITH RESULT
C           (RESULTS PUT IN LARGEST INDICES OF ARRAY)
C
      DIMENSION IHOLL(N),INUM(10)
      CHARACTER*4 INUM,IPOINT,IMINUS,IBLANK,ISTAR,IHOLL
      DATA INUM /'1   ','2   ','3   ','4   ','5   ','6   ',
     1           '7   ','8   ','9   ','0   '/
      DATA IPOINT /'.   '/
      DATA IMINUS /'-   '/
      DATA IBLANK /'    '/
      DATA ISTAR /'*   '/
C
C ... BLANK IHOLL ARRAY
C
      DO 1000 I=1,N
         IHOLL(I)=IBLANK
 1000 CONTINUE
C
C ... ROUND THE NUMBER TO NDEC DECIMAL DIGITS
C
      V=ABS(VALUE)*10**NDEC
C
C ... NUMBER OF DIGITS TO SEARCH + DECIMAL POINT
C
      NDIGTS=N-1
      IF(V .NE. 0.)NDIGTS=AINT(ALOG10(V))+1.5
      IF(NDIGTS .GT. N)NDIGTS=N
      IV=V+0.5
      IOFF=0
C
C ... LOOP ON NUMBER DIGITS
C
C  REV 3/99 MODIFICATION TO ALLOW <1% THICKNESS AIRFOIL 
C
      IF(NDIGTS.EQ.1) NDIGTS=2
      DO 1020 I=1,NDIGTS
         INDEX=N-I+1
         IF(I-1 .EQ. NDEC)IHOLL(INDEX)=IPOINT
         IF(I-1 .EQ. NDEC)IOFF=1
C
C ... EXTRACT DIGIT
C
         IDIGIT=10.*(FLOAT(IV)/10.**I-AINT(FLOAT(IV)/10.**I))+0.01
C
C ... FIND MATCH AND SET VALUE
C
         INDEX=N-I+1-IOFF
         IF(INDEX .LT. 1)INDEX=1
         IF(INDEX .EQ. 1 .AND. I .NE. NDIGTS)IHOLL(INDEX)=ISTAR
         IF(INDEX .EQ. 1 .AND. I .NE. NDIGTS)GO TO 1030
C
         DO 1010 J=1,10
            IF(J .LT. 10 .AND. IDIGIT .EQ. J)IHOLL(INDEX)=INUM(J)
            IF(J .EQ. 10 .AND. IDIGIT .EQ. 0)IHOLL(INDEX)=INUM(J)
 1010    CONTINUE
 1020 CONTINUE
C
C ... INSERT SIGN
C
      INDEX=N-NDIGTS-IOFF
      IF(VALUE .LT. 0.)IHOLL(INDEX)=IMINUS
C
 1030 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE BDCNV(ALPHA,CDC,ETA,SPLAN,SREF,CNVIS)
C
C***  SUBROUTINE TO COMPUTE THE VISCOUS NORMAL FORCE FOR BODIES
C***  METHOD OF ALLEN AND PERKINS
C
C***  INPUTS
C
C  ALPHA -- ANGLE OF ATTACK, DEGREES
C    CDC -- CROSS FLOW DRAG COEFFICIENT
C    ETA -- CROSS FLOW DRAG PROPORTIONALITY FACTOR
C  SPLAN -- PLANFORM AREA, FEET SQUARED
C   SREF -- REFERENCE AREA, FEET SQUARED
C
C***  OUTPUT
C
C  CNVIS -- VISCOUS NORMAL FORCE COEFFICIENT AT ALPHA
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      SINALP=SIN(ALPHA/RAD)
      CNVIS=CDC*ETA*SPLAN*SINALP*ABS(SINALP)/SREF
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CLOCD(ALPHA,CN,CA,CL,CD,CLCD)
C
C***  SUBROUTINE TO COMPUTE THE LIFT, DRAG AND LIFT/DRAG
C***  COEFFICIENTS FROM THE NORMAL FORCE AND AXIAL FORCE
C***  COEFFICIENTS
C
C***  INPUTS
C
C  ALPHA -- ANGLE OF ATTACK, DEGREES
C     CN -- NORMAL FORCE COEFFICIENT
C     CA -- AXIAL FORCE COEFFICIENT
C
C***  OUTPUTS
C
C     CL -- LIFT COEFFICIENT
C     CD -- DRAG COEFFICIENT
C   CLCD -- LIFT DIVIDED BY DRAG COEFFICIENT
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      CL=UNUSED
      CD=UNUSED
      CLCD=1./UNUSED
C
      IF(ALPHA .EQ. UNUSED)GO TO 1000
      IF(CN .EQ. UNUSED .OR. CA .EQ. UNUSED)GO TO 1000
C
      CL=CN*COS(ALPHA/RAD)-CA*SIN(ALPHA/RAD)
      CD=CA*COS(ALPHA/RAD)+CN*SIN(ALPHA/RAD)
C
      IF(CD .NE. 0.)CLCD=CL/CD
      IF(CD .EQ. 0.)CLCD=1./UNUSED
C
 1000 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE CYPAXI(BET,CYI,CLNI)
C
C***********************************************************************
C
C     THIS SUBROUTINE CALCULATES INLET SIDE FORCE COEFFICIENT AND
C     CENTER OF PRESSURE IN THE INLET COORDINATE SYSTEM FOR AN AXISYM-
C     METRIC INLET.  THIS SUBROUTINE CALCULATES AERODYNAMICS AT ONE
C     SET OF FLIGHT CONDITIONS.
C
C***********************************************************************
C
C  WRITTEN BY M. MOORE, MCDONNELL DOUGLAS
C
      COMMON /INLETN/ NIN,INTYPE,XINLT,XDIV,HDIV,LDIV,PHI(20),
     1                XI(5),HI(5),WI(5),ICOVER,RAMANG,IAD,MFR(20)
      COMMON /ILTGEO/ LENGTH(5),LLNGTH(5),ALPEFF(5),SI(5),
     1                CRXLEN(5),DEQI(5),XMIDI(5),XMIDD(3),
     2                XD(3),HD(3),WD(3),DEQD(3),
     3                RARC(5),DLEN(3),KWA(20),KWB(20),
     4                RA2(20),RB2(20),AREAI(5),AREAD(3)
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHIROL,NMACH,MACH(20),
     1                ALT(20),REN(20),FLDUM(60)
      COMMON /REFQN/  SREF,LREF,BREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
      COMMON /CONST/  PI,RAD,UNUSED,KAND
      COMMON /POTENT/ CNP(20),CYP(20),CMP(20),CLNP(20)
      COMMON / MOMEN/ CNMOM(20),CYMOM(20)
      COMMON /LINEAR/ ARA,ARB,CNLIN(20),CMLIN(20),
     1                CYLIN(20),CLNLIN(20)
      COMMON /CFFLOW/ CNCF(20),CYCF(20),
     1                CMCF(20),CLNCF(20)
      COMMON /ILTVSC/ THETAI(5,20),PHIR(20),CRXIWD(5,20),
     1                CRXIHT(5,20),CNNIZP(5,20),
     2                CNNIZN(5,20),CNNIYP(5,20),
     3                CNNIYN(5,20),PANILN(5,5,20),
     4                CNCIRN,FRI,RARX(3),
     5                DLCNAP(3,20),DLCNAN(3,20),
     6                DLCYAP(3,20),DLCYAN(3,20)
      COMMON /DIVVSC/ THETAD(5,20),CRXDWD(3,20),
     1                CRXDHT(3,20),CNNDZP(3,20),
     2                CNNDZN(3,20),CNNDYP(3,20),
     3                CNNDYN(3,20),PANDLN(5,20),FRD
      COMMON /BODVSC/ DLCNBP(5,20),DLCNBN(5,20),
     1                DLCYBP(5,20),DLCYBN(5,20),FRB
C
      REAL NIN,INTYPE,LENGTH,LLNGTH,LREF,LDIV,MACH,KWA,KWB
      REAL NALPHA,NMACH
      LOGICAL ICOVER
C
      DIMENSION DCYI(4),DCLNI(4)
C
      IF (.NOT.ICOVER) THEN
        WII=2.*LENGTH(1)*TAN(RAMANG/RAD)
        DCYI(1)=-(PI*BET)/(2.*RAD*SREF)*(WII)**2
        DCLNI(1)=((PI*BET)/(6.*RAD*BREF*SREF))*(2.*WII**2)*LENGTH(1)
      ELSE
        DCYI(1)=-((PI*BET)/(2.*RAD*SREF))*(DEQI(2)**2-DEQI(1)**2)
        DCLNI(1)=((PI*BET)/(6.*RAD*BREF*SREF))*(2.*DEQI(2)**2
     &            -DEQI(2)*DEQI(1)-DEQI(1)**2)*LENGTH(1)
      ENDIF
      DO 10 J=2,4
        DCYI(J)=-(PI*BET/(2.*RAD*SREF))*(DEQI(J+1)**2-DEQI(J)**2)
        TCLNI=((PI*BET)/(6.*RAD*BREF*SREF))*(2.*DEQI(J+1)**2
     &        -DEQI(J+1)*DEQI(J)-DEQI(J)**2)*LENGTH(J)
        IF(DCYI(J).GT.-0.00001)THEN
          DCYI(J)=0.0
          DCLNI(J)=0.0
        ELSE
          TCYICP=TCLNI*BREF/DCYI(J)
          DCYICP=-XI(J)+TCYICP
          DCLNI(J)=DCYI(J)*DCYICP/BREF
        ENDIF
   10   CONTINUE
      CYI=0.0
      CLNI=0.0
      DO 20 J=1,4
        CYI=CYI+DCYI(J)
        CLNI=CLNI+DCLNI(J)
   20 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE F4GEOM
C
C***  SUBROUTINE TO COMPUTE THE GEOMETRIC CHARACTERISTICS OF A
C***  FIN
C
C  WRITTEN BY S. STOY, MCDONNELL DOUGLAS
C
      COMMON /FSET4/  FDATA(399)
C
      COMMON /GEOFS4/ GFIN(188)
C
      DIMENSION SSPAN(10),LMAXU(10),LFLATU(10),LMAXL(10),
     1          LFLATL(10),CHORD(10),THICKU(10),THICKL(10),
     2          SWEEP(10),STA(10),XLE(10),
     3          XCORD(50),MEAN(50),THICK(50),YUPPER(50),
     4          YLOWER(50),LER(10)
C
      REAL LER,LMAXU,LMAXL,LFLATU,LFLATL,NPANEL,MEAN
C
      EQUIVALENCE (FDATA(1),SECTYP),(FDATA(2),SSPAN(1)),
     1            (FDATA(12),LMAXU(1)),(FDATA(22),LFLATU(1)),
     2            (FDATA(32),LMAXL(1)),(FDATA(42),LFLATL(1)),
     3            (FDATA(52),CHORD(1)),(FDATA(62),THICKU(1)),
     4            (FDATA(72),THICKL(1)),(FDATA(82),SWEEP(1)),
     5            (FDATA(92),STA(1)),(FDATA(102),XLE(1)),
     6            (FDATA(112),NPANEL),(FDATA(113),XCORD(1)),
     7            (FDATA(163),MEAN(1)),(FDATA(213),THICK(1)),
     8            (FDATA(263),YUPPER(1)),(FDATA(313),YLOWER(1)),
     9            (FDATA(363),FINPHI),(FDATA(364),LER(1))
C
      DIMENSION SPLANF(10),CBAR(10),SWEPLE(10),SWEP25(10),
     1          SWEP50(10),SWEP75(10),SWEPTE(10),
     2          XMGCLE(10),XMGC25(10),
     3          XMGC50(10),XMGC75(10),XMGCTE(10),YMEANC(10),
     4          ASPCT(10),TAPER(10),TOVERC(10),XCENT(10)
C
      EQUIVALENCE (GFIN(1),SPLANF(1)),(GFIN(11),CBAR(1)),
     1            (GFIN(21),SWEPLE(1)),(GFIN(31),SWEP25(1)),
     2            (GFIN(41),SWEP50(1)),(GFIN(51),SWEP75(1)),
     3            (GFIN(61),SWEPTE(1)),(GFIN(71),XMGCLE(1)),
     4            (GFIN(81),XMGC25(1)),(GFIN(91),XMGC50(1)),
     5            (GFIN(101),XMGC75(1)),(GFIN(111),XMGCTE(1)),
     6            (GFIN(121),YMEANC(1)),(GFIN(131),ASPCT(1)),
     7            (GFIN(141),TAPER(1)),(GFIN(151),TOVERC(1)),
     8            (GFIN(161),XCENT(1)),(GFIN(171),FINAR),
     9            (GFIN(172),FINTPR),(GFIN(173),FINSPN),
     A            (GFIN(174),FINSP),(GFIN(175),FINWET),
     B            (GFIN(176),TCEFF),(GFIN(177),FINXGC),
     C            (GFIN(178),FINYGC),(GFIN(179),SWAVLE),
     D            (GFIN(180),SWAV25),(GFIN(181),SWAV50),
     E            (GFIN(182),SWAV75),(GFIN(183),SWAVTE),
     F            (GFIN(184),FINCBR),(GFIN(185),DELTAY),
     G            (GFIN(186),DELTAD),(GFIN(187),XCENF),(GFIN(188),XOVC)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
C***  CALCULATE CHARACTERISTICS USING COMMON FUNCTIONS
C
C***  DO ONLY FOR SEGMENTS WHERE SPAN STATIONS ARE NOT ZERO OR
C***  UNUSED
C
C***  SET DEFAULTS
C
      IF(SECTYP.EQ.UNUSED .OR. SECTYP.LT.0. .OR. SECTYP.GT.3.)SECTYP=0.
C
      IF(NPANEL .LE. UNUSED)NPANEL=4.
      IF(FINPHI .EQ. UNUSED)FINPHI=0.
C
      DO 1000 I=1,10
         IF(I .GT. 1 .AND. SSPAN(I) .LE. UNUSED)GO TO 1010
         IF(STA(I) .EQ. UNUSED)STA(I)=1.
         IF(THICKU(I) .EQ. UNUSED)THICKU(I)=0.025
         IF(THICKL(I) .EQ. UNUSED)THICKL(I)=THICKU(I)
         IF(NPANEL .EQ. UNUSED)NPANEL=2.
         IF(LMAXU(I) .EQ. UNUSED)LMAXU(I)=0.5
         IF(LMAXL(I) .EQ. UNUSED)LMAXL(I)=LMAXU(I)
         IF(LFLATU(I) .EQ. UNUSED)LFLATU(I)=0.
         IF(LFLATL(I) .EQ. UNUSED)LFLATL(I)=LFLATU(I)
         IF(LER(I) .EQ. UNUSED)LER(I)=0.
C
 1000 CONTINUE
C
C
 1010 CONTINUE
      FINSP=0.0
      FINSPN=0.0
      FINAR=0.0
      FINTPR=0.0
      FINWET=0.0
      SWAVLE=0.0
      SWAV25=0.0
      SWAV50=0.0
      SWAV75=0.0
      SWAVTE=0.0
      XCENF=0.0
      FINXGC=0.0
      FINYGC=0.0
      FINCBR=0.0
C
      DO 1020 I=1,9
C
         II=I
C
         TOVERC(I)=THICKU(I)+THICKL(I)
C
         IF(SSPAN(I+1) .EQ. UNUSED .OR. SSPAN(I+1) .EQ. 0.)GO TO 1030
C
            SPAN=2.*(SSPAN(I+1)-SSPAN(I))
C
            TAPER(I)=CHORD(I+1)/CHORD(I)
C
            IF(SWEEP(I) .EQ. UNUSED)SWEEP(I)=ATAN((XLE(I+1)-
     1         XLE(I) + CHORD(I+1) -CHORD(I) )/(SPAN/2.))*RAD
C
            ASPCT(I)=ASPECT(SPAN,CHORD(I),TAPER(I))/2.
C
            SWEPLE(I)=SWEEPN(STA(I),SWEEP(I),0.00,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEP25(I)=SWEEPN(STA(I),SWEEP(I),0.25,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEP50(I)=SWEEPN(STA(I),SWEEP(I),0.50,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEP75(I)=SWEEPN(STA(I),SWEEP(I),0.75,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SWEPTE(I)=SWEEPN(STA(I),SWEEP(I),1.00,SPAN,CHORD(I),
     1                       TAPER(I))
C
            SPLANF(I)=FINPLN(SPAN,CHORD(I),TAPER(I))/2.
C
            CBAR(I)=FINMGC(CHORD(I),TAPER(I))
C
            YMEANC(I)=YMGC(SPAN,CHORD(I),TAPER(I))
C
            IF(I .GT. 1 .AND. XLE(I) .EQ. UNUSED)XLE(I)=XLE(I-1)+
     1        (SSPAN(I)-SSPAN(I-1))*TAN(SWEPLE(I-1)/RAD)
C
            XMGCLE(I)=XLE(I)-XLE(1)+YMEANC(I)*TAN(SWEPLE(I)/RAD)
C
            XMGC25(I)=XMGCLE(I)+0.25*CBAR(I)
C
            XMGC50(I)=XMGCLE(I)+0.50*CBAR(I)
C
            XMGC75(I)=XMGCLE(I)+0.75*CBAR(I)
C
            XMGCTE(I)=XMGCLE(I)+CBAR(I)
C
            YMEANC(I)=YMEANC(I)+SSPAN(I)
C
            XCENT(I)=XLE(I)-XLE(1)+FINCEN(SPAN,SWEPLE(I),CHORD(I),
     1               TAPER(I))
C
            FINSPN=FINSPN+SPAN/2.
C
            FINSP=FINSP+SPLANF(I)
C
 1020 CONTINUE
C
 1030 CONTINUE
C
C***  TOTAL FIN RESULTS
C
      FINAR=(2.*FINSPN)**2/(2.*FINSP)/2.
C
      FINTPR=CHORD(II)/CHORD(1)
C
      FINWET=2.*FINSP
C
C
      DO 1040 I=1,II
C
         SWAVLE=SWAVLE+SWEPLE(I)*SPLANF(I)/FINSP
C
         SWAV25=SWAV25+SWEP25(I)*SPLANF(I)/FINSP
C
         SWAV50=SWAV50+SWEP50(I)*SPLANF(I)/FINSP
C
         SWAV75=SWAV75+SWEP75(I)*SPLANF(I)/FINSP
C
         SWAVTE=SWAVTE+SWEPTE(I)*SPLANF(I)/FINSP
C
         FINXGC=FINXGC+XMGCLE(I)*SPLANF(I)/FINSP
C
         FINYGC=FINYGC+YMEANC(I)*SPLANF(I)/FINSP
C
         FINCBR=FINCBR+CBAR(I)*SPLANF(I)/FINSP
C
         XCENF=XCENF+XCENT(I)*SPLANF(I)/FINSP
C
 1040 CONTINUE
C
      TCEFF=TCEFFT(II,SSPAN,CHORD,TOVERC,FINSP)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE FINXCA(NSET,IM,GFIN1,FDATA1,F1WK,CFIN1)
C
C***  FIN SET 1 AXIAL FORCE EXECUTIVE
C
      COMMON /THERY/  LSOSE,PRESUR,LHYBRD,LHYPER
      LOGICAL LSOSE,PRESUR,LHYBRD,FAIL
C
      COMMON /REFQN/  SREF,LREF,LATREF,ROUGH,XCG,ZCG,SCALE,BLAYER,RHR
C
      REAL LREF,LATREF
C
      COMMON /FLC/    NALPHA,ALPHA(20),BETA,PHI,NMACH,MACH(20),
     1                ALT(20),REN(20),VINF(20),TINF(20),PINF(20)
      COMMON /CONST/  PI,RAD,UNUSED,KAND
C
      COMMON /PARTF/ PARTS(19)
      LOGICAL PARTS
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      REAL NALPHA,NMACH,MACH
C
      DIMENSION GFIN1(188),FDATA1(389),F1WK(270),CFIN1(220)
      DIMENSION CANL(20),IROUT(2)
C
      CAPR=0.0
      CAWT=0.0
      CAWS=0.0
      CALE=0.0
      NPCHRD=2
      NPSPAN=2
      FAIL=.FALSE.
C
C***  SKIN FRICTION
C
      CALL SKINF(MACH(IM),REN(IM),GFIN1(184),ROUGH,BLAYER,
     1           GFIN1(175),SREF,1.,1.,1.,CAFRIC)
C
C***  SUBSONIC PRESSURE DRAG
C
      IF(MACH(IM) .LT. 1.4)CALL FINCAP(MACH(IM),GFIN1(188),
     1      F1WK(2),CAFRIC,CAPR)
C
C***  TRANSONIC WAVE DRAG
C
      IF(MACH(IM) .LT. 1.05)CALL FCAWT(MACH(IM),2.*GFIN1(174),
     1   F1WK(2),2.*GFIN1(171),GFIN1(180),SREF,CAWT)
C
C***  BASE DRAG INCREMENT (ALL SPEEDS)
C
C ... FIND LAST SECTION STATION
C
      DO 1000 I=1,50
         IF(FDATA1(I+112) .EQ. UNUSED)GO TO 1010
         NPCHRD=I
 1000 CONTINUE
C
 1010 CONTINUE
C
C ... COMPUTE FIN BASE AREA
C
      SBASE=2.*FDATA1(NPCHRD+212)*GFIN1(184)*GFIN1(173)
C
      CALL FINCAB(MACH(IM),SBASE,SREF,CABASE)
C
C***  COMPUTE L.E. BLUNTNESS AND WAVE DRAG USING POTENTIAL FLOW
C***  IF THE AIRFOIL IS DIAMOND, DOUBLE WEDGE OR CIRCULAR ARC
C***  IF THE AIRFOIL TYPE IS NACA OR USER DEFINED USE DATCOM
C
      SECTYP=FDATA1(1)
      IF(MACH(IM) .GE. 1.4 .AND. (SECTYP .EQ. 0. .OR. SECTYP .EQ. 2.))
     1 GO TO 1040
C
C***  HERE FOR TRANSONIC SPEEDS, OR NACA OR USER DEFINED SHAPES
C
C ... LEADING EDGE DRAG
C
C   REV 3/99 CORRECT FIN SPAN FOR LE DRAG CALCULATION, GFIN1(173)
C
 1020 CALL FCALE(MACH(IM),GFIN1(179),F1WK(1),GFIN1(173),SREF,CALE)
C
      IF(FAIL)GO TO 1030
C
      IF(MACH(IM) .GT. 0.8 .AND. (SECTYP .EQ. 0. .OR. SECTYP .EQ. 2.))
     1 GO TO 1040
C
C ... SUPERSONIC WAVE DRAG
C
 1030 IF(MACH(IM) .GE. 1.05 .OR. FAIL)CALL FCAWS(MACH(IM),F1WK(3),
     1   GFIN1(176),GFIN1(174),SREF,GFIN1(179),CAWS)
      IF(MACH(IM) .GE. 1.05 .AND. FAIL)CAWT=0.
      GO TO 1080
C
C***  HERE FOR POTENTIAL FLOW ANALYSIS (SUPERSONIC SPEEDS)
C
 1040 CONTINUE
C
C ... LAST SEMI-SPAN STATION INPUT
C
      DO 1050 I=2,10
         IF(FDATA1(I+51) .EQ. UNUSED)GO TO 1060
         NPSPAN=I
 1050 CONTINUE
C
 1060 CONTINUE
C
      CR=FDATA1(52)
      TAPER=GFIN1(172)
      IF(TAPER .EQ. 0.)TAPER=0.001
      CT=CR*TAPER
      B=2.*GFIN1(173)
      CR1=CR*FDATA1(12)
      CR2=CR-CR1-CR*FDATA1(22)
      CT1=CR1*TAPER
      CT2=CR2*TAPER
      TRC=2.*FDATA1(62)
      TTC=2.*FDATA1(NPSPAN+61)
      IF(TTC .LE. UNUSED)TTC=0.001
      RLER=FDATA1(364)
      RLET=FDATA1(NPSPAN+363)
      RTER=FDATA1(NPCHRD+212)*GFIN1(184)/2.
      RTET=RTER
      IF(RLER .GE. TRC*CR/2.)RLER=0.99*TRC*CR/2.
      IF(RLET .GE. TTC*CT/2.)RLET=0.99*TTC*CT/2.
      IF(RTER .GE. TRC*CR/2.)RTER=0.99*TRC*CR/2.
      IF(RTET .GE. TTC*CT/2.)RTET=0.99*TTC*CT/2.
      SWEEP=GFIN1(179)
      IF(ABS(SWEEP) .LE. UNUSED)SWEEP=1.0
C
      IF(MACH(IM) .LT. 1.05)GO TO 1070
C
      CALL FCAWPF(CR, CT, B, CR1, CR2, CT1, CT2, RLER, RLET,
     1            RTER, RTET, TRC, TTC, SWEEP, MACH(IM), SREF,
     2            SECTYP, PRESUR, NSET, CAWP, CALE, FAIL)
      IF(FAIL .AND. PARTS(18))WRITE(6,1120)
      IF(FAIL)GO TO 1020
C
      CAWS=CAWP-CALE
C
      GO TO 1080
C
 1070 CALL FCAWPF(CR, CT, B, CR1, CR2, CT1, CT2, RLER, RLET,
     1            RTER, RTET, TRC, TTC, SWEEP, 1.05, SREF,
     2            SECTYP, PRESUR, NSET, CAWP, CALET, FAIL)
      IF(FAIL .AND. PARTS(18))WRITE(6,1120)
      IF(FAIL)GO TO 1020
C
      CAWT=(CAWP-CALET)*4.*(MACH(IM)-0.8)
C
C***  AXIAL FORCE AT ALPHA = 0.0
C
 1080 CAO=CAFRIC+CAPR+CAWT+CAWS+CABASE+CALE
C
      F1WK(207)=CAO
C
C***  AXIAL FORCE AT ANGLE OF ATTACK
C
      NALP=NALPHA+0.5
C
      NFINS=FDATA1(112)+.5
C
      RADLE=F1WK(1)
C
      DO 1090 I=1,NALP
         CALL FCALP(NALP,ALPHA,F1WK(125),CAO,2.*GFIN1(174),
     1   FDATA1(112),2.*GFIN1(171),SREF,MACH(IM),REN(IM),RADLE,
     2   GFIN1(179),GFIN1(172),ALPHA(I),CANL(I))
         F1WK(I+207)=CANL(I)/2.
         CANL(I)=CANL(I)/2.
 1090 CONTINUE
C
      DO 1110 I=1,NALP
         DO 1100 N=1,NFINS
            PHIF=FDATA1(N+381)
            AEQ=ABS(ALPHA(I)*SIN(PHIF/RAD))
            CALL LNTRP(ALPHA,CANL,NALP,AEQ,CAALP)
            CFIN1(I+40)=CFIN1(I+40)+CAO*COS(ALPHA(I)/RAD)+CAALP
 1100    CONTINUE
 1110 CONTINUE
C
      IF(PARTS(NSET+6))CALL FAPART(IM,NSET,NFINS,CAFRIC,
     1 CAPR,CAWT,CAWS,CALE,CABASE,CAO,CANL,CFIN1(41))
C
 1120 FORMAT(4X,'FIN PRESSURE DIST. CANNOT BE CALCULATED',
     1 ' DATCOM METHOD USED FOR WAVE DRAG')
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE HYPERS(ALPHA,AM,X,R,NPTS,SREF,DREF,XCG,IPRINT,
     1 CA,CN,CM)
C
C***  COMPUTE NEWTONIAN CA, CN, AND CM AT HYPERSONIC SPEEDS
C***  METHOD FROM NASA TN D-176
C
C  ROUTINE ADAPTED FROM DIGITAL DATCOM
C  ORIGINAL ROUTINE WRITTEN BY J.E. WILLIAMS, MCDONNELL DOUGLAS
C  MODIFIED BY W. BLAKE, WL/FIGC
C
C***  INPUTS
C
C  ALPHA - ANGLE OF ATTACK, DEG.
C     AM - FREE STREAM MACH NUMBER
C      X - ARRAY OF BODY LONGITUDINAL STATIONS
C      R - ARRAY OF BODY RADII
C   NPTS - NUMBER OF X AND R COORDINATE POINTS
C   SREF - REFERENCE AREA
C   DREF - REFERENCE LENGTH
C    XCG - LOCATION OF MOMENT REFERENCE CENTER FROM NOSE
C IPRINT - PRESSURE DISTRIBUTION PRINT FLAG
C          0=DO NOT PRINT PRESSURE DISTRIBUTIONS
C          1=PRINT PRESSURE DISTRIBUTION DATA
C          2=PRINT BODY COORDINATES TO TAPE UNIT 3
C
C***  OUTPUTS
C
C     CA - AXIAL FORCE (LESS FRICTION) BASED ON SREF
C     CN - NORMAL FORCE BASED ON SREF
C     CM - PITCHING MOMENT ABOUT XCG, BASED ON SREF AND DREF
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      DIMENSION X(NPTS),R(NPTS),CNN(101),CAA(101),CMM(101)
      DIMENSION XX(101),RR(101),DRDX(101),CP(7),PHI(7),IROUT(2)
C
      DATA GAM / 1.4 /
      DATA PHI / 0., 30., 60., 90., 120., 150., 180. /
C
C***  SET DELTA-X AND BODY LENGTH
C
      DX=(X(NPTS)-X(1))/100.
      AL=X(NPTS)-X(1)
C
C***  GET MAXIMUM RADIUS
C
      RMAX=R(1)
      DO 1000 I=2,NPTS
         IF(R(I) .GT. RMAX)RMAX=R(I)
 1000 CONTINUE
      DMAX=2.*RMAX
C
C***  COMPUTE RADII AND INTEGRAL FACTORS ALONG THE BODY
C
      DO 1010 I=1,101
         XX(I)=X(1)+FLOAT(I-1)*DX
 1010 CONTINUE
C
C ... INTERPOLATE FOR RADIUS AND DIFFERENCE FOR BODY SLOPE
C
      DO 1015 I=1,101
         CALL LNTRP(X,R,NPTS,XX(I),RR(I))
         IF(I.GT.2) DRDX(I-1)=(RR(I)-RR(I-2))/(XX(I)-XX(I-2))
 1015 CONTINUE
         DRDX(1)=  (RR(2) - RR(1))  /(XX(2) - XX(1))
         DRDX(101)=(RR(101)-RR(100))/(XX(101)-XX(100))
C
C ... STAGNATION PRESSURE COEFFICIENT
C
      AK=(GAM+3.)/(GAM+1.)*(1.-2./(GAM+3.)/AM**2)
C
C ... NOW GET INTEGRAL FACTORS
C
      DO 1030 I=1,101
         THETA=ATAN(DRDX(I))*RAD
         CALL NEWTON(THETA,ABS(ALPHA),PHI1,CAF,CNF,CMF)
         CNN(I)=CNF*RR(I)/RMAX
         CAA(I)=CAF*RR(I)/RMAX
         CMM(I)=CMF*RR(I)/RMAX*(XCG-XX(I)+XX(1))/AL
C
         DO 1020 J=1,7
            JJ=J
            IF(ALPHA .LT. 0)JJ=8-J
            CETA=SIN(THETA/RAD)*COS(ALPHA/RAD)-COS(THETA/RAD)*
     1           SIN(ALPHA/RAD)*COS(PHI(J)/RAD)
            CP(JJ)=AK*CETA*CETA
            IF(ALPHA .NE. 0. .AND. PHI(J) .LT. PHI1*RAD)CP(JJ)=0.
 1020    CONTINUE
         XXX=(XX(I)-XX(1))/DMAX
C
C  PRINT PRESSURE COEFFICIENT DATA IF REQUESTED
C
      IF(IPRINT.NE.1) GO TO 1025
C        IF(I.EQ.1.OR.I.EQ.42.OR.I.EQ.82)CALL HEADR9
C        IF(I.EQ.1.OR.I.EQ.42.OR.I.EQ.82)WRITE(6,1040)AM,ALPHA
C        IF(I.EQ.1.OR.I.EQ.42.OR.I.EQ.82)WRITE(6,1050)
         WRITE(10,1060) XXX,(CP(J),J=1,7)
C        IF(I.EQ.41 .OR. I.EQ.81 .OR. I.EQ.101)WRITE(6,1070)
 1025 CONTINUE
C
C  PRINT BODY COORDINATES TO TAPE UNIT 9 IF REQUESTED
C
      IF(IPRINT.NE.2) GO TO 1030
C
C  FOLLOWING CARD REMOVED FOR TECPLOT FORMAT
C
C        IF(I.EQ.1) WRITE(9,1100)
         WRITE(9,1110) XXX*DMAX,RR(I)
 1030 CONTINUE
C
C***  INTEGRATE FOR BODY TOTAL CA, CN, AND CM
C
      CALL QUAD1(CNN,101,DX,ANSCN)
      CALL QUAD1(CAA,101,DX,ANSCA)
      CALL QUAD1(CMM,101,DX,ANSCM)
C
C ... COMPLETE FORCE AND MOMENT CALCULATIONS
C
      CN=AK/PI/RMAX*ANSCN
      CA=AK/PI/RMAX*ANSCA + AK*(R(1)/RMAX*COS(ALPHA/RAD))**2
      CM=AK/PI/RMAX*ANSCM
C
C***  CORRECT FOR NEGATIVE ANGLES OF ATTACK
C
      IF(ALPHA .LT. 0.)CN=-CN
      IF(ALPHA .LT. 0.)CM=-CM
C
C***  CORRECT REFERENCE QUANTITIES
C
      CN=CN*PI*DMAX**2/4./SREF
      CA=CA*PI*DMAX**2/4./SREF
      CM=CM*PI*DMAX**2*AL/4./SREF/DREF
C
C1040 FORMAT(51X,26HBODY ALONE PRESSURE OUTPUT//
C    1 43X,6HMACH =,F5.2,2X,17HANGLE OF ATTACK =,F7.2,5H DEG.)
C1050 FORMAT(//,52X,21HPRESSURE COEFFICIENTS,//,7X,10H  X/DMAX  ,9X,
C    15HPHI=0,8X,6HPHI=30,8X,6HPHI=60,8X,6HPHI=90,7X,7HPHI=120,7X,
C    27HPHI=150,7X,7HPHI=180)
 1060 FORMAT(F14.6,7F10.5)
C1070 FORMAT(49H0 NOTE - PHI=  0 IS TOP VERTICAL CENTER (LEEWARD) /
C    1       53H         PHI=180 IS BOTTOM VERTICAL CENTER (WINDWARD) )
C
C  BODY COORDINATE COMMENT REMOVED FOR TECPLOT FORMAT
C
C1100 FORMAT(3X,43HNEWTONIAN THEORY BODY COORDINATES (IN FEET))
 1110 FORMAT(3X,2F14.6)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE LUCERO(BETA,X,CNA)
C
C     THIS ROUTINE USES THE METHODS FROM AIAA PAPER
C     AIAA-84-0575 BY E.F. LUCERO, TO CALCULATE
C     THE NORMAL FORCE CURVE SLOPE CN/ALPHA FOR 2-PANEL
C     FINSETS REFERENCED TO WING PLANFORM AREA
C
C  WRITTEN BY K. DETERS, MCDONNELL DOUGLAS
C
C     INPUTS
C
C     BETA = SQRT(M**2-1.0)
C
C     X  - DEPENDANT ON PLANFORM 
C        = 1./(BETA*AR) FOR NEARLY RECTANGULAR WINGS
C        = 1./(COT(L.E. SWEEP)*BETA) FOR DELTA WINGS
C
C     OUTPUT
C
C     CNA - FIN ALONE CN/ALPHA REFERENCED TO PLANFORM AREA
C
C     PROGRAM AREA
      XX=1/X
      IF (XX .GE. 1.35) BCNA=4.*(1.-.5*X)
      IF (XX .GE. .1 .AND. XX .LT. 1.35) BCNA=3.406-1.4778*X
     &+.48775*X**2-.08233*X**3+6.7867E-3*X**4-2.1626E-4*X**5
      IF (XX .LT. .1) BCNA=4./3.
C
C***  THEORECTICAL CN/ALPHA VALUE FOR 2 - PANELS
      CNA=BCNA/(57.3*BETA)
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE PRIF2
C
C***  SUBROUTINE TO PRINT THE RESULTS FOR FIN SET 2
C
      COMMON /FSET2/  FDATA(399)
C
      COMMON /GEOFS2/ GFIN(188)
C
      DIMENSION SSPAN(10),LMAXU(10),LFLATU(10),LMAXL(10),
     1          LFLATL(10),CHORD(10),THICKU(10),THICKL(10),
     2          SWEEP(10),STA(10),XLE(10),
     3          XCORD(50),MEAN(50),THICK(50),YUPPER(50),
     4          YLOWER(50),LER(10)
C
      REAL LER,LMAXU,LMAXL,LFLATU,LFLATL,NPANEL,MEAN
C
      EQUIVALENCE (FDATA(1),SECTYP),(FDATA(2),SSPAN(1)),
     1            (FDATA(12),LMAXU(1)),(FDATA(22),LFLATU(1)),
     2            (FDATA(32),LMAXL(1)),(FDATA(42),LFLATL(1)),
     3            (FDATA(52),CHORD(1)),(FDATA(62),THICKU(1)),
     4            (FDATA(72),THICKL(1)),(FDATA(82),SWEEP(1)),
     5            (FDATA(92),STA(1)),(FDATA(102),XLE(1)),
     6            (FDATA(112),NPANEL),(FDATA(113),XCORD(1)),
     7            (FDATA(163),MEAN(1)),(FDATA(213),THICK(1)),
     8            (FDATA(263),YUPPER(1)),(FDATA(313),YLOWER(1)),
     9            (FDATA(363),FINPHI),(FDATA(364),LER(1))
C
      DIMENSION SPLANF(10),CBAR(10),SWEPLE(10),SWEP25(10),
     1          SWEP50(10),SWEP75(10),SWEPTE(10),
     2          XMGCLE(10),XMGC25(10),
     3          XMGC50(10),XMGC75(10),XMGCTE(10),YMEANC(10),
     4          ASPCT(10),TAPER(10),TOVERC(10),XCENT(10)
C
      EQUIVALENCE (GFIN(1),SPLANF(1)),(GFIN(11),CBAR(1)),
     1            (GFIN(21),SWEPLE(1)),(GFIN(31),SWEP25(1)),
     2            (GFIN(41),SWEP50(1)),(GFIN(51),SWEP75(1)),
     3            (GFIN(61),SWEPTE(1)),(GFIN(71),XMGCLE(1)),
     4            (GFIN(81),XMGC25(1)),(GFIN(91),XMGC50(1)),
     5            (GFIN(101),XMGC75(1)),(GFIN(111),XMGCTE(1)),
     6            (GFIN(121),YMEANC(1)),(GFIN(131),ASPCT(1)),
     7            (GFIN(141),TAPER(1)),(GFIN(151),TOVERC(1)),
     8            (GFIN(161),XCENT(1)),(GFIN(171),FINAR),
     9            (GFIN(172),FINTPR),(GFIN(173),FINSPN),
     A            (GFIN(174),FINSP),(GFIN(175),FINWET),
     B            (GFIN(176),TCEFF),(GFIN(177),FINXGC),
     C            (GFIN(178),FINYGC),(GFIN(179),SWAVLE),
     D            (GFIN(180),SWAV25),(GFIN(181),SWAV50),
     E            (GFIN(182),SWAV75),(GFIN(183),SWAVTE),
     F            (GFIN(184),FINCBR),(GFIN(185),DELTAY),
     G            (GFIN(186),DELTAD),(GFIN(187),XCENF),(GFIN(188),XOVC)
C
      COMMON /CONST/ PI,RAD,UNUSED,KAND
C
      COMMON /LOGIC/ LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
      LOGICAL        LDMPCS,LDAMP,LBUILD,LNACA,LDERDG,
     1               LDERRD,LPART,LNAME,LPLOT,
     2               LFLT,LREFQ,LAXIS,LFIN1,LFIN2,LFIN3,LFIN4,
     3               LDEFL,LTRIM,LDIMIN,LDIMFT,LDIMCM,LDIMM,LELLB,
     4               LINLET,LEXPR,LICRMT,LSPIN,LARBOD
C
      CHARACTER*4 IFT,ICM,IM,IIN,IUNIT
C
      DATA IFT/'  FT'/
      DATA ICM/'  CM'/
      DATA IM /'   M'/
      DATA IIN/'  IN'/
C
      IUNIT=IFT
      IF(LDIMCM)IUNIT=ICM
      IF(LDIMM)IUNIT=IM
      IF(LDIMIN)IUNIT=IIN
C
      ISET=2
C
      WRITE(6,1030)ISET
      WRITE(6,1040)
      WRITE(6,1050)
      WRITE(6,1060)
      IF(LDIMFT) WRITE(6,1082) IUNIT
      IF(LDIMIN) WRITE(6,1084)
      IF(LDIMM)  WRITE(6,1086)
      IF(LDIMCM) WRITE(6,1088)
C
      NSEG=1
C
C***  FIND LAST SPAN STATION
C
      DO 1000 I=2,10
          IF(SSPAN(I) .EQ. UNUSED .OR. SSPAN(I) .EQ. 0.)GO TO 1010
          NSEG=I-1
 1000 CONTINUE
C
 1010 CONTINUE
C
C***  PRINT RESULTS FOR EACH FIN SEGMENT
C
      DO 1020 ISEG=1,NSEG
         WRITE(6,1090)ISEG,SPLANF(ISEG),ASPCT(ISEG),TAPER(ISEG),
     1   SWEPLE(ISEG),SWEPTE(ISEG),CBAR(ISEG),TOVERC(ISEG)
 1020 CONTINUE
C
      WRITE(6,1100)FINSP,FINAR,FINTPR,SWAVLE,SWAVTE,FINCBR,TCEFF
C
 1030 FORMAT(29X,'FIN SET NUMBER ',I2)
 1040 FORMAT(26X,'(DATA FOR ONE PANEL ONLY)',/)
 1050 FORMAT(4X,'SEGMENT',3X,'PLAN',8X,'ASPECT',4X,'TAPER',5X,
     1 'L.E.',5X,'T.E.',4X,'M.A.C.',4X,'T/C')
 1060 FORMAT(4X,'NUMBER',4X,'AREA',8X,'RATIO',5X,'RATIO',4X,'SWEEP',
     1 4X,'SWEEP',4X,'CHORD',4X,'RATIO')
 1082 FORMAT(4X,A4,6X,'FT**2',27X,'DEG',6X,'DEG',7X,'FT')
 1084 FORMAT(4X,A4,6X,'IN**2',27X,'DEG',6X,'DEG',7X,'IN')
 1086 FORMAT(4X,A4,6X,' M**2',27X,'DEG',6X,'DEG',7X,' M')
 1088 FORMAT(4X,A4,6X,'CM**2',27X,'DEG',6X,'DEG',7X,'CM')
 1090 FORMAT(4X,1X,I2,2X,F10.4,4X,6F9.3)
 1100 FORMAT(4X, 'TOTAL',F10.4,4X,6F9.3)
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE SKIPBL(KOL, KCOL)
C
C***  SKIP BLANK CHARACTERS IN ARRAY KOL, UPDATE KCOL POINTER.
C***  KCOL IS SET TO 81 IF ALL LOCATIONS STARTING AT KCOL ARE BLANK.
C
      CHARACTER*4 KOL,BLANK
C
      DIMENSION KOL(80)
C
      DATA BLANK / '    ' /
C
 1000 IF(KOL(KCOL) .NE. BLANK)GO TO 1010
      KCOL=KCOL+1
C
      IF(KCOL .LT. 81)GO TO 1000
C
 1010 CONTINUE
C
      RETURN
      END
c *************************************
c *************************************
c *************************************
      SUBROUTINE TOINT(ALPHA, IANS, IERR)
C
C***  CONVERT AN ALPHANUMERIC STRING INTO AN INTEGER CONSTANT
C
C***  INPUTS
C
C  ALPHA - ALPHANUMERIC STRING (MUST BE INTEGER)
C
C***  OUTPUTS
C
C   IANS - INTEGER RESULT
C   IERR - ERROR CODE, 0=NO ERROR OR 1=CONSTANT NOT CORRECT TYPE
C
      CHARACTER*4 PERIOD,ALPHA
C
      DIMENSION ALPHA(80)
C
      DATA PERIOD / '.   ' /
C
      IERR=0
      IER1=0
      IER2=0
C
      LCOL=1
C
      CALL FINDCH(ALPHA, PERIOD, LCOL)
C
      IF(LCOL .LT. 81)IER1=1
C
      CALL TODEC(ALPHA, ANS, IER2)
C
      IF(IER1 .GT. 0)IERR=1
      IF(IER2 .GT. 0)IERR=2
C
      SIGN=1
      IF(ANS .LT. 0.)SIGN=-1
      IANS=SIGN*(ABS(ANS)+0.5)
C
      RETURN
      END
