第11章程序设计341 191 F(ABS(XNO)-XNOI)LT0.00005)GOTO82 J=S(XN),YN),XNI),YNJD) T=SJ"XNOFYNOHCY XU=Cx+SJ*T-SQRI(1+SJ**2)RO**2-(SJCX-)*2))(1+SJ**2) XU上交点的横坐标 ROO=RO**2-ABS(XU-CX)**2 IF( ROO.LT0 RETURN无交点,需修改RO,重新计算 YU=CY+SQRT(RO*#2-ABS(XU-CX) 2) IF( CYGTYN( J)AND CYGT.YN(J) RETURN凸弧否定,重算 IF(WRSNE.0 AND YU. LTYUI)XU=XUI XU=XNO) DO541=1,NS划分土条求各点坐标 X2(=(-)+(XLXU(NS-1)+XU!土条宽度B=(XL-XU(NS-1) Y2(FCY+SQRT(RO*2-ABS(X2()-CX)**2) 41 CONTINUE IF(ABS(Y2(NS-Y2(1)). LT0.OlTHEN WRITE(6, THE SLIP SURFACE INTERCEPTS A HORIZONTAL SURFACE RETURN ENDIF N=NS+1 Y2(NFY2(NS 计算土条中点坐标 DO544=2.NS X(=(X2(1)+X2(1-1)2 Y(=Y2(+Y2(-1)y ALF(I=ATAN(Y2(1)Y2(-1))(X2(1}X2(-1)) 4 CONTINUE ALF(IFALF(2) ALF(NALF(NS) X(NX2(N) X(1)=x2(1) Y(1)=Y2(1) RETURN END SUBROUTINE SEAR(LNUM,IC, DS, CX, CY,XN,YN, LSL, NLOW, NUPP) REAL R, DS, CY, R2, CX, XN(80),YN(80),Rl, D, XXL, SLO INTEGER I, I1, K, LNUM(80),J1, J2, IC(80,3), IN, NLOW,NUPP LSL I=1NLOW=下交点所在直线段的线段号 I1=0NUPP=上交点所在直线段的线段号 12K=LNUMD JI=IC(K, 1) J2=IC(K, 2) R= DS-CY!R=圆弧半 R2=SQRT(ABS(CX-XN(2)**2+ABS(CY-YNO2)* *2) RI=SQRT(ABS(CX-XNO1)**2+ABS(CY-YNJD))**2) R,R2为圆心至该线段两端点的距离 IF(REQ R2AND II.NEO)GOTOll IF(RGTR1 ANDR GTR2)GOTO11!无交点 IF(RLTR1 ANDRLTR2GOTO19有两个或零个交点 GOT020 19 CALL DD(XNJI),YND), XN(2), YN(J2), CX, CY, D, IN) XXL=XN(2)-XNO1第 11 章 程序设计 341 191 F(ABS(XN(J)-XN(J1)).LT.0.00005)GOTO82 SJ=S(XN(J),YN(J),XN(J1),YN(J1)) T=SJ*XN(J)-YN(J)+CY XU=(CX+SJ*T-SQRT((1+SJ**2)*RO**2-(SJ*CX-T)**2))/(1+SJ**2) !XU 上交点的横坐标 ROO=RO**2-ABS(XU-CX)**2 IF(ROO.LT.0)RETURN!无交点,需修改 RO,重新计算 YU=CY+SQRT(RO**2-ABS(XU-CX)**2) IF(CY.GT.YN(J).AND.CY.GT.YN(J1))RETURN!凸弧,否定,重算 IF(IWR5.NE.0.AND.YU.LT.YU1)XU=XU1 GOTO20 82 XU=XN(J) 20 X2(1)=XU DO541I=1,NS!划分土条,求各点坐标 X2(I)=(I-1)*(XL-XU)/(NS-1)+XU!土条宽度 B=(XL-XU)/(NS-1) Y2(I)=CY+SQRT(RO**2-ABS(X2(I)-CX)**2) 541 CONTINUE IF(ABS(Y2(NS)-Y2(1)).LT.0.01)THEN WRITE(6,*)'THE SLIP SURFACE INTERCEPTS A HORIZONTAL SURFACE' RETURN ENDIF N=NS+1 X2(N)=X2(NS) Y2(N)=Y2(NS) C 计算土条中点坐标 DO544I=2,NS X(I)=(X2(I)+X2(I-1))/2. Y(I)=(Y2(I)+Y2(I-1))/2. ALF(I)=ATAN((Y2(I)-Y2(I-1))/(X2(I)-X2(I-1))) 544 CONTINUE ALF(1)=ALF(2) ALF(N)=ALF(NS) X(N)=X2(N) Y(N)=Y2(N) X(1)=X2(1) Y(1)=Y2(1) RETURN END SUBROUTINE SEAR(LNUM,IC,DS,CX,CY,XN,YN,LSL,NLOW,NUPP) REAL R,DS,CY,R2,CX,XN(80),YN(80),R1,D,XXL,SLO INTEGER I,I1,K,LNUM(80),J1,J2,IC(80,3),IN,NLOW,NUPP,LSL I=1 !NLOW=下交点所在直线段的线段号 I1=0 !NUPP=上交点所在直线段的线段号 12K=LNUM(I) J1=IC(K,1) J2=IC(K,2) R=DS-CY!R=圆弧半径 R2=SQRT(ABS(CX-XN(J2))**2+ABS(CY-YN(J2))**2) R1=SQRT(ABS(CX-XN(J1))**2+ABS(CY-YN(J1))**2) !R1,R2 为圆心至该线段两端点的距离 IF(R.EQ.R2.AND.I1.NE.0)GOTO11 IF(R.GT.R1.AND.R.GT.R2)GOTO11 !无交点 IF(R.LT.R1.AND.R.LT.R2)GOTO19 !有两个或零个交点 GOTO20 19 CALL DD(XN(J1),YN(J1),XN(J2),YN(J2),CX,CY,D,IN) XXL=XN(J2)-XN(J1)