1      SUBROUTINE WBCM1(A,WINGIN,BD,WB)
2C
3C*** COMPUTES (XAC/CBARR)B(W) FOR MACH=0.60
4C
5      COMMON /OPTION/ SREF,CBARR,ROUGFC,BLREF
6      DIMENSION ROUTID(2),Q2136B(3),Q21C(3)
7      DIMENSION A(195),WINGIN(4),WB(39),BD(87)
8      DIMENSION C21C(6),X21C(13),Y21C(13)
9      DIMENSION X38B(3),Y38B(3),C38B(6)
10      DATA ROUTID/4HWBCM,4H1   /,Q2136B/4H4.3.,4H2.2-,4H36-B/,
11     1     Q21C/4H4.2.,4H2.2-,4H35   /
12C
13C*********          PAGE 5-8 CALCULATIONS         **********************
14C*********          FIGURE 4.3.2.2-36-B           **********************
15C
16      DATA X38B/0.0,1.0,1.0E06/
17      DATA Y38B/0.0,0.50,0.50/
18      DATA I38B/0/
19C
20C                  FIGURE 4.3.2.2-35
21C
22      DATA IN21C/0/
23      DATA X21C/0.0,.025,.050,.075,.10,.15,.20,.30,.40,.50,.60,.70,.80/
24      DATA Y21C/0.0,.056,.101,.130,.152,.190,.22,.266,.301,.33,.348,
25     1.365,.375/
26C
27      SSPN = WINGIN(4)
28      TEMP0= 0.25*A(7)*(1.+A(27))*A(38)
29C
30C*********     SELECT VALUE OF(X-PRIME)AC/(C)RE AT (BETA*A)= ZERO
31C
32      WB(15)= 0.50
33      IF(TEMP0.GE.1.00) GO TO 1000
34C
35C*********          FIGURE 4.3.2.2-36-B
36C
37      CALL TBFUNX(TEMP0,WB(15),DYDX,3,X38B,Y38B,C38B,I38B,MI,NG,
38     1            0,0,Q2136B,3,ROUTID)
39C
40C*********     COMPUTE VALUE OF (X-PRIME)AC/(C)RE AT (BETA*A)= 4.0
41C
42 1000 RATIO= BD(87)/(2.*SSPN)
43      CALL TBFUNX(RATIO,BRAC,DYDX,13,X21C,Y21C,C21C,IN21C,MI,NG,
44     1            0,0,Q21C,3,ROUTID)
45      TEMP4= 0.25+(2.*SSPN-BD(87))/(2.*A(10))*A(44)*BRAC
46C
47C*********     IF (BETA*A).GT.ZERO AND .LT.4.0  USE ELLIPSE CURVE FIT
48C         REVISIONS TO WBCM SUBROUTINE
49C
50      ARG=0.80*A(7)
51      IF(ARG.LT.4.0) GO TO 1010
52      WB(14)= TEMP4
53      GO TO 1040
54C
55C*********     COMPUTE (X-PRIME)AC/(C)RE USING ELLIPSE CURVE FIT
56C
57 1010 X1= 4.0
58      Y1= WB(15)
59      Y= TEMP4
60      P= 4.0
61      Q= ABS(Y-Y1)
62      BB= -2.0*Y1
63      CC= (Y1*Y1-Q*Q+((Q/P)**2)*(ARG-X1)**2)
64      IF((BB*BB-4.*CC).GT.0.0) GO TO 1030
65 1020 FORMAT (30X,45H ELLIPSE CURVE FIT IN ERROR, WBCM SUBROUTINE  )
66      WRITE(6,1020)
67      RETURN
68 1030 CONTINUE
69C
70C*********     SOLVE QUADRATIC EQUATION FOR WB(14), (NOTE, AA=1)
71C
72      YMAX= (-BB+SQRT(BB*BB-4.*CC))/2.0
73      YMIN= (-BB-SQRT(BB*BB-4.*CC))/2.0
74      WB(14)= YMAX
75      IF(Y.LT.Y1) WB(14)= YMIN
76 1040 WB(13)= WB(14)*A(10)/CBARR
77      RETURN
78      END
79