Sources Esope | Cast3M

somdru
C SOMDRU    SOURCE    PV        22/04/22    21:15:13     11344          
      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)
      DIMENSION XMAT(*)
      DIMENSION ORMAT(1)
 
-INC PPARAM
-INC CCOPTIO
*
      SEGMENT ECOU
***     COMMON/ECOU/TEST,ALFAH,
       REAL*8 TEST, ALFAH,
     1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
     2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
     1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
     2 SIPLAD(6),DSIGP0(6),TET,TETI
      ENDSEGMENT
C      COMMON/ECOU/TEST,ALFAH,
C     . HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
C     . CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
C     . DALPHA(6),EPSPLA(6),E(12),XINV(3),
C     . SIPLAD(6),DSIGP0(6),TET,TETI
*
      SEGMENT NECOU
*      COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
       INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
     . ITYP,JFOUR,IFLUAG,
     . ICINE,ITHER,IFLUPL,ICYCL,IBI,
     . JFLUAG,LEGAUS,LFLUAG,
     . IRELAX,JNTRIN,MFLUAG,JELEM,JGRDEF
      ENDSEGMENT
C      COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
C     . ITYP,JFOUR,IFLUAG,
C     . ICINE,ITHER,IFLUPL,ICYCL,IBI,
C     . JFLUAG,LEGAUS,LFLUAG,
C     . IRELAX,JNTRIN,MFLUAG,JELEM,JGRDEF
*
*  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)
*     PENTE =XMAT(9)*PEPSI
      XI1LIM=SN/XMATE
*
*     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(ITYP.NE.1.AND.ITYP.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(ITYP.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(ITYP.LT.7) GO TO 205
      SIGEL(5)=0.D0
      SIGEL(2)=0.D0
      SIGEL(4)=SIGEL(1)
      IF(ITYP.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,ITYP,ORMAT,XMAT)
      DEPS=VONEPS(EPSPLA,ITYP,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,ITYP,XMAT,ALFAH,COVNMS,XINV,SI)
      RETURN
*
*  2-EME CAS   ECROUISSAGE
*
 300  CONTINUE
      IF(ITYP.NE.1.AND.ITYP.NE.5.AND.ITYP.NE.6) THEN
      KERRE=51
      RETURN
      ENDIF
*
*  CAS DES CONTRAINTES PLANES
*
      IF(ITYP.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,ITYP,XMAT,ALFAH,COVNMS,XINV,SI)
         LAPOIN=1
         RETURN
      ENDIF
*
*  CAS DU MASSIF
*
      IF(ITYP.EQ.1.OR.ITYP.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*FAC1*(W1(1)+W1(2)+W1(3))/3.D0
      CC = (VONEPS(W1,ITYP,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**2+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
*                                     AM 24/5/93 TEST SUR SN
      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) WRITE(IOIMP,77389) (SIGEL(I),I=1,IBOU)
      IF(IIMPI.EQ.15) WRITE(IOIMP,77390) EPSTAR,DEPS,EPST
      CALL CKRIT(IMAPLA,SIGEL,ITYP,XMAT,ALFAH,COVNMS,XINV,SI)
      RETURN
      ENDIF
      END