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