ypsew

对于桥梁的圆形截面

	PROGRAM YPSEW
	CHARACTER*4 STR
	REAL L0,NJ,NO,MO,KCJG,J
	DIMENSION EG(2),AG1(2),BS(50),HS(50)
	OPEN(1,FILE='YPSEW.DAT')
	OPEN(2,FILE='YPSEW.OUT')
1     READ(1,*)ID
	READ(1,*)L0,D,EG(1),MK,MG
5     READ(1,*)NO,MO
	WRITE(*,'(/1X,''ID='',I1)')ID
	WRITE(2,'(/1X,''ID='',I1)')ID
	WRITE(*,106) L0,D,EG(1),MK,MG
	WRITE(2,106) L0,D,EG(1),MK,MG
	WRITE(*,'(1X,''NO='',E11.5,3X,''MO='',E11.5)')NO,MO
	WRITE(2,'(1X,''NO='',E11.5,3X,''MO='',E11.5)')NO,MO
	E0=ABS(MO/NO)*100
	IF(ID.EQ.0) READ(1,*)AG1(1)
	IF(ID.EQ.1) AG1(1)=0
	IF(E0.LT.1E-3) THEN
	 IF(NO.LT.0.0) READ(1,*)DJ,S1,MG2
	 IF(ID.EQ.0.AND.NO.LT.0.0) THEN
	  WRITE(*,107) DJ,S1,MG2,AG1(1)
	  WRITE(2,107) DJ,S1,MG2,AG1(1)
	 ENDIF
	 IF(ID.EQ.1.AND.NO.LT.0.0) THEN
	  WRITE(*,108) DJ,S1,MG2
	  WRITE(2,108) DJ,S1,MG2
	 ENDIF
	 F=3.1416*0.25*D**2
	 IF(NO.GT.0.0) GOTO 30
	 NS=1
	 CALL FIM(0,L0,HS,BS,NS,D,F,J,FE)
	 IF(MG2.NE.0) CALL REG(MG2,RG2,RG1,ES,KCJG)
	 IF(MG2.EQ.0)RG2=0
 30    IF(ID.EQ.0) GOTO 35
	 CALL SJJM(MK,NO,F,AG1,MG,RG2,D,EG,DJ,S1,FE,0,L0)
	 WRITE(*,105) NO,AG1(1)
	 WRITE(2,105) NO,AG1(1)
 35    CALL ESJM(MK,NO,NJ,F,AG1,MG,RG2,D,EG,DJ,S1,FE,L0,0)
	 STR='.LT.'
	 IF(ABS(NJ)-ABS(NO).GT.0.2) STR='.GT.'
	 IF(ABS(NO-NJ).LE.0.2) STR='.EQ.'
	 WRITE(*,100)NO,NJ,STR,('*',I=1,63)
	 WRITE(2,100)NO,NJ,STR,('*',I=1,63)
	ELSE
	 IF(ID.EQ.0) GOTO 45
	 CALL PSEWY1(D,EG,E0,MK,MG,NO,NJ,AG1)
 45    CALL ETAE0(L0,D,NO,AG1,MK,E0,E01)
	 CALL PSEWY0(D,EG,E01,MK,MG,NJ,AG1)
	 STR='.LT.'
	 IF(ABS(NJ-NO).LE.0.2) STR='.EQ.'
	 IF(ABS(NJ)-ABS(NO).GT.0.2) STR='.GT.'
	 IF(ID.EQ.0) GOTO 55
	 IF(STR.EQ.'.LT.') THEN
	  AG1(2)=AG1(1)*1.5
 50     AG=(AG1(1)+AG1(2))/2
	  CALL ETAE0(L0,D,NO,AG,MK,E0,E01)
	  CALL PSEWY0(D,EG,E01,MK,MG,NJ,AG)
	  IF(NJ.GT.NO) AG1(1)=AG
	  IF(NJ.LT.NO) AG1(2)=AG
	  IF(ABS(AG1(1)-AG1(2)).GT.0.2) GOTO 50
	  AG1(1)=AG1(2)+0.2
	  GOTO 45
	 ENDIF
 55    WRITE(*,'(1X,''NJ='',E11.5,3X,''AG1(1)='',E10.5)')NJ,AG1(1)
	 WRITE(2,'(1X,''NJ='',E11.5,3X,''AG1(1)='',E10.5)')NJ,AG1(1)
	 WRITE(*,'(1X,''E0='',E11.5,3X,''E01='',E11.5)')E0,E01
	 WRITE(2,'(1X,''E0='',E11.5,3X,''E01='',E11.5)')E0,E01
	 WRITE(*,100)NO,NJ,STR,('*',I=1,63)
	 WRITE(2,100)NO,NJ,STR,('*',I=1,63)
	ENDIF
	READ(1,*)LD
	IF(LD-1) 60,5,1
 60   STOP
100   FORMAT(1X,'NO=',E11.5,3X,'NJ=',E11.5,5X,'NJ',A4,'NO'/80A1)
105   FORMAT(' NO=',E11.5,3X,'AG1(1)=',E11.5)
106   FORMAT(1X,'L0=',E11.5,3X,'D=',E10.5,3X,'EG(1)=',E10.5,3X,'MK='
     1      ,I2,2X,'MG=',I1)
