1 SUBROUTINE GRDEFF(GRDHT,L) 2C 3C*** COMPUTES GROUND EFFECTS 4C 5 COMMON /FLGTCD/ FLC(93) 6 COMMON /SUPWH/ GR(303) 7 COMMON /BDATA/ BD(275),CIOM(320) 8 COMMON /WINGD/ A(195), B(49) 9 COMMON /HTDATA/ AHT(195), BHT(49) 10 COMMON /CONSNT/ PI, DEG, UNUSED, RAD 11 COMMON /SYNTSS/ SYNA(19) 12 COMMON /OPTION/ SREF, CBARR, ROUGFC, BLREF 13 COMMON /OVERLY/ NLOG, NMACH, I, NALPHA, IG 14 COMMON /WINGI/ WINGIN(77) 15 COMMON /HTI/ HTIN(131) 16 COMMON /FLAPIN/ F(69) 17 COMMON /IWING/ PWING, WING(400) 18 COMMON /IBW/ PBW, BWI(380) 19 COMMON /IBWV/ PBWV, BWV(380) 20 COMMON /IBWH/ PBWH, BWH(380) 21 COMMON /IBWHV/ PBWHV, BWHV(380) 22 COMMON /IDWASH/ PDWASH, DWASH(60) 23 COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC, 24 1 HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON, 25 2 TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP, 26 3 HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART, 27 4 VFPL,VFSC,CTAB 28C 29 LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC, 30 1 HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON, 31 2 TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP, 32 3 HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART, 33 4 VFPL,VFSC,CTAB 34C 35 DIMENSION ROUTID(2),Q47118(2),Q47119(2),Q7122A(3),Q47125(2) 36 1 ,QCLWBG(2),QCLHTG(2) 37 DIMENSION CW(6),LGH(4),VAR(4),X4717A(13),Y4717A(13),Y4717B(13) 38 DIMENSION CT(6),Q47117(2),DELTA(10) 39 REAL K,LOLOM1(20),LH,LHOCBR 40 DIMENSION DALPHA(20),ALPHWG(20),DDWASH(20),CLHT(20),ALPHAT(20), 41 1CLWBG(20),CLG(20),CLHTG(20),DCLWBG(20),DCMWBG(20),CMG(20),DCLHTG 42 2(20),DCMHTG(20),DCDLWG(20),CLOCOS(20),BW(20),CMWBG(20) 43 EQUIVALENCE (DELTA(1),F(1)) 44 EQUIVALENCE (CLG(1),BWH(21)) 45 EQUIVALENCE (CMWBG(1),BWI(41)), (CMG(1),BWH(41)) 46 EQUIVALENCE (GR(1),DX),(GR(2),DXOB2),(GR(3),H75CR),(GR(4),HW), 47 1 (GR(5),HWOB2),(GR(6),HWCR4),(GR(7),HWCOCR),(GR(8),HWMACX),(GR(9), 48 2 HWMAC4),(GR(10),HTMACX),(GR(11),HTMAC4),(GR(12),R),(GR(13),SIGMA) 49 3 ,(GR(14),HWOCBR),(GR(15),T),(GR(17),DALPHA(1)), 50 4 (GR(37),ALPHWG(1)),(GR(57),K),(GR(58),X),(GR(59),BWOB),(GR(60), 51 5 BEFF),(GR(61),DDWASH(1)),(GR(81),CLHT(1)),(GR(101),ALPHAT(1)), 52 6 (GR(121),BW(1)),(GR(141),LOLOM1(1)),(GR(161),CLHTG(1)), 53 7 (GR(181),DCLWBG(1)),(GR(201),DXCP),(GR(202),DCMWBG(1)), 54 8 (GR(222),CLOCOS(1)),(GR(242),LH),(GR(243),LHOCBR), 55 9 (GR(244),DCLHTG(1)),(GR(264),DCMHTG(1)),(GR(284),DCDLWG(1)) 56 DIMENSION X218(11),X118(7),Y18(77) 57 DIMENSION X219(12),X119(9),Y19(108) 58 DIMENSION X222A(6),X122A(4),Y22A(24) 59 DIMENSION X225(11),X125(9),Y25(99) 60C 61C *********FIGURE 4.7.1-14********** 62C ******** X218=HWOB2 X118=DX Y18=X ********** 63C 64 DATA ROUTID/4HGRDE,4HFF /,Q47118/4H4.7.,4H1-14/,Q47119/4H4.7., 65 1 4H1-15/,Q7122A/4H4.7.,4H1-18,4HA /,Q47125/4H4.7.,4H1-21/, 66 2 QCLWBG/4HCLWB,4HG /,QCLHTG/4HCLHT,4HG / 67 DATA X218/0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/ 68 DATA X118/1.0,0.5,0.2,0.0,-0.2,-0.5,-1.0/ 69 DATA Y18/1.4,1.01,0.79,0.62,0.50,0.40,0.33,0.27,0.22,0.18,0.15, 70 11.27,0.90,0.69,0.54,0.42,0.33,0.28,0.22,0.18,0.15,0.12, 71 21.11,0.78,0.58,0.45,0.35,0.28,0.22,0.18,0.15,0.12,0.099, 72 31.00,0.66,0.50,0.38,0.30,0.23,0.19,0.16,0.12,0.10,0.085, 73 40.86,0.55,0.40,0.31,0.24,0.19,0.16,0.13,0.10,0.085,0.080, 74 50.72,0.41,0.29,0.21,0.16,0.13,0.10,0.080,0.070,0.060,0.050, 75 60.60,0.30,0.19,0.12,0.085,0.065,0.045,0.035,0.025,0.020,0.0200/ 76C 77C *********FIGURE 4.7.1-15********** 78C ******** X219=HWCOCR X119=CLOCOS(J) Y19=LOLOM1(J) ********* 79C 80 DATA X219/.3,.4,.6,.8,1.,1.2,1.4,1.6,1.8,2.,2.2,2.4/ 81 DATA X119/0.0,5.0,10.0,15.0,18.0,20.0,22.0,24.0,36.0/ 82 DATA Y19/.40,.27,.145,.090,.060,.04,.030,.022,.015,.013,.010,.010, 83 1.25,.16,.065,.035,.017,.007,0.0,-.005,-.007,-.010,-.012,-.016, 84 2.11,.060,0.0,-.020,-.030,-.030,-.030,-.030,-.030,-.030,-.030,-.030 85 3,-.020,-.040,-.065,-.070,-.070,-.065,-.060,-.055,-.050,-.048,-.045 86 4,-.040,-.080,-.10,-.115,-.11,-.098,-.085,-.080,-.070,-.065,-.060, 87 5-.060,-.055,-.125,-.135,-.140,-.125,-.115,-.10,-.090,-.085,-.075, 88 6-.070,-.065,-.063,-.160,-.165,-.165,-.15,-.13,-.12,-.105,-.095, 89 7-.085,-.080,-.070,-.067,-.20,-.20,-.190,-.170,-.148,-.130,-.115, 90 8-.10,-.090,-.085,-.077,-.073,-.20,-.20,-.20,-.20,-.20,-.19,-.17, 91 9-.155,-0.138,-.127,-.118,-.11/ 92C 93C *********FIGURE 4.7.1-18A********* 94C ******** X22A=1.0/A(118) X12A=A(120) Y22A=BWOB ************ 95C 96 DATA X222A/1.0,1.5,2.0,3.0,4.0,5.0/ 97 DATA X122A/4.0,6.0,8.0,10.0/ 98 DATA Y22A/.825,.79,.77,.745,.725,.715,.853,.805,.77,.740,.715,.70, 99 1.88,.82,.77,.73,.703,.69,.895,.825,.77,.725,.695,.68/ 100C 101C *********FIGURE 4.7.1-21********** 102C ******** X225=HWOCBR X122A=B(J+182) Y25=BW(J) ************* 103C 104 DATA X225/.2,.3,.4,.5,.6,.7,.8,.9,1.0,1.1,1.2/ 105 DATA X125/0.0,.2,.4,.6,.8,1.0,1.2,1.4,1.6/ 106 DATA Y25/11*0.0,.92,.59,.41,.31,.23,.19,.15,.11,.09,.08,.07, 107 11.92,1.13,.80,.60,.45,.35,.25,.20,.17,.15,.12, 108 22.45,1.65,1.15,.81,.60,.43,.35,.23,.20,.16,.12, 109 32.6,2.15,1.42,1.0,.70,.50,.37,.25,.19,.15,.14, 110 42.6,2.5,1.7,1.15,.78,.52,.37,.22,.14,.09,.04, 111 52.6,2.6,1.85,1.20,.76,.46,.29,.18,.08,0.0,-.02, 112 62.6,2.6,1.95,1.20,.72,.39,.19,.03,-.02,-.09,-.12, 113 72.6,2.6,2.10,1.16,.52,.20,.03,-.07,-.16,-.22,-.26/ 114 DATA X4717A/0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1.,1.1,1.2/ 115 DATA Y4717A/-.145,-.125,-.1,-.08,-.062,-.05,-.038,-.029,-.02, 116 1 -.014,-.005,2*0./ 117 DATA Y4717B/.098,.08,.062,.051,.04,.032,.024,.016,.01,.006,3*0./ 118 DATA Q47117/4H4.7.,4H1-17 / 119 DATA STRA/4HSTRA/ 120C 121 IF(IG.GT.1)GO TO 1010 122C 123C STORE BASIC AERO, FREE AIR, FOR MULTIPLE HEIGHTS 124C 125 DO 1000 J=1,20 126 CIOM(J )= BWI(J ) 127 CIOM(J+ 20)= BWI(J+ 20) 128 CIOM(J+ 40)= BWI(J+ 40) 129 CIOM(J+ 60)= BWI(J+100) 130 CIOM(J+ 80)= BWI(J+120) 131 CIOM(J+100)= BWH(J ) 132 CIOM(J+120)= BWH(J+ 20) 133 CIOM(J+140)= BWH(J+ 40) 134 CIOM(J+160)= BWH(J+100) 135 CIOM(J+180)= BWH(J+120) 136 CIOM(J+200)= BWV(J ) 137 CIOM(J+220)=BWHV(J ) 138 CIOM(J+240)=BWHV(J+ 20) 139 CIOM(J+260)=BWHV(J+ 40) 140 CIOM(J+280)=BWHV(J+100) 141 CIOM(J+300)=BWHV(J+120) 142 1000 CONTINUE 143C 144C REPLACE BASIC AERO, FREE AIR, FOR MULTIPLE HEIGHTS 145C 146 1010 DO 1020 J=1,20 147 BWI(J )=CIOM(J ) 148 BWI(J+ 20)=CIOM(J+ 20) 149 BWI(J+ 40)=CIOM(J+ 40) 150 BWI(J+100)=CIOM(J+ 60) 151 BWI(J+120)=CIOM(J+ 80) 152 BWH(J )=CIOM(J+100) 153 BWH(J+ 20)=CIOM(J+120) 154 BWH(J+ 40)=CIOM(J+140) 155 BWH(J+100)=CIOM(J+160) 156 BWH(J+120)=CIOM(J+180) 157 BWV(J )=CIOM(J+200) 158 BWHV(J )=CIOM(J+220) 159 BWHV(J+ 20)=CIOM(J+240) 160 BWHV(J+ 40)=CIOM(J+260) 161 BWHV(J+100)=CIOM(J+280) 162 BWHV(J+120)=CIOM(J+300) 163 1020 CONTINUE 164 GR(16)=GRDHT 165C 166C *************CALCULATE GROUND EFFECT GEOMETRIC PARAMETERS******** 167C 168 TANGI=TAN(WINGIN(13)/RAD) 169 TANGO=TAN(WINGIN(14)/RAD) 170C 171C ****CALCULATE DELTAX**** 172C 173 IF(STRA.EQ.WINGIN(15))GO TO 1040 174 IF(WINGIN(2).LE.0.25*WINGIN(4)) GO TO 1030 175 DX=.5*WINGIN(6)-A(92)*(WINGIN(2)-0.25*WINGIN(4))-A(68)* 176 1 (WINGIN(4)-WINGIN(2)) 177 GO TO 1050 178 1030 DX=0.50*WINGIN(6)-0.75*WINGIN(4)*A(8) 179 GO TO 1050 180 1040 DX=0.50*WINGIN(6)-A(44)*0.75*WINGIN(4) 181 1050 DXOB2=DX/WINGIN(4) 182C 183C ****CALCULATE AVERAGE ELEVATION OF WING ABOVE GROUND (HW)***** 184C 185 H75CR=GRDHT+SYNA(3)-0.75*WINGIN(6)*TAN(SYNA(4)/RAD) 186 IF(WINGIN(13).EQ.UNUSED.AND.WINGIN(14).EQ.UNUSED) GO TO 1070 187 IF(WINGIN(13).NE.UNUSED.AND.WINGIN(14).EQ.UNUSED) GO TO 1060 188 IF(WINGIN(13).EQ.UNUSED.AND.WINGIN(14).NE.UNUSED) GO TO 1080 189 IF(WINGIN(12).LE.0.25*WINGIN(4)) GO TO 1060 190 HW=H75CR+0.50*((WINGIN(4)-WINGIN(12))*TANGI 191 1 +(WINGIN(12)-0.25*WINGIN(4))*TANGO) 192 2 +DX*TAN(SYNA(4)/RAD)*0.50 193 GO TO 1090 194 1060 HW=H75CR+0.375*WINGIN(4)*TANGI+DX*TAN(SYNA(4)/RAD)*.50 195 GO TO 1090 196 1070 HW=H75CR+DX*TAN(SYNA(4)/RAD)*.50 197 GO TO 1090 198 1080 IF(WINGIN(12).LE.0.25*WINGIN(4)) GO TO 1070 199 HW=H75CR+0.50*TANGO*(WINGIN(12)-0.25*WINGIN(4)) 200 1 +DX*TAN(SYNA(4)/RAD)*.50 201 1090 HWOB2=HW/WINGIN(4) 202C 203C ****CALCULATE ELEVATION OF WING 1/4CR (HWCR4) ***** 204C 205 HWCR4=H75CR+0.50*WINGIN(6)*TAN(SYNA(4)/RAD) 206 HWCOCR=HWCR4/WINGIN(6) 207C 208C ****CALCULATE WING AND TAIL ELEVATIONS IF TAIL IS PRESENT**** 209C 210 IF(HTPL) GO TO 1100 211 GO TO 1180 212 1100 CONTINUE 213C 214C ****CALCULATE ELEVATION OF WING MAC (HWMAC4)***** 215C 216 HWMACX=GRDHT+SYNA(3)-A(161)*TAN(SYNA(4)/RAD) 217 IF(WINGIN(13).EQ.UNUSED.AND.WINGIN(14).EQ.UNUSED)GO TO 1120 218 IF(WINGIN(13).NE.UNUSED.AND.WINGIN(14).EQ.UNUSED) GO TO 1110 219 IF(WINGIN(13).EQ.UNUSED.AND.WINGIN(14).NE.UNUSED) GO TO 1130 220 IF(A(136).LE.WINGIN(4)-WINGIN(12)) GO TO 1110 221 HWMAC4=HWMACX+(WINGIN(4)-WINGIN(12))*TANGI 222 1 +(A(136)+WINGIN(12)-WINGIN(4))*TANGO 223 GO TO 1140 224 1110 HWMAC4=HWMACX+A(136)*TANGI 225 GO TO 1140 226 1120 HWMAC4=HWMACX 227 GO TO 1140 228 1130 IF(A(136).LE.WINGIN(4)-WINGIN(12)) GO TO 1120 229 HWMAC4=HWMACX+(A(136)+WINGIN(12)-WINGIN(4))*TANGO 230 1140 CONTINUE 231C 232C ****CALCULATE ELEVATION OF TAIL MAC (HTMAC4)***** 233C 234 HTMACX=GRDHT+SYNA(7)-AHT(161)*TAN(SYNA(8)/RAD) 235 TANGIT=TAN(HTIN(13)/RAD) 236 TANGOT=TAN(HTIN(14)/RAD) 237 IF(HTIN(13).EQ.UNUSED.AND.HTIN(14).EQ.UNUSED) GO TO 1160 238 IF(HTIN(13).NE.UNUSED.AND.HTIN(14).EQ.UNUSED) GO TO 1150 239 IF(HTIN(13).EQ.UNUSED.AND.HTIN(14).NE.UNUSED) GO TO 1170 240 IF(AHT(136).LE.HTIN(4)-HTIN(12)) GO TO 1150 241 HTMAC4=HTMACX+(HTIN(4)-HTIN(12))*TANGIT+(AHT(136)+HTIN(12) 242 1 -HTIN(4))*TANGOT 243 GO TO 1180 244 1150 HTMAC4=HTMACX+AHT(136)*TANGIT 245 GO TO 1180 246 1160 HTMAC4=HTMACX 247 GO TO 1180 248 1170 IF(AHT(136).LE.HTIN(4)-HTIN(12)) GO TO 1160 249 HTMAC4=HTMACX+(AHT(136)+HTIN(12)-HTIN(4))*TANGOT 250 1180 CONTINUE 251C 252C **************CALCULATE GROUND EFFECT ON WING LIFT (DELTA ALPHA)** 253C 254 R=(1.0+HWOB2**2)**.50-HWOB2 255 SIGMA=EXP(-2.48*HWOB2**.768) 256 HWOCBR=HW/A(122) 257 T=(RAD/(8.0*PI))*(HWOCBR/(HWOCBR**2+1.0/64.)) 258 IF(A(120).LT.3.0) GO TO 1230 259 CALL TLINEX(X118,X218,Y18,7,11,DXOB2,HWOB2,X, 260 1 0,0,0,0,Q47118,2,ROUTID) 261 IF(STRA.EQ.WINGIN(15)) GO TO 1190 262 COSL4=(A(91)*WINGIN(2)+A(67)*(WINGIN(4)-WINGIN(2)))/WINGIN(4) 263 GO TO 1200 264 1190 COSL4=A(43) 265 1200 CONTINUE 266C 267 DDCLF=0.0 268 IFTYPE=F(17)+0.5 269 IF(IFTYPE.LT.3 .OR. IFTYPE.GT.5)GO TO 1210 270C 271C FIG. 4.7.1-17 DEL(DEL-CL) FOR FLAPS 272C 273 VAR(1)=HWMAC4/WINGIN(6) 274 LGH(1)=13 275 IF(IFTYPE.EQ.3.OR.IFTYPE.EQ.4)CALL INTERX(1,X4717A,VAR,LGH, 276 1 Y4717A,DDCLF,13,13,1,0,0,0,1,0,0,0,Q47117,2,ROUTID) 277 IF(IFTYPE.EQ.5) CALL INTERX(1,X4717A,VAR,LGH, 278 1 Y4717B,DDCLF,13,13,1,0,0,0,1,0,0,0,Q47117,2,ROUTID) 279 1210 DO 1220 J=1,NALPHA 280 IF(.NOT.HTPL) CLWF=BWI(J+20)+WING(L+200) 281 IF( HTPL ) CLWF=BWI(J+20) 282 CLOCOS(J)=RAD*WING(J+20)/(2.0*PI*COSL4**2) 283 CALL TLINEX(X119,X219,Y19,9,12,CLOCOS(J),HWCOCR,LOLOM1(J), 284 1 0,0,2,2,Q47119,2,ROUTID) 285 DALPHA(J)=-(9.12/A(120)+7.16*WINGIN(6)/(2.0*WINGIN(4)))* 286 1 CLWF*X-(A(120)*WINGIN(6)/(4.0*BWI(101) 287 2 *WINGIN(4)))* LOLOM1(J)*CLWF*R 288 ALPHWG(J)=FLC(J+22)+DALPHA(J)-DDCLF*DELTA(L)**2/(2500. 289 1 *BWI(J+100)) 290 1220 CONTINUE 291 GO TO 1250 292 1230 CONTINUE 293C 294C *********GROUND EFFECTS ON LOW ASPECT RATIO WING LIFT****** 295C 296 K=RAD*.0030*HWOCBR*(1.0/(HWOCBR**2+1.0/64.)**2+1.0/(HWOCBR**2 297 1 +9.0/64.)**2) 298 DO 1240 J=1,NALPHA 299 CALL TLINEX(X125,X225,Y25,9,11,WING(J+20),HWOCBR,BW(J), 300 1 0,0,2,2,Q47125,2,ROUTID) 301 DALPHA(J)=-18.24*BWI(J+20)*SIGMA/A(120)+R*T*BWI(J+20)**2/ 302 1 (RAD*BWI(101))-R*BW(J)+K*WINGIN(16) 303 ALPHWG(J)=FLC(J+22)+DALPHA(J) 304 1240 CONTINUE 305 1250 CONTINUE 306 IF(HTPL) GO TO 1260 307 GO TO 1280 308 1260 CONTINUE 309C 310C *********GROUND EFFECTS ON TAIL ************ 311C 312 CALL TLINEX(X122A,X222A,Y22A,4,6,A(120),1/A(118),BWOB, 313 1 2,0,2,1,Q7122A,3,ROUTID) 314 BEFF=BWOB*2.0*WINGIN(4) 315 DO 1270 J=1,NALPHA 316 DDWASH(J)=DWASH(J+20)*(BEFF**2+4.*(HTMAC4-HWMAC4)**2)/(BEFF**2+ 317 1 4.*(HTMAC4+HWMAC4)**2) 318 CLHT(J)=BWH(J+20)-BWI(J+20) 319 ALPHAT(J)=FLC(J+22)-DDWASH(J) 320 1270 CONTINUE 321 1280 CONTINUE 322 IW=0 323 IT=0 324 DO 1300 J=1,NALPHA 325 CLWB = BWI(J+20) 326 CALL TBFUNX(FLC(J+22),CLWBG(J),DYDX,NALPHA,ALPHWG(1),BWI(21), 327 1 CW,IW,MI,NG,1,2,QCLWBG,2,ROUTID) 328 DCLWBG(J) = CLWBG(J)-CLWB 329 IF(VTPL .OR. VFPL .OR. TVTPAN) BWV(J+20)=CLWBG(J) 330 IF(HTPL) GO TO 1290 331 GO TO 1300 332 1290 CALL TBFUNX(FLC(J+22),CLHTG(J),DYDX,NALPHA,ALPHAT(1),CLHT(1), 333 1 CT,IT,MI,NG,1,2,QCLHTG,2,ROUTID) 334 CLG(J)=BWV(J+20)+CLHTG(J) 335 IF(VTPL .OR. VFPL .OR. TVTPAN) BWHV(J+20)=CLG(J) 336 1300 CONTINUE 337 DO 1310 J=1,NALPHA 338 1310 BWI(J+20)=CLWBG(J) 339C 340C **************GROUND EFFECTS ON PITCHING MOMENT *********** 341C 342 DO 1350 J=1,NALPHA 343 DXCP=BWI(121)/BWI(101) 344 DCMWBG(J)=DXCP*DCLWBG(J) 345 CMWBG(J)=BWI(J+40)+DCMWBG(J) 346 IF(VTPL .OR. VFPL .OR. TVTPAN) BWV(J+40)=CMWBG(J) 347 IF(HTPL) GO TO 1320 348 GO TO 1330 349 1320 CONTINUE 350C 351C *********GROUND EFFECT ON TAIL CM ***** 352C 353 LH=SYNA(6)+AHT(161)-SYNA(1) 354 LHOCBR=LH/A(122) 355 DCLHTG(J)=CLHTG(J)-CLHT(J) 356 DCMHTG(J)=-DCLHTG(J)*LHOCBR*DWASH(J) 357 CMG(J)=BWH(J+40)+DCMHTG(J) 358 IF(VTPL .OR. VFPL .OR. TVTPAN) BWHV(J+40)=CMG(J) 359 1330 CONTINUE 360C 361C **************GROUND EFFECT ON DRAG *********************** 362C 363 DCDLWG(J)=-SIGMA*WING(J+20)**2/(PI*A(120))-(WING(J)-SIGMA* 364 1 WING(J+20)**2/(PI*A(120)))*R*T*WING(J+20)/RAD 365 BWI(J)=BWI(J)+DCDLWG(J) 366 IF(VTPL .OR. VFPL .OR. TVTPAN) BWV(J)=BWV(J)+DCDLWG(J) 367 IF(HTPL) GO TO 1340 368 GO TO 1350 369 1340 BWH(J)=BWH(J)+DCDLWG(J) 370 IF(VTPL .OR. VFPL .OR. TVTPAN) BWHV(J)=BWHV(J)+DCDLWG(J) 371 1350 CONTINUE 372C 373C CALCULATE CN AND CA 374C 375 IW = 0 376 IT = 0 377 DO 1360 J=1,NALPHA 378 SA = SIN(FLC(J+22)/RAD) 379 CA = COS(FLC(J+22)/RAD) 380 BWI(J+60) = BWI(J+20)*CA + BWI(J)*SA 381 BWI(J+80) = BWI(J)*CA - BWI(J+20)*SA 382 BWV(J+60) = BWV(J+20)*CA + BWV(J)*SA 383 BWV(J+80) = BWV(J)*CA - BWV(J+20)*SA 384 BWH(J+60) = BWH(J+20)*CA + BWH(J)*SA 385 BWH(J+80) = BWH(J)*CA - BWH(J+20)*SA 386 BWHV(J+60) = BWHV(J+20)*CA + BWHV(J)*SA 387 BWHV(J+80) = BWHV(J)*CA - BWHV(J+20)*SA 388C 389C B-W CLA AND CMA 390C 391 CALL TBFUNX(FLC(J+22),Z,BWI(J+100),NALPHA,FLC(23),BWI(21), 392 1 CW,IW,MI,NG,0,0,4HCLA ,1,ROUTID) 393 CALL TBFUNX(FLC(J+22),Z,BWI(J+120),NALPHA,FLC(23),BWI(41), 394 1 CT,IT,MI,NG,0,0,4HCMA ,1,ROUTID) 395 1360 CONTINUE 396C 397C B-W-V CLA AND CMA 398C 399 IW = 0 400 IT = 0 401 DO 1370 J=1,NALPHA 402 CALL TBFUNX(FLC(J+22),Z,BWV(J+100),NALPHA,FLC(23),BWV(21), 403 1 CW,IW,MI,NG,0,0,4HCLA ,1,ROUTID) 404 CALL TBFUNX(FLC(J+22),Z,BWV(J+120),NALPHA,FLC(23),BWV(41), 405 1 CT,IT,MI,NG,0,0,4HCMA ,1,ROUTID) 406 1370 CONTINUE 407C 408C B-W-H CLA AND CMA 409C 410 IW = 0 411 IT = 0 412 DO 1380 J=1,NALPHA 413 CALL TBFUNX(FLC(J+22),Z,BWH(J+100),NALPHA,FLC(23),BWH(21), 414 1 CW,IW,MI,NG,0,0,4HCLA ,1,ROUTID) 415 CALL TBFUNX(FLC(J+22),Z,BWH(J+120),NALPHA,FLC(23),BWH(41), 416 1 CT,IT,MI,NG,0,0,4HCMA ,1,ROUTID) 417 1380 CONTINUE 418C 419C B-W-H-V CLA AND CMA 420C 421 IW = 0 422 IT = 0 423 DO 1390 J=1,NALPHA 424 CALL TBFUNX(FLC(J+22),Z,BWHV(J+100),NALPHA,FLC(23),BWHV(21), 425 1 CW,IW,MI,NG,0,0,4HCLA ,1,ROUTID) 426 CALL TBFUNX(FLC(J+22),Z,BWHV(J+120),NALPHA,FLC(23),BWHV(41), 427 1 CT,IT,MI,NG,0,0,4HCMA ,1,ROUTID) 428 1390 CONTINUE 429 RETURN 430 END 431