弹性链杆法计算内力.docVIP

弹性链杆法计算内力 C C********** C DIMENSION X(31),Y(31),DYCS(30,4),KB(93,94),DRTA(93),FE(93) REAL*8 X,Y,DYCS,KB,DRTA,FE REAL*8 QH,QV,TKH,TKV,RZ,E,HA,FLAG INTEGER NJ,N,M,JDCS(31,4),TXFLAG(31),CSFLAG,NTRY C OPEN(1,FILE=1.DAT,STATUS=OLD) OPEN(2,FILE=1.out,STATUS=UNKNOWN) C CALL INPUT(NJ,X,Y,DYCS,JDCS,RZ,E,TKH,TKV,QH,QV,HA,TXFLAG) C NTRY=0 11 CSFLAG=0 NTRY=NTRY+1 WRITE(*,*) NTRY, STEP C CALL SUBKB(NJ,DYCS,JDCS,TXFLAG,X,Y,QH,QV,TKH,TKV,E,RZ,HA,KB) C N=3*NJ M=N+1 C CALL FCQJ(KB,N,M,DRTA) C WRITE(2,100) NTRY 100 FORMAT(1X,I2,STEP) WRITE(2,200) 200 FORMAT(1X,NO.,5X,X-DISP.,1X,Y-DISP., . 1X,X-SPRING Y-SPRING,1X,R-DISP.) DO 21 I=1,NJ DIST=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),DIST 300 FORMAT(4X,I2,5X,F8.6,2X,F8.6,5X,I2,4X,F8.6) 21 CONTINUE DO 31 I=1,NJ FLAG=X(I)*DRTA(3*I-2) IF (FLAG.LE.0.0.AND.TXFLAG(I).EQ.1) THEN TXFLAG(I)=0 CSFLAG=1 END IF IF (FLAG.GT.0.0.AND.TXFLAG(I).EQ.0) THEN TXFLAG(I)=1 CSFLAG=1 END IF 31 CONTINUE IF (CSFLAG.NE.0) GO TO 11 C CALL SUBFE(NJ,DYCS,E,DRTA,FE) WRITE(2,400) 400 FORMAT(1X,NODAL FORCE) WRITE(2,500) 500 FORMAT(1X,NO.,5X,N,8X,Q,8X,M) DO 41 I=1,NJ WRITE(2,600) I,FE(3*I-2),FE(3*I-1),FE(3*I) 600 FORMAT(1X,3X,I2,4(4X,F9.3)) 41 CONTINUE END C SUBROUTINE INPUT(NJ,X,Y,DYCS,JDCS,RZ,E,TKH,TKV, . QH,QV,HA,TXFLAG) DIMENSION X(31),Y(31),DYCS(30,4),JDHD(31) REAL*8 X,Y,DYCS,JDHD,QH,QV,TKH,TKV,RZ,E,HA INTEGER JDCS(31,4),TXFLAG(31) READ(1,*) NJ,RZ,E,QH,QV,TKH,TKV,HA DO 10 I=1,NJ READ(1,*) X(I),Y(I),(JDCS(I,J),J=1,4),JDHD(I) TXFLAG(I)=JDCS(I,1) 10 CONTINUE DO 20 I=1,NJ-1 DX=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.0 DYCS(I,3)=DY/DYCS(I,1) DYCS(I,4)=DX/DYCS(I,1) 20 CONTINUE END C SUBROUTINE SUBKB(NJ,DYCS,JDCS,TXFLAG,X,Y,QH,QV,TKH,TKV, . E,RZ,HA,KB) DIMENSION KE(6,6),KC(3,3),KB(93,94),KT(31),HZ(31,3) DIMENSION DYCS(30,4),X(31),Y(31) REAL*8 KE,KC,K