107   FORMAT(1X,'DJ=',E11.5,3X,'S1=',E11.5,3X,'MG2=',I1,3X,
     1      'AG1(1)=',E11.5)
108   FORMAT(1X,'DJ=',E11.5,3X,'S1=',E11.5,3X,'MG2=',I1)
	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 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 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 ABCD(KC,RG,EG,G,A,B,C,D)
	REAL KC
	PI=3.14159
	EP=0.0033
	BT=1.0667-0.2666*KC
	IF(KC.LE.1.0) BT=0.8
	CTH1=1.0-2.0*BT*KC
	IF(ABS(CTH1).GE.1) CTH=PI
	IF(ABS(CTH1).LT.1) CTH=ACOS(CTH1)
	CTA1=2.0*KC/G/EP*RG/EG+(1.0-2.0*KC)/G
	IF(ABS(CTA1).GE.1) CTA=PI
	IF(ABS(CTA1).LT.1) CTA=ACOS(CTA1)
	CTL1=-2.0*KC/G/EP*RG/EG+(1.0-2.0*KC)/G
	IF(ABS(CTL1).GE.1) CTL=PI
	IF(ABS(CTL1).LT.1) CTL=ACOS(CTL1)
	A=0.5*(2.0*CTH-SIN(2.0*CTH))
	B=2.0*(SIN(CTH))**3/3.0
	C=CTA-PI+CTL+1.0/(G*COS(CTA)-(1.0-2.0*KC))*(G*(SIN(CTL)-S
     1            IN(CTA))-(1.0-2.0*KC)*(CTL-CTA))
	D=SIN(CTA)+SIN(CTL)+1.0/(G*COS(CTA)-(1.0-2.0*KC))*(G*((CTL-CTA)
     1          /2.0+(SIN(2.0*CTL)-SIN(2.0*CTA))/4.0)-(1.0-2.0*KC)*(SIN
     2          (CTL)-SIN(CTA)))
	RETURN
	END

	SUBROUTINE PSEWY0(D,EG,E0,MK,MG,NJ,AG1)
	REAL KC,KC1,KC2,MU,NJ,KCJG
	DIMENSION EG(2),AG1(2)
	R=D/2.0
	G=(R-EG(1))/R
	CALL REH(MK,RA,RL,EH)
	CALL REG(MG,RG,RG1,ES,KCJG)
	MU=AG1(1)/(3.14159*R*R)
	KC1=0.2
	KC2=1.5
10    KC=(KC1+KC2)/2.0
	CALL ABCD(KC,RG,ES,G,A,B,C,D1)
	E01=(B*RA+D1*MU*G*RG)*R/(A*RA+C*MU*RG)
	IF(ABS(E01-E0).LE.1E-3) GOTO 20
	IF(E0.LE.E01) KC1=KC
	IF(E0.GT.E01) KC2=KC
	GOTO 10
20    NJ=-0.76*(A*R*R*RA+C*MU*R*R*RG)*0.1
	RETURN
	END

	SUBROUTINE PSEWY1(D,EG,E0,MK,MG,NO,NJ,AG1)
	REAL KC,MU,NO,NJ,KCJG,KC1,KC2
	DIMENSION EG(2),AG1(2)
	R=D/2.0
	G=(R-EG(1))/R
	CALL REH(MK,RA,RL,EH)
	CALL REG(MG,RG,RG1,ES,KCJG)
	KC=0.2
10    CALL ABCD(KC,RG,ES,G,A,B,C,D1)
	MU=RA*(B*R-A*E0)/RG/(C*E0-D1*G*R)
	NJ=-0.76*(A*R*R*RA+C*MU*R*R*RG)*0.1
	IF(NJ.GE.NO) GOTO 20
	KC1=KC-0.05
	KC2=KC
15    KC=(KC1+KC2)/2
	CALL ABCD(KC,RG,ES,G,A,B,C,D1)
	MU=RA*(B*R-A*E0)/RG/(C*E0-D1*G*R)
	NJ=-0.76*(A*R*R*RA+C*MU*R*R*RG)*0.1
	IF(ABS(NJ-NO).LE.1E-2) GOTO 30
	IF(NO.LE.NJ) KC1=KC
	IF(NO.GT.NJ) KC2=KC
	GOTO 15
20    IF(ABS((NJ-NO)/NO).LE.1E-2) GOTO 30
	KC=KC+0.05
	GOTO 10
30    AG1(1)=3.14159*MU*R*R
	IF(AG1(1).LT.0.0) AG1(1)=0.0
	END

	SUBROUTINE ETAE0(L0,D,NO,AG1,MK,E0,E01)
	REAL L0,NO,J,IH
	DIMENSION AG1(2)
	IF(L0/D.LE.7.0) THEN
	 E01=E0
	 RETURN
	ENDIF
	F=3.14159*D*D/4.0
	J=3.14159*D**4/64.0
	ALF=0.1/(0.3+E0/D)+0.143
	IF(E0/D.GE.1.0) ALF=0.22
	CALL ETA1(AG1,F,J,ALF,NO,L0,MK,ETA)
	E01=E0*ETA
	RETURN
	END

	SUBROUTINE ETA1(AG1,F,J,ALF,NO,L0,MK,ETA)
	REAL L0,J,NO,IH,MU
	DIMENSION AG1(2)
	CALL REH(MK,RA,RL,EH)
	MU=AG1(1)/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