流线曲率法解S1流面问题计算程序.docx
《流线曲率法解S1流面问题计算程序.docx》由会员分享，可在线阅读，更多相关《流线曲率法解S1流面问题计算程序.docx（27页珍藏版）》请在冰豆网上搜索。
流线曲率法解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
升级会员 