1 : C DEFMAT SOURCE PV 09/03/12 21:19:09 6325 2 : SUBROUTINE DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS, 3 : . IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2, 4 : . WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB, 5 : . XMOB,BID,BID2,KERR0) 6 : * 7 : ********************************************************* 8 : * ENTREES 9 : ********************************************************* 10 : * 11 : * NMATT : nombre de composantes matériau 12 : * NSTRS : nombre de composantes des contraintes 13 : * MFR : formulation de l'élément 14 : * INPLAS : numéro du matériau inélastique 15 : * IVAMAT : pointeur sur un segment mptval de materiau 16 : * IB : numéro de l'élément 17 : * IGAU : numéro du point de Gauss 18 : * CMATE : nom du matériau 19 : * MATE : numéro du matériau 20 : * LUNI1 : booléen pour le matériau ACIER_UNI 21 : * LUNI2 : booléen pour le matériau ACIER_UNI 22 : * TXR : cosinus directeur des axes locaux pour l'ACIER_UNI 23 : * (WTRAV) 24 : * 25 : ********************************************************* 26 : * SORTIES 27 : ********************************************************* 28 : * 29 : * SIG0 : contraintes effectives (WRK1) 30 : * EPST0 : deformations totales au debut du pas (WRK5) 31 : * XMAT : composantes matériaux (WRK0) 32 : * CMASS : élément de réduction de la masse 33 : * CRIGI : élément de réduction de la rigidité 34 : * TYMAT : type des composantes materiau (WR00) 35 : * COB : porosité (éventuelle) 36 : * BID : 37 : * BID2 : 38 : * KERR0 : indicateur d'erreur 39 : * 40 : ********************************************************* 41 : * 42 : IMPLICIT INTEGER(I-N) 43 : IMPLICIT REAL*8(A-H,O-Z) 44 : * 45 : -INC CCOPTIO 46 : -INC SMCHAML 47 : -INC SMLREEL 48 : * 49 : SEGMENT MPTVAL 50 : INTEGER IPOS(NS) ,NSOF(NS) 51 : INTEGER IVAL(NCOSOU) 52 : CHARACTER*16 TYVAL(NCOSOU) 53 : ENDSEGMENT 54 : * 55 : SEGMENT WRK0 56 : REAL*8 XMAT(NCXMAT) 57 : ENDSEGMENT 58 : * 59 : SEGMENT WR00 60 : CHARACTER*16 TYMAT(NCXMAT) 61 : REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT) 62 : ENDSEGMENT 63 : * 64 : SEGMENT WRK1 65 : REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS) 66 : REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI) 67 : REAL*8 DEFP(NSTRS),XCAR(ICARA) 68 : ENDSEGMENT 69 : * 70 : SEGMENT WRK5 71 : REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS) 72 : ENDSEGMENT 73 : * 74 : SEGMENT WTRAV 75 : REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT) 76 : REAL*8 VALCAR(NUCAR),DSIGT(NSTRS) 77 : REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK) 78 : REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM) 79 : REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK) 80 : ENDSEGMENT 81 : * 82 : DIMENSION CRIGI(12),CMASS(12) 83 : DIMENSION BID(*),BID2(*) 84 : LOGICAL LUNI1,LUNI2 85 : CHARACTER*8 CMATE 86 : * 87 : * on recupere les constantes du materiau 88 : * 89 : * 90 : * >>>>>>>>>> cas des materiaux orthotropes plastiques decouples 91 : * 92 : c mistral : 93 : IF ((INPLAS.EQ.67).OR.(INPLAS.EQ.68).OR.(INPLAS.EQ.94)) THEN 94 : c mistral. 95 : MPTVAL=IVAMAT 96 : DO IC=1,NMATT 97 : MELVAL=IVAL(IC) 98 : IAUX=MELVAL 99 : IF(IAUX.NE.0) THEN 100 : IF(TYVAL(IC)(1:8).NE.'POINTEUR') THEN 101 : IBMN=MIN(IB,VELCHE(/2)) 102 : IGMN=MIN(IGAU,VELCHE(/1)) 103 : XMAT(IC)=VELCHE(IGMN,IBMN) 104 : ELSE 105 : IBMN=MIN(IB,IELCHE(/2)) 106 : IGMN=MIN(IGAU,IELCHE(/1)) 107 : XMAT(IC)=IELCHE(IGMN,IBMN) 108 : ENDIF 109 : ELSE 110 : XMAT(IC)=0.D0 111 : IF(TYVAL(IC)(1:8).EQ.'POINTEUR') XMAT(IC)=0 112 : ENDIF 113 : END DO 114 : GOTO 1000 115 : ENDIF 116 : * 117 : * >>>>>>>>>> cas du SIC_SIC 118 : * 119 : IF (INPLAS.EQ.88) THEN 120 : MPTVAL=IVAMAT 121 : DO IC=1,NMATT 122 : MELVAL=IVAL(IC) 123 : IAUX=MELVAL 124 : IF(IAUX.NE.0) THEN 125 : IF(TYVAL(IC)(1:8).NE.'POINTEUR') THEN 126 : IBMN=MIN(IB,VELCHE(/2)) 127 : IGMN=MIN(IGAU,VELCHE(/1)) 128 : XMAT(IC)=VELCHE(IGMN,IBMN) 129 : ELSE 130 : IBMN=MIN(IB,IELCHE(/2)) 131 : IGMN=MIN(IGAU,IELCHE(/1)) 132 : XMAT(IC)=IELCHE(IGMN,IBMN) 133 : ENDIF 134 : ELSE 135 : XMAT(IC)=0.D0 136 : IF(TYVAL(IC)(1:8).EQ.'POINTEUR') XMAT(IC)=0 137 : ENDIF 138 : END DO 139 : GOTO 1000 140 : ENDIF 141 : * 142 : * cas des poutres en formulation section 143 : * 144 : IF ((MFR.EQ.7.OR.MFR.EQ.13).AND. 145 : 1 CMATE.EQ.'SECTION') THEN 146 : MPTVAL=IVAMAT 147 : DO IC=1,NMATT 148 : MELVAL=IVAL(IC) 149 : IAUX=MELVAL 150 : IF(IAUX.NE.0)THEN 151 : IBMN=MIN(IB,IELCHE(/2)) 152 : IGMN=MIN(IGAU,IELCHE(/1)) 153 : XMAT(IC)=DBLE(IELCHE(IGMN,IBMN)) 154 : IF(IC.EQ.1) IPM=IELCHE(IGMN,IBMN) 155 : IF(IC.EQ.2) IPC=IELCHE(IGMN,IBMN) 156 : ELSE 157 : XMAT(IC)=DBLE(0) 158 : ENDIF 159 : END DO 160 : IF (INPLAS.EQ.0) THEN 161 : MLREEL = NINT(XMAT(3)) 162 : IF(MLREEL.EQ.0)THEN 162 : CALL FRIGIE(IPM,IPC,CRIGI,CMASS) 163 : ELSE 164 : SEGACT, MLREEL 164 : CALL BIFLX1(PROG(1),NSTRS,CRIGI) 165 : SEGDES, MLREEL 166 : ENDIF 167 : ENDIF 168 : * 169 : * >>>>>>>>>> cas des materiaux elastiques isotropes 170 : * ou unidirectionnels 171 : ELSE IF(MATE.EQ.1.OR.MATE.EQ.4) THEN 172 : MPTVAL=IVAMAT 173 : IF(INPLAS.EQ. 9.OR.INPLAS.EQ.28.OR.INPLAS.EQ.36. 174 : & OR.INPLAS.EQ.42.OR.INPLAS.EQ.65. 175 : & OR.INPLAS.EQ.66.OR.INPLAS.EQ.74) THEN 176 : * 177 : * pour les modeles beton et ubiquitous 178 : * et ceux dont on ne remodifie pas l'ordre 179 : * 180 : DO 1105 IC=1,NMATT 181 : MELVAL=IVAL(IC) 182 : IAUX=MELVAL 183 : IF(IAUX.NE.0)THEN 184 : IF(VELCHE(/1)+VELCHE(/2).NE.0) THEN 185 : IBMN=MIN(IB,VELCHE(/2)) 186 : IGMN=MIN(IGAU,VELCHE(/1)) 187 : XMAT(IC)=VELCHE(IGMN,IBMN) 188 : ELSE IF(IELCHE(/1)+IELCHE(/2).NE.0) THEN 189 : IBMN=MIN(IB ,IELCHE(/2)) 190 : IGMN=MIN(IGAU,IELCHE(/1)) 191 : XMAT(IC)=DBLE(IELCHE(IGMN,IBMN)) 192 : ENDIF 193 : ELSE 194 : XMAT(IC)=0.D0 195 : ENDIF 196 : * print *,'defmat XMAT(',IC,')=',XMAT(IC) 197 : 1105 continue 198 : * 199 : ELSE 200 : * 201 : * pour les autres modeles : 202 : * on a les noms : e,nu,puis le reste des obligatoires 203 : * puis les facultatives qui se terminent par rho et alph 204 : * d'apres un rangement dans idmatr 205 : * dans le remplissage de xmat, on veut e,nu,rho,alph 206 : * puis la suite. d'ou ce qui suit .... 207 : * am 9/11/93 a reprendre !! 208 : * am 28/7/95 le commentaire ci dessus est FAUX si l'on a des 209 : * proprietes facultatives en plus de rho et alph 210 : * car dans ce cas les facultatives COMMENCENT par 211 : * rho et alph. a reprendre !!!!!!!! 212 : * 213 : DO 1106 IC=1,NMATT 214 : IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31 215 : + .OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN 216 : IF(IC.LE.2.OR.IC.EQ.NMATT) JC=IC 217 : IF(IC.GT.2.AND.IC.LT.NMATT-2) JC=IC+2 218 : IF(IC.EQ.NMATT-2) JC=3 219 : IF(IC.EQ.NMATT-1) JC=4 220 : C 221 : ELSEIF(MFR.EQ.53)THEN 222 : III=1 223 : IF(IC.LE.III.OR.IC.EQ.NMATT) JC=IC 224 : IF(IC.GT.III.AND.IC.LT.NMATT-2) JC=IC+2 225 : IF(IC.EQ.NMATT-2) JC=III+1 226 : IF(IC.EQ.NMATT-1) JC=III+2 227 : 228 : ELSE 229 : IF(IC.LE.2) JC=IC 230 : IF(IC.GT.2.AND.IC.LT.NMATT-1) JC=IC+2 231 : IF(IC.EQ.NMATT-1) JC=3 232 : IF(IC.EQ.NMATT) JC=4 233 : ENDIF 234 : MELVAL=IVAL(IC) 235 : IAUX=MELVAL 236 : IF(IAUX.NE.0)THEN 237 : IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN 238 : IBMN=MIN(IB,VELCHE(/2)) 239 : IGMN=MIN(IGAU,VELCHE(/1)) 240 : XMAT(JC)=VELCHE(IGMN,IBMN) 241 : TYMAT(JC)=TYVAL(IC) 242 : ELSE 243 : IBMN=MIN(IB,IELCHE(/2)) 244 : IGMN=MIN(IGAU,IELCHE(/1)) 245 : XMAT(JC)=IELCHE(IGMN,IBMN) 246 : TYMAT(JC)=TYVAL(IC) 247 : ENDIF 248 : ELSE 249 : XMAT(JC)=0.D0 250 : TYMAT(JC)='REAL*8 ' 251 : ENDIF 252 : * PRINT *,'XMAT(',JC,')=',XMAT(JC) 253 : 1106 continue 254 : * 255 : * rearrangement pour certaines lois cas elastique isotrope 256 : * 257 : IF(INPLAS.EQ.64) THEN 258 : C gurson2 259 : XSRMA=XMAT(3) 260 : XMAT(3)=XMAT(17) 261 : XMAT(17)=XMAT(4) 262 : XMAT(4)=XSRMA 263 : ENDIF 264 : C IF (INPLAS.EQ.7) THEN 265 : * chaboche 1 266 : C IF(XMAT(10).NE.0.OR.XMAT(11).NE.0)THEN 267 : C INPLAS=8 268 : C ENDIF 269 : IF (INPLAS.EQ.2) THEN 270 : IF (XMAT(6).NE.0) THEN 271 : INPLAS=27 272 : XMAT(5)=XMAT(6) 273 : ENDIF 274 : ENDIF 275 : C IF (INPLAS.EQ.12) THEN 276 : * chaboche 2 277 : C IF(XMAT(12).NE.0.OR.XMAT(13).NE.0)THEN 278 : C INPLAS=13 279 : C ENDIF 280 : IF (INPLAS.EQ.14) THEN 281 : IF(XMAT(8).NE.0.OR.XMAT(9).NE.0)THEN 282 : INPLAS=18 283 : XMAT(5)=XMAT(8) 284 : XMAT(6)=XMAT(9) 285 : ENDIF 286 : ENDIF 287 : ENDIF 288 : * 289 : * rearrangement pour certaines formulations 290 : * 291 : * milieu poreux cas elastique isotrope 292 : * 293 : IF (MFR.EQ.33) THEN 294 : IF(IFOUR.EQ.-3.OR.IFOUR.EQ.1) THEN 295 : KERR0=99 296 : GO TO 1000 297 : ENDIF 298 : COB=XMAT(5) 299 : XMOB=XMAT(6) 300 : DO 1992 IC=1,NMATT-12 301 : XMAT(4+IC)=XMAT(6+IC) 302 : 1992 continue 303 : * 304 : * calcul des contraintes effectives 305 : * 306 : DO 1993 IC=1,3 307 : IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1993 308 : SIG0(IC) =SIG0(IC) + COB* EPST0(NSTRS) 309 : 1993 continue 310 : ENDIF 311 : * 312 : * rearrangement pour les materiaux unidirectionnels 313 : * en plasticite 314 : * 315 : * ce qui suit est limité au coq2 et au dst 316 : * 317 : * on met v1x et v1y à la place de rho et alph 318 : * on met nu à 0. et on se decale ( on ignore les axes ) 319 : * 320 : * dans le cas des coq2, il faut aller chercher les contraintes 321 : * dans la direction ad-hoc. inutile pour le dst. 322 : * on se limite au cas axisymetrique ? 323 : * 324 : IF (MATE.EQ.4.AND.INPLAS.NE.0.AND.INPLAS.NE.74) THEN 325 : * ppu if(mele.ne.44.and.mele.ne.93) go to 1000 326 : XMAT(3)=XMAT(2) 327 : XMAT(2)=0.D0 328 : DO 1995 IC=4,NMATT-1 329 : XMAT(IC) = XMAT(IC+1) 330 : 1995 CONTINUE 331 : * 332 : * coq2 : on change les contraintes de repere 333 : * les variables internes sont dans le repere unidirectionnel 334 : * 335 : IF (MELE.EQ.44) THEN 336 : DO 1996 I=1,NSTRS 337 : BID(I)=SIG0(I) 338 : BID2(I)=DSIGT(I) 339 : 1996 CONTINUE 340 : * 341 : ELSEIF(LUNI1)THEN 342 : V1X=TXR(1,1)*XMAT(3)+TXR(1,2)*XMAT(4) 343 : V1Y=TXR(2,1)*XMAT(3)+TXR(2,2)*XMAT(4) 344 : XMAT(3)=V1X 345 : XMAT(4)=V1Y 346 : ELSEIF(LUNI2)THEN 347 : ELSE 348 : GOTO 1000 349 : * 350 : ENDIF 351 : ENDIF 352 : * 353 : ENDIF 354 : * 355 : * >>>>>>>>>> fin du traitement du materiau 356 : * 357 : 1000 RETURN 358 : END 359 : 360 : 361 : 362 : 363 : 364 : 365 : 366 : 367 : 368 : 369 : 370 : 371 : 372 : 373 : 374 : 375 : 376 : 377 : 378 :
© Cast3M 2003 - All rights reserved.
Disclaimer