1      SUBROUTINE DPRESR(ZJ,ZWAKE,ALPHJ,DWANGL,QQINFY,MJ)
2C
3C***  CALCULATES NON-VISCOUS DYNAMIC PRESSURE AT HORIZONTAL TAIL
4C
5      DIMENSION ROUTID(2)
6      LOGICAL ZUPPER
7      LOGICAL TE
8      REAL KN(6)
9      REAL KNU(7),M(7),MACH
10      REAL MJ
11      DIMENSION C1(6),C2(6),THETA(7)
12      DIMENSION SLOPE(6),X(6),Z(6),DKNU(7),VAR(4),LGH(4),QQ(7),QQPT(7)
13      COMMON /CONSNT/ PI,DEG,UNUSED,RAD
14      COMMON /SYNTSS/ SYNA(19)
15      COMMON /SUPDW/  DWA(237)
16      COMMON /WINGI/  WINGIN(100)
17      COMMON /WINGD/  A(195)
18      EQUIVALENCE (DELTE,DWA(235)),(THETE,DWA(236))
19      EQUIVALENCE (THETA1,DWA(234)),(DLE,DWA(231)),(DELTAZ,DWA(232)),
20     1            (XSUR,DWA(233))
21      EQUIVALENCE (MACH,DWA(1)),(RL2,A(24))
22      EQUIVALENCE (ZH,SYNA(7)),(ZW,SYNA(3)),(SLOPE(1),WINGIN(95)),
23     1            (CR,WINGIN(6))
24      DATA ROUTID/4HDPRE,4HSR  /
25      DATA KN/0.0,0.2,0.4,0.6,0.8,1.0/
26C
27C  ***CALCULATE INTERSECTION OF MACH WAVES WITH SURVEY PLANE***
28C
29      QPT(XM) = 0.7*XM**2/(1.0+0.2*XM**2)**3.5
30      TE=.FALSE.
31      ZUPPER=.FALSE.
32      ALPHA=ALPHJ
33      ALPHA=ALPHA/RAD
34      XSUR=(A(12)-(CR+RL2)*TAN(ALPHA))*SIN(ALPHA)+(RL2+CR)/COS(ALPHA)
35      DELTAZ=CR*SIN(ALPHA)+(XSUR-CR*COS(ALPHA))*TAN(DWANGL)
36      IF(ZJ.GT.0.0) ZUPPER=.TRUE.
37      IF(ZUPPER)GO TO 1010
38C
39C                **TAIL BELOW WING***
40C
41      DLE=-ALPHA*RAD-SLOPE(1)
42 1000 IF(DLE.GE.0.0)GO TO 1020
43      GO TO 1040
44C
45C                ***TAIL ABOVE WING***
46C
47 1010 DLE= ALPHA*RAD-SLOPE(1)
48      GO TO 1000
49 1020 CONTINUE
50C
51C                ***EXPANSION***
52C
53      U=ATAN(1./SQRT(MACH**2-1.))
54      ANG=U+ALPHA
55      ARG1=XSUR*SIN(ALPHA)/TAN(ANG)
56      ARG2=XSUR*COS(ALPHA)
57      ARG3=SIN(ALPHA)+COS(ALPHA)/TAN(ANG)
58      DO 1030 N=1,6
59         X(N)= KN(N)*CR
60         Z(N)= (-X(N)+ARG2-ARG1)/ARG3
61         IF(ZUPPER)Z(N)=Z(N)+DELTAZ
62 1030 IF(.NOT.ZUPPER)Z(N)=-ABS(Z(N))-DELTAZ
63      GO TO 1080
64 1040 CONTINUE
65C
66C                ***COMPRESSION***
67C
68      DELTA=ABS(DLE)
69      MJ=UNUSED
70 1050 CALL FIG68(MACH,DELTA,THETA1,IER)
71      THETA(1)=THETA1
72      IF(IER.NE.2)GO TO 1060
73      DELTA=THETA1
74      GO TO 1050
75 1060 ANG=ALPHA-THETA(1)/RAD
76      ARG1=XSUR*COS(ALPHA)-XSUR*SIN(ALPHA)/TAN(ANG)
77      ARG2=SIN(ALPHA)+COS(ALPHA)/TAN(ANG)
78      DO 1070 N=1,6
79         X(N)=KN(N)*CR
80         Z(N)= (-X(N)+ARG1)/ARG2
81         IF(ZUPPER)Z(N)=ABS(Z(N))  +DELTAZ
82         IF(.NOT.ZUPPER)Z(N)=Z(N)+DELTAZ
83 1070 CONTINUE
84      GO TO 1130
85C
86C  ***SUPERSONIC DYNAMIC PRESSURE RATIO***
87C                ***EXPANSION***
88 1080 NN=2
89      DKNU(1)=DLE
90      ARG2=SQRT(MACH**2-1.)
91      ARG1=.40825*ARG2
92      KNUINF=(2.4495*ATAN(ARG1)-ATAN(ARG2))*RAD
93      KNU(1)=KNUINF+DKNU(1)
94      CALL MACH2(KNU(1),M(1),IER)
95      QQINF = QPT(MACH)
96      QQPT(1) = QPT(M(1))
97      QQ(1)=QQPT(1)/QQINF
98 1090 I=NN
99 1100 DKNU(I)=SLOPE(I-1)-SLOPE(I)
100 1110 KNU(I)=KNU(I-1)+DKNU(I)
101      CALL MACH2(KNU(I),M(I),IER)
102      QQPT(I) = QPT(M(I))
103      QQ(I)= QQPT(I)*QQ(I-1)/QQPT(I-1)
104      IF(TE)GO TO 1210
105 1120 I=I+1
106      IF(I.LE.6)GO TO 1100
107      GO TO 1190
108C
109C                ***COMPRESSION***
110C
111 1130 CONTINUE
112      DKNU(1)=DLE
113      ANG=(THETA(1)+DLE)/RAD
114      ANG=ABS(ANG)
115      QQ(1)=(MACH**2*SIN(THETA(1)/RAD)**2+5.0)/
116     1      (6.0*MACH**2*SIN(ANG)**2)
117      ARG1=(MACH*SIN(THETA(1)/RAD))**2+5.
118      ARG2=7.*MACH**2*SIN(THETA(1)/RAD)**2-1.
119      M(1)=(ARG1/ARG2)**.5/SIN(ANG)
120      IF(M(1).LT.1.0) GO TO 1240
121      ARG2=SQRT(M(1)**2-1.)
122      ARG1=.40825*ARG2
123      KNU(1)=(2.4495*ATAN(ARG1)-ATAN(ARG2))*RAD
124 1140 I=2
125 1150 CONTINUE
126      DKNU(I)= SLOPE(I-1)-SLOPE(I)
127      CALL FIG68(M(I-1),DKNU(I),THETA(I),IER)
128      ARG=SIN(THETA(I)/RAD)**2
129      IF(DKNU(I).GT.0.0)GO TO 1170
130 1160 CONTINUE
131      ANG=(THETA(I)+DKNU(I))/RAD
132      ANG=ABS(ANG)
133      QQ(I)=(M(I-1)**2*ARG+5.0)/(6.0*M(I-1)**2*SIN(ANG)**2)
134      QQ(I)= QQ(I)*QQ(I-1)
135      ARG1=(M(I-1)**2*ARG+5.)/(7.*M(I-1)**2*ARG-1.)
136      M(I)= (ARG1**.5)/SIN(ANG)
137      IF(TE)GO TO 1210
138      GO TO 1180
139 1170 QQPT(I-1) = QPT(M(I-1))
140      ARG2=SQRT(M(I-1)**2-1.)
141      ARG1=.40825*ARG2
142      KNU(I-1)= (2.4495*ATAN(ARG1)-ATAN(ARG2))*RAD
143      NN=I
144      IF(TE)GO TO 1110
145      GO TO 1090
146 1180 I=I+1
147      IF(I.LE.6)GO TO 1150
148 1190 CONTINUE
149C
150C  ***CHECK FOR EXPANSION OR COMPRESSION AT THE TRAILING EDGE***
151C
152      TE=.TRUE.
153      IF(M(6).LE.MACH) GO TO 1200
154C
155C  ***FLOW IS COMPRESSED TO FREESTREAM***
156C
157      I=7
158      DKNU(I)=-ALPHA*RAD+SLOPE(6)
159      DELTE=ABS(DKNU(I))
160      CALL FIG68(M(6),DELTE,THETE,IER)
161      IF(IER .NE. 2) GO TO 1195
162        DKNU(I) = -THETE
163        DELTE   = THETE
164        CALL FIG68(M(6),DELTE,THETE,IER)
165 1195 CONTINUE
166      THETA(I)=THETE
167      ARG=SIN(THETE/RAD)**2
168      GO TO 1160
169 1200 CONTINUE
170C
171C  ***FLOW IS EXPANDED TO FREESTREAM***
172C
173      I=7
174      DKNU(I)=ALPHA*RAD+SLOPE(6)
175      GO TO 1170
176 1210 CONTINUE
177C
178C  ***FIND Q AND M AT ZJ***
179C
180      IF(ZJ/Z(6).LE.1.0)GO TO 1220
181      I1=0
182      I2=0
183      CALL TBFUNX(ZJ,QQINFY,DYDX,6,Z,QQ,C1,I1,MI,NG,0,0,4HQNFY,1,ROUTID)
184      CALL TBFUNX(ZJ,MJ,DYDX,6,Z,M,C2,I2,MI,NG,0,0,4HMJ  ,1,ROUTID)
185      GO TO 1230
186 1220 CONTINUE
187      ARG=(ZJ-ZWAKE)/(Z(6)-ZWAKE)
188      QQINFY=1.0+(QQ(7)-1.0)*ARG
189      MJ=MACH
190 1230 CONTINUE
191      RETURN
192 1240 MJ=M(1)
193      RETURN
194      END
195