Sources Esope | Cast3M

dfsig
C DFSIG     SOURCE    CB215821  16/04/21    21:16:27     8920
C DFSIG     SOURCE    INSL       24/10/96
      SUBROUTINE DFSIG(S1,DFSI,DGSI,SEQ,NSTRS,RB,AA,BB,DK1,DK2,ILO)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION S1(NSTRS),DFSI(NSTRS),DGSI(NSTRS)
      DIMENSION DFS1(6),DGS1(6),C1(6),C2(6),C3P(6),C3(6)
C-------------------------------------------------------------------
C             *******************************************
C             *    CALCUL DU VECTEUR  {dF/d{SIGMA}}     *
C             *     {dF/d{SIGMA}}=A1*C1+A2*C2+A3*C3     *
C             *******************************************
C-------------------------------------------------------------------
      PI=4.D0*ATAN(1.D0)
      CALL ZERO(DFSI,NSTRS,1)
      CALL ZERO(DGSI,NSTRS,1)
      CALL ZERO(DFS1,6,1)
      CALL ZERO(DGSI,6,1)
C
      CALL PARINV(S1,SX,SY,SZ,SXY,SXZ,SYZ,NSTRS)
      CALL INVA(S1,DJ2,DI1,CO3T,DJ3,NSTRS)
C
      SSX=SX-DI1/3.D0
      SSY=SY-DI1/3.D0
      SSZ=SZ-DI1/3.D0
C
C-------------------------------------------------------------------
C             ************************************
C             *    CALCUL DES COEFFICIENTS Ai    *
C             *           A1=dF/dI1              *
C             *           A2=dF/dJ2              *
C             *           A3=dF/COS(3TETA)      *
C             *                                  *
C             *  f(Sij,K)= a*J2/f'cý+ ... -1=0   *
C             ************************************
C
      TT=DK2*CO3T
      IF(CO3T .GE. 0.D0) PP=ACOS(TT)/3.D0
      IF(CO3T .LT. 0.D0) PP=(PI-ACOS(-1.D0*TT))/3.D0
C
      DLA=DK1*COS(PP)
      T1=1.D0/SQRT(1.D0-TT*TT)
      AP2=AA/SEQ/SEQ
      AP3=1.D0/SQRT(DJ2)/SEQ/2.D0
C
      A1=BB/SEQ
      A2=AP2+AP3*(DLA-DK1*SIN(PP)*TT*T1)
      A3=DK1*DK2*SQRT(DJ2)*T1/3.D0/SEQ*SIN(PP)
C
C-------------------------------------------------------------------
C             **********************************
C             *    CALCUL DES VECTEURS {Ci}    *
C             **********************************
C
      CALL ZERO(C1,6,1)
      CALL ZERO(C2,6,1)
      CALL ZERO(C3P,6,1)
      CALL ZERO(C3,6,1)
C
      C1(1)=1.D0
      C1(2)=1.D0
      C1(3)=1.D0
C
      C2(1)=SSX
      C2(2)=SSY
      C2(3)=SSZ
      C2(4)=2.D0*SXY
      C2(5)=2.D0*SXZ
      C2(6)=2.D0*SYZ
C
      SX1=2.D0*SSY*SSZ-SSX*SSZ-SSX*SSY
      SX2=SXZ*SXZ-2.D0*SYZ*SYZ+SXY*SXY
C
      SY1=2.D0*SSX*SSZ-SSY*SSZ-SSY*SSX
      SY2=SYZ*SYZ-2.D0*SXZ*SXZ+SXY*SXY
C
      SZ1=2.D0*SSX*SSY-SSZ*SSY-SSZ*SSX
      SZ2=SXZ*SXZ-2.D0*SXY*SXY+SYZ*SYZ
C
      C3P(1)=(SX1+SX2)/3.D0
      C3P(2)=(SY1+SY2)/3.D0
      C3P(3)=(SZ1+SZ2)/3.D0
      C3P(4)=2.D0*(SYZ*SXZ-SSZ*SXY)
      C3P(5)=2.D0*(SXY*SYZ-SSY*SXZ)
      C3P(6)=2.D0*(SXY*SXZ-SSX*SYZ)
C
      AA1=3.D0*SQRT(3.D0)/2.D0/SQRT(DJ2**3)
      AA2=-3.D0*DJ3/DJ2/2.D0
C-------------------------------------------------------------------
      DO 2 I=1,6
        C3(I)=AA1*(C3P(I)+AA2*C2(I))
        DFS1(I)=A1*C1(I)+A2*C2(I)+A3*C3(I)
    2 CONTINUE
C-------------------------------------------------------------------
      STEST=SEQ/RB
      IF(ILO.EQ.1) THEN
C             **************************************************
C             ***  ILO = 0 PLASTICITE ASSOCIEE (STANDARD)    ***
C             ***           G  =  F                          ***
C             ***  ILO = 1 PLASTICITE NON ASSOCIEE           ***
C             ***           G = A1 * I1 + SQRT(J2) - d        ***
C             **************************************************
C
        AAA1 =.57143D0*(STEST-1.D0)
        A1 =-0.2D0
        IF(AAA1 .GT. A1) A1=AAA1
        IF(STEST.GE.1.D0) A1=0.D0
        A2 =1.D0/SQRT(DJ2)/2.D0
      ENDIF
C
      DO 3 I=1,6
        IF(ILO.EQ.0) DGS1(I)=DFS1(I)
        IF(ILO.EQ.1) DGS1(I)=A1*C1(I)+A2*C2(I)
    3 CONTINUE
C-------------------------------------------------------------------
      IF(NSTRS.EQ.3.OR.NSTRS.EQ.5) THEN
         DO 4 I=3,NSTRS
           DFS1(I)=DFS1(I+1)
           DGS1(I)=DGS1(I+1)
    4    CONTINUE
      ENDIF
C
      DO 5 I=1,NSTRS
         DFSI(I)=DFS1(I)
         DGSI(I)=DGS1(I)
    5 CONTINUE
C-------------------------------------------------------------------
      IECR=0
      IF(IECR.EQ.10) THEN
      WRITE(*,*) '****  ON EST DANS DFSIG ******'
      WRITE(*,200) A1,A2,A3,ILO
  200 FORMAT('A1=',E8.2,1X,'A2=',E8.2,1X,'A3=',E8.2,1X,'ILO=',I2)
      WRITE(*,*) '***  S1 DANS DFSIG ***  SEQ = ',SEQ
      WRITE(*,1991) (S1(IA),IA=1,NSTRS)
      WRITE(*,*) '***  C1 DANS DFSIG ***  '
      WRITE(*,1991) (C1(IA),IA=1,6)
      WRITE(*,*) '***  C2 DANS DFSIG ***  '
      WRITE(*,1991) (C2(IA),IA=1,6)
      WRITE(*,*) '***  C3 DANS DFSIG ***  '
      WRITE(*,1991) (C3(IA),IA=1,6)
      WRITE(*,*) '***  C3P DANS DFSIG ***  '
      WRITE(*,1991) (C3P(IA),IA=1,6)
      WRITE(*,*) '***  DFS1 ***  '
      WRITE(*,1991) (DFS1(IA),IA=1,6)
      WRITE(*,*) '***  DGS1 ***  '
      WRITE(*,1991) (DGS1(IA),IA=1,6)
      WRITE(*,*) '***  DFSI ***  NSTRS=',NSTRS
      WRITE(*,1991) (DFSI(IA),IA=1,NSTRS)
      WRITE(*,*) '***  DGSI ***  NSTRS=',NSTRS
      WRITE(*,1991) (DGSI(IA),IA=1,NSTRS)
      ENDIF
1991  FORMAT(18(1X,E12.5))
C-------------------------------------------------------------------
  100 CONTINUE
      RETURN
      END