1      SUBROUTINE SUPLAT
2C
3C ************SUPERSONIC LATERAL STABILITY************
4C                        WING
5C                     WING-BODY
6C
7      COMMON /OPTION/ SR,CRBAR,ROUGFC,BLREF
8      COMMON /FLGTCD/ FLC(160)
9      COMMON /CONSNT/ PI,DEG,UNUSED,RAD
10      COMMON /BDATA/  BD(762)
11      COMMON /OVERLY/ NLOG,NMACH,I,NALPHA,IG,NF,LF
12      COMMON /SYNTSS/ SYNA(19)
13      COMMON /WINGD/  A(195)
14      COMMON /SUPWH/  SLG(141)
15      COMMON /SBETA/  SLA(31)
16      COMMON /SUPBOD/ SBD(227)
17      COMMON /HTDATA/ AHT(195)
18      COMMON /BODYI/  BODYIN(126)
19      COMMON /WINGI/  WINGIN(100)
20      COMMON /HTI/    HTIN(154)
21      COMMON /IWING/  PWING, WING(400)
22      COMMON /IBW/    PBW, BWI(380)
23      COMMON /IBWH/   PBWH, BWH(380)
24      COMMON /IBWV/   PBWV, BWV(380)
25      COMMON /IBWHV/  PBWHV, BWHV(380)
26      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,
27     1                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,
28     2                TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,
29     3                HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,
30     4                VFPL,VFSC,CTAB
31C
32      LOGICAL  FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,
33     1         HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,SUPERS,SUBSON,
34     2         TRANSN,HYPERS,SYMFP,ASYFP,TRIMC,TRIM,DAMP,
35     3         HYPEF,TRAJET,BUILD,FIRST,DRCONV,PART,
36     4         VFPL,VFSC,CTAB
37C
38      DIMENSION ROUTID(2)
39      DIMENSION Q51116(3),Q71118(3),Q225AE(3),Q52318(3),Q125OO(3)
40      REAL MACH
41      DIMENSION SEXT(20),RLPH(20)
42      DIMENSION VAR(4),LGH(4),ZAR(4),ILGH(4)
43      DIMENSION C1(6),C2(6)
44      DIMENSION X158A(10),X258A(2),Y58A(20),X158B(5),X258B(3),Y58B(15),
45     1X158C(5),X258C(2),Y58C(10)
46      DIMENSION WTYPE(4)
47      DIMENSION X12225(39),Y2225A(119),Y2225B(119),Y2225C(119),
48     1Y2225D(119),Y2225E(119),Y12225(595)
49      DIMENSION X71118(8),Y71118(8),X51116(16),Y51116(16),
50     1          XA25OO( 6),YA25OO( 6),XB25OO(8),YB25OO(8)
51      DIMENSION ALPHA(20),CLBWB(20),SHB(20),
52     1CLBW(20),CNW(20),CYBW(20),CNBW(20)
53C
54      EQUIVALENCE (TANMID,A(74))
55      EQUIVALENCE (SLA(3),X),(DIHEQ,SLA(4)),(CYBW(1),WING(141)),
56     1(QBC,SLA(5)),(EBC,SLA(6)),(CLPTOA,SLA(7)),(CLP,SLA(8))
57     2,(CLBD,SLA(9)),(CLBW(1),WING(181)),(ZW,SLA(10)),(RKI,SLA(11)),
58     3(CYBWB,BWI(141)),(RNN,SLA(12)),(RKRL,SLA(13)),(RH1,SLA(14)),(RH2,
59     4SLA(15)),(SBS,SLA(16)),(RKN,SLA(17)),(CNBWB,BWI(161))
60     5,(CNBW(1),WING(161))
61      EQUIVALENCE (ZWP,SLA(18)),(CLBZW,SLA(19)),(DCLB,SLA(20)),(CLBWB(1)
62     1,BWI(181))
63      EQUIVALENCE (MACH,SLA(1)),(BETA,SLA(2)),(SWEPE,A(59)),(TAPR,A(118)
64     1),(AR,A(120)),(TANLE,A(62)),(XW,SYNA(2)),(CR,WINGIN(6)),
65     2(XCG,SYNA(1)),(ALPHA(1),FLC(23)),(SPAN,WINGIN(4)),(SLG(3),CLPCTY),
66     3(COSLE,A(61)),(CNW(1),WING(61)),(CNAW,SLG(7))
67      EQUIVALENCE (SPANO,WINGIN(3)),(CLAB,SBD(18)),(RLB,BD(1)),
68     1(ALPHAI,SYNA(4))
69      EQUIVALENCE (ZHH,SYNA(7)), (ALIH,SYNA(8))
70      EQUIVALENCE (RKHBHL,SLA(21)),(RKHB,SLA(22)),(DCYHWB,SLA(23)),
71     1  (SHB(1),HTIN(115)),(SEXT(1),HTIN(135))
72      EQUIVALENCE (RLPH(1),HTIN(95))
73      EQUIVALENCE (Y12225(1),Y2225A(1)),(Y12225(120),Y2225B(1)),
74     1(Y12225(239),Y2225C(1)),(Y12225(358),Y2225D(1)),(Y12225(477),
75     2 Y2225E(1))
76C
77      DATA ROUTID/4HSUPL,4HAT  /
78      DATA Q51116/4H5.1.,4H1.1-,4H6   /,Q71118/4H7.1.,4H1.1-,4H8   /,
79     1Q225AE/4H7.1.,4H2.2-,4H25AE/,Q52318/4H5.2.,4H3.1-,4H8   /,Q125OO/
80     24H5.3.,4H1.1-,4H25OO/
81      DATA WTYPE/4HSTRA,4HDOUB,4HCRAN,4HCURV/
82C
83C                         FIGURE 5.2.3.1-8A
84C
85      DATA X158A/20.,14.,10.,8.,7.,6.,5.,4.,3.,2.5/
86      DATA X258A/.2,.8/
87      DATA Y58A/.1,1.88,
88     1.40,2.21,
89     2.74,2.60,
90     3.98,2.80,
91     41.30,3.13,
92     51.61,3.50,
93     62.00,3.88,
94     72.50,4.40,
95     82.99,5.00,
96     93.45,5.40/
97C                        FIGURE 5.2.3.1-8B
98C
99      DATA X158B/.8,1.0,1.2,1.4,1.6/
100      DATA X258B/0.0,3.0,6.0/
101      DATA Y58B/0.0,2.35,4.68,
102     10.0,3.00,6.00,
103     20.0,3.60,7.25,
104     30.0,4.18,8.50,
105     40.0,4.79,9.50/
106C
107C                        FIGURE 5.2.3.1-8C
108C
109      DATA X158C/.5,.6,.8,1.,2./
110      DATA X258C/0.0,6.0/
111      DATA Y58C/-.00048,.00251,
112     1-.00048,.0035,
113     2-.00048,.00477,
114     3-.00048,.00559,
115     4-.00048,.00641/
116C
117C     ----FIGURE 7.1.1.1-8 ELLIPTIC INTEGRAL OF THE STABILITY DERIVATIVE
118C
119      DATA X71118 /0.,.05,.1,.165,.25,.35,.8,1.0/
120      DATA Y71118 /1.0,.995,.985,.966,.940,.90,.705,.631/
121C
122C     ----FIGURE 5.3.1.1-25OO APPARENT MASS FACTORS
123C
124      DATA XA25OO/0.,.2,.4,.6,.8,1.0/
125      DATA XB25OO/0.,.1,.2,.3,.4,.6,.8,1.0/
126      DATA YA25OO/0.,.01,.04,.12,.22,.35/
127      DATA YB25OO/1.275,1.24,1.18,1.08,.95,.69,.51,.35/
128C
129C     ----FIGURE 5.1.1.1-6 ELLIPTIC INTEGRAL FACTOR OF STABILITY DERIV.
130C
131      DATA X51116/0.,.1,.2,.45,.55,.65,.7,.75,.8,.85,.875,.9,.95,.974,
132     1 .99,1.0/
133      DATA Y51116/1.,1.028,1.078,1.241,1.284,1.3,1.287,1.26,1.207,1.125,
134     11.05,.970,.75,.55,.350,0./
135C
136C----FIGURE 7.1.2.2.-25 (A-E) ROLL DAMPING PARAMETER.
137C
138      DATA X12225/0.,1.,2.,2.45,3.,3.31,4.,4.7,5.,5.3,5.75,6.,6.7,7.,8.,
139     19.,10.,
140     20.0,1.,2.,3.,4.,5.,6.,10*0.0,
141     30.0,.25,.50,.75,1.0/
142      DATA Y2225A /-.098,-.1025,-.1067,-.1088,-.0954,-.087,-.075,-.065,
143     1-.0615,-.0585,-.054,-.052,-.047,-.0455,-.0408,-.0363,-.0338      ,
144     2-.098,-.099,-.1008,-.1015,-.099,-.09,-.077,-.0666,-.063,-.06,-.055
145     3,-.0535,-.048,-.0465,-.0414,-.0368,-.0335    , -.098,-.0958,-.0925
146     4,-.0908,-.0888,-.087,-.085,-.071,-.0665,-.064,-.0578,-.0555,-.050,
147     5-.048,-.0424,-.0376,-.034   ,-.085,-.082,-.0814,-.0806,-.079,-.078
148     6,-.0764,-.074,-.073,-.068,-.062,-.060,-.053,-.051,-.044,-.0387,
149     7-.0345   ,-.0748,-.074,3*-.073,-.0729,-.0713,-.0696,-.0686,-.0678,
150     8-.066,-.065,-.056,-.0531,-.046,-.040,-.0350   ,-.0665,-.0668,-.067
151     9,-.067,-.0672,-.067,-.0663,-.065,-.0647,-.064,-.063,-.0627,-.0610,
152     A-.060,-.0497,-.0425,-.037    ,-.0575,-.0585,-.06,-.0605,-.0614,
153     B-.0616,-.0626,-.062,-.0615,-.061,-.060,-.0599,-.0582,-.058,-.0558,
154     C-.0454,-.040 /
155      DATA Y2225B /-.0985,-.116,-.135,-.1285,-.1185,-.113,-.098,-.0865,
156     1-.081,-.077,-.072,-.0695,-.0635,-.061,-.054,-.049,-.0445        ,
157     2-.0985,-.1115,-.125,-.123,-.1165,-.110,-.101,-.0895,-.0833,-.080,
158     3-.073,-.071,-.0645,-.062,-.055,-.0495,-.045    ,-.0985,-.1058,
159     4-.113,-.112,-.1108,-.110,-.101,-.0905,-.085,-.0815,-.075,-.0728,
160     5-.0655,-.063,-.056,-.05,-.0455    ,-.092,-.097,-.1025,-.1028,-.102
161     6,-.101,-.098,-.0925,-.088,-.0845,-.079,-.076,-.069,-.0655,-.058,
162     7-.0516,-.0465    ,-.084,-.0871,-.0905,-.092,-.0936,-.0931,-.0913,
163     8-.089,-.088,-.087,-.082,-.0795,-.0725,-.069,-.061,-.0542,-.049
164     9,-.0765,-.0776,-.0788,-.081,-.083,-.084,-.086,-.0843,-.0835,-.083,
165     A-.0814,-.0806,-.076,-.0731,-.0644,-.057,-.0509   ,-.069,-.0696,
166     B-.070,-.072,-.0739,-.0746,-.077,-.0786,-.0789,-.0783,-.0773,-.077,
167     C-.075,-.0735,-.0684,-.0606,-.0536 /
168      DATA Y2225C /-.098,-.119,-.1375,-.131,-.123,-.118,-.1055,-.095,
169     1-.090,-.086,-.0815,-.0777,-.0712,-.0682,-.0619,-.056,-.0512,
170     2-.098,-.114,-.131,-.127,-.121,-.1175,-.1055,-.0977,-.0938,-.086,
171     3-.0815,-.0782,-.0721,-.069,-.062,-.056,-.0512     ,-.098,-.1088,
172     4-.119,-.1182,-.1155,-.1133,-.1055,-.0977,-.0940,-.089,-.0842,-.081
173     5,-.0730,-.0692,-.0620,-.056,-.0512     ,-.095,-.1011,-.1075,-.1091
174     6,-.1081,-.1078,-.104,-.0977,-.0950,-.0905,-.086,-.0831,-.076,-.073
175     7,-.0645,-.0576,-.052    ,-.0875,-.091,-.094,-.0958,-.0982,-.0996,
176     8-.0985,-.0977,-.0950,-.0915,-.0879,-.0855,-.0791,-.076,-.0675,
177     9-.0605,-.0548      ,-.0816,-.0822,-.0826,-.0843,-.0865,-.0875,
178     A-.0905,-.0906,-.0899,-.0886,-.0879,-.0855,-.0806,-.0778,-.070,
179     B-.063,-.056     ,-.0738,-.073,-.0725,-.0740,-.076,-.0770,-.08,
180     C-.0827,-.084,-.085,-.0845,-.0841,-.083,-.081,-.073,-.0657,-.059  /
181      DATA Y2225D /-.0989,-.120,-.1415,-.1335,-.124,-.119,-.108,-.099,
182     1-.094,-.090,-.0861,-.083,-.0775,-.074,-.066,-.060,-.0545         ,
183     2-.0989,-.1145,-.1311,-.1265,-.120,-.117,-.108,-.099,-.094,-.090,
184     3-.0861,-.083,-.0775,-.074,-.066,-.060,-.0545     ,-.0989,-.108,
185     4-.1171,-.121,-.117,-.1144,-.107,-.100,-.096,-.093,-.0882,-.085,
186     5-.0795,-.075,-.067,-.0605,-.055     ,-.0959,-.0999,-.1038,-.1056,
187     6-.1085,-.111,-.1054,-.100,-.097,-.0935,-.090,-.0865,-.0816,-.0775,
188     7-.069,-.0623,-.0565     ,-.0899,-.0906,-.0915,-.096,-.098,-.099,
189     8-.101,-.100,-.0972,-.0950,-.092,-.089,-.0841,-.0806,-.0725,-.065,
190     9-.0585     ,-.083,-.082,-.081,-.0845,-.088,-.0898,-.093,-.094,
191     A-.0935,-.0934,-.092,-.0900,-.086,-.0825,-.0745,-.067,-.060       ,
192     B-.0765,-.0746,-.073,-.076,-.0798,-.0815,-.0846,-.086,-.0867,-.0875
193     C,-.0875,-.0865,-.0841,-.0825,-.0755,-.0686,-.062  /
194      DATA Y2225E /-.098,-.1135,-.1283,-.130,-.1245,-.1200,-.1090,-.100,
195     1-.0960,-.0915,-.0881,-.0860,-.0794,-.076,-.0681,-.062,-.057      ,
196     2-.098,-.112,-.1255,-.1265,-.1230,-.1190,-.1090,-.100,-.096,-.0915,
197     3-.0881,-.0860,-.0794,-.076,-.0681,-.062,-.057    ,-.098,-.1051,
198     4-.1125,-.1180,-.1178,-.1160,-.1090,-.102,-.0985,-.0935,-.09,-.0868
199     5,-.0815,-.0775,-.0695,-.063,-.0578    ,-.100,-.091,-.1040,-.1083,
200     6-.114,-.1128,-.1075,-.1020,-.0985,-.0950,-.092,-.089,-.0831,-.0795
201     7,-.072,-.065,-.059     ,-.090,-.0912,-.0920,-.0955,-.0994,-.1010,
202     8-.1045,-.102,-.0980,-.0950,-.0930,-.09,-.0850,-.0811,-.073,-.066,
203     9-.0606     ,-.0832,-.0823,-.0815,-.0850,-.0889,-.0910,-.094,-.0956
204     A,-.096,-.096,-.093,-.0905,-.0860,-.083,-.075,-.0682,-.0625       ,
205     B-.076,-.0743,-.0725,-.0751,-.0787,-.0810,-.084,-.0870,-.088,-.089,
206     C-.0895,-.090,-.0867,-.084,-.0767,-.0705,-.065   /
207C
208C  *** CYB WING ALONE ***
209C
210      LF = 0
211      ZH = ZHH-((HTIN(4)-HTIN(3))*AHT(62)+AHT(30))*SIN(ALIH/RAD)
212      SCALE=2.*WINGIN(4)/BLREF
213      MACH=FLC(I +2)
214      BETA=SQRT(MACH**2-1.)
215      NX=BODYIN(1)+.5
216      RLB=BODYIN(NX+1)
217      RM=MACH**2
218      RB=BETA**2
219      IF(WINGIN(13).EQ.UNUSED)WINGIN(13)=0.0
220      IF(WINGIN(12).EQ.UNUSED)WINGIN(12)=0.0
221      IF(WINGIN(14).EQ.UNUSED)WINGIN(14)=0.0
222      ARG=WINGIN(3)-WINGIN(12)
223      DIHEQ=(WINGIN(13)*ARG+WINGIN(14)*WINGIN(12))/WINGIN(3)
224      IF(WINGIN(15).NE.WTYPE(1)) GO TO 1060
225      IF(SWEPE.EQ.0.AND.TAPR.EQ.1.AND.(AR*BETA.GE.1.0))GO TO 1000
226      ARG=BETA/.00001
227      IF(TANLE.NE.0.0)ARG=BETA/TANLE
228      IF(TAPR .EQ. 0.0 .AND. (ARG .LT. .998))GO TO 1020
229      GO TO 1040
230 1000 CONTINUE
231      X=XW+0.5*CR-XCG
232      ARG1= 1./(PI*AR**2*RB)
233      ARG2=4.*RM/3.+8.*RM*X/CRBAR
234      ARG3=PI* AR*(1.-RB)*(3.+RB)/(3.*BETA**3)
235      DO 1010 J=1,NALPHA
236         ALP= (ALPHA(J)/RAD)**2
237         CYBW(J)=-ALP*8.0*RM/(RAD*PI*RB*AR) -.0001*ABS(DIHEQ)
238C
239C  *** CNB WING ALONE ***
240C
241         CNBW(J)=SCALE*ALP*ARG1*(ARG2-ARG3)/RAD
242 1010 CONTINUE
243      GO TO 1040
244 1020 CONTINUE
245C                        FIGURE 5.1.1.1-6 (1./Q(BC))
246      VAR(1)=ARG
247      LGH(1)=16
248      CALL INTERX(1,X51116,VAR,LGH,Y51116,QBC,16,16,
249     10,0,0,0,0,0,0,0,Q51116,3,ROUTID)
250C
251C                            FIGURE 7.1.1.1-8 (EBC)
252C
253      LGH(1)=8
254      CALL INTERX(1,X71118,VAR,LGH,Y71118,EBC,8,8,
255     10,0,0,0,0,0,0,0,Q71118,3,ROUTID)
256      ARG1= PI*AR*RM/(4.*RAD*QBC)
257      X=XW+.6666*SPAN*TANLE-XCG
258      ARG2=PI/3.*(EBC+(AR**2/16.+X/CRBAR)*RM/QBC)/RAD
259      DO 1030 J=1,NALPHA
260         ALP= (ALPHA(J)/RAD)**2
261         CYBW(J)=-ALP*ARG1-.0001*ABS(DIHEQ)
262         CNBW(J)=SCALE*ALP*ARG2
263 1030 CONTINUE
264 1040 CONTINUE
265C
266C *** CLB WING ALONE ***
267C                      FIGURE 7.1.2.2-25A-E  (CLPTOA)
268      VAR(1)=BETA*AR
269      VAR(2)=AR*TANMID
270      VAR(3)=TAPR
271      LGH(1)=17
272      LGH(2)=7
273      LGH(3)=5
274      CALL INTERX(3,X12225,VAR,LGH,Y12225,CLPTOA,17,597,
275     10,0,0,0,2,2,0,0,Q225AE,3,ROUTID)
276      CLP= CLPTOA*AR*CLPCTY
277      CLBD=2.*DIHEQ*(1.+2.*TAPR)*CLP/(RAD**2.*(1.+3.*TAPR))
278      ARG1=(1.+TAPR*(1.+SWEPE))*(1.+SWEPE/2.)*TANLE/BETA
279      ARG2= RM*COSLE**2/AR+(ABS(TANLE/4.))**1.3333
280      DO 1050 J=1,NALPHA
281         CLBW(J)=SCALE*(CLBD-0.061*CNW(J)*CNAW*ARG1*ARG2/RAD)
282 1050 CONTINUE
283C
284C  *** CYB WING-BODY ***
285C
286 1060 IF(.NOT.BO)RETURN
287      SPANIN=SPAN-SPANO
288      ARG=SIN(SYNA(4)/RAD)
289      ZW=-SYNA(3)+(.25*A(10)+BD(66))*ARG-SPANIN*TAN(WINGIN(13)/RAD)
290      ARG=ZW/(SPANIN)
291      RKI= 1.0+.49*ARG
292      IF(ARG.LT.0.0)RKI=1.0-.85*ARG
293      CYBWB=-RKI*CLAB-0.0001*ABS(DIHEQ)
294C
295C  *** CNB WING-BODY ***
296C
297      RNN=FLC(I +42)*RLB
298C                          EQUATION FOR FIGURE 5.2.3.1-9 KRL
299      RKRL=1.+ALOG(1.E-6*RNN)/4.86
300      ARG11=1.0
301      NV=BODYIN(1)+.5
302      QL=RLB*.25
303      TFL=RLB*.75
304      I1=0
305      I2=0
306      CALL TBFUNX(QL,RH1,DYDX,NV,BODYIN(2),BODYIN(62),C1,I1,MI,NG,
307     10,0,4HRH1 ,1,ROUTID)
308      RH1=2.*RH1
309      CALL TBFUNX(TFL,RH2,DYDX,NV,BODYIN(2),BODYIN(62),C2,I2,MI,NG,
310     10,0,4HRH2 ,1,ROUTID)
311      RH2=2.*RH2
312      ARG12=SQRT(RH1/RH2)
313      CALL TRAPZ(BODYIN(62),NV,BODYIN(2),SBS,1)
314      SBS=2.*SBS
315      ARG13=RLB**2/SBS
316      ARG14=XCG/RLB
317C
318C                   FIGURE 5.2.3.1-8 (KN)
319C
320      CALL TLINEX(X158A,X258A,Y58A,10,2,ARG13,ARG14,YDUMY,
321     1           2,1,2,1,Q52318,3,ROUTID)
322      CALL TLINEX(X158B,X258B,Y58B,5,3,ARG12,YDUMY,YDUMY2,
323     1           2,0,2,1,Q52318,3,ROUTID)
324      CALL TLINEX(X158C,X258C,Y58C,5,2,ARG11,YDUMY2,RKN,
325     1          2,0,2,1,Q52318,3,ROUTID)
326      CNBWB=-RKN*RKRL*SBS*RLB/(SR*BLREF)
327      IF(WINGIN(15).NE.WTYPE(1)) GO TO 1080
328C
329C  *** CLB WING-BODY ***
330C
331      ZWP= ZW+CR*SIN(ALPHAI/RAD)/4.0
332      ARG1=SQRT(AR)
333      DBODY = 2.0*SPANIN
334      CLBZW =  0.6*ARG1*ZWP*DBODY/(RAD*SPAN**2)
335      ARG= (DBODY/(2.*SPAN))**2*DIHEQ
336      DCLB=-0.0005*ARG1*ARG
337      ARG2=CLBZW+DCLB
338      DO 1070 J=1,NALPHA
339      CLBWB(J)=CLBW(J)+ARG2*SCALE
340      BWV(J+180)=BWI(J+180)
341 1070 CONTINUE
342      BWV(141)=BWI(141)
343      BWV(161)=BWI(161)
344 1080 CONTINUE
345C
346C       ***HORIZONTAL TAIL ADDED TO WING-BODY***
347C
348      IF(.NOT.HTPL)GO TO 1110
349      RH= HTIN(4)-HTIN(3)
350C
351C              FIGURE 5.3.1.1-25OO (KH(B))HL=RKHBHL
352C
353      IF(ABS(ZH).GT.RH.OR.(ZH/RH.EQ.0.0))GO TO 1110
354      ARG=RH/HTIN(4)
355      IF(ARG.LT.1.0)GO TO 1090
356      VAR(1)=1./ARG
357      LGH(1)=6
358      CALL INTERX(1,XA25OO,VAR,LGH,YA25OO,RKHBHL,6,6,
359     1            0,0,0,0,0,0,0,0,Q125OO,3,ROUTID)
360      GO TO 1100
361 1090 VAR(1)=ARG
362      LGH(1)=8
363      CALL INTERX(1,XB25OO,VAR,LGH,YB25OO,RKHBHL,8,8,
364     1            0,0,0,0,0,0,0,0,Q125OO,3,ROUTID)
365 1100 RKHB=RKHBHL*(1.-(1.-(ZH/RH)**2)**0.5)
366      DCYHWB=-RKHB*CLAB*SHB(I)/SEXT(I)
367      GO TO 1120
368 1110 DCYHWB=0.0
369      IF(.NOT. HTPL) GO TO 1120
370      IF((ZH/RH) .NE. 0.0) LF = 1
371 1120 CONTINUE
372      IF(.NOT. HTPL) GO TO 1140
373      BWH(141)=CYBWB+DCYHWB
374      BWH(161)=CNBWB-DCYHWB*RLPH(I)/BLREF
375      BWHV(141) = BWH(141)
376      BWHV(161) = BWH(161)
377      IF(WINGIN(15).NE.WTYPE(1)) GO TO 1140
378      DO 1130 J=1,NALPHA
379         BWH(J+180)=CLBWB(J)
380         BWV(J+180)=BWI(J+180)
381         BWHV(J+180)=BWH(J+180)
382 1130 CONTINUE
383 1140 CONTINUE
384      RETURN
385      END
386