1      PROGRAM DATCOM
2C
3C***  NOTE - THE FOLLOWING THREE CARDS ARE REQUIRED FOR CYBER
4C
5C     PROGRAM DATCOM(INPUT=100,OUTPUT,TAPE5=INPUT,TAPE6=OUTPUT,
6C    1               TAPE8=100,TAPE9=100,TAPE10=100,TAPE11=100,
7C    2               TAPE12,TAPE13,TAPE14)
8C
9C***  NOTE - WHEN CONVERTING FROM FORTRAN-IV TO FORTRAN-V THE
10C***  END-OF-FILE CHECKS IN ROUTINES CONERR, INPUT, READCD, AND XPERNM
11C***  MUST BE CHANGED.  THE CORRECT CODE IS GIVEN IN THE
12C***  APPROPIATE PLACES OF EACH ROUTINE.  REPLACE THE C IN COLUMN 1
13C***  WITH A BLANK AND ON THE CARDS IDENTIFIED AS FORTRAN-V
14C***  REPLACE THE BLANK IS COLUMN 1 WITH A C.
15C
16C***  THIS PROGRAM REQUIRES SEVERAL TAPE UNITS FOR I/O.  THESE ARE
17C***  DEFINED IN FORTRAN-V IN THE OPEN STATEMENTS IN THIS ROUTINE.
18C***  THEY MUST BE CHANGES TO COMMENT CARDS BEFORE COMPILING IN
19C***  FORTRAN-IV.
20C
21C     ----DATCOM MAIN PROGRAM
22C
23C
24C***  IDEAL OUTPUT MATRIX
25C
26C             BLOCK    PRINT     IOM
27C             NAME     FLAG     ARRAY
28C
29      COMMON /IBODY/   PBODY,  BODY(400)
30      COMMON /IWING/   PWING,  WING(400)
31      COMMON /IHT/     PHT,    HT(380)
32      COMMON /IVT/     PVT,    VT(380)
33      COMMON /IVF/     PVF,    VF(380)
34      COMMON /IBW/     PBW,    BW(380)
35      COMMON /IBH/     PBH,    BH(380)
36      COMMON /IBV/     PBV,    BV(380)
37      COMMON /IBWH/    PBWH,   BWH(380)
38      COMMON /IBWV/    PBWV,   BWV(380)
39      COMMON /IBWHV/   PBWHV,  BWHV(380)
40      COMMON /IPOWER/  PPOWER, POWER(200)
41      COMMON /IDWASH/  PDWASH, DWASH(60)
42C
43      LOGICAL PBODY, PWING, PHT, PVT, PVF, PBW, PBH, PBV, PBWH, PBWV,
44     1        PBWHV, PPOWER, PDWASH
45C
46C***  INPUT DATA BLOCKS
47C
48      COMMON /FLGTCD/ FLC(160)
49      COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF, IRUN
50      COMMON /SYNTSS/ XCG, XW, ZW, ALIW, ZCG, XH, ZH, ALIH, XV,
51     1                VERTUP, HINAX, XVF, SCALE, ZV, ZVF, YV, YF,
52     2                PHIV, PHIF
53      COMMON /BODYI/  BODYIN(129)
54      COMMON /WINGI/  WINGIN(101)
55      COMMON /VTI/    VTIN(154), TVTIN(8), VFIN(154)
56      COMMON /HTI/    HTIN(154)
57      COMMON /POWER/  PWIN(29), LBIN(21)
58      COMMON /FLAPIN/ F(138)
59C
60      DIMENSION MACH(20), VINF(20), ALT(20), PINF(20), TINF(20)
61      DIMENSION ZL(20), RNNUB(20)
62      EQUIVALENCE (ZL(1),BODYIN(102))
63      EQUIVALENCE (FLC(3),MACH(1)), (FLC(43),RNNUB(1)), (FLC(97),ALT(1))
64      EQUIVALENCE (FLC(117),TINF(1)), (FLC(137),VINF(1))
65      EQUIVALENCE (FLC(74),PINF(1))
66      LOGICAL VERTUP
67      REAL MACH
68C
69C***  COMPUTATIONAL BLOCKS
70C
71      COMMON /WINGD/  A(195), B(49)
72      COMMON /SBETA/  STB(135), TRA(108), TRAH(108), STBH(135)
73      COMMON /BDATA/  BD(762)
74      COMMON /WHWB/   FACT(182), WB(39), HB(39)
75      COMMON /WBHCAL/ WBT(156)
76      COMMON /HTDATA/ AHT(195), BHT(49)
77      COMMON /VTDATA/ AVT(195), AVF(195)
78      COMMON /WHAERO/ C(51), D(55), CHT(51), DHT(55), DVT(55), DVF(55)
79      COMMON /POWR/   PW(315)
80      COMMON /SUPWBB/  SWB(61), SHB(61)
81      COMMON /SUPDW/  DWA(237)
82      COMMON /SUPWH/  GR(303)
83      COMMON /SUPBOD/ SBD(229)
84      COMMON /LEVEL2/ SECOND(23)
85C
86      DIMENSION SLG(141), STG(141), FCM(287), LB(200), DYN(213)
87      DIMENSION SPR(59),FLA(45), FLP(189), STP(156), JET(26), SLA(31)
88      DIMENSION FHG(35), TCD(58), TRM(22), TRM2(22), TRN(7), DYNH(213)
89      DIMENSION SLAH(31)
90C
91      EQUIVALENCE (GR(1), FCM(1), SLG(1)), (GR(142), STG(1))
92      EQUIVALENCE (DWA(1), LB(1), JET(1), FHG(1)), (WBT(1), STP(1))
93      EQUIVALENCE (PW(1), DYN(1), SPR(1)), (PW(60), FLA(1))
94      EQUIVALENCE (PW(105), FLP(1)), (PW(294), TRM(1), TRM2(1), TRN(1))
95      EQUIVALENCE (STB(1), SLA(1)), (DWA(36), TCD(1)), (DYNH(1),BD(301))
96      EQUIVALENCE (STB(32), SLAH(1))
97C
98C***   CONTROL DATA BLOCKS
99C
100      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
101      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF,K,NOVLY
102      COMMON /CASEID/ IDCASE(74),KOUNT,NAMSV(100),IDIM
103      COMMON /EXPER/  KLIST, NLIST(100), NNAMES, IMACH, MDATA,
104     1                KBODY, KWING, KHT, KVT, KWB, KDWASH(3),
105     2                ALPOW, ALPLW, ALPOH, ALPLH
106      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,
107     1                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,
108     2                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,
109     3                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,
110     4                VFPL,VFSC,CTAB,PLOT
111      COMMON /ERROR/  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,
112     1                DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,
113     2                DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,
114     3                DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,
115     4                DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,
116     5                DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,
117     6                DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,
118     7                DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,
119     8                DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,
120     9                DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,
121     A                DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH,LIST
122C
123      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,
124     1         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,
125     2         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,
126     3         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,
127     4         VFPL,VFSC,CTAB,PLOT
128      LOGICAL  IERR,GONOGO,IEND,DMPALL,DPB,DPA,DPBD,DPAVF,
129     1         DPFACT,DPWBT,DPBHT,DPAVT,DPAHT,DPC,DPD,DPWB,
130     2         DPCHT,DPDHT,DPDYNH,SAVE,DMPCSE,DPDVT,DPGR,DPLB,
131     3         DPPW,DPSTB,DPSBD,DPSLG,DPSWB,DPSTP,DPDWA,DPSTG,
132     4         DPSLA,DPTRA,DPEXPD,DPDVF,DPFLP,DPFHG,DPFCM,DPTCD,
133     5         DPFLA,DPTRM,DPSPR,DPTRN,DPTRM2,DPHYP,DPDYN,DPJET,
134     6         DPHB,DPSHB,DPTRAH,DPSTBH,DPSEC,DPSLAH,DPINPT,
135     7         DPFLC,DPOPTN,DPSYN,DPBDIN,DPWGIN,DPVTIN,DPTVT,
136     8         DPVFIN,DPHTIN,DPPWIN,DPLBIN,DPF,DPIOM,
137     9         DPIBDY,DPIWG,DPIHT,DPIVT,DPIVF,DPIBW,DPIBH,DPIBV,
138     A         DPIBWH,DPIBWV,DPITOT,DPIPWR,DPIDWH,LIST
139C
140      LOGICAL IM, IRN, IATM
141C
142      CHARACTER(len=32) :: filename, progname
143      INTEGER :: argc
144      CALL getarg(0,progname)
145      CALL getarg(1,filename)
146      if (iargc() /= 1) then
147        write(*,*) "usage:", progname, "input.dat"
148        return
149      end if
150      OPEN(UNIT=5,  FILE=filename, STATUS='OLD')
151      OPEN(UNIT=6,  FILE='output.dat', STATUS='UNKNOWN')
152      OPEN(UNIT=8,  STATUS='SCRATCH')
153      OPEN(UNIT=9,  STATUS='SCRATCH')
154      OPEN(UNIT=10, STATUS='SCRATCH')
155      OPEN(UNIT=11, STATUS='SCRATCH')
156      OPEN(UNIT=12, STATUS='SCRATCH')
157      OPEN(UNIT=13, FILE='for013.dat', STATUS='UNKNOWN')
158      OPEN(UNIT=14, FILE='for014.dat', STATUS='UNKNOWN')
159C
160C  DISCLAIMER REQUIRED BY HQ USAF FOR PUBLIC RELEASE APPROVAL
161C
162      PRINT*,'THIS SOFTWARE AND ANY ACCOMPANYING DOCUMENTATION'
163      PRINT*,'IS RELEASED "AS IS".  THE U.S. GOVERNMENT MAKES NO'
164      PRINT*,'WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, CONCERNING'
165      PRINT*,'THIS SOFTWARE AND ANY ACCOMPANYING DOCUMENTATION,'
166      PRINT*,'INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OF'
167      PRINT*,'MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.'
168      PRINT*,'IN NO EVENT WILL THE U.S. GOVERNMENT BE LIABLE FOR ANY'
169      PRINT*,'DAMAGES, INCLUDING LOST PROFITS, LOST SAVINGS OR OTHER'
170      PRINT*,'INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE '
171      PRINT*,'USE, OR INABILITY TO USE, THIS SOFTWARE OR ANY'
172      PRINT*,'ACCOMPANYING DOCUMENTATION, EVEN IF INFORMED IN ADVANCE'
173      PRINT*,'OF THE POSSIBILITY OF SUCH DAMAGES.'
174C
175C
176      WRITE(6,900)
177  900 FORMAT(////////,
178     140X,52H****************************************************,/,
179     240X,1H*,4X,42HUSAF STABILITY AND CONTROL  DIGITAL DATCOM,
180     3 4X,1H*,/,
181     440X,1H*,4X,42HPROGRAM REV. JAN 96   DIRECT INQUIRIES TO:,
182     5 4X,1H*,/,
183     640X,1H*,3X,44HWRIGHT LABORATORY  (WL/FIGC)  ATTN: W. BLAKE,
184     7 3X,1H*,/,
185     840X,1H*,9X,33HWRIGHT PATTERSON AFB, OHIO  45433,8X,1H*,/,
186     940X,1H*,4X,42HPHONE (513) 255-6764,   FAX (513) 258-4054,
187     1 4X,1H*,/,
188     240X,52H****************************************************)
189C
190C***  CASE INITIALIZATION AND READ INPUTS
191C
192      IRUN  = 0
193      NLOG  = 34
194      IDIM  = 1
195      IEND  = .FALSE.
196      SAVE  = .FALSE.
197      FIRST = .TRUE.
198      REWIND 12
199      REWIND 13
200 1000 CALL M01O01
201C
202C***  CALL AIRFOIL SECTION MODULE, OVERLAY 50
203C
204      CALL M50O62
205C
206      IF(.NOT. ASYFP) GO TO 1010
207        TRIMC = .FALSE.
208        TRIM  = .FALSE.
209 1010 CONTINUE
210C
211C***  CATALOG EXPERIMENTAL DATA NAMELISTS, SET CASE DATA
212C
213      IF(KLIST .GT. 0) CALL M34O42
214      NALPHA = FLC(2)+0.5
215      NMACH  = FLC(1)+0.5
216      LOOP   = FLC(160)+0.5
217      NALT   = FLC(159)+0.5
218      IF(ROUGFC .LT. 1.E-10) ROUGFC = 1.6E-4
219      IF(BLREF .EQ. UNUSED)  BLREF  = 2.0*WINGIN(4)
220C
221C***  SET LIFTING SURFACE PARAMETERS FOR SUBSONIC AND TRANSONIC MACHS
222C
223      CALL M02O02
224      IF(.NOT. (SUBSON .OR. TRANSN)) GO TO 1020
225        IF(WGPL) CALL CLMCH0(A,B,WINGIN(21),WINGIN(41),WINGIN(68),
226     1                       WINGIN(69),WING,0)
227        IF(HTPL) CALL CLMCH0(AHT,BHT,HTIN(21),HTIN(41),HTIN(68),
228     1                       HTIN(69),HT,1)
229 1020 CONTINUE
230      IG = 1
231      CALL M51O63
232      IM   = FLC(3) .NE. UNUSED
233      IRN  = FLC(43) .NE. UNUSED
234      IATM = (FLC(97) .NE. UNUSED) .OR.
235     1       ((FLC(117) .NE. UNUSED) .AND. (FLC(74) .NE. UNUSED))
236C
237C***  LOOP MACH AND ALTITUDE TOGETHER -- LOOP = 1
238C
239      IF(LOOP .NE. 1) GO TO 1040
240        DO 1030 I=1,NMACH
241          K = I
242          IF(IM .AND. IATM) VINF(I) = MACH(I)*49.01685*SQRT(TINF(K))
243          IF(.NOT. IM)      MACH(I) = VINF(I)/(49.01685*SQRT(TINF(K)))
244          IF(.NOT. IRN)    RNNUB(I) = 1.2527E6*PINF(K)*MACH(I)*
245     1                                (TINF(K)+198.6)/(TINF(K)**2)
246          IF(VINF(I) .EQ. UNUSED) VINF(I) = -UNUSED
247          IF(ALT(K)  .EQ. UNUSED) ALT(K)  = -UNUSED
248          IF(PINF(K) .EQ. UNUSED) PINF(K) = -UNUSED
249          IF(TINF(K) .EQ. UNUSED) TINF(K) = -UNUSED
250          CALL MAIN00
251 1030   CONTINUE
252 1040 CONTINUE
253C
254C***  FIX ALTITUDE AND VARY MACH -- LOOP = 2
255C
256      IF(LOOP .NE. 2) GO TO 1070
257        DO 1060 K=1,NALT
258          DO 1050 I=1,NMACH
259            IF(IM .AND. IATM) VINF(I) = MACH(I)*49.01685*SQRT(TINF(K))
260            IF(.NOT. IM)      MACH(I) = VINF(I)/(49.01685*SQRT(TINF(K)))
261            IF(.NOT. IRN)    RNNUB(I) = 1.2527E6*PINF(K)*MACH(I)*
262     1                                  (TINF(K)+198.6)/(TINF(K)**2)
263            IF(VINF(I) .EQ. UNUSED) VINF(I) = -UNUSED
264            IF(ALT(K)  .EQ. UNUSED) ALT(K)  = -UNUSED
265            IF(PINF(K) .EQ. UNUSED) PINF(K) = -UNUSED
266            IF(TINF(K) .EQ. UNUSED) TINF(K) = -UNUSED
267            CALL MAIN00
268 1050     CONTINUE
269 1060   CONTINUE
270 1070 CONTINUE
271C
272C***  FIX MACH AND VARY ALTITUDE -- LOOP = 3
273C
274      IF(LOOP .NE. 3) GO TO 1100
275        DO 1090 I=1,NMACH
276          DO 1080 K=1,NALT
277            IF(IM .AND. IATM) VINF(I) = MACH(I)*49.01685*SQRT(TINF(K))
278            IF(.NOT. IM)      MACH(I) = VINF(I)/(49.01685*SQRT(TINF(K)))
279            IF(.NOT. IRN)    RNNUB(I) = 1.2527E6*PINF(K)*MACH(I)*
280     1                                  (TINF(K)+198.6)/(TINF(K)**2)
281            IF(VINF(I) .EQ. UNUSED) VINF(I) = -UNUSED
282            IF(ALT(K)  .EQ. UNUSED) ALT(K)  = -UNUSED
283            IF(PINF(K) .EQ. UNUSED) PINF(K) = -UNUSED
284            IF(TINF(K) .EQ. UNUSED) TINF(K) = -UNUSED
285            CALL MAIN00
286 1080     CONTINUE
287 1090   CONTINUE
288 1100 CONTINUE
289C
290C***  DUMP EXTRAPOLATION MESSAGES FOR CASE
291C
292      CALL M57O71
293C
294      GO TO 1000
295      END
296