198 lines
5.3 KiB
Fortran
198 lines
5.3 KiB
Fortran
SUBROUTINE UEL(RHS,AMATRX,SVARS,ENERGY,NDOFEL,NRHS,NSVARS,PROPS,
|
|
1 NPROPS,COORDS,MCRD,NNODE,U,DU,V,A,JTYPE,TIME,DTIME,KSTEP,KINC,
|
|
2 JELEM,PARAMS,NDLOAD,JDLTYP,ADLMAG,PREDEF,NPREDF,LFLAGS,
|
|
3 MLVARX,DDLMAG,MDLOAD,PNEWDT,JPROPS,NJPROP,PERIOD)
|
|
C
|
|
INCLUDE 'aba_param.inc'
|
|
C
|
|
DIMENSION RHS(MLVARX,*),AMATRX(NDOFEL,NDOFEL),SVARS(NSVARS),
|
|
1 ENERGY(8),PROPS(*),COORDS(MCRD,NNODE),
|
|
2 U(NDOFEL),DU(MLVARX,*),V(NDOFEL),A(NDOFEL),TIME(2),
|
|
3 PARAMS(3),JDLTYP(MDLOAD,*),ADLMAG(MDLOAD,*),
|
|
4 DDLMAG(MDLOAD,*),PREDEF(2,NPREDF,NNODE),LFLAGS(*),JPROPS(*)
|
|
C
|
|
DIMENSION GPX(9),GPY(9),GWEI(9),PHI(8),PHIX(8),PHIY(8),PHIC(8),
|
|
1 PHIE(8),IFACE(9),GWE(3),AR(3)
|
|
C
|
|
PARAMETER(ZERO=0.D0,TWOHUN=200.D0,FIVHUN=500.D0,CONDUC=204.D0)
|
|
DATA IFACE/1,5,2,6,3,7,4,8,1/
|
|
C
|
|
C
|
|
C MATERIAL PROPERTY DEFINITION
|
|
C
|
|
THICK = PROPS(1)
|
|
RHO = PROPS(2)
|
|
SPEC = PROPS(3)
|
|
C
|
|
C INITIALIZATION (NRHS=1)
|
|
C
|
|
DO 6 K1=1,NDOFEL
|
|
RHS(K1,NRHS)=ZERO
|
|
DO 4 K2=1,NDOFEL
|
|
AMATRX(K2,K1)=ZERO
|
|
4 CONTINUE
|
|
6 CONTINUE
|
|
C
|
|
IF (LFLAGS(3).EQ.4) RETURN
|
|
C
|
|
C TRANSIENT ANALYSIS
|
|
C
|
|
IF (LFLAGS(1).EQ.33) THEN
|
|
C
|
|
C DETERMINE GAUSS POINT LOCATIONS
|
|
C
|
|
SUBROUTINE GSPT(GPX,GPY)
|
|
INCLUDE 'aba_param.inc'
|
|
DIMENSION AR(3),GPX(9),GPY(9)
|
|
C
|
|
PARAMETER(ZERO=0.D0,ONENEG=-1.D0,ONE=1.D0,SIX=6.D0,TEN=10.D0)
|
|
C
|
|
C GPX: X COORDINATE OF GAUSS PT
|
|
C GPY: Y COORDINATE OF GAUSS PT
|
|
C
|
|
R=SQRT(SIX/TEN)
|
|
AR(1)=-1.
|
|
AR(2)=0.
|
|
AR(3)=1.
|
|
DO 10 I=1,3
|
|
DO 10 J=1,3
|
|
NUMGP=(I-1)*3+J
|
|
GPX(NUMGP)=AR(I)*R
|
|
GPY(NUMGP)=AR(J)*R
|
|
10 CONTINUE
|
|
RETURN
|
|
END
|
|
CALL GSPT(GPX,GPY)
|
|
C
|
|
C DETERMINE GAUSS WEIGHTS
|
|
C
|
|
CALL GSWT(GWEI,GWE)
|
|
C
|
|
C ASSEMBLE AMATRX AND RHS
|
|
C
|
|
DO 300 K=1,9
|
|
C LOOP THROUGH GAUSS PTS
|
|
C=GPX(K)
|
|
E=GPY(K)
|
|
CALL DER(C,E,GPX,GPY,GWEI,PHI,PHIX,PHIY,PHIC,PHIE
|
|
1 ,DXDC,DXDE,DYDC,DYDE,AJACOB,COORDS,MCRD,NNODE)
|
|
DTDX=ZERO
|
|
DTDY=ZERO
|
|
T =ZERO
|
|
TOLD=ZERO
|
|
DO I=1,8
|
|
DTDX=U(I)*PHIX(I)+DTDX
|
|
DTDY=U(I)*PHIY(I)+DTDY
|
|
T =U(I)*PHI(I)+T
|
|
TOLD=(U(I)-DU(I,NRHS))*PHI(I)+TOLD
|
|
END DO
|
|
C CHECK ON TEMPERATURE DEPENDENCE OF THERMAL CONDUCTIVITY
|
|
COND=CONDUC
|
|
DCDT=ZERO
|
|
DTDT=(T-TOLD)/DTIME
|
|
WE=GWEI(K)*AJACOB
|
|
DO KI=1,8
|
|
C LOOP OVER NODES
|
|
RHS(KI,NRHS) = RHS(KI,NRHS) -
|
|
1 WE*(PHI(KI)*RHO*SPEC*DTDT +
|
|
2 COND*(PHIX(KI)*DTDX + PHIY(KI)*DTDY))
|
|
|
|
DO KJ=1,8
|
|
AMATRX(KI,KJ)= AMATRX(KI,KJ) + WE*(PHI(KI)*PHI(KJ)*RHO*
|
|
1 SPEC/DTIME + COND*(PHIX(KI)*PHIX(KJ) + PHIY(KI)*
|
|
2 PHIY(KJ)) + DCDT*PHI(KJ)*(PHIX(KI)*DTDX +
|
|
3 PHIY(KI)*DTDY))
|
|
|
|
END DO
|
|
END DO
|
|
300 CONTINUE
|
|
C
|
|
RETURN
|
|
END
|
|
C
|
|
|
|
C
|
|
SUBROUTINE GSWT(GWEI,GWE)
|
|
INCLUDE 'aba_param.inc'
|
|
DIMENSION GWEI(9),GWE(3)
|
|
C
|
|
PARAMETER(FIVE=5.D0,EIGHT=8.D0,NINE=9.D0)
|
|
C
|
|
C GWEI : GAUSS WEIGHT
|
|
C
|
|
GWE(1)=FIVE/NINE
|
|
GWE(2)=EIGHT/NINE
|
|
GWE(3)=FIVE/NINE
|
|
DO 10 I=1,3
|
|
DO 10 J=1,3
|
|
NUMGP=(I-1)*3+J
|
|
GWEI(NUMGP)=GWE(I)*GWE(J)
|
|
10 CONTINUE
|
|
RETURN
|
|
END
|
|
C
|
|
SUBROUTINE DER(C,E,GPX,GPY,GWEI,PHI,PHIX,PHIY,PHIC,PHIE,
|
|
1 DXDC,DXDE,DYDC,DYDE,AJACOB,COORDS,MCRD,NNODE)
|
|
INCLUDE 'aba_param.inc'
|
|
DIMENSION PHI(8),PHIX(8),PHIY(8),PHIC(8),PHIE(8),
|
|
1 COORDS(MCRD,NNODE)
|
|
C
|
|
PARAMETER(ZERO=0.D0,FOURTH=0.25D0,HALF=0.5D0,ONE=1.D0,TWO=2.D0)
|
|
C
|
|
C INTERPOLATION FUNCTIONS
|
|
C
|
|
PHI(1) = FOURTH*(ONE-C)*(ONE-E)*(-C-E-ONE)
|
|
PHI(2) = FOURTH*(ONE+C)*(ONE-E)*(C-E-ONE)
|
|
PHI(3) = FOURTH*(ONE+C)*(ONE+E)*(C+E-ONE)
|
|
PHI(4) = FOURTH*(ONE-C)*(ONE+E)*(-C+E-ONE)
|
|
PHI(5) = HALF*(ONE-C*C)*(ONE-E)
|
|
PHI(6) = HALF*(ONE+C)*(ONE-E*E)
|
|
PHI(7) = HALF*(ONE-C*C)*(ONE+E)
|
|
PHI(8) = HALF*(ONE-C)*(ONE-E*E)
|
|
C
|
|
C DERIVATIVES WRT TO C
|
|
C
|
|
PHIC(1) = FOURTH*(ONE-E)*(TWO*C+E)
|
|
PHIC(2) = FOURTH*(ONE-E)*(TWO*C-E)
|
|
PHIC(3) = FOURTH*(ONE+E)*(TWO*C+E)
|
|
PHIC(4) = FOURTH*(ONE+E)*(TWO*C-E)
|
|
PHIC(5) = -C*(ONE-E)
|
|
PHIC(6) = HALF*(ONE-E*E)
|
|
PHIC(7) = -C*(ONE+E)
|
|
PHIC(8) = -HALF*(ONE-E*E)
|
|
C
|
|
C DERIVATIVES WRT TO E
|
|
C
|
|
PHIE(1) = FOURTH*(ONE-C)*(TWO*E+C)
|
|
PHIE(2) = FOURTH*(ONE+C)*(TWO*E-C)
|
|
PHIE(3) = FOURTH*(ONE+C)*(TWO*E+C)
|
|
PHIE(4) = FOURTH*(ONE-C)*(TWO*E-C)
|
|
PHIE(5) = -HALF*(ONE-C*C)
|
|
PHIE(6) = -E*(ONE+C)
|
|
PHIE(7) = HALF*(ONE-C*C)
|
|
PHIE(8) = -E*(ONE-C)
|
|
|
|
DXDC=ZERO
|
|
DXDE=ZERO
|
|
DYDC=ZERO
|
|
DYDE=ZERO
|
|
|
|
DO 3 I=1,8
|
|
DXDC=DXDC+COORDS(1,I)*PHIC(I)
|
|
DXDE=DXDE+COORDS(1,I)*PHIE(I)
|
|
DYDC=DYDC+COORDS(2,I)*PHIC(I)
|
|
DYDE=DYDE+COORDS(2,I)*PHIE(I)
|
|
3 CONTINUE
|
|
C
|
|
C CALCULATION OF JACOBIAN
|
|
C
|
|
AJACOB=(DXDC*DYDE-DXDE*DYDC)
|
|
C
|
|
C DERIVATIVES WRT TO X AND Y
|
|
C
|
|
DO 5 I=1,8
|
|
PHIX(I)=(PHIC(I)*DYDE-PHIE(I)*DYDC)/AJACOB
|
|
PHIY(I)=(PHIE(I)*DXDC-PHIC(I)*DXDE)/AJACOB
|
|
5 CONTINUE
|
|
RETURN
|
|
END
|