Sources Esope | Cast3M

somdru
C SOMDRU    SOURCE    OF166741  25/11/04    21:16:08     12349          
      SUBROUTINE SOMDRU(IBOU,SI,DEPS,EPST,
     .           EPSTAR,SN,XMAT,YUNG,XNU,PENTE,KERRE,ecou,necou)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL *8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
-INC TECOU
 
      DIMENSION XMAT(*)
      DIMENSION ORMAT(1)
 
*  QUELQUES INITIALISATIONS
*
      KERRE = 0
      XMATE =XMAT(1)
      XMATM =XMAT(2)
      XMATKL=XMAT(3)
      XMATC =XMAT(4)
      XMATD =XMAT(5)
      PEPSI =SQRT(2.D0*XMATC*XMATC+XMATD*XMATD)
      XI1LIM=SN/XMATE
 
      JFOUR = necou.IFOURB
      ITYPL = necou.ITYP
*
*     PROJECTION AU SOMMET
*
      IF(IIMPI.EQ.15) WRITE(IOIMP,77387)
77387 FORMAT('0   SOMDRU - ON PROJETTE AU SOMMET ')
      IF(IIMPI.EQ.15) WRITE(IOIMP,77388) XI1LIM,PENTE
77388 FORMAT('0   SOMDRU - XI1LIM= ',1PE12.5,2X,'PENTE= ',1PE12.5/)
 
      CALL ZDANUL(SIGEL,6)
      CALL ZDANUL(EPSPLA,6)
*
*  1-ER CAS  PAS D'ECROUISSAGE
*
      IF(PENTE.NE.0.D0) GO TO 300
*
 400  CONTINUE
      IF(ITYPL.NE.1.AND.ITYPL.NE.5) GO TO 201
      DO 202 IB=1,3
        SIGEL(IB)=XI1LIM/3.D0
 202  CONTINUE
      GO TO 205
 201  CONTINUE
      SIGEL(1)=0.5D0*XI1LIM
      SIGEL(2)=SIGEL(1)
      IF(ITYPL.NE.2) GO TO 204
      SIGEL(1)=0.5D0*SIGEL(1)
      SIGEL(2)=SIGEL(1)
      SIGEL(4)=SIGEL(1)
      SIGEL(5)=SIGEL(1)
      GO TO 205
  204 IF(ITYPL.LT.7) GO TO 205
      SIGEL(5)=0.D0
      SIGEL(2)=0.D0
      SIGEL(4)=SIGEL(1)
      IF(ITYPL.LT.8) GO TO 205
      SIGEL(4)=0.D0
      SIGEL(1)=XI1LIM
 205  CONTINUE
      IF(IIMPI.EQ.15) WRITE(IOIMP,77389) (SIGEL(I),I=1,IBOU)
77389 FORMAT(1X,'SOMDRU - SIGEL  '/(6(1X,1PE12.5)))
*
*     ON CALCULE ALORS DELTA SIGMA PLASTIQUE
*
      DO 209 IB=1,IBOU
        DSIGP(IB)=STOT(IB)-SIGEL(IB)
 209  CONTINUE
*
*     ON CALCULE DELTA EPSILON PLASTIQUE PUIS DELTA EPSILON *
*
      CALL EPSIG(DSIGP,EPSPLA,JFOUR,YUNG,XNU,ITYPL,ORMAT,XMAT)
      DEPS=VONEPS(EPSPLA,ITYPL,ALFAH,COVNMS)
      EPST=EPSTAR+DEPS
      IF(IIMPI.EQ.15) WRITE(IOIMP,77390) EPSTAR,DEPS,EPST
77390 FORMAT(1X,'EPSTAR=',1PE12.5,2X,'DEPS=',1PE12.5,2X,'EPST=',
     .       1PE12.5/)
      CALL CKRIT(IMAPLA,SIGEL,ITYPL,XMAT,ALFAH,COVNMS,XINV,SI)
      RETURN
*
*  2-EME CAS   ECROUISSAGE
*
 300  CONTINUE
*
*  CAS DES CONTRAINTES PLANES
*
      IF(ITYPL.EQ.6) THEN
         IF((PENTE*XMATKL.GE.0.D0).OR.(XMAT(9).EQ.0.D0)) THEN
           KERRE=52
           RETURN
         ENDIF
         DEPS= -XI1LIM/XMAT(9)
         EPST= EPSTAR+DEPS
         IF(IIMPI.EQ.15) WRITE(IOIMP,77389) (SIGEL(I),I=1,IBOU)
         IF(IIMPI.EQ.15) WRITE(IOIMP,77390) EPSTAR,DEPS,EPST
         CALL CKRIT(IMAPLA,SIGEL,ITYPL,XMAT,ALFAH,COVNMS,XINV,SI)
         LAPOIN=1
*
*  CAS DU MASSIF
*
      ELSE IF(ITYPL.EQ.1.OR.ITYPL.EQ.5) THEN
         IF (XMATE.EQ.0.D0) THEN
           KERRE=52
           RETURN
         ENDIF
      FAC1=(1.D0-2.D0*XNU)/(3.D0*XMATE*YUNG)
      FAC2=FAC1*XI1LIM
      FAC1=FAC1*XMAT(9)
      UNSE = 1.D0/YUNG
      UNSE2= UNSE*2.D0*(1.D0+XNU)
      W1(1)= UNSE*(STOT(1)-XNU*(STOT(2)+STOT(3)))-FAC2
      W1(2)= UNSE*(STOT(2)-XNU*(STOT(1)+STOT(3)))-FAC2
      W1(3)= UNSE*(STOT(3)-XNU*(STOT(1)+STOT(2)))-FAC2
      W1(4)= UNSE2*STOT(4)
      W1(5)= UNSE2*STOT(5)
      W1(6)= UNSE2*STOT(6)
      AA = 1.D0-2.D0*FAC1*FAC1
      BB = (2.D0/3.D0)*FAC1*(W1(1)+W1(2)+W1(3))
      CC = (VONEPS(W1,ITYPL,ALFAH,COVNMS))**2
      IF(AA.EQ.0.D0) THEN
        IF  (BB.EQ.0.D0) THEN
          KERRE=53
          RETURN
        ENDIF
        DEPS= CC/(2.D0*BB)
        IF (DEPS.LT.0D0) THEN
          KERRE=53
          RETURN
        ENDIF
      ELSE
        DISCR=BB*BB+AA*CC
        IF(DISCR.LT.0D0) THEN
          KERRE=53
          RETURN
        ENDIF
        DISCR=SQRT(DISCR)
        DEPS1 = (-BB+DISCR)/AA
        DEPS2 = (-BB-DISCR)/AA
        DEPS=MAX(DEPS1,DEPS2)
        IF(DEPS.LT.0D0) THEN
          KERRE=53
          RETURN
        ENDIF
      ENDIF
 
      SNN = XI1LIM+XMAT(9)*DEPS
      IF (SNN .LT. 0.D0) THEN
        SNN=0.D0
        DEPS= -XI1LIM/XMAT(9)
      ENDIF
      DO 302 IB=1,3
        SIGEL(IB)=SNN/3.D0
 302  CONTINUE
      EPST=EPSTAR+DEPS
      IF(IIMPI.EQ.15) THEN
        WRITE(IOIMP,77389) (SIGEL(I),I=1,IBOU)
        WRITE(IOIMP,77390) EPSTAR,DEPS,EPST
      ENDIF
      CALL CKRIT(IMAPLA,SIGEL,ITYPL,XMAT,ALFAH,COVNMS,XINV,SI)
 
* CAS NON PREVUS A CE JOUR
      ELSE
        KERRE=51
        RETURN
      ENDIF
 
      RETURN
      END