流线曲率法解S1流面问题计算程序.docx

1、流线曲率法解S1流面问题计算程序流线曲率法解S1流面问题计算程序*MAIN*EXTERNAL WG,GWDIMENSION XA(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/

2、A15& /HH5/AMJ(40),RJ(40),OPJ(40),OSJ(40),YPJ(40),YSJ(40)MDPWJ(40),& NNY00=Y00/R0Z00=Z00/R0XL=X1/R0YL=Y1/R0XE=X2/R0YE=Y2/R0W1=W1/U0R1=R1/R0388RH1=RH1*OM0*R0*3/G0T1S=T1S/T0P1S=P1S/(G0*OM0*R0)OM=OM/OM0RR=RR/(U0*U0/T0)CP=RR*GM2FX=0.CALL QUGEN(WJ(1),1,GM)A15=2*PAI/NBJF1=JF-1DO 75 J=1,JF1CALL XY(XL,YL,B2,

3、AMJ(J),Y)YPJ(J)=YYSJ(J)=YCONTINUECALL Y2Y3(XL,YL,Z0,AMJ(JF-1),YPJ(JF-1),X2,Y2,X3,Y3)CALL ABC(AMJ(JF-1),X3,AMJ(JF+1),Y3,YPJ(JF+1),& AMJ(JF),Y)YPJ(JF)=YCALL ABC(AMJ(JF-1),X2,AMJ(JF+1), YPJ(JF-1),Y2,YPJ(JF+1),& AMJ(JF),Y) YSJ(JF)=YCALL Y2Y3(XE,YE,Z00,AMJ(JT+1),YPJ(JT+1),X2,Y2,X3,Y3)CALL ABC(AMJ(JT-1),X

4、3,AMJ(JT+1),YPJ(JT-1),Y3,YPJ(JT+1& ),AMJ(JT),Y) YPJ(JT)=Y CALL ABC(AMJ(JT-1),X2,AMJ(JT+1),YSJ(JT-1),Y2,YSJ(JT+1& ),AMJ(JT),Y) YSJ(JT)=YDO 85 J=1,JM OPJ(J)=YPJ(J)/RJ(J)OSJ(J)=YSJ(J)/RJ(J)+A15AD0=(OSJ(J)-OPJ(J)/(KN-1)DO 85 K=1,KNO(J,K)=OPJ(J)+(K-1)*AD0CONTINUECALL SCB(1,KN,1)DO 87 J=1,JMDO 87 K=1,KNDW

5、ODM(J,K)=0.WRITE(*,450)FORMAT(1X,2HJ=,7X,3HYPJ,11X,3HYSJ,11X,2HAMJ)DO 88 J=1,JMAM1=AMJ(J)*R0YP1=YPJ(J)*R0YS1=YSJ(J)*R0389WRITE(*,350) J, YP1, YS1,AM1CONTINUEWRITE(*,411)FORMAT(/5X,-Go To The Last Program -/)IF(N007.EQ.1) GOTO 95IF(N008.EQ.1) GOTO 90CALL TXY2(B1,B2,0,0.2*PT0,N006)GOTO 105CALL TXY1(B1

6、,B2,1,0.1*PT0,N006)GOTO 105IF(N008.EQ.1) GOTO 100CALL TXY1(B1,B2,1,0.1*PT0,N006)GOTO 105CALL CON(B1,B2,F0)CONTINUEDO 554 J=1,JMAMJ(J)=AM(J)*R0DO 554 K=1, KNP(J,K)=P(J,K)*(Go*OM0/R0)O(J,K)=O(J,K)*RJ(J)*R0T(J,K)-=T(J,K)*T0W(J,K)=W(J,K)*U0RH(J,K)=RH(J,K)/(OM0*R0* *3/Go)CONTINUEDS1= -(O(JF,KN)-A15*RJ(JF

7、)R0)+O(JF,1)DS2= O(JT,1) - (O(JT,KN)-A15*RJ(JT)*R0)OPEN(8,FILE = YR,DAT)WRITE(8,*)DS1,DS2WRITE(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(*,*)- THE END-,CLOSE(5)CLOSE(6)STOPEND*0001*SUBROUTINE LB(N,X,Y)COMMON/HH8/XX(40),YY(40),ALT

8、(11),ALR(11),DWODW(40,11)DO 10 I=1, NK=1IF(X,LT.XX(K) GOTO 15CONTINUEIF(K.NE.1) GOTO 20CONTINUEIF(K.NE.1) GOTO 20AJX=(X-XX(1)/(XX2-XX(1)Y=YY(1)+AJX*(YY(2)-YY(1)RETURNAJX=(X-XX(K-1)/(XX.(K)-XX(K-1)390Y=YY(K-1)+ AJX*(YY(K)-YY(K-1)RETURNEND*002*SUBROUTINE FF(J0,J,M1)COMMON/HH6CSA(40),DRJ(40),AMM(40),XX

9、1(40),YYI(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)*CRETURNEND*0003*SUBROUTINE SPLINE(M1,C1,CJM)COMMON/HH1/JM,KN,K0,JF,JT,W1,AI,T1,P1,IA,IB,C,D,F,WJ(4

10、0)AL3/HH6CSA(40),SSA(40),DRJ(40),AMM(40),XX1(40),CA,SA,Y11(40)JM2=JM-2DO 10 J=2,JM2CALL FF(JM-1,JM-2,M1)IF(M1,EQ.0) GOTO 15CALL FF(1,2,M1)CALL FF(JM,JM2,M1)GOTO 20AMM(1)=C1/2AMM(JM)=CJM/2CONTINUERETUREEND*0004*SUBOUTINE SXYCOMMON/HH1/JM,KN,K0,JF,JT,W1,AI,T1,P1,IA,IB,C,D,F,WJ(40),AL3& /HH5/AMJ(40),RJ

11、(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)391DIMENSION XP(40),YP(40)K5=0DO 10 I=1,NNXP(I)=XX(I)*CA-YY(I)*SAYP(I)=XX(I)*SA+YY(I)*CADO 40 M=JF,JTNN1=NN-1DO 20 J=2,NN1K5=JXC1=AMJ(M)*2I

12、F(XC1.LT.(XP(K5)+XP(K5+1) GOTO 30CONTINUEK5=NN1CALL ABC(XP(K5-1), XP(K5),XP(K5+1),YP(K5-1),YP(K5),Y& P(K5+1),& AMJ(M),Y)Y11(M)=YCONTINUERETURNEND*0005*SUBROUTINE SCB(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& /H

13、H5/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)DO 10 J=1,JMXX1(J)=AMJ(J)DO 30 K=K1,K2,IDDO 20,J=1,JMYY1(J)=O(J,K)TB1

14、=SIN(B1)/COS(B1)*2/R1TB2=SIN(B2)/COS(B2)*2/RJ(JM)CALL SPLINE(1,TB1,TB2)DO 30 J=1,JMCC=AMM(J)*RJ(J)SS(J,K)=CC/SQRT(1.+CC*CC)CS(J,K)=SQRT(1.-SS(J,K)*SS(J,K)CONTINUERETURNEND* 0006 *SUBROUTINE SCB(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

15、),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) DO 10 J=1,JM XX1(J)=AMJ(J)DO 40 K=K1,K2,IDDO 20 J=1,JMYY1(J

16、)=W(J,K)*SS(J,K)CALL SPLINE(2,0.,0.)DO 30 J=1,JMDWODM(J,K)=AMM(J)CONTINUERETURNEND392页* 007 *SUBROUTINE TPRHCOMMON/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& /H

17、H5/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/CPPWS=P1S*(TWS/T1S)*GM2-DPWJ(J)IF(T(J,K),GT.0.) GOTO 10FX=1.WRITE(*,100) J,K,T(

18、J,K),W(J,K)FORMAT(1X,2HJ=,12,2HK=,12,2X,7HT(J,K)=,E13.6,& 7HK(J,K)=,E13.6/5X,* T20,RETURN! -0011# * GOTO 20395 IF(W2.GE.0.00001) GOTO 10 CALL TPRH(J,K) RETURN END* 0012 *SUBROUTINE QUGEN(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,Z

19、0,X00,Y00,Z00,& IM(40),FX& /HH10/N002,A05 KK=0 KIM=0 IF(FX.EQ.1.) GOTO 55 XK=XQ CALL FUNC(XK,J) IF(ABS(F).LT.0.0005) GOTO 100 FK=F IF(IM(J).EQ.2) GOTO 55 IF(IM(J).EQ.0) GOTO 20 D=0.2 GOTO 25 D=-0.2CONTINUEXY=XKXK=XK+DCALL FUNC(XK,J)IF(ABS(D).LT.0.00001) GOTO 40DH=XK-XK1IF(ABS(DH).GT.0.8) DH=-0.8*ABS

20、(DH)/DHXK1=XKFK1=FKXK=XK+DHKK=KK+1CALL FUNC(XK,J)IF(N002.EQ.1) GOTO 50IF(ABS(F).LT.0.005) GOTO 100FK=FIF(KK.LE.40) GOTO 35WRITE(*,*) * KK40,DO Again! *IQ=JKK=0GOTO 35D=0.1396XK=A05CALL FUNC(XK,J)IF(ABS(F).LT.0.0005) GOTO 100FK=FXK=XK+DCALL FUNC(XK,J)IF(ABS(F).LT.0.0005) GOTO 100FK1=FXK1=XKXK=XK-DIF(FK1.LE.FK) GOTO 75FK=FJ1XK=XK1GOTO 65XK=XK-DCALL FUNC(XK,J)FK1=FXK1=XKXK1=XK+DIF(FK1.LE.FK) GOTO 85FK=FK1XK=XK1GOTO 75IF(ABS(XK-XK1).LT.0.001) GOTO 90D=D/2GOTO 65IF(F.LT.0.) GOTO 95KIM=KIM+1IM(J)=IM(J-1)IF(KIM.GE.2) IM(J)=0GOTO 15CONTINUEFORMA