📄 lew1
字号:
PROGRAM LEW1
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='LEW1.DAT')
OPEN(2,FILE='LEW1.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(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 SJJM(MK,NO,F,AG1,MG,RG2,D,EG,DJ,S1,FE,1,L0)
GOTO 40
25 CALL INV(M,MO,HS,NS,NGO,EG,E,AG1,AG)
IF(ABS(NO).GE.1E-4) GOTO 30
AG(2)=0.0
CALL BMA1(MK,M,HS,BS,NS,E,AG,MG,NGO,NN,Y,Y1)
IF(AG(1).GE.8E3) GOTO 32
CALL BMA0(MK,MJ,HS,BS,NS,E,AG,MG,NGO,NN,Y,Y1)
IF(Y.LE.Y1) GOTO 35
GOTO 32
30 E0=ABS(MO/NO)*100
IF(NO.GT.0.0) THEN
CALL CEE1(NO,NS,BS,HS,NGO,E,AG,NN,E0,EE,EE1)
IF(EE1.LT.E(1)-E(2)) THEN
CALL REG(MG,RG,RG1,ES,KCJG)
AG(1)=NO*EE1*12.5/(EE+EE1)/RG
AG(2)=NO*EE*12.5/(EE+EE1)/RG
GOTO 35
ENDIF
ENDIF
32 C=AG(2)
CALL BORDER(C,2.0,C1,C2,L0,NS,BS,HS,NO,NJ,M,AG,E,MK,MG,
1 NGO,E0,NN,Y,Y1)
IF(C2.LT.2.1) THEN
AG(2)=0.0
IF(ABS(NO).GT.1E-4) CALL LEWSJ(L0,NS,BS,HS,NO,NJ,AG,E,MK,MG,
1 NGO,E0,NN,Y,Y1)
IF(ABS(NO).LT.1E-4) CALL BMA1(MK,M,HS,BS,NS,E,AG,MG,NGO,NN,Y,
1 Y1)
GOTO 33
ENDIF
CALL O618(C1,C2,0.5,L0,NS,BS,HS,NO,NJ,M,AG,E,MK,MG,NGO,E0,NN,
1 Y,Y1)
33 IF(Y.LE.Y1) GOTO 35
AG(2)=AG(2)+1.0
IF(ABS(NO).GT.1E-4) CALL LEWSJ(L0,NS,BS,HS,NO,NJ,AG,E,MK,MG,NGO
1 ,E0,NN,Y,Y1)
IF(ABS(NO).LT.1E-4)CALL BMA1(MK,M,HS,BS,NS,E,AG,MG,NGO,NN,Y,Y1)
GOTO 33
35 IF(NGO) THEN
AG1(1)=AG(2)
AG1(2)=AG(1)
ELSE
AG1(1)=AG(1)
AG1(2)=AG(2)
ENDIF
40 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
WRITE(*,'(80A1)') ('*',I=1,36)
WRITE(2,'(80A1)') ('*',I=1,36)
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)
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 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 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
SUBROUTINE SJJM(MK,NO,A,AG1,MG,RG2,D,EG,DJ,S,FE,K,L0)
DIMENSION AG1(2),EG(2)
REAL NO,L0,KCJG
IF(NO) 20,20,10
10 CALL REG(MG,RG,RG1,ES,KCJG)
AG1(1)=1.25*NO/RG*10
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*AG1(1).OR.AJG.LE.1E-5) GOTO 80
AG1(1)=-NO/0.95*1.25/RG1*10-(RA*AHE+2*RG2*AJG)/RG1
IF(AG1(1).LT.0.0) AG1(1)=0.0
RETURN
80 AG1(1)=-NO/FE/0.95*1.25/RG1*10-RA*A/RG1
IF(AG1(1).LT.0.0) AG1(1)=0.0
RETURN
END
SUBROUTINE BMA1(MK,M,HS,BS,NS,E,AG,MG,NGO,NN,Y,YE)
LOGICAL NGO
REAL NN,M,J,KCJG,MJ
DIMENSION HS(NS),BS(NS),AG(2),E(2)
CALL REH(MK,RA,RL,EH)
CALL REG(MG,RG,RG1,ES,KCJG)
IF(0.8*RG1*AG(2)*(E(1)-E(2))*0.001.GT.M) THEN
AG(1)=1.25*M/RG/(E(1)-E(2))*1000
RETURN
ENDIF
H0=E(1)
CALL FSJYA(1,H0,F,S,J,NS,BS,HS,NGO,E,AG,NN)
YC=H0-S/F
IF(M.GT.(0.8*RG1*AG(2)*(E(1)-E(2))+0.8*RA*F*(E(1)-YC))*0.001)
1 GOTO 75
C1=0.0
C2=H0
YE=KCJG*H0
71 Y=(C1+C2)/2.0
CALL FSJYA(1,Y,F,S,J,NS,BS,HS,NGO,E,AG,NN)
YC=Y-S/F
MJ=(0.8*RG1*AG(2)*(E(1)-E(2))+0.8*RA*F*(E(1)-YC))*0.001
IF(M.GT.MJ) C1=Y
IF(M.LE.MJ) C2=Y
IF(ABS((C2-C1)/H0).GT.1E-4) GOTO 71
AG(1)=(F*RA+RG1*AG(2))/RG
RETURN
75 AG(1)=8192
RETURN
END
SUBROUTINE BMA0(MK,MJ,HS,BS,NS,E,AG,MG,NGO,NN,Y,YE)
LOGICAL NGO
REAL NN,J,MJ,KCJG,MJ1
DIMENSION HS(NS),BS(NS),AG(2),E(2)
CALL REH(MK,RA,RL,EH)
CALL REG(MG,RG,RG1,ES,KCJG)
IAG=1
IF(AG(1).GT.AG(2)) GOTO 75
72 MJ1=0.8*RG*AG(1)*(E(1)-E(2))*0.001
IAG=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(IAG.EQ.1.AND.F*RA.LT.RG*AG(1)-RG1*AG(2).OR.
1 IAG.EQ.0.AND.F*RA.LT.RG*AG(1)) THEN
C1=Y
ELSE
C2=Y
ENDIF
IF(ABS((C2-C1)/H0).GT.1E-4) GOTO 81
IF(IAG.EQ.1.AND.Y.LT.2*E(2)) GOTO 72
YC=Y-S/F
IF(IAG.EQ.1)MJ=(0.8*RA*F*(H0-YC)+0.8*RG1*AG(2)*(H0-E(2)))*0.001
IF(IAG.EQ.0)MJ=0.8*RA*F*(H0-YC)*0.001
IF(MJ1.GT.MJ) MJ=MJ1
YE=KCJG*H0
END
SUBROUTINE LEWSJ(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),AG(2),E(2)
AG(1)=2
10 CALL LEWES(L0,NS,BS,HS,NO,NJ,AG,E,MK,MG,NGO,E0,NN,Y,Y1)
IF(AG(1).GT.8E3) RETURN
IF(ABS(NO).GT.ABS(NJ)) THEN
AG(1)=2*AG(1)
GOTO 10
ELSE
A1=AG(1)/2
A2=AG(1)
ENDIF
IF(A2.LE.2.5) RETURN
20 AG(1)=(A1+A2)/2
CALL LEWES(L0,NS,BS,HS,NO,NJ,AG,E,MK,MG,NGO,E0,NN,Y,Y1)
IF(ABS(NO).GT.ABS(NJ)) A1=AG(1)
IF(ABS(NO).LE.ABS(NJ)) A2=AG(1)
IF(A2-A1.GT.0.2) GOTO 20
AG(1)=A2
END
FUNCTION AGSJYH(L0,NS,BS,HS,NO,NJ,M,AG,E,MK,MG,NGO,E0,NN,Y,Y1)
REAL L0,NO,NJ,M,NN
LOGICAL NGO
DIMENSION BS(NS),HS(NS),AG(2),E(2)
IF(ABS(NO).GT.1E-4) CALL LEWSJ(L0,NS,BS,HS,NO,NJ,AG,E,MK,MG,NGO
1 ,E0,NN,Y,Y1)
IF(ABS(NO).LT.1E-4)CALL BMA1(MK,M,HS,BS,NS,E,AG,MG,NGO,NN,Y,Y1)
AGSJYH=AG(2)+AG(1)
WRITE(*,'('' ----AGSJYH,AG1,AG2----'',3E15.5)')AGSJYH,AG
RETURN
END
SUBROUTINE BORDER(C,H,C1,C2,L0,NS,BS,HS,NO,NJ,M,AG,E,MK,MG,
1 NGO,E0,NN,Y,Y1)
REAL L0,NO,NJ,M,NN
LOGICAL NGO
DIMENSION BS(NS),HS(NS),E(2),AG(2)
C1=0.0
C2=H
5 AG(2)=C1+C
WRITE(*,'('' ----BF1:'')')
F1=AGSJYH(L0,NS,BS,HS,NO,NJ,M,AG,E,MK,MG,NGO,E0,NN,Y,Y1)
IF(AG(1).GT.8E3) THEN
C1=C2
IF(C2.GT.17.0)C2=C2+16.0
IF(C2.LT.17.0)C2=2.0*C2
GOTO 5
ENDIF
10 AG(2)=C+C2
WRITE(*,'('' ----BF2:'')')
F2=AGSJYH(L0,NS,BS,HS,NO,NJ,M,AG,E,MK,MG,NGO,E0,NN,Y,Y1)
IF(F2.GE.F1) GOTO 20
C1=C2
IF(C2.GT.17.0) C2=C2+16.0
IF(C2.LE.17.0) C2=2.0*C2
F1=F2
GOTO 10
20 IF(C1.LT.33.0) C1=C1/2.0
IF(C1.GT.33.0) C1=C1-16.0
C1=C+C1
C2=C+C2
RETURN
END
SUBROUTINE O618(C1,C2,EPS,L0,NS,BS,HS,NO,NJ,M,AG,E,MK,MG,
1 NGO,E0,NN,Y,Y1)
REAL L0,NO,NJ,M,NN,L1,L2,K
LOGICAL NGO
DIMENSION BS(NS),HS(NS),E(2),AG(2)
K=(SQRT(5.0)-1.0)/2.0
D=C2-C1
L2=C1+K*D
L1=C1+(1.0-K)*D
AG(2)=L2
WRITE(*,'('' ----OF2:'')')
F2=AGSJYH(L0,NS,BS,HS,NO,NJ,M,AG,E,MK,MG,NGO,E0,NN,Y,Y1)
AG(2)=L1
WRITE(*,'('' ----OF1:'')')
F1=AGSJYH(L0,NS,BS,HS,NO,NJ,M,AG,E,MK,MG,NGO,E0,NN,Y,Y1)
10 IF(ABS(F2-F1).LE.EPS) RETURN
IF(F1.GT.F2) GOTO 15
C2=L2
L2=L1
F2=F1
D=C2-C1
L1=C1+(1.0-K)*D
AG(2)=L1
WRITE(*,'('' ----OF1:'')')
F1=AGSJYH(L0,NS,BS,HS,NO,NJ,M,AG,E,MK,MG,NGO,E0,NN,Y,Y1)
GOTO 10
15 C1=L1
L1=L2
F1=F2
D=C2-C1
L2=C1+K*D
AG(2)=L2
WRITE(*,'('' ----OF2:'')')
F2=AGSJYH(L0,NS,BS,HS,NO,NJ,M,AG,E,MK,MG,NGO,E0,NN,Y,Y1)
GOTO 10
END
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -