流线曲率法解S1流面问题计算程序.docx
《流线曲率法解S1流面问题计算程序.docx》由会员分享,可在线阅读,更多相关《流线曲率法解S1流面问题计算程序.docx(27页珍藏版)》请在冰豆网上搜索。
![流线曲率法解S1流面问题计算程序.docx](https://file1.bdocx.com/fileroot1/2023-2/24/82f75ab4-1947-4a4b-b9da-d2ba48c9d885/82f75ab4-1947-4a4b-b9da-d2ba48c9d8851.gif)
流线曲率法解S1流面问题计算程序
流线曲率法解S1流面问题计算程序
******MAIN******
EXTERNALWG,GW
DIMENSIONXA(40),YP(40),YS(40)
COMMON/HH1/JM,KN,K0,JF,JT,W1,AI,T1,P1,IA,IB,C,D,F,WJ(40),AL3
&/HH2/P1S,T1S.B0,B1,B2,GM2,PAI,PT0,AD0,R1,CP,G0,RR,R0,T0,U0
&/HH3/OM0,OM,NB,V01,W01,X(40),Y,AL,X0,Y0,Z0,X00,Y00,Z00
&,IM(40),FX
&/HH4/X1,X2,X3,Y1,Y2,Y3/HH12/A15
&/HH5/AMJ(40),RJ(40),OPJ(40),OSJ(40),YPJ(40),YSJ(40)MDPWJ(40),
&NN
Y00=Y00/R0
Z00=Z00/R0
XL=X1/R0
YL=Y1/R0
XE=X2/R0
YE=Y2/R0
W1=W1/U0
R1=R1/R0
388
RH1=RH1*OM0*R0**3/G0
T1S=T1S/T0
P1S=P1S/(G0*OM0*R0)
OM=OM/OM0
RR=RR/(U0*U0/T0)
CP=RR*GM2
FX=0.
CALLQUGEN(WJ
(1),1,GM)
A15=2*PAI/NB
JF1=JF-1
DO75J=1,JF1
CALLXY(XL,YL,B2,AMJ(J),Y)
YPJ(J)=Y
YSJ(J)=Y
CONTINUE
CALLY2Y3(XL,YL,Z0,AMJ(JF-1),YPJ(JF-1),X2,Y2,X3,Y3)
CALLABC(AMJ(JF-1),X3,AMJ(JF+1),Y3,YPJ(JF+1),
&AMJ(JF),Y)
YPJ(JF)=Y
CALLABC(AMJ(JF-1),X2,AMJ(JF+1),YPJ(JF-1),Y2,YPJ(JF+1),
&AMJ(JF),Y)
YSJ(JF)=Y
CALLY2Y3(XE,YE,Z00,AMJ(JT+1),YPJ(JT+1),X2,Y2,X3,Y3)
CALLABC(AMJ(JT-1),X3,AMJ(JT+1),YPJ(JT-1),Y3,YPJ(JT+1
&),AMJ(JT),Y)
YPJ(JT)=Y
CALLABC(AMJ(JT-1),X2,AMJ(JT+1),YSJ(JT-1),Y2,YSJ(JT+1
&),AMJ(JT),Y)
YSJ(JT)=Y
DO85J=1,JM
OPJ(J)=YPJ(J)/RJ(J)
OSJ(J)=YSJ(J)/RJ(J)+A15
AD0=(OSJ(J)-OPJ(J))/(KN-1)
DO85K=1,KN
O(J,K)=OPJ(J)+(K-1)*AD0
CONTINUE
CALLSCB(1,KN,1)
DO87J=1,JM
DO87K=1,KN
DWODM(J,K)=0.
WRITE(*,450)
FORMAT(1X,2HJ=,7X,3HYPJ,11X,3HYSJ,11X,2HAMJ)
DO88J=1,JM
AM1=AMJ(J)*R0
YP1=YPJ(J)*R0
YS1=YSJ(J)*R0
389
WRITE(*,350)J,YP1,YS1,AM1
CONTINUE
WRITE(*,411)
FORMAT(/5X,’----GoToTheLastProgram-------‘/)
IF(N007.EQ.1)GOTO95
IF(N008.EQ.1)GOTO90
CALLTXY2(B1,B2,0,0.2*PT0,N006)
GOTO105
CALLTXY1(B1,B2,1,0.1*PT0,N006)
GOTO105
IF(N008.EQ.1)GOTO100
CALLTXY1(B1,B2,1,0.1*PT0,N006)
GOTO105
CALLCON(B1,B2,F0)
CONTINUE
DO554J=1,JM
AMJ(J)=AM(J)*R0
DO554K=1,KN
P(J,K)=P(J,K)*(Go*OM0/R0)
O(J,K)=O(J,K)*RJ(J)*R0
T(J,K)-=T(J,K)*T0
W(J,K)=W(J,K)*U0
RH(J,K)=RH(J,K)/(OM0*R0**3/Go)
CONTINUE
DS1=-(O(JF,KN)-A15*RJ(JF)R0)+O(JF,1)
DS2=O(JT,1)-(O(JT,KN)-A15*RJ(JT)*R0)
OPEN(8,FILE=‘YR,DAT’)
WRITE(8,*)DS1,DS2
WRITE(8,*)(AMJ(I),O(I,KN),I=JF,JT)
WRITE(8,*)(W(J,1),J=1,JM)
CLOSE(8)
WRITE(6,*),------O(J,1)------,
WRITE(6,*)(O(J,1),J=JF,JT)
WRITE(*,*)’------THEEND------,
CLOSE(5)
CLOSE(6)
STOP
END
***0001***
SUBROUTINELB(N,X,Y)
COMMON/HH8/XX(40),YY(40),ALT(11),ALR(11),DWODW(40,11)
DO10I=1,N
K=1
IF(X,LT.XX(K))GOTO15
CONTINUE
IF(K.NE.1)GOTO20
CONTINUE
IF(K.NE.1)GOTO20
AJX=(X-XX
(1))/(XX2-XX
(1))
Y=YY
(1)+AJX*(YY
(2)-YY
(1))
RETURN
AJX=(X-XX(K-1))/(XX.(K)-XX(K-1))
390
Y=YY(K-1)+AJX*(YY(K)-YY(K-1))
RETURN
END
***002***
SUBROUTINEFF(J0,J,M1)
COMMON/HH6CSA(40),DRJ(40),AMM(40),XX1(40),YY
I(40),CA,SA,
Y11(40)
X0=XX1(J-1)
X1=XX1(J)
X2=XX1(J+1)
X3=XX1(J+2)
Y0=YY1(J-1)
Y1=YY1(J)
Y2=YY1(J+1)
Y3=YY1(J+2)
X=XX1(J0)
F01=(Y0-Y1)/(X0-X1)
F02=(Y1-Y2)/(X1-X2)
C=(F01-F02)/(X0-X2)
AMM(J0)=F01+(2.0X-X0-X1)*C
RETURN
END
***0003***
SUBROUTINESPLINE(M1,C1,CJM)
COMMON/HH1/JM,KN,K0,JF,JT,W1,AI,T1,P1,IA,IB,C,D,F,WJ(40)AL3
/HH6CSA(40),SSA(40),DRJ(40),AMM(40),XX1(40),CA,SA
Y11(40)
JM2=JM-2
DO10J=2,JM2
CALLFF(JM-1,JM-2,M1)
IF(M1,EQ.0)GOTO15
CALLFF(1,2,M1)
CALLFF(JM,JM2,M1)
GOTO20
AMM
(1)=C1/2
AMM(JM)=CJM/2
CONTINUE
RETURE
END
***0004***
SUBOUTINESXY
COMMON/HH1/JM,KN,K0,JF,JT,W1,AI,T1,P1,IA,IB,C,D,F,WJ(40),AL3
&/HH5/AMJ(40),RJ(40),OPJ(40),OSJ(40),YPJ(40),YSJ(40),
&DPWJ(40),NN
&/HH6/CSA(40),SSA(40),DRJ(40),AMM(40),XX1(40),YY1(40),CA,SA
&,Y11(40)
&/HH8/XX(40),YY(40),ALT(11),DWODM(40,11)
391
DIMENSIONXP(40),YP(40)
K5=0
DO10I=1,NN
XP(I)=XX(I)*CA-YY(I)*SA
YP(I)=XX(I)*SA+YY(I)*CA
DO40M=JF,JT
NN1=NN-1
DO20J=2,NN1
K5=J
XC1=AMJ(M)*2
IF(XC1.LT.(XP(K5)+XP(K5+1)))GOTO30
CONTINUE
K5=NN1
CALLABC(XP(K5-1),XP(K5),XP(K5+1),YP(K5-1),YP(K5),Y
&P(K5+1),
&AMJ(M),Y)
Y11(M)=Y
CONTINUE
RETURN
END
***0005***
SUBROUTINESCB(K1,K2,ID)
COMMON/HH1/JM,KN,K0,JF,JT,W1,AI,T1,P1,IA,IB,C,D,F,WJ(40),AL3
&/HH2/P1S,T1S,B0,B1,B2,GM2,PAI,PT0,AD0,R1,CP,G0,RR,R0,T0,U0
&/HH5/AMJ(40),RJ(40),OPJ(40),OSJ(40),YPJ(40),YSJ(40),
&DPWJ(40),NN
&/HH6/CSA(40),SSA(40),DRJ(40),AMM(40),XX1(40),YY1(40),CA,SA
&,Y11(40)
&/HH7/G(40,11),O(40,11),W(40,11),P(40,11),T(40,11),UB(40,11),
&SS(40,11),CS(40,11),RH(40,11)
DO10J=1,JM
XX1(J)=AMJ(J)
DO30K=K1,K2,ID
DO20,J=1,JM
YY1(J)=O(J,K)
TB1=SIN(B1)/COS(B1)*2/R1
TB2=SIN(B2)/COS(B2)*2/RJ(JM)
CALLSPLINE(1,TB1,TB2)
DO30J=1,JM
CC=AMM(J)*RJ(J)
SS(J,K)=CC/SQRT(1.+CC*CC)
CS(J,K)=SQRT(1.-SS(J,K)*SS(J,K))
CONTINUE
RETURN
END
***0006***
SUBROUTINESCB(K1,K2,ID)
COMMON/HH1/JM,KN,K0,JF,JT,W1,AI,T1,P1,IA,IB,C,D,F,WJ(40),AL3
&/HH5/AMJ(40),RJ(40),OPJ(40),OSJ(40),YPJ(40),YSJ(40),
&DPWJ(40),NN
&/HH6/CSA(40),SSA(40),DRJ(40),AMM(40),XX1(40),YY1(40),CA,SA
&,Y11(40)
&/HH7/G(40,11),O(40,11),W(40,11),P(40,11),T(40,11),UB(40,11),
&SS(40,11),CS(40,11),RH(40,11)
&/HH8/XX(40),YY(40),ALT(11),DWODM(40,11)
DO10J=1,JM
XX1(J)=AMJ(J)
DO40K=K1,K2,ID
DO20J=1,JM
YY1(J)=W(J,K)*SS(J,K)
CALLSPLINE(2,0.,0.)
DO30J=1,JM
DWODM(J,K)=AMM(J)
CONTINUE
RETURN
END
392页
***007***
SUBROUTINETPRH
COMMON/HH1/JM,KN,K0,JF,JT,W1,A1,T1,P1,IA,IB,C,D,F,WJ(40),AL3
&/HH2/P1S,T1S,B0,B1,B2,GM2,PAI,PT0,AD0,R1,CP,G0,RR,R0,T0,U0
&/HH3/OM0,OM,NB,V01,W01,X(40),Y,AL,X0,Y0,Z0,X00,Y00,Z00,
&IM(40),FX
&/HH5/AMJ(40),RJ(40),OPJ(40),OSJ(40),YPJ(40),YSJ(40),
&DPWJ(40),NN
&/HH7/G(40,11),O(40,11),W(40,11),P(40,11),T(40,11),UB(40,11),
&SS(40,11),CS(40,11),RH(40,11)
TWS=(AI+OM*OM*RJ(J)*RJ(J)/2)/CP
T(J,K)=TWS-W(J,K)*W(J,K)/2/CP
PWS=P1S*(TWS/T1S)**GM2-DPWJ(J)
IF(T(J,K),GT.0.)GOTO10
FX=1.
WRITE(*,100)J,K,T(J,K),W(J,K)
FORMAT(1X,2HJ=,12,2HK=,12,2X,7HT(J,K)=,E13.6,
&7HK(J,K)=,E13.6/5X,’*************T<0,TryAgain!
*********’)
W(J,K)=W(J,K)*0.95
GOTO5
CONTINUE
P(J,K)=PWS*(T(J,K)/TWS)**GM2
RH(J,K)=P(J,K)/(RR*T(J,K))
IF(J.EQ.1)GOTO15
UB(J,K)=UB(J-1,K)+CP*ALOG(T(J,K)/T(J-1,K))-
&RR*ALOG(P(J,K)/P(J-1,K))
GOTO20
UB(J,K)=0.
CONTINUE
RETURN
END
***008***
SUBROUTINEGWG(J)
COMMON/HH1/JM,KN,K0,JF,JT,W1,A1,T1,P1,IA,IB,C,D,F,WJ(40),AL3
393
&/HH3/OM0,OM,NB,V01,W01,X(40),Y,AL,X0,Y0,Z0,X00,Y00,Z00,
&IM(40),FX
/HH5/AMJ(40),RJ(40),OPJ(40),OSJ(40),YPJ(40),YSJ(40),
&DPWJ(40),NN
&/HH6/CSA(40),SSA(40),DRJ(40),AMM(40),XX1(40),YY1(40),CA,SA
&,Y11(40)
&/HH7/G(40,11),O(40,11),W(40,11),P(40,11),T(40,11),UB(40,11),
&SS(40,11),CS(40,11),RH(40,11)
&/HH8/XX(40),YY(40),ALT(11),ALR(11),DWODM(40,11)
SA1=SSA(J)
OS=2*OM*SA1
PS=RJ(J)
DO10K=2,KN
SS2=0.5*(SS(J,K-1)+DWODM(J,K))
ALT(K)=CS2*SS2*SA1
ALR(K)=CS2*PS*(DWM2+OS)
CONTINUE
RETURN
END
***009***
SUBROUTINEGW(W,JG00)
COMMON/HH1/JM,KN,K0,JF,JT,W1,A1,T1,P1,IA,IB,C,D,F,WJ(40),AL3
&/HH2/P1S,T1S,B0,B1,B2,GM2,PAI,PT0,AD0,R1,CP,G0,RR,R0,T0,U0
&/HH3/OM0,OM,NB,V01,W01,X(40),Y,AL,X0,Y0,Z0,X00,Y00,Z00,
&IM(40),FX
&/HH6/CSA(40),SSA(40),DRJ(40),AMM(40),XX1(40),YY1(40),CA,SA
&,Y11(40)
W1=W
W01=W1*SIN(B1)
V01=W01+OM*R1
AI=CP*T1S-OM*R1*V01
T1=(AI+(OM*OM*R1*R1-W*W)/2)/CP
IF(T1.GE.0.)GOTO20
W1=W1*0.95
GOTO10
CONTINUE
P1=P1S*(T1*T1S)**GM2
RH1=P1/(RR*T1)
F=RH1*W1*COS(B1)*CSA
(1)*DRJ
(1)*R1*2*PAI-1
RETURN
END
***0010***
SUBROUTINEGW(X3,J)
COMMON/HH1/JM,KN,K0,JF,JT,W1,A1,T1,P1,IA,IB,C,D,F,WJ(40),AL3
&/HH3/OM0,OM,NB,V01,W01,X(40),Y,AL,X0,Y0,Z0,X00,Y00,Z00,
&IM(40),FX
&/HH5/AMJ(40),RJ(40),OPJ(40),OSJ(40),YPJ(40),YSJ(40),
&DPWJ(40),NN
394
&/HH6/CSA(40),SSA(40),DRJ(40),AMM(40),XX1(40),YY1(40),CA,SA
&,Y11(40)
&/HH7/G(40,11),O(40,11),W(40,11),P(40,11),T(40,11),UB(40,11),
&SS(40,11),CS(40,11),RH(40,11)
W(J,1)=X3
CALLSWG(J,1)
DO10K1=2,KN
IA=K1-1
IB=K1
CALLSWG(J,K1)
CONTINUE
IF(K0.EQ.KN)GOTO20
G(J,KN)=1.0
DO15K=1,KN-1
L=KN-K
G(J,L)=G(J,L+1)-NB*CSA(J)*DRJ(J)*RJ(J)*(O(J,L+1)-O(J,L))*
&(RH(J,L)*W(J,L)*CS(J,L)+RH(J,L+1)*W(J,L+1)*CS(J,L+1))/2
CONTINUE
F=G(J,1)-0.0
RETURN
CONTINUE
G(J,1)=0.
DO30K=2,KN
G(J,L)=G(J,K-1)-NB*CSA(J)*DRJ(J)*RJ(J)*(O(J,K)-O(J,K-1))*
&(RH(J,K)*W(J,K)*CS(J,K)+RH(J,K-1)*W(J,K-1)*CS(J,K-1))/2
CONTINUE
F=G(J,KN)-1.
RETURN
END
***0011***
SUBROUTINESWG(J,K)
COMMON/HH1/JM,KN,K0,JF,JT,W1,AI,T1,P1,IA,IB,C,D,F,WJ(40),AL3
&/HH2/P1S,T1S,B0,B1,B2,GM2,PAI,PT0,AD0,R1,CP,G0,RR,R0,T0,U0
&/HH11/N001
&/HH7/G(40,11),O(40,11),W(40,11),P(40,11),T(40,11),UB(40,11),
&SS(40,11),CS(40,11),RH(40,11)
&/HH8/XX(40),YY(40),ALT(11),ALR(11),DWODM(40,11)
IF(K.EQ.1)GOTO20
IV=0
T(J,K)=T(J,IA)
W(J,K)=W(J,IA)
W2=0.5*(W(J,IA)+W(J,K))
IV=IV+1
Z=W(J,IA)+(O(J,K)-O(J,IA))*(W2*ALT(IB)+ALR(IB))-
&0.5*(T(J,K)+T(J,IA))/W2*(UB(J,K)-UB(J,IA))
W2=ABS(W(J,K)-Z)
W(J,K)=Z
IF(IV.LE.20)GOTO15
WRITE(*,*)‘*******IV>20,RETURN!
---0011#**********’
GOTO20
395
IF(W2.GE.0.00001)GOTO10
CALLTPRH(J,K)
RETURN
END
***0012***
SUBROUTINEQUGEN(XQ,J,FUNC)
COMMON/HH1/JM,KN,K0,JF,JT,W1,AI,T1,P1,IA,IB,C,D,F,WJ(40),AL3
&/HH3/OM0,OM,NB,V01,W01,X(40),Y,AL,X0,Y0,Z0,X00,Y00,Z00,
&IM(40),FX
&/HH10/N002,A05
KK=0
KIM=0
IF(FX.EQ.1.)GOTO55
XK=XQ
CALLFUNC(XK,J)
IF(ABS(F).LT.0.0005)GOTO100
FK=F
IF(IM(J).EQ.2)GOTO55
IF(IM(J).EQ.0)GOTO20
D=0.2
GOTO25
D=-0.2
CONTINUE
XY=XK
XK=XK+D
CALLFUNC(XK,J)
IF(ABS(D).LT.0.00001)GOTO40
DH=XK-XK1
IF(ABS(DH).GT.0.8)DH=-0.8*ABS(DH)/DH
XK1=XK
FK1=FK
XK=XK+DH
KK=KK+1
CALLFUNC(XK,J)
IF(N002.EQ.1)GOTO50
IF(ABS(F).LT.0.005)GOTO100
FK=F
IF(KK.LE.40)GOTO35
WRITE(*,*)‘******KK>40,DOAgain!
!
**************’
IQ=J
KK=0
GOTO35
D=0.1
396
XK=A05
CALLFUNC(XK,J)
IF(ABS(F).LT.0.0005)GOTO100
FK=F
XK=XK+D
CALLFUNC(XK,J)
IF(ABS(F).LT.0.0005)GOTO100
FK1=F
XK1=XK
XK=XK-D
IF(FK1.LE.FK)GOTO75
FK=FJ1
XK=XK1
GOTO65
XK=XK-D
CALLFUNC(XK,J)
FK1=F
XK1=XK
XK1=XK+D
IF(FK1.LE.FK)GOTO85
FK=FK1
XK=XK1
GOTO75
IF(ABS(XK-XK1).LT.0.001)GOTO90
D=D/2
GOTO65
IF(F.LT.0.)GOTO95
KIM=KIM+1
IM(J)=IM(J-1)
IF(KIM.GE.2)IM(J)=0
GOTO15
CONTINUE
FORMA