Download mistrl.eso

Back to the list

   1 : C MISTRL    SOURCE    PV        11/03/07    21:17:30     6885           
   2 : 
   3 : C-----------------------------------------------------------------------
   4 : C Sous-programme d'interface entre CAST3M et module MISTRAL version 2.0
   5 : C-----------------------------------------------------------------------
   6 :       SUBROUTINE MISTRL (TEMP0,T0,FI0, SIG0, VAR0,
   7 :      &                   IFOURB, NSTRS,
   8 :      &                   DT, TF,FIF, DEPST, XMAT,TXR,IDIM,
   9 :      &                   PDILT, NDPI,NDVP,NXX,NPSI,
  10 :      &                   PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, PCROI,
  11 :      &                   NPINCR,PINCR,
  12 :      &                   SIGF,VARF,EPINF)
  13 : C-----------------------------------------------------------------------
  14 : C     Entrees :
  15 : C     ---------
  16 : C     TEMP0    : instant de debut du pas de temps
  17 : C     T0       : temperature au debut du pas de temps
  18 : C     FI0      : flux de neutrons rapides au debut du pas de temps
  19 : C     SIG0()   : contraintes au debut du pas de temps *
  20 : C     VAR0()   : variables internes materiau au debut du pas de temps **
  21 : C     IFOURB   : type de calcul CAST3M :
  22 : C                =  2 : tridimensionnel (3D)
  23 : C                =  0 : axisymetrie (2D)
  24 : C                = -1 : deformations planes (2D)
  25 : C                = -2 : contraintes planes (2D)
  26 : C                = -3 : deformations planes generalisees (2D)
  27 : C                =  3 a 11 : unidimensionnel plan (massif 1D)
  28 : C                = 12 a 14 : unidimensionnel axisymetrique (massif 1D)
  29 : C     NSTRS    : nombre de composantes de contraintes et de deformations
  30 : C                pour CAST3M
  31 : C     DT       : pas de temps
  32 : C     TF       : temperature a la fin du pas de temps
  33 : C     FIF      : flux de neutrons rapides a la fin du pas de temps
  34 : C     DEPST()  : increment impose de deformation totale *
  35 : C     XMAT()   : caracteristiques materiau selon CAST3M
  36 : C     TXR(l,c) : composante l du vecteur c de la base locale de CAST3M (element
  37 : C                fini) dans la base generale de CAST3M (ensemble du modele)
  38 : C     IDIM     : dimension de l'espace dans CAST3M : 1 a 3 (pour DIMENSION TXR)
  39 : C     PDILT    : tableau des parametres relatifs a la dilatation thermique
  40 : C     NDPI     : nombre de deformations plastiques instantanees (0 ou 1)
  41 : C     NDVP     : nombre de deformations viscoplastiques (0 a 3)
  42 : C     NXX      : nombre de contraintes internes (0 a 3)
  43 : C     NPSI     : existence (1) ou non (0) de variable de durcissement
  44 : C                d'irradiation differente de la fluence neutronique
  45 : C     tableaux des parametres du modele :
  46 : C     PCOHI    : relatif aux coefficients de Hill
  47 : C     PECOU    : relatif a l'ecoulement viscoplastique
  48 : C     PEDIR    : relatif a la contrainte seuil
  49 : C     PRVCE    : relatif aux lois d'evolution des deformations equivalentes
  50 : C     PECRX    : relatif aux lois d'evolution des contraintes internes
  51 : C     PDVDI    : relatif au durcissement d'irradiation
  52 : C     PCROI    : relatif a la croissance d'irradiation
  53 : C     NPINCR   : nombre de parametres de PINCR
  54 : C     PINCR    : tableau des increments maximaux autorises
  55 : C
  56 : C     Sorties :
  57 : C     ---------
  58 : C     SIGF()   : contraintes a la fin du pas de temps *
  59 : C     VARF()   : variables internes materiau a la fin du pas de temps **
  60 : C     EPINF()  : deformation inelastique globale (somme des deformations
  61 : C                plastiques de toutes natures) a la fin du pas de temps *
  62 : C
  63 : C     *  : dans la base generale de CAST3M
  64 : C          (donc composantes 4, 5 et 6 des deformations = glissements)
  65 : C     ** : dans la base generale de CAST3M ou dans base d'orthotropie MISTRAL
  66 : C          pour les composantes de deformations et contraintes internes
  67 : C          selon valeur de ICBASE extrait de XMAT
  68 : C-----------------------------------------------------------------------
  69 : 
  70 :       IMPLICIT INTEGER (I-N)
  71 :       IMPLICIT REAL*8 (A-H, O-Z)
  72 : 
  73 : C     Nombre total de variables internes :
  74 : C        NIJ*(4+NDVPMA)+2*(1+NDVPMA)+NIJ*NXXMAX+8+2*NIJ+1+NDVPMA = 101
  75 :       PARAMETER ( NIJ = 6 , NDVPMA = 4 , NXXMAX = 3 )
  76 :       PARAMETER ( FEPSIJ = 2. )
  77 :       PARAMETER ( NPCELM = 19 )
  78 : 
  79 :       DIMENSION SIG0(1:*),VAR0(1:*),DEPST(1:*),XMAT(1:*),
  80 :      &          TXR(1:IDIM,1:*)
  81 :       DIMENSION PDILT(1:*),PCOHI(1:*),PECOU(1:*),
  82 :      &          PEDIR(1:*),PRVCE(1:*),PECRX(1:*),PDVDI(1:*),
  83 :      &          PCROI(1:*),PINCR(1:*)
  84 :       DIMENSION PCOEL(1:NPCELM)
  85 :       DIMENSION PBLOC(1:3,1:3),VEC(1:3,1:3),
  86 :      &          IP(1:3),SENS(1:3),PVEC(1:3,1:3),
  87 :      &          PBPO(1:3,1:3),PINV(1:3,1:3),IC(6),JC(6),
  88 :      &          VECT(1:3,1:3),VECTP(1:3,1:3),
  89 :      &          PROMAT(1:3,1:3)
  90 :       DIMENSION SIG(1:6),EPS(1:6),EPSTH(1:6),EPSEL(1:6),EPSCR(1:6),
  91 :      &          EPSP(1:6,0:NDVPMA),EPSE(0:NDVPMA),EPSEQ(0:NDVPMA),
  92 :      &          XX(1:6,1:NXXMAX)
  93 :       DIMENSION CSIG(1:6,1:6),CEPS(1:6,1:6),CSIEP0(1:6)
  94 :       DIMENSION SEQ(0:NDVPMA),RR(0:NDVPMA)
  95 :       DIMENSION SIGP(1:6),VEPS(1:6),VEPSTH(1:6),VEPSEL(1:6),VEPSCR(1:6),
  96 :      &          VEPSP(1:6,0:NDVPMA),VEPSE(0:NDVPMA),
  97 :      &          EPSEQP(0:NDVPMA),XXP(1:6,1:NXXMAX)
  98 :       DIMENSION DELSIG(1:6),
  99 :      &          DELEPS(1:6),DELETH(1:6),DELEEL(1:6),DELECR(1:6),
 100 :      &          DELEP(1:6,0:NDVPMA),DELEE(0:NDVPMA),DELEEQ(0:NDVPMA),
 101 :      &          DELXX(1:6,1:NXXMAX)
 102 :       DIMENSION VEPSIN(1:6)
 103 :       REAL*8 NU120,NU230,NU310,MU120,MU130,MU230
 104 :       CHARACTER FICH*1
 105 :       DIMENSION SIGF(1:*),VARF(1:*),EPINF(1:*)
 106 : C     ------------------------------------------------------------------
 107 :       DATA IC / 1 , 2 , 3 , 1 , 1 , 2 /
 108 :       DATA JC / 1 , 2 , 3 , 2 , 3 , 3 /
 109 :       DATA FICH / ' ' /
 110 : C     ------------------------------------------------------------------
 111 : C     Variables diverses
 112 : C
 113 :       T = TEMP0
 114 :       TT = T0
 115 :       FI = FI0
 116 :       IF (DT.EQ.0.D0) THEN
 117 :         DTI = 1.D-20
 118 :       ELSE
 119 :         DTI = DT
 120 :       END IF
 121 :       TTP = (TF-T0)/DTI
 122 :       FIP = (FIF-FI0)/DTI
 123 : C     ------------------------------------------------------------------
 124 : C     Determination de la matrice PBPO de passage de la base generale
 125 : C     CAST3M a la base principale d'orthotropie pour MISTRAL
 126 : C     et de son inverse PINV
 127 : C
 128 :       IF (IFOURB.EQ.2) THEN
 129 :         PBLOC(1,1) = TXR(1,1)
 130 :         PBLOC(1,2) = TXR(2,1)
 131 :         PBLOC(1,3) = TXR(3,1)
 132 :         PBLOC(2,1) = TXR(1,2)
 133 :         PBLOC(2,2) = TXR(2,2)
 134 :         PBLOC(2,3) = TXR(3,2)
 135 :         PBLOC(3,1) = TXR(1,3)
 136 :         PBLOC(3,2) = TXR(2,3)
 137 :         PBLOC(3,3) = TXR(3,3)
 138 :         VEC(1,1) = XMAT(10)
 139 :         VEC(1,2) = XMAT(11)
 140 :         VEC(1,3) = XMAT(12)
 141 :         VEC(2,1) = XMAT(13)
 142 :         VEC(2,2) = XMAT(14)
 143 :         VEC(2,3) = XMAT(15)
 144 :         VEC(3,1) = VEC(1,2)*VEC(2,3)-VEC(1,3)*VEC(2,2)
 145 :         VEC(3,2) = VEC(1,3)*VEC(2,1)-VEC(1,1)*VEC(2,3)
 146 :         VEC(3,3) = VEC(1,1)*VEC(2,2)-VEC(1,2)*VEC(2,1)
 147 :         SENIP1 = XMAT(16)
 148 :         SENIP2 = XMAT(17)
 149 :       ELSE IF ((IFOURB.GE.-3).AND.(IFOURB.LE.0)) THEN
 150 :         PBLOC(1,1) = TXR(1,1)
 151 :         PBLOC(1,2) = TXR(2,1)
 152 :         PBLOC(1,3) = 0.
 153 :         PBLOC(2,1) = TXR(1,2)
 154 :         PBLOC(2,2) = TXR(2,2)
 155 :         PBLOC(2,3) = 0.
 156 :         PBLOC(3,1) = 0.
 157 :         PBLOC(3,2) = 0.
 158 :         PBLOC(3,3) = 1.
 159 :         IF (IFOURB.EQ.-2) THEN
 160 :           VEC(1,1) = XMAT(5)
 161 :           VEC(1,2) = XMAT(6)
 162 :         ELSE
 163 :           VEC(1,1) = XMAT(8)
 164 :           VEC(1,2) = XMAT(9)
 165 :         END IF
 166 :         VEC(1,3) = 0.
 167 :         VEC(3,1) = 0.
 168 :         VEC(3,2) = 0.
 169 :         VEC(3,3) = 1.
 170 : C*      VEC(2,1) = VEC(3,2)*VEC(1,3)-VEC(3,3)*VEC(1,2)
 171 : C*      VEC(2,2) = VEC(3,3)*VEC(1,1)-VEC(3,1)*VEC(1,3)
 172 : C*      VEC(2,3) = VEC(3,1)*VEC(1,2)-VEC(3,2)*VEC(1,1)
 173 :         VEC(2,1) = -VEC(1,2)
 174 :         VEC(2,2) = VEC(1,1)
 175 :         VEC(2,3) = 0.
 176 :         SENIP1 = XMAT(10)
 177 :         SENIP2 = XMAT(11)
 178 :       ELSE IF ((IFOURB.GE.3).AND.(IFOURB.LE.14)) THEN
 179 :         PBLOC(1,1) = 1.
 180 :         PBLOC(1,2) = 0.
 181 :         PBLOC(1,3) = 0.
 182 :         PBLOC(2,1) = 0.
 183 :         PBLOC(2,2) = 1.
 184 :         PBLOC(2,3) = 0.
 185 :         PBLOC(3,1) = 0.
 186 :         PBLOC(3,2) = 0.
 187 :         PBLOC(3,3) = 1.
 188 :         VEC(1,1) = 1.
 189 :         VEC(1,2) = 0.
 190 :         VEC(1,3) = 0.
 191 :         VEC(2,1) = 0.
 192 :         VEC(2,2) = 1.
 193 :         VEC(2,3) = 0.
 194 :         VEC(3,1) = 0.
 195 :         VEC(3,2) = 0.
 196 :         VEC(3,3) = 1.
 197 :         SENIP1 = XMAT(7)
 198 :         SENIP2 = XMAT(8)
 199 :       END IF
 200 :       IP(1) = ABS(nint(SENIP1))
 201 :       IP(2) = ABS(nint(SENIP2))
 202 :       SENS(1) = SENIP1/ABS(SENIP1)
 203 :       SENS(2) = SENIP2/ABS(SENIP2)
 204 :       DO I = 1,2
 205 :         DO J = 1,3
 206 :           IF (J.EQ.IP(I)) THEN
 207 :             PVEC(I,J) = SENS(I)
 208 :           ELSE
 209 :             PVEC(I,J) = 0.
 210 :           END IF
 211 :         END DO
 212 :       END DO
 213 :       PVEC(3,1) = PVEC(1,2)*PVEC(2,3)-PVEC(1,3)*PVEC(2,2)
 214 :       PVEC(3,2) = PVEC(1,3)*PVEC(2,1)-PVEC(1,1)*PVEC(2,3)
 215 :       PVEC(3,3) = PVEC(1,1)*PVEC(2,2)-PVEC(1,2)*PVEC(2,1)
 215 :       CALL PRODMA(PBLOC,VEC,3,3,3, PROMAT)
 215 :       CALL PRODMA(PROMAT,PVEC,3,3,3, PBPO)
 216 :       DO I = 1,3
 217 :         DO J = 1,3
 218 :           PINV(I,J) = PBPO(J,I)
 219 :         END DO
 220 :       END DO
 221 : C     ------------------------------------------------------------------
 222 : C     Changement de base pour contraintes debut de pas de temps
 223 : C
 224 :       IF (IFOURB.EQ.2) THEN
 225 :         VECT(1,1) = SIG0(1)
 226 :         VECT(2,1) = SIG0(4)
 227 :         VECT(3,1) = SIG0(5)
 228 :         VECT(1,2) = SIG0(4)
 229 :         VECT(2,2) = SIG0(2)
 230 :         VECT(3,2) = SIG0(6)
 231 :         VECT(1,3) = SIG0(5)
 232 :         VECT(2,3) = SIG0(6)
 233 :         VECT(3,3) = SIG0(3)
 234 :       ELSE IF ((IFOURB.GE.-3).AND.(IFOURB.LE.0)) THEN
 235 :         VECT(1,1) = SIG0(1)
 236 :         VECT(2,1) = SIG0(4)
 237 :         VECT(3,1) = 0.
 238 :         VECT(1,2) = SIG0(4)
 239 :         VECT(2,2) = SIG0(2)
 240 :         VECT(3,2) = 0.
 241 :         VECT(1,3) = 0.
 242 :         VECT(2,3) = 0.
 243 :         IF (IFOURB.EQ.-2) THEN
 244 :           VECT(3,3) = 0.
 245 :         ELSE
 246 :           VECT(3,3) = SIG0(3)
 247 :         END IF
 248 :       ELSE IF ((IFOURB.GE.3).AND.(IFOURB.LE.14)) THEN
 249 :         VECT(1,1) = SIG0(1)
 250 :         VECT(2,1) = 0.
 251 :         VECT(3,1) = 0.
 252 :         IF ((IFOURB.EQ.5).OR.(IFOURB.EQ.6).OR.(IFOURB.EQ.10).OR.
 253 :      &      (IFOURB.EQ.13)) THEN
 254 :           VECT(2,2) = 0.
 255 :         ELSE
 256 :           VECT(2,2) = SIG0(2)
 257 :         END IF
 258 :         VECT(3,2) = 0.
 259 :         VECT(1,3) = 0.
 260 :         VECT(2,3) = 0.
 261 :         IF ((IFOURB.EQ.4).OR.(IFOURB.EQ.6).OR.(IFOURB.EQ.8)) THEN
 262 :           VECT(3,3) = 0.
 263 :         ELSE
 264 :           VECT(3,3) = SIG0(3)
 265 :         END IF
 266 :       END IF
 266 :       CALL PRODMA(VECT,PBPO,3,3,3, PROMAT)
 266 :       CALL PRODMA(PINV,PROMAT,3,3,3, VECTP)
 267 :       SIG(1) = VECTP(1,1)
 268 :       SIG(2) = VECTP(2,2)
 269 :       SIG(3) = VECTP(3,3)
 270 :       SIG(4) = VECTP(1,2)
 271 :       SIG(5) = VECTP(1,3)
 272 :       SIG(6) = VECTP(2,3)
 273 : C     ------------------------------------------------------------------
 274 : C     Coefficients des equations entre derivees des contraintes
 275 : C     et vitesses de deformations
 276 : C
 277 :       IF (IFOURB.EQ.2) THEN
 278 :         CSIEP0(1) = DEPST(1)/DTI
 279 :         CSIEP0(2) = DEPST(2)/DTI
 280 :         CSIEP0(3) = DEPST(3)/DTI
 281 :         CSIEP0(4) = DEPST(4)/FEPSIJ/DTI
 282 :         CSIEP0(5) = DEPST(5)/FEPSIJ/DTI
 283 :         CSIEP0(6) = DEPST(6)/FEPSIJ/DTI
 284 :         DO IJ = 1,6
 285 :           DO IPJP = 1,3
 286 :             CSIG(IPJP,IJ) = 0.
 287 :             CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 288 :           END DO
 289 :           DO IPJP = 4,6
 290 :             CSIG(IPJP,IJ) = 0.
 291 :             CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 292 :      &                    + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 293 :           END DO
 294 :         END DO
 295 :       ELSE IF ((IFOURB.GE.-3).AND.(IFOURB.LE.0)) THEN
 296 :         IF (IFOURB.EQ.-2) THEN
 297 :           CSIEP0(3) = 0.
 298 :           IJ = 3
 299 :           DO IPJP = 1,3
 300 :             CSIG(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 301 :             CEPS(IPJP,IJ) = 0.
 302 :           END DO
 303 :           DO IPJP = 4,6
 304 :             CSIG(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 305 :      &                    + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 306 :             CEPS(IPJP,IJ) = 0.
 307 :           END DO
 308 :         ELSE
 309 :           CSIEP0(3) = DEPST(3)/DTI
 310 :           IJ = 3
 311 :           DO IPJP = 1,3
 312 :             CSIG(IPJP,IJ) = 0.
 313 :             CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 314 :           END DO
 315 :           DO IPJP = 4,6
 316 :             CSIG(IPJP,IJ) = 0.
 317 :             CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 318 :      &                    + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 319 :           END DO
 320 :         END IF
 321 :         CSIEP0(1) = DEPST(1)/DTI
 322 :         CSIEP0(2) = DEPST(2)/DTI
 323 :         CSIEP0(4) = DEPST(4)/FEPSIJ/DTI
 324 :         CSIEP0(5) = 0.
 325 :         CSIEP0(6) = 0.
 326 :         DO IJ = 1,2
 327 :           DO IPJP = 1,3
 328 :             CSIG(IPJP,IJ) = 0.
 329 :             CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 330 :           END DO
 331 :           DO IPJP = 4,6
 332 :             CSIG(IPJP,IJ) = 0.
 333 :             CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 334 :      &                    + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 335 :           END DO
 336 :         END DO
 337 :         IJ = 4
 338 :         DO IPJP = 1,3
 339 :           CSIG(IPJP,IJ) = 0.
 340 :           CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 341 :         END DO
 342 :         DO IPJP = 4,6
 343 :           CSIG(IPJP,IJ) = 0.
 344 :           CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 345 :      &                  + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 346 :         END DO
 347 :         DO IJ = 5,6
 348 :           DO IPJP = 1,3
 349 :             CSIG(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 350 :             CEPS(IPJP,IJ) = 0.
 351 :           END DO
 352 :           DO IPJP = 4,6
 353 :             CSIG(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 354 :      &                    + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 355 :             CEPS(IPJP,IJ) = 0.
 356 :           END DO
 357 :         END DO
 358 :       ELSE IF ((IFOURB.GE.3).AND.(IFOURB.LE.14)) THEN
 359 :         IF ((IFOURB.EQ.5).OR.(IFOURB.EQ.10).OR.(IFOURB.EQ.13)) THEN
 360 :           CSIEP0(2) = 0.
 361 :           CSIEP0(3) = DEPST(3)/DTI
 362 :           IJ = 2
 363 :           DO IPJP = 1,3
 364 :             CSIG(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 365 :             CEPS(IPJP,IJ) = 0.
 366 :           END DO
 367 :           DO IPJP = 4,6
 368 :             CSIG(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 369 :      &                    + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 370 :             CEPS(IPJP,IJ) = 0.
 371 :           END DO
 372 :           IJ = 3
 373 :           DO IPJP = 1,3
 374 :             CSIG(IPJP,IJ) = 0.
 375 :             CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 376 :           END DO
 377 :           DO IPJP = 4,6
 378 :             CSIG(IPJP,IJ) = 0.
 379 :             CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 380 :      &                    + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 381 :           END DO
 382 :         ELSE IF ((IFOURB.EQ.4).OR.(IFOURB.EQ.8)) THEN
 383 :           CSIEP0(2) = DEPST(2)/DTI
 384 :           CSIEP0(3) = 0.
 385 :           IJ = 2
 386 :           DO IPJP = 1,3
 387 :             CSIG(IPJP,IJ) = 0.
 388 :             CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 389 :           END DO
 390 :           DO IPJP = 4,6
 391 :             CSIG(IPJP,IJ) = 0.
 392 :             CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 393 :      &                    + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 394 :           END DO
 395 :           IJ = 3
 396 :           DO IPJP = 1,3
 397 :             CSIG(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 398 :             CEPS(IPJP,IJ) = 0.
 399 :           END DO
 400 :           DO IPJP = 4,6
 401 :             CSIG(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 402 :      &                    + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 403 :             CEPS(IPJP,IJ) = 0.
 404 :           END DO
 405 :         ELSE IF (IFOURB.EQ.6) THEN
 406 :           CSIEP0(2) = 0.
 407 :           CSIEP0(3) = 0.
 408 :           DO IJ = 2,3
 409 :             DO IPJP = 1,3
 410 :               CSIG(IPJP,IJ)=PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 411 :               CEPS(IPJP,IJ)=0.
 412 :             END DO
 413 :             DO IPJP = 4,6
 414 :               CSIG(IPJP,IJ)= PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 415 :      &                     + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 416 :               CEPS(IPJP,IJ) = 0.
 417 :             END DO
 418 :           END DO
 419 :         ELSE
 420 :           CSIEP0(2) = DEPST(2)/DTI
 421 :           CSIEP0(3) = DEPST(3)/DTI
 422 :           DO IJ = 2,3
 423 :             DO IPJP = 1,3
 424 :               CSIG(IPJP,IJ)= 0.
 425 :               CEPS(IPJP,IJ)= PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 426 :             END DO
 427 :             DO IPJP = 4,6
 428 :               CSIG(IPJP,IJ)= 0.
 429 :               CEPS(IPJP,IJ)= PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 430 :      &                     + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 431 :             END DO
 432 :           END DO
 433 :         END IF
 434 :         CSIEP0(1) = DEPST(1)/DTI
 435 :         CSIEP0(4) = 0.
 436 :         CSIEP0(5) = 0.
 437 :         CSIEP0(6) = 0.
 438 :         IJ = 1
 439 :         DO IPJP = 1,3
 440 :           CSIG(IPJP,IJ) = 0.
 441 :           CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 442 :         END DO
 443 :         DO IPJP = 4,6
 444 :           CSIG(IPJP,IJ) = 0.
 445 :           CEPS(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 446 :      &                  + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 447 :         END DO
 448 :         DO IJ = 4,6
 449 :           DO IPJP = 1,3
 450 :             CSIG(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 451 :             CEPS(IPJP,IJ) = 0.
 452 :           END DO
 453 :           DO IPJP = 4,6
 454 :             CSIG(IPJP,IJ) = PINV(IC(IJ),IC(IPJP))*PINV(JC(IJ),JC(IPJP))
 455 :      &                    + PINV(IC(IJ),JC(IPJP))*PINV(JC(IJ),IC(IPJP))
 456 :             CEPS(IPJP,IJ) = 0.
 457 :           END DO
 458 :         END DO
 459 :       END IF
 460 : C     ------------------------------------------------------------------
 461 : C     Recuperation des variables internes au debut du pas de temps
 462 : C
 463 :       IVAR = NIJ*(3+NDVPMA)
 464 :       DO IJ = 1,NIJ
 465 :         EPSTH(IJ) = VAR0(IJ)
 466 :         EPSEL(IJ) = VAR0(NIJ+IJ)
 467 :         EPSCR(IJ) = VAR0(IVAR+IJ)
 468 :       END DO
 469 :       IVAR = NIJ*(4+NDVPMA)+1
 470 :       JVAR = IVAR+NDVPMA+1
 471 :       DO IDP = 1-NDPI,NDVP
 472 :         KVAR = NIJ*(2+IDP)
 473 :         DO IJ = 1,NIJ
 474 :           EPSP(IJ,IDP) = VAR0(KVAR+IJ)
 475 :         END DO
 476 :         EPSE(IDP) = VAR0(IVAR+IDP)
 477 :         EPSEQ(IDP) = VAR0(JVAR+IDP)
 478 :       END DO
 479 :       IVAR = NIJ*(3+NDVPMA)+2*(1+NDVPMA)
 480 :       DO IXX = 1,NXX
 481 :         JVAR = IVAR+NIJ*IXX
 482 :         DO IJ = 1,NIJ
 483 :           XX(IJ,IXX) = VAR0(JVAR+IJ)
 484 :         END DO
 485 :       END DO
 486 :       IFVAR = NIJ*(4+NDVPMA)+2*(1+NDVPMA)+NIJ*NXXMAX
 487 :       FIT = VAR0(IFVAR+1)
 488 :       PSI = VAR0(IFVAR+2)
 489 :       DTA = VAR0(IFVAR+3)
 490 :       SEQA0 = VAR0(IFVAR+4)
 491 :       RRA0 = VAR0(IFVAR+5)
 492 :       VEEA0 = VAR0(IFVAR+6)
 493 :       KPLAST = nint(VAR0(IFVAR+7))
 494 : C     ------------------------------------------------------------------
 495 : C     Changement eventuel de base pour deformations de toutes natures
 496 : C     et contraintes internes
 497 : C
 498 :       IF (IFOURB.EQ.2) THEN
 499 :         ICBASE = nint(XMAT(18))
 500 :       ELSE IF ((IFOURB.GE.-3).AND.(IFOURB.LE.0)) THEN
 501 :         ICBASE = nint(XMAT(12))
 502 :       ELSE IF ((IFOURB.GE.3).AND.(IFOURB.LE.14)) THEN
 503 :         ICBASE = nint(XMAT(9))
 504 :       END IF
 505 :       IF (ICBASE.GE.1) THEN
 506 :         VECT(1,1) = EPSTH(1)
 507 :         VECT(2,2) = EPSTH(2)
 508 :         VECT(3,3) = EPSTH(3)
 509 :         VECT(1,2) = EPSTH(4)/FEPSIJ
 510 :         VECT(2,1) = VECT(1,2)
 511 :         VECT(1,3) = EPSTH(5)/FEPSIJ
 512 :         VECT(3,1) = VECT(1,3)
 513 :         VECT(2,3) = EPSTH(6)/FEPSIJ
 514 :         VECT(3,2) = VECT(2,3)
 514 :         CALL PRODMA(VECT,PBPO,3,3,3, PROMAT)
 514 :         CALL PRODMA(PINV,PROMAT,3,3,3, VECTP)
 515 :         EPSTH(1) = VECTP(1,1)
 516 :         EPSTH(2) = VECTP(2,2)
 517 :         EPSTH(3) = VECTP(3,3)
 518 :         EPSTH(4) = VECTP(1,2)
 519 :         EPSTH(5) = VECTP(1,3)
 520 :         EPSTH(6) = VECTP(2,3)
 521 :         VECT(1,1) = EPSEL(1)
 522 :         VECT(2,2) = EPSEL(2)
 523 :         VECT(3,3) = EPSEL(3)
 524 :         VECT(1,2) = EPSEL(4)/FEPSIJ
 525 :         VECT(2,1) = VECT(1,2)
 526 :         VECT(1,3) = EPSEL(5)/FEPSIJ
 527 :         VECT(3,1) = VECT(1,3)
 528 :         VECT(2,3) = EPSEL(6)/FEPSIJ
 529 :         VECT(3,2) = VECT(2,3)
 529 :         CALL PRODMA(VECT,PBPO,3,3,3, PROMAT)
 529 :         CALL PRODMA(PINV,PROMAT,3,3,3, VECTP)
 530 :         EPSEL(1) = VECTP(1,1)
 531 :         EPSEL(2) = VECTP(2,2)
 532 :         EPSEL(3) = VECTP(3,3)
 533 :         EPSEL(4) = VECTP(1,2)
 534 :         EPSEL(5) = VECTP(1,3)
 535 :         EPSEL(6) = VECTP(2,3)
 536 :         VECT(1,1) = EPSCR(1)
 537 :         VECT(2,2) = EPSCR(2)
 538 :         VECT(3,3) = EPSCR(3)
 539 :         VECT(1,2) = EPSCR(4)/FEPSIJ
 540 :         VECT(2,1) = VECT(1,2)
 541 :         VECT(1,3) = EPSCR(5)/FEPSIJ
 542 :         VECT(3,1) = VECT(1,3)
 543 :         VECT(2,3) = EPSCR(6)/FEPSIJ
 544 :         VECT(3,2) = VECT(2,3)
 544 :         CALL PRODMA(VECT,PBPO,3,3,3, PROMAT)
 544 :         CALL PRODMA(PINV,PROMAT,3,3,3, VECTP)
 545 :         EPSCR(1) = VECTP(1,1)
 546 :         EPSCR(2) = VECTP(2,2)
 547 :         EPSCR(3) = VECTP(3,3)
 548 :         EPSCR(4) = VECTP(1,2)
 549 :         EPSCR(5) = VECTP(1,3)
 550 :         EPSCR(6) = VECTP(2,3)
 551 :         DO IDP = 1-NDPI,NDVP
 552 :           VECT(1,1) = EPSP(1,IDP)
 553 :           VECT(2,2) = EPSP(2,IDP)
 554 :           VECT(3,3) = EPSP(3,IDP)
 555 :           VECT(1,2) = EPSP(4,IDP)/FEPSIJ
 556 :           VECT(2,1) = VECT(1,2)
 557 :           VECT(1,3) = EPSP(5,IDP)/FEPSIJ
 558 :           VECT(3,1) = VECT(1,3)
 559 :           VECT(2,3) = EPSP(6,IDP)/FEPSIJ
 560 :           VECT(3,2) = VECT(2,3)
 560 :           CALL PRODMA(VECT,PBPO,3,3,3, PROMAT)
 560 :           CALL PRODMA(PINV,PROMAT,3,3,3, VECTP)
 561 :           EPSP(1,IDP) = VECTP(1,1)
 562 :           EPSP(2,IDP) = VECTP(2,2)
 563 :           EPSP(3,IDP) = VECTP(3,3)
 564 :           EPSP(4,IDP) = VECTP(1,2)
 565 :           EPSP(5,IDP) = VECTP(1,3)
 566 :           EPSP(6,IDP) = VECTP(2,3)
 567 :         END DO
 568 :         IF (ICBASE.EQ.2) THEN
 569 :           DO IXX = 1,NXX
 570 :             VECT(1,1) = XX(1,IXX)
 571 :             VECT(2,2) = XX(2,IXX)
 572 :             VECT(3,3) = XX(3,IXX)
 573 :             VECT(1,2) = XX(4,IXX)
 574 :             VECT(2,1) = XX(4,IXX)
 575 :             VECT(1,3) = XX(5,IXX)
 576 :             VECT(3,1) = XX(5,IXX)
 577 :             VECT(2,3) = XX(6,IXX)
 578 :             VECT(3,2) = XX(6,IXX)
 578 :             CALL PRODMA(VECT,PBPO,3,3,3, PROMAT)
 578 :             CALL PRODMA(PINV,PROMAT,3,3,3, VECTP)
 579 :             XX(1,IXX) = VECTP(1,1)
 580 :             XX(2,IXX) = VECTP(2,2)
 581 :             XX(3,IXX) = VECTP(3,3)
 582 :             XX(4,IXX) = VECTP(1,2)
 583 :             XX(5,IXX) = VECTP(1,3)
 584 :             XX(6,IXX) = VECTP(2,3)
 585 :           END DO
 586 :         END IF
 587 :       END IF
 588 : C     ------------------------------------------------------------------
 589 : C     Variables et parametres divers(es)
 590 : C
 591 :       DO IJ = 1,NIJ
 592 :         EPS(IJ) = EPSTH(IJ)+EPSEL(IJ)+EPSCR(IJ)
 593 :         DO IDP = 1-NDPI,NDVP
 594 :           EPS(IJ) = EPS(IJ)+EPSP(IJ,IDP)
 595 :         END DO
 596 :       END DO
 597 :       DTMI = 0.
 598 :       DTMAX = DTI
 599 :       TMAX = 1.D+4*DTI
 600 :       NPAS = 0
 601 :       NCHPL = 0
 602 :       EPSMAX = 10.
 603 :       IES = 0
 604 :       IUM = 8
 605 :       IUI = IUM-2
 606 :       ISTOP = 0
 607 : C     ------------------------------------------------------------------
 608 : C     Passage de la base locale d'orthotropie CAST3M a celle de MISTRAL
 609 : C     pour les coefficients d'elasticite
 610 : C
 611 :       PYG1 = XMAT(1)
 612 :       PYG2 = XMAT(2)
 613 :       IF (IFOURB.EQ.-2) THEN
 614 :         PYG3 = XMAT(7)
 615 :         PNU12 = XMAT(3)
 616 :         PNU23 = XMAT(8)
 617 :         PNU13 = XMAT(9)
 618 :         PG12 = XMAT(4)
 619 :         PG23 = PG12
 620 :         PG13 = PG12
 621 :       ELSE
 622 :         PYG3 = XMAT(3)
 623 :         PNU12 = XMAT(4)
 624 :         PNU23 = XMAT(5)
 625 :         PNU13 = XMAT(6)
 626 :         IF (IFOURB.EQ.2) THEN
 627 :           PG12 = XMAT(7)
 628 :           PG23 = XMAT(8)
 629 :           PG13 = XMAT(9)
 630 :         ELSE IF ((IFOURB.GE.-3).AND.(IFOURB.LE.0)) THEN
 631 :           PG12 = XMAT(7)
 632 :           PG23 = PG12
 633 :           PG13 = PG12
 634 :         ELSE IF ((IFOURB.GE.3).AND.(IFOURB.LE.14)) THEN
 635 :           PG12 = 0.
 636 :           PG23 = 0.
 637 :           PG13 = 0.
 638 :         END IF
 639 :       END IF
 640 : C
 641 :       IP(3) = 6-IP(1)-IP(2)
 642 :       IF (IP(1).EQ.1) THEN
 643 : C Cas 1.1 : IP(1)=1 , IP(2)=2 , IP(3)=3
 644 :         IF (IP(2).EQ.2) THEN
 645 :           E10 = PYG1
 646 :           E20 = PYG2
 647 :           E30 = PYG3
 648 :           NU120 = PNU12
 649 :           NU230 = PNU23
 650 :           NU310 = PNU13*PYG3/PYG1
 651 :           MU120 = PG12
 652 :           MU130 = PG13
 653 :           MU230 = PG23
 654 : C Cas 1.2 : IP(1)=1 , IP(2)=3 , IP(3)=2
 655 :         ELSE
 656 :           E10 = PYG1
 657 :           E20 = PYG3
 658 :           E30 = PYG2
 659 :           NU120 = PNU13
 660 :           NU230 = PNU23*PYG3/PYG2
 661 :           NU310 = PNU12*PYG2/PYG1
 662 :           MU120 = PG13
 663 :           MU130 = PG12
 664 :           MU230 = PG23
 665 :         END IF
 666 :       ELSE IF (IP(1).EQ.2) THEN
 667 : C Cas 2.1 : IP(1)=2 , IP(2)=1 , IP(3)=3
 668 :         IF (IP(2).EQ.1) THEN
 669 :           E10 = PYG2
 670 :           E20 = PYG1
 671 :           E30 = PYG3
 672 :           NU120 = PNU12*PYG2/PYG1
 673 :           NU230 = PNU13
 674 :           NU310 = PNU23*PYG3/PYG2
 675 :           MU120 = PG12
 676 :           MU130 = PG23
 677 :           MU230 = PG13
 678 : C Cas 2.2 : IP(1)=2 , IP(2)=3 , IP(3)=1
 679 :         ELSE
 680 :           E10 = PYG2
 681 :           E20 = PYG3
 682 :           E30 = PYG1
 683 :           NU120 = PNU23
 684 :           NU230 = PNU13*PYG3/PYG1
 685 :           NU310 = PNU12
 686 :           MU120 = PG23
 687 :           MU130 = PG12
 688 :           MU230 = PG13
 689 :         END IF
 690 :       ELSE IF (IP(1).EQ.3) THEN
 691 : C Cas 3.1 : IP(1)=3 , IP(2)=1 , IP(3)=2
 692 :        IF (IP(2).EQ.1) THEN
 693 :         E10 = PYG3
 694 :         E20 = PYG1
 695 :         E30 = PYG2
 696 :         NU120 = PNU13*PYG3/PYG1
 697 :         NU230 = PNU12
 698 :         NU310 = PNU23
 699 :         MU120 = PG13
 700 :         MU130 = PG23
 701 :         MU230 = PG12
 702 : C Cas 3.2 : IP(1)=3 , IP(2)=2 , IP(3)=1
 703 :        ELSE
 704 :         E10 = PYG3
 705 :         E20 = PYG2
 706 :         E30 = PYG1
 707 :         NU120 = PNU23*PYG3/PYG2
 708 :         NU230 = PNU12*PYG2/PYG1
 709 :         NU310 = PNU13
 710 :         MU120 = PG23
 711 :         MU130 = PG13
 712 :         MU230 = PG12
 713 :        END IF
 714 :       END IF
 715 :       PCOEL( 1) = 0
 716 :       PCOEL( 2) = E10
 717 :       PCOEL( 3) = 0.
 718 :       PCOEL( 4) = E20
 719 :       PCOEL( 5) = 0.
 720 :       PCOEL( 6) = E30
 721 :       PCOEL( 7) = 0.
 722 :       PCOEL( 8) = NU120
 723 :       PCOEL( 9) = 0.
 724 :       PCOEL(10) = NU230
 725 :       PCOEL(11) = 0.
 726 :       PCOEL(12) = NU310
 727 :       PCOEL(13) = 0.
 728 :       PCOEL(14) = MU120
 729 :       PCOEL(15) = 0.
 730 :       PCOEL(16) = MU130
 731 :       PCOEL(17) = 0.
 732 :       PCOEL(18) = MU230
 733 :       PCOEL(19) = 0.
 734 : C     ------------------------------------------------------------------
 735 : C     Appel du module MISTRAL pour calculer l'evolution durant DTI = DT
 736 : C     (ou DTI = 1.E-20 si DT = 0.)
 737 : C
 737 :       CALL MISTR1 (T, TT,FI,FIT, SIG,
 738 :      &             EPS,EPSTH,EPSEL,EPSP,EPSCR,EPSE,EPSEQ,XX,PSI,
 739 :      &             DTA,SEQA0,RRA0,VEEA0, KPLAST,
 740 :      &             DTI, TTP,FIP, CSIG,CEPS,CSIEP0,
 741 :      &             PDILT,PCOEL, NDPI,NDVP,NXX,NPSI,
 742 :      &             PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, PCROI,
 743 :      &             NPINCR,PINCR, DTMI,DTMAX,TMAX,
 744 :      &             NPAS,NCHPL, EPSMAX, IES,FICH,IUM, ISTOP,
 745 :      &             DELTT,DELFI,DELFIT, DELSIG,DELEPS,DELETH,
 746 :      &             DELEEL,DELEP,DELECR,DELEE,DELEEQ,DELXX,DELPSI)
 747 :       IF (ISTOP.NE.0) THEN
 748 :        STOP
 749 :       END IF
 750 : C
 751 : C     Vitesses de deformations a la fin du pas de temps
 752 : C
 752 :       CALL MISTR0 (TT,TTP,FI,FIT, SIG, XX,EPSE,EPSEQ,PSI,KPLAST,
 753 :      &             CSIG,CEPS,CSIEP0, IUI,
 754 :      &             PDILT,PCOEL, NDPI,NDVP,NXX,
 755 :      &             PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, PCROI,
 756 :      &             SEQ,RR,
 757 :      &             SIGP, VEPS,VEPSTH,VEPSEL,VEPSP,VEPSCR,
 758 :      &             VEPSE,EPSEQP,XXP,PSIP,
 759 :      &             ISTOP)
 760 :       IF (ISTOP.NE.0) THEN
 761 :        STOP
 762 :       END IF
 763 :       DO IJ = 1,NIJ
 764 :         VEPSIN(IJ) = 0.
 765 :         DO IDP = 1-NDPI,NDVP
 766 :           VEPSIN(IJ) = VEPSIN(IJ)+VEPSP(IJ,IDP)
 767 :         END DO
 768 :       END DO
 769 : C     ------------------------------------------------------------------
 770 : C     Changement de base inverse pour contraintes a fin de pas de temps
 771 : C
 772 :       VECTP(1,1) = SIG(1)
 773 :       VECTP(2,2) = SIG(2)
 774 :       VECTP(3,3) = SIG(3)
 775 :       VECTP(1,2) = SIG(4)
 776 :       VECTP(2,1) = SIG(4)
 777 :       VECTP(1,3) = SIG(5)
 778 :       VECTP(3,1) = SIG(5)
 779 :       VECTP(2,3) = SIG(6)
 780 :       VECTP(3,2) = SIG(6)
 780 :       CALL PRODMA(VECTP,PINV,3,3,3, PROMAT)
 780 :       CALL PRODMA(PBPO,PROMAT,3,3,3, VECT)
 781 :       SIGF(1) = VECT(1,1)
 782 :       SIGF(2) = VECT(2,2)
 783 :       SIGF(3) = VECT(3,3)
 784 :       IF (IFOURB.EQ.2) THEN
 785 :         SIGF(4) = VECT(1,2)
 786 :         SIGF(5) = VECT(1,3)
 787 :         SIGF(6) = VECT(2,3)
 788 :       ELSE IF ((IFOURB.GE.-3).AND.(IFOURB.LE.0)) THEN
 789 :         SIGF(4) = VECT(1,2)
 790 :       END IF
 791 : C     ------------------------------------------------------------------
 792 : C     Changement eventuel de base pour deformations de toutes natures
 793 : C     et contraintes internes a fin de pas de temps
 794 : C
 795 :       IF (ICBASE.GE.1) THEN
 796 :         VECTP(1,1) = EPSTH(1)
 797 :         VECTP(2,2) = EPSTH(2)
 798 :         VECTP(3,3) = EPSTH(3)
 799 :         VECTP(1,2) = EPSTH(4)
 800 :         VECTP(2,1) = EPSTH(4)
 801 :         VECTP(1,3) = EPSTH(5)
 802 :         VECTP(3,1) = EPSTH(5)
 803 :         VECTP(2,3) = EPSTH(6)
 804 :         VECTP(3,2) = EPSTH(6)
 804 :         CALL PRODMA(VECTP,PINV,3,3,3, PROMAT)
 804 :         CALL PRODMA(PBPO,PROMAT,3,3,3, VECT)
 805 :         EPSTH(1) = VECT(1,1)
 806 :         EPSTH(2) = VECT(2,2)
 807 :         EPSTH(3) = VECT(3,3)
 808 :         EPSTH(4) = VECT(1,2)*FEPSIJ
 809 :         EPSTH(5) = VECT(1,3)*FEPSIJ
 810 :         EPSTH(6) = VECT(2,3)*FEPSIJ
 811 :         VECTP(1,1) = EPSEL(1)
 812 :         VECTP(2,2) = EPSEL(2)
 813 :         VECTP(3,3) = EPSEL(3)
 814 :         VECTP(1,2) = EPSEL(4)
 815 :         VECTP(2,1) = EPSEL(4)
 816 :         VECTP(1,3) = EPSEL(5)
 817 :         VECTP(3,1) = EPSEL(5)
 818 :         VECTP(2,3) = EPSEL(6)
 819 :         VECTP(3,2) = EPSEL(6)
 819 :         CALL PRODMA(VECTP,PINV,3,3,3, PROMAT)
 819 :         CALL PRODMA(PBPO,PROMAT,3,3,3, VECT)
 820 :         EPSEL(1) = VECT(1,1)
 821 :         EPSEL(2) = VECT(2,2)
 822 :         EPSEL(3) = VECT(3,3)
 823 :         EPSEL(4) = VECT(1,2)*FEPSIJ
 824 :         EPSEL(5) = VECT(1,3)*FEPSIJ
 825 :         EPSEL(6) = VECT(2,3)*FEPSIJ
 826 :         VECTP(1,1) = EPSCR(1)
 827 :         VECTP(2,2) = EPSCR(2)
 828 :         VECTP(3,3) = EPSCR(3)
 829 :         VECTP(1,2) = EPSCR(4)
 830 :         VECTP(2,1) = EPSCR(4)
 831 :         VECTP(1,3) = EPSCR(5)
 832 :         VECTP(3,1) = EPSCR(5)
 833 :         VECTP(2,3) = EPSCR(6)
 834 :         VECTP(3,2) = EPSCR(6)
 834 :         CALL PRODMA(VECTP,PINV,3,3,3, PROMAT)
 834 :         CALL PRODMA(PBPO,PROMAT,3,3,3, VECT)
 835 :         EPSCR(1) = VECT(1,1)
 836 :         EPSCR(2) = VECT(2,2)
 837 :         EPSCR(3) = VECT(3,3)
 838 :         EPSCR(4) = VECT(1,2)*FEPSIJ
 839 :         EPSCR(5) = VECT(1,3)*FEPSIJ
 840 :         EPSCR(6) = VECT(2,3)*FEPSIJ
 841 :         DO IDP = 1-NDPI,NDVP
 842 :           VECTP(1,1) = EPSP(1,IDP)
 843 :           VECTP(2,2) = EPSP(2,IDP)
 844 :           VECTP(3,3) = EPSP(3,IDP)
 845 :           VECTP(1,2) = EPSP(4,IDP)
 846 :           VECTP(2,1) = EPSP(4,IDP)
 847 :           VECTP(1,3) = EPSP(5,IDP)
 848 :           VECTP(3,1) = EPSP(5,IDP)
 849 :           VECTP(2,3) = EPSP(6,IDP)
 850 :           VECTP(3,2) = EPSP(6,IDP)
 850 :           CALL PRODMA(VECTP,PINV,3,3,3, PROMAT)
 850 :           CALL PRODMA(PBPO,PROMAT,3,3,3, VECT)
 851 :           EPSP(1,IDP) = VECT(1,1)
 852 :           EPSP(2,IDP) = VECT(2,2)
 853 :           EPSP(3,IDP) = VECT(3,3)
 854 :           EPSP(4,IDP) = VECT(1,2)*FEPSIJ
 855 :           EPSP(5,IDP) = VECT(1,3)*FEPSIJ
 856 :           EPSP(6,IDP) = VECT(2,3)*FEPSIJ
 857 :         END DO
 858 :         VECTP(1,1) = VEPS(1)
 859 :         VECTP(2,2) = VEPS(2)
 860 :         VECTP(3,3) = VEPS(3)
 861 :         VECTP(1,2) = VEPS(4)
 862 :         VECTP(2,1) = VEPS(4)
 863 :         VECTP(1,3) = VEPS(5)
 864 :         VECTP(3,1) = VEPS(5)
 865 :         VECTP(2,3) = VEPS(6)
 866 :         VECTP(3,2) = VEPS(6)
 866 :         CALL PRODMA(VECTP,PINV,3,3,3, PROMAT)
 866 :         CALL PRODMA(PBPO,PROMAT,3,3,3, VECT)
 867 :         VEPS(1) = VECT(1,1)
 868 :         VEPS(2) = VECT(2,2)
 869 :         VEPS(3) = VECT(3,3)
 870 :         VEPS(4) = VECT(1,2)*FEPSIJ
 871 :         VEPS(5) = VECT(1,3)*FEPSIJ
 872 :         VEPS(6) = VECT(2,3)*FEPSIJ
 873 :         IF ((NDPI+NDVP).GT.0) THEN
 874 :           VECTP(1,1) = VEPSIN(1)
 875 :           VECTP(2,2) = VEPSIN(2)
 876 :           VECTP(3,3) = VEPSIN(3)
 877 :           VECTP(1,2) = VEPSIN(4)
 878 :           VECTP(2,1) = VEPSIN(4)
 879 :           VECTP(1,3) = VEPSIN(5)
 880 :           VECTP(3,1) = VEPSIN(5)
 881 :           VECTP(2,3) = VEPSIN(6)
 882 :           VECTP(3,2) = VEPSIN(6)
 882 :           CALL PRODMA(VECTP,PINV,3,3,3, PROMAT)
 882 :           CALL PRODMA(PBPO,PROMAT,3,3,3, VECT)
 883 :           VEPSIN(1) = VECT(1,1)
 884 :           VEPSIN(2) = VECT(2,2)
 885 :           VEPSIN(3) = VECT(3,3)
 886 :           VEPSIN(4) = VECT(1,2)*FEPSIJ
 887 :           VEPSIN(5) = VECT(1,3)*FEPSIJ
 888 :           VEPSIN(6) = VECT(2,3)*FEPSIJ
 889 :         END IF
 890 :         IF (ICBASE.EQ.2) THEN
 891 :           DO IXX = 1,NXX
 892 :             VECTP(1,1) = XX(1,IXX)
 893 :             VECTP(2,2) = XX(2,IXX)
 894 :             VECTP(3,3) = XX(3,IXX)
 895 :             VECTP(1,2) = XX(4,IXX)
 896 :             VECTP(2,1) = XX(4,IXX)
 897 :             VECTP(1,3) = XX(5,IXX)
 898 :             VECTP(3,1) = XX(5,IXX)
 899 :             VECTP(2,3) = XX(6,IXX)
 900 :             VECTP(3,2) = XX(6,IXX)
 900 :             CALL PRODMA(VECTP,PINV,3,3,3, PROMAT)
 900 :             CALL PRODMA(PBPO,PROMAT,3,3,3, VECT)
 901 :             XX(1,IXX) = VECT(1,1)
 902 :             XX(2,IXX) = VECT(2,2)
 903 :             XX(3,IXX) = VECT(3,3)
 904 :             XX(4,IXX) = VECT(1,2)
 905 :             XX(5,IXX) = VECT(1,3)
 906 :             XX(6,IXX) = VECT(2,3)
 907 :           END DO
 908 :         END IF
 909 :       END IF
 910 : C     ------------------------------------------------------------------
 911 : C     Stockage des variables internes a la fin du pas de temps
 912 : C
 913 :       IVAR = NIJ*(3+NDVPMA)
 914 :       DO IJ = 1,NIJ
 915 :         VARF(IJ) = EPSTH(IJ)
 916 :         VARF(NIJ+IJ) = EPSEL(IJ)
 917 :         VARF(IVAR+IJ) = EPSCR(IJ)
 918 :       END DO
 919 :       IVAR = NIJ*(4+NDVPMA)+1
 920 :       JVAR = IVAR+NDVPMA+1
 921 :       LVAR = IFVAR+8
 922 :       VARF(LVAR) = 0.
 923 :       DO IDP = 1-NDPI,NDVP
 924 :         KVAR = NIJ*(2+IDP)
 925 :         DO IJ = 1,NIJ
 926 :           VARF(KVAR+IJ) = EPSP(IJ,IDP)
 927 :         END DO
 928 :         VARF(IVAR+IDP) = EPSE(IDP)
 929 :         VARF(JVAR+IDP) = EPSEQ(IDP)
 930 :         VARF(LVAR) = VARF(LVAR) + EPSE(IDP)
 931 :       END DO
 932 :       IVAR = NIJ*(3+NDVPMA)+2*(1+NDVPMA)
 933 :       DO IXX = 1,NXX
 934 :         JVAR = IVAR+NIJ*IXX
 935 :         DO IJ = 1,NIJ
 936 :           VARF(JVAR+IJ) = XX(IJ,IXX)
 937 :         END DO
 938 :       END DO
 939 :       VARF(IFVAR+1) = FIT
 940 :       VARF(IFVAR+2) = PSI
 941 :         IF (DT.NE.0.D0) THEN
 942 :       VARF(IFVAR+3) = DTA
 943 :       VARF(IFVAR+4) = SEQA0
 944 :       VARF(IFVAR+5) = RRA0
 945 :       VARF(IFVAR+6) = VEEA0
 946 :       VARF(IFVAR+7) = KPLAST
 947 :         ENDIF
 948 :       IVAR = LVAR+NIJ
 949 :       DO IJ = 1,NIJ
 950 :         VARF(LVAR+IJ) = VEPS(IJ)
 951 :         VARF(IVAR+IJ) = VEPSIN(IJ)
 952 :       END DO
 953 :       IVAR = IVAR+NIJ+1
 954 :       DO IDP = 1-NDPI,NDVP
 955 :         VARF(IVAR+IDP) = VEPSE(IDP)
 956 :       END DO
 957 : C     ------------------------------------------------------------------
 958 : C     Deformation inelastique = somme des deformations plastiques
 959 : C     a la fin du pas de temps
 960 : C
 961 :       IF (ICBASE.EQ.0) THEN
 962 :         VECTP(1,1) = 0.
 963 :         VECTP(2,2) = 0.
 964 :         VECTP(3,3) = 0.
 965 :         VECTP(1,2) = 0.
 966 :         VECTP(1,3) = 0.
 967 :         VECTP(2,3) = 0.
 968 :         DO IDP = 1-NDPI,NDVP
 969 :           VECTP(1,1) = VECTP(1,1) + EPSP(1,IDP)
 970 :           VECTP(2,2) = VECTP(2,2) + EPSP(2,IDP)
 971 :           VECTP(3,3) = VECTP(3,3) + EPSP(3,IDP)
 972 :           VECTP(1,2) = VECTP(1,2) + EPSP(4,IDP)
 973 :           VECTP(1,3) = VECTP(1,3) + EPSP(5,IDP)
 974 :           VECTP(2,3) = VECTP(2,3) + EPSP(6,IDP)
 975 :         END DO
 976 :         VECTP(2,1) = VECTP(1,2)
 977 :         VECTP(3,1) = VECTP(1,3)
 978 :         VECTP(3,2) = VECTP(2,3)
 978 :         CALL PRODMA(VECTP,PINV,3,3,3, PROMAT)
 978 :         CALL PRODMA(PBPO,PROMAT,3,3,3, VECT)
 979 :         EPINF(1) = VECT(1,1)
 980 :         EPINF(2) = VECT(2,2)
 981 :         EPINF(3) = VECT(3,3)
 982 :         IF (IFOURB.EQ.2) THEN
 983 :           EPINF(4) = VECT(1,2)*FEPSIJ
 984 :           EPINF(5) = VECT(1,3)*FEPSIJ
 985 :           EPINF(6) = VECT(2,3)*FEPSIJ
 986 :         ELSE IF ((IFOURB.GE.-3).AND.(IFOURB.LE.0)) THEN
 987 :           EPINF(4) = VECT(1,2)*FEPSIJ
 988 :         END IF
 989 :       ELSE
 990 :         DO IJ =1,NSTRS
 991 :           EPINF(IJ) = 0.
 992 :           DO IDP = 1-NDPI,NDVP
 993 :             EPINF(IJ) = EPINF(IJ)+EPSP(IJ,IDP)
 994 :           END DO
 995 :         END DO
 996 :       END IF
 997 : C     ------------------------------------------------------------------
 998 :       RETURN
 999 :       END
1000 : 
1001 :  
1002 :  
1003 :  
1004 :  

© Cast3M 2003 - All rights reserved.
Disclaimer