1 : C INCOMS SOURCE GOUNAND 11/04/29 21:15:23 6947 2 : SUBROUTINE INCOMS(MYCOMS,CGEOM2,LERF,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : INCOMS 7 : C PROJET : Noyau linéaire NLIN 8 : C DESCRIPTION : Initialise le segment contenant les informations sur 9 : C les lois de comportement 10 : C 11 : C LANGAGE : ESOPE 12 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 13 : C mél : gounand@semt2.smts.cea.fr 14 : C*********************************************************************** 15 : C APPELES : 16 : C APPELES (E/S) : 17 : C APPELE PAR : 18 : C*********************************************************************** 19 : C ENTREES : - 20 : C SORTIES : MYCOMS 21 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 22 : C*********************************************************************** 23 : C VERSION : v1, 10/05/04, version initiale 24 : C HISTORIQUE : v1, 10/05/04, création 25 : C HISTORIQUE : 26 : C HISTORIQUE : 27 : C*********************************************************************** 28 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 29 : C en cas de modification de ce sous-programme afin de faciliter 30 : C la maintenance ! 31 : C*********************************************************************** 32 : -INC CCOPTIO 33 : -INC SMELEME 34 : POINTEUR CGEOM2.MELEME 35 : -INC SMLMOTS 36 : POINTEUR LNCOM.MLMOTS 37 : CBEGININCLUDE SLCOMP 38 : SEGMENT COMP 39 : CHARACTER*8 NOMCOM 40 : INTEGER DERCOF(NCOCOF) 41 : LOGICAL LTREF 42 : ENDSEGMENT 43 : SEGMENT COMPS 44 : POINTEUR LISCOM(NBCOMP).COMP 45 : ENDSEGMENT 46 : CENDINCLUDE SLCOMP 47 : POINTEUR MYCOMS.COMPS 48 : POINTEUR COCOUR.COMP 49 : * 50 : INTEGER IMPR,IRET 51 : CHARACTER*8 BLANC 52 : CHARACTER*8 NCOM 53 : INTEGER IDIM0,IDIM1,IDIM2,IDIM3,IDIM4 54 : CHARACTER*1 CDIM0,CDIM1,CDIM2,CDIM3,CDIM4,CMETH,CIH 55 : CHARACTER*1 CID 56 : * 57 : * 58 : * Executable statements 59 : * 60 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans incoms' 61 : BLANC=' ' 62 : NBCOMP=0 63 : SEGINI MYCOMS 64 : * 65 : * Détermination de la dimension de l'espace de dérivation 66 : * 67 : IF (LERF.NE.0) THEN 67 : CALL DIMESH(CGEOM2,IDMESH,IMPR,IRET) 68 : IF (IRET.NE.0) GOTO 9999 69 : IESDER=IDMESH 70 : ELSE 71 : IESDER=IDIM 72 : ENDIF 73 : * 74 : * Loi de comportement RIEN 75 : * 76 : NCOM=BLANC 77 : NCOM='RIEN' 78 : NCOCOF=0 79 : SEGINI COCOUR 80 : COCOUR.NOMCOM=NCOM 81 : COCOUR.LTREF=.FALSE. 82 : SEGDES COCOUR 83 : MYCOMS.LISCOM(**)=COCOUR 84 : * 85 : * Loi de comportement IDEN 86 : * 87 : NCOM=BLANC 88 : NCOM='IDEN' 89 : NCOCOF=1 90 : SEGINI COCOUR 91 : COCOUR.NOMCOM=NCOM 92 : COCOUR.DERCOF(1)=0 93 : COCOUR.LTREF=.FALSE. 94 : SEGDES COCOUR 95 : MYCOMS.LISCOM(**)=COCOUR 96 : * 97 : * Loi de comportement rays = epsi * sigma * T^3 98 : * 99 : NCOM=BLANC 100 : NCOM='RAYS' 101 : NCOCOF=3 102 : SEGINI COCOUR 103 : COCOUR.NOMCOM=NCOM 104 : COCOUR.DERCOF(1)=0 105 : COCOUR.DERCOF(2)=0 106 : COCOUR.DERCOF(3)=0 107 : COCOUR.LTREF=.FALSE. 108 : SEGDES COCOUR 109 : MYCOMS.LISCOM(**)=COCOUR 110 : * 111 : * Loi de comportement MUR 112 : * 113 : NCOM=BLANC 114 : NCOM='MUR' 115 : NCOCOF=4 116 : SEGINI COCOUR 117 : COCOUR.NOMCOM=NCOM 118 : COCOUR.DERCOF(1)=0 119 : COCOUR.DERCOF(2)=0 120 : COCOUR.DERCOF(3)=0 121 : COCOUR.DERCOF(4)=0 122 : COCOUR.LTREF=.FALSE. 123 : SEGDES COCOUR 124 : MYCOMS.LISCOM(**)=COCOUR 125 : * 126 : * Loi de comportement SUTH 127 : * 128 : NCOM=BLANC 129 : NCOM='SUTH' 130 : NCOCOF=3 131 : SEGINI COCOUR 132 : COCOUR.NOMCOM=NCOM 133 : COCOUR.DERCOF(1)=0 134 : COCOUR.DERCOF(2)=0 135 : COCOUR.DERCOF(3)=0 136 : COCOUR.LTREF=.FALSE. 137 : SEGDES COCOUR 138 : MYCOMS.LISCOM(**)=COCOUR 139 : * 140 : * Loi de comportement DDX{1..IESDER} 141 : * 142 : DO IID=1,IESDER 142 : CALL INT2CH(IID,CID,IMPR,IRET) 143 : IF (IRET.NE.0) GOTO 9999 144 : NCOM=BLANC 145 : NCOM='D/DX' 146 : NCOM(5:5)=CID 147 : NCOCOF=1 148 : SEGINI COCOUR 149 : COCOUR.NOMCOM=NCOM 150 : COCOUR.DERCOF(1)=1 151 : COCOUR.LTREF=.FALSE. 152 : SEGDES COCOUR 153 : MYCOMS.LISCOM(**)=COCOUR 154 : ENDDO 155 : * 156 : * Loi de comportement DIV 157 : * 158 : NCOM=BLANC 159 : NCOM='DIV' 160 : NCOCOF=IESDER 161 : SEGINI COCOUR 162 : COCOUR.NOMCOM=NCOM 163 : DO IIDIM=1,IESDER 164 : COCOUR.DERCOF(IIDIM)=1 165 : ENDDO 166 : COCOUR.LTREF=.FALSE. 167 : SEGDES COCOUR 168 : MYCOMS.LISCOM(**)=COCOUR 169 : * 170 : * Loi de comportement MAXI 171 : * 172 : NCOM=BLANC 173 : NCOM='MAXI' 174 : NCOCOF=1 175 : SEGINI COCOUR 176 : COCOUR.NOMCOM=NCOM 177 : COCOUR.DERCOF(1)=0 178 : COCOUR.LTREF=.FALSE. 179 : SEGDES COCOUR 180 : MYCOMS.LISCOM(**)=COCOUR 181 : * 182 : * Loi de comportement TAU 183 : * 184 : NCOM=BLANC 185 : NCOM='TAU' 186 : NCOCOF=5 187 : SEGINI COCOUR 188 : COCOUR.NOMCOM=NCOM 189 : COCOUR.DERCOF(1)=0 190 : COCOUR.DERCOF(2)=0 191 : COCOUR.DERCOF(3)=0 192 : COCOUR.DERCOF(4)=0 193 : COCOUR.DERCOF(5)=0 194 : COCOUR.LTREF=.FALSE. 195 : SEGDES COCOUR 196 : MYCOMS.LISCOM(**)=COCOUR 197 : * 198 : * Loi de comportement SIGMA 199 : * 200 : NCOM=BLANC 201 : NCOM='SIGMA' 202 : NCOCOF=5 203 : SEGINI COCOUR 204 : COCOUR.NOMCOM=NCOM 205 : COCOUR.DERCOF(1)=0 206 : COCOUR.DERCOF(2)=0 207 : COCOUR.DERCOF(3)=0 208 : COCOUR.DERCOF(4)=0 209 : COCOUR.DERCOF(5)=0 210 : COCOUR.LTREF=.FALSE. 211 : SEGDES COCOUR 212 : MYCOMS.LISCOM(**)=COCOUR 213 : * 214 : * Loi de comportement TAILDIRE 215 : * 216 : NCOM=BLANC 217 : NCOM='TAILDIRE' 218 : NCOCOF=IDIM 219 : SEGINI COCOUR 220 : COCOUR.NOMCOM=NCOM 221 : DO IIDIM=1,IDIM 222 : COCOUR.DERCOF(IIDIM)=0 223 : ENDDO 224 : COCOUR.LTREF=.TRUE. 225 : SEGDES COCOUR 226 : MYCOMS.LISCOM(**)=COCOUR 227 : * 228 : * Loi de comportement VOLORI 229 : * 230 : NCOM=BLANC 231 : NCOM='VOLORI' 232 : NCOCOF=0 233 : SEGINI COCOUR 234 : COCOUR.NOMCOM=NCOM 235 : COCOUR.LTREF=.TRUE. 236 : SEGDES COCOUR 237 : MYCOMS.LISCOM(**)=COCOUR 238 : * 239 : * Loi de comportement MADSMID 240 : * max |d|/min|d| où d=det J 241 : * avec un signe moins si d change de signe 242 : * 243 : NCOM=BLANC 244 : NCOM='MADSMID' 245 : NCOCOF=0 246 : SEGINI COCOUR 247 : COCOUR.NOMCOM=NCOM 248 : COCOUR.LTREF=.TRUE. 249 : SEGDES COCOUR 250 : MYCOMS.LISCOM(**)=COCOUR 251 : * 252 : * Loi de comportement AHUF : Huang 253 : * AHPF : Huang préconditionné 254 : * 255 : DO ICOPO=1,2 256 : IF (ICOPO.EQ.1) THEN 257 : CIH='U' 258 : ELSE 259 : CIH='P' 260 : ENDIF 261 : NARG=2 262 : NCOM=BLANC 263 : NCOM='AH?F' 264 : NCOM(3:3)=CIH 265 : NCOCOF=((IDIM*(IDIM+1))/2)+NARG 266 : SEGINI COCOUR 267 : COCOUR.NOMCOM=NCOM 268 : * Plus clair, mais inutile 269 : * DO ICOCOF=1,NCOCOF 270 : * COCOUR.DERCOF(ICOCOF)=0 271 : * ENDDO 272 : COCOUR.LTREF=.TRUE. 273 : SEGDES COCOUR 274 : MYCOMS.LISCOM(**)=COCOUR 275 : * 276 : * Lois de comportement AHUR{1..idim}*{0..iesder} 277 : * 278 : DO IDIM1=1,IDIM 278 : CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) 279 : IF (IRET.NE.0) GOTO 9999 280 : DO IDIM2=0,IESDER 280 : CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) 281 : IF (IRET.NE.0) GOTO 9999 282 : NCOM=BLANC 283 : NCOM='AH?R' 284 : NCOM(3:3)=CIH 285 : NCOM(5:5)=CDIM1 286 : NCOM(6:6)=CDIM2 287 : NCOCOF=((IDIM*(IDIM+1))/2)+NARG 288 : SEGINI COCOUR 289 : COCOUR.NOMCOM=NCOM 290 : COCOUR.LTREF=.TRUE. 291 : SEGDES COCOUR 292 : MYCOMS.LISCOM(**)=COCOUR 293 : ENDDO 294 : ENDDO 295 : * 296 : * Lois de comportement AHUJ{1..idim}*4 297 : * 298 : DO IDIM1=1,IDIM 298 : CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) 299 : IF (IRET.NE.0) GOTO 9999 300 : DO IDIM2=0,IESDER 300 : CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) 301 : IF (IRET.NE.0) GOTO 9999 302 : DO IDIM3=1,IDIM 302 : CALL INT2CH(IDIM3,CDIM3,IMPR,IRET) 303 : IF (IRET.NE.0) GOTO 9999 304 : DO IDIM4=0,IESDER 304 : CALL INT2CH(IDIM4,CDIM4,IMPR,IRET) 305 : IF (IRET.NE.0) GOTO 9999 306 : NCOM=BLANC 307 : NCOM='AH?J' 308 : NCOM(3:3)=CIH 309 : NCOM(5:5)=CDIM1 310 : NCOM(6:6)=CDIM2 311 : NCOM(7:7)=CDIM3 312 : NCOM(8:8)=CDIM4 313 : NCOCOF=((IDIM*(IDIM+1))/2)+NARG 314 : SEGINI COCOUR 315 : COCOUR.NOMCOM=NCOM 316 : COCOUR.LTREF=.TRUE. 317 : SEGDES COCOUR 318 : MYCOMS.LISCOM(**)=COCOUR 319 : ENDDO 320 : ENDDO 321 : ENDDO 322 : ENDDO 323 : ENDDO 324 : * 325 : * Loi de comportement Qualité de maillage 326 : * 327 : DO IQ=1,2 328 : NCOM=BLANC 329 : IF (IQ.EQ.1) THEN 330 : NCOM='QEQU' 331 : ELSE 332 : NCOM='QALI' 333 : ENDIF 334 : NCOCOF=((IDIM*(IDIM+1))/2) 335 : SEGINI COCOUR 336 : COCOUR.NOMCOM=NCOM 337 : COCOUR.LTREF=.TRUE. 338 : SEGDES COCOUR 339 : MYCOMS.LISCOM(**)=COCOUR 340 : ENDDO 341 : * 342 : * Lois de comportement MUSTAB{1,2,3}{1..idim} 343 : * (viscosité numérique) 344 : * 345 : DO IMETH=1,3 345 : CALL INT2CH(IMETH,CMETH,IMPR,IRET) 346 : IF (IRET.NE.0) GOTO 9999 347 : DO IDIM1=0,IDIM 347 : CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) 348 : IF (IRET.NE.0) GOTO 9999 349 : NCOM=BLANC 350 : NCOM='MUSTAB' 351 : NCOM(7:7)=CMETH 352 : NCOM(8:8)=CDIM1 353 : NCOCOF=IDIM+3 354 : SEGINI COCOUR 355 : COCOUR.NOMCOM=NCOM 356 : COCOUR.LTREF=.TRUE. 357 : SEGDES COCOUR 358 : MYCOMS.LISCOM(**)=COCOUR 359 : ENDDO 360 : ENDDO 361 : * 362 : * Loi de comportement TSUF : Tension de surface 363 : * 364 : NCOM=BLANC 365 : NCOM='TSUF' 366 : NCOCOF=1 367 : SEGINI COCOUR 368 : COCOUR.NOMCOM=NCOM 369 : COCOUR.LTREF=.TRUE. 370 : SEGDES COCOUR 371 : MYCOMS.LISCOM(**)=COCOUR 372 : * 373 : * Lois de comportement TSUR{1..idim}*{0..iesder} 374 : * 375 : DO IDIM1=0,IDIM 375 : CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) 376 : IF (IRET.NE.0) GOTO 9999 377 : DO IDIM2=0,IESDER 377 : CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) 378 : IF (IRET.NE.0) GOTO 9999 379 : NCOM=BLANC 380 : NCOM='TSUR' 381 : NCOM(5:5)=CDIM1 382 : NCOM(6:6)=CDIM2 383 : NCOCOF=1 384 : SEGINI COCOUR 385 : COCOUR.NOMCOM=NCOM 386 : COCOUR.LTREF=.TRUE. 387 : SEGDES COCOUR 388 : MYCOMS.LISCOM(**)=COCOUR 389 : ENDDO 390 : ENDDO 391 : * 392 : * Lois de comportement TSUJ{1..idim}*4 393 : * 394 : DO IDIM1=1,IDIM 394 : CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) 395 : IF (IRET.NE.0) GOTO 9999 396 : DO IDIM2=0,IESDER 396 : CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) 397 : IF (IRET.NE.0) GOTO 9999 398 : DO IDIM3=1,IDIM 398 : CALL INT2CH(IDIM3,CDIM3,IMPR,IRET) 399 : IF (IRET.NE.0) GOTO 9999 400 : DO IDIM4=0,IESDER 400 : CALL INT2CH(IDIM4,CDIM4,IMPR,IRET) 401 : IF (IRET.NE.0) GOTO 9999 402 : NCOM=BLANC 403 : NCOM='TSUJ' 404 : NCOM(5:5)=CDIM1 405 : NCOM(6:6)=CDIM2 406 : NCOM(7:7)=CDIM3 407 : NCOM(8:8)=CDIM4 408 : NCOCOF=1 409 : SEGINI COCOUR 410 : COCOUR.NOMCOM=NCOM 411 : COCOUR.LTREF=.TRUE. 412 : SEGDES COCOUR 413 : MYCOMS.LISCOM(**)=COCOUR 414 : ENDDO 415 : ENDDO 416 : ENDDO 417 : ENDDO 418 : * 419 : * Lois de comportement TSU{1..4}{1..idim}*4 420 : * 421 : DO IDIM0=1,4 421 : CALL INT2CH(IDIM0,CDIM0,IMPR,IRET) 422 : IF (IRET.NE.0) GOTO 9999 423 : DO IDIM1=1,IDIM 423 : CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) 424 : IF (IRET.NE.0) GOTO 9999 425 : DO IDIM2=0,IESDER 425 : CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) 426 : IF (IRET.NE.0) GOTO 9999 427 : DO IDIM3=1,IDIM 427 : CALL INT2CH(IDIM3,CDIM3,IMPR,IRET) 428 : IF (IRET.NE.0) GOTO 9999 429 : DO IDIM4=0,IESDER 429 : CALL INT2CH(IDIM4,CDIM4,IMPR,IRET) 430 : IF (IRET.NE.0) GOTO 9999 431 : NCOM=BLANC 432 : NCOM='TSU' 433 : NCOM(4:4)=CDIM0 434 : NCOM(5:5)=CDIM1 435 : NCOM(6:6)=CDIM2 436 : NCOM(7:7)=CDIM3 437 : NCOM(8:8)=CDIM4 438 : NCOCOF=1 439 : SEGINI COCOUR 440 : COCOUR.NOMCOM=NCOM 441 : COCOUR.LTREF=.TRUE. 442 : SEGDES COCOUR 443 : MYCOMS.LISCOM(**)=COCOUR 444 : ENDDO 445 : ENDDO 446 : ENDDO 447 : ENDDO 448 : ENDDO 449 : * 450 : * Lois de comportement VNOR{1..idim} 451 : * 452 : DO IDIM1=1,IDIM 452 : CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) 453 : IF (IRET.NE.0) GOTO 9999 454 : NCOM=BLANC 455 : NCOM='VNOR' 456 : NCOM(5:5)=CDIM1 457 : NCOCOF=0 458 : SEGINI COCOUR 459 : COCOUR.NOMCOM=NCOM 460 : COCOUR.LTREF=.TRUE. 461 : SEGDES COCOUR 462 : MYCOMS.LISCOM(**)=COCOUR 463 : ENDDO 464 : * 465 : * Lois de comportement VNOJ{1..idim}*3 466 : * 467 : DO IDIM1=1,IDIM 467 : CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) 468 : IF (IRET.NE.0) GOTO 9999 469 : DO IDIM2=0,IDIM 469 : CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) 470 : IF (IRET.NE.0) GOTO 9999 471 : DO IDIM3=1,IDIM 471 : CALL INT2CH(IDIM3,CDIM3,IMPR,IRET) 472 : IF (IRET.NE.0) GOTO 9999 473 : NCOM=BLANC 474 : NCOM='VNOJ' 475 : NCOM(5:5)=CDIM1 476 : NCOM(6:6)=CDIM2 477 : NCOM(7:7)=CDIM3 478 : NCOCOF=0 479 : SEGINI COCOUR 480 : COCOUR.NOMCOM=NCOM 481 : COCOUR.LTREF=.TRUE. 482 : SEGDES COCOUR 483 : MYCOMS.LISCOM(**)=COCOUR 484 : ENDDO 485 : ENDDO 486 : ENDDO 487 : * 488 : * Lois de comportement IMET{1..idim}{idim1..idim} 489 : * 490 : DO IDIM1=1,IDIM 490 : CALL INT2CH(IDIM1,CDIM1,IMPR,IRET) 491 : IF (IRET.NE.0) GOTO 9999 492 : DO IDIM2=IDIM1,IDIM 492 : CALL INT2CH(IDIM2,CDIM2,IMPR,IRET) 493 : IF (IRET.NE.0) GOTO 9999 494 : NCOM=BLANC 495 : NCOM='IMET' 496 : NCOM(5:5)=CDIM1 497 : NCOM(6:6)=CDIM2 498 : NCOCOF=0 499 : SEGINI COCOUR 500 : COCOUR.NOMCOM=NCOM 501 : COCOUR.LTREF=.TRUE. 502 : SEGDES COCOUR 503 : MYCOMS.LISCOM(**)=COCOUR 504 : ENDDO 505 : ENDDO 506 : * 507 : * Impression finale 508 : * 509 : IF (IMPR.GT.1) THEN 510 : SEGPRT,MYCOMS 511 : NBCOMP=MYCOMS.LISCOM(/1) 512 : DO IBCOMP=1,NBCOMP 513 : COCOUR=MYCOMS.LISCOM(IBCOMP) 514 : SEGPRT,COCOUR 515 : ENDDO 516 : ENDIF 517 : SEGDES MYCOMS 518 : * 519 : * Normal termination 520 : * 521 : IRET=0 522 : RETURN 523 : * 524 : * Format handling 525 : * 526 : * 527 : * Error handling 528 : * 529 : 9999 CONTINUE 530 : IRET=1 531 : WRITE(IOIMP,*) 'An error was detected in subroutine incoms' 532 : RETURN 533 : * 534 : * End of subroutine INCOMS 535 : * 536 : END 537 : 538 : 539 : 540 : 541 : 542 : 543 : 544 :
© Cast3M 2003 - All rights reserved.
Disclaimer