1 : C CFL1 SOURCE CHAT 11/03/16 21:16:39 6902 2 : SUBROUTINE CFL1(IPMODL,IPCHA1,IPCHA2,IPCHA3,IPCHA4,ICAS) 3 : * 4 : *----------------------------------------------------------------------- 5 : * 6 : * calcul du pas de temps de stabilité operateur CFL 7 : * de la vitesse du son operateur CSON 8 : * de la taille de propagation de l'information opérateur TAILLE 9 : * 10 : * en entrée 11 : * ipmodl objet model 12 : * ipcha1 champ de caractéristiques 13 : * ipcha2 champ de vitesse du son composante 'CSON' 14 : * ipcha3 champ de taille du maillage composante 'L' ( et 'L2H' facultatif) 15 : * icas décrit le cas de figure 16 : * entree -------> sortie 17 : * = 1 ipcha1 pas de temps cfl 18 : * = 2 ipcha2 ( et ipcha1 si cara geom ) " " " 19 : * = 3 ipcha3 et ipcha1 " " " 20 : * = 4 ipcha1 vitesse du son 21 : * = 5 ( et ipcha1 si cara geom ) parametre de taille 22 : * en sortie 23 : * ipcha4 le champ par element demandé 24 : * 25 : *----------------------------------------------------------------------- 26 : * 27 : IMPLICIT INTEGER(I-N) 28 : IMPLICIT REAL*8(A-H,O-Z) 29 : -INC CCOPTIO 30 : -INC CCHAMP 31 : -INC CCGEOME 32 : -INC CCREEL 33 : -INC SMCHAML 34 : -INC SMINTE 35 : -INC SMELEME 36 : -INC SMRIGID 37 : -INC SMMODEL 38 : -INC SMCOORD 39 : -INC SMLREEL 40 : C 41 : * SEGMENT INFO 42 : * INTEGER INFELE(JG) 43 : * ENDSEGMENT 44 : * 45 : SEGMENT NOTYPE 46 : CHARACTER*16 TYPE(NBTYPE) 47 : ENDSEGMENT 48 : * 49 : SEGMENT MPTVAL 50 : INTEGER IPOS(NS) ,NSOF(NS) 51 : INTEGER IVAL(NCOSOU) 52 : CHARACTER*16 TYVAL(NCOSOU) 53 : ENDSEGMENT 54 : * 55 : CHARACTER*(NCONCH) CONM 56 : CHARACTER*8 CMATE 57 : PARAMETER ( NINF=3 ) 58 : INTEGER INFOS(NINF) 59 : CHARACTER*4 CMOT 60 : LOGICAL DEUCMP,lsupma 61 : *--------------------------------------------------------------------* 62 : * 62 : * call tcloc2(' ',-1,it) 63 : deucmp=.FALSE. 64 : IF ( ICAS .EQ. 1) THEN 65 : IPCHE1 = IPCHA1 66 : IPCHE2 = 0 67 : ELSE IF ( ICAS .EQ. 2 ) THEN 68 : IPCHE1 = IPCHA1 69 : IPCHE2 = IPCHA2 70 : ELSE IF ( ICAS .EQ. 3 ) THEN 71 : IPCHE1 = IPCHA1 72 : IPCHE2 = IPCHA3 73 : ELSE IF ( ICAS .EQ. 4 ) THEN 74 : IPCHE1 = IPCHA1 75 : IPCHE2 = 0 76 : ELSE IF ( ICAS .EQ. 5 ) THEN 77 : IPCHE1 = IPCHA1 78 : IPCHE2 = 0 79 : ENDIF 80 : 81 : MMODEL = IPMODL 82 : SEGACT MMODEL 83 : NSOUS = KMODEL(/1) 84 : * 85 : * initialisation de l'objet résultat 86 : * 87 : 88 : N1 = NSOUS 89 : N3 = 6 90 : L1 = 16 91 : SEGINI MCHELM 92 : IF ( ICAS .LE. 3 .OR. ICAS .GE. 1 ) THEN 93 : TITCHE = 'PAS DE TEMPS CFL' 94 : ELSE IF ( ICAS .EQ. 4 ) THEN 95 : TITCHE = 'VITESSE DU SON' 96 : ELSE IF ( ICAS .EQ. 5 ) THEN 97 : TITCHE = 'TAILLE CFL' 98 : ENDIF 99 : * 100 : IFOCHE = IFOUR 101 : *--------------------------------------------------------------------* 102 : * 103 : * BOUCLE SUR LES ZONES ELEMENTAIRES ( MEME TYPE D'EF ) 104 : * 105 : *--------------------------------------------------------------------* 106 : * 107 : DO 500 ISOUS=1,NSOUS 108 : IMODEL=KMODEL(ISOUS) 109 : SEGACT IMODEL 110 : lsupma=.true. 111 : * 112 : * INITIALISATIONS 113 : * 114 : IVAM1 = 0 115 : IVAM2 = 0 116 : * 117 : MELE = NEFMOD 118 : IPMAIL= IMAMOD 119 : CONM = CONMOD 120 : NFOR = FORMOD(/2) 121 : NMAT = MATMOD(/2) 122 : * 123 : IVAMAT=0 124 : IVACAR=0 125 : NMATR=0 126 : NMATF=0 127 : NCARA=0 128 : NCARF=0 129 : MOCARA=0 130 : MOMATR=0 131 : DESCR=0 132 : IMATRI=0 133 : * 134 : C 135 : C COQUE INTEGREE OU PAS ? 136 : C 137 : IF(INFMOD(/1).NE.0)THEN 138 : NPINT=INFMOD(1) 139 : ELSE 140 : NPINT=0 141 : ENDIF 142 : * 143 : * formulation et matériau ( ca peut servir par la suite ) 144 : * 144 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) 145 : * 146 : * sortie cmate : Nom du materiau (isotrope, orthotrope....) 147 : * mate : Numero du materiau 148 : * intau : Numero de nature 149 : * 150 : * 151 : IF (CMATE.EQ.' ')THEN 151 : CALL ERREUR(251) 152 : SEGSUP MCHELM 153 : SEGDES IMODEL,MMODEL 154 : IRET=0 155 : RETURN 156 : ENDIF 157 : * 158 : * information sur l'élément finis : nécessaire pour les tests 159 : * qui donnent les noms de composantes 160 : * 161 : * 162 : INTTYP = 2 162 : * CALL ELQUOI(MELE,0,INTTYP,IPINF,IMODEL) 163 : * 164 : IF ( IERR.NE.0 ) THEN 165 : SEGSUP MCHELM 166 : SEGDES IMODEL,MMODEL 167 : IPCHA4=0 168 : RETURN 169 : ENDIF 170 : * 171 : * INFO = IPINF 172 : * LHOOK = INFELE(10) 173 : * LHOO2 = LHOOK*LHOOK 174 : * NSTRS = INFELE(16) 175 : MFR = INFELE(13) 176 : * LW = INFELE(7) 177 : * NDDL = INFELE(15) 178 : IELE = INFELE(14) 179 : * LRE = INFELE(9) 180 : * IPORE = INFELE(8) 181 : * IPINT = INFELE(11) 182 : ipint=infmod(4) 183 : * 184 : * 185 : * Verification de compatibilite de MCHAML du point de vue des 186 : * 187 : * tableaux INFCHE et creation du tableau INFOS pour COMCHA 188 : * 188 : CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,IRTD) 189 : IF (IRTD.EQ.0) THEN 190 : * incompatibilité entre le modele et le chamelem 191 : SEGDES IMODEL,MMODEL 192 : SEGSUP MCHELM 193 : RETURN 194 : ENDIF 195 : 195 : * call tcloc2('Apres ident',6,it) 196 : 197 : * 198 : * 199 : *--------------------------------------------------------------------* 200 : * determination des noms de composantes dans les champs 201 : * 202 : * on commence par le champ 2 qui n'existe que dans le cas 2 et 3 203 : IF (ICAS.EQ.2 .OR.ICAS.EQ.3) THEN 204 : IF (ICAS.EQ.2) THEN 205 : * le champ 2 contient la vitesse du son 206 : NBROBL=1 207 : NBRFAC=0 208 : SEGINI NOMID 209 : LESOBL(1)='CSON' 210 : NBTYPE=1 211 : SEGINI NOTYPE 212 : TYPE(1) = 'REAL*8' 213 : ELSE IF(ICAS.EQ.3) THEN 214 : * le champ 2 contient le parametre de taille 215 : NBROBL=1 216 : NBRFAC=1 217 : SEGINI NOMID 218 : LESOBL(1)='L' 219 : LESFAC(1) = 'L2H' 220 : NBTYPE=1 221 : SEGINI NOTYPE 222 : TYPE(1) = 'REAL*8' 223 : ENDIF 224 : MOTYPE = NOTYPE 225 : MOMATR = NOMID 226 : * 227 : * 228 : * ===> 229 : * write(6,*) 'Sous zone' ,isous,' Composante obligatoire ipche2' 230 : * write(6,7001) (lesobl(i),i=1,nbrobl) 231 : * write(6,*) 'facultatives' 232 : * write(6,7001) (lesfac(i),i=1,nbrfac) 233 : * 7001 format(4(A4,2X)) 234 : * Recherche des valeurs des composantes dans les MELVAL d'un 235 : * CHAMELEM. On distingue les composantes obligatoires des 236 : * composantes facultatives. 236 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAM2) 237 : SEGSUP NOTYPE,NOMID 238 : IF (IERR.NE.0) THEN 239 : SEGSUP MCHELM 240 : SEGDES IMODEL,MMODEL 241 : RETURN 242 : ENDIF 243 : ENDIF 243 : * call tcloc2('Apres komcha1',6,it) 244 : * 245 : * dans les cas 1,2 ou 5 il peut y avoir des caractéristiques geometriques 246 : * dans les cas 1,3 ou 4 il y a des caractéristiques matériau 247 : * on commence par traiter les caractéristiques matériau 248 : IF (ICAS .EQ. 1 .OR. ICAS .EQ. 3 .OR. ICAS .EQ. 4) THEN 249 : IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN 250 : NBROBL=3 251 : NBRFAC=0 252 : SEGINI NOMID 253 : MOMATR=NOMID 254 : LESOBL(1)='YOUN' 255 : LESOBL(2)='NU' 256 : LESOBL(3)='RHO' 257 : NMATR=NBROBL 258 : NMATF=NBRFAC 259 : ELSE 260 : $ IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN 261 : * indisponible! pour les volontaies voir voir rigi1.eso 262 : * SEGSUP MCHELM 263 : SEGDES MMODEL,IMODEL 263 : CALL ERREUR(251) 264 : RETURN 265 : ELSE 266 : $ IF (FORMOD(1).EQ.'POREUX '.AND.CMATE.EQ.'ISOTROPE') THEN 267 : * indisponible! pour les volontaies voir rigi1.eso 267 : CALL ERREUR(251) 268 : SEGSUP MCHELM 269 : SEGDES MMODEL,IMODEL 270 : RETURN 271 : * 272 : ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN 273 : * indisponible! pour les volontaies voir rigi1.eso 274 : SEGSUP MCHELM 275 : SEGDES MMODEL,IMODEL 275 : CALL ERREUR(251) 276 : RETURN 277 : * 278 : ELSE 279 : if(lnomid(6).ne.0) then 280 : nomid=lnomid(6) 281 : segact nomid 282 : momatr=nomid 283 : nmatr=lesobl(/2) 284 : nmatf=lesfac(/2) 285 : lsupma=.false. 286 : else 287 : lsupma=.true. 287 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 288 : endif 289 : ENDIF 290 : * 291 : * type des composantes 292 : * 293 : IF (CMATE.EQ.'SECTION') THEN 294 : SEGSUP MCHELM 295 : SEGDES MMODEL,IMODEL 295 : CALL ERREUR(251) 296 : RETURN 297 : ELSE 298 : NBTYPE=1 299 : SEGINI NOTYPE 300 : TYPE(1)='REAL*8' 301 : MOTYPE=NOTYPE 302 : ENDIF 303 : 304 : * 305 : * dans le cas ou il y des caractéristiques géometriques on augmente 306 : * motype 307 : * 308 : ELSE IF((ICAS.EQ.2 .OR. ICAS.EQ.5).AND.IPCHE1.NE.0)THEN 309 : * dans ces cas il faut eventuellement récuperer les caractéristiques 310 : * geométriques et avoir initialiser notype avant 311 : NBROBL=0 312 : NBRFAC=0 313 : SEGINI NOMID 314 : MOMATR=NOMID 315 : NBTYPE=1 316 : SEGINI NOTYPE 317 : MOTYPE=NOTYPE 318 : TYPE(1)='REAL*8' 319 : NMATR=NBROBL 320 : NMATF=NBRFAC 321 : ENDIF 322 : * 323 : IF((IPCHE1.NE.0).AND.(ICAS.NE.4).AND.(ICAS.NE.3))THEN 324 : * 325 : * 326 : * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES 327 : * 328 : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 329 : NBROBL=NBROBL+1 330 : IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN 331 : NBRFAC=NBRFAC+2 332 : ELSE 333 : NBRFAC=NBRFAC+1 334 : ENDIF 335 : SEGADJ NOMID 336 : MOCARA=NOMID 337 : LESOBL(NBROBL)='EPAI' 338 : LESFAC(NBRFAC)='EXCE' 339 : IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN 340 : LESFAC(NBRFAC-1)='EXCE' 341 : LESFAC(NBRFAC)='DIM3' 342 : ELSE 343 : LESFAC(NBRFAC)='EXCE' 344 : ENDIF 345 : * 346 : * SECTION POUR LES BARRES ET LES CERCES 347 : * 348 : ELSE IF (MFR.EQ.27) THEN 349 : NBROBL=NBROBL+1 350 : SEGADJ NOMID 351 : LESOBL(NBROBL)='SECT' 352 : * 353 : * section, excentrements et orientation pour les barres excentrees 354 : * 355 : ELSE IF (MFR.EQ.49) THEN 356 : NBROBL=NBROBL+6 357 : SEGADJ NOMID 358 : LESOBL(NBROBL-5)='SECT' 359 : LESOBL(NBROBL-4)='EXCZ' 360 : LESOBL(NBROBL-3)='EXCY' 361 : LESOBL(NBROBL-2)='VX ' 362 : LESOBL(NBROBL-1)='VY ' 363 : LESOBL(NBROBL)='VZ ' 364 : * 365 : * CARACTERISTIQUES POUR LES POUTRES 366 : * 367 : ELSE IF (MFR.EQ.7 ) THEN 368 : NBROBL=NBROBL+4 369 : NBRFAC=NBRFAC+2 370 : SEGADJ NOMID 371 : LESOBL(NBROBL-3)='TORS' 372 : LESOBL(NBROBL-2)='INRY' 373 : LESOBL(NBROBL-1)='INRZ' 374 : LESOBL(NBROBL)='SECT' 375 : LESFAC(NBRFAC-1)='SECY' 376 : LESFAC(NBRFAC)='SECZ' 377 : * 378 : * CARACTERISTIQUES POUR LES TUYAUX 379 : * 380 : ELSE IF (MFR.EQ.13) THEN 381 : * pour les autres on ne ient pas compte des modification 382 : * qui assouplissent le tuyau donc omega max diminue 383 : NBROBL=NBROBL+2 384 : SEGADJ NOMID 385 : LESOBL(NBROBL-1)='EPAI' 386 : LESOBL(NBROBL)='RAYO' 387 : ELSE IF (MFR.EQ.39) THEN 388 : NBROBL=NBROBL+2 389 : NBRFAC=NBRFAC+2 390 : SEGADJ NOMID 391 : LESOBL(NBROBL-1)='EPAI' 392 : LESOBL(NBROBL)='RAYO' 393 : LESFAC(NBRFAC-1)='RACO' 394 : LESFAC(NBRFAC)='PRES' 395 : ENDIF 396 : * 397 : MOMATR=NOMID 398 : NMATR=NBROBL 399 : NMATF=NBRFAC 400 : * 401 : * ===> 402 : * write(6,*) 'Sous zone' ,isous,' Composante obligatoire ipche1' 403 : * write(6,7001) (lesobl(i),i=1,nbrobl) 404 : * write(6,*) 'facultatives' 405 : * write(6,7001) (lesfac(i),i=1,nbrfac) 406 : * 407 : * 408 : ENDIF 409 : * 410 : IF (NMATR.NE.0) THEN 410 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAM1) 411 : SEGSUP NOTYPE 412 : nomid=momatr 413 : if(lsupma)segsup NOMID 414 : IF (IERR.NE.0) THEN 415 : SEGDES IMODEL,MMODEL 416 : SEGSUP MCHELM 417 : RETURN 418 : ENDIF 418 : * call tcloc2('Apres komcha2',6,it) 419 : ENDIF 420 : 421 : * 422 : * 423 : *--------------------------------------------------------------------* 424 : * remplissage de la description du sous champ résultat 425 : * 426 : * dimension 427 : * = 2 si taille et coque ou poutre 428 : * mfr obtenu par elquoi nous renseigne 429 : * 430 : IF ((ICAS.EQ.5).AND. 431 : & (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.7.OR.MFR.EQ.9.OR.MFR.EQ.13)) 432 : & THEN 433 : DEUCMP = .TRUE. 434 : N2 = 2 435 : SEGINI MCHAML 436 : NOMCHE(1) = 'L' 437 : NOMCHE(2) = 'L2H' 438 : TYPCHE(1) = 'REAL*8' 439 : TYPCHE(2) = 'REAL*8' 440 : ELSE IF (ICAS.EQ.5) THEN 441 : N2 = 1 442 : SEGINI MCHAML 443 : NOMCHE(1) = 'L' 444 : TYPCHE(1) = 'REAL*8' 445 : ELSE IF (ICAS.EQ.4) THEN 446 : N2 = 1 447 : SEGINI MCHAML 448 : NOMCHE(1) = 'CSON' 449 : TYPCHE(1) = 'REAL*8' 450 : ELSE IF (ICAS.EQ.1.OR.ICAS.EQ.2.OR.ICAS.EQ.3) THEN 451 : N2 = 1 452 : SEGINI MCHAML 453 : NOMCHE(1) = 'TCFL' 454 : TYPCHE(1) = 'REAL*8' 455 : ENDIF 456 : ICHAML(ISOUS) = MCHAML 457 : * 458 : * le chamelem est defini au centre de gravité 459 : * 460 : INFCHE(ISOUS,6) = 2 461 : * il faut brancher sur le segment d'intégration 462 : INFCHE(ISOUS,4)=IPINT 463 : * nom du constituant 464 : CONCHE(ISOUS) = CONMOD 465 : * maillage 466 : IMACHE(ISOUS) = IPMAIL 467 : * a priori info ne set plus 468 : * SEGSUP INFO 469 : * 470 : *--------------------------------------------------------------------* 471 : * appel au sous routine spécifiques 472 : * 473 : * NUMERO DES ETIQUETTES : 474 : * Les elements sont groupes comme suit : 475 : * - massif,liquide 'surface libre' poreux ----------------------> 4 476 : * - coq3,dkt,coq4,coq8,coq2,dst --------------------------------> 12 477 : * - poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,jot3> 27 478 : * - joi4,joi2,poutre de timoschenko,joi3 29 479 : * 480 : * 1 5 0 5 0 481 : GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,12,99, 4, 4, 4, 4,99,99,99, 482 : 2 99,99, 4, 4, 4, 4,27,27,29,99,99,99,99,99,99,99,99,99,99,99, 483 : 4 27,29,99,27,99,29,12,99,27,99,99,99,99,99,12,27,99,99,99,99, 484 : 6 99,99,99,99,99,99,99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99, 485 : 8 99,99,99,29,99,99,99,99,99,99,99,99,27,12,99,99,99,99,99,99, 486 : 1 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 487 : 2 99,99,99,99,99,99,99),MELE 488 : 99 CONTINUE 489 : MOTERR(1:4)=NOMTP(MELE) 490 : MOTERR(9:12)='CFL1' 490 : CALL ERREUR(86) 491 : SEGDES IMODEL,MMODEL 492 : SEGSUP MCHELM,MCHAML 493 : RETURN 494 : C 495 : C_______________________________________________________________________ 496 : C 497 : C massif 498 : C_______________________________________________________________________ 499 : C 500 : 4 CONTINUE 501 : * write(6,*) 'Appel a cfl2' 501 : CALL CFL2(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2) 502 : IF (IERR.NE.0) RETURN 503 : GOTO 400 504 : 505 : C_______________________________________________________________________ 506 : C 507 : C ELTS DE RACCORD LIQUIDE SOLIDE RAC2 RACO LIA3 LIA4 LICO LIC4 508 : C PAS DE RIGIDITE 509 : C_______________________________________________________________________ 510 : C 511 : 12 CONTINUE 512 : * write(6,*) 'Appel a cfl3' 512 : CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2) 513 : IF (IERR.NE.0) RETURN 514 : GOTO 400 515 : C_______________________________________________________________________ 516 : C 517 : C coq3,dkt,coq4,coq8,coq2,dst 518 : C_______________________________________________________________________ 519 : C 520 : 27 CONTINUE 521 : * write(6,*) 'Appel a cfl4' 521 : CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2) 522 : IF (IERR.NE.0) RETURN 523 : GOTO 400 524 : C_______________________________________________________________________ 525 : C 526 : C poutre,barre,homogeneise 527 : C poutre de Timoschenko 528 : C_______________________________________________________________________ 529 : C 530 : 29 CONTINUE 531 : * write(6,*) 'Appel a cfl5' 532 : * ivam1 et 2 sont actifs , ipmail descativé 532 : CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2) 533 : * en sortie melv1 et melv2 sont inactifs 534 : IF (IERR.NE.0) RETURN 535 : GOTO 400 536 : * 537 : * 538 : * 539 : 400 CONTINUE 540 : * on raccroche le résultat 541 : IELVAL(1) = MELV1 542 : IF (DEUCMP) IELVAL(2) = MELV2 543 : SEGDES MCHAML 544 : SEGDES IMODEL 545 : IF (IVAM1.NE.0) THEN 546 : MPTVAL = IVAM1 547 : SEGSUP MPTVAL 548 : ENDIF 549 : IF (IVAM2.NE.0) THEN 550 : MPTVAL = IVAM2 551 : SEGSUP MPTVAL 552 : ENDIF 553 : * fin boucle sur les sous zone des champs 554 : 500 CONTINUE 555 : * 556 : * 557 : * 558 : IPCHA4 = MCHELM 559 : SEGDES MCHELM,MMODEL 560 : RETURN 561 : END 562 : 563 : 564 : 565 : 566 : 567 : 568 : 569 : 570 : 571 : 572 : 573 : 574 : 575 : 576 : 577 : 578 : 579 : 580 : 581 : 582 : 583 : 584 : 585 :
© Cast3M 2003 - All rights reserved.
Disclaimer