1 : C GRAD1 SOURCE AM 13/12/16 21:15:40 7825 2 : 3 : C======================================================================= 4 : C= G R A D 1 = 5 : C= --------- = 6 : C= = 7 : C= Fonction : = 8 : C= ---------- = 9 : C= Traitement des informations necessaires au calcul du gradient d'un = 10 : C= champ deplacement/temperature. Branchement suivant l'element fini. = 11 : C= Sous-programme appele par GRAD (grad.eso) = 12 : C= = 13 : C= Parametres : (E)=Entree (S)=Sortie = 14 : C= ------------ = 15 : C= IPMODL (E) Pointeur sur segment MMODEL = 16 : C= IPCHE2 (E) Pointeur sur segment MCHELM de DEPLACEMENT/TEMPER. = 17 : C= IPCHE1 (E) Pointeur sur segment MCHELM de CARACTERISTIQUES = 18 : C= IPCHL1 (S) Pointeur sur segment MCHELM de GRADIENT resultat = 19 : C= IRET (S) Entier valant 1 en cas de succes, 0 sinon (et un = 20 : C= message d'erreur est imprime dans ce cas) = 21 : C= = 22 : C= Remarque : En entree du sousprogramme, IPCHL1 contient le CHPOINT = 23 : C= ---------- de deplacement ou de temperature fourni a l'operateur = 24 : C= 'GRAD'. Dans le cas d'un modele MECANIQUE, ce CHPOINT = 25 : C= est indispensable a avoir pour calculer les deforma- = 26 : C= generalisees au(x) point(s) support(s). = 27 : C= = 28 : C= Christian LE BRETON - Denis ROBERT-MOUGIN, le 31 juillet 1986. = 29 : C= Modifications aux nouvelles normes I.MONNIER, le 28 mai 1990. = 30 : C======================================================================= 31 : 32 : SUBROUTINE GRAD1 (IPMODL,IPCHE2,IPCHE1, IPCHL1,IRET) 33 : 34 : IMPLICIT INTEGER(I-N) 35 : IMPLICIT REAL*8 (A-H,O-Z) 36 : 37 : -INC CCOPTIO 38 : -INC CCHAMP 39 : -INC CCREEL 40 : 41 : -INC SMCHAML 42 : -INC SMMODEL 43 : -INC SMELEME 44 : -INC SMINTE 45 : -INC SMCOORD 46 : -INC SMLREEL 47 : 48 : SEGMENT INFO 49 : INTEGER INFELL(JG) 50 : ENDSEGMENT 51 : 52 : SEGMENT NOTYPE 53 : CHARACTER*16 TYPE(NBTYPE) 54 : ENDSEGMENT 55 : 56 : SEGMENT MPTVAL 57 : INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU) 58 : CHARACTER*16 TYVAL(NCOSOU) 59 : ENDSEGMENT 60 : 61 : SEGMENT MVELCH 62 : REAL*8 VALMAT(NV1) 63 : ENDSEGMENT 64 : 65 : SEGMENT MWRK1 66 : REAL*8 XDDL(LRE),XE(3,NBNO),GRADI(NGRA) 67 : REAL*8 DDHOOK(NSTRS,NSTRS),DDHOMU(NSTRS,NSTRS) 68 : ENDSEGMENT 69 : 70 : SEGMENT MWRK2 71 : REAL*8 SHPWRK(6,NBNO),BGR(NGRA,LRE),BB(2,NGRA) 72 : ENDSEGMENT 73 : 74 : SEGMENT MWRK3 75 : REAL*8 WORK(LW) 76 : ENDSEGMENT 77 : 78 : SEGMENT MWRK4 79 : REAL*8 BPSS(3,3),XEL(3,NBNO),XDDLOC(LRE) 80 : ENDSEGMENT 81 : 82 : PARAMETER (NINF=3) 83 : INTEGER INFOS(NINF) 84 : CHARACTER*8 CMATE 85 : CHARACTER*(NCONCH) CONM 86 : 87 : DIMENSION UDPGE(3) 88 : LOGICAL BDPGE,ldpge,lsupgd,lsupdp 89 : IRET=0 90 : iMess=0 91 : 92 : C 1 - QUELQUES INITIALISATIONS 93 : C ============================== 94 : C 1.1 - Activation du MMODEL 95 : C ===== 96 : MMODEL=IPMODL 97 : SEGACT,MMODEL 98 : NSOUS=KMODEL(/1) 99 : C ===== 100 : C 1.2 - Cas des modes de calculs en DEFORMATIONS GENERALISEES 101 : C En mecanique, on conserve le CHPOINT de deplacements pour 102 : C calculer les deplacements du point support en DPGE (IPCHP1) 103 : C ===== 104 : IPCHP1=IPCHL1 105 : IF (IFOUR.EQ.-3) THEN 106 : BDPGE=.TRUE. 107 : NDPGE=3 108 : ELSE IF (IFOUR.EQ. 7.OR.IFOUR.EQ. 8.OR.IFOUR.EQ. 9.OR. 109 : . IFOUR.EQ.10.OR.IFOUR.EQ.14) THEN 110 : BDPGE=.TRUE. 111 : NDPGE=1 112 : ELSE IF (IFOUR.EQ.10) THEN 113 : BDPGE=.TRUE. 114 : NDPGE=2 115 : ELSE 116 : BDPGE=.FALSE. 117 : NDPGE=0 118 : ENDIF 119 : C ===== 120 : C 1.2 - Activation du MCHELM resultat du champ de gradients 121 : C ===== 122 : L1=8 123 : N1=NSOUS 124 : N3=6 125 : SEGINI,MCHELM 126 : TITCHE='GRADIENT' 127 : IFOCHE=IFOUR 128 : IPCHL1=MCHELM 129 : 130 : 131 : C ===== 132 : C 1.3 - Les composantes des champs de deplacement/temperature, de 133 : C gradient resultat sont toutes du meme type ('REAL*8') sur tout 134 : C le modele IPMODL. Le segment MOTYCH de type NOTYPE associe est 135 : C donc initialise une seule fois. 136 : C ===== 137 : NBTYPE=1 138 : SEGINI,NOTYPE 139 : TYPE(1)='REAL*8' 140 : MOTYCH=NOTYPE 141 : 142 : C 2 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (iSou) 143 : C ======================================================== 144 : isouss=0 145 : DO 2000 iSou=1,NSOUS 146 : C ===== 147 : C 2.1 - Quelques initialisations 148 : C ===== 149 : NDEP=0 150 : MODEPL=0 151 : IVADEP=0 152 : NGRA=0 153 : MOGRAD=0 154 : IVAGRA=0 155 : MOCARA=0 156 : IVACAR=0 157 : MOMATR=0 158 : IVAMAT=0 159 : MWRK1=0 160 : MWRK2=0 161 : MWRK3=0 162 : MWRK4=0 163 : MCHAML=0 164 : MELVAL=0 165 : MVELCH=0 166 : C ===== 167 : C 2.2 - Activation du sous-modele (iSou) 168 : C ===== 169 : IMODEL=KMODEL(iSou) 170 : SEGACT,IMODEL 171 : NFOR = formod(/2) 171 : CALL PLACE(FORMOD,NFOR,iliais,'LIAISON') 172 : iaffai=1 173 : DO iou=1,matmod(/2) 174 : if (matmod(iou).eq.'MODAL' .or. matmod(iou).eq.'STATIQUE' .or. 175 : $ matmod(iou).eq.'IMPEDANCE') iaffai=0 176 : ENDDO 177 : IF (iaffai.eq.0 .or. iliais.ne.0) then 178 : segdes imodel 179 : GOTO 2000 180 : ENDIF 181 : MELE=NEFMOD 182 : * au cas ou il y en aurait besoin 183 : IF (mele.eq.22 .or. mele.eq.50000) then 184 : segdes imodel 185 : go to 2000 186 : endif 187 : isouss=isouss+1 188 : IPMAIL=IMAMOD 189 : CONM=CONMOD 190 : IIPDPG=IPDPGE 191 : C ===== 192 : C 2.3 - Determination ... 193 : C ===== 193 : CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,iOK) 194 : IF (iOK.EQ.0) GOTO 200 195 : iOK=0 196 : C ===== 197 : C 2.4 - Determination de la nature du materiau et verification 198 : C ===== 199 : NFOR=FORMOD(/2) 200 : * NMAT=MATMOD(/2) 200 : * CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) 201 : CMATE = CMATEE 202 : MATE = IMATEE 203 : *NU INAT = INATUU 204 : IF (CMATE.EQ.' ') THEN 204 : CALL ERREUR(251) 205 : GOTO 200 206 : ENDIF 206 : CALL PLACE(FORMOD,NFOR,ITHEHY,'THERMOHYDRIQUE') 206 : CALL PLACE(FORMOD,NFOR,ITTHE,'CONVECTION') 206 : CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE') 207 : ITHER=ITHER+ITTHE 208 : C ===== 209 : C 2.5 - Recuperation d'informations lies au maillage IPMAIL 210 : C ===== 211 : MELEME=IPMAIL 212 : SEGACT,MELEME 213 : NBNN=NUM(/1) 214 : NBELEM=NUM(/2) 215 : NBNO=NBNN 216 : C ===== 217 : C 2.6 - Recuperation d'informations sur l'element fini du sous-modele 218 : C suivant la formulation du modele (MECANIQUE ou THERMIQUE) 219 : C ===== 220 : C SP 07/08 : NII=Nombre Inconnues Independantes 221 : C (e.g. T,Pc,Pg en Thermohydrique) 222 : NII=1 223 : IPINF=0 224 : IF (ITHEHY.NE.0) THEN 225 : MFR=65 225 : CALL TSHAPE(MELE,'GAUSS',IPMINT) 226 : IPMIN1=0 227 : NII=3 228 : LRE=NII*NBNN 229 : C*OF : Valeur de LW ? 230 : LW=1700 231 : NSTRS=0 232 : ldpge = .FALSE. 233 : ELSE IF (ITHER.NE.0) THEN 234 : MFR=NUMMFR(MELE) 234 : CALL TSHAPE(MELE,'GAUSS',IPMINT) 235 : IPMIN1=0 236 : IF (MFR.EQ.5.OR.MFR.EQ.9) THEN 236 : CALL TSHAPE(MELE,'NOEUD',IPMIN1) 237 : ENDIF 238 : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 239 : LRE=3*NBNN 240 : ELSE 241 : LRE=NBNN 242 : ENDIF 243 : C*OF : Valeur de LW ? 244 : LW=1700 245 : NSTRS=0 246 : ldpge = .FALSE. 247 : c ajout bp du 18/06/2013 : il faut renseigner NPINT pour idtemp 248 : NPINT=0 249 : IF(INFMOD(/1).NE.0) NPINT=INFMOD(1) 250 : ELSE 251 : if(infmod(/1).lt.7)then 251 : CALL ELQUOI(MELE,0,5,IPINF,IMODEL) 252 : INFO=IPINF 253 : IF (IERR.NE.0) GOTO 210 254 : MFR=INFELL(13) 255 : IPMINT=INFELL(11) 256 : IPMIN1=INFELL(12) 257 : LRE=INFELL(9) 258 : LW=INFELL(7) 259 : LHOOK=INFELL(10) 260 : NSTRS=INFELL(16) 261 : segsup info 262 : else 263 : MFR=INFELE(13) 264 : * IPMINT=INFELE(11) 265 : ipmint=infmod(7) 266 : IPMIN1=INFMOD(8) 267 : LRE=INFELE(9) 268 : LW=INFELE(7) 269 : LHOOK=INFELE(10) 270 : NSTRS=INFELE(16) 271 : endif 272 : ldpge = BDPGE 273 : IF (MFR.EQ.71 .OR. MFR.EQ.73) ldpge = .FALSE. 274 : ENDIF 275 : C ===== 276 : C 2.6 - Recherche des DDL du noeud support des def. planes generalisees 277 : C Dans ce cas, IPCHP1 est fourni a GRAD via IPCHL1 (cf. 1.3) 278 : C ===== 279 : IF (ldpge) THEN 280 : IF (IPCHP1.NE.0) THEN 280 : CALL DEPDPG(IPCHP1,UDPGE(1),UDPGE(2),UDPGE(3),IIPDPG) 281 : ELSE 281 : CALL ERREUR(621) 282 : GOTO 210 283 : ENDIF 284 : ENDIF 285 : C ===== 286 : C 2.7 - Segment d'integration 287 : C ===== 288 : MINTE=IPMINT 289 : SEGACT,MINTE 290 : NBPGAU=POIGAU(/1) 291 : C ===== 292 : C 2.8 - Recuperation des noms des caracteristiques GEOMETRIQUES 293 : C Verification de leur presence dans le MCHAML (IPCHE1) 294 : C ===== 295 : NBROBL=0 296 : NBRFAC=0 297 : IVECT =0 298 : if (iaffai.eq.1.and.iliais.eq.0) then 299 : C= 2.8.1 - Elements COQUES : epaisseur et excentrement 300 : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 301 : NBROBL=1 302 : NBRFAC=1 303 : SEGINI,NOMID 304 : LESOBL(1)='EPAI' 305 : LESFAC(1)='EXCE' 306 : MOCARA=NOMID 307 : NBTYPE=1 308 : SEGINI,NOTYPE 309 : TYPE(1)='REAL*8' 310 : C= 2.8.2 - Elements BARREs 311 : ELSE IF (MFR.EQ.27) THEN 312 : NBROBL=1 313 : SEGINI NOMID 314 : MOCARA=NOMID 315 : LESOBL(1)='SECT' 316 : NBTYPE=1 317 : SEGINI NOTYPE 318 : TYPE(1)='REAL*8' 319 : C= 2.8.3 - Elements BARREs EXCENTREES : section, excentrements et orientation 320 : ELSE IF (MFR.EQ.49) THEN 321 : NBROBL=6 322 : SEGINI NOMID 323 : MOCARA=NOMID 324 : LESOBL(1)='SECT' 325 : LESOBL(2)='EXCZ' 326 : LESOBL(3)='EXCY' 327 : LESOBL(4)='VX ' 328 : LESOBL(5)='VY ' 329 : LESOBL(6)='VZ ' 330 : NBTYPE=1 331 : SEGINI NOTYPE 332 : TYPE(1)='REAL*8' 333 : 334 : C= 2.8.4 - Elements POUTRES 335 : ELSE IF (MFR.EQ.7) THEN 336 : IF (CMATE.EQ.'SECTION') THEN 337 : NBROBL=0 338 : NBRFAC=1 339 : SEGINI NOMID 340 : MOCARA=NOMID 341 : LESFAC(1)='VECT' 342 : IVECT=1 343 : 344 : NBTYPE=1 345 : SEGINI NOTYPE 346 : TYPE(1)='POINTEURPOINT ' 347 : ELSE 348 : IF(IFOUR.EQ.2) THEN 349 : NBROBL=4 350 : NBRFAC=3 351 : SEGINI NOMID 352 : MOCARA=NOMID 353 : LESOBL(1)='TORS' 354 : LESOBL(2)='INRY' 355 : LESOBL(3)='INRZ' 356 : LESOBL(4)='SECT' 357 : LESFAC(1)='SECY' 358 : LESFAC(2)='SECZ' 359 : LESFAC(3)='VECT' 360 : IVECT=1 361 : NBTYPE=7 362 : SEGINI NOTYPE 363 : TYPE(1)='REAL*8' 364 : TYPE(2)='REAL*8' 365 : TYPE(3)='REAL*8' 366 : TYPE(4)='REAL*8' 367 : TYPE(5)='REAL*8' 368 : TYPE(6)='REAL*8' 369 : TYPE(7)='POINTEURPOINT ' 370 : ELSEIF(IFOUR.EQ.-1.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3) THEN 371 : NBRFAC=1 372 : NBROBL=2 373 : SEGINI NOMID 374 : MOCARA=NOMID 375 : LESOBL(1)= 'SECT' 376 : LESOBL(2)= 'INRZ' 377 : LESFAC(1)= 'SECY' 378 : NBTYPE=1 379 : SEGINI NOTYPE 380 : TYPE(1)='REAL*8' 381 : ENDIF 382 : ENDIF 383 : C= 2.8.5 - Elements POUTRES TIMO 2D : 384 : C* non defini actuellement 385 : C= 2.8.6 - Elements TUYAUX 386 : ELSE IF (MFR.EQ.13) THEN 387 : NBROBL=2 388 : NBRFAC=3 389 : SEGINI NOMID 390 : MOCARA=NOMID 391 : LESOBL(1)='EPAI' 392 : LESOBL(2)='RAYO' 393 : LESFAC(1)='RACO' 394 : LESFAC(2)='CISA' 395 : LESFAC(3)='VECT' 396 : IVECT=1 397 : NBTYPE=5 398 : SEGINI NOTYPE 399 : TYPE(1)='REAL*8' 400 : TYPE(2)='REAL*8' 401 : TYPE(3)='REAL*8' 402 : TYPE(4)='REAL*8' 403 : TYPE(5)='POINTEURPOINT ' 404 : ENDIF 405 : endif 406 : NCARA=NBROBL 407 : NCARF=NBRFAC 408 : NCAR =NBROBL+NBRFAC 409 : C= 2.8.x - Verification de la presence des caracteristiques dans IPCHE1 410 : IF (NCAR.NE.0) THEN 411 : IF (IPCHE1.NE.0) THEN 412 : MOTYPE=NOTYPE 412 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1, 413 : . INFOS,3,IVACAR) 414 : SEGSUP,NOTYPE 415 : IF (IERR.NE.0) GOTO 220 416 : * IF (IVACAR.NE.0) THEN 417 : * MPTVAL=IVACAR 418 : * IPMELV=IVAL(1) 418 : * CALL QUELCH(IPMELV,ICONS) 419 : * IF (ICONS.NE.0) THEN 419 : * CALL ERREUR(566) 420 : * GOTO 220 421 : * ENDIF 422 : * ENDIF 423 : * CAS DES POUTRES : TRAITEMENT DES VECTEURS 424 : IF (IVECT.EQ.1) THEN 425 : MPTVAL=IVACAR 426 : IF (IVAL(NCAR).EQ.0) THEN 427 : C MOT CLE VECT EN CAS DE CONVERSION 428 : segsup mptval 429 : IVECT=2 430 : NOMID=MOCARA 431 : C* SEGACT NOMID 432 : NBRFAC=NBRFAC+2 433 : SEGADJ NOMID 434 : LESFAC(NBRFAC-2)='VX ' 435 : LESFAC(NBRFAC-1)='VY ' 436 : LESFAC(NBRFAC) ='VZ ' 437 : NCARF=NBRFAC 438 : NCAR=NCARA+NCARF 438 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYCH, 439 : $ 1,INFOS,3,IVACAR) 440 : IF (IERR.NE.0) GOTO 220 441 : ENDIF 442 : ENDIF 443 : ELSE 444 : MOTERR(1:8)='CARACTER' 445 : MOTERR(9:12)=NOMTP(MELE) 446 : MOTERR(13:20)='GRAD' 446 : CALL ERREUR(145) 447 : GOTO 220 448 : ENDIF 449 : ENDIF 450 : C ===== 451 : C 2.9.1 - Traitement particulier dans le cas de l'element COQUE DST 452 : C Recuperation des donnees contenues dans la matrice de HOOKE 453 : C Verification de leur presence dans le MCHAML (IPCHE1) 454 : C ===== 455 : NMATR=0 456 : NMATF=0 457 : NMATT=0 458 : IF (MELE.EQ.93) THEN 459 : IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN 460 : NBROBL=2 461 : NBRFAC=0 462 : SEGINI,NOMID 463 : LESOBL(1)='YOUN' 464 : LESOBL(2)='NU ' 465 : MOMATR=NOMID 466 : NMATR=NBROBL 467 : NMATF=NBRFAC 468 : IF (IPCHE1.NE.0) THEN 469 : C*OF : On va utiliser MOTYCH pour gagner un peu de temps 470 : C*OF NBTYPE=1 471 : C*OF SEGINI,NOTYPE 472 : C*OF TYPE(1)='REAL*8' 473 : C*OF MOTYPE=NOTYPE 473 : C*OF CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1, 473 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYCH,1, 474 : . INFOS,3,IVAMAT) 475 : IF (IERR.NE.0) GOTO 230 476 : C*OF SEGSUP,NOTYPE 477 : ELSE 478 : SEGSUP,NOTYPE 479 : MOTERR(1:8)='CARACTER' 480 : MOTERR(9:12)=NOMTP(MELE) 481 : MOTERR(13:20)='GRAD' 481 : CALL ERREUR(145) 482 : GOTO 230 483 : ENDIF 484 : NMATT=NMATR+NMATF 485 : MPTVAL=IVAMAT 486 : NBGMAT=0 487 : NELMAT=0 488 : DO i=1,NMATT 489 : IF (IVAL(i).NE.0)THEN 490 : MELVAL=IVAL(i) 491 : NBGMAT=MAX(NBGMAT,VELCHE(/1)) 492 : NELMAT=MAX(NELMAT,VELCHE(/2)) 493 : ENDIF 494 : ENDDO 495 : ENDIF 496 : ENDIF 497 : C ===== 498 : C 2.9.2 - Cas d'un joint unidimensionnel JOI1 499 : C Chargement des vecteurs stitués dans les caractéristiques matériau 500 : C ===== 501 : IF(MFR.EQ.75) THEN 502 : IF(IDIM.EQ.3) THEN 503 : NBROBL=6 504 : NBRFAC=0 505 : SEGINI NOMID 506 : MOMATR=NOMID 507 : LESOBL(1)='V1X' 508 : LESOBL(2)='V1Y' 509 : LESOBL(3)='V1Z' 510 : LESOBL(4)='V2X' 511 : LESOBL(5)='V2Y' 512 : LESOBL(6)='V2Z' 513 : NMATR=NBROBL 514 : NMATF=NBRFAC 515 : ELSE IF(IDIM.EQ.2) THEN 516 : NBROBL=2 517 : NBRFAC=0 518 : SEGINI NOMID 519 : MOMATR=NOMID 520 : LESOBL(1)='V1X' 521 : LESOBL(2)='V1Y' 522 : NMATR=NBROBL 523 : NMATF=NBRFAC 524 : ENDIF 525 : NBTYPE=1 526 : SEGINI NOTYPE 527 : TYPE(1)='REAL*8' 528 : MOTYPE=NOTYPE 529 : * 529 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 530 : SEGSUP NOTYPE 531 : IF (IERR.NE.0) GOTO 2000 532 : * 533 : NMATT=NMATR+NMATF 534 : * C 535 : IF(ISUP1.EQ.1)THEN 535 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 536 : IF(IERR.NE.0)THEN 537 : ISUP1=0 538 : GOTO 2000 539 : ENDIF 540 : ENDIF 541 : MPTVAL=IVAMAT 542 : NBGMAT = 0 543 : NELMAT = 0 544 : DO 11265 IM=1,NMATT 545 : IF(IVAL(IM).NE.0)THEN 546 : MELVAL=IVAL(IM) 547 : IF (CMATE.EQ.'SECTION') THEN 548 : NBGMAT=MAX(NBGMAT,IELCHE(/1)) 549 : NELMAT=MAX(NELMAT,IELCHE(/2)) 550 : ELSE 551 : NBGMAT=MAX(NBGMAT,VELCHE(/1)) 552 : NELMAT=MAX(NELMAT,VELCHE(/2)) 553 : ENDIF 554 : ENDIF 555 : 11265 CONTINUE 556 : nmattd=nmatt 557 : ivamtd= ivamat 558 : segdes nomid 559 : ENDIF 560 : C ====== 561 : C 2.10 - Recuperation des noms des composantes de DEPL. ou T 562 : C Verification de leur presence dans le MCHAML (IPCHE2) 563 : C*OF Par abus : MODEPL noms des composantes de DEPL et de Temperatures 564 : C ====== 565 : IF (ITHEHY.NE.0) THEN 566 : IF(LNOMID(1).NE.0) THEN 567 : NOMID=LNOMID(1) 568 : SEGACT NOMID 569 : MODEPL=NOMID 570 : ndep=LESOBL(/2) 571 : NFAC=LESFAC(/2) 572 : LSUPDP=.FALSE. 573 : ELSE 574 : LSUPDP=.TRUE. 574 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEP,NFAC) 575 : ENDIF 576 : MDM=MFR 577 : ELSEIF (ITHER.EQ.0) THEN 578 : C IF (ITHER.EQ.0) THEN 579 : if(lNOMID(1).ne.0) then 580 : NOMID=lNOMID(1) 581 : segact NOMID 582 : modepl=NOMID 583 : ndep=lesobl(/2) 584 : nfac=lesfac(/2) 585 : lsupdp=.false. 586 : else 587 : lsupdp=.true. 587 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEP,NFAC) 588 : endif 589 : MDM=MFR 590 : ELSE 591 : if(lNOMID(8).ne.0) then 592 : NOMID=lNOMID(8) 593 : segact NOMID 594 : modepl=NOMID 595 : ndep=lesobl(/2) 596 : nfac=lesfac(/2) 597 : lsupdp=.false. 598 : else 599 : lsupdp=.true. 599 : CALL IDTEMP(MFR,IFOUR,NPINT,MODEPL,NDEP,NFAC) 600 : endif 601 : IF (MFR.EQ.1) THEN 602 : MDM=29 603 : ELSE IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 604 : MDM=39 605 : ENDIF 606 : ENDIF 606 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MODEPL,MOTYCH,1,INFOS,3,IVADEP) 607 : IF (IERR.NE.0) GOTO 240 608 : C ====== 609 : C 2.11 - Recuperation des noms des composantes de gradient 610 : C ====== 611 : IF(LNOMID(3).NE.0) then 612 : MOGRAD=LNOMID(3) 613 : NOMID=MOGRAD 614 : SEGACT,NOMID 615 : NGRA=LESOBL(/2) 616 : NFAC=LESFAC(/2) 617 : LSUPGD=.FALSE. 618 : ELSE 619 : LSUPGD=.TRUE. 619 : CALL IDGRAD(MDM,IFOUR,MOGRAD,NGRA,NFAC) 620 : NOMID=MOGRAD 621 : SEGACT,NOMID 622 : ENDIF 623 : C ====== 624 : C 2.12 - Initialisation du MCHAML des gradients (MCHAML) 625 : C associe au modele elementaire iSou (de maillage IPMAIL) 626 : C Remplissage des donnees associees a MCHAML dans MCHELM(global) 627 : C ====== 628 : C= 2.12.1 - Initialisation de MCHAML 629 : N2=NGRA 630 : SEGINI,MCHAML 631 : C= 2.12.2 - Remplissage de MCHEML(iSou) 632 : CONCHE(iSouss)=CONMOD 633 : IMACHE(iSouss)=IPMAIL 634 : ICHAML(iSouss)=MCHAML 635 : INFCHE(iSouss,1)=0 636 : INFCHE(iSouss,2)=0 637 : INFCHE(iSouss,3)=NIFOUR 638 : INFCHE(iSouss,4)=IPMINT 639 : INFCHE(iSouss,5)=0 640 : IF (ITHEHY.NE.0) THEN 641 : INFCHE(iSouss,6)=5 642 : ELSEIF (ITHER.EQ.0) THEN 643 : INFCHE(iSouss,6)=5 644 : ELSE 645 : INFCHE(iSouss,6)=6 646 : ENDIF 647 : C= 2.12.3 - Initialisation des N2 MELVAL associes a MCHAML 648 : C= Fin du remplissage de MCHAML 649 : N1EL=0 650 : N1PTEL=0 651 : MPTVAL=IVADEP 652 : DO i=1,NDEP 653 : MELVAL=IVAL(i) 654 : N1PTEL=MAX(N1PTEL,VELCHE(/1)) 655 : N1EL=MAX(N1EL,VELCHE(/2)) 656 : ENDDO 657 : IF (N1PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN 658 : N1PTEL=1 659 : ELSE 660 : N1PTEL=NBPGAU 661 : ENDIF 662 : N1EL=MIN(N1EL,NBELEM) 663 : * write(6,*) 'N1PTEL,N1EL=',N1PTEL,N1EL 664 : N2PTEL=0 665 : N2EL=0 666 : NS=1 667 : NCOSOU=NGRA 668 : SEGINI,MPTVAL 669 : NOMID=MOGRAD 670 : DO i=1,N2 671 : NOMCHE(i)=LESOBL(i) 672 : TYPCHE(i)='REAL*8' 673 : SEGINI,MELVAL 674 : IELVAL(i)=MELVAL 675 : IVAL(i)=MELVAL 676 : ENDDO 677 : IVAGRA=MPTVAL 678 : C ====== 679 : C 2.13 - Initialisations de quelques valeurs 680 : C ====== 681 : cbp NDDD=NDEP -> ne prend pas en compte les composantes facultatives 682 : MPTVAL=IVADEP 683 : NDDD=IVAL(/1) 684 : IF (ldpge) NDDD=NDEP-NDPGE 685 : * 686 : IF (MFR.EQ.77) THEN 687 : * zones cohesives : on se limite aux composantes obligatoires 688 : NDDD=NDEP 689 : ENDIF 690 : 691 : C POUR les XFEM on fait un cas particulier inspiré du cas massif 692 : IF (MFR.EQ.63) THEN 692 : CALL GRAD1X(IMODEL,IVADEP,LRE,IVAGRA,NGRA, 693 : & IPMINT,IPMIN1,IIPDPG,IOK) 694 : GOTO 260 695 : ELSE IF (MFR.EQ.29) THEN 696 : i=NGRA 697 : NGRA=i*NBNO 698 : SEGINI,MWRK1 699 : NGRA=i 700 : ELSE 701 : SEGINI,MWRK1 702 : ENDIF 703 : C 704 : IF (ITHEHY.NE.0) THEN 705 : LREII=LRE/NII 706 : NGRAII=NGRA/NII 707 : JG=LREII 708 : SEGINI,MLREE1 709 : JG=NGRAII 710 : SEGINI,MLREE2 711 : ENDIF 712 : IF (ITHEHY.NE.0.OR.ITHER.NE.0) THEN 713 : NOELE=57 714 : ELSE 715 : NOELE=MELE 716 : ENDIF 717 : C ====== 718 : C 2.14 - Boucle sur les elements du sous-modele elementaire 719 : C ====== 720 : 721 : 722 : DO 100 IB=1,NBELEM 723 : C= 2.14.1 - Recuperation des coordonnees des noeuds de l'element 723 : CALL DOXE(XCOOR,IDIM,NBNO,NUM,IB,XE) 724 : C= 2.14.2 - Recuperation des deplacements/temperatures aux noeuds 725 : C= Traitement dans les cas des modes generalises 726 : MPTVAL=IVADEP 727 : IE=1 728 : DO iGau=1,NBNN 729 : DO i=1,NDDD 730 : MELVAL=IVAL(i) 731 : IF (MELVAL.NE.0) THEN 732 : IGMN=MIN(iGau,VELCHE(/1)) 733 : IBMN=MIN(IB,VELCHE(/2)) 734 : XDDL(IE)=VELCHE(IGMN,IBMN) 735 : ELSE 736 : XDDL(IE)=XZero 737 : ENDIF 738 : IE=IE+1 739 : ENDDO 740 : ENDDO 741 : IF (ldpge) THEN 742 : DO i=1,NDPGE 743 : XDDL(IE)=UDPGE(i) 744 : IE=IE+1 745 : ENDDO 746 : ENDIF 747 : 748 : C= 2.14.3 - Branchement suivant l'element fini 749 : c 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 750 : GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99, 751 : c 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 752 : . 99,99, 4, 4, 4, 4,27,28,29,99,99,99,99,99,99,99,99,99,99,99, 753 : . 41,29,99,44,99,99,99,99,49,99,99,99,99,99,99,41, 4, 4, 4, 4, 754 : . 4, 4, 4, 4, 4, 4, 4, 4,99,99,99,99,99,99,99,99,99,99,99,99, 755 : . 99,99,99,29,99,99,99,99,99,99,99,99,93,99,99,99,99,99,99,99, 756 : . 99,99,99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 757 : . 4, 4),MELE 758 : IF (MELE.EQ.183.OR.MELE.EQ.184) GOTO 4 759 : IF (MELE.GE.191.AND.MELE.LE.194) GOTO 4 760 : IF (MELE.EQ.265) GOTO 265 761 : IF (MELE.EQ.266) GOTO 266 762 : IF (MELE.EQ.267) GOTO 267 763 : 99 CONTINUE 764 : C*OF On ne veut plus sortir sur une erreur : 765 : C* MOTERR(1:4)=NOMTP(MELE) 766 : C* MOTERR(9:12)='GRADIENT' 767 : C* iMess=86 768 : C*OF On met un champ de gradient nul pour les elements non implementes ! 769 : N1PTEL=1 770 : N1EL=1 771 : N2PTEL=0 772 : N2EL=0 773 : DO i=1,IELVAL(/1) 774 : MELVAL=IELVAL(i) 775 : SEGADJ,MELVAL 776 : VELCHE(1,1)=XZero 777 : ENDDO 778 : iOK=1 779 : GOTO 250 780 : C= 2.14.4 - Elements MASSIFS et INCOMPRESSIBLES 781 : 4 CONTINUE 782 : IF (IB.EQ.1) SEGINI,MWRK2 783 : ISDJC=0 784 : DO iGau=1,NBPGAU 785 : C -- Calcul de la matrice B et du jacobien au point de Gauss IGAU 786 : IF (ITHEHY.NE.0) THEN 786 : CALL BGRMAS(iGau,NOELE,NBNO,LREII,IFOUR,NGRAII,NIFOUR,XE, 787 : . XZero,SHPTOT,SHPWRK,BB,BGR,DJAC,IIPDPG) 788 : ELSE 789 : C= 2.14.4bis - Elements massifs en 'ELECTROSTATIQUE' et 'DIFFUSION' 790 : IF (MFR.EQ.71) THEN 790 : CALL BELEC(XE,SHPTOT(1,1,IGAU),NBNO,NGRA,+1, 791 : & SHPWRK,BGR,DJAC) 792 : ELSE IF (MFR.EQ.73) THEN 792 : CALL BDIFF(XE,SHPTOT(1,1,IGAU),NBNN,NGRA,+1, 793 : & SHPWRK,BGR,DJAC) 794 : ELSE 795 : C- Elements MASSIFS et INCOMPRESSIBLES en MECANIQUE 795 : CALL BGRMAS(iGau,NOELE,NBNO,LRE,IFOUR,NGRA,NIFOUR,XE, 796 : . XZero,SHPTOT,SHPWRK,BB,BGR,DJAC,IIPDPG) 797 : ENDIF 798 : ENDIF 799 : IF (DJAC.LT.XZero) ISDJC=ISDJC+1 800 : IF (DJAC.EQ.XZero) THEN 801 : iMess=259 802 : GOTO 260 803 : ENDIF 804 : IF (ITHEHY.NE.0) THEN 805 : DO KII=1,NII 806 : DO LLL=1,LREII 807 : MLREE1.PROG(LLL)=XDDL(LLL*NII-(NII-KII)) 808 : ENDDO 808 : CALL BGRDEP(BGR,NGRAII,MLREE1.PROG,LREII,MLREE2.PROG) 809 : DO LLL=1,NGRAII 810 : GRADI(LLL+(KII-1)*NGRAII)=MLREE2.PROG(LLL) 811 : ENDDO 812 : ENDDO 813 : ELSE 814 : IF (MFR.EQ.71 .OR. MFR.EQ.73) THEN 814 : CALL BST(BGR,XDDL,LRE,NGRA,GRADI) 815 : ELSE 815 : CALL BGRDEP(BGR,NGRA,XDDL,LRE,GRADI) 816 : ENDIF 817 : ENDIF 818 : MPTVAL=IVAGRA 819 : DO i=1,NGRA 820 : MELVAL=IVAL(i) 821 : IGMN=MIN(iGau,VELCHE(/1)) 822 : IBMN=MIN(IB,VELCHE(/2)) 823 : VELCHE(IGMN,IBMN)=GRADI(i) 824 : ENDDO 825 : ENDDO 826 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 827 : iMess=195 828 : GOTO 260 829 : ENDIF 830 : GOTO 100 831 : C= 2.14.5 - Elements COQUES COQ3 (thermique - mecanique) 832 : 27 IF (ITHER.NE.0) THEN 833 : IF (IB.EQ.1) SEGINI,MWRK2 834 : ISDJC=0 835 : DO iGau=1,NBPGAU 835 : CALL CQTGR1(iGau,MELE,NBNN,LRE,IFOUR,NGRA,XE,SHPTOT, 836 : . XDDL,SHPWRK,BGR,DJAC,GRADI) 837 : IF (IERR.NE.0) GOTO 260 838 : IF (DJAC.EQ.XZero) THEN 839 : iMess=259 840 : GOTO 260 841 : ENDIF 842 : IF (DJAC.LT.XZero) ISDJC=ISDJC+1 843 : MPTVAL=IVAGRA 844 : DO i=1,NGRA 845 : MELVAL=IVAL(i) 846 : IGMN=MIN(iGau,VELCHE(/1)) 847 : IBMN=MIN(IB,VELCHE(/2)) 848 : VELCHE(IGMN,IBMN)=GRADI(i) 849 : ENDDO 850 : ENDDO 851 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 852 : iMess=195 853 : GOTO 260 854 : ENDIF 855 : ELSE 856 : C= COQ3 mecanique : un point d'integration au centre de gravite 857 : IF (IB.EQ.1) SEGINI,MWRK3 857 : CALL COQ3GR(XE,XDDL,GRADI,WORK) 858 : MPTVAL=IVAGRA 859 : DO i=1,NGRA 860 : MELVAL=IVAL(i) 861 : IBMN=MIN(IB,VELCHE(/2)) 862 : VELCHE(1,IBMN)=GRADI(i) 863 : ENDDO 864 : ENDIF 865 : GOTO 100 866 : C= 2.14.6 - Elements DKT 867 : 28 IF (IB.EQ.1) SEGINI,MWRK2,MWRK4 867 : CALL VPAST(XE,BPSS) 867 : CALL VCORLC(XE,XEL,BPSS) 867 : CALL MATVEC(XDDL,XDDLOC,BPSS,6) 868 : EPAIST=XZero 869 : MPTVAL=IVACAR 870 : IF (IVAL(1).NE.0) THEN 871 : MELVAL=IVAL(1) 872 : IBMN=MIN(IB,VELCHE(/2)) 873 : DO iGau=1,NBPGAU 874 : IGMN=MIN(iGau,VELCHE(/1)) 875 : EPAIST=EPAIST+VELCHE(IGMN,IBMN) 876 : ENDDO 877 : EPAIST=EPAIST/NBPGAU 878 : ENDIF 879 : DO iGau=1,NBPGAU 880 : MPTVAL=IVACAR 881 : MELVAL=IVAL(2) 882 : IF (MELVAL.NE.0) THEN 883 : IBMN=MIN(IB,VELCHE(/2)) 884 : EXCEN=VELCHE(1,IBMN) 885 : ELSE 886 : EXCEN=XZero 887 : ENDIF 887 : CALL BGRMAS(iGau,MELE,NBNO,LRE,IFOUR,NGRA,0,XEL, 888 : . EXCEN,SHPTOT,SHPWRK,BB,BGR,DJAC,IIPDPG) 888 : CALL BGRDEP(BGR,NGRA,XDDLOC,LRE,GRADI) 889 : MPTVAL=IVAGRA 890 : DO i=1,NGRA 891 : MELVAL=IVAL(i) 892 : IGMN=MIN(iGau,VELCHE(/1)) 893 : IBMN=MIN(IB,VELCHE(/2)) 894 : VELCHE(IGMN,IBMN)=GRADI(i) 895 : ENDDO 896 : ENDDO 897 : GOTO 100 898 : C= 2.14.7 - Elements COQ8 et COQ6 899 : 41 IF (IB.EQ.1) THEN 900 : SEGINI,MWRK3 901 : MINTE1=IPMIN1 902 : SEGACT,MINTE1 903 : ENDIF 904 : C= Recuperation de l'epaisseur et des excentrements 905 : MPTVAL=IVACAR 906 : EPAIST=XZero 907 : MELVAL=IVAL(1) 908 : IF (MELVAL.NE.0) THEN 909 : IBMN=MIN(IB,VELCHE(/2)) 910 : DO iGau=1,NBPGAU 911 : IGMN=MIN(iGau,VELCHE(/1)) 912 : EPAIST=EPAIST+VELCHE(IGMN,IBMN) 913 : ENDDO 914 : EPAIST=EPAIST/NBPGAU 915 : ENDIF 916 : EXCEN=XZero 917 : MELVAL=IVAL(2) 918 : IF (MELVAL.NE.0) THEN 919 : IBMN=MIN(IB,VELCHE(/2)) 920 : DO iGau=1,NBPGAU 921 : IGMN=MIN(iGau,VELCHE(/1)) 922 : EXCEN=EXCEN+VELCHE(IGMN,IBMN) 923 : ENDDO 924 : EXCEN=EXCEN/NBPGAU 925 : ENDIF 926 : C= Element thermique 927 : IF (ITHER.NE.0) THEN 927 : CALL CQTGR2(XE,NBNN,NBPGAU,LRE,EPAIST,DZEGAU, 928 : . SHPTOT,MINTE1.SHPTOT,XDDL,WORK(1),WORK(1+LRE)) 929 : IE=LRE 930 : C= Element mecanique 931 : ELSE 931 : CALL CQ8GRA(XE,NBNO,NBPGAU,LRE,EPAIST,EXCEN,DZEGAU, 932 : . SHPTOT,MINTE1.SHPTOT,XDDL,WORK,IRR) 933 : IE=0 934 : ENDIF 935 : MPTVAL=IVAGRA 936 : DO iGau=1,NBPGAU 937 : DO i=1,NGRA 938 : MELVAL=IVAL(i) 939 : IGMN=MIN(iGau,VELCHE(/1)) 940 : IBMN=MIN(IB,VELCHE(/2)) 941 : IE=IE+1 942 : VELCHE(IGMN,IBMN)=WORK(IE) 943 : ENDDO 944 : ENDDO 945 : GOTO 100 946 : C= 2.14.8 - Element COQ2 947 : 44 IF (IB.EQ.1) SEGINI,MWRK2 948 : C= Element thermique 949 : IF (ITHER.NE.0) THEN 950 : ISDJC=0 951 : DO iGau=1,NBPGAU 951 : CALL CQTGR1(iGau,MELE,NBNN,LRE,IFOUR,NGRA,XE,SHPTOT, 952 : . XDDL,SHPWRK,BGR,DJAC,GRADI) 953 : IF (IERR.NE.0) GOTO 260 954 : IF (DJAC.EQ.XZero) THEN 955 : iMess=259 956 : GOTO 260 957 : ENDIF 958 : MPTVAL=IVAGRA 959 : DO i=1,NGRA 960 : MELVAL=IVAL(i) 961 : IGMN=MIN(iGau,VELCHE(/1)) 962 : IBMN=MIN(IB,VELCHE(/2)) 963 : VELCHE(IGMN,IBMN)=GRADI(i) 964 : ENDDO 965 : ENDDO 966 : C= Element mecanique 967 : ELSE 968 : MPTVAL=IVACAR 969 : IF (IVAL(1).NE.0) THEN 970 : MELVAL=IVAL(1) 971 : IBMN=MIN(IB,VELCHE(/2)) 972 : EPAIST=VELCHE(1,IBMN) 973 : ELSE 974 : EPAIST=XZero 975 : ENDIF 976 : DO iGau=1,NBPGAU 976 : CALL BGRCQ2(BGR,DJAC,iGau,IFOUR,XE,NIFOUR, 977 : . QSIGAU,POIGAU,IERT) 978 : IF (IERT.NE.0) THEN 979 : IF (IERT.EQ.1) iMess=255 980 : IF (IERT.EQ.2) iMess=256 981 : GOTO 260 982 : ENDIF 982 : CALL BGRDEP(BGR,NGRA,XDDL,LRE,GRADI) 983 : MPTVAL=IVAGRA 984 : DO i=1,NGRA 985 : MELVAL=IVAL(i) 986 : IGMN=MIN(iGau,VELCHE(/1)) 987 : IBMN=MIN(IB,VELCHE(/2)) 988 : VELCHE(IGMN,IBMN)=GRADI(i) 989 : ENDDO 990 : ENDDO 991 : ENDIF 992 : GOTO 100 993 : 994 : C= 2.14.9 - Element COQ4 995 : 49 MPTVAL=IVACAR 996 : MELVAL=IVAL(1) 997 : IF (MELVAL.NE.0) THEN 998 : IBMN=MIN(IB,VELCHE(/2)) 999 : EPAIST=VELCHE(1,IBMN) 1000 : ELSE 1001 : EPAIST=XZero 1002 : ENDIF 1003 : MELVAL=IVAL(2) 1004 : IF (MELVAL.NE.0) THEN 1005 : IBMN=MIN(IB,VELCHE(/2)) 1006 : EXCEN=VELCHE(1,IBMN) 1007 : ELSE 1008 : EXCEN=XZero 1009 : ENDIF 1010 : C= Element thermique 1011 : IF (ITHER.NE.0) THEN 1012 : IF (IB.EQ.1) THEN 1013 : SEGINI,MWRK3 1014 : MINTE1=IPMIN1 1015 : SEGACT,MINTE1 1016 : ENDIF 1016 : CALL CQTGR2(XE,NBNN,NBPGAU,LRE,EPAIST,DZEGAU, 1017 : . SHPTOT,MINTE1.SHPTOT,XDDL,WORK(1),WORK(1+LRE)) 1018 : MPTVAL=IVAGRA 1019 : IE=LRE 1020 : DO iGau=1,NBPGAU 1021 : DO i=1,NGRA 1022 : MELVAL=IVAL(i) 1023 : IGMN=MIN(iGau,VELCHE(/1)) 1024 : IBMN=MIN(IB,VELCHE(/2)) 1025 : IE=IE+1 1026 : VELCHE(IGMN,IBMN)=WORK(IE) 1027 : ENDDO 1028 : ENDDO 1029 : C= Element mecanique 1030 : ELSE 1031 : IF (IB.EQ.1) SEGINI,MWRK2,MWRK4 1031 : CALL CQ4LOC(XE,XEL,BPSS,IERT,1) 1032 : IF (IERT.EQ.1) IG1=IB 1033 : IF (IERT.EQ.3) THEN 1034 : IERT=0 1035 : NOPLAN=1 1036 : ELSE 1037 : NOPLAN=0 1038 : ENDIF 1038 : CALL MATVEC(XDDL,XDDLOC,BPSS,8) 1039 : DO iGau=1,NBPGAU 1039 : CALL BGRCQ4(iGau,XEL,SHPTOT,SHPWRK,BGR,DJAC,EXCEN, 1040 : . NOPLAN,IERT) 1041 : IF (IERT.EQ.1) THEN 1042 : iMess=321 1043 : GOTO 260 1044 : ENDIF 1044 : CALL BGRDEP(BGR,NGRA,XDDLOC,LRE,GRADI) 1045 : MPTVAL=IVAGRA 1046 : DO i=1,NGRA 1047 : MELVAL=IVAL(i) 1048 : IGMN=MIN(iGau,VELCHE(/1)) 1049 : IBMN=MIN(IB,VELCHE(/2)) 1050 : VELCHE(IGMN,IBMN)=GRADI(i) 1051 : ENDDO 1052 : ENDDO 1053 : ENDIF 1054 : GOTO 100 1055 : C= 2.14.10 - Element DST 1056 : 93 IF (IB.EQ.1) THEN 1057 : NV1=NMATT 1058 : SEGINI,MWRK2,MWRK3,MWRK4,MVELCH 1059 : ENDIF 1059 : CALL VPAST(XE,BPSS) 1059 : CALL VCORLC(XE,XEL,BPSS) 1059 : CALL MATVEC(XDDL,XDDLOC,BPSS,6) 1060 : C= Calcul de la moyenne des epaisseurs 1061 : MPTVAL=IVACAR 1062 : EPAIST=XZero 1063 : MELVAL=IVAL(1) 1064 : IF (MELVAL.NE.0) THEN 1065 : IBMN=MIN(IB,VELCHE(/2)) 1066 : DO iGau=1,NBPGAU 1067 : IGMN=MIN(iGau,VELCHE(/1)) 1068 : EPAIST=EPAIST+VELCHE(IGMN,IBMN) 1069 : ENDDO 1070 : EPAIST=EPAIST/NBPGAU 1071 : ENDIF 1072 : C= Calcul de la moyenne des excentrements 1073 : EXCEN=XZero 1074 : MELVAL=IVAL(2) 1075 : IF (MELVAL.NE.0) THEN 1076 : IBMN=MIN(IB,VELCHE(/2)) 1077 : DO iGau=1,NBPGAU 1078 : IGMN=MIN(iGau,VELCHE(/1)) 1079 : EXCEN=EXCEN+VELCHE(IGMN,IBMN) 1080 : ENDDO 1081 : EXCEN=EXCEN/NBPGAU 1082 : ENDIF 1083 : DO iGau=1,NBPGAU 1084 : MPTVAL=IVAMAT 1085 : DO i=1,NMATT 1086 : IF (IVAL(i).NE.0) THEN 1087 : MELVAL=IVAL(i) 1088 : IGMN=MIN(iGau,VELCHE(/1)) 1089 : IBMN=MIN(IB,VELCHE(/2)) 1090 : VALMAT(i)=VELCHE(IGMN,IBMN) 1091 : ELSE 1092 : VALMAT(i)=XZero 1093 : ENDIF 1094 : ENDDO 1095 : IF (iGau.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN 1095 : CALL DOHDST(VALMAT,CMATE,IFOUR,NSTRS,DDHOOK,IRTD1) 1096 : IF (IRTD1.EQ.0) GOTO 260 1097 : ENDIF 1097 : CALL HOOKMU(EPAIST,XZero,LHOOK,DDHOOK,DDHOMU) 1097 : CALL ZERO(BGR,NGRA,LRE) 1098 : C= Termes de la matrice BGR relatifs aux cisaillements transverses 1098 : CALL DSTGR2(XEL,NGRA,NSTRS,DDHOMU,WORK(1),WORK(10), 1099 : . WORK(19),BGR) 1100 : C= Termes de la matrice BGR relatifs aux effets de membrane 1100 : CALL DSTGR1(iGau,NBNO,XEL,NGRA,QSIGAU,ETAGAU,SHPTOT,SHPWRK, 1101 : . EXCEN,WORK(1),WORK(10),WORK(19),BGR,DJAC) 1102 : C= Multiplication de BGR par les deplacements XDDLOC 1102 : CALL BGRDEP(BGR,NGRA,XDDLOC,LRE,GRADI) 1103 : MPTVAL=IVAGRA 1104 : DO i=1,NGRA 1105 : MELVAL=IVAL(i) 1106 : IGMN=MIN(iGau,VELCHE(/1)) 1107 : IBMN=MIN(IB,VELCHE(/2)) 1108 : VELCHE(IGMN,IBMN)=GRADI(i) 1109 : EnDDO 1110 : ENDDO 1111 : GOTO 100 1112 : C= 2.14.29 - ElementS POUTRE, TUYA, TIMO 1113 : 29 IF (IB.EQ.1) THEN 1114 : SEGINI,MWRK2 1115 : SEGINI,MWRK3 1116 : ENDIF 1117 : C= Element thermique 1118 : IF (ITHER.NE.0) THEN 1119 : IMESS = 86 1120 : GO TO 260 1121 : C= Element mecanique 1122 : ELSE 1123 : C ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB 1123 : CALL ZERO(WORK,NCAR,1) 1124 : DO 4029 IGAU=1,NBNN 1125 : MPTVAL=IVACAR 1126 : DO 6029 IC=1,NCAR 1127 : IF (IVAL(IC).NE.0) THEN 1128 : MELVAL=IVAL(IC) 1129 : IBMN=MIN(IB ,VELCHE(/2)) 1130 : IGMN=MIN(IGAU,VELCHE(/1)) 1131 : IF (IGMN.GT.0.AND.IBMN.GT.0) THEN 1132 : WORK(IC)=WORK(IC)+VELCHE(IGMN,IBMN) 1133 : ELSE 1134 : WORK(IC)=0. 1135 : ENDIF 1136 : ELSE 1137 : WORK(IC)=0. 1138 : ENDIF 1139 : IF (IGAU.EQ.NBNN) WORK(IC)=WORK(IC)/NBNN 1140 : 6029 CONTINUE 1141 : 4029 CONTINUE 1142 : C CAS OU ON A LU LE MOT VECTEUR 1143 : IF (IFOUR.EQ.2) THEN 1144 : IF (IVECT.EQ.1) THEN 1145 : IF (IVAL(NCAR).NE.0) THEN 1146 : MELVAL=IVAL(NCAR) 1147 : IBMN=MIN(IB,IELCHE(/2)) 1148 : IP=IELCHE(1,IBMN) 1149 : IREF=(IP-1)*(IDIM+1) 1150 : DO 6129 IC=1,IDIM 1151 : WORK(NCAR+IC-1)=XCOOR(IREF+IC) 1152 : 6129 CONTINUE 1153 : ELSE 1154 : DO 6229 IC=1,IDIM 1155 : WORK(NCAR+IC-1)=0.D0 1156 : 6229 CONTINUE 1157 : ENDIF 1158 : ENDIF 1159 : ENDIF 1160 : C CAS DES TUYAUX - ON CALCULE LES CARACTERISTIQUES DE LA POUTRE 1161 : C EQUIVALENTE 1162 : IF (MELE.EQ.42) THEN 1163 : CISA=WORK(4) 1164 : VX=WORK(5) 1165 : VY=WORK(6) 1166 : VZ=WORK(7) 1166 : CALL TUYCAR(WORK,CISA,VX,VY,VZ,KERRE,2) 1167 : ENDIF 1168 : C ON CALCULE LES GRADIENTS 1169 : IF (MELE.EQ.84) THEN 1170 : IF (CMATE.EQ.'SECTION') THEN 1171 : IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN 1171 : CALL TIMGR2(XE,XDDL,WORK(12),WORK(25)) 1172 : ELSE 1172 : CALL TIMGR1(XE,XDDL,WORK(1),WORK(12),WORK(25)) 1173 : ENDIF 1174 : ELSE 1175 : IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN 1175 : CALL TIMGR2(XE,XDDL,WORK(12),WORK(25)) 1176 : ELSE 1176 : CALL TIMGR1(XE,XDDL,WORK(7),WORK(12),WORK(25)) 1177 : ENDIF 1178 : ENDIF 1179 : ELSE 1180 : IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN 1180 : CALL POUGR2(XE,XDDL,WORK,WORK(12),WORK(25)) 1181 : ELSE 1181 : CALL POUGR1(XE,XDDL,WORK,WORK(12),WORK(25)) 1182 : ENDIF 1183 : ENDIF 1184 : C REMPLISSAGE 1185 : DO iGau=1,NBPGAU 1186 : MPTVAL=IVAGRA 1187 : DO i=1,NGRA 1188 : MELVAL=IVAL(i) 1189 : IGMN=MIN(iGau,VELCHE(/1)) 1190 : IBMN=MIN(IB,VELCHE(/2)) 1191 : IDECA=11+I+(IGAU-1)*NGRA 1192 : VELCHE(IGMN,IBMN)=WORK(IDECA) 1193 : ENDDO 1194 : ENDDO 1195 : ENDIF 1196 : GOTO 100 1197 : C= 2.14.265 - JOINT UNIDIMENSIONNEL JOI1 1198 : 265 SEGINI,MWRK2 1199 : SEGINI,MWRK3 1200 : SEGINI,MWRK4 1201 : C 1202 : C RANGEMENT DES CARACTERISTIQUES DANS WORK 1203 : C 1204 : MPTVAL=IVAMAT 1205 : DO IC=1,NMATT 1206 : IF(IVAL(IC).NE.0) THEN 1207 : MELVAL=IVAL(IC) 1208 : IBMN=MIN(IB,VELCHE(/2)) 1209 : WORK(IC)=VELCHE(1,IBMN) 1210 : ELSE 1211 : WORK(IC)=0.D0 1212 : ENDIF 1213 : END DO 1214 : C 1214 : CALL MAPALU(NMATT,WORK,BPSS,IDIM) 1215 : C 1216 : C CALCUL DES DEPLACEMENTS LOCAUX 1217 : C 1218 : IAW1 = 101 1219 : IAW2 = IAW1 + LRE 1219 : CALL JOILOC(XDDL,BPSS,WORK(IAW1),WORK(IAW2),LRE,IDIM) 1220 : * 1221 : C ON CALCULE LES GRADIENTS 1222 : * 1222 : CALL JOIGR1(XDDL,WORK,LRE,NGRA,IDIM) 1223 : C REMPLISSAGE 1224 : DO iGau=1,NBPGAU 1225 : MPTVAL=IVAGRA 1226 : DO i=1,NGRA 1227 : MELVAL=IVAL(i) 1228 : IGMN=MIN(iGau,VELCHE(/1)) 1229 : IBMN=MIN(IB,VELCHE(/2)) 1230 : * IDECA=11+I+(IGAU-1)*NGRA 1231 : VELCHE(IGMN,IBMN)=WORK(I) 1232 : ENDDO 1233 : ENDDO 1234 : GOTO 100 1235 : 1236 : C= 2.14.266 - Element ZCO2 1237 : 266 CONTINUE 1238 : IF (IB.EQ.1) SEGINI,MWRK2,MWRK4 1239 : DO 2660 iGau=1,NBPGAU 1240 : C MATRICE JACOBIENNE 1241 : DO I=1,NBNO 1242 : SHPWRK(1,I) = SHPTOT(1,I,IGAU) 1243 : SHPWRK(2,I) = SHPTOT(2,I,IGAU) 1244 : ENDDO 1245 : C TRAITEMENT PARTICULIER POUR LE CAS 2D 1246 : C SINON, APPEL A DEVOLU 1247 : IF(IDIM.EQ.2) THEN 1248 : dXdQsi=0.D0 1249 : dYdQsi=0.D0 1250 : DO i=1,NBNO 1251 : dXdQsi=dXdQsi+SHPWRK(2,i)*XE(1,i) 1252 : dYdQsi=dYdQsi+SHPWRK(2,i)*XE(2,i) 1253 : ENDDO 1254 : DJAC=SQRT(dXdQsi*dXdQsi+dYdQsi*dYdQsi) 1255 : C ON MULTIPLIE PAR LE RAYON EN AXI 1256 : IF (IFOUR.EQ.0) THEN 1257 : RAYON=0.D0 1258 : DO IRAY=1,NBNO 1259 : RAYON=RAYON+SHPTOT(1,IRAY,IGAU)*XE(1,IRAY) 1260 : ENDDO 1261 : DJAC=DJAC*RAYON 1262 : ENDIF 1263 : ELSE 1264 : * write(ioimp,*) 'option 3d non implementee' 1265 : GOTO 260 1265 : CALL DEVOLU(XE,SHPWRK,MFR,NBNO,IFOU,NIFOU,IDIM,1.D0,RR,DJAC) 1266 : ENDIF 1267 : IF (DJAC.LT.XZero) ISDJC=ISDJC+1 1268 : IF (DJAC.EQ.XZero) THEN 1269 : iMess=259 1270 : GOTO 260 1271 : ENDIF 1272 : c passage Ni,qsi -> Ni,x 1273 : dQsidX = 0.d0 1274 : dQsidY = 0.d0 1275 : if((abs(dXdQsi)).gt.XPETIT) dQsidX = 1.d0/dXdQsi 1276 : if((abs(dYdQsi)).gt.XPETIT) dQsidY = 1.d0/dYdQsi 1277 : IF(IDIM.EQ.3) THEN 1278 : dQsidZ = 0.d0 1279 : if(abs(dZdQsi).gt.XPETIT) dQsidZ = 1.d0/dZdQsi 1280 : ENDIF 1280 : CALL ZERO(BGR,NGRA,LRE) 1281 : c on boucle sur les NGRA(=idim*idim) ligne : 1282 : c IGRA2 permet de remplir 1 sur idim 1283 : IGRA2=1 1284 : DO iidim = 1,idim 1285 : c on boucle sur les idim*NBNO colonnes : 1286 : c II permet de remplir 1 sur idim 1287 : DO I=1,NBNO 1288 : II = idim*(I-1) + iidim 1289 : BGR(IGRA2 ,II) = SHPWRK(2,I)*dQsidX 1290 : BGR(IGRA2+1,II) = SHPWRK(2,I)*dQsidY 1291 : if(idim.eq.3) BGR(IGRA2+2,II) = SHPWRK(2,I)*dQsidZ 1292 : ENDDO 1293 : IGRA2=IGRA2+idim 1294 : ENDDO 1295 : c {grad u}_i = [Bij] * {u_j} 1295 : CALL BGRDEP(BGR,NGRA,XDDL,LRE,GRADI) 1296 : c on remplit 1297 : MPTVAL=IVAGRA 1298 : DO i=1,NGRA 1299 : MELVAL=IVAL(i) 1300 : IGMN=MIN(iGau,VELCHE(/1)) 1301 : IBMN=MIN(IB,VELCHE(/2)) 1302 : VELCHE(IGMN,IBMN)=GRADI(i) 1303 : ENDDO 1304 : 2660 CONTINUE 1305 : GOTO 100 1306 : 1307 : C= 4.14.267 - Element ZCO3 1308 : 267 CONTINUE 1309 : IF (IB.EQ.1) SEGINI,MWRK2,MWRK4 1310 : DO 2670 iGau=1,NBPGAU 1311 : C MATRICE JACOBIENNE 1312 : DO I=1,NBNO 1313 : SHPWRK(1,I) = SHPTOT(1,I,IGAU) 1314 : SHPWRK(2,I) = SHPTOT(2,I,IGAU) 1315 : SHPWRK(3,I) = SHPTOT(3,I,IGAU) 1316 : ENDDO 1317 : c write(6,*) 'SHPWRK(2,I) = ' ,(SHPWRK(2,iou),iou=1,NBNO) 1318 : c write(6,*) 'SHPWRK(3,I) = ' ,(SHPWRK(3,iou),iou=1,NBNO) 1319 : 1320 : 1321 : dXdQsi=0.D0 1322 : dXdEta=0.D0 1323 : dYdQsi=0.D0 1324 : dYdEta=0.D0 1325 : dZdQsi=0.D0 1326 : dZdEta=0.D0 1327 : DO i=1,NBNO 1328 : dXdQsi=dXdQsi+SHPWRK(2,i)*XE(1,i) 1329 : dXdEta=dXdEta+SHPWRK(3,i)*XE(1,i) 1330 : dYdQsi=dYdQsi+SHPWRK(2,i)*XE(2,i) 1331 : dYdEta=dYdEta+SHPWRK(3,i)*XE(2,i) 1332 : dZdQsi=dYdQsi+SHPWRK(2,i)*XE(3,i) 1333 : dZdEta=dZdEta+SHPWRK(3,i)*XE(3,i) 1334 : ENDDO 1335 : 1336 : c write(6,*)' dXdQsi = ',dXdQsi 1337 : c write(6,*)' dYdQsi = ',dYdQsi 1338 : c write(6,*)' dZdQsi = ',dZdQsi 1339 : c write(6,*)' dXdEta = ',dXdEta 1340 : c write(6,*)' dYdEta = ',dYdEta 1341 : c write(6,*)' dZdEta = ',dZdEta 1342 : C définition des vecteurs de la base orthonormé 1343 : c vQsi 1344 : vQsi = sqrt(dXdQsi*dXdQsi+dYdQsi*dYdQsi+dZdQsi*dZdQsi) 1345 : c write(6,*) 'Norme de vQsi = ',vQsi 1346 : vQsiX = dXdQsi / vQsi 1347 : vQsiY = dYdQsi / vQsi 1348 : vQsiZ = dZdQsi / vQsi 1349 : c write(6,*) ' vQsiX = ', vQsiX 1350 : c write(6,*) ' vQsiY = ', vQsiY 1351 : c write(6,*) ' vQsiZ = ', vQsiZ 1352 : 1353 : c produit scalaire VEta vQsi 1354 : Sca1 = dXdEta*vQsiX + dYdEta*vQsiY + dZdEta*vQsiZ 1355 : c write(6,*) 'VEta.vQsi = ',Sca1 1356 : c EEta = Veta - sca1 Eqsi (orthogonalisation) 1357 : vEtaX = dXdEta - sca1 * vQsiX 1358 : vEtaY = dYdEta - sca1 * vQsiY 1359 : vEtaZ = dZdEta - sca1 * vQsiZ 1360 : c write(6,*) ' vEtaX = ', vEtaX 1361 : c write(6,*) ' vEtaY = ', vEtaY 1362 : c write(6,*) ' vEtaZ = ', vEtaZ 1363 : c on morme EEta 1364 : vEta = sqrt(vEtaX*vEtaX+vEtaY*vEtaY+vEtaZ*vEtaZ) 1365 : c write(6,*) 'Norme de vEta = ',veta 1366 : vEtaX = vEtaX / vEta 1367 : vEtaY = vEtaY / vEta 1368 : vEtaZ = vEtaZ / vEta 1369 : 1370 : c Qsi,x 1371 : dQsidX=0.D0 1372 : dQsidY=0.D0 1373 : dQsidZ=0.D0 1374 : dEtadX=0.D0 1375 : dEtadY=0.D0 1376 : dEtadZ=0.D0 1377 : dQsidX=(vQsiX - (sca1*vEtaX)/vEta)/vQsi 1378 : dQsidY=(vQsiY - (sca1*vEtaY)/vEta)/vQsi 1379 : dQsidZ=(vQsiZ - (sca1*vEtaZ)/vEta)/vQsi 1380 : dEtadX=vEtaX/vEta 1381 : dEtadY=vEtaY/vEta 1382 : dEtadZ=vEtaZ/vEta 1383 : 1384 : c write(6,*)' dQsidX = ',dQsidX 1385 : c write(6,*)' dQsidY = ',dQsidY 1386 : c write(6,*)' dQsidZ = ',dQsidZ 1387 : c write(6,*)' dEtadX = ',dEtadX 1388 : c write(6,*)' dEtadY = ',dEtadY 1389 : c write(6,*)' dEtadZ = ',dEtadZ 1390 : 1391 : c write(6,*) 'SHPWRK(1,I) = ' ,(SHPWRK(1,iou),iou=1,NBNO) 1392 : c write(6,*) 'SHPWRK(2,I) = ' ,(SHPWRK(2,iou),iou=1,NBNO) 1393 : c write(6,*) 'SHPWRK(3,I) = ' ,(SHPWRK(3,iou),iou=1,NBNO) 1394 : 1394 : CALL ZERO(BGR,NGRA,LRE) 1395 : c on boucle sur les NGRA(=idim*idim) ligne : 1396 : c IGRA2 permet de remplir 1 sur idim 1397 : IGRA2=1 1398 : DO iidim = 1,idim 1399 : c on boucle sur les idim*NBNO colonnes : 1400 : c II permet de remplir 1 sur idim 1401 : DO I=1,NBNO 1402 : II = idim*(I-1) + iidim 1403 : BGR(IGRA2 ,II) = SHPWRK(2,I)*dQsidX+SHPWRK(3,I)*dEtadX 1404 : BGR(IGRA2+1,II) = SHPWRK(2,I)*dQsidY+SHPWRK(3,I)*dEtadY 1405 : if(idim.eq.3) then 1406 : BGR(IGRA2+2,II) = SHPWRK(2,I)*dQsidZ+SHPWRK(3,I)*dEtadZ 1407 : endif 1408 : ENDDO 1409 : IGRA2=IGRA2+idim 1410 : ENDDO 1411 : c {grad u}_i = [Bij] * {u_j} 1412 : c DO I=1,NGRA 1413 : c write(6,*) 'BGR(',I,',..) = ' ,(BGR(I,iou),iou=1,idim*NBNO) 1414 : c write(6,*) 'BGR(2,I) = ' ,(BGR(2,iou),iou=1,idim*NBNO) 1415 : c write(6,*) 'BGR(3,I) = ' ,(BGR(3,iou),iou=1,idim*NBNO) 1416 : c ENDDO 1417 : 1417 : CALL BGRDEP(BGR,NGRA,XDDL,LRE,GRADI) 1418 : c write(6,*) 'XDDL(i) = ' ,(XDDL(iou),iou=1,LRE) 1419 : c write(6,*) 'GRADI(i) = ' ,(GRADI(iou),iou=1,NGRA) 1420 : c on remplit 1421 : MPTVAL=IVAGRA 1422 : DO i=1,NGRA 1423 : MELVAL=IVAL(i) 1424 : IGMN=MIN(iGau,VELCHE(/1)) 1425 : IBMN=MIN(IB,VELCHE(/2)) 1426 : VELCHE(IGMN,IBMN)=GRADI(i) 1427 : ENDDO 1428 : 1429 : 2670 CONTINUE 1430 : GOTO 100 1431 : 1432 : 100 CONTINUE 1433 : 1434 : 1435 : 1436 : IF (ITHEHY.NE.0) SEGSUP,MLREE1,MLREE2 1437 : C= Fin de la boucle sur les elements 1438 : iOK=1 1439 : C ====== 1440 : C 2.15 - Desactivation/suppression de segments associes a iSou 1441 : C ====== 1442 : 260 IF (MWRK2.NE.0) SEGSUP,MWRK2 1443 : IF (MWRK3.NE.0) SEGSUP,MWRK3 1444 : IF (MWRK4.NE.0) SEGSUP,MWRK4 1445 : IF (MVELCH.NE.0) SEGSUP,MVELCH 1446 : IF (IPMIN1.NE.0) SEGDES,MINTE1 1447 : 250 CONTINUE 1448 : SEGSUP,MWRK1 1449 : NOMID=MOGRAD 1450 : if(lsupgd)SEGSUP,NOMID 1451 : 240 NOMID=MODEPL 1452 : if(lsupdp)SEGSUP,NOMID 1452 : CALL DTMVAL(IVADEP,1) 1453 : 230 IF (MOMATR.NE.0) THEN 1454 : NOMID=MOMATR 1455 : SEGSUP,NOMID 1456 : ENDIF 1456 : CALL DTMVAL(IVAMAT,1) 1457 : 220 IF (MOCARA.NE.0) THEN 1458 : NOMID=MOCARA 1459 : SEGSUP,NOMID 1460 : ENDIF 1460 : CALL DTMVAL(IVACAR,1) 1461 : SEGDES,MINTE 1462 : 210 CONTINUE 1463 : SEGDES,MELEME 1464 : 200 CONTINUE 1465 : SEGDES,IMODEL 1466 : C= Sortie prematuree en cas d'ERREUR (iOK=0) 1467 : IF (iOK.EQ.0) THEN 1467 : CALL DTMVAL(IVAGRA,3) 1468 : IF (MCHAML.NE.0) SEGSUP,MCHAML 1469 : SEGSUP,MCHELM 1470 : IF (iMess.NE.0) THEN 1471 : INTERR(1)=IB 1471 : CALL ERREUR(iMess) 1472 : ENDIF 1473 : GOTO 300 1474 : ENDIF 1475 : MPTVAL = IVAGRA 1476 : DO i = 1, IVAL(/1) 1477 : MELVAL = IVAL(i) 1477 : CALL COMRED(MELVAL) 1478 : ENDDO 1478 : CALL DTMVAL(IVAGRA,1) 1479 : SEGDES,MCHAML 1480 : 2000 continue 1481 : 1482 : C 3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS 1483 : C ==================================================== 1484 : IRET=1 1485 : if( n1.ne.isouss) then 1486 : n1=isouss 1487 : segadj mchelm 1488 : endif 1489 : SEGDES,MCHELM 1490 : 300 CONTINUE 1491 : SEGDES,MMODEL 1492 : NOTYPE=MOTYCH 1493 : SEGSUP,NOTYPE 1494 : C* IF (IPCHE1.NE.0) THEN 1495 : C* MCHELM=IPCHE1 1496 : C* SEGDES,MCHELM 1497 : C* ENDIF 1498 : C* IF (IPCHE2.NE.0) THEN 1499 : C* MCHELM=IPCHE2 1500 : C* SEGDES,MCHELM 1501 : C* ENDIF 1502 : 1503 : RETURN 1504 : END 1505 : 1506 : 1507 : 1508 : 1509 : 1510 :
© Cast3M 2003 - All rights reserved.
Disclaimer