1      SUBROUTINE SUBHYW
2C
3C     THIS ROUTINE YIELDS THE SUBSONIC H.T.,H.T.-BODY
4C     ROLLING DERIVATIVE CLP
5C
6      COMMON /OVERLY/ NLOG,NMACH,IM,NALPHA
7      COMMON /OPTION/ SR,CBARR,RUFF,BLREF
8      COMMON /CONSNT/ PI,DR,UNUSED,RAD
9      COMMON /FLGTCD/ FLC(93)
10      COMMON /SYNTSS/ SYNA(19)
11      COMMON /HTDATA/ A(195),B(49)
12      COMMON /HTI/    WINGIN(77)
13      COMMON /IHT/    PWING, WING(380)
14      COMMON /BDATA/  BD(300),DYN(213)
15      COMMON /WHAERO/ DUM1(106),C(51)
16      COMMON /SBETA/  DUM2(351),STB(135)
17      COMMON /FLOLOG/ FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,
18     1                HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,
19     2                SUPERS,SUBSON,TRANSN,HYPERS,
20     3                SYMFP,ASYFP,TRIMC,TRIM
21      LOGICAL FLTC,OPTI,BO,WGPL,WGSC,SYNT,HTPL,HTSC,VTPL,VTSC,
22     1        HEAD,PRPOWR,JETPOW,LOASRT,TVTPAN,
23     2        SUPERS,SUBSON,TRANSN,HYPERS,
24     3        SYMFP,ASYFP,TRIMC,TRIM
25      INTEGER Y71336,D11336,D21336,D31336,Y71337,D11337,D21337,D31337,
26     1 Y2220A,D1220A,D2220A,Y2220B,Y2220C,Y2220D,D1220D,D2220D,Y12224,
27     2 Y12312,Y1219B,Y1219C
28      INTEGER Y7133A
29      REAL LAMCO4,MACOE
30      REAL MACH,LAMB,KAY(20),K,LAMDA
31      DIMENSION ROUTID(2)
32      DIMENSION CL(20),ALSCHD(20),Z(6),CLSUB(20),ALSCH2(20),
33     1 DCLPD(20),CLPWBS(20),CLTAN(20),CDCDO(20),CL2PAW(20),CD(20)
34      DIMENSION Y(6),D(6),E(6),G(6),H(6),O(6),P(6)
35      DIMENSION CLA(20),DCDDA(20),DCADA(20)
36      DIMENSION CLPTAN(20),DCLDA(20),CDOO(20)
37      DIMENSION CYPWBS(20),I2A219(4),QEXPD(5),
38     1          QIMPR1(4),QIMPR2(4),QIMPR3(4),Q71336(3),Q71337(3)
39      DIMENSION X11336(4),X21336(15),X31336(3),Y71336( 90),
40     1          D11336(30),D21336(30),D31336(30)
41      DIMENSION X1133A(2),X2133A(2),Y7133A(2)
42      DIMENSION X11337(4),X21337(9),X31337(3),Y71337( 54),
43     1          D11337(18),D21337(18),D31337(18)
44      DIMENSION X1220A( 13),X2220A( 17),Y2220A( 111),Q2220A(3)
45      DIMENSION D1220A( 97),D2220A(14)
46      DIMENSION X1220B( 13),X2220B( 10),Y2220B(  65),Q2220B(3)
47      DIMENSION X1220C( 13),X2220C( 10),Y2220C(  65),Q2220C(3)
48      DIMENSION X1220D( 13),X2220D( 18),Y2220D( 117),Q2220D(3)
49      DIMENSION D1220D( 97),D2220D(20)
50      DIMENSION X12224(  8),X22224( 10),Y12224(  40),Q12224(3)
51      DIMENSION X12312(  6),X22312(  8),Y12312(  24),Q12312(3)
52      DIMENSION X1219A( 10),Y1219A(  10),Q1219A(3)
53      DIMENSION X1219B(  8),X2219B(  2),Y1219B(   8),Q1219B(3)
54      DIMENSION X1219C(  3),X2219C(  2),Y1219C(   3),Q1219C(3)
55      DIMENSION CNPWBS(20)
56      DIMENSION CNRWBS(20)
57      EQUIVALENCE (DCMDCL,DYN(21)),(MACOE,A(16))
58      EQUIVALENCE (CL(1),WING(21))
59      EQUIVALENCE (ZW,SYNA(7)),(ZCG,SYNA(5)),(GEG,STB(122)),
60     1  (ALSCHD(1),FLC(23)),(SSPN,WINGIN(4)),(SSPNE,WINGIN(3)),
61     2  (LAMCO4,A(64)),(SW,A(4)),(TANCO4,A(68)),
62     3  (LAMDA,A(27)),(CD(1),WING(1)),(ASTRW,A(120))
63      EQUIVALENCE (ALSD,DYN(44)),(CLACLO,DYN(45)),(CDO,DYN(94)),
64     1          (CLA(1),DYN(47)),(ZEE,DYN(67)),(CLPCLP,DYN(68)),
65     2          (CLPCL2,DYN(69)),(BAOK,DYN(70)),(BCLPCL,DYN(71)),
66     3          (DCLPD(1),DYN(72)),(CLPWBS(1),WING(281)),
67     4    (DCLDA(1),DYN(96)),(DCDDA(1),DYN(116)),(DCADA(1),DYN(136)),
68     5    (KAY(1),DYN(156)),(CNPWBS(1),WING(321))
69      EQUIVALENCE (CYPWBS(1),WING(301)),
70     1            (CDOO(1),DYN(184)),(CNRWBS(1),WING(341))
71      EQUIVALENCE (D11336(1),Y71336(1)),(D21336(1),Y71336(31)),
72     1            (D31336(1),Y71336( 61))
73      EQUIVALENCE (D11337(1),Y71337(1)),(D21337(1),Y71337(19)),
74     1            (D31337(1),Y71337(37))
75      EQUIVALENCE (D1220A(1),Y2220A(1)),(D2220A(1),Y2220A( 98))
76      EQUIVALENCE (D1220D(1),Y2220D(1)),(D2220D(1),Y2220D( 98))
77      DATA ROUTID /4HSUBH,4HYW  /
78      DATA I2A219 /10,3*0/
79      DATA IN /0/, IX/0/, IO/0/, IP/0/, IQ/0/, IR/0/, IS/0/, IT/0/
80      DATA QEXPD  /4HEXPE,4HRIME,4HNTAL,4H DAT,4HA   /
81      DATA Q12224 /4H7.1.,4H2.2-,4H24  /
82      DATA Q12312 /4H7.1.,4H2.3-,4H12  /
83      DATA QIMPR1 /4HCLTA,4HN VS,4H ALS,4HCHD /
84      DATA QIMPR2 /4HCDCD,4HO VS,4H ALS,4HCHD /
85      DATA QIMPR3 /4HCL2P,4HAW V,4HS AL,4HSCHD/
86      DATA Q71336 /4H7.1.,4H3.3-,4H6   /
87      DATA Q71337 /4H7.1.,4H3.3-,4H7   /
88C
89C      ----FIGURE 7.1.2.2-20A
90C
91      DATA Q2220A /4H7.1.,4H2.2-,4H20A /
92      DATA X1220A /  .100E 02,  .900E 01,  .800E 01,  .700E 01,
93     1  .600E 01,  .500E 01,  .450E 01,  .400E 01,  .350E 01,  .300E 01,
94     2  .250E 01,  .200E 01,  .150E 01/
95      DATA X2220A / -.193E 02, -.989E 01, -.437E 01,  .134E-01,
96     1  .104E 02,  .143E 02,  .203E 02,  .251E 02,  .300E 02,  .355E 02,
97     2  .402E 02,  .445E 02,  .505E 02,  .547E 02,  .598E 02,  .651E 02,
98     3  .702E 02/
99C
100C      ----FIGURE 7.1.2.2-20B
101C
102      DATA Q2220B /4H7.1.,4H2.2-,4H20B /
103      DATA X1220B /  .100E 02,  .900E 01,  .800E 01,  .700E 01,
104     1  .600E 01,  .500E 01,  .450E 01,  .400E 01,  .350E 01,  .300E 01,
105     2  .250E 01,  .200E 01,  .150E 01/
106      DATA X2220B / -.201E 02, -.105E 02,  .230E 00,  .994E 01,
107     1  .197E 02,  .300E 02,  .403E 02,  .499E 02,  .604E 02,  .703E 02/
108C
109C      ----FIGURE 7.1.2.2-20C
110C
111      DATA Q2220C /4H7.1.,4H2.2-,4H20C /
112      DATA X1220C /  .100E 02,  .900E 01,  .800E 01,  .700E 01,
113     1  .600E 01,  .500E 01,  .450E 01,  .400E 01,  .350E 01,  .300E 01,
114     2  .250E 01,  .200E 01,  .150E 01/
115      DATA X2220C / -.193E 02, -.937E 01,  .893E-01,  .105E 02,
116     1  .208E 02,  .304E 02,  .405E 02,  .505E 02,  .607E 02,  .704E 02/
117C
118C      ----FIGURE 7.1.2.2-20D
119C
120      DATA Q2220D /4H7.1.,4H2.2-,4H20D /
121      DATA X1220D /  .100E 02,  .900E 01,  .800E 01,  .700E 01,
122     1  .600E 01,  .500E 01,  .450E 01,  .400E 01,  .350E 01,  .300E 01,
123     2  .250E 01,  .200E 01,  .150E 01/
124      DATA X2220D / -.200E 02, -.965E 01, -.458E 01,  .293E-01,
125     1  .556E 01,  .995E 01,  .148E 02,  .203E 02,  .245E 02,  .301E 02,
126     2  .354E 02,  .400E 02,  .447E 02,  .502E 02,  .553E 02,  .602E 02,
127     3  .646E 02,  .698E 02/
128C
129C      ----FIGURE 7.1.2.2-24
130C
131      DATA X12224 /  .700E 02,  .600E 02,  .500E 02,  .400E 02,
132     1  .300E 02,  .200E 02,  .100E 02,  .000E 00/
133      DATA X22224 /  .196E 01,  .252E 01,  .302E 01,  .350E 01,
134     1  .402E 01,  .505E 01,  .599E 01,  .700E 01,  .804E 01,  .100E 02/
135C
136C      ----FIGURE 7.1.2.3-12
137C
138      DATA X12312 /  .100E 01,  .800E 00,  .600E 00,  .400E 00,
139     1  .200E 00,  .000E 00/
140      DATA X22312 /  .202E 01,  .307E 01,  .404E 01,  .502E 01,
141     1  .603E 01,  .808E 01,  .100E 02,  .120E 02/
142C
143C      ----FIGURE 7.1.2.1-9A
144C
145      DATA Q1219A /4H7.1.,4H2.1-,4H9A  /
146      DATA X1219A /  .822E 00,  .109E 01,  .144E 01,  .207E 01,
147     1  .257E 01,  .316E 01,  .398E 01,  .462E 01,  .531E 01,  .600E 01/
148      DATA Y1219A /  .452E 01,  .381E 01,  .297E 01,  .215E 01,
149     1  .147E 01,  .966E 00,  .486E 00,  .279E 00,  .117E 00,  .154E-06/
150C
151C      ----FIGURE 7.1.2.1-9B
152C
153      DATA Q1219B /4H7.1.,4H2.1-,4H9B  /
154      DATA X1219B /  .700E 02,  .650E 02,  .600E 02,  .450E 02,
155     1  .300E 02,  .000E 00, -.300E 02, -.450E 02/
156      DATA X2219B / 0.0,4.5/
157C
158C      ----FIGURE 7.1.2.1-9C
159C
160      DATA Q1219C /4H7.1.,4H2.1-,4H9C  /
161      DATA X1219C /  .000E 00,  .500E 00,  .100E 01/
162      DATA X2219C /  .453E 01, -.963E 00/
163      DATA X11336 /  .600E 02,  .500E 02,  .400E 02,  .000E 00/
164      DATA X21336 /  .101E 01,  .126E 01,  .151E 01,  .178E 01,
165     1  .201E 01,  .244E 01,  .299E 01,  .352E 01,  .400E 01,  .501E 01,
166     2  .599E 01,  .698E 01,  .799E 01,  .902E 01,  .994E 01/
167      DATA X31336 /0.0,0.2,0.4/
168C
169C      ----FIGURE 7.1.3.3-6D
170C
171      DATA X1133A /0.0,1.0/
172      DATA X2133A /0.0,4.0/
173      DATA X11337 /  .000E 00,  .400E 02,  .500E 02,  .600E 02/
174      DATA X21337 /  .103E 01,  .144E 01,  .197E 01,  .297E 01,
175     1  .397E 01,  .503E 01,  .606E 01,  .706E 01,  .803E 01/
176      DATA X31337 /0.0,0.2,0.4/
177C
178C****    IN THE FOLLOWING DATA STATEMENTS 2 FLOATING POINT NUMBERS,WITH
179C        3 SIGNIFICANT DIGITS EACH,ARE PACKED IN 1 FIXED POINT WORD.
180C
181C        THE FORMAT IS AS FOLLOWS-
182C
183C        SIGN1,NS2,NSPS,NP1,NP2,ND1,ND2
184C
185C        WHERE-
186C
187C        SIGN1 IS THE ACTUAL SIGN OF THE 1ST NUMBER
188C        NS2   REPRESENTS THE SIGN OF THE 2ND NUMBER.0 IF + , 1 IF -
189C        NSPS  REPRESENTS THE SIGNS OF THE POWERS OF 10 FOR BOTH NUMBERS
190C             0 IF ++ , 1 IF -- , 2 IF +- , 3 IF -+
191C        NP1   IS THE POWER OF 10 FOR THE 1ST NUMBER. LIMITED TO 1 DIGIT
192C        NP2   IS THE POWER OF 10 FOR THE 2ND NUMBER. LIMITED TO 1 DIGIT
193C        ND1  3 DIGITS OF THE 1ST NUMBER (DECIMAL POINT AT END)
194C        ND2  3 DIGITS OF THE 2ND NUMBER (DECIMAL POINT AT END)
195C
196      DATA D11336/  122392378,  122366359,  122352345,  122335325,
197     1  122320318,  122314315,  122313316,  122317157,  122167177,
198     2  122181187,  122204212,  122218226,  122234241,  122241242,
199     3  122240239,  133758974,  122116132,  122142160,  122176185,
200     4  122200209,  122216221,  122224222,  124225341,  133325655,
201     5  132872102,  122127147,  122160173,  122189201,  122206206,
202     6  122207205/
203      DATA D21336/  122762654,  122584539,  122499463,  122436427,
204     1  122418408,  122404404,  122402403,  122403381,  122349331,
205     2  122322312,  122300299,  122297295,  122290289,  122282283,
206     3  122279279,  122253253,  122253253,  122253256,  122258261,
207     4  122265270,  122273273,  122272272,  122268175,  122180185,
208     5  122191196,  122209218,  122222229,  122245253,  122255260,
209     6  122261261/
210      DATA D31336/  111160130,  122950630,  122572509,  122462437,
211     1  122416388,  122379371,  122370371,  121373150,  122450447,
212     2  122369347,  112112630,  122291284,  122281278,  122280281,
213     3  122280283,  122351293,  122272247,  122242230,  122225225,
214     4  122224223,  122222228,  122236242,  123259951,  132994111,
215     5  122125130,  122141159,  122169178,  122196204,  122206206,
216     6  122206205/
217      DATA D11337/-1133563462,-1133383332,-1133310299,-1133293293,
218     1-1133293569,-1133501468,-1133451456,-1133456456,-1133456451,
219     2-1133670644,-1133608608,-1133619631,-1133631637,-1133642975,
220     3-1133953952,-1132979101,-1122102103,-1122103103/
221      DATA D21337/-1133743503,-1133440371,-1133331297,-1133291291,
222     1-1133291759,-1133560480,-1133457451,-1133457457,-1133463469,
223     2-1133806669,-1133623606,-1133611623,-1133634640,-1132646106,
224     3-1133985949,-1133971988,-1122101101,-1122102102/
225      DATA D31337/-1133978712,-1133518417,-1133364346,-1133340334,
226     1-1132340102,-1133712538,-1133500472,-1133465465,-1133471471,
227     2-1123107796,-1133664614,-1133626638,-1133644650,-1132656121,
228     3-1123104979,-1132995101,-1122101103,-1122104105/
229      DATA D1220A/-1133347366,-1133375377,-1133379378,-1133376372,
230     1-1133361354,-1133338321,-1133298280,-1133248215,-1133177339,
231     2-1133357361,-1133365369,-1133368363,-1133359353,-1133339325,
232     3-1133308288,-1133267237,-1133211175,-1133326340,-1133345353,
233     4-1133355355,-1133353347,-1133339329,-1133316301,-1133281258,
234     5-1133230206,-1133170310,-1133323329,-1133334338,-1133338336,
235     6-1133332326,-1133319305,-1133290268,-1133251227,-1133198169,
236     7-1133289303,-1133307311,-1133318318,-1133316310,-1133305298,
237     8-1133287276,-1133256241,-1133214192,-1133160267,-1133283286,
238     9-1133289289,-1133292289,-1133286284,-1133280268,-1133261247,
239     A-1133230208,-1133184157,-1133254266,-1133273277,-1133281281,
240     B-1133279277,-1133270267,-1133259250,-1133233222,-1133198179,
241     C-1133151242,-1133250255,-1133261263,-1133263263,-1133262256,
242     D-1133253247,-1133241228,-1133214193,-1133175150,-1133227232,
243     E-1133238242,-1133245246,-1133245243,-1133239233,-1133230224,
244     F-1133212203,-1133184169,-1133140205,-1133211214,-1133216220,
245     G-1133222222,-1133222219,-1133218213,-1133209198,-1133192176,
246     H-1133159139,-1133184190,-1133191193,-1133194194,-1133195195,
247     I-1133194193,-1133193191,-1133184176,-1133161151,-1133131159,
248     J-1133162164,-1133164168,-1133169169/
249      DATA D2220A/-1133169169,-1133165164,-1133161157,-1133156150,
250     1-1133137120,-1133133132,-1133133134,-1133133134,-1133133133,
251     2-1133133134,-1133133132,-1133129124,-1133120114, -330102000/
252      DATA Y2220B/-1133464486,-1133500494,-1133484457,-1133419364,
253     1-1133298218,-1133445465,-1133479473,-1133463441,-1133407354,
254     2-1133291215,-1133428444,-1133450449,-1133437419,-1133388344,
255     3-1133287209,-1133407414,-1133422422,-1133415398,-1133372331,
256     4-1133276202,-1133375386,-1133391392,-1133385377,-1133353320,
257     5-1133270199,-1133340353,-1133358358,-1133353342,-1133325296,
258     6-1133255189,-1133325330,-1133334334,-1133331324,-1133310299,
259     7-1133247190,-1133300304,-1133312307,-1133305301,-1133288270,
260     8-1133237183,-1133278280,-1133282282,-1133281276,-1133268251,
261     9-1133221178,-1133245248,-1133251251,-1133250248,-1133241232,
262     A-1133208167,-1133221221,-1133222221,-1133220217,-1133215206,
263     B-1133192161,-1133183182,-1133182181,-1133180180,-1133178174,
264     C-1133162140,-1133138139,-1133141141,-1133141141,-1133142141,
265     D-1133134124/
266      DATA Y2220C/-1133523535,-1133539534,-1133519496,-1133456407,
267     1-1133337245,-1133503509,-1133513505,-1133499475,-1133441390,
268     2-1133317234,-1133470483,-1133486483,-1133470454,-1133421375,
269     3-1133312228,-1133445451,-1133453451,-1133445428,-1133400355,
270     4-1133298223,-1133410415,-1133420414,-1133409392,-1133370338,
271     5-1133287213,-1133371376,-1133377375,-1133371358,-1133338314,
272     6-1133269204,-1133343349,-1133354353,-1133349339,-1133321299,
273     7-1133260204,-1133320320,-1133322322,-1133319316,-1133300280,
274     8-1133245199,-1133293297,-1133298297,-1133295286,-1133278264,
275     9-1133238189,-1133264264,-1133263264,-1133262259,-1133248239,
276     A-1133220180,-1133226226,-1133225226,-1133224222,-1133219207,
277     B-1133191165,-1133188188,-1133189187,-1133186186,-1133180172,
278     C-1133163145,-1133149149,-1133149149,-1133148147,-1133146142,
279     D-1133134121/
280      DATA D1220D/-1133560573,-1133575575,-1133573567,-1133560546,
281     1-1133539520,-1133502481,-1133461430,-1133398367,-1133335280,
282     2-1133538545,-1133546546,-1133544542,-1133537525,-1133518501,
283     3-1133484464,-1133446415,-1133384353,-1133319269,-1133508517,
284     4-1133519517,-1133515512,-1133507499,-1133487475,-1133462442,
285     5-1133425396,-1133367339,-1133305266,-1133469477,-1133480480,
286     6-1133477471,-1133469463,-1133454448,-1133434418,-1133401376,
287     7-1133350321,-1133290246,-1133431434,-1133435435,-1133433431,
288     8-1133428423,-1133416409,-1133397383,-1133371350,-1133322299,
289     9-1133273232,-1133385390,-1133391390,-1133389386,-1133384378,
290     A-1133375368,-1133360353,-1133340325,-1133304284,-1133260224,
291     B-1133359361,-1133361362,-1133362360,-1133360356,-1133354347,
292     C-1133339334,-1133323307,-1133288271,-1133249216,-1133332334,
293     D-1133334334,-1133333333,-1133331329,-1133325322,-1133317310,
294     E-1133302290,-1133276257,-1133237208,-1133265266,-1133266266,
295     F-1133266265,-1133265264,-1133262261,-1133258255,-1133250246,
296     G-1133234222,-1133209183,-1133298300,-1133302302,-1133302301,
297     H-1133300298,-1133298293,-1133289284,-1133280267,-1133255243,
298     I-1133225197,-1133230230,-1133230230,-1133230231,-1133230230,
299     J-1133229228,-1133224223,-1133219216/
300      DATA D2220D/-1133208198,-1133188170,-1133189190,-1133190190,
301     1-1133190189,-1133188187,-1133187184,-1133183181,-1133179175,
302     2-1133171163,-1133156143,-1133148146,-1133146145,-1133145145,
303     3-1133146146,-1133145145,-1133144142,-1133142141,-1133141139,
304     4-1133135122/
305      DATA Y12224/-1133407331,-1133278240,-1133216175,-1133146127,
306     1-1134112891,-1133171137,-1133116103,-1144901734,-1144620532,
307     2-1144456365,-1144918736,-1144606535,-1144467381,-1144344280,
308     3-1144239183,-1144567428,-1144382349,-1144297232,-1144183177,
309     4-1144160125,-1144400303,-1144267223,-1144193165,-1144149120,
310     5-1144114103,-1144302225,-1144199187,-1144159131,-1145103856,
311     6-1155683804,-1144230201,-1144165141,-1145136843,-1155686624,
312     7-1155338463,-1144221179,-1144153141,-1145113850,-1155687398,
313     8-1155341456/
314      DATA Y12312/-1166968781,-1166626494,-1166388197, -176319113,
315     1-1166941724,-1166541382, -168238339,  166218422,-1166885655,
316     2-1166450256, -176949195,  166454705,-1166777520,-1166300113,
317     3  176533337,  166590825,-1166548303, -177979781,  166231499,
318     4  166724919, -176387127,  166264371,  166473661,  166827994/
319      DATA Y1219B/ 122468642 , 122368554 , 122300494 , 122176413,
320     1 122111372 , 132160292 , -132680236 ,-122168172/
321      DATA Y1219C/ 1123153677, 1123161573 , 1123182380 /
322      DATA Y7133A/-133110100,-134127830/
323C
324      BETA=B(2)
325      IF( HTPL.AND.(.NOT.BO))GO TO 1000
326      DB=(SSPN-SSPNE)/SSPN
327      IF(DB.GT.0.3)RETURN
328 1000 K=BETA*WINGIN(IM+20)*RAD/(2.*PI)
329      MACH=FLC(IM+2)
330      XYZ=0.
331C
332C     H.T.-BODY ROLLING DERIVATIVE,CLP---
333C
334      CALL TBFUNX(XYZ,ALSD,DYDX,NALPHA,CL,ALSCHD,Y,IN,MI,NG,1,1,QEXPD,5,
335     1            ROUTID)
336      CALL TBFUNX(XYZ,CDO,DYDX,NALPHA,CL,CD,D,IO,MI,NG,2,2,
337     1            QEXPD,5,ROUTID)
338      IF(CL(1).LE.0..AND.CL(NALPHA).GE.0.) GO TO 1005
339      NNALPH=NALPHA+1
340      IF(CL(1).LT.0.) GO TO 1002
341      CLSUB(1)=0.
342      ALSCH2(1)=ALSD
343      DO 1001 J=1,NALPHA
344         CLSUB(J+1)=CL(J)
345 1001 ALSCH2(J+1)=ALSCHD(J)
346      GO TO 1004
347 1002 CLSUB(NNALPH)=0.
348      ALSCH2(NNALPH)=ALSD
349      DO 1003 J=1,NALPHA
350         CLSUB(J)=CL(J)
351 1003 ALSCH2(J)=ALSCHD(J)
352 1004 CALL TBFUNX(ALSD,ABCD,CLACLO,NNALPH,ALSCH2,CLSUB,E,IX,MI,
353     1            NG,1,1,QEXPD,5,ROUTID)
354      GO TO 1006
355 1005 CALL TBFUNX(ALSD,ABCD,CLACLO,NALPHA,ALSCHD,CL,Z,IX,MI,
356     1            NG,1,1,QEXPD,5,ROUTID)
357 1006 CONTINUE
358      XBOCB=-DCMDCL*CBARR/MACOE
359      DO 1010 I=1,NALPHA
360         CALL TBFUNX(ALSCHD(I),CDEF,CLA(I),NALPHA,ALSCHD,CL,G,IQ,MI,NG,
361     1               0,0,QEXPD,5,ROUTID)
362 1010 CONTINUE
363      ZEE=ZW-ZCG
364      SINGEG=SIN(GEG/RAD)
365      CLPCLP=1.-2.*ZEE*SINGEG/SSPN+3.*(ZEE/SSPN)**2*SINGEG**2
366      LAMB=RAD*ATAN(TANCO4/BETA)
367C
368C           -- FIGURE 7.1.2.2-24 --
369C
370      CALL TLIP2X(X12224,X22224,Y12224,8,10,LAMCO4,ASTRW,CLPCL2,
371     1            1,1,1,1,Q12224,3,ROUTID)
372      SRSW=SR/SW
373      AAAA=4.*SSPN**2/(RAD*SRSW*BLREF**2)
374      BAOK  =BETA*ASTRW/K
375C
376C              FIGURE 7.1.2.2-20 A-D
377C
378      CALL INTEP3(BAOK,LAMB,LAMDA,X1220A,X2220A,Y2220A,13,17,Q2220A,
379     1            X1220B,X2220B,Y2220B,13,10,Q2220B,
380     2            X1220C,X2220C,Y2220C,13,10,Q2220C,
381     3            1,1,1,1,1,1,
382     4            X1220D,X2220D,Y2220D,13,18,Q2220D,BCLPCL)
383      BBBB=AAAA*BCLPCL*K*CLPCLP/(BETA*CLACLO)
384      DO 1020 I=1,NALPHA
385         CLT=CL(I)*SRSW
386         DCLPD(I)=CLPCL2*CLT**2-CDO/8.*SRSW
387         CLPWBS(I)=BBBB*CLA(I)+AAAA*DCLPD(I)
388 1020 CONTINUE
389      RETURN
390      END
391