1 : C CNEQP SOURCE CHAT 11/03/16 21:17:06 6902 2 : 3 : SUBROUTINE CNEQP(IPMODL,IPCHE1,IPCHPO,IPCHE2, IPCHP4,IRET) 4 : 5 : C_______________________________________________________________________ 6 : C 7 : C Entrees: 8 : C ________ 9 : C 10 : C IPMODL Pointeur sur un MMODEL 11 : C IPCHE1 Pointeur sur un MCHAML de forces volumiques 12 : C IPCHPO Pointeur sur un CHPOINT de forces volumiques 13 : C IPCHE2 Pointeur sur un MCHAML de caracteristiques (FACULTATIF) 14 : C 15 : C SORTIES: 16 : C ________ 17 : C 18 : C IPCHP4 Pointeur sur un CHPOINT de forces aux noeuds 19 : C IRET =1 OU 0 suivant succes ou pas (Message d'erreur 20 : C imprime dans ce cas 21 : C 22 : C_______________________________________________________________________ 23 : C 24 : IMPLICIT INTEGER(I-N) 25 : IMPLICIT REAL*8(A-H,O-Z) 26 : * 27 : -INC CCOPTIO 28 : -INC CCHAMP 29 : -INC SMCHAML 30 : -INC SMCHPOI 31 : -INC SMELEME 32 : -INC SMCOORD 33 : -INC SMMODEL 34 : -INC SMINTE 35 : * 36 : SEGMENT INFO 37 : INTEGER INFELL(JG) 38 : ENDSEGMENT 39 : * 40 : POINTEUR NOMID1.NOMID 41 : * 42 : SEGMENT NOTYPE 43 : CHARACTER*16 TYPE(NBTYPE) 44 : ENDSEGMENT 45 : * 46 : SEGMENT MPTVAL 47 : INTEGER IPOS(NS) ,NSOF(NS) 48 : INTEGER IVAL(NCOSOU) 49 : CHARACTER*16 TYVAL(NCOSOU) 50 : ENDSEGMENT 51 : * 52 : PARAMETER ( NINF=3 ) 53 : INTEGER INFOS(NINF) 54 : CHARACTER*8 CMATE 55 : CHARACTER*(NCONCH) CONM 56 : LOGICAL lsupfo 57 : * 58 : IRET = 0 59 : IPCHP4 = 0 60 : * 61 : * Premieres verifications sur le modele (formulation) 62 : MMODEL = IPMODL 63 : SEGACT,MMODEL 64 : NSOUS = KMODEL(/1) 65 : IMECA = 0 66 : IELEC = 0 67 : IMAGN = 0 68 : DO ISOUS = 1, NSOUS 69 : IMODEL = KMODEL(ISOUS) 70 : SEGACT,IMODEL 71 : NFOR = FORMOD(/2) 72 : IF (NFOR.EQ.1) THEN 73 : IF (FORMOD(1).EQ.'MECANIQUE' .OR. FORMOD(1).EQ.'POREUX') THEN 74 : IMECA = 1 75 : ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN 76 : IELEC = 1 77 : ELSE IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN 78 : IMAGN = 1 79 : ELSE 80 : MOTERR(1:8) = FORMOD(1) 80 : CALL ERREUR(193) 81 : GOTO 9990 82 : ENDIF 83 : ELSE IF (NFOR.GT.1) THEN 84 : MOTERR(1:8) = FORMOD(1) 84 : CALL ERREUR(193) 85 : GOTO 9990 86 : ENDIF 87 : ENDDO 88 : IF (IMECA+IELEC+IMAGN .NE. 1) THEN 89 : *AV Affiner l'erreur ! 90 : write(ioimp,*) 'Une seule formulation dans le modele !' 90 : CALL ERREUR(21) 91 : GOTO 9990 92 : ENDIF 93 : * 94 : * PASSAGE DU CHPOINT EN MCHAML 95 : * 96 : IF (IPCHE1.EQ.0) THEN 96 : CALL CHAME1(0,IPMODL,IPCHPO,'VOLUMIQUE',IPCHE1,1) 97 : ENDIF 98 : * 99 : * Verification du lieu support du MCHAML de forces volumiques 100 : * 100 : CALL QUESUP(IPMODL,IPCHE1,3,0,ISUP1,IRET1) 101 : IF (ISUP1.GT.1) THEN 101 : CALL ERREUR(609) 102 : GOTO 9990 103 : ENDIF 104 : * 105 : * Verification du lieu support du MCHAML de caracteristiques 106 : * 107 : IF (IPCHE2.NE.0) THEN 107 : CALL QUESUP(IPMODL,IPCHE2,3,1,ISUP2,IRET2) 108 : IF (ISUP2.GT.1) THEN 108 : CALL ERREUR(609) 109 : GOTO 9990 110 : ENDIF 111 : ENDIF 112 : *_______________________________________________________________________ 113 : * 114 : * ACTIVATION DU MODELE 115 : *_______________________________________________________________________ 116 : * 117 : MMODEL=IPMODL 118 : SEGACT,MMODEL 119 : NSOUS=KMODEL(/1) 120 : C 121 : C ACTIVATION DU CHAMP VOLUMIQUE 122 : C 123 : MCHEL1=IPCHE1 124 : SEGACT MCHEL1 125 : C 126 : C INITIALISATION DU MCHELM DE VALEURS NODALES 127 : C 128 : L1=6 129 : N1=NSOUS 130 : N3=5 131 : SEGINI MCHELM 132 : IPCHE5=MCHELM 133 : IFOCHE=IFOUR 134 : TITCHE='FORCES' 135 : C Initialisation de quelques variables (MECANIQUE ou POREUX) 136 : IF (IMECA.EQ.1) THEN 137 : IF (IFOUR.EQ.-3) THEN 138 : NFORDG=3 139 : ELSE IF (IFOUR.EQ.11) THEN 140 : NFORDG=2 141 : ELSE IF ((IFOUR.GE.7.AND.IFOUR.LE.10).OR.IFOUR.EQ.14) THEN 142 : NFORDG=1 143 : ELSE 144 : NFORDG=0 145 : ENDIF 146 : ELSE 147 : NFORDG=0 148 : ENDIF 149 : C_______________________________________________________________________ 150 : C 151 : C BOUCLE SUR LES SOUS ZONES 152 : C_______________________________________________________________________ 153 : C 154 : DO 200 ISOUS=1,NSOUS 155 : C 156 : C INITIALISATION 157 : C 158 : IPMINT = 0 159 : IVACAR = 0 160 : IVAFOR = 0 161 : IVAFVO = 0 162 : MOCARA = 0 163 : MOFORC = 0 164 : MOFOVO = 0 165 : lsupfo=.true. 166 : MCHAML = 0 167 : C 168 : C TRAITEMENT DU MODELE 169 : C 170 : IMODEL=KMODEL(ISOUS) 171 : SEGACT IMODEL 172 : IIPDPG=IPDPGE 173 : MELE=NEFMOD 174 : IPMAIL=IMAMOD 175 : CONM =CONMOD 176 : C____________________________________________________________________ 177 : C 178 : C ACTIVATION DU MELEME 179 : C 180 : MELEME=IPMAIL 181 : SEGACT MELEME 182 : NBNN=NUM(/1) 183 : NBELEM=NUM(/2) 184 : C 185 : C CREATION DU TABLEAU INFOS 186 : C 186 : CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD) 187 : IF (IRTD.EQ.0) GOTO 510 188 : C_______________________________________________________________________ 189 : C 190 : C INFORMATIONS SUR L'ELEMENT FINI 191 : C_______________________________________________________________________ 192 : C 193 : iplaz=3 194 : C* IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') iplaz=2 195 : IF (IMAGN .EQ. 1) iplaz=2 196 : if(infmod(/1).lt.2+iplaz) then 196 : CALL ELQUOI(MELE,0,iplaz,IPINF,IMODEL) 197 : IF (IERR.NE.0) GOTO 510 198 : INFO=IPINF 199 : NBPGAU= INFELL(4) 200 : NBG = INFELL(6) 201 : MINTE = INFELL(11) 202 : MFR = INFELL(13) 203 : LW = INFELL(7) 204 : NDDL = INFELL(15) 205 : LRE = INFELL(9) 206 : IPORE = INFELL(8) 207 : MINTE1=INFELL(12) 208 : SEGSUP,INFO 209 : ELSE 210 : NBPGAU= INFELE(4) 211 : NBG = INFELE(6) 212 : minte=infmod(2+iplaz) 213 : MINTE1= INFMOD(8) 214 : MFR = INFELE(13) 215 : LW = INFELE(7) 216 : NDDL = INFELE(15) 217 : LRE = INFELE(9) 218 : IPORE = INFELE(8) 219 : ENDIF 220 : IPPORE=0 221 : IF(MFR.EQ.33) IPPORE=NBNN 222 : NHRM = NIFOUR 223 : C 224 : IPMINT = MINTE 225 : IPMIN1 = MINTE1 226 : SEGACT MINTE 227 : NBNO=SHPTOT(/2) 228 : C 229 : C RECOPIE DU MCHELM 230 : C 231 : IMACHE(ISOUS)=IPMAIL 232 : CONCHE(ISOUS)=CONMOD 233 : INFCHE(ISOUS,1)=0 234 : INFCHE(ISOUS,2)=0 235 : INFCHE(ISOUS,3)=NIFOUR 236 : INFCHE(ISOUS,4)=0 237 : INFCHE(ISOUS,5)=0 238 : C_______________________________________________________________________ 239 : C 240 : C NOMS DE COMPOSANTES EN SORTIE ( FORCES POUR L'INSTANT , 241 : C COMPTE TENU DES FORMULATIONS DISPONIBLES ) 242 : C + CREATION DU MCHAML 243 : C_______________________________________________________________________ 244 : C 245 : C* IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN 246 : IF (IMAGN .EQ. 1) THEN 246 : CALL IDPVIN(MFR,IFOUR,MOFORC,NFOR,NFAC) 247 : IF ( NFAC.NE.0 ) THEN 247 : CALL ERREUR(19) 248 : GO TO 510 249 : ENDIF 250 : NCOMP=NFOR 251 : NOMID1=MOFORC 252 : SEGACT NOMID1 253 : N2=1 254 : SEGINI MCHAML 255 : ICHAML(ISOUS)=MCHAML 256 : NOMCHE(1)='ED' 257 : TYPCHE(1)='REAL*8' 258 : ELSE 259 : if(lnomid(2).ne.0) then 260 : moforc=lnomid(2) 261 : nomid1=moforc 262 : segact nomid1 263 : nfor=nomid1.lesobl(/2) 264 : nfac=nomid1.lesfac(/2) 265 : lsupfo=.false. 266 : else 266 : CALL IDFORC(MFR,IFOUR,MOFORC,NFOR,NFAC) 267 : NOMID1=MOFORC 268 : SEGACT,NOMID1 269 : endif 270 : IF (NFAC.NE.0 .OR. NFOR.NE.NDDL) THEN 271 : SEGDES,NOMID1 271 : CALL ERREUR(19) 272 : GO TO 510 273 : ENDIF 274 : NCOMP=NFOR-NFORDG 275 : NDDL =NDDL-NFORDG 276 : N2=NCOMP 277 : SEGINI,MCHAML 278 : ICHAML(ISOUS)=MCHAML 279 : DO 110 ICOMP=1,NCOMP 280 : NOMCHE(ICOMP)=NOMID1.LESOBL(ICOMP) 281 : TYPCHE(ICOMP)='REAL*8' 282 : 110 CONTINUE 283 : ENDIF 284 : *_______________________________________________________________________ 285 : * 286 : * TRAITEMENT DU CHAMP DE VALEURS NODALES EN ENTREE 287 : *_______________________________________________________________________ 288 : * 289 : * ON PREND TOUS LES NOMS DE FORCES COMME COMPOSANTES POSSIBLES 290 : * MAIS ON LES MET EN FACULTATIF 291 : * PUIS ON CREE LE SEGMENT MOFOVO 292 : * 293 : NBROBL=0 294 : NBRFAC=NCOMP 295 : NFOVO=NBRFAC 296 : SEGINI NOMID 297 : MOFOVO=NOMID 298 : DO 120 ICOMP=1,NCOMP 299 : LESFAC(ICOMP)=NOMID1.LESOBL(ICOMP) 300 : 120 CONTINUE 301 : SEGDES NOMID 302 : SEGDES NOMID1 303 : * 304 : * RECUPERATION DES COMPOSANTES PRESENTES 305 : * 306 : NBTYPE=1 307 : SEGINI NOTYPE 308 : MOTYPE=NOTYPE 309 : TYPE(1)='REAL*8' 309 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOFOVO,MOTYPE,0,INFOS,3,IVAFVO) 310 : SEGSUP NOTYPE 311 : IF (IERR.NE.0) GOTO 510 312 : * 313 : * ON VERIFIE A POSTERIORI QU'ON A TROUVE QUELQUE CHOSE 314 : * 315 : MPTVAL = IVAFVO 316 : NCOSOU = IVAL(/1) 317 : NFOVOL = 0 318 : DO 50 I=1,NCOSOU 319 : IF (IVAL(I).NE.0) NFOVOL=NFOVOL+1 320 : 50 CONTINUE 321 : IF(NFOVOL.EQ.0) THEN 322 : MOTERR(1:8)='FOR. VOL' 323 : MOTERR(9:12)=NOMTP(MELE) 324 : MOTERR(13:20)='CNEQ ' 324 : CALL ERREUR(145) 325 : GO TO 510 326 : ENDIF 327 : * 328 : * CHANGEMENT DE SUPPORT SI BESOIN 329 : * 330 : IF (ISUP1.EQ.1) THEN 330 : CALL VALCHE(IVAFVO,NFOVO,IPMINT,IPPORE) 331 : ENDIF 332 : C____________________________________________________________________ 333 : C 334 : * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES * 335 : C____________________________________________________________________ 336 : * 337 : NBROBL=0 338 : NBRFAC=0 339 : NOMID =0 340 : IVECT=0 341 : * 342 : C* IF (FORMOD(1).NE.'MECANIQUE' .AND. 343 : C* & FORMOD(1).NE.'POREUX' ) GO TO 777 344 : IF (IMECA .NE. 1) GO TO 777 345 : * 346 : * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES 347 : * 348 : IF((MFR.EQ.1.OR.MFR.EQ.33).AND.IFOUR.EQ.-2. 349 : + AND.IPCHE2.NE.0)THEN 350 : NBROBL=0 351 : NBRFAC=1 352 : SEGINI NOMID 353 : LESFAC(1)='DIM3' 354 : * 355 : NBTYPE=1 356 : SEGINI NOTYPE 357 : TYPE(1)='REAL*8' 358 : * 359 : * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES 360 : * 361 : ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 362 : NBROBL=1 363 : IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN 364 : NBRFAC=2 365 : ELSE 366 : NBRFAC=1 367 : ENDIF 368 : SEGINI NOMID 369 : LESOBL(1)='EPAI' 370 : LESFAC(1)='EXCE' 371 : IF(MFR.EQ.3.AND.IFOUR.EQ.-2) LESFAC(2)='DIM3' 372 : * 373 : NBTYPE=1 374 : SEGINI NOTYPE 375 : TYPE(1)='REAL*8' 376 : * 377 : * SECTION POUR LES BARRES 378 : * 379 : ELSE IF (MFR.EQ.27) THEN 380 : NBROBL=1 381 : SEGINI NOMID 382 : LESOBL(1)='SECT' 383 : * 384 : NBTYPE=1 385 : SEGINI NOTYPE 386 : TYPE(1)='REAL*8' 387 : * 388 : * CARACTERISTIQUES POUR LES POUTRES 389 : * 390 : ELSE IF (MFR.EQ.7 ) THEN 391 : NBROBL=4 392 : NBRFAC=3 393 : SEGINI NOMID 394 : LESOBL(1)='TORS' 395 : LESOBL(2)='INRY' 396 : LESOBL(3)='INRZ' 397 : LESOBL(4)='SECT' 398 : LESFAC(1)='SECY' 399 : LESFAC(2)='SECZ' 400 : LESFAC(3)='VECT' 401 : IVECT=1 402 : * 403 : NBTYPE=7 404 : SEGINI NOTYPE 405 : TYPE(1)='REAL*8' 406 : TYPE(2)='REAL*8' 407 : TYPE(3)='REAL*8' 408 : TYPE(4)='REAL*8' 409 : TYPE(5)='REAL*8' 410 : TYPE(6)='REAL*8' 411 : TYPE(7)='POINTEURPOINT ' 412 : * 413 : * CARACTERISTIQUES POUR LES TUYAUX 414 : * 415 : ELSE IF (MFR.EQ.13) THEN 416 : NBROBL=2 417 : NBRFAC=2 418 : SEGINI NOMID 419 : LESOBL(1)='EPAI' 420 : LESOBL(2)='RAYO' 421 : LESFAC(1)='RACO' 422 : LESFAC(2)='VECT' 423 : IVECT=1 424 : C 425 : NBTYPE=4 426 : SEGINI NOTYPE 427 : TYPE(1)='REAL*8' 428 : TYPE(2)='REAL*8' 429 : TYPE(3)='REAL*8' 430 : TYPE(4)='POINTEURPOINT ' 431 : * 432 : * CARACTERISTIQUES POUR LES LINESPRING 433 : * 434 : ELSE IF (MFR.EQ.15) THEN 435 : NBROBL=5 436 : SEGINI NOMID 437 : LESOBL(1)='EPAI' 438 : LESOBL(2)='FISS' 439 : LESOBL(3)='VX ' 440 : LESOBL(4)='VY ' 441 : LESOBL(5)='VZ ' 442 : C 443 : NBTYPE=1 444 : SEGINI NOTYPE 445 : TYPE(1)='REAL*8' 446 : * 447 : * CARACTERISTIQUES POUR LES TUYAUX FISSURES 448 : * 449 : ELSE IF (MFR.EQ.17) THEN 450 : NBROBL=9 451 : SEGINI NOMID 452 : LESOBL(1)='RAYO' 453 : LESOBL(2)='EPAI' 454 : LESOBL(3)='VX ' 455 : LESOBL(4)='VY ' 456 : LESOBL(5)='VZ ' 457 : LESOBL(6)='VXF ' 458 : LESOBL(7)='VYF ' 459 : LESOBL(8)='VZF ' 460 : LESOBL(9)='ANGL' 461 : * 462 : NBTYPE=1 463 : SEGINI NOTYPE 464 : TYPE(1)='REAL*8' 465 : * 466 : * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES 467 : * 468 : ELSE IF (MFR.EQ.37) THEN 469 : IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN 470 : NBROBL=4 471 : SEGINI NOMID 472 : LESOBL(1)='SCEL' 473 : LESOBL(2)='SFLU' 474 : LESOBL(3)='EPS ' 475 : LESOBL(4)='XINE' 476 : ELSE 477 : NBROBL=3 478 : SEGINI NOMID 479 : LESOBL(1)='SCEL' 480 : LESOBL(2)='SFLU' 481 : LESOBL(3)='EPS ' 482 : ENDIF 483 : * 484 : NBTYPE=1 485 : SEGINI NOTYPE 486 : TYPE(1)='REAL*8' 487 : ENDIF 488 : * 489 : MOCARA=NOMID 490 : NCARA=NBROBL 491 : NCARF=NBRFAC 492 : NCARR=NCARA+NCARF 493 : * 494 : IF (MOCARA.NE.0) THEN 495 : IF (IPCHE2.EQ.0) THEN 496 : SEGSUP NOTYPE 497 : MOTERR(1:8)='CARACTER' 498 : MOTERR(9:12)=NOMTP(MELE) 499 : MOTERR(13:20)='CNEQ ' 499 : CALL ERREUR(145) 500 : GOTO 510 501 : ENDIF 502 : MOTYPE=NOTYPE 502 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3, 503 : $ IVACAR) 504 : SEGSUP NOTYPE 505 : IF (IERR.NE.0) GOTO 510 506 : IF (IVECT.EQ.1) THEN 507 : MPTVAL=IVACAR 508 : IF (IVAL(NCARR).EQ.0) THEN 509 : * 510 : * MOT CLE VECT EN CAS DE CONVERSION 511 : * 512 : IVECT=2 513 : NBRFAC=NBRFAC+2 514 : SEGADJ NOMID 515 : LESFAC(NBRFAC-2)='VX ' 516 : LESFAC(NBRFAC-1)='VY ' 517 : LESFAC(NBRFAC )='VZ ' 518 : NCARF=NBRFAC 519 : NCARR=NCARA+NCARF 520 : * 521 : NBTYPE=1 522 : SEGINI NOTYPE 523 : TYPE(1)='REAL*8' 524 : MOTYPE=NOTYPE 525 : C 525 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3, 526 : $ IVACAR) 527 : SEGSUP NOTYPE 528 : IF (IERR.NE.0)GOTO 510 529 : ENDIF 530 : ENDIF 531 : * 532 : IF (ISUP2.EQ.1) THEN 532 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 533 : IF (IERR.NE.0)THEN 534 : ISUP2=0 535 : GOTO 510 536 : ENDIF 537 : ENDIF 538 : ENDIF 539 : C 540 : C TAILLES DE MELVAL 541 : C 542 : 777 CONTINUE 543 : C 544 : N1EL =NBELEM 545 : N1PTEL=NBNN 546 : N2PTEL=0 547 : N2EL=0 548 : NBPTEL=NBPGAU 549 : NEL =N1EL 550 : C 551 : C CREATION DU MELVAL DE FORCES NODALES 552 : C 553 : NS=1 554 : C* IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN 555 : IF (IMAGN .EQ. 1) THEN 556 : NCOSOU=1 557 : ELSE 558 : NCOSOU=NCOMP 559 : ENDIF 560 : SEGINI MPTVAL 561 : IVAFOR=MPTVAL 562 : DO 100 ICOMP=1,NCOSOU 563 : SEGINI MELVAL 564 : IELVAL(ICOMP)=MELVAL 565 : IVAL(ICOMP)=MELVAL 566 : 100 CONTINUE 567 : C_______________________________________________________________________ 568 : C 569 : C NUMERO DES ETIQUETTES : 570 : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT 571 : C Les elements sont groupes comme suit : 572 : C - massif, poreux ---------------------------------> CNEQ1 573 : C - coq3,dkt,coq4,coq8,coq2 ------------------------> CNEQ2 574 : C - poutre,tuyau,linespring,tuyau fissure,barre ----> CNEQ3 575 : C_______________________________________________________________________ 576 : C 577 : IF(MELE.EQ.128) GO TO 128 578 : GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99, 579 : 1 99,99, 4, 4, 4, 4,27,27,29,29,99,99,99,99,99,99,99,99,99,99, 580 : 2 27,29,29,27,99,29,99,99,27,29,99,99,99,99,99,27,99,99,99,99, 581 : 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 4, 4, 582 : 4 4, 4, 4,99,99,99,99,99,99,99,99,99,27,99,99,99,99),MELE 583 : C 584 : IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4 585 : 99 CONTINUE 586 : MOTERR(1:4)=NOMTP(MELE) 587 : MOTERR(5:8)='CNEQ' 587 : CALL ERREUR(86) 588 : GOTO 510 589 : C_______________________________________________________________________ 590 : C 591 : C massifs, poreux 592 : C_______________________________________________________________________ 593 : C 594 : 4 CONTINUE 595 : IF (MFR.EQ.71) THEN 595 : CALL CNEQEL(IPMAIL,IVAFVO,IPMINT,NBPGAU,IVAFOR,NCOMP) 596 : ELSE 596 : CALL CNEQ1(IPMAIL,LRE,NDDL,NBPGAU,MELE,MFR,IVAFVO,IPMINT,IVACAR, 597 : & IPORE,NCOMP,IVAFOR,IIPDPG) 598 : ENDIF 599 : GOTO 510 600 : C_______________________________________________________________________ 601 : C 602 : C coq3,dkt,coq4,coq8,coq2,dst 603 : C_______________________________________________________________________ 604 : C 605 : 27 CONTINUE 605 : CALL CNEQ2(IPMAIL,LRE,NDDL,IVAFVO,LW,NBPGAU,IVACAR,CMATE, 606 : & NBPTEL,MELE,IPMINT,IPMIN1,IVAMAT,NMATT,NBGMAT,NELMAT,IMAT,IVAFOR) 607 : GOTO 510 608 : C_______________________________________________________________________ 609 : C 610 : C poutre,tuyau,linespring,tuyau fissure,barre 611 : C_______________________________________________________________________ 612 : C 613 : 29 CONTINUE 614 : GO TO 99 615 : C CAS NON PREVU 615 : C CALL CNEQ3(IPMAIL,LRE,NFOVO,LW,IVACAR,NCARR,IVECT,MELE, 616 : C & IVAFVO,ISOUS,NBPGAU,NBPTEL,IPMINT,NCOMP,IVAFOR) 617 : C GOTO 510 618 : C_______________________________________________________________________ 619 : C 620 : C Element fini rot3 pour la magnetodynamique 621 : C_______________________________________________________________________ 622 : C 623 : 128 CONTINUE 623 : CALL CNEQMG(IPMAIL,IPMINT,IVAFVO,IVAFOR) 624 : GO TO 510 625 : C_______________________________________________________________________ 626 : C 627 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS 628 : C_______________________________________________________________________ 629 : C 630 : 510 CONTINUE 631 : C 632 : SEGDES MELEME 633 : IF (IPMINT.NE.0) SEGDES MINTE 634 : C 635 : IF(ISUP1.EQ.1)THEN 635 : CALL DTMVAL(IVAFVO,3) 636 : ELSE 636 : CALL DTMVAL(IVAFVO,1) 637 : ENDIF 638 : C 639 : IF(ISUP2.EQ.1)THEN 639 : CALL DTMVAL(IVACAR,3) 640 : ELSE 640 : CALL DTMVAL(IVACAR,1) 641 : ENDIF 642 : C 643 : NOMID=MOFORC 644 : if(lsupfo.AND.MOFORC.NE.0) SEGSUP NOMID 645 : NOMID=MOFOVO 646 : IF (MOFOVO.NE.0) SEGSUP NOMID 647 : NOMID=MOCARA 648 : IF (MOCARA.NE.0) SEGSUP NOMID 649 : C 650 : IF (IERR.EQ.0) THEN 650 : CALL DTMVAL(IVAFOR,1) 651 : SEGDES MCHAML 652 : ELSE 652 : CALL DTMVAL(IVAFOR,3) 653 : IF (MCHAML.NE.0) SEGSUP MCHAML 654 : SEGSUP MCHELM 655 : IRET = 0 656 : GO TO 9990 657 : ENDIF 658 : C 659 : 200 CONTINUE 660 : 661 : C_______________________________________________________________________ 662 : C 663 : C TRANSFORMATION DU CHAMELEM EN CHPOINT 664 : C_______________________________________________________________________ 665 : C 666 : IRET = 1 666 : CALL CHAMPO(IPCHE5,0,IPCHP4,IRET) 666 : CALL DTCHAM(IPCHE5) 667 : C 668 : C Desactivation (modele,mchaml) dans tous les cas 669 : 9990 CONTINUE 670 : SEGDES,MCHEL1 671 : DO ISOUS = 1, NSOUS 672 : IMODEL = KMODEL(ISOUS) 673 : SEGDES,IMODEL 674 : ENDDO 675 : SEGDES,MMODEL 676 : 677 : RETURN 678 : END 679 : 680 : 681 :
© Cast3M 2003 - All rights reserved.
Disclaimer