Sources Esope | Cast3M

fattt
C FATTT     SOURCE    CHAT      07/12/04    21:15:58     5985
C FATTT
      SUBROUTINE FATTT(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,ISTEP,
     1                                        ICARA,KERRE,MFR,DT)
C MAZZZ     SOURCE    CHAT      05/01/13    01:38:25     5004
C      SUBROUTINE MAZZZ(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,ISTEP,
C     1                                           ICARA,KERRE,MFR)
*======================================================================
* DB
*     New source: one nonlocal damage material model added:
*     Fatigue damage
*     This routine is very similar to MAZZZ.ESO
*======================================================================
C
C    calcule la deformation initiale et l'increment de deformation
C    a partir de la contrainte initiale et l'increment de contrainte
C    elastique puis appelle la subroutine MAZARS
C
C
C     variables en entree
C
C     WRK0,KRK1,WRK5  pointeurs sur des segments de travail
C
C     NSTRS      nombre de composantes dans les vecteurs des contraintes
C                                        et les vecteurs des deformations
C
C     NVARI      nombre de variables internes (doit etre egal a 2)
C
C     NMATT      nombre de constantes du materiau
C
C     ISTEP      flag utilise pour separer les etapes dans un calcul non local
C                ISTEP=0 -----> calcul local
C                ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
C                ISTEP=2 -----> calcul non local etape 2 on continue le calcul
C                               a partir des seuils moyennes
C
C
C     variables en sortie
C
C     VARF      variables internes finales dans WRK0
C
C     SIGF      contraintes finales dans WRK0
C
C Modif L.Bode - 09/10/92 - Traitement particulier des coques
C Modif L.Bode - 14/10/92 - Modifications complementaires
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
      SEGMENT WRK0
        REAL*8 XMAT(NMATT)
      ENDSEGMENT
*
      SEGMENT WRK1
        REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
        REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
        REAL*8 DEFP(NSTRS),XCAR(ICARA)
      ENDSEGMENT
      SEGMENT WRKK2
         REAL*8 EPSILI(NSTRSV),DSIGT(NSTRSV)
      END SEGMENT
*
      SEGMENT WRK5
        REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
      ENDSEGMENT
      SEGMENT WRK6
        REAL*8 SIG0S(NSTRS),DEPSTS(NSTRS)
      END SEGMENT
*
      CHARACTER*8 CMATE
      INTEGER NSTRS,NVARI,NMATT
      INTEGER KCAS,IRTD,ISTRS,KERRE,MFR
      REAL*8 PREC,EPAI,FAC,AUX,AUX1,AUX2,YOUN,XNU
      REAL*8 UN
      PARAMETER (UN=1.D0)
      KERRE=0
      YOUN = XMAT(1)
      XNU  = XMAT(2)
C
C     ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
C
C      print*,'dans mazzzz MFR=', mfr
      IF (MFR .EQ. 9) THEN
         EPAI=XCAR(1)
         SEGINI WRK6
         DO 101 ISTRS=1,NSTRS
            SIG0S(ISTRS)=SIG0(ISTRS)
            DEPSTS(ISTRS)=DEPST(ISTRS)
  101    CONTINUE
         NSTRSV=4
         IFOUR2=-2
C Modif L.Bode - 14/10/92
C Dans le cas des coques, on force la dimension a 2 pour MAZARS
C ie on travaille en contraintes planes
         JDIM =2
C Fin modif L.Bode
         DO 102 ISTRS=1,2
            SIG0(ISTRS)=SIG0S(ISTRS)/EPAI
  102    CONTINUE
         DEPST(3)=0.D0
         DEPST(4)=DEPSTS(3)
         SIG0(3)=0.D0
         SIG0(4)=SIG0S(3)/EPAI
      ELSE IF (MFR .EQ. 1) THEN
         NSTRSV=NSTRS
         IFOUR2=IFOUR
C Modif L.Bode - 14/10/92
C Pour les elts massifs, on utilise la vraie dimension
         JDIM = IDIM
C Fin modif L.Bode
      ELSE
         PRINT*,'MFR=',MFR
         KERRE=57
         RETURN
      END IF
      SEGINI WRKK2
 
 
C
C     calcul de la matrice elastique
C
      CMATE = 'ISOTROPE'
      KCAS=1
*      print*,'increment de deformation elastique'
      CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
*      DO ISTRS=1,NSTRS
*         print*,(DDHOOK(ISTRS,J),j=1,nstrs)
*         print*,DEPST(ISTRS)
*      END DO
      IF ( IRTD .EQ. 1) THEN
C
C      calcul de l'increment de contrainte
C
         CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
C
C
C     inversion de cette matrice
C
         PREC=1.D-08
      CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,2,DDHOOK,IRTD)
*      DO ISTRS=1,NSTRSV
*              print*,(DDHOOK(ISTRS,J),j=1,nstrsv)
*      END DO
*         print*,'appel a invalm'
         CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
         IF (IRTD.EQ.0)THEN
C
C     calcul des deformations du materiau elastique lineaire
C
*           print*,'appel a matve1'
           CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
C
C     modification pour tenir compte de l'endommagement
C
            DO 100 ISTRS=1,NSTRSV
               EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
100         CONTINUE
 
C
C      appel a la routine MAZARS
C
C Modif L.Bode - 14/10/92
C On envoie la dimension et le numero de la formulation
C  ( Elts Coques JDIM =2 , IFOUR2 = -2 => contraintes planes
C    Elts Massifs JDIM = IDIM ,IFOUR2 = IFOUR)
*            print*,'appel a mazars'
*            CALL  MAZARS (WRK0,WRK1,WRKK2,WRK5,NSTRSV,NVARI,NMATT,
*     1                    ISTEP,ICARA,JDIM,IFOUR2)
C Fin modif L.Bode
* DB
*
            CALL  FATI (WRK0,WRK1,WRKK2,WRK5,NSTRSV,NVARI,NMATT,
     1                    ISTEP,ICARA,JDIM,IFOUR2,DT)
*
* DB
C
C      ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
C
*            print*,'apres mazars'
            IF (MFR .EQ. 9) THEN
 
 
C
C     ON MET A JOUR DE FACON NON LINEAIRE LA PARTIE MEMBRANE
C     ET  LES PARTIES FLEXION ET EFFORTS
C     TRANCHANTS LE CAS ECHEANT
C
               FAC=(EPAI**3)/12.D0
               AUX =FAC*YOUN/(1.D0-XNU*XNU)
               AUX1=FAC*YOUN*.5D0/(1.D0+XNU)
               AUX2=EPAI*YOUN*.5D0/(1.d0+XNU)/1.2d0
               DO 103 ISTRS=1,NSTRS
                  SIG0(ISTRS)=SIG0S(ISTRS)
                  DEPST(ISTRS)=DEPSTS(ISTRS)
 103           CONTINUE
 
               DO 104 ISTRS=1,2
                  SIGF (ISTRS)=SIGF(ISTRS)*EPAI
 104           CONTINUE
               SIGF(3)=SIGF(4)*EPAI
               SIGF(4)=SIG0(4)+AUX*(DEPST(4)+XNU*DEPST(5))
               SIGF(5)=SIG0(5)+AUX*(DEPST(5)+XNU*DEPST(4))
               SIGF(6)=SIG0(6)+AUX1*DEPST(6)
               SIGF(7)=SIG0(7)+AUX2*DEPST(7)
               SIGF(8)=SIG0(8)+AUX2*DEPST(8)
               SEGSUP WRK6
            END IF
         ELSE
             print*,'erreur dans invalm'
             KERRE=56
         END IF
      ELSE
         print*,'erreur dans dohmas'
         KERRE=56
      END IF
      SEGSUP WRKK2
      RETURN
      END