Esope source files

   1 : C FATTT     SOURCE    CHAT      07/12/04    21:15:58     5985           
   2 : C FATTT             
   3 :       SUBROUTINE FATTT(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,ISTEP,
   4 :      1                                        ICARA,KERRE,MFR,DT)
   5 : C MAZZZ     SOURCE    CHAT      05/01/13    01:38:25     5004 
   6 : C      SUBROUTINE MAZZZ(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,ISTEP,
   7 : C     1                                           ICARA,KERRE,MFR)
   8 : *======================================================================
   9 : * DB
  10 : *     New source: one nonlocal damage material model added:
  11 : *     Fatigue damage 
  12 : *     This routine is very similar to MAZZZ.ESO
  13 : *======================================================================
  14 : C
  15 : C    calcule la deformation initiale et l'increment de deformation
  16 : C    a partir de la contrainte initiale et l'increment de contrainte
  17 : C    elastique puis appelle la subroutine MAZARS
  18 : C
  19 : C
  20 : C     variables en entree
  21 : C
  22 : C     WRK0,KRK1,WRK5  pointeurs sur des segments de travail
  23 : C
  24 : C     NSTRS      nombre de composantes dans les vecteurs des contraintes
  25 : C                                        et les vecteurs des deformations
  26 : C
  27 : C     NVARI      nombre de variables internes (doit etre egal a 2)
  28 : C
  29 : C     NMATT      nombre de constantes du materiau
  30 : C
  31 : C     ISTEP      flag utilise pour separer les etapes dans un calcul non local
  32 : C                ISTEP=0 -----> calcul local
  33 : C                ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
  34 : C                ISTEP=2 -----> calcul non local etape 2 on continue le calcul
  35 : C                               a partir des seuils moyennes
  36 : C
  37 : C
  38 : C     variables en sortie
  39 : C
  40 : C     VARF      variables internes finales dans WRK0
  41 : C
  42 : C     SIGF      contraintes finales dans WRK0
  43 : C
  44 : C Modif L.Bode - 09/10/92 - Traitement particulier des coques
  45 : C Modif L.Bode - 14/10/92 - Modifications complementaires
  46 : C
  47 :       IMPLICIT INTEGER(I-N)
  48 :       IMPLICIT REAL*8(A-H,O-Z)
  49 : -INC CCOPTIO
  50 :       SEGMENT WRK0
  51 :         REAL*8 XMAT(NMATT)
  52 :       ENDSEGMENT
  53 : *
  54 :       SEGMENT WRK1
  55 :         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  56 :         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  57 :         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  58 :       ENDSEGMENT
  59 :       SEGMENT WRKK2
  60 :          REAL*8 EPSILI(NSTRSV),DSIGT(NSTRSV)
  61 :       END SEGMENT
  62 : *
  63 :       SEGMENT WRK5
  64 :         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  65 :       ENDSEGMENT
  66 :       SEGMENT WRK6
  67 :         REAL*8 SIG0S(NSTRS),DEPSTS(NSTRS)
  68 :       END SEGMENT
  69 : *
  70 :       CHARACTER*8 CMATE
  71 :       INTEGER NSTRS,NVARI,NMATT
  72 :       INTEGER KCAS,IRTD,ISTRS,KERRE,MFR
  73 :       REAL*8 PREC,EPAI,FAC,AUX,AUX1,AUX2,YOUN,XNU
  74 :       REAL*8 UN
  75 :       PARAMETER (UN=1.D0)
  76 :       KERRE=0
  77 :       YOUN = XMAT(1)
  78 :       XNU  = XMAT(2)
  79 : C
  80 : C     ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
  81 : C
  82 : C      print*,'dans mazzzz MFR=', mfr
  83 :       IF (MFR .EQ. 9) THEN
  84 :          EPAI=XCAR(1)
  85 :          SEGINI WRK6
  86 :          DO 101 ISTRS=1,NSTRS
  87 :             SIG0S(ISTRS)=SIG0(ISTRS)
  88 :             DEPSTS(ISTRS)=DEPST(ISTRS)
  89 :   101    CONTINUE
  90 :          NSTRSV=4
  91 :          IFOUR2=-2
  92 : C Modif L.Bode - 14/10/92
  93 : C Dans le cas des coques, on force la dimension a 2 pour MAZARS
  94 : C ie on travaille en contraintes planes
  95 :          JDIM =2
  96 : C Fin modif L.Bode
  97 :          DO 102 ISTRS=1,2
  98 :             SIG0(ISTRS)=SIG0S(ISTRS)/EPAI
  99 :   102    CONTINUE
 100 :          DEPST(3)=0.D0
 101 :          DEPST(4)=DEPSTS(3)
 102 :          SIG0(3)=0.D0
 103 :          SIG0(4)=SIG0S(3)/EPAI
 104 :       ELSE IF (MFR .EQ. 1) THEN
 105 :          NSTRSV=NSTRS
 106 :          IFOUR2=IFOUR
 107 : C Modif L.Bode - 14/10/92
 108 : C Pour les elts massifs, on utilise la vraie dimension
 109 :          JDIM = IDIM
 110 : C Fin modif L.Bode
 111 :       ELSE
 112 :          PRINT*,'MFR=',MFR
 113 :          KERRE=57
 114 :          RETURN
 115 :       END IF
 116 :       SEGINI WRKK2
 117 : 
 118 : 
 119 : C
 120 : C     calcul de la matrice elastique
 121 : C
 122 :       CMATE = 'ISOTROPE'
 123 :       KCAS=1
 124 : *      print*,'increment de deformation elastique'
 124 :       CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
 125 : *      DO ISTRS=1,NSTRS
 126 : *         print*,(DDHOOK(ISTRS,J),j=1,nstrs)
 127 : *         print*,DEPST(ISTRS)
 128 : *      END DO
 129 :       IF ( IRTD .EQ. 1) THEN
 130 : C
 131 : C      calcul de l'increment de contrainte
 132 : C
 132 :          CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
 133 : C
 134 : C
 135 : C     inversion de cette matrice
 136 : C
 137 :          PREC=1.D-08
 137 :       CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,2,DDHOOK,IRTD) 
 138 : *      DO ISTRS=1,NSTRSV
 139 : *              print*,(DDHOOK(ISTRS,J),j=1,nstrsv)
 140 : *      END DO       
 141 : *         print*,'appel a invalm'
 141 :          CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
 142 :          IF (IRTD.EQ.0)THEN
 143 : C
 144 : C     calcul des deformations du materiau elastique lineaire
 145 : C
 146 : *           print*,'appel a matve1'
 146 :            CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
 147 : C
 148 : C     modification pour tenir compte de l'endommagement
 149 : C
 150 :             DO 100 ISTRS=1,NSTRSV
 151 :                EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
 152 : 100         CONTINUE
 153 : 
 154 : C
 155 : C      appel a la routine MAZARS
 156 : C
 157 : C Modif L.Bode - 14/10/92
 158 : C On envoie la dimension et le numero de la formulation 
 159 : C  ( Elts Coques JDIM =2 , IFOUR2 = -2 => contraintes planes
 160 : C    Elts Massifs JDIM = IDIM ,IFOUR2 = IFOUR)
 161 : *            print*,'appel a mazars'
 161 : *            CALL  MAZARS (WRK0,WRK1,WRKK2,WRK5,NSTRSV,NVARI,NMATT,
 162 : *     1                    ISTEP,ICARA,JDIM,IFOUR2)
 163 : C Fin modif L.Bode
 164 : * DB
 165 : *
 165 :             CALL  FATI (WRK0,WRK1,WRKK2,WRK5,NSTRSV,NVARI,NMATT,
 166 :      1                    ISTEP,ICARA,JDIM,IFOUR2,DT)
 167 : *
 168 : * DB
 169 : C
 170 : C      ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
 171 : C
 172 : *            print*,'apres mazars'
 173 :             IF (MFR .EQ. 9) THEN
 174 :                
 175 :                
 176 : C
 177 : C     ON MET A JOUR DE FACON NON LINEAIRE LA PARTIE MEMBRANE
 178 : C     ET  LES PARTIES FLEXION ET EFFORTS
 179 : C     TRANCHANTS LE CAS ECHEANT
 180 : C
 181 :                FAC=(EPAI**3)/12.D0
 182 :                AUX =FAC*YOUN/(1.D0-XNU*XNU)
 183 :                AUX1=FAC*YOUN*.5D0/(1.D0+XNU)
 184 :                AUX2=EPAI*YOUN*.5D0/(1.d0+XNU)/1.2d0
 185 :                DO 103 ISTRS=1,NSTRS
 186 :                   SIG0(ISTRS)=SIG0S(ISTRS)
 187 :                   DEPST(ISTRS)=DEPSTS(ISTRS)
 188 :  103           CONTINUE
 189 : 
 190 :                DO 104 ISTRS=1,2
 191 :                   SIGF (ISTRS)=SIGF(ISTRS)*EPAI
 192 :  104           CONTINUE
 193 :                SIGF(3)=SIGF(4)*EPAI
 194 :                SIGF(4)=SIG0(4)+AUX*(DEPST(4)+XNU*DEPST(5))
 195 :                SIGF(5)=SIG0(5)+AUX*(DEPST(5)+XNU*DEPST(4))
 196 :                SIGF(6)=SIG0(6)+AUX1*DEPST(6)
 197 :                SIGF(7)=SIG0(7)+AUX2*DEPST(7)
 198 :                SIGF(8)=SIG0(8)+AUX2*DEPST(8)
 199 :                SEGSUP WRK6
 200 :             END IF
 201 :          ELSE
 202 :              print*,'erreur dans invalm'
 203 :              KERRE=56
 204 :          END IF
 205 :       ELSE
 206 :          print*,'erreur dans dohmas'
 207 :          KERRE=56
 208 :       END IF
 209 :       SEGSUP WRKK2
 210 :       RETURN
 211 :       END
 212 :  
 213 :  
 214 :  
 215 :