有限元分析程序与算例
SUBROUTINE SURFOR(ND,AE,PR,Y0,GAMA,NSI) !C IMPLICIT DOUBLE PRECISION(A-H,O-Z) DIMENSION PR(2),KCRD(4),RST(2),AE(4,*), &
KFACE(2,4),IPRM(2),FVAL(4),NODES(2) COMMON /C1/ NP,NE,NM,NR,NW,NF,NI,NDP COMMON /C2/ N,MX,NH
COMMON /C3/ SKE(8,8),NN(8),RF(8),B(3,8),XY(2,4) COMMON /C4/ NEE,NME,NET,NK,NSF,NST COMMON /C5/ FUN(4),P(2,4),XJR(2,2) COMMON /GAUSS/ RSTG(2) DATA KCRD/1,1,2,2/
DATA KFACE/2,3,1,4,3,4,1,2/ DATA IPRM/2,1/
DATA FVAL/1.0,-1.0,1.0,-1./
T=AE(4,NME) FACT=-FVAL(ND)
DO 20 I=1,2 J=KFACE(I,ND) NODES(I)=J
IF (NSI.EQ.0) GOTO 20 Y=Y0-XY(2,J) PR(I)=0.0
IF (Y.GT.0.0) PR(I)=Y*GAMA 20 CONTINUE
ML=KCRD(ND) MM=IPRM(ML) RST(ML)=FVAL(ND) DO 70 LX=1,2
RST(MM)=RSTG(LX)
CALL FPJD(RST(1),RST(2),DET) PXY=0.0 DO 25 I=1,2 J=NODES(I)
PXY=PXY+FUN(J)*PR(I) 25 CONTINUE
A1=XJR(MM,2)*(-1)**MM A2=-XJR(MM,1)*(-1)**MM
DO 60 I=1,2 J=NODES(I)
- 11 -
有限元分析程序与算例
K2=2*J K1=K2-1
Q=PXY*FUN(J)*FACT*T RF(K1)=RF(K1)+Q*A1 RF(K2)=RF(K2)+Q*A2 60 CONTINUE 70 CONTINUE RETURN END
!C****************************************************************** SUBROUTINE SURNST(ND,AE,PR)
DIMENSION PR(2),KCRD(4),RST(2),AE(4,*),KFACE(2,4), & IPRM(2),FVAL(4),NODES(2) COMMON /C1/ NP,NE,NM,NR,NW,NF,NI,NDP COMMON /C2/ N,MX,NH
COMMON /C3/ SKE(8,8),NN(8),RF(8),B(3,8),XY(2,4) COMMON /C4/ NEE,NME,NET,NK,NSF,NST COMMON /C5/ FUN(4),P(2,4),XJR(2,2) COMMON /GAUSS/ RSTG(2) DATA KCRD/1,1,2,2/
DATA KFACE/2,3,1,4,3,4,1,2/ DATA IPRM/2,1/
DATA FVAL/1.0,-1.0,1.0,-1.0/ T=AE(4,NME) DO 20 I=1,2
20 NODES(I)=J ML=KCRD(ND) MM=IPRM(ML)
RST(ML)=FVAL(LX) DO 70 LX=1,2
RST(MM)=RSTG(LX)
CALL FPJD(RST(1),RST(2),DET) RXY=0.0
DO 25 I=1,2 J=NODES(I)
PXY=PXY+FUN(J)*PR(I) 25 CONTINUE
A2=XJR(MM,2)*(-1)**MM A1=-XJR(MM,1)*(-1)**MM DO 60 I=1,2 J=NODES(I) K2=2*J K1=K2-1
- 12 -
有限元分析程序与算例
Q=PXY*FUN(J)*T RF(K1)=RF(K1)+Q*A1 RF(K2)=RF(K2)+Q*A2 60 CONTINUE 70 CONTINUE RETURN END
!C****************************************************************** SUBROUTINE ASLOAD (R,LP)
!C IMPLICIT DOUBLEPRECISION (A-H,O-Z) DIMENSION R(*)
COMMON /C1/ NP,NE,NM,NR,NW,NF,NI,NDP
COMMON /C3/ SKE(8,8),NN(8),RF(8),B(3,8),XY(2,4) DO 20 I=1,LP L=NN(I)
IF(L.EQ.0) GOTO 20 R(L)=R(L)+RF(I) 20 CONTINUE RETURN END
!C****************************************************************** SUBROUTINE OUTPUT (JR,F,NS)
!C IMPLICIT DOUBLEPRECISION (A-H,O-Z) DIMENSION JR(2,*),F(*),B(2)
COMMON /C1/ NP,NE,NM,NR,NW,NF,NI,NDP If(ns.eq.0)write(16,300) If(ns.eq.1)write(16,400) WRITE (16,500) DO 40 I=1,NP DO 20 J=1,2 20 B(J)=0. DO 30 J=1,2 L=JR(J,I)
IF(L.EQ.0) GOTO 30 B(J)=F(L)
30 CONTINUE WRITE (16,550) I,B
IF(NS.EQ.1) WRITE(10,650) I,B 40 CONTINUE
300 FORMAT (/28X,'LOAD OF NODES'/)
400 FORMAT (/25X,'DISPLACEMENT OF NODES'/)
500 FORMAT (10X,'NODE NO.',8X,'X-DIRECTION',8X,'Y-DIRECTION'/) 550 FORMAT (13X,I5,2(8X,E12.4)) 650 FORMAT (3X,I4,2E12.4)
- 13 -
有限元分析程序与算例
RETURN END
!C****************************************************************** SUBROUTINE ASESK(SK,MA)
!C IMPLICIT DOUBLEPRECISION (A-H,O-Z) DIMENSION SK(*),MA(*)
COMMON /C1/ NP,NE,NM,NR,NW,NF,NI,NDP COMMON /C2/N,MX,NH
COMMON /C3/SKE(8,8),NN(8),RF(8),B(3,8),XY(2,4) DO 10 I=1,NH SK(I)=0.0
10 CONTINUE REWIND 12
DO 95 IE=1,NE READ (12) NN,SKE DO 50 JJ=1,8 I2=NN(JJ)
IF (I2.GT.0.AND.I2.LE.N) GOTO 60 50 CONTINUE GOTO 95 60 DO 70 L=1,8 DO 70 M=1,8 JJ=NN(L) JK=NN(M)
IF(JJ.GE.JK.AND.JK.GT.0.AND.JJ.GT.0.AND.JJ.LE.N) GOTO 65 GOTO 70
65 J3=MA(JJ)-JJ+JK SK(J3)=SK(J3)+SKE(L,M) 70 CONTINUE 95 CONTINUE RETURN END
!C****************************************************************** SUBROUTINE TREAT(SK,MA,R,JR,NDI,DV)
!C IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION SK(*),MA(*),R(*),JR(2,*),NDI(*),DV(2,*) COMMON /C1/ NP,NE,NM,NR,NW,NF,NI,NDP WRITE(16,500) DO 5 I=1,NDP
READ(15,*)NDI(I),(DV(J,I),J=1,2) WRITE(16,600)NDI(I),(DV(J,I),J=1,2) 5 CONTINUE
DO 30 I=1,NDP
- 14 -
有限元分析程序与算例
JJ=NDI(I) DO 20 J=1,2 L=JR(J,JJ) JN=MA(L)
IF(DV(J,I).EQ.0)GOTO 20 SK(JN)=1.E30
R(L)=DV(J,I)*1.E30 20 CONTINUE 30 CONTINUE
500 FORMAT(/1X,'KNOWN DISPLACEMENT NODES AND (X,Y) VALUES') 600 FORMAT(10X,I8,10X,F10.6,10X,F10.6) RETURN END
!C****************************************************************** SUBROUTINE DECOMP(SK,MA)
!C IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION SK(*),MA(*)
COMMON /C1/ NP,NE,NM,NR,NW,NF,NI,NDP COMMON /C2/N,MX,NH
COMMON /C3/SKE(8,8),NN(8),RF(8),B(3,8),XY(2,4) DO 65 I=2,N
L=I-MA(I)+MA(I-1)+1 K=I-1 L1=L+1
IF (L1.GT.K) GOTO 55 DO 50 J1=L1,K IJ=MA(I)-I+J1
M=MA(J1-1)-MA(J1)+J1+1 IF(L.GT.M) M=L MP=J1-1
IF(M.GT.MP) GOTO 50 DO 40 LP=M,MP IP=MA(I)-I+LP JP=MA(J1)-J1+LP
SK(IJ)=SK(IJ)-SK(IP)*SK(JP) 40 CONTINUE 50 CONTINUE
55 IF(L.GT.K) GOTO 65 DO 60 LP=L,K IP=MA(I)-I+LP LPP=MA(LP)
SK(IP)=SK(IP)/SK(LPP)
- 15 -