1 : C FCOUL1 SOURCE CHAT 12/04/06 21:15:07 7348 2 : SUBROUTINE FCOUL1(DEPSI,IPMODL,IPCHE1,IPCHE2,IPCAR, 3 : & SIGMA,IPCHE7,IPCHE8,IRETO,NSTRS2) 4 : ********************************************************************** 5 : * 6 : * ECOULEMENT INELASTIQUE POUR LES MODELE A SECTION 7 : * Boucle sur les ss-zone du modele de section 8 : * 9 : ********************************************************************** 10 : * Pierre Pegon (ISPRA) Juillet/Aout 1993 11 : ********************************************************************** 12 : * 13 : * ENTREES: 14 : * 15 : * DEPSI(6) INCREMENT DE DEFORMATION POUR LA FIBRE CENTRALE 16 : * IPMODL = POINTEUR SUR UN OBJET MMODEL 17 : * IPCHE1 = POINTEUR SUR UN MCHAML DE CONTRAINTES INITIALES 18 : * IPCHE2 = POINTEUR SUR UN MCHAML DE VARIABLES INTERNES INITIALES 19 : * IPCAR = POINTEUR SUR UN MCHAML DE CARACTERISTIQUES 20 : * 21 : * SORTIES: 22 : * 23 : * SIGMA(6) ELEMENT DE REDUCTION DES EFFORT POUR LA FIBRE CENTRALE 24 : * IPCHE7 = POINTEUR SUR UN MCHAML DE CONTRAINTES 25 : * IPCHE8 = POINTEUR SUR UN MCHAML DE VARIABLES INTERNES 26 : * 27 : ************************************************************************ 28 : IMPLICIT INTEGER(I-N) 29 : IMPLICIT REAL*8(A-H,O-Z) 30 : * 31 : -INC CCOPTIO 32 : -INC SMCHAML 33 : -INC SMELEME 34 : -INC SMCOORD 35 : -INC SMMODEL 36 : -INC SMINTE 37 : -INC CCHAMP 38 : C 39 : DIMENSION DEPSI(NSTRS2),SIGMA(NSTRS2) 40 : 41 : SEGMENT NOTYPE 42 : CHARACTER*16 TYPE(NBTYPE) 43 : ENDSEGMENT 44 : * 45 : SEGMENT MPTVAL 46 : INTEGER IPOS(NS) ,NSOF(NS) 47 : INTEGER IVAL(NCOSOU) 48 : CHARACTER*16 TYVAL(NCOSOU) 49 : ENDSEGMENT 50 : * 51 : CHARACTER*8 CMATE 52 : CHARACTER*(NCONCH) CONM 53 : CHARACTER*16 MOMODL(10) 54 : PARAMETER ( NINF=3 ) 55 : INTEGER INFOS(NINF) 56 : LOGICAL lsupva,lsupco,lsupma,lsupca 57 : C 58 : IRETO=0 59 : NHRM=NIFOUR 60 : C 61 : C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CONTRAINTES 62 : C 62 : CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1) 63 : IF (ISUP1.GT.1) RETURN 64 : * 65 : * VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES 66 : * 66 : CALL QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2) 67 : IF (ISUP2.GT.1) RETURN 68 : C 69 : C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES 70 : C 70 : CALL QUESUP(IPMODL,IPCAR,5,0,ISUP5,IRET5) 71 : IF (ISUP5.GT.1) RETURN 72 : C 73 : C ACTIVATION DU MODELE 74 : C 75 : MMODEL=IPMODL 76 : SEGACT MMODEL 77 : NSOUS=KMODEL(/1) 78 : C 79 : C CREATION DES 2 MCHELMS 80 : C 81 : N1=NSOUS 82 : L1=11 83 : N3=6 84 : SEGINI MCHELM 85 : TITCHE='CONTRAINTES' 86 : IFOCHE=IFOUR 87 : IPCHE7=MCHELM 88 : L1=18 89 : SEGINI MCHEL1 90 : MCHEL1.TITCHE='VARIABLES INTERNES' 91 : MCHEL1.IFOCHE=IFOUR 92 : IPCHE8=MCHEL1 93 : C 94 : C MISE A ZERO DES CONTRAINTES 95 : C 96 : DO IE1=1,NSTRS2 97 : SIGMA(IE1)=0.D0 98 : ENDDO 99 : C____________________________________________________________________ 100 : C 101 : C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES 102 : C____________________________________________________________________ 103 : C 104 : *-DC- 105 : EPSUP=-1.0D10 106 : EPINF= 1.0D10 107 : * 108 : DAMAG= 0.0D0 109 : ETIQE= 0.0D0 110 : *-DC- 111 : 112 : DO 1000 ISOUS=1,NSOUS 113 : * 114 : * INITIALISATION 115 : * 116 : NSTR=0 117 : MOSTRS=0 118 : IVASTR=0 119 : MOVARI=0 120 : NVARI=0 121 : NVARF=0 122 : IVARI=0 123 : NMATF=0 124 : NMATR=0 125 : MOMATR=0 126 : IVAMAT=0 127 : NCARA=0 128 : NCARF=0 129 : MOCARA=0 130 : IVACAR=0 131 : IVASTF=0 132 : IVARIF=0 133 : C 134 : C ON RECUPERE L INFORMATION GENERALE 135 : C 136 : IMODEL=KMODEL(ISOUS) 137 : SEGACT IMODEL 138 : IPMAIL=IMAMOD 139 : CONM =CONMOD 140 : IMACHE(ISOUS)=IPMAIL 141 : CONCHE(ISOUS)=CONMOD 142 : MCHEL1.IMACHE(ISOUS)=IPMAIL 143 : MCHEL1.CONCHE(ISOUS)=CONMOD 144 : * 145 : MELE=NEFMOD 146 : MELEME=IMAMOD 147 : SEGACT MELEME 148 : NBNN=NUM(/1) 149 : NBELEM=NUM(/2) 150 : C+PPf 151 : C ON EVACUE LE CAS DU SEGS EN 3D 152 : IF(MELE.EQ.166.AND.IDIM.EQ.3)THEN 153 : SEGDES IMODEL 153 : CALL ERREUR(832) 154 : GOTO 888 155 : ENDIF 156 : C+PPf 157 : C 158 : C TRAITEMENT DU MODELE 159 : C 160 : NFOR=FORMOD(/2) 161 : NMAT=MATMOD(/2) 162 : C 163 : C NATURE DU MATERIAU 164 : C 164 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR) 165 : IF (CMATE.EQ.' ')THEN 166 : SEGDES IMODEL 166 : CALL ERREUR(251) 167 : GOTO 888 168 : ENDIF 169 : IF(MATE.NE.1)THEN 170 : SEGDES,IMODEL 170 : CALL ERREUR(635) 171 : GOTO 888 172 : ENDIF 172 : CALL TEMANF(INFIBR,NIFIBR) 173 : IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN 173 : CALL ERREUR(636) 174 : SEGDES,IMODEL 175 : GOTO 888 176 : ENDIF 177 : INFIBR=NIFIBR 178 : * 179 : C____________________________________________________________________ 180 : C 181 : C INFORMATION SUR L'ELEMENT FINI 182 : C____________________________________________________________________ 183 : C 183 : * CALL ELQUOI(MELE,0,5,IPINF,IMODEL) 184 : * IF (IERR.NE.0) THEN 185 : * SEGDES,IMODEL 186 : * GOTO 888 187 : * ENDIF 188 : * INFO=IPINF 189 : MFR =INFELE(13) 190 : IPPORE=0 191 : IF(MFR.EQ.33) IPPORE=NBNN 192 : IF (MFR.NE.47)THEN 192 : CALL ERREUR(637) 193 : SEGDES IMODEL,MMODEL 194 : SEGSUP MCHELM,MCHEL1 195 : RETURN 196 : ENDIF 197 : NBG =INFELE(6) 198 : NBGS =INFELE(4) 199 : NSTRS=INFELE(16) 200 : LRE =INFELE(9) 201 : LHOOK=INFELE(10) 202 : LHOO2=LHOOK*LHOOK 203 : * MINTE=INFELE(11) 204 : MINTE=infmod(7) 205 : IPMINT=MINTE 206 : SEGACT,MINTE 207 : * 208 : * REMPLISSAGE DES TABLEAUX INFCHE 209 : * 210 : INFCHE(ISOUS,1)=0 211 : INFCHE(ISOUS,2)=0 212 : INFCHE(ISOUS,3)=NHRM 213 : INFCHE(ISOUS,4)=IPMINT 214 : INFCHE(ISOUS,5)=0 215 : INFCHE(ISOUS,6)=5 216 : * 217 : MCHEL1.INFCHE(ISOUS,1)=0 218 : MCHEL1.INFCHE(ISOUS,2)=0 219 : MCHEL1.INFCHE(ISOUS,3)=NHRM 220 : MCHEL1.INFCHE(ISOUS,4)=IPMINT 221 : MCHEL1.INFCHE(ISOUS,5)=0 222 : MCHEL1.INFCHE(ISOUS,6)=5 223 : C 224 : C CREATION DU TABLEAU INFOS 225 : C 225 : CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD) 226 : IF (IRTD.EQ.0)THEN 227 : SEGDES IMODEL,MINTE 228 : * INFO=IPINF 229 : * SEGSUP INFO 230 : GOTO 888 231 : ENDIF 232 : * 233 : * TRAITEMENT DU CHAMP DE CONTRAINTES 234 : * 235 : if(lnomid(4).ne.0) then 236 : nomid=lnomid(4) 237 : segact nomid 238 : mostrs=nomid 239 : nstr=lesobl(/2) 240 : nfac=lesfac(/2) 241 : lsupco=.false. 242 : else 243 : lsupco=.true. 243 : CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC) 244 : endif 245 : IF (MOSTRS.EQ.0) THEN 246 : MOTERR(1:4)='CONT' 247 : MOTERR(5:8)=NOMTP(MELE) 247 : CALL ERREUR (76) 248 : SEGDES,IMODEL,MINTE 249 : * INFO=IPINF 250 : * SEGSUP INFO 251 : GOTO 888 252 : ENDIF 253 : * 254 : NBTYPE=1 255 : SEGINI NOTYPE 256 : MOTYPE=NOTYPE 257 : TYPE(1)='REAL*8' 257 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR) 258 : IF(IERR.NE.0)THEN 259 : SEGSUP NOTYPE 260 : GOTO 9990 261 : ENDIF 262 : * 263 : IF (ISUP1.EQ.1) THEN 263 : CALL VALCHE(IVASTR,NSTR,IPMINT,IPPORE) 264 : IF(IERR.NE.0)THEN 265 : SEGSUP NOTYPE 266 : ISUP1=0 267 : GOTO 9990 268 : ENDIF 269 : ENDIF 270 : * 271 : * TRAITEMENT DU CHAMP DE VARIABLES INTERNES 272 : * 273 : if(lnomid(10).ne.0) then 274 : nomid=lnomid(10) 275 : segact nomid 276 : movari=nomid 277 : nvari=lesobl(/2) 278 : nvarf=lesfac(/2) 279 : lsupva=.false. 280 : else 281 : lsupva=.true. 281 : CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF) 282 : endif 283 : * write(6,*) ' lnomid(10) nvari nvarf ', lnomid(10),nvari,nvarf 284 : IF (MOVARI.EQ.0) THEN 285 : MOTERR(1:4)='VARI' 286 : MOTERR(5:8)=NOMTP(MELE) 286 : CALL ERREUR (76) 287 : SEGSUP NOTYPE 288 : GOTO 9990 289 : ENDIF 290 : * 290 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI) 291 : IF(IERR.NE.0)THEN 292 : SEGSUP NOTYPE 293 : GOTO 9990 294 : ENDIF 295 : * 296 : NVART=NVARI+NVARF 297 : IF (ISUP2.EQ.1) THEN 297 : CALL VALCHE(IVARI,NVART,IPMINT,IPPORE) 298 : IF(IERR.NE.0)THEN 299 : SEGSUP NOTYPE 300 : ISUP2=0 301 : GOTO 9990 302 : ENDIF 303 : ENDIF 304 : * 305 : * TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES 306 : * 307 : if(lnomid(6).ne.0) then 308 : nomid=lnomid(6) 309 : segact nomid 310 : momatr=nomid 311 : nmatr=lesobl(/2) 312 : nmatf=lesfac(/2) 313 : lsupma=.false. 314 : else 315 : lsupma=.true. 315 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 316 : endif 317 : IF (MOMATR.EQ.0) THEN 318 : MOTERR(1:4)='MATE' 319 : MOTERR(5:8)=NOMTP(MELE) 319 : CALL ERREUR (76) 320 : GOTO 9990 321 : ENDIF 322 : * 323 : IF (NIFIBR.NE.8) THEN 324 : NBTYPE=1 325 : SEGINI NOTYPE 326 : MOTYPE=NOTYPE 327 : TYPE(1)='REAL*8' 328 : * 329 : ELSE 330 : NBTYPE=13 331 : SEGINI NOTYPE 332 : MOTYPE=NOTYPE 333 : DO I=1,NBTYPE 334 : TYPE(I)='REAL*8' 335 : ENDDO 336 : TYPE(10)='POINTEUREVOLUTIO' 337 : TYPE(11)='POINTEUREVOLUTIO' 338 : * 339 : ENDIF 340 : * 340 : CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1, 341 : & INFOS,3,IVAMAT) 342 : SEGSUP NOTYPE 343 : IF(IERR.NE.0)THEN 344 : GOTO 9990 345 : ENDIF 346 : NMATT=NMATR+NMATF 347 : * 348 : IF (ISUP5.EQ.1) THEN 348 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 349 : IF(IERR.NE.0)THEN 350 : ISUP5=0 351 : GOTO 9990 352 : ENDIF 353 : ENDIF 354 : * 355 : * TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES 356 : * 357 : if(lnomid(7).ne.0) then 358 : nomid=lnomid(7) 359 : segact nomid 360 : mocara=nomid 361 : ncara=lesobl(/2) 362 : ncarf=lesfac(/2) 363 : lsupca=.false. 364 : else 365 : lsupca=.true. 365 : CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF) 366 : endif 367 : * 368 : * write(6,*) ' lnomid(7) ncara ncarf ' , lnomid(7),ncara,ncarf 369 : NBTYPE=1 370 : SEGINI NOTYPE 371 : MOTYPE=NOTYPE 372 : TYPE(1)='REAL*8' 373 : * 373 : CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1, 374 : & INFOS,3,IVACAR) 375 : SEGSUP NOTYPE 376 : IF(IERR.NE.0)THEN 377 : GOTO 9990 378 : ENDIF 379 : NCARR=NCARA+NCARF 380 : * 381 : IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN 381 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 382 : IF(IERR.NE.0)THEN 383 : ISUP5=0 384 : GOTO 9990 385 : ENDIF 386 : ENDIF 387 : * 388 : * CREATION DES MCHAMLS DE LA SOUS ZONE 389 : * 390 : NBPTEL=NBGS 391 : NEL=NBELEM 392 : N1PTEL=NBPTEL 393 : N1EL=NEL 394 : * 395 : * CONTRAINTES 396 : * 397 : N2=NSTRS 398 : SEGINI MCHAML 399 : ICHAML(ISOUS)=MCHAML 400 : NS=1 401 : NCOSOU=NSTRS 402 : SEGINI MPTVAL 403 : IVASTF=MPTVAL 404 : NOMID=MOSTRS 405 : SEGACT NOMID 406 : DO 1100 ICOMP=1,NSTRS 407 : NOMCHE(ICOMP)=LESOBL(ICOMP) 408 : TYPCHE(ICOMP)='REAL*8' 409 : N2PTEL=0 410 : N2EL=0 411 : SEGINI MELVAL 412 : IELVAL(ICOMP)=MELVAL 413 : IVAL(ICOMP)=MELVAL 414 : 1100 CONTINUE 415 : SEGDES NOMID 416 : * 417 : * VARIABLES INTERNES 418 : * 419 : N2=NVART 420 : SEGINI MCHAM1 421 : MCHEL1.ICHAML(ISOUS)=MCHAM1 422 : NS=1 423 : NCOSOU=NVART 424 : SEGINI MPTVAL 425 : IVARIF=MPTVAL 426 : NOMID=MOVARI 427 : SEGACT NOMID 428 : DO 1200 ICOMP=1,NVARI 429 : MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP) 430 : MCHAM1.TYPCHE(ICOMP)='REAL*8' 431 : N2PTEL=0 432 : N2EL=0 433 : SEGINI MELVAL 434 : MCHAM1.IELVAL(ICOMP)=MELVAL 435 : IVAL(ICOMP)=MELVAL 436 : 1200 CONTINUE 437 : DO 1201 ICOMP=NVARI+1,NVART 438 : MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP) 439 : MCHAM1.TYPCHE(ICOMP)='REAL*8' 440 : N2PTEL=0 441 : N2EL=0 442 : SEGINI MELVAL 443 : MCHAM1.IELVAL(ICOMP)=MELVAL 444 : IVAL(ICOMP)=MELVAL 445 : 1201 CONTINUE 446 : SEGDES NOMID 447 : * 448 : * APPEL A L'ECOULEMENT PROPREMENT DIT 449 : * 449 : CALL FCOUL2(DEPSI,INFIBR,MELE,IPMAIL,IPMINT,NBPTEL,IVASTR, 450 : 1 IVARI,IVAMAT,IVACAR,NSTRS,NVART,NMATT,NCARR, 451 : 2 SIGMA,IVASTF,IVARIF,EPSUP,EPINF,DAMAG,NSTRS2) 452 : * 453 : 9990 CONTINUE 454 : * 455 : ckich contraction eventuelle des melval 456 : MPTVAL = IVASTF 457 : do ICOMP=1,NSTRS 458 : ichin = ival(icomp) 458 : call comred(ichin) 459 : ielval(icomp) = ichin 460 : C* ival(icomp) = ichin 461 : enddo 462 : 463 : MPTVAL=IVARIF 464 : do ICOMP=1,NVARI 465 : ichin = ival(icomp) 465 : call comred(ichin) 466 : mcham1.ielval(icomp) = ichin 467 : C* ival(icomp) = ichin 468 : enddo 469 : do ICOMP=NVARI+1,NVART 470 : ichin = ival(icomp) 470 : call comred(ichin) 471 : mcham1.ielval(icomp) = ichin 472 : C* ival(icomp) = ichin 473 : enddo 474 : * DESACTIVATION DES SEGMENTS 475 : * 476 : IF(ISUP1.EQ.1)THEN 476 : CALL DTMVAL (IVASTR,3) 477 : ELSE 477 : CALL DTMVAL (IVASTR,1) 478 : ENDIF 479 : IF(ISUP2.EQ.1)THEN 479 : CALL DTMVAL (IVARI,3) 480 : ELSE 480 : CALL DTMVAL (IVARI,1) 481 : ENDIF 482 : IF(ISUP5.EQ.1)THEN 482 : CALL DTMVAL (IVAMAT,3) 482 : CALL DTMVAL (IVACAR,3) 483 : ELSE 483 : CALL DTMVAL (IVAMAT,1) 483 : CALL DTMVAL (IVACAR,1) 484 : ENDIF 485 : IF (IERR.EQ.0) THEN 485 : CALL DTMVAL (IVASTF,1) 485 : CALL DTMVAL (IVARIF,1) 486 : ELSE 486 : CALL DTMVAL (IVASTF,3) 486 : CALL DTMVAL (IVARIF,3) 487 : END IF 488 : * 489 : IF (MOCARA.NE.0) THEN 490 : NOMID=MOCARA 491 : if(lsupca)SEGSUP NOMID 492 : END IF 493 : * 494 : IF (MOMATR.NE.0) THEN 495 : NOMID=MOMATR 496 : if(lsupma)SEGSUP NOMID 497 : END IF 498 : * 499 : IF (MOVARI.NE.0) THEN 500 : NOMID=MOVARI 501 : if(lsupva)SEGSUP NOMID 502 : END IF 503 : * 504 : IF (MOSTRS.NE.0) THEN 505 : NOMID=MOSTRS 506 : if(lsupco)SEGSUP NOMID 507 : END IF 508 : * 509 : * IF (IPINF .NE.0) THEN 510 : * INFO=IPINF 511 : * SEGSUP INFO 512 : * END IF 513 : * 514 : SEGDES,MINTE 515 : SEGDES MELEME,IMODEL 516 : * 517 : IF (IERR.EQ.0) THEN 518 : SEGDES MCHAML,MCHAM1 519 : ELSE 520 : SEGSUP MCHAML,MCHAM1 521 : GOTO 888 522 : ENDIF 523 : 1000 CONTINUE 524 : * 525 : 888 CONTINUE 526 : SEGDES MMODEL 527 : IF (IERR.EQ.0)THEN 528 : IRETO=1 529 : SEGDES MCHELM,MCHEL1 530 : ELSE 531 : IRETO=0 532 : SEGSUP MCHELM,MCHEL1 533 : ENDIF 534 : * 535 : RETURN 536 : END 537 : 538 : 539 :
© Cast3M 2003 - All rights reserved.
Disclaimer