1      SUBROUTINE CALCA0(A,B,AIN)
2C
3C***  COMPUTES LIFTING SURFACE ALPHA ZERO LIFT
4C
5      COMMON /CONSNT/ PI,DEG,UNUSED,RAD
6      DIMENSION ROUTID(2)
7      DIMENSION A(195),B(49),AIN(64)
8      DIMENSION TR(3),AR(4),SAQC(22),DA0OT(22,10),DA(220)
9      DIMENSION DAP(132),DAPP(88)
10      EQUIVALENCE (DAP(1),DA(1)),(DAPP(1),DA(133))
11      DIMENSION NPT(7),LOCX(7),LOCY(7),CC(6,7),IN(7),MI(7)
12      DIMENSION TOC(7) , CX(12),CY(33)
13      LOGICAL CAMBER,NOINTP,NOINT2 , NOINT3
14      EQUIVALENCE (CAMBER,CAFAKE)
15      EQUIVALENCE (DA0OT(1,1) , DA(1))
16      DIMENSION Q41315(3)
17      DATA Q41315 /4H4.1.,4H3.1-,4H5   /
18      DATA ROUTID /4HCALC,4HA0  /
19      DATA TR     /0.,.5,1./ , AR/1.5,3.5,6.0,10./
20      DATA SAQC   /-45.,-40.,-35.,-30.,-25.,-20.,-15.,-10.,-5.,0.,
21     1    5.,10.,15.,20.,25.,30.,35.,40.,45.,50.,55.,60./
22      DATA DAP/-.399  ,-.3995 ,-.400  ,-.400  ,-.4005 ,-.4005 ,-.4005 ,
23     1 -.4005 ,-.4005 ,-.400  ,-.400  ,-.400  ,-.3995 ,-.3990 ,-.3985 ,
24     2 -.398  ,-.397  ,-.3955 ,-.3940 ,-.385  ,-.380  ,-.372  ,
25     3         -.384  ,-.385  ,-.3855 ,-.386  ,-.386  ,-.3865 ,-.386  ,
26     4 -.3855 ,-.3845 ,-.384  ,-.3825 ,-.3815 ,-.380  ,-.378  ,-.375  ,
27     5 -.372  ,-.369  ,-.364  ,-.358  ,-.350  ,-.3435 ,-.335  ,
28     6         -.375  ,-.375  ,-.375  ,-.3745 ,-.374  ,-.373  ,-.372  ,
29     7 -.371  ,-.370  ,-.3685 ,-.367  ,-.365  ,-.362  ,-.359  ,-.355  ,
30     8 -.3515 ,-.347  ,-.342  ,-.336  ,-.331  ,-.325  ,-.318  ,
31     9         -.417  ,-.4155 ,-.414  ,-.413  ,-.412  ,-.411  ,-.4105 ,
32     A -.410  ,-.4095 ,-.409  ,-.408  ,-.4075 ,-.407  ,-.4065 ,-.406  ,
33     B -.405  ,-.404  ,-.4025 ,-.401  ,-.396  ,-.393  ,-.387  ,
34     C         -.430  ,-.427  ,-.424  ,-.422  ,-.420  ,-.4175 ,-.4155 ,
35     D -.414  ,-.412  ,-.410  ,-.4085 ,-.407  ,-.405  ,-.403  ,-.401  ,
36     E -.399  ,-.396  ,-.393  ,-.390  ,-.385  ,-.381  ,-.375  ,
37     F         -.437  ,-.434  ,-.431  ,-.428  ,-.4245 ,-.422  ,-.419  ,
38     G -.417  ,-.414  ,-.412  ,-.409  ,-.407  ,-.404  ,-.402  ,-.399  ,
39     H -.3965 ,-.394  ,-.391  ,-.3885 ,-.3875 ,-.386  ,-.380/
40      DATA DAPP/-.419 ,-.417  ,-.416  ,-.414  ,-.413  ,-.413  ,-.412  ,
41     1 -.411  ,-.4105 ,-.410  ,-.4095 ,-.409  ,-.408  ,-.4075 ,-.407  ,
42     2 -.406  ,-.405  ,-.4035 ,-.402  ,-.400  ,-.395  ,-.390  ,
43     3         -.4405 ,-.4365 ,-.433  ,-.430  ,-.427  ,-.425  ,-.422  ,
44     4 -.4205 ,-.419  ,-.4175 ,-.416  ,-.415  ,-.413  ,-.412  ,-.410  ,
45     5 -.409  ,-.407  ,-.406  ,-.406  ,-.4055 ,-.405  ,-.405  ,
46     6         -.456  ,-.451  ,-.447  ,-.442  ,-.439  ,-.436  ,-.433  ,
47     7 -.431  ,-.4285 ,-.426  ,-.424  ,-.422  ,-.420  ,-.419  ,-.417  ,
48     8 -.416  ,-.415  ,-.414  ,-.415  ,-.416  ,-.417  ,-.418  ,
49     9         -.469  ,-.465  ,-.460  ,-.456  ,-.452  ,-.449  ,-.445  ,
50     A -.442  ,-.439  ,-.437  ,-.434  ,-.432  ,-.429  ,-.428  ,-.426  ,
51     B -.425  ,-.424  ,-.423  ,-.423  ,-.423  ,-.424  ,-.425/
52      DATA IN   /7*0/
53      DATA TOC  /16.,14.,12.,10.,9.,8.,7./
54      DATA NPT  /7,6,4,4,3,4,5/
55      DATA LOCX /1,3,5,6,8,8,8/
56      DATA LOCY /1,8,14,18,22,25,29/
57      DATA CX   /.4,.45,.5,.55,.6,.65,.7,.75,.8,.85,.9,.95/
58      DATA CY /1.,.95,.85,.65,.35,-.15,-1. , 1.,.95,.75,.45,-.06,-1.25 ,
59     1 1.,.9,.6,-.5 , 1.,1.,.85,.1 , 1.,.8,0. , 1.,.95,.65,0. ,
60     2 1.,1.,.95,.85,.55/
61C
62      CAFAKE = AIN(64)
63      IF(AIN(10).EQ.UNUSED) GO TO 1000
64      A(134)=AIN(10)
65      GO TO 1010
66 1000 A(134)=AIN(20)-AIN(19)/A(131)
67C
68C     ----TEST FOR TWIST
69C
70 1010 IF(ABS(AIN(11)).LT.0.5) GO TO 1160
71C
72C     ----HAVE TWIST-CALCULATE CORRECTED ALPHA0
73C
74      NOINTP = .FALSE.
75      NOINT2 = .FALSE.
76      NOINT3  = .FALSE.
77      DO 1030 I=1,3
78         II = I
79         TEMP = A(27) - TR(I)
80         IF(ABS(TEMP).LT.2.E-2) GO TO 1040
81         IF(TEMP.LT.0.) GO TO 1050
82         TEMPP = TEMP
83 1030 CONTINUE
84 1040 NOINTP = .TRUE.
85 1050 ITR = 3*(II-1)
86      IF(II.EQ.1) NOINTP =.TRUE.
87      IF(.NOT.NOINTP) TRR = TEMPP/(TEMPP-TEMP)
88      DO 1060 I=1,4
89         II = I
90         TEMP2 = A(7) - AR(I)
91         IF(ABS(TEMP2).LT.2.E-2) GO TO 1070
92         IF(TEMP2.LT.0.) GO TO 1080
93         TEMPP2 = TEMP2
94 1060 CONTINUE
95 1070 NOINT2 = .TRUE.
96 1080 IAR = II
97      IF(II.EQ.1) NOINT2 =.TRUE.
98      IF(.NOT.NOINT2) ARR = TEMPP2/(TEMPP2-TEMP2)
99      DO 1090 I=1,22
100         II = I
101         TEMP3 = A(40) - SAQC(I)
102         IF(ABS(TEMP3).LT.2.E-2) GO TO 1100
103         IF(TEMP3.LT.0.0) GO TO 1110
104         TEMPP3 = TEMP3
105 1090 CONTINUE
106 1100 NOINT3= .TRUE.
107 1110 IF(II.EQ.1) NOINT3 = .TRUE.
108      IF(.NOT.NOINT3) SAR = TEMPP3/(TEMPP3-TEMP3)
109      IP1=1
110      IF(IAR.EQ.4.AND.A(7).LE.0.5)IAR=3
111 1120 IDX=ITR+IAR
112      D2=DA0OT(II,IDX)
113      IF(.NOT.NOINT3)D2=DA0OT(II-1,IDX)+SAR*(D2-DA0OT(II-1,IDX))
114      IF(NOINT2) GO TO 1130
115      IDX=IDX-1
116      D1=DA0OT(II,IDX)
117      IF(.NOT.NOINT3)D1=DA0OT(II-1,IDX)+SAR*(D1-DA0OT(II-1,IDX))
118      D2=D1+ARR*(D2-D1)
119 1130 IF(NOINTP) GO TO 1150
120      IF(IP1.EQ.2) GO TO 1140
121      IP1=IP1+1
122      ITR=ITR-3
123      DSV=D2
124      IF(IAR.EQ.4) IAR=3
125      GO TO 1120
126 1140 D2=D2+TRR*(DSV-D2)
127 1150 A(135)=D2
128      A(134) = AIN(11) * A(135) + A(134)
129C
130C     ----TEST FOR CAMBER
131C
132 1160 CONTINUE
133      IF(.NOT.CAMBER) GO TO 1230
134C
135C     ----HAVE CAMBER-CALCULATE ALPHA0 FOR EACH MACH NUMBER
136C
137      NOINTP = .FALSE.
138      DO 1170 I=1,7
139         II = I
140         TEMP = 100.*AIN(16) - TOC(I)
141         IF(ABS(TEMP).LT.2.E-2) GO TO 1180
142         IF(TEMP.GT.0.0) GO TO 1190
143         TEMPP = TEMP
144 1170 CONTINUE
145 1180 NOINTP = .TRUE.
146 1190 IF(II.EQ.1.OR.TEMP.LT.0.) NOINTP = .TRUE.
147      IF(.NOT.NOINTP)FACT=TEMPP/(TEMPP-TEMP)
148      XAG = A(43) * B(1)
149      I=1
150 1200 NP = NPT(II)
151      IX = LOCX(II)
152      IY = LOCY(II)
153      CALL TBFUNX(XAG,YAG1,DYDX,NP,CX(IX),CY(IY),CC(1,II),IN(II),MI(II),
154     1            NG,-1,0,Q41315,3,ROUTID)
155      IF(I.EQ.2) GO TO 1210
156      IF(NOINTP) GO TO 1220
157      I=I+1
158      II=II-1
159      YSV = YAG1
160      GO TO 1200
161 1210 YAG1=YAG1+(YSV-YAG1)*FACT
162      II=II+1
163 1220 B(49) = YAG1 * A(134)
164      A(137) = YAG1
165      RETURN
166 1230 CONTINUE
167      B(49) = A(134)
168      RETURN
169      END
170