内容发布更新时间 : 2024/6/4 0:12:50星期一 下面是文章的全部内容请认真阅读。

C ************************************************

C * FINITE ELEMENT PROGRAM * C * FOR Two DIMENSIONAL ELASticity PROBLEM * C * WITH 4 NODE * C ************************************************ PROGRAM ELASTICITY character*32 dat,cch

DIMENSION SK(80000),COOR(2,300),AE(4,11),MEL(5,200), & WG(4),JR(2,300),MA(600),R(600),iew(30),STRE(3,200) COMMON /CMN1/ NP,NE,NM,NR COMMON /CMN2/ N,MX,NH

COMMON /CMN3/ RF(8),SKE(8,8),NN(8)

WRITE(*,*)'PLEASE ENTER INPUT FILE NAME' READ(*,'(A)')DAT

OPEN(4,FILE=dat,STATUS='OLD')

OPEN(7,FILE='OUT',STATUS='UNKNOWN') READ(4,*)NP,NE,NM,NR

WRITE(7,'(A,I6)')'NUMBER OF NODE---------------------NP=',np WRITE(7,'(A,I6)')'NUMBER OF ELEMENT------------------NE=',ne WRITE(7,'(A,I6)')'NUMBER OF MATERIAL-----------------NM=',nm WRITE(7,'(A,I6)')'NUMBER OF surporting---------------NC=',Nr CALL INPUT (JR,COOR,AE,MEL) CALL CBAND (MA,JR,MEL) DO I=1,NH SK(I)=0.0 enddo

CALL SK0(SK,MEL,COOR,JR,MA,AE) do I=1,N R(I)=0.0 enddo pause 'aaa' stop

READ(4,*)NCP,NBE,iz

WRITE(*,'(5i8)')NCP,NBE,iz WRITE(7,'(5i8)')NCP,NBE,iz

IF(NCP.GT.0)CALL CONCR(NCP,R,JR)

IF(NBE.GT.0) CALL BODYR(NBE,R,MEL,COOR,JR,AE) IF(iz.GT.0)then do jj=1,iz

READ (4,*)Js,nse,(WG(I),I=1,4) read(4,*)(iew(m),m=1,nse)

CALL FACER(iew,NSE,R,MEL,COOR,JR,WG) enddo endif

CALL DECOP (SK,MA) CALL FOBA (SK,MA,R) CALL OUTDISP(NP,R,JR)

CALL STRESS (COOR,MEL,JR,AE,R,STRE)

WRITE(7,'(A)')' PROGRAM SAFF HAS BEEN ENDED' WRITE(*,'(A)')' PROGRAM SAFF HAS BEEN ENDED' STOP c RETURN END

C ********************************************* SUBROUTINE INPUT (JR,COOR,AE,MEL)

DIMENSION JR(2,*),COOR(2,*),AE(4,*),MEL(5,*) COMMON /CMN1/ NP,NE,NM,NR COMMON /CMN2/ N,MX,NH DO 70 I=1,NP READ(4,*) IP,X,Y COOR(1,IP)=X COOR(2,IP)=Y 70 CONTINUE DO 11 J=1,NE

READ(4,*)NEE,NME,(MEL(I,NEE),I=1,4) MEL(5,NEE)=NME 11 CONTINUE DO 10 I=1,NP DO 10 J=1,2 10 JR(J,I)=1

DO 20 I=1,NR

READ(4,*) IP,IX,IY JR(1,IP)=IX JR(2,IP)=IY 20 CONTINUE N=0

DO 30 I=1,NP DO 30 J=1,2

IF (JR(J,I)) 30,30,25 25 N=N+1 JR(J,I)=N 30 CONTINUE DO 55 J=1,NM

READ (4,*)JJ,(AE(I,JJ),I=1,4) WRITE(*,910) JJ,(AE(I,JJ),I=1,4) 55 CONTINUE

910 FORMAT (/20X,'MATERIAL PROPERTIES'/(3X,I5,4(1x,E8.3))) RETURN

END

C ********************************************** SUBROUTINE CBAND (MA,JR,MEL)

DIMENSION MA(*),JR(2,*),MEL(5,*),NN(8) COMMON /CMN1/ NP,NE,NM,NR COMMON /CMN2/ N,MX,NH DO 65 I=1,N 65 MA(I)=0

DO 90 IE=1,NE DO 75 K=1,4 IEK=MEL(K,IE) DO 95 M=1,2 JJ=2*(K-1)+M NN(JJ)=JR(M,IEK) 95 CONTINUE 75 CONTINUE L=N

DO 80 I=1,2*4 NNI=NN(I)

IF(NNI.EQ.0) GO TO 80 IF(NNI.LT.L) L=NNI 80 CONTINUE DO 85 M=1,2*4 JP=NN(M)

IF(JP.EQ.0) GO TO 85 JPL=JP-L+1

IF(JPL.GT.MA(JP)) MA(JP)=JPL 85 CONTINUE 90 CONTINUE MX=0 MA(1)=1 DO 10 I=2,N

IF(MA(I).GT.MX) MX=MA(I) MA(I)=MA(I)+MA(I-1) 10 CONTINUE NH=MA(N)

WRITE(7,'(A,I8)')'TOTAL DEGREES OF FREEDOM-----------N= ',N WRITE(7,'(A,I8)')'MAX-SEMI-BANDWIDTH-----------------MX=',MX WRITE(7,'(A,I8)')'TOTAL-STORAGE----------------------NH=',NH 500 FORMAT (/5X,'FREEDOM N='

*,I5,3X,'SEMI-BANDWI. MX=',I5,3X, * 'STORAGE NH=',I7) RETURN END