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