黄永刚单晶塑性有限元umat子程序 下载本文

CFIXB

TERM5=2.*EXP(-TERM4)/(1.+EXP(-2.*TERM4)) G=FAB/GAMMA0*TERM5**2

END IF

DHSELF=F*G

END IF

RETURN END

C-----------------------------------

C----- Use single precision on cray CFIXA

REAL*8 FUNCTION DHLATN(GAMMA,GMSLTL,GAMTOL,NSLPTL,NSET, 2 NSLIP,PROP,CHECK,ISELF,ISET,LATENT, 3 KDERIV) CFIXB

C----- User-supplied function of the derivative of latent-hardening C moduli

C----- Use single precision on cray C

IMPLICIT REAL*8 (A-H,O-Z) CFIXA

DIMENSION GAMMA(NSLPTL), GMSLTL(NSLPTL), NSLIP(NSET), 2 PROP(16) CFIXB

ILOWER=0

IUPPER=NSLIP(1) IF (ISET.GT.1) THEN DO K=2,ISET

ILOWER=ILOWER+NSLIP(K-1) IUPPER=IUPPER+NSLIP(K) END DO END IF

IF (LATENT.GT.ILOWER.AND.LATENT.LE.IUPPER) THEN Q=PROP(9) ELSE

Q=PROP(10) END IF

IF (CHECK.EQ.0.) THEN

C----- HYPER SECANT hardening law by Asaro, Pierce et al

TERM1=PROP(1)*GAMTOL/(PROP(2)-PROP(3)) TERM2=2.*EXP(-TERM1)/(1.+EXP(-2.*TERM1))

TERM3=PROP(1)/(PROP(2)-PROP(3))*DSIGN(1.D0,GAMMA(KDERIV)) DHLATN=-2.*PROP(1)*TERM2**2*TANH(TERM1)*TERM3*Q

ELSE

C----- Bassani's hardening law CFIXA

TERM1=(PROP(1)-PROP(4))*GMSLTL(ISELF)/(PROP(2)-PROP(3)) CFIXB

TERM2=2.*EXP(-TERM1)/(1.+EXP(-2.*TERM1)) TERM3=(PROP(1)-PROP(4))/(PROP(2)-PROP(3))

IF (KDERIV.EQ.ISELF) THEN

F=-2.*(PROP(1)-PROP(4))*TERM2**2*TANH(TERM1)*TERM3 ID=0 G=1.

DO I=1,NSET

IF (I.EQ.ISET) THEN GAMMA0=PROP(5) FAB=PROP(7) ELSE

GAMMA0=PROP(6) FAB=PROP(8) END IF

DO J=1,NSLIP(I) ID=ID+1 CFIXA

IF (ID.NE.ISELF) G=G+FAB*TANH(GMSLTL(ID)/GAMMA0) CFIXB

END DO END DO

ELSE

F=(PROP(1)-PROP(4))*TERM2**2+PROP(4) ILOWER=0

IUPPER=NSLIP(1) IF (ISET.GT.1) THEN DO K=2,ISET

ILOWER=ILOWER+NSLIP(K-1) IUPPER=IUPPER+NSLIP(K) END DO END IF

IF (KDERIV.GT.ILOWER.AND.KDERIV.LE.IUPPER) THEN GAMMA0=PROP(5) FAB=PROP(7) ELSE

GAMMA0=PROP(6) FAB=PROP(8) END IF CFIXA

TERM4=GMSLTL(KDERIV)/GAMMA0 CFIXB

TERM5=2.*EXP(-TERM4)/(1.+EXP(-2.*TERM4)) G=FAB/GAMMA0*TERM5**2

END IF

DHLATN=F*G*Q

END IF

RETURN END

C----------------------------------------------------------------------

SUBROUTINE LUDCMP (A, N, NP, INDX, D)

C----- LU decomposition

C----- Use single precision on cray C

IMPLICIT REAL*8 (A-H,O-Z)

PARAMETER (NMAX=200, TINY=1.0E-20) DIMENSION A(NP,NP), INDX(N), VV(NMAX)

D=1.

DO I=1,N

AAMAX=0.

DO J=1,N

IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J)) END DO

IF (AAMAX.EQ.0.) PAUSE 'Singular matrix.' VV(I)=1./AAMAX END DO

DO J=1,N DO I=1,J-1

SUM=A(I,J)

DO K=1,I-1

SUM=SUM-A(I,K)*A(K,J) END DO

A(I,J)=SUM END DO AAMAX=0.

DO I=J,N

SUM=A(I,J)

DO K=1,J-1

SUM=SUM-A(I,K)*A(K,J) END DO

A(I,J)=SUM

DUM=VV(I)*ABS(SUM)

IF (DUM.GE.AAMAX) THEN IMAX=I

AAMAX=DUM END IF END DO

IF (J.NE.IMAX) THEN DO K=1,N