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