1 : C FPMASS SOURCE PV 13/10/25 21:15:05 7853 2 : SUBROUTINE FPMASS(IPCHE1,IPMODL,IPTFP,JPMAIL,XP,IRET) 3 : C_____________________________________________________________________ 4 : C 5 : C CALCULE LES FORCES DE PRESSIONS APPLIQUEES SUR DES MASSIFS 6 : C 7 : C ENTREES : 8 : C --------- 9 : C 10 : C IPCHE1 CHPOINT CONTENANT LES VALEURS DES PRESSIONS AUX NOEUDS 11 : C DE LA FACE D UN MASSIF 12 : C IPMODL OBJET MODELE SUR LEQUEL S APPLIQUE LA PRESSION 13 : C 14 : C JPMAIL POINTEUR SUR LE MAILLAGE SI ON A LU UN FLOTTANT ET 15 : C UN MAILLAGE, SINON 0 16 : C 17 : C XP LA VALEUR DE LA PRESSION SI ON L'A LUE 18 : C 19 : C SORTIES : 20 : C ---------- 21 : C 22 : C IPTFP = CHPOINT DES FORCES NODALES EQUIVALENTES 23 : C IRET = 1 OU 0 SUIVANT SUCCES OU NON 24 : C 25 : C REVISION JACQUELINE BROCHARD SEPTEMBRE 86 26 : C MISE A JOUR P VERPEAUX MAI 88 27 : C 28 : C PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 17 09 90 29 : C_______________________________________________________________________ 30 : C 31 : IMPLICIT INTEGER(I-N) 32 : IMPLICIT REAL*8(A-H,O-Z) 33 : C 34 : -INC CCOPTIO 35 : -INC CCHAMP 36 : -INC SMCOORD 37 : -INC SMELEME 38 : -INC SMMODEL 39 : -INC SMCHAML 40 : -INC SMCHPOI 41 : -INC SMINTE 42 : C 43 : SEGMENT INFO 44 : INTEGER INFELL(JG) 45 : ENDSEGMENT 46 : * 47 : SEGMENT NOTYPE 48 : CHARACTER*16 TYPE(NBTYPE) 49 : ENDSEGMENT 50 : C 51 : SEGMENT MPTVAL 52 : INTEGER IPOS(NS) ,NSOF(NS) 53 : INTEGER IVAL(NCOSOU) 54 : CHARACTER*16 TYVAL(NCOSOU) 55 : ENDSEGMENT 56 : C 57 : DIMENSION V(3),F(3) 58 : CHARACTER*4 MOSTRI,MOAPPU,MOGEOM 59 : CHARACTER*(NCONCH) CONM 60 : PARAMETER (NINF=3) 61 : INTEGER INFOS(NINF) 62 : LOGICAL LSUPFO,ltelq 63 : C 64 : DATA MOAPPU/'APPU'/,MOSTRI/'STRI'/ 65 : DATA MOGEOM/'GEOM'/ 66 : C 67 : IRET = 0 68 : C 69 : IND=0 70 : IPCHE2=0 71 : NHRM=NIFOUR 72 : IPTVPR=0 73 : C 74 : C ON CREE L OBJET GEOMETRIQUE CONTENANT TOUS LES PTS DU CHPOP 75 : C SI BESOIN 76 : C 77 : IF(JPMAIL.EQ.0) THEN 78 : MCHPOI=IPCHE1 79 : SEGACT MCHPOI 80 : DO 50 I=1,IPCHP(/1) 81 : MSOUPO=IPCHP(I) 82 : SEGACT MSOUPO 83 : IF (I.GT.1) THEN 84 : ltelq=.false. 84 : CALL FUSE(IGEOM,IGEOC,IPPT,ltelq) 85 : IGEOM=IPPT 86 : ELSE 87 : IGEOM=IGEOC 88 : ENDIF 89 : SEGDES MSOUPO 90 : 50 CONTINUE 91 : SEGDES MCHPOI 92 : IF (IERR.NE.0) RETURN 93 : ENDIF 94 : C 95 : C ACTIVATION DU MODEL 96 : C 97 : MMODEL=IPMODL 98 : SEGACT MMODEL 99 : NSOUS=KMODEL(/1) 100 : 101 : idimp1=IDIM+1 102 : C= Cas des modes de calculs en DEFORMATIONS GENERALISEES 103 : IF (IFOUR.EQ.-3) THEN 104 : NDPGE=3 105 : ELSE IF (IFOUR.EQ.11) THEN 106 : NDPGE=2 107 : ELSE IF (IFOUR.EQ. 7.OR.IFOUR.EQ. 8.OR.IFOUR.EQ. 9.OR. 108 : . IFOUR.EQ.10.OR.IFOUR.EQ.14) THEN 109 : NDPGE=1 110 : ELSE 111 : NDPGE=0 112 : ENDIF 113 : 114 : IRRT=0 115 : DO 100 ISOUS=1,NSOUS 116 : C 117 : C ON RECUPERE L INFORMATION GENERALE 118 : C 119 : IMODEL=KMODEL(ISOUS) 120 : SEGACT IMODEL 121 : IPMAIL=IMAMOD 122 : CONM =CONMOD 123 : C 124 : C TRAITEMENT DU MODEL 125 : C 126 : MOCARA = 0 127 : IVACAR = 0 128 : IVAFOR = 0 129 : C 130 : MELM=NEFMOD 131 : if(melm . eq . 22) go to 100 132 : C 133 : C ON RECUPERE LES ELTS DE L ENVELOPPE DU MASSIF APPUYES 134 : C STRICTEMENT SUR LE CHPOINT DE PRESSIONS OU appartenant au 135 : C MAILLAGE DONNE 136 : C 136 : CALL ECROBJ('MAILLAGE',IPMAIL) 137 : IF (IDIM.EQ.2) THEN 137 : CALL PRCONT 138 : ELSE IF (IDIM.EQ.3) THEN 138 : CALL ENVELO 139 : ELSE IF (IDIM.EQ.1) THEN 139 : CALL PREX1D 140 : ENDIF 141 : IF (IERR.NE.0) THEN 142 : SEGDES MMODEL 143 : SEGDES IMODEL 144 : RETURN 145 : ENDIF 145 : CALL LIROBJ('MAILLAGE',ienvel,1,IRETOU) 146 : c ... si un CHPOINT a été donné, on va chercher la partie de 147 : c l'enveloppe s'appuyant strictement sur le support du CHPOINT ... 148 : IF(JPMAIL.EQ.0) THEN 148 : CALL ECROBJ('MAILLAGE',IGEOM) 148 : CALL ECRCHA(MOSTRI) 148 : CALL ECRCHA(MOAPPU) 148 : CALL ECROBJ('MAILLAGE',ienvel) 148 : CALL EXTREL (IRR,0,IBNOR) 149 : ELSE 150 : c ... sinon, on va chercher l'intersection de l'enveloppe avec 151 : c le maillage fourni ... 151 : CALL INTERB(ienvel,jpmail,irr,IPOGEO) 152 : ENDIF 153 : C ... Ici on teste si intersection est vide, si OUI on 154 : C incrémente le compteur et on passe à la zone suivante ... 155 : IF (irr.gt.0) THEN 156 : IRRT=IRRT+1 157 : GOTO 100 158 : ENDIF 159 : IF(JPMAIL.EQ.0) THEN 159 : CALL LIROBJ('MAILLAGE',IPOGEO,1,iret) 160 : IF (IERR.NE.0) RETURN 161 : ENDIF 162 : C 163 : C ON DETERMINE LA FORMULATION ASSOCIEE A L OBJET 164 : C GEOMETRIQUE ELEMENTAIRE DE SURFACE 165 : C 166 : IPT3=IPOGEO 167 : SEGACT IPT3 168 : IPT2=IPT3 169 : IB=0 170 : C 171 : C BOUCLE SUR LES SOUS ZONES DE L ENVELOPPE 172 : C 173 : DO 110 IB=1,MAX(1,IPT3.LISOUS(/1)) 174 : IF (IPT3.LISOUS(/1).NE.0) THEN 175 : IPT2=IPT3.LISOUS(IB) 176 : SEGACT IPT2 177 : IPOGEO=IPT2 178 : ENDIF 179 : NBNN =IPT2.NUM(/1) 180 : LETYP=IPT2.ITYPEL 181 : IF (IPT3.LISOUS(/1).EQ.0) GOTO 112 182 : SEGDES IPT2 183 : C 184 : 112 CONTINUE 185 : * 186 : * PETIT TEST SUR LE TYPE 187 : * 188 : IF(LETYP.EQ.1.AND.IDIM.NE.1) THEN 188 : CALL ERREUR(16) 189 : SEGDES IPT3 190 : GOTO 9997 191 : ENDIF 192 : * 192 : CALL TYPFAC(MELM,NBNN,MELE) 193 : IF (MELE.EQ.0) THEN 194 : C 195 : C ERREUR : IMPOSSIBLE D UTILISER L OPERATEUR PRESSI POUR 196 : C LES ELEMENTS DE FORMULATION MELM 197 : C 198 : MOTERR(1:8)=NOMTP(MELM) 198 : CALL ERREUR(193) 199 : SEGDES IPT3 200 : GOTO 9997 201 : ENDIF 202 : C 203 : C ON CREE L OBJET MODEL ASSOCIE A LA SURFACE ELEMENTAIRE 204 : C 205 : N1=1 206 : SEGINI MMODE1 207 : IPMOD1=MMODE1 208 : NFOR=FORMOD(/2) 209 : NMAT=MATMOD(/2) 210 : MN3=0 211 : NPARMO=0 212 : nobmod=0 213 : SEGINI IMODE1 214 : MMODE1.KMODEL(1)=IMODE1 215 : IMODE1.IMAMOD=IPOGEO 216 : IMODE1.NEFMOD=MELE 217 : IMODE1.CONMOD=CONMOD 218 : DO 10 I=1,NFOR 219 : IMODE1.FORMOD(I)=FORMOD(I) 220 : 10 CONTINUE 221 : DO 11 I=1,NFOR 222 : IMODE1.MATMOD(I)=MATMOD(I) 223 : 11 CONTINUE 224 : SEGDES MMODE1 225 : SEGDES IMODE1 226 : C 227 : C ON TRANSFORME LE CHPOINT DE PRESSION EN CHELEM ELEMENTAIRE 228 : C 229 : IF(JPMAIL.EQ.0) THEN 229 : CALL CHAME1(0,IPMOD1,IPCHE1,' ',ICHELP,3) 230 : IF (IERR.NE.0) THEN 230 : CALL DTMODL(IPMOD1) 231 : SEGDES IPT3 232 : RETURN 233 : ENDIF 234 : MCHEL1=ICHELP 235 : SEGACT MCHEL1 236 : MCHAM1=MCHEL1.ICHAML(1) 237 : SEGACT MCHAM1 238 : IPTVPR=MCHAM1.IELVAL(1) 239 : ENDIF 240 : C 241 : C INFORMATION SUR L'ELEMENT FINI 242 : C 242 : CALL ELQUOI(MELE,0,3,IPINF,IMODEL) 243 : IF (IERR.NE.0) THEN 244 : SEGDES IPT3 244 : IF(JPMAIL.EQ.0) CALL DTCHAM(ICHELP) 244 : CALL DTMODL(IPMOD1) 245 : GOTO 9997 246 : RETURN 247 : ENDIF 248 : INFO=IPINF 249 : IPTINT=INFELL(11) 250 : MFR =INFELL(13) 251 : C*OF En DIMEnsion 1, on force FORMULATION MASSIVE pour POI1 252 : IF (IDIM.EQ.1.AND.MELE.EQ.45) MFR=1 253 : IPPORE=0 254 : IF(MFR.EQ.33) IPPORE=NBNN 255 : C Destruction immediate du segment 256 : SEGSUP,INFO 257 : C Caracteristiques d'integration 258 : MINTE=IPTINT 259 : SEGACT,MINTE 260 : C 261 : C INITIALISATION DU CHELEM ELEMENTAIRE DES FORCES NODALES 262 : C 263 : N1=1 264 : L1=6 265 : N3=5 266 : SEGINI MCHELM 267 : TITCHE='FORCES' 268 : IFOCHE=IFOUR 269 : IPCHEL=MCHELM 270 : C 271 : IMACHE(1)=IPOGEO 272 : INFCHE(1,1)=0 273 : INFCHE(1,2)=0 274 : INFCHE(1,3)=NHRM 275 : INFCHE(1,4)=IPTINT 276 : INFCHE(1,5)=0 277 : C 278 : C RECHERCHE DE LA TAILLE DES MELVALS 279 : C 280 : MELEME=IPOGEO 281 : SEGACT MELEME 282 : N1PTEL=NUM(/1) 283 : N1EL =NUM(/2) 284 : N2PTEL=0 285 : N2EL =0 286 : SEGDES MELEME 287 : C 288 : C RECHERCHE DES NOM DE COMPOSANTES 289 : C 290 : if(lnomid(2).ne.0) then 291 : nomid=lnomid(2) 292 : segact nomid 293 : moforc=nomid 294 : nfor=lesobl(/2) 295 : nfac=0 296 : lsupfo=.false. 297 : else 298 : lsupfo=.true. 298 : CALL IDFORC(MFR,IFOUR,MOFORC,NFOR,NFAC) 299 : endif 300 : NCOMP=NFOR-NDPGE 301 : C** IF (IFOUR.EQ.-3) NCOMP=NFOR-3 302 : C 303 : C CREATION DU MCHAML DE LA SOUS ZONE 304 : C 305 : N2=NCOMP 306 : SEGINI MCHAML 307 : ICHAML(1)=MCHAML 308 : NS=1 309 : NCOSOU=NCOMP 310 : SEGINI MPTVAL 311 : IVAFOR=MPTVAL 312 : NOMID=MOFORC 313 : SEGACT NOMID 314 : DO 4 ICOMP=1,NCOMP 315 : NOMCHE(ICOMP)=LESOBL(ICOMP) 316 : TYPCHE(ICOMP)='REAL*8' 317 : SEGINI MELVAL 318 : IELVAL(ICOMP)=MELVAL 319 : IVAL(ICOMP)=MELVAL 320 : 4 CONTINUE 321 : * 322 : *____________________________________________________________________ 323 : * 324 : * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES 325 : *____________________________________________________________________ 326 : * 327 : IF (IFOUR.EQ.-2.AND.IND.EQ.0) THEN 327 : CALL LIROBJ('MCHAML',IPCHE2,0,IRT3) 328 : IND=1 329 : IF (IERR.NE.0) GOTO 9990 330 : IF (IPCHE2.NE.0) THEN 331 : * 332 : * Verification du lieu support du MCHAML de caracteristique 333 : * 333 : CALL QUESUP(IPMODL,IPCHE2,3,1,ISUP,IRETCA) 334 : IF (ISUP.GT.1) GOTO 9990 335 : * 336 : * CREATION DU TABLEAU INFOS 337 : * 337 : CALL IDENT (IPMAIL,CONM,IPCHE2,0,INFOS,IRTD) 338 : IF (IRTD.EQ.0) THEN 339 : SEGSUP MCHELM 339 : CALL DTCHAM(IPCHE2) 340 : RETURN 341 : ENDIF 342 : * 343 : NBROBL=0 344 : NBRFAC=1 345 : SEGINI NOMID 346 : MOCARA=NOMID 347 : LESFAC(1)='DIM3' 348 : * 349 : NBTYPE=1 350 : SEGINI NOTYPE 351 : MOTYPE=NOTYPE 352 : TYPE(1)='REAL*8' 353 : * 353 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,0, 354 : + INFOS,3,IVACAR) 355 : SEGSUP NOTYPE 356 : IF (IERR.NE.0) GOTO 9990 357 : NCARA=NBROBL 358 : NCARF=NBRFAC 359 : NCARR=NCARA+NCARF 360 : * 361 : IF (ISUP.EQ.1) THEN 361 : CALL VALCHE(IVACAR,NCARR,IPTINT,IPPORE) 362 : ENDIF 363 : * 364 : ENDIF 365 : ENDIF 366 : C 367 : C CALCUL DES FORCES NODALES EQUIVALENTES 368 : C DEBRANCHEMENT SUIVANT LE TYPE DES ELEMENTS 369 : C 370 : IF (MELE.EQ.2.OR.MELE.EQ.3) THEN 371 : C 372 : C CAS DES ELEMENTS MASSIFS BIDIMENSIONNELS 373 : C FACES ASSOCIEES SEG2 OU SEG3 374 : C 374 : CALL FPMA2D(IPTVPR,IPOGEO,IPTINT,IVAFOR,IVACAR,XP) 375 : C 376 : ELSE IF(MELE.EQ.31.OR.MELE.EQ.32.OR.MELE.EQ.33. 377 : + OR.MELE.EQ.34)THEN 378 : C 379 : C CAS DES ELEMENTS MASSIFS TRIDIMENSIONNELS 380 : C FACES ASSOCIEES FAC3,FAC4,FAC6 OU FAC8 381 : C 381 : CALL FPMA3D(IPTVPR,IPOGEO,IPTINT,IVAFOR,XP) 382 : C 383 : C= Cas des elements MASSIFs UNIDIMENSIONNELs (1D) 384 : C= Face associee : POI1 (numero 45) 385 : ELSE IF (MELE.EQ.45) THEN 385 : CALL FPMA1D(IPTVPR,IPOGEO,IPTINT,IVAFOR,XP) 386 : 387 : ELSE 388 : C 389 : C ERREUR L ELEMENT N EST PAS ENCORE IMPLEMENTE 390 : C 391 : MOTERR(1:4)=NOMTP(MELE) 392 : MOTERR(5:12)='FPMASS' 392 : CALL ERREUR (86) 393 : SEGDES IPT3 394 : IF(JPMAIL.EQ.0) THEN 395 : SEGDES MCHEL1 396 : SEGDES MCHAM1 397 : ENDIF 397 : CALL DTMODL(IPMOD1) 398 : GOTO 9990 399 : ENDIF 400 : C 401 : C POUR CHAQUE ELEMENT, 402 : C ON DETERMINE UN VECTEUR DIRIGE VERS L INTERIEUR DU MASSIF 403 : C A PARTIR D UN POINT DE LA FACE ET DU CENTRE DE GRAVITE DU MASSI 404 : C 405 : * prob optimiseur il faut initialiser melva1 406 : MELVA1=IPMODL 407 : IF(IPTVPR.NE.0) THEN 408 : MELVA1=IPTVPR 409 : SEGACT MELVA1 410 : ENDIF 411 : MELEME=IPOGEO 412 : IPT1=IPMAIL 413 : SEGACT MELEME,IPT1 414 : C 415 : DO 150 IEF=1,NUM(/2) 416 : DO 160 IEM=1,IPT1.NUM(/2) 417 : JNE=0 418 : DO 161 INM=1,IPT1.NUM(/1) 419 : DO 162 INF=1,NUM(/1) 420 : IF (IPT1.NUM(INM,IEM).EQ.NUM(INF,IEF)) JNE=JNE+1 421 : 162 CONTINUE 422 : 161 CONTINUE 423 : IF (JNE.EQ.NUM(/1)) GOTO 170 424 : 160 CONTINUE 425 : SEGDES IPT1,MELEME 425 : CALL ERREUR(26) 426 : IF(IPTVPR.NE.0) SEGDES MELVA1 427 : SEGDES IPT3 427 : CALL DTMODL(IPMOD1) 428 : GOTO 9990 429 : C 430 : 170 CONTINUE 431 : NBM=IPT1.NUM(/1) 432 : NBMA1=NUM(/1) 433 : IF (IDIM.EQ.3) THEN 434 : XG=0.D0 435 : YG=0.D0 436 : ZG=0.D0 437 : DO INM=1,NBM 438 : IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1 439 : XG=XG+XCOOR(IREFM+1) 440 : YG=YG+XCOOR(IREFM+2) 441 : ZG=ZG+XCOOR(IREFM+3) 442 : ENDDO 443 : XG=XG/NBM 444 : YG=YG/NBM 445 : ZG=ZG/NBM 446 : XK=0.D0 447 : YK=0.D0 448 : ZK=0.D0 449 : DO INF=1,NBMA1 450 : IREFF=(NUM(INF,IEF)-1)*idimp1 451 : XK=XK+XCOOR(IREFF+1) 452 : YK=YK+XCOOR(IREFF+2) 453 : ZK=ZK+XCOOR(IREFF+3) 454 : ENDDO 455 : XK=XK/NBMA1 456 : YK=YK/NBMA1 457 : ZK=ZK/NBMA1 458 : V(1)=XG-XK 459 : V(2)=YG-YK 460 : V(3)=ZG-ZK 461 : VN=SQRT(V(1)**2+V(2)**2+V(3)**2) 462 : V(1)=V(1)/VN 463 : V(2)=V(2)/VN 464 : V(3)=V(3)/VN 465 : ELSE IF (IDIM.EQ.2) THEN 466 : XG=0.D0 467 : YG=0.D0 468 : DO INM=1,NBM 469 : IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1 470 : XG=XG+XCOOR(IREFM+1) 471 : YG=YG+XCOOR(IREFM+2) 472 : ENDDO 473 : XG=XG/NBM 474 : YG=YG/NBM 475 : XK=0.D0 476 : YK=0.D0 477 : DO INF=1,NBMA1 478 : IREFF=(NUM(INF,IEF)-1)*idimp1 479 : XK=XK+XCOOR(IREFF+1) 480 : YK=YK+XCOOR(IREFF+2) 481 : ENDDO 482 : XK=XK/NBMA1 483 : YK=YK/NBMA1 484 : V(1)=XG-XK 485 : V(2)=YG-YK 486 : VN=SQRT(V(1)**2+V(2)**2) 487 : V(1)=V(1)/VN 488 : V(2)=V(2)/VN 489 : ELSE IF (IDIM.EQ.1) THEN 490 : XG=0.D0 491 : DO INM=1,NBM 492 : IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1 493 : XG=XG+XCOOR(IREFM+1) 494 : ENDDO 495 : XG=XG/NBM 496 : XK=0.D0 497 : DO INF=1,NBMA1 498 : IREFF=(NUM(INF,IEF)-1)*idimp1 499 : XK=XK+XCOOR(IREFF+1) 500 : ENDDO 501 : XK=XK/NBMA1 502 : V(1)=XG-XK 503 : VN=ABS(V(1)) 504 : V(1)=V(1)/VN 505 : ENDIF 506 : C 507 : C ET ON ORIENTE LES FORCES NODALES APPLIQUEES SUR L ELEMENT 508 : C EN COMPARANT LES DIRECTIONS DE LA RESULTANTE DES FORCES ET DU VECTEUR 509 : C PUIS ON MULTIPLIE PAR LE SIGNE DE LA PRESSION 510 : C 511 : F(1)=0.D0 512 : F(2)=0.D0 513 : F(3)=0.D0 514 : MPTVAL=IVAFOR 515 : DO 200 INF=1,N1PTEL 516 : DO 201 J=1,IDIM 517 : MELVAL=IVAL(J) 518 : F(J)=F(J)+VELCHE(INF,IEF) 519 : 201 CONTINUE 520 : 200 CONTINUE 521 : FN2=0.D0 522 : TEST=0.D0 523 : DO 210 J=1,IDIM 524 : FN2=FN2 + F(J)**2 525 : TEST=TEST+ V(J)*F(J) 526 : 210 CONTINUE 527 : FN=SQRT(FN2) 528 : C 529 : C ERREUR IMPOSSIBLE D ORIENTER LES FORCES DE PRESSION 530 : C 531 : IF (ABS(TEST).LE.0.001D0*FN .AND. FN.NE.0.D0) THEN 531 : CALL ERREUR(192) 532 : SEGDES MELEME,IPT1 533 : IF(IPTVPR.NE.0) SEGDES MELVA1 533 : CALL DTMODL(IPMOD1) 534 : GOTO 9990 535 : ENDIF 536 : XFLOT=1.D0 537 : IF (TEST.LT.0.) XFLOT=-1.D0 538 : IF(IPTVPR.NE.0) THEN 539 : SP=MELVA1.VELCHE(1,IEF)/ABS(MELVA1.VELCHE(1,IEF)) 540 : ELSE 541 : SP=XP/ABS(XP) 542 : ENDIF 543 : MPTVAL=IVAFOR 544 : DO 220 INF=1,N1PTEL 545 : DO 220 ICOMP=1,NCOMP 546 : MELVAL=IVAL(ICOMP) 547 : VELCHE(INF,IEF)=VELCHE(INF,IEF)*XFLOT*SP 548 : 220 CONTINUE 549 : 150 CONTINUE 550 : SEGDES,MINTE 551 : SEGDES IPT1,MELEME 552 : SEGDES MCHELM,MCHAML 553 : IF(IPTVPR.NE.0) SEGDES MELVA1 554 : C 555 : C ON TRANSFORME LE CHAM/ELEM EN CHAM/POIN 556 : C ET ON ADDITIONNE LES CHAM/POIN ELEMENTAIRES 557 : C 557 : CALL CHAMPO(IPCHEL,0,IPCHPO,IPPT) 557 : CALL DTCHAM(IPCHEL) 558 : IF (IPPT.EQ.0) THEN 558 : CALL DTMODL (IPMOD1) 559 : GOTO 9990 560 : ENDIF 561 : IF ((ISOUS-IRRT).GT.1.OR.IB.GT.1) THEN 561 : CALL ADCHPO(IPCHPO,IPTFP,IPPT,1D0,1D0) 561 : * CALL ECRCHA(MOGEOM) 561 : CALL DTCHPO(IPCHPO) 561 : * CALL ECRCHA(MOGEOM) 561 : CALL DTCHPO(IPTFP) 562 : IF (IPPT.EQ.0) THEN 562 : CALL DTMODL(IPMOD1) 563 : GOTO 9990 564 : ENDIF 565 : IPTFP=IPPT 566 : ELSE 567 : IPTFP=IPCHPO 568 : ENDIF 568 : CALL DTMODL(IPMOD1) 569 : 110 CONTINUE 570 : SEGDES IPT3 571 : SEGDES IMODEL 572 : NOMID=MOFORC 573 : if(lsupfo)SEGSUP NOMID 573 : IF(JPMAIL.EQ.0) CALL DTCHAM(ICHELP) 574 : * 575 : IF(ISUP.EQ.1.AND.IPCHE2.NE.0)THEN 575 : CALL DTMVAL(IVACAR,3) 576 : ELSE 576 : CALL DTMVAL(IVACAR,1) 577 : ENDIF 578 : NOMID=MOCARA 579 : IF (MOCARA.NE.0) SEGSUP NOMID 580 : * 581 : MPTVAL=IVAFOR 582 : SEGSUP MPTVAL 583 : C 584 : 100 CONTINUE 585 : IF(IRRT.EQ.KMODEL(/1)) THEN 585 : CALL ERREUR(395) 586 : ELSE 587 : IRET = 1 588 : ENDIF 589 : SEGDES MMODEL 590 : RETURN 591 : C 592 : 9990 CONTINUE 593 : C 594 : C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR 595 : C 595 : CALL DTMVAL(IVAFOR,3) 596 : * 597 : IF(ISUP.EQ.1.AND.IPCHE2.NE.0)THEN 597 : CALL DTMVAL(IVACAR,3) 598 : ELSE 598 : CALL DTMVAL(IVACAR,1) 599 : ENDIF 600 : NOMID=MOCARA 601 : IF (MOCARA.NE.0) SEGSUP NOMID 602 : * 603 : SEGSUP MCHAML 604 : SEGSUP MCHELM 605 : C 606 : NOMID=MOFORC 607 : if(lsupfo)SEGSUP NOMID 608 : C 609 : SEGDES,MINTE 610 : 9997 CONTINUE 611 : SEGDES IMODEL 612 : SEGDES MMODEL 613 : 614 : IRET = 0 615 : 616 : RETURN 617 : END 618 : 619 : 620 :
© Cast3M 2003 - All rights reserved.
Disclaimer