340土质边坡德定分析一原理·方法程序 READ(5,*)LSL外边坡线总数 READ(S,*)LNUM()l=1,LSL)外边坡线编号 READ(5,NN!点总数 READ,*)L,XN(I,YN(D)1=1,NN)点坐标 703 FORMAT(T25,***) WRITE(6, 704) ORMAT(IOX, THEABSCISSAVALUESOFTHEUPPERANDLOWER') CALL SEARCLNUM,C,DS,CXCY,XN,YN,LSL, NLOW NUPP)!寻找上、下交点所在线段 CALL DIVI(NIC,IWRS,DS,CXCY,XN,YN!确定上、下交点坐标,条分 S, YTENSION, NLOW, NUPP X, Y, ALI 711 FORMAT(TS, NO, T17, X,T32,Y, T47,ALF) DO309I=1 WRITE(6,710)L, X),Y(),ALFO 710 FORMAT(1X,15,3F15.6) 309 CONTINUE 12 CALLCLOSEFL END SUBROUTINE CLOSEFL CLOSE(5) CLOSE(6) RETURN SUBROUTINE DIVI(N, IC, TWRS, DS, CX, CY,XN,YN S, YTENSION, NLOW,NUPP,X,Y,ALF) INTEGERNS, N, K, IC(80,3), KI, KTEMP, TWRS,J,J1,JTEMPNLOW, NUPP REAL RO, DS, CY,XN(80), YN(80),SK, T, XL, CX, XUl, YTENSION REAL YUI,SJ, XU, ROO, YU, X2(80), Y2(80), X(80), Y(80), ALF(80) S(E1,F1E2,F2)=(F2-F1)(E2-E1) NS=N-1 RO=DS-CY KI=IC(NLOW, 2) IF(XN(K).GTXN(KDGOTO190 KTEMP=K KI=KTEMP 190 IF(ABS(XN(K)-XN(KI).LT0.00005 ) GOTO23 SK=S(XN(K),YN(K), XN(KD,YN(KD) T=SK*XN(K)-YN(K)+CY XL=(CX+SK*T+SQRT(1+SK*2)RO*2-(SK*CX-T)*2))(1+SK**2) !按式(16)计算下交点的横坐标 GOTO28 23 XLFXNK 28 CONTINUE IF(WRS NE.O)THEN XUI=CX-SQRT(RORO-(YTENSION-CY*2) YUI=CY+SQRT(RO**2-ABS(XUl-CX)**2) J=IC(NUPP, D) IF(XNO).GT.XNJDGOTO191 JTEMP- JI=JTEMP340 土质边坡稳定分析 原理 ⋅ 方法 ⋅ 程序 READ(5,*)LSL!外边坡线总数 READ(5,*)(LNUM(I),I=1,LSL)!外边坡线编号 READ(5,*)NN!点总数 READ(5,*)(L,XN(I),YN(I),I=1,NN)!点坐标 WRITE(6,703) 703 FORMAT(T25,'******************'//) WRITE(6,704) 704 FORMAT(10X,'THEABSCISSAVALUESOFTHEUPPERANDLOWER') CALL SEAR(LNUM,IC,DS,CX,CY,XN,YN,LSL,NLOW,NUPP)!寻找上 下交点所在线段 CALL DIVI(N,IC,IWR5,DS,CX,CY,XN,YN 确定上 下交点坐标 条分 $,YTENSION,NLOW,NUPP,X,Y,ALF) WRITE(6,711) 711 FORMAT(T5,'NO.',T17,'X',T32,'Y',T47,'ALF') DO 309 I=1,N WRITE(6,710)I,X(I),Y(I),ALF(I) 710 FORMAT(1X,I5,3F15.6) 309 CONTINUE 12 CALLCLOSEFL END SUBROUTINE CLOSEFL CLOSE(5) CLOSE(6) RETURN END SUBROUTINE DIVI(N,IC,IWR5,DS,CX,CY,XN,YN $,YTENSION, NLOW,NUPP,X,Y,ALF) INTEGERN S,N,K,IC(80,3),K1,KTEMP,IWR5,J,J1,JTEMP,NLOW,NUPP REAL RO,DS,CY,XN(80),YN(80),SK,T,XL,CX,XU1,YTENSION REAL YU1,SJ,XU,ROO,YU,X2(80),Y2(80),X(80),Y(80),ALF(80) S(E1,F1,E2,F2)=(F2-F1)/(E2-E1) NS=N-1 RO=DS-CY K=IC(NLOW,1) K1=IC(NLOW,2) IF(XN(K).GT.XN(K1))GOTO190 KTEMP=K K=K1 K1=KTEMP 190 IF(ABS(XN(K)-XN(K1)).LT.0.00005)GOTO23 SK=S(XN(K),YN(K),XN(K1),YN(K1)) T=SK*XN(K)-YN(K)+CY XL=(CX+SK*T+SQRT((1+SK**2)*RO**2-(SK*CX-T)**2))/(1+SK**2) !按式(11.6)计算下交点的横坐标 GOTO28 23 XL=XN(K) 28 CONTINUE IF(IWR5.NE.0)THEN XU1=CX-SQRT(RO*RO-(YTENSION-CY)**2) YU1=CY+SQRT(RO**2-ABS(XU1-CX)**2) ENDIF J=IC(NUPP,1) J1=IC(NUPP,2) IF(XN(J).GT.XN(J1))GOTO191 JTEMP=J J=J1 J1=JTEMP