Sources Esope | Cast3M

comeff
C COMEFF    SOURCE    CB215821  24/04/12    21:15:21     11897          
      SUBROUTINE COMEFF(IQMOD,IWRK52,IWRK53,IWRK54,ICAS,IRETOU)
*----------------------------------------------------------
*     cas des milieux poreux isotropes:
*
*     appele par COMARA et COMSOR
*
*     rearrangement dans  XMAT
*     passage en contraintes effectives et reciproquement
*
* pb: IRETOU=1
*----------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMMODEL
-INC SMCHAML
-INC DECHE
C
      imodel = iqmod
      wrk52 = iwrk52
      wrk53 = iwrk53
      ncara = xmat(/1)
      wrk54=iwrk54
      IRETOU=1
      NSTMU=2
      IF(IFOUR.GE.0) NSTMU=3
*
*     CAS MODELE EXTERIEUR
*
      IF(INPLAS.LT.0) GO TO 1990
*
*---------------------------------------------------------------------
*
      IF(ICAS.EQ.1) THEN
*
*
*       milieu poreux  cas elastique isotrope
*
        IF (MFR.EQ.33.AND.MATE.EQ.1) THEN
 
*
*         CAS DES JOINTS
*
          IF(MELE.GE.108.AND.MELE.LE.110)THEN
            NSTMU=2
            IF(IFOUR.GE.0) NSTMU=3
*
*           rearrangement
*
            LIND=3
            COB=XMAT(LIND)
            XMOB=XMAT(LIND+1)
 
            DO 1991 IC=1,NMATT-LIND-1
              XMAT(LIND-1+IC)=XMAT(LIND+1+IC)
              XMAT0(LIND-1+IC)=XMAT0(LIND+1+IC)
1991        CONTINUE
*
*           PRINT *,'NMATT=',NMATT
*           DO IJ=1,NMATT
*             WRITE(6,77882) XMAT(IJ)
*77882 FORMAT(2X,1PE12.5)
*           ENDDO
 
            XMAT(NMATT-1)=COB
            XMAT0(NMATT-1)=COB
            XMAT(NMATT)=XMOB
            XMAT0(NMATT)=XMOB
*
*           calcul des contraintes effectives
*
            SIG0(NSTMU) =SIG0(NSTMU)  + COB* EPST0(NSTRS)
C
          ELSE
*
*           CAS MASSIF ISOTROPE
*
            IF(IFOUR.EQ.-3.OR.IFOUR.EQ.1) THEN
              KERR0=99
              GO TO 1000
            ENDIF
*
*           rearrangement
*
            LIND=5
            COB=XMAT(LIND)
            XMOB=XMAT(LIND+1)
            DO 1992 IC=1,NMATT-LIND-1
              XMAT(LIND-1+IC)=XMAT(LIND+1+IC)
              XMAT0(LIND-1+IC)=XMAT0(LIND+1+IC)
1992        CONTINUE
*
            XMAT(NMATT-1)=COB
            XMAT0(NMATT-1)=COB
            XMAT(NMATT)=XMOB
            XMAT0(NMATT)=XMOB
 
 
*           PRINT *,'NMATT=',NMATT
*           DO IJ=1,NMATT
*             WRITE(6,77882) XMAT(IJ)
*77882 FORMAT(2X,1PE12.5)
*           ENDDO
 
*
*           calcul des contraintes effectives
*
            DO 1993 IC=1,3
              IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1993
              SIG0(IC) =SIG0(IC)  + COB* EPST0(NSTRS)
1993        continue
          ENDIF
*
        ELSE
*
*         CAS NON PREVU
*
          GO TO 1000
        ENDIF
*
        GO TO 1990
      ENDIF
*
*---------------------------------------------------------------------
*               calcul des contraintes totales
*
      IF(ICAS.EQ.2) THEN
 
        IF (MFR.EQ.33.AND.MATE.EQ.1) THEN
*
*         attention : a prendre dans XMAT0 et pas XMAT
*
*         CAS DES JOINTS
*
          IF(MELE.GE.108.AND.MELE.LE.110)THEN
*
            NSTMU=2
            IF(IFOUR.GE.0) NSTMU=3
            COB= XMAT0(NMATT-1)
            XMOB=XMAT0(NMATT)
            IF(XMOB.EQ.0.D0) THEN
              UNSURM=0.D0
            ELSE
              UNSURM=1.D0/XMOB
            ENDIF
*
*           PRINT *, 'COB=',COB,'  XMOB=',XMOB
*           PRINT *, 'NSTMU=',NSTMU
*           PRINT *, 'NSTRS=',NSTRS
*           PRINT *, 'SIG0(NSTRS)=',SIG0(NSTRS)
*           PRINT *, 'DEPST(NSTRS)=',DEPST(NSTRS)
            SIGF(NSTRS) = SIG0(NSTRS)+DEPST(NSTRS)*UNSURM
     &                      +COB*DEPST(NSTMU)
            SIGF(NSTMU) = SIGF(NSTMU)
     &                 -COB*(EPST0(NSTRS)+DEPST(NSTRS))
 
          ELSE
*
*           CAS MASSIF ISOTROPE
*
            COB= XMAT0(NMATT-1)
            XMOB=XMAT0(NMATT)
            IF(XMOB.EQ.0.D0) THEN
              UNSURM=0.D0
            ELSE
              UNSURM=1.D0/XMOB
            ENDIF
*           PRINT *,' COB=', COB
*           IRETOU=1
*           GO TO 1000
 
            SIGF(NSTRS) = SIG0(NSTRS)+DEPST(NSTRS)*UNSURM
            DO 1994 IC=1,3
              IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1994
              SIGF(IC) = SIGF(IC)
     &                -COB*(EPST0(NSTRS)+DEPST(NSTRS))
*
*
              SIGF(NSTRS) = SIGF(NSTRS)
     &                       +COB*DEPST(IC)
 
1994        CONTINUE
          ENDIF
*
        ELSE
*
*         CAS NON PREVU
*
          GO TO 1000
 
        ENDIF
 
        GO TO 1990
      ENDIF
*
1000   CONTINUE
       RETURN
*
1990   CONTINUE
       IRETOU=0
       RETURN
       END