1 : C CARMAT SOURCE CHAT 11/03/16 21:16:34 6902 2 : SUBROUTINE CARMAT(IPMODE,IPCHE1,IPMAIL,MFR,MELE,CMATE, 3 : 1 ISUP5,INFOS,CONM,IMAT,ICAR,NUMAT,NUCAR,IRET) 4 : C_______________________________________________________________________ 5 : C 6 : C Entrees: 7 : C ________ 8 : C 9 : C IPMODE Pointeur sur un IMODEL 10 : C IPCHE1 Pointeur sur un MCHAML de caracteristiques 11 : C IPMAIL Pointeur sur un maillage elementaire 12 : C MFR Formulation de l element fini 13 : C MELE Numero de l element fini 14 : C CMATE Nom du materiau 15 : C ISUP5 Critere d existence des caracteristiques 16 : C INFOS Tableau d infos 17 : C CONM Nom du maillage elementaire 18 : C 19 : C Sorties: 20 : C ________ 21 : C 22 : C IMAT = Pointeur sur un tableau de MELVAL de MATERIAU 23 : C ICAR = Pointeur sur un tableau de MELVAL de CARACTERISTIQUES 24 : C NUMAT = Nombre des composantes de materiau 25 : C NUCAR = Nombre des composantes des caract. geometriques 26 : C IRET 1 si tout OK 0 sinon 27 : C 28 : C_______________________________________________________________________ 29 : C 30 : IMPLICIT INTEGER(I-N) 31 : IMPLICIT REAL*8 (A-H,O-Z) 32 : 33 : -INC CCHAMP 34 : -INC CCOPTIO 35 : 36 : -INC SMCHAML 37 : -INC SMMODEL 38 : -INC CCGEOME 39 : 40 : SEGMENT NOTYPE 41 : CHARACTER*16 TYPE(NBTYPE) 42 : ENDSEGMENT 43 : * 44 : SEGMENT MPTVAL 45 : INTEGER IPOS(NS) ,NSOF(NS) 46 : INTEGER IVAL(NCOSOU) 47 : CHARACTER*16 TYVAL(NCOSOU) 48 : ENDSEGMENT 49 : * 50 : CHARACTER*8 CMATE 51 : CHARACTER*(NCONCH) CONM 52 : PARAMETER (NINF=3) 53 : INTEGER INFOS(NINF) 54 : LOGICAL lsupma 55 : C 56 : IRET=1 57 : IMAT=0 58 : ICAR=0 59 : MOCARA=0 60 : MOMATR=0 61 : NUMAT=0 62 : NUCAR=0 63 : NBTYPE=0 64 : IPPORE=0 65 : IF(MFR.EQ.33) IPPORE= NBNNE(NUMGEO(MELE)) 66 : C 67 : C TRAITEMENT DU MODELE 68 : C 69 : IMODEL=IPMODE 70 : lsupma=.true. 71 : * 72 : * TRAITEMENT DES CHAMPS DE MATERIAU 73 : * 74 : IF (FORMOD(1).EQ.'MECANIQUE') THEN 75 : IF (CMATE.EQ.'ISOTROPE') THEN 76 : NBROBL=2 77 : NBRFAC=0 78 : SEGINI NOMID 79 : MOMATR=NOMID 80 : IF (MFR.EQ.35) THEN 81 : LESOBL(1)='KS ' 82 : LESOBL(2)='KN ' 83 : * 84 : ELSE IF(MFR.EQ.53)THEN 85 : NBROBL=1 86 : SEGADJ,NOMID 87 : LESOBL(1)='KS ' 88 : * 89 : ELSE 90 : LESOBL(1)='YOUN' 91 : LESOBL(2)='NU ' 92 : ENDIF 93 : NMATR=NBROBL 94 : NMATF=NBRFAC 95 : ELSEIF (CMATE.EQ.'ORTHOTRO') THEN 96 : IF (MFR.EQ.3) THEN 97 : * COQUES MINCES 98 : NBROBL=6 99 : NBRFAC=0 100 : SEGINI NOMID 101 : MOMATR=NOMID 102 : LESOBL(1)='YG1 ' 103 : LESOBL(2)='YG2 ' 104 : LESOBL(3)='NU12' 105 : LESOBL(4)='G12 ' 106 : LESOBL(5)='V1X ' 107 : LESOBL(6)='V1Y ' 108 : ELSE IF (MFR.EQ.9.OR.MFR.EQ.5) THEN 109 : * COQUES AVEC CISAILLEMENT TRANSVERSE 110 : NBROBL=8 111 : NBRFAC=0 112 : SEGINI NOMID 113 : MOMATR=NOMID 114 : LESOBL(1)='YG1 ' 115 : LESOBL(2)='YG2 ' 116 : LESOBL(3)='NU12' 117 : LESOBL(4)='G12 ' 118 : LESOBL(5)='G23 ' 119 : LESOBL(6)='G13 ' 120 : LESOBL(7)='V1X ' 121 : LESOBL(8)='V1Y ' 122 : ELSE IF (MFR.EQ.1) THEN 123 : * ELEMENTS MASSIFS 124 : IF(IDIM.EQ.3)THEN 125 : * ELEMENTS 3D 126 : NBROBL=15 127 : NBRFAC=0 128 : SEGINI NOMID 129 : MOMATR=NOMID 130 : LESOBL(1)='YG1 ' 131 : LESOBL(2)='YG2 ' 132 : LESOBL(3)='YG3 ' 133 : LESOBL(4)='NU12' 134 : LESOBL(5)='NU23' 135 : LESOBL(6)='NU13' 136 : LESOBL(7)='G12 ' 137 : LESOBL(8)='G23 ' 138 : LESOBL(9)='G13 ' 139 : LESOBL(10)='V1X ' 140 : LESOBL(11)='V1Y ' 141 : LESOBL(12)='V1Z ' 142 : LESOBL(13)='V2X ' 143 : LESOBL(14)='V2Y ' 144 : LESOBL(15)='V2Z ' 145 : ELSE IF (IDIM.EQ.2) THEN 146 : IF(IFOUR.EQ.-2)THEN 147 : * CONTRAINTE PLANE 148 : NBROBL=6 149 : NBRFAC=0 150 : SEGINI NOMID 151 : MOMATR=NOMID 152 : LESOBL(1)='YG1 ' 153 : LESOBL(2)='YG2 ' 154 : LESOBL(3)='NU12' 155 : LESOBL(4)='G12 ' 156 : LESOBL(5)='V1X ' 157 : LESOBL(6)='V1Y ' 158 : ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN 159 : * DEFORMATION PLANE ,AXISYMETRIE 160 : NBROBL=9 161 : NBRFAC=0 162 : SEGINI NOMID 163 : MOMATR=NOMID 164 : LESOBL(1)='YG1 ' 165 : LESOBL(2)='YG2 ' 166 : LESOBL(3)='YG3 ' 167 : LESOBL(4)='NU12' 168 : LESOBL(5)='NU23' 169 : LESOBL(6)='NU13' 170 : LESOBL(7)='G12 ' 171 : LESOBL(8)='V1X ' 172 : LESOBL(9)='V1Y ' 173 : ELSE IF (IFOUR.EQ.1) THEN 174 : * AXISYMETRIE DE FOURIER 175 : NBROBL=11 176 : NBRFAC=0 177 : SEGINI NOMID 178 : MOMATR=NOMID 179 : LESOBL(1)='YG1 ' 180 : LESOBL(2)='YG2 ' 181 : LESOBL(3)='YG3 ' 182 : LESOBL(4)='NU12' 183 : LESOBL(5)='NU23' 184 : LESOBL(6)='NU13' 185 : LESOBL(7)='G12 ' 186 : LESOBL(8)='G23 ' 187 : LESOBL(9)='G13 ' 188 : LESOBL(10)='V1X ' 189 : LESOBL(11)='V1Y ' 190 : ENDIF 191 : ENDIF 192 : ELSE IF (MFR.EQ.35) THEN 193 : * ELEMENTS JOINTS 194 : IF (IFOUR.EQ.2) THEN 195 : NBROBL=5 196 : NBRFAC=0 197 : SEGINI NOMID 198 : MOMATR=NOMID 199 : LESOBL(1)='KS1 ' 200 : LESOBL(2)='KS2 ' 201 : LESOBL(3)='KN ' 202 : LESOBL(4)='V1X ' 203 : LESOBL(5)='V1Y ' 204 : ENDIF 205 : ENDIF 206 : NMATR=NBROBL 207 : NMATF=NBRFAC 208 : ELSEIF (CMATE.EQ.'ANISOTRO') THEN 209 : IF(MFR.EQ.1)THEN 210 : * ELEMENTS MASSIFS 211 : IF(IDIM.EQ.3)THEN 212 : * ELEMENTS 3D 213 : IF (IFOUR.EQ.2) THEN 214 : NBROBL=27 215 : NBRFAC=0 216 : SEGINI NOMID 217 : MOMATR=NOMID 218 : LESOBL(1)='D11 ' 219 : LESOBL(2)='D21 ' 220 : LESOBL(3)='D22 ' 221 : LESOBL(4)='D31 ' 222 : LESOBL(5)='D32 ' 223 : LESOBL(6)='D33 ' 224 : LESOBL(7)='D41 ' 225 : LESOBL(8)='D42 ' 226 : LESOBL(9)='D43 ' 227 : LESOBL(10)='D44 ' 228 : LESOBL(11)='D51 ' 229 : LESOBL(12)='D52 ' 230 : LESOBL(13)='D53 ' 231 : LESOBL(14)='D54 ' 232 : LESOBL(15)='D55 ' 233 : LESOBL(16)='D61 ' 234 : LESOBL(17)='D62 ' 235 : LESOBL(18)='D63 ' 236 : LESOBL(19)='D64 ' 237 : LESOBL(20)='D65 ' 238 : LESOBL(21)='D66 ' 239 : LESOBL(22)='V1X ' 240 : LESOBL(23)='V1Y ' 241 : LESOBL(24)='V1Z ' 242 : LESOBL(25)='V2X ' 243 : LESOBL(26)='V2Y ' 244 : LESOBL(27)='V2Z ' 245 : ENDIF 246 : ELSE IF (IDIM.EQ.2) THEN 247 : IF (IFOUR.EQ.-2) THEN 248 : * CONTRAINTE PLANE 249 : NBROBL=8 250 : NBRFAC=0 251 : SEGINI NOMID 252 : MOMATR=NOMID 253 : LESOBL(1)='D11 ' 254 : LESOBL(2)='D21 ' 255 : LESOBL(3)='D22 ' 256 : LESOBL(4)='D41 ' 257 : LESOBL(5)='D42 ' 258 : LESOBL(6)='D44 ' 259 : LESOBL(7)='V1X ' 260 : LESOBL(8)='V1Y ' 261 : ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN 262 : * DEFORMATION PLANE ,AXISYMETRIE 263 : NBROBL=12 264 : NBRFAC=0 265 : SEGINI NOMID 266 : MOMATR=NOMID 267 : LESOBL(1)='D11 ' 268 : LESOBL(2)='D21 ' 269 : LESOBL(3)='D22 ' 270 : LESOBL(4)='D31 ' 271 : LESOBL(5)='D32 ' 272 : LESOBL(6)='D33 ' 273 : LESOBL(7)='D41 ' 274 : LESOBL(8)='D42 ' 275 : LESOBL(9)='D43 ' 276 : LESOBL(10)='D44 ' 277 : LESOBL(11)='V1X ' 278 : LESOBL(12)='V1Y ' 279 : ELSE IF (IFOUR.EQ.1) THEN 280 : * AXISYMETRIE DE FOURIER 281 : NBROBL=15 282 : NBRFAC=0 283 : SEGINI NOMID 284 : MOMATR=NOMID 285 : LESOBL(1)='D11 ' 286 : LESOBL(2)='D21 ' 287 : LESOBL(3)='D22 ' 288 : LESOBL(4)='D31 ' 289 : LESOBL(5)='D32 ' 290 : LESOBL(6)='D33 ' 291 : LESOBL(7)='D41 ' 292 : LESOBL(8)='D42 ' 293 : LESOBL(9)='D43 ' 294 : LESOBL(10)='D44 ' 295 : LESOBL(11)='D55 ' 296 : LESOBL(12)='D65 ' 297 : LESOBL(13)='D66 ' 298 : LESOBL(14)='V1X ' 299 : LESOBL(15)='V1Y ' 300 : ENDIF 301 : ENDIF 302 : ENDIF 303 : NMATR=NBROBL 304 : NMATF=NBRFAC 305 : ELSEIF (CMATE.EQ.'UNIDIREC') THEN 306 : IF ((MFR.EQ.1.OR.MFR.EQ.31).AND.IDIM.EQ.3) THEN 307 : NBROBL=7 308 : NBRFAC=0 309 : SEGINI NOMID 310 : MOMATR=NOMID 311 : LESOBL(1)='YOUN' 312 : LESOBL(2)='V1X ' 313 : LESOBL(3)='V1Y ' 314 : LESOBL(4)='V1Z ' 315 : LESOBL(5)='V2X ' 316 : LESOBL(6)='V2Y ' 317 : LESOBL(7)='V2Z ' 318 : ELSE 319 : NBROBL=3 320 : NBRFAC=0 321 : SEGINI NOMID 322 : MOMATR=NOMID 323 : LESOBL(1)='YOUN' 324 : LESOBL(2)='V1X ' 325 : LESOBL(3)='V1Y ' 326 : ENDIF 327 : NMATR=NBROBL 328 : NMATF=NBRFAC 329 : ELSE 330 : if(lnomid(6).ne.0) then 331 : nomid=lnomid(6) 332 : segact nomid 333 : momatr=nomid 334 : nmatr=lesobl(/2) 335 : nmatf=lesfac(/2) 336 : lsupma=.false. 337 : else 338 : lsupma=.true. 338 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 339 : endif 340 : ENDIF 341 : ELSE 342 : if(lnomid(6).ne.0) then 343 : nomid=lnomid(6) 344 : segact nomid 345 : momatr=nomid 346 : nmatr=lesobl(/2) 347 : nmatf=lesfac(/2) 348 : lsupma=.false. 349 : else 350 : lsupma=.true. 350 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 351 : endif 352 : ENDIF 353 : * 354 : IF (MFR.EQ.7.AND.CMATE.EQ.'SECTION') THEN 355 : NBTYPE=3 356 : SEGINI NOTYPE 357 : TYPE(1)='POINTEURMMODEL' 358 : TYPE(2)='POINTEURMCHAML' 359 : TYPE(3)='POINTEURLISTREEL' 360 : ELSE 361 : NBTYPE=1 362 : SEGINI NOTYPE 363 : TYPE(1)='REAL*8' 364 : ENDIF 365 : MOTYPE=NOTYPE 365 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IMAT) 366 : SEGSUP NOTYPE 367 : IF (IERR.NE.0) GOTO 9990 368 : NUMAT=NMATR+NMATF 369 : * 370 : IF (MOMATR.NE.0.AND.ISUP5.EQ.1) THEN 370 : CALL VALCHE (IMAT,NUMAT,IPMINT,IPPORE) 371 : ENDIF 372 : * 373 : C____________________________________________________________________ 374 : C 375 : * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES * 376 : C____________________________________________________________________ 377 : C 378 : NBROBL=0 379 : NBRFAC=0 380 : NOMID=0 381 : * 382 : * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES 383 : * 384 : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 385 : NBROBL=1 386 : NBRFAC=1 387 : SEGINI NOMID 388 : LESOBL(1)='EPAI' 389 : LESFAC(1)='EXCE' 390 : * 391 : * SECTION POUR LES BARRES 392 : * 393 : ELSE IF (MFR.EQ.27) THEN 394 : NBROBL=1 395 : SEGINI NOMID 396 : LESOBL(1)='SECT' 397 : c+mdj 398 : * 399 : * section, excentrements et orientation pour les barres excentrees 400 : * 401 : ELSE IF (MFR.EQ.49) THEN 402 : NBROBL=6 403 : SEGINI NOMID 404 : LESOBL(1)='SECT' 405 : LESOBL(2)='EXCZ' 406 : LESOBL(3)='EXCY' 407 : LESOBL(4)='VX ' 408 : LESOBL(5)='VY ' 409 : LESOBL(6)='VZ ' 410 : * 411 : NBTYPE=1 412 : SEGINI NOTYPE 413 : MOTYPE=NOTYPE 414 : TYPE(1)='REAL*8' 415 : c+mdj 416 : * 417 : * CARACTERISTIQUES POUR LES POUTRES 418 : * 419 : ELSE IF (MFR.EQ.7 ) THEN 420 : IF (CMATE.NE.'SECTION') THEN 421 : IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN 422 : NBRFAC=1 423 : NBROBL=2 424 : SEGINI NOMID 425 : LESOBL(1)= 'SECT' 426 : LESOBL(2)= 'INRZ' 427 : LESFAC(1)= 'SECY' 428 : ELSE 429 : NBROBL=4 430 : NBRFAC=2 431 : SEGINI NOMID 432 : LESOBL(1)='TORS' 433 : LESOBL(2)='INRY' 434 : LESOBL(3)='INRZ' 435 : LESOBL(4)='SECT' 436 : LESFAC(1)='SECY' 437 : LESFAC(2)='SECZ' 438 : ENDIF 439 : ELSE 440 : NBROBL=0 441 : NBRFAC=1 442 : SEGINI NOMID 443 : LESFAC(1)='VECT' 444 : ENDIF 445 : * 446 : * CARACTERISTIQUES POUR LES TUYAUX 447 : * 448 : ELSE IF (MFR.EQ.13) THEN 449 : NBROBL=2 450 : NBRFAC=8 451 : SEGINI NOMID 452 : LESOBL(1)='EPAI' 453 : LESOBL(2)='RAYO' 454 : LESFAC(1)='RACO' 455 : LESFAC(2)='PRES' 456 : LESFAC(3)='CISA' 457 : LESFAC(4)='CFFX' 458 : LESFAC(5)='CFMX' 459 : LESFAC(6)='CFMY' 460 : LESFAC(7)='CFMZ' 461 : LESFAC(8)='CFPR' 462 : * 463 : * CARACTERISTIQUES POUR LES LINESPRING 464 : * 465 : ELSE IF (MFR.EQ.15) THEN 466 : NBROBL=5 467 : SEGINI NOMID 468 : LESOBL(1)='EPAI' 469 : LESOBL(2)='FISS' 470 : LESOBL(3)='VX ' 471 : LESOBL(4)='VY ' 472 : LESOBL(5)='VZ ' 473 : * 474 : * CARACTERISTIQUES POUR LES TUYAUX FISSURES 475 : * 476 : ELSE IF (MFR.EQ.17) THEN 477 : NBROBL=9 478 : SEGINI NOMID 479 : LESOBL(1)='RAYO' 480 : LESOBL(2)='EPAI' 481 : LESOBL(3)='VX ' 482 : LESOBL(4)='VY ' 483 : LESOBL(5)='VZ ' 484 : LESOBL(6)='VXF ' 485 : LESOBL(7)='VYF ' 486 : LESOBL(8)='VZF ' 487 : LESOBL(9)='ANGL' 488 : * 489 : * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES 490 : * 491 : ELSE IF (MFR.EQ.37) THEN 492 : IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN 493 : NBROBL=5 494 : SEGINI NOMID 495 : LESOBL(1)='SCEL' 496 : LESOBL(2)='SFLU' 497 : LESOBL(3)='EPS ' 498 : LESOBL(4)='SECT' 499 : LESOBL(5)='INRZ' 500 : ELSE 501 : NBROBL=3 502 : NBRFAC=2 503 : SEGINI NOMID 504 : LESOBL(1)='SCEL' 505 : LESOBL(2)='SFLU' 506 : LESOBL(3)='EPS ' 507 : LESFAC(1)='NOF1' 508 : LESFAC(2)='NOF2' 509 : ENDIF 510 : ENDIF 511 : * 512 : MOCARA=NOMID 513 : NCARA=NBROBL 514 : NCARF=NBRFAC 515 : NUCAR=NCARA+NCARF 516 : IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN 517 : NBTYPE=1 518 : SEGINI NOTYPE 519 : TYPE(1)='REAL*8' 520 : IF(CMATE.EQ.'SECTION')TYPE(1)='POINTEURPOINT ' 521 : MOTYPE=NOTYPE 521 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,ICAR) 522 : SEGSUP NOTYPE 523 : IF (IERR.NE.0) GOTO 9990 524 : NOMID=MOCARA 525 : SEGDES NOMID 526 : ENDIF 527 : * 528 : IF (MOCARA.NE.0.AND.ISUP5.EQ.1) THEN 528 : CALL VALCHE (ICAR,NUCAR,IPMINT,IPPORE) 529 : ENDIF 530 : * 531 : RETURN 532 : * 533 : 9990 CONTINUE 534 : * 535 : * ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR 536 : * 537 : IRET =0 538 : * 539 : IF (ISUP5.EQ.1) THEN 539 : CALL DTMVAL(IMAT,3) 539 : CALL DTMVAL(ICAR,3) 540 : ELSE 540 : CALL DTMVAL(IMAT,1) 540 : CALL DTMVAL(ICAR,1) 541 : ENDIF 542 : * 543 : NOMID=MOCARA 544 : IF (MOCARA.NE.0) SEGSUP NOMID 545 : NOMID=MOMATR 546 : IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID 547 : * 548 : SEGDES IMODEL 549 : * 550 : IF (IPCHE1.NE.0) THEN 551 : MCHEL1=IPCHE1 552 : SEGDES MCHEL1 553 : ENDIF 554 : 555 : RETURN 556 : END 557 : 558 : 559 :
© Cast3M 2003 - All rights reserved.
Disclaimer