📄 lew0
字号:
PROGRAM LEW0
CHARACTER*4 STR
REAL L0,NO,MO,J,NN,M,NJ,MJ
LOGICAL NGO
DIMENSION EG(2),AG1(2),BS(50),HS(50),E(2),AG(2)
OPEN(1,FILE='LEW0.DAT')
OPEN(2,FILE='LEW0.OUT')
5 READ(1,*)NS,(BS(I),HS(I),I=1,NS)
READ(1,*)MK,MG
10 READ(1,*)(AG1(I),EG(I),I=1,2)
READ(1,*)NO,MO
IF(NO.LT.0.0) READ(1,*)L0
WRITE(*,101) (BS(I),HS(I),I=1,NS)
WRITE(2,101) (BS(I),HS(I),I=1,NS)
IF(ABS(MO).GT.1E-4) THEN
WRITE(*,102) (AG1(I),EG(I),I=2,1,-1)
WRITE(2,102) (AG1(I),EG(I),I=2,1,-1)
ELSE
WRITE(*,'(1X,''AG1(1)='',E11.5)')AG1(1)
WRITE(2,'(1X,''AG1(1)='',E11.5)')AG1(1)
ENDIF
IF(NO.LT.0.0) THEN
WRITE(*,103)MK,MG,L0
WRITE(2,103)MK,MG,L0
ELSE
WRITE(*,'(1X,''MK='',I2,3X,''MG='',I1)')MK,MG
WRITE(2,'(1X,''MK='',I2,3X,''MG='',I1)')MK,MG
ENDIF
WRITE(*,'(1X,''NO='',E11.5,7X,''MO='',E11.5)')NO,MO
WRITE(2,'(1X,''NO='',E11.5,7X,''MO='',E11.5)')NO,MO
NGO=MO.LT.0.0
IF(ABS(MO).GE.1E-4) GOTO 25
H=HS(NS)
CALL FSJYA(1,H,F,S,J,NS,BS,HS,NGO,EG,AG1,NN)
IF(NO.GT.0.0) GOTO 15
CALL FIM(1,L0,HS,BS,NS,D,F,J,FE)
15 CALL ESJM(MK,NO,NJ,F,AG1,MG,RG2,D,EG,DJ,S1,FE,L0,1)
GOTO 40
25 IF(ABS(NO).GE.1E-4) GOTO 30
CALL BMSTS1(MK,MO,MJ,HS,BS,NS,EG,AG1,AG,MG)
GOTO 40
30 CALL INV(M,MO,HS,NS,NGO,EG,E,AG1,AG)
E0=ABS(MO/NO)*100
CALL LEWES(L0,NS,BS,HS,NO,NJ,AG,E,MK,MG,NGO,E0,NN,Y,Y1)
40 IF(ABS(NO).GT.1E-4) THEN
STR='.LT.'
IF(ABS(NJ-NO).LT.0.1) STR='.EQ.'
IF(ABS(NJ)-ABS(NO).GE.0.1) STR='.GT.'
WRITE(*,104)NO,NJ,STR,('*',I=1,51)
WRITE(2,104)NO,NJ,STR,('*',I=1,51)
ELSE
STR='.LT.'
IF(ABS(MJ-MO).LT.0.1) STR='.EQ.'
IF(ABS(MJ)-ABS(MO).GE.0.1) STR='.GT.'
WRITE(*,105)MO,MJ,STR,('*',I=1,51)
WRITE(2,105)MO,MJ,STR,('*',I=1,51)
ENDIF
READ(1,*)LD
IF(LD-1)50,10,5
50 STOP
101 FORMAT(/5X,'BS(I)',11X,'HS(I)'/(1X,E11.5,5X,E11.5))
102 FORMAT(4X,'AG1(I)'11X,'EG(I)'/(1X,E11.5,5X,E11.5))
103 FORMAT(1X,'MK=',I2,3X,'MG=',I1,3X,'L0=',E11.5)
104 FORMAT(1X,'NO=',E11.5,7X,'NJ=',E11.5,7X,'NJ',A4,'NO'/80A1)
105 FORMAT(1X,'MO=',E11.5,7X,'MJ=',E11.5,7X,'MJ',A4,'MO'/80A1)
END
SUBROUTINE FSJYA(G,Y,F,S,J,NS,BS,HS,NGO,E,AG,NN)
INTEGER G
REAL J,NN
LOGICAL NGO
DIMENSION BS(NS),HS(NS),E(2),AG(2)
F=0.0
S=0.0
J=0.0
IF(G-1) 40,5,5
5 DO 20 K=2,NS
I=K
I1=I-1
IF(NGO) I=NS+1-K
IF(NGO) I1=I+1
IF(Y.GT.HV(I,NGO,HS,NS)) GOTO 10
D=Y-HV(I1,NGO,HS,NS)
BI=BS(I1)+D*(BS(I)-BS(I1))/(HV(I,NGO,HS,NS)-HV(I1,NGO,HS,NS))
CALL AD(F,S,J,D,BI,I1,BS,NS)
GOTO 30
10 BI=BS(I)
D=HV(I,NGO,HS,NS)-HV(I1,NGO,HS,NS)
CALL AD(F,S,J,D,BI,I1,BS,NS)
20 CONTINUE
30 IF(G.EQ.1) RETURN
40 DO 50 K=1,2
A=AG(K)*NN
F=F+A
A=A*(Y-E(K))
S=S+A
J=J+A*(Y-E(K))
50 CONTINUE
END
FUNCTION HV(I,NGO,HS,NS)
LOGICAL NGO
DIMENSION HS(NS)
HV=HS(I)
IF(NGO) HV=HS(NS)-HS(I)
RETURN
END
SUBROUTINE AD(F,S,J,D,BI,I1,BS,NS)
REAL J
DIMENSION BS(NS)
B=BI-BS(I1)
J=J+2.0*D*S+D*D*F+(BS(I1)+B/4.0)*D**3/3.0
S=S+D*F+(BS(I1)+B/3.0)*D*D/2.0
F=F+D*(BI+BS(I1))/2.0
RETURN
END
SUBROUTINE REH(MK,RA,RL,EH)
DIMENSION RAD(7),RLD(7),EHD(7)
DATA RAD/8.5,11.0,14.5,17.5,23.0,28.5,32.5/
DATA RLD/1.05,1.3,1.55,1.75,2.15,2.45,2.65/
DATA EHD/2.3E4,2.6E4,2.85E4,3.0E4,3.3E4,3.5E4,3.65E4/
IF(MK.LT.30) I=MK/5-2
IF(MK.GE.30) I=MK/10+1
RA=RAD(I)
RL=RLD(I)
EH=EHD(I)
RETURN
END
SUBROUTINE REG(MG,RG,RG1,EG,KCJG)
REAL KCJG,KCD
DIMENSION RGD(5),RG1D(5),EGD(5),KCD(5)
DATA RGD/240.0,340.0,380.0,550.0,280.0/
DATA RG1D/240.0,340.0,380.0,400.0,280.0/
DATA EGD/2.1E5,4*2E5/,KCD/0.65,3*0.55,0.6/
RG=RGD(MG)
RG1=RG1D(MG)
EG=EGD(MG)
KCJG=KCD(MG)
RETURN
END
SUBROUTINE INV(M,MO,HS,NS,NGO,EG,E,AG1,AG)
DIMENSION HS(NS),EG(2),E(2),AG1(2),AG(2)
REAL M,MO
LOGICAL NGO
H=HS(NS)
IF(NGO) GOTO 20
M=MO
DO 10 I=1,2
E(I)=EG(I)
10 AG(I)=AG1(I)
GOTO 30
20 M=-MO
E(1)=H-EG(2)
E(2)=H-EG(1)
AG(1)=AG1(2)
AG(2)=AG1(1)
30 RETURN
END
SUBROUTINE ETAE1(L0,NS,BS,HS,NO,AG,E,MK,NGO,E0,E01)
REAL L0,NO,J,IH,NN
LOGICAL NGO
DIMENSION BS(NS),HS(NS),AG(2),E(2)
IF(NO.GT.0.0) THEN
E01=E0
RETURN
ENDIF
H=HS(NS)
CALL FSJYA(1,H,F,S,J,NS,BS,HS,NGO,E,AG,NN)
Y2=S/F
J=J-Y2*Y2*F
RW=SQRT(J/F)
IF(L0/RW.LE.28.0.AND.NS.NE.2.OR.NS.EQ.2.AND.L0/H.LE.8.0) THEN
E01=E0
RETURN
ENDIF
ALF=0.1/(0.3+E0/H)+0.143
IF(E0/H.GE.1.0) ALF=0.22
CALL ETA1(AG,F,J,ALF,NO,L0,MK,ETA)
E01=E0*ETA
RETURN
END
SUBROUTINE ETA1(AG,F,J,ALF,NO,L0,MK,ETA)
REAL L0,J,NO,IH,MU
DIMENSION AG(2)
CALL REH(MK,RA,RL,EH)
MU=(AG(1)+AG(2))/F
IH=J
IF(MU.GT.0.03) IH=1.2*J
ETA0=1.0-12.5*ABS(NO)*L0*L0/(9.5*ALF*EH*IH)
IF(ETA0.EQ.0.0) GOTO 5
ETA=1.0/ETA0
IF(ETA.LT.0.0.OR.ETA.GT.3.0) GOTO 5
RETURN
5 STOP 'Revise section,compute again!'
END
SUBROUTINE BMSTS1(MK,MO,MJ,HS,BS,NS,EG,AG1,AG,MG)
DIMENSION HS(NS),BS(NS),EG(2),AG(2),AG1(2),E(2)
LOGICAL NGO
REAL MO,NN,M,J,MJ,KCJG,MJ1
NGO=MO.LT.0.0
CALL REH(MK,RA,RL,EH)
CALL REG(MG,RG,RG1,ES,KCJG)
CALL INV(M,MO,HS,NS,NGO,EG,E,AG1,AG)
IF(AG(1).GT.AG(2)) GOTO 75
72 MJ1=0.8*RG*AG(1)*(E(1)-E(2))*0.001
AG(2)=0.0
E(2)=0.0
75 H0=E(1)
C1=0.0
C2=H0
81 Y=(C1+C2)/2.0
CALL FSJYA(1,Y,F,S,J,NS,BS,HS,NGO,E,AG,NN)
IF(F*RA.LT.RG*AG(1)-RG1*AG(2)) C1=Y
IF(F*RA.GE.RG*AG(1)-RG1*AG(2)) C2=Y
IF(ABS((C2-C1)/H0).GT.1E-4) GOTO 81
IF(Y.LT.2*E(2)) GOTO 72
IF(Y.GT.KCJG*H0) STOP 'The X greater than Kcjg*H0'
YC=Y-S/F
MJ=(0.8*RA*F*(H0-YC)+0.8*RG1*AG(2)*(H0-E(2)))*0.001
IF(MJ1.GT.MJ) MJ=MJ1
IF(NGO) MJ=-MJ
RETURN
END
SUBROUTINE CEE1(NO,NS,BS,HS,NGO,E,AG,NN,E01,EE,EE1)
REAL NN,J,NO
LOGICAL NGO
DIMENSION BS(NS),HS(NS),E(2),AG(2)
H=HS(NS)
CALL FSJYA(1,H,F,S,J,NS,BS,HS,NGO,E,AG,NN)
R=H-S/F
IF(NO.LT.0.0) THEN
EE=E(1)-R+E01
EE1=ABS(R-E01-E(2))
ELSE
EE=ABS(R+E01-E(1))
EE1=R+E01-E(2)
ENDIF
RETURN
END
SUBROUTINE FIM(K,L0,HS,BS,NS,D,F,J,FE1)
REAL J,L0
DIMENSION HS(NS),BS(NS),X1(22),X2(22),X3(22),FI(22)
DATA X1/8.0,10.0,12.0,14.0,16.0,18.0,20.0,22.0,24.0,26.0,
1 28.0,30.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0,50.0/
DATA X2/7.0,8.5,10.5,12.0,13.0,15.5,17.0,19.0,21.0,22.5,24.0,
1 26.0,28.0,29.5,31.0,33.0,34.5,36.5,38.0,40.0,41.5,43.0/
DATA X3/28.0,35.0,42.0,48.0,50.0,62.0,69.0,76.0,83.0,90.0,
1 97.0,104.0,111.0,118.0,125.0,132.0,139.0,146.0,153.0,160.0,
2 167.0,174.0/
DATA FI/1.0,0.98,0.95,0.92,0.87,0.81,0.75,0.70,0.65,0.60,
1 0.56,0.52,0.48,0.44,0.40,0.36,0.32,0.29,0.26,0.23,0.21,0.19/
IF(K.EQ.0) GOTO 100
IF(NS.EQ.2) GOTO 110
X=L0/SQRT(J/F)
FE1=FE(X,X3,FI,22)
RETURN
100 X=L0/D
FE1=FE(X,X2,FI,22)
RETURN
110 IF(BS(2).LE.HS(2)) X=L0/BS(2)
IF(BS(2).GT.HS(2)) X=L0/HS(2)
FE1=FE(X,X1,FI,22)
RETURN
END
FUNCTION FE(X,XI,FI,N)
DIMENSION XI(N),FI(N)
IF(X.LE.XI(1)) GOTO 50
IF(X.GE.XI(N)) GOTO 60
DO 30 I=1,N
IF(X.LT.XI(I)) GOTO 40
30 CONTINUE
40 FE=FI(I-1)+(FI(I)-FI(I-1))*(X-XI(I-1))
1 /(XI(I)-XI(I-1))
RETURN
50 FE=1.0
RETURN
60 FE=0.19
RETURN
END
SUBROUTINE ESJM(MK,NO,NJ,A,AG,MG,RG2,D,EG,DJ,S,FE,L0,K)
DIMENSION AG(2),EG(2)
REAL NO,NJ,L0,KCJG
IF(NO)20,20,10
10 CALL REG(MG,RG,RG1,ES,KCJG)
NJ=1.0/1.25*RG*AG(1)*0.1
RETURN
20 CALL REH(MK,RA,RL,EH)
CALL REG(MG,RG,RG1,ES,KCJG)
IF(K.EQ.1) GOTO 80
IF(L0/D.GT.7.0.OR.DJ.LE.1E-5) GOTO 80
AHE=3.1416*(D-2*EG(1))**2/4
AJ=3.1416*(DJ/10)**2/4
AJG=3.1416*(D-2.0*EG(1))*AJ/S
IF(AJG.LT.0.25*AG(1)) GOTO 80
NJ=-0.95*(RA*AHE+RG1*AG(1)+2*RG2*AJG)/1.25*0.1
BJ=-FE*0.95*(RA*A/1.25+RG1*AG(1)/1.25)*0.1
IF(NJ.LT.1.5*BJ) NJ=1.5*BJ
IF(NJ.GT.BJ) NJ=BJ
RETURN
80 NJ=-FE*0.95*(RA*A/1.25+RG1*AG(1)/1.25)*0.1
RETURN
END
SUBROUTINE DSEW(NS,BS,HS,RG,RG1,KCJG,ES,RA,EE,EE1,AG,E,NGO,NJ)
REAL KC,J,NN,NJ,NJ1,NJ2,NJ3,KCJG
LOGICAL NGO
DIMENSION BS(NS),HS(NS),E(2),AG(2)
NJ2=0.0
IF(AG(2).GT.1E-4) IAG=1
IF(AG(2).LT.1E-4) IAG=0
IF(IAG.EQ.1) E2=E(2)
IF(IAG.EQ.0) E2=0.0
H0=E(1)
E2=E(2)
5 Y1=0.0
Y2=HS(NS)
10 Y=(Y1+Y2)/2.0
CALL FSJYA(1,Y,F,S,J,NS,BS,HS,NGO,E,AG,NN)
YC=Y-S/F
KC=Y/H0
IF(KC.LE.KCJG) SG=RG
IF(KC.GT.KCJG) SG=0.003*ES*(0.9/KC-1.0)
IF(SG.GT.RG) SG=RG
IF(EE.GE.H0-E2) THEN
IF(IAG.EQ.1) THEN
A=(SG*AG(1)*EE-RG1*AG(2)*EE1)*0.001
IF(A.GT.0.0) THEN
NAG=1
ELSE
NAG=0
A=SG*AG(1)*EE*0.001
ENDIF
ELSE
A=SG*AG(1)*EE*0.001
ENDIF
ELSE
NAG=1
IF(IAG.EQ.1) A=(SG*AG(1)*EE+RG1*AG(2)*EE1)*0.001
IF(IAG.EQ.0) A=SG*AG(1)*EE*0.001
ENDIF
B=RA*F*(EE-E(1)+YC)*0.001
IF(B.LE.A) Y1=Y
IF(B.GT.A) Y2=Y
IF(ABS((B-A)/B).GT.1E-4) GOTO 10
IF(IAG.EQ.1) NJ1=-0.76*(RA*F+RG1*AG(2)-SG*AG(1))*0.1
IF(IAG.EQ.0.OR.NAG.EQ.0) NJ1=-0.76*(RA*F-SG*AG(1))*0.1
IF(NAG.EQ.0.OR.IAG.EQ.0) GOTO 20
IF(NAG.EQ.1.AND.Y.LT.2.0*E(2)) THEN
NJ2=-0.76*RG*AG(1)*(E(1)-E(2))/EE1*0.1
IAG=0
NAG=0
GOTO 5
ENDIF
20 IF(ABS(NJ2).LT.ABS(NJ1)) NJ=NJ1
IF(ABS(NJ2).GE.ABS(NJ1)) NJ=NJ2
IF(NAG.EQ.0) E2=0
IF(EE.GT.E(1)-E2) RETURN
H=HS(NS)
CALL FSJYA(1,H,F,S,J,NS,BS,HS,NGO,E,AG,NN)
B=BS(1)
IF(NGO) B=BS(NS)
F=F-B*E2
S=S-B*E2*(H-E2/2.0)
YC=H-E2-S/F
IF(EE1.GT.1E-4) NJ3=-0.76*(RA*F*YC+RG1*AG(1)*(E(1)-E2))/EE1*0.1
IF(NJ3.GT.NJ) NJ=NJ3
RETURN
END
SUBROUTINE DLW(NS,BS,HS,RG,RG1,KCJG,RA,EE,EE1,AG,E,NGO,NJ,Y,YE)
REAL KCJG,J,NN,NJ,NJ1,NJ2
LOGICAL NGO
DIMENSION BS(NS),HS(NS),E(2),AG(2)
NJ2=0.0
IF(AG(2).LT.1E-5) IAG=0
IF(AG(2).GT.1E-5) IAG=1
H0=E(1)
YE=KCJG*H0
5 Y1=0.0
Y2=H0
10 Y=(Y1+Y2)/2.0
CALL FSJYA(1,Y,F,S,J,NS,BS,HS,NGO,E,AG,NN)
YC=Y-S/F
IF(IAG.EQ.1) THEN
A=(RG*AG(1)*EE-RG1*AG(2)*EE1)*0.001
IF(A.GT.0.0) THEN
NAG=1
ELSE
NAG=0
A=RG*AG(1)*EE*0.001
ENDIF
ELSE
A=RG*AG(1)*EE*0.001
ENDIF
B=RA*F*(EE+E(1)-YC)*0.001
IF(B.LE.A) Y1=Y
IF(B.GT.A) Y2=Y
IF(Y.GT.0.95*H0) THEN
AG(1)=8192
RETURN
ENDIF
IF(ABS((B-A)/B).GT.1E-4) GOTO 10
IF(IAG.EQ.1) NJ1=0.8*(RG*AG(1)-RG1*AG(2)-RA*F)*0.1
IF(IAG.EQ.0.OR.NAG.EQ.0) NJ1=0.8*(RG*AG(1)-RA*F)*0.1
IF(IAG.EQ.0.OR.NAG.EQ.0) GOTO 20
IF(NAG.EQ.1.AND.Y.LT.2.0*E(2)) THEN
NJ2=0.8*RG*AG(1)*(E(1)-E(2))/EE1*0.1
IAG=0
NAG=0
GOTO 5
ENDIF
20 IF(NJ2.LT.NJ1) NJ=NJ1
IF(NJ2.GT.NJ1) NJ=NJ2
RETURN
END
SUBROUTINE LEWZHZ(NS,BS,HS,MK,MG,EE,EE1,AG,E,NGO,NO,NJ,Y,YE)
REAL KC,KCJG,J,NN,NO,NJ,NJ1
LOGICAL NGO
DIMENSION BS(NS),HS(NS),E(2),AG(2)
CALL REH(MK,RA,RL,EH)
CALL REG(MG,RG,RG1,ES,KCJG)
IF(NO.GT.0.0.AND.EE1.LT.E(1)-E(2)) THEN
IF(EE.GE.1E-4) NJ=0.8*(RG*AG(2)*(EE+EE1))/EE*0.1
NJ1=0.8*(RG*AG(1)*(EE+EE1))/EE1*0.1
IF(NJ1.LT.NJ) NJ=NJ1
RETURN
ENDIF
IF(NO.GT.0.0) THEN
CALL DLW(NS,BS,HS,RG,RG1,KCJG,RA,EE,EE1,AG,E,NGO,NJ,Y,YE)
RETURN
ENDIF
CALL DSEW(NS,BS,HS,RG,RG1,KCJG,ES,RA,EE,EE1,AG,E,NGO,NJ)
END
SUBROUTINE LEWES(L0,NS,BS,HS,NO,NJ,AG,E,MK,MG,NGO,E0,NN,Y,Y1)
REAL L0,NO,NJ,NN
LOGICAL NGO
DIMENSION BS(NS),HS(NS),E(2),AG(2)
CALL ETAE1(L0,NS,BS,HS,NO,AG,E,MK,NGO,E0,E01)
CALL CEE1(NO,NS,BS,HS,NGO,E,AG,NN,E01,EE,EE1)
CALL LEWZHZ(NS,BS,HS,MK,MG,EE,EE1,AG,E,NGO,NO,NJ,Y,Y1)
RETURN
END
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -