《弹性链杆法半衬砌程序.doc》由会员分享，可在线阅读，更多相关《弹性链杆法半衬砌程序.doc（16页珍藏版）》请在金锄头文库上搜索。
1、DIMENSION X(31),Y(31),DYCS(30,4),KB(93,94),DRTA(93)REAL KBINTEGER JDCS(31,4),TXFLAG(31),CSFLAGOPEN(1,FILE=INPUT.DAT,STATUS=OLD)OPEN(2,FILE=OUTPUT.DAT,STATUS=UNKNOWN)CALL INPUT(NJ,X,Y,DYCS,JDCS,RZ,E,TKH,TKV,QH,QV,HA,TXFLAG)NTRY=011CSFLAG=0NTRY=NTRY+1CALL SUBKB(NJ,DYCS,JDCS,TXFLAG,X,Y,QH,QV,TKH,TKV,E,
2、RZ,HA,KB) N=3*NJM=N+1CALL FCQJ(KB,N,M,DRTA)WRITE(2,100) NTRYWRITE(*,100) NTRY100FORMAT(1X,I3,STEP)WRITE(2,200)200FORMAT(1X,NO,5X,X-DISP,5X,Y-DISP,1X,X-SPRING, * 1X,R-DISP)DO 21 I=1,NJDISP=SQRT(DRTA(3*I-2)*2+DRTA(3*I-1)*2)WRITE(2,300) I,DRTA(3*I-2),DRTA(3*I-1),TXFLAG(I),DISP21CONTINUE300FORMAT(1X,I2,
3、2E11.3,I5,E11.3)DO 31 I=1,NJFLAG=DRTA(3*I-2)IF(FLAG.LE.0.0.AND.TXFLAG(I).EQ.0) THENTXFLAG(I)=1CSFLAG=1END IFIF(FLAG.GT.0.0.AND.TXFLAG(I).EQ.1) THENTXFLAG(I)=0CSFLAG=1END IF31 CONTINUEIF(CSFLAG.NE.0) GO TO 11CALL SUBFE(NJ,DYCS,E,DRTA)ENDSUBROUTINE INPUT(NJ,X,Y,DYCS,JDCS,RZ,E,TKH,TKV,QH,QV,HA,TXFLAG)D
4、IMENSION X(31),Y(31),DYCS(30,4),JDHD(31)INTEGER JDCS(31,4),TXFLAG(31)REAL JDHDREAD(1,*) NJ,RZ,E,QH,QV,TKH,TKV,HADO 10 I=1,NJREAD(1,*) X(I),Y(I),(JDCS(I,J),J=1,4),JDHD(I)TXFLAG(I)=JDCS(I,1)10CONTINUEDO 20 I=1,NJ-1DX=X(I+1)-X(I)DY=Y(I+1)-Y(I)DYCS(I,1)=SQRT(DX*DX+DY*DY)DYCS(I,2)=(JDHD(I+1)+JDHD(I)/2.0D
5、YCS(I,3)=DY/DYCS(I,1)DYCS(I,4)=DX/DYCS(I,1)20CONTINUEENDSUBROUTINE SUBKT(NJ,Y,TKH,KT)REAL Y(31),KT(31)DO 10 I=1,NJKT(I)=010CONTINUEDO 20 I=2,NJ-1KT(I)=TKH*ABS(Y(I+1)-Y(I-1)/220CONTINUE KT(1)=TKH*ABS(Y(2)-Y(1)/2KT(NJ)=TKH*ABS(Y(NJ)-Y(NJ-1)/2ENDSUBROUTINE SUBKC(HA,TKV,KC)REAL KC(3,3)DO 10 I=1,3DO 10 J
6、=1,3KC(I,J)=0.010CONTINUE KC(1,1)=0KC(2,2)=TKV*HAKC(3,3)=(TKV*HA*3)/12.0ENDSUBROUTINE JDHZ(NJ,X,Y,RZ,QH,QV,DYCS,HZ)DIMENSION HZ(31,3),X(31),Y(31),DYCS(30,4)DO 10 I=1,NJDO 10 J=1,3HZ(I,J)=010CONTINUEDO 20 I=1,NJ-1PH=(Y(I+1)-Y(I)*QH/2HZ(I,1)=HZ(I,1)+PHHZ(I+1,1)=HZ(I+1,1)+PH20CONTINUEDO 30 I=1,NJ-1IF(X
7、(I).LT.X(I+1) THENPV=-(X(I+1)-X(I)*QV/2HZ(I,2)=HZ(I,2)+PVHZ(I+1,2)=HZ(I+1,2)+PVEND IF30CONTINUEDO 40 I=1,NJ-1G=-DYCS(I,1)*DYCS(I,2)*RZ/2HZ(I,2)=HZ(I,2)+GHZ(I+1,2)=HZ(I+1,2)+G40CONTINUEENDSUBROUTINE TT(SI,CO,T)REAL T(6,6)DO 10 I=1,6DO 10 J=1,6T(I,J)=010CONTINUET(1,1)=COT(1,2)=SIT(2,1)=-T(1,2)T(2,2)=T
8、(1,1)T(3,3)=1.0DO 20 I=1,3DO 20 J=1,320T(I+3,J+3)=T(I,J)RETURNEND SUBROUTINE KSE(E,BL,D,KE)REAL KE(6,6)DO 10 I=1,6DO 10 J=1,6KE(I,J)=010CONTINUEKE(1,1)=E*D/BLKE(1,4)=-KE(1,1)KE(2,2)=E*D*3/BL*3KE(2,5)=-KE(2,2)KE(2,3)=E*D*3/2/BL*2KE(2,6)=KE(2,3)KE(3,3)=E*D*3/3/BLKE(3,5)=-KE(2,6)KE(3,6)=KE(3,3)/2KE(4,4
9、)=KE(1,1)KE(5,5)=KE(2,2)KE(5,6)=KE(3,5)KE(6,6)=KE(3,3)DO 20 I=2,6DO 20 J=1,I-1KE(I,J)=KE(J,I)20CONTINUEENDSUBROUTINEESM(E,BL,D,SI,CO,KE)REAL KE(6,6),T(6,6),A(6,6),C(6,6)CALL TT(SI,CO,T)CALL KSE(E,BL,D,KE)DO 10 I=1,6DO 10 J=1,6A(I,J)=T(J,I)10CONTINUEDO 20 I=1,6DO 20 J=1,6C(I,J)=0DO 20 K=1,6C(I,J)=C(I
10、,J)+A(I,K)*KE(K,J)20CONTINUE DO 30 I=1,6DO 30 J=1,6KE(I,J)=0DO 30 K=1,6KE(I,J)=KE(I,J)+C(I,K)*T(K,J)30CONTINUE END SUBROUTINE SUBKB(NJ,DYCS,JDCS,TXFLAG,X,Y,QH,QV,TKH,TKV,E,RZ,HA,KB)REAL KE(6,6),KC(3,3),KB(93,94),KT(31),HZ(31,3),DYCS(30,4), * X(31),Y(34)INTEGER JDCS(31,4),TXFLAG(31)DO 10 I=1,3*NJDO 1
11、0 J=1,3*NJ+1KB(I,J)=010CONTINUE DO 20 K=1,NJ-1BL=DYCS(K,1)HD=DYCS(K,2)SI=DYCS(K,3)CO=DYCS(K,4)CALL ESM(E,BL,HD,SI,CO,KE)DO 20 I=1,6DO 20 J=1,6KB(3*(K-1)+I,3*(K-1)+J)=KB(3*(K-1)+I,3*(K-1)+J)+KE(I,J)20CONTINUECALL SUBKT(NJ,Y,TKH,KT)DO 30 I=1,NJIF(TXFLAG(I).NE.0) THENKB(3*I-2,3*I-2)=KB(3*I-2,3*I-2)+KT(
12、I)END IF30CONTINUECALL SUBKC(HA,TKV,KC)DO 40 I=1,3KB(I,I)=KB(I,I)+KC(I,I)40 CONTINUECALL JDHZ(NJ,X,Y,RZ,QH,QV,DYCS,HZ) DO 50 I=1,NJDO 50 J=1,3KB(3*(I-1)+J,3*NJ+1)=KB(3*(I-1)+J,3*NJ+1)+HZ(I,J)50CONTINUEDO 60 I=1,NJDO 60 K=2,4IF(JDCS(I,K).EQ.0) THEN DO 70 J=1,3*NJ+170KB(3*(I-1)+K-1,J)=0DO 80 L=1,3*NJ8
13、0KB(L,3*(I-1)+K-1)=0 KB(3*(I-1)+K-1,3*(I-1)+K-1)=1.0END IF60 CONTINUEENDSUBROUTINE FCQJ(A,N,N1,X)DIMENSION A(93,94),X(93)CSOLVE THE EQUATIONDO 50 K=1,ND=0.0DO 20 I=K,NIF (D-ABS(A(I,K) 10,20,2010D=ABS(A(I,K)L=I 20CONTINUEIF (L.EQ.K) GO TO 30DO 25 J=K,N1T=A(L,J)A(L,J)=A(K,J)25A(K,J)=T30T=1.0/A(K,K)K1=K+1DO 40 J=K1,N1A(K,J)=A(K,J)*TDO 40 I=K1,N40A(I,J)=A(I,J)-A(I,K)*A(K,J)50CONTINUEDO 60 IK=2,NI=N1-IKI1=I+1DO 60 J=I1,N60A(I,N1)=A(I,N1)-A(I,J)*A(J,N1)DO 70 I=1,N70X(I)=A(I,N1)END SUBROUTINE SUBFE(NJ,DYCS,E,D)DIMENSION DYCS(30,4),D(93),T(6,6),DD(6),KE(6,6),FF(6)
