Download cmvmmm.eso

Back to the list

   1 : C CMVMMM    SOURCE    KICH      09/09/11    21:16:43     6505           
   2 :       SUBROUTINE CMVMMM(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou)
   3 : C MVMMM     SOURCE    PV        02/11/04    21:34:10     4472           
   4 : C MAZZZ     SOURCE    AM        00/12/13    21:39:54     4045           
   5 : c      SUBROUTINE MVMMM(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,ISTEP,
   6 : c     1                                           ICARA,KERRE,MFR)
   7 : *======================================================================
   8 : * BCN
   9 : *     New source: one nonlocal damage material model added:
  10 : *     Modified Von Mises                              
  11 : *     This routine is very similar to MAZZZ.ESO
  12 : *======================================================================
  13 : C
  14 : C    calcule la deformation initiale et l'increment de deformation
  15 : C    a partir de la contrainte initiale et l'increment de contrainte
  16 : C    elastique puis appelle la subroutine MAZARS
  17 : C
  18 : C
  19 : C     variables en entree
  20 : C
  21 : C
  22 : C     NSTRS1      nombre de composantes dans les vecteurs des contraintes
  23 : C                                        et les vecteurs des deformations
  24 : C
  25 : C     NVARI      nombre de variables internes (doit etre egal a 2)
  26 : C
  27 : C     NMATT      nombre de constantes du materiau
  28 : C
  29 : C     ISTEP      flag utilise pour separer les etapes dans un calcul non local
  30 : C                ISTEP=0 -----> calcul local
  31 : C                ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
  32 : C                ISTEP=2 -----> calcul non local etape 2 on continue le calcul
  33 : C                               a partir des seuils moyennes
  34 : C
  35 : C
  36 : C     variables en sortie
  37 : C
  38 : C     VARF      variables internes finales dans WRK0
  39 : C
  40 : C     SIGF      contraintes finales dans WRK0
  41 : C
  42 : C Modif L.Bode - 09/10/92 - Traitement particulier des coques
  43 : C Modif L.Bode - 14/10/92 - Modifications complementaires
  44 : C
  45 :       IMPLICIT INTEGER(I-N)
  46 :       IMPLICIT REAL*8(A-H,O-Z)
  47 : -INC CCOPTIO
  48 : -INC DECHE
  49 :       SEGMENT IECOU
  50 : *      COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  51 :        INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  52 : C      INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM,  NYKK,
  53 :      1  icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  54 : C    .  NYALF1,NYBET1,NYR,  NYA,   NYRHO,NSIGY,  NNKX,  NYKX,  IND,
  55 :      2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  56 : C    .  NSOM,  NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT,  NCXMAT,
  57 :      3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA,
  58 : C    .  LTRAC, MFR,  IELE,  NHRM,   NBNN, NBELEM,ICARA,
  59 :      4  icow32,icow33,NSTRS1,MFR1,icow36,icow37,icow38,
  60 : C    .  LW2,   NDEF,  NSTRSS,MFR1,  NBGMAT,NELMAT,MSOUPA,
  61 :      5  icow39,icow40,icow41,icow42,icow43,icow44
  62 : C    .  NUMAT1,LENDO, NBBB,  NNVARI,KERR1, MELEME
  63 :         INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  64 :      .          icow51,icow52,icow53,icow54,icow55,icow56
  65 :      .          icow57,icow58
  66 :       ENDSEGMENT
  67 :       SEGMENT NECOU
  68 : *      COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  69 :        INTEGER ncow(6), IFOURB,ncow1(14)
  70 :       ENDSEGMENT
  71 :       SEGMENT XECOU
  72 : *      COMMON/XECOU/DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
  73 :       REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
  74 :       ENDSEGMENT
  75 : *
  76 :       SEGMENT WRKK2
  77 :          REAL*8 EPSILI(NSTRSV)
  78 :       END SEGMENT
  79 : *
  80 :       SEGMENT WRK6
  81 :         REAL*8 SIG0S(NSTRS1),DEPSTS(NSTRS1)
  82 :       END SEGMENT
  83 : *
  84 : *      INTEGER KCAS,IRTD
  85 : *      REAL*8 PREC,EPAI,FAC,AUX,AUX1,AUX2,YOUN,XNU
  86 : *      REAL*8 UN
  87 :       PARAMETER (UN=1.D0)
  88 :       KERRE=0
  89 :       YOUN = XMAT(1)
  90 :       XNU  = XMAT(2)
  91 : C
  92 : C     ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
  93 : C
  94 : C      print*,'dans mazzzz MFR=', mfr
  95 :       IF (MFR .EQ. 9) THEN
  96 :          EPAI=xcarb(1)
  97 :          SEGINI WRK6
  98 :          DO 101 ISTRS=1,nstrs1
  99 :             SIG0S(ISTRS)=SIG0(ISTRS)
 100 :             DEPSTS(ISTRS)=DEPST(ISTRS)
 101 :   101    CONTINUE
 102 :          nstrsV=4
 103 :          IFOUR2=-2
 104 : C Modif L.Bode - 14/10/92
 105 : C Dans le cas des coques, on force la dimension a 2 pour MAZARS
 106 : C ie on travaille en contraintes planes
 107 :          JDIM =2
 108 : C Fin modif L.Bode
 109 :          DO 102 ISTRS=1,2
 110 :             SIG0(ISTRS)=SIG0S(ISTRS)/EPAI
 111 :   102    CONTINUE
 112 :          DEPST(3)=0.D0
 113 :          DEPST(4)=DEPSTS(3)
 114 :          SIG0(3)=0.D0
 115 :          SIG0(4)=SIG0S(3)/EPAI
 116 :       ELSE IF (MFR .EQ. 1) THEN
 117 :          nstrsV=nstrs1
 118 :          IFOUR2=IFOUR
 119 : C Modif L.Bode - 14/10/92
 120 : C Pour les elts massifs, on utilise la vraie dimension
 121 :          JDIM = IDIM
 122 : C Fin modif L.Bode
 123 :       ELSE
 124 :          PRINT*,'MFR=',MFR
 125 :          KERRE=57
 126 :          RETURN
 127 :       END IF
 128 :       SEGINI WRKK2
 129 : 
 130 : 
 131 : C
 132 : C     calcul de la matrice elastique
 133 : C
 134 :       CMATE = 'ISOTROPE'
 135 :       KCAS=1
 136 : *      print*,'increment de deformation elastique'
 136 :       CALL DOHMAS(XMAT,CMATE,IFOUR2,nstrsV,KCAS,DDHOOK,IRTD)
 137 : *      DO ISTRS=1,nstrs1
 138 : *         print*,(DDHOOK(ISTRS,J),j=1,nstrs1)
 139 : *         print*,DEPST(ISTRS)
 140 : *      END DO
 141 :       IF ( IRTD .EQ. 1) THEN
 142 : C
 143 : C      calcul de l'increment de contrainte
 144 : C
 144 :          CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
 145 : C
 146 : C
 147 : C     inversion de cette matrice
 148 : C
 149 :          PREC=1.D-08
 149 :       CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,2,DDHOOK,IRTD) 
 150 : *      DO ISTRS=1,NSTRSV
 151 : *              print*,(DDHOOK(ISTRS,J),j=1,nstrsv)
 152 : *      END DO       
 153 : *         print*,'appel a invalm'
 153 :          CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
 154 :          IF (IRTD.EQ.0)THEN
 155 : C
 156 : C     calcul des deformations du materiau elastique lineaire
 157 : C
 158 : *           print*,'appel a matve1'
 158 :            CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
 159 : C
 160 : C     modification pour tenir compte de l'endommagement
 161 : C
 162 :             DO 100 ISTRS=1,NSTRSV
 163 :                EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
 164 : 100         CONTINUE
 165 : 
 166 : C
 167 : C      appel a la routine MAZARS
 168 : C
 169 : C Modif L.Bode - 14/10/92
 170 : C On envoie la dimension et le numero de la formulation 
 171 : C  ( Elts Coques JDIM =2 , IFOUR2 = -2 => contraintes planes
 172 : C    Elts Massifs JDIM = IDIM ,IFOUR2 = IFOUR)
 173 : *            print*,'appel a mazars'
 174 : *
 175 : * BCN
 175 : C            CALL  MAZARS (WRK0,WRK1,WRKK2,WRK5,NSTRSV,NVARI,NMATT,
 176 : C     1                    ISTEP,ICARA,JDIM,IFOUR2)
 176 : c        CALL  MODVONMISES (WRK0,WRK1,WRKK2,WRK5,NSTRSV,NVARI,NMATT,
 177 : c     1                    ISTEP,ICARA,JDIM,IFOUR2)
 178 :       icarbi=icara
 178 :         CALL  CODVMS (WRK52,WRK53,WRK54,WRKK2,NSTRSV,NVARI,ICARBI,
 179 :      $     jdim,ifour2)
 180 : * BCN
 181 : *
 182 : C Fin modif L.Bode
 183 : C
 184 : C      ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
 185 : C
 186 : *            print*,'apres mazars'
 187 :             IF (MFR .EQ. 9) THEN
 188 :                
 189 :                
 190 : C
 191 : C     ON MET A JOUR DE FACON NON LINEAIRE LA PARTIE MEMBRANE
 192 : C     ET  LES PARTIES FLEXION ET EFFORTS
 193 : C     TRANCHANTS LE CAS ECHEANT
 194 : C
 195 :                FAC=(EPAI**3)/12.D0
 196 :                AUX =FAC*YOUN/(1.D0-XNU*XNU)
 197 :                AUX1=FAC*YOUN*.5D0/(1.D0+XNU)
 198 :                AUX2=EPAI*YOUN*.5D0/(1.d0+XNU)/1.2d0
 199 :                DO 103 ISTRS=1,nstrs1
 200 :                   SIG0(ISTRS)=SIG0S(ISTRS)
 201 :                   DEPST(ISTRS)=DEPSTS(ISTRS)
 202 :  103           CONTINUE
 203 : 
 204 :                DO 104 ISTRS=1,2
 205 :                   SIGF (ISTRS)=SIGF(ISTRS)*EPAI
 206 :  104           CONTINUE
 207 :                SIGF(3)=SIGF(4)*EPAI
 208 :                SIGF(4)=SIG0(4)+AUX*(DEPST(4)+XNU*DEPST(5))
 209 :                SIGF(5)=SIG0(5)+AUX*(DEPST(5)+XNU*DEPST(4))
 210 :                SIGF(6)=SIG0(6)+AUX1*DEPST(6)
 211 :                SIGF(7)=SIG0(7)+AUX2*DEPST(7)
 212 :                SIGF(8)=SIG0(8)+AUX2*DEPST(8)
 213 :                SEGSUP WRK6
 214 :             END IF
 215 :          ELSE
 216 :              print*,'erreur dans invalm'
 217 :              KERRE=56
 218 :          END IF
 219 :       ELSE
 220 :          print*,'erreur dans dohmas'
 221 :          KERRE=56
 222 :       END IF
 223 :       SEGSUP WRKK2
 224 :       RETURN
 225 :       END
 226 :  
 227 :  
 228 :  
 229 :  
 230 :  
 231 :  
 232 :  

© Cast3M 2003 - All rights reserved.
Disclaimer