1 : C EPSI2 SOURCE PV 13/11/08 21:15:24 7855 2 : 3 : SUBROUTINE EPSI2(IPMAIL,IPMINT,MELE,IELE, 4 : & IVADEP,NBPTEL,LRE,NSTRS,LHOOK, 5 : & MFR,NDEP,IPORE,IREPS2,NBPGAU,IVAEPS,UZDPG,RYDPG,RXDPG,IIPDPG, 6 : & IDERI,ivamat,ivade2,mate,nmatt,cmate,ngra,noer,kerr) 7 : 8 : *---------------------------------------------------------------------* 9 : c 10 : c calcul des deformations 11 : c 12 : c massif, poreux, joints poreux, incompressibles 13 : *---------------------------------------------------------------------* 14 : * * 15 : * entrees : * 16 : * ________ * 17 : * * 18 : * ipmail pointeur sur un segment meleme * 19 : * ipmint pointeur sur un segment minte * 20 : * mele numero de l'element fini * 21 : * iele numero geometrique de l'element 22 : * nbpgau nombre de point d'integration pour la rigidite * 23 : * ivadep pointeur sur le chamelem de deplacements * 24 : * nbptel nombre de points par element * 25 : * lre nombre de ddl dans la matrice de rigidite * 26 : * nstrs nombre de composante de contraintes/deformations * 27 : * pour une matrice de hooke * 28 : * lhook dimension de la matrice de hooke * 29 : * mfr numero de la formulation de l'element fini * 30 : * ndep nombre de composantes de deplacements * 31 : * ipore nombre de fonctions de forme * 32 : * iresp2 flag pour indiquer si on veut les contraintes * 33 : * de piola-kirchhoff * 34 : * uzdpg = deformation au point nsdpge support de la * 35 : * rydpf = deformation plane generalisee * 36 : * rxdpg = * 37 : * * 38 : * sorties : * 39 : * ________ * 40 : * * 41 : * ivaeps pointeur sur un segment mptval contenant les * 42 : * les melvals de deformations * 43 : *---------------------------------------------------------------------* 44 : * Pour MEMOIRE : Si MELE element incompressible alors MFR = 31 45 : *---------------------------------------------------------------------* 46 : 47 : IMPLICIT INTEGER(I-N) 48 : IMPLICIT REAL*8(A-H,O-Z) 49 : 50 : -INC CCOPTIO 51 : -INC CCREEL 52 : -INC CCHAMP 53 : -INC CCGEOME 54 : -INC SMCHAML 55 : -INC SMCHPOI 56 : -INC SMELEME 57 : -INC SMCOORD 58 : -INC SMMODEL 59 : -INC SMINTE 60 : -INC SMLREEL 61 : 62 : SEGMENT WRK1 63 : REAL*8 DDHOOK(NSTRS,NSTRS),XDDL(LRE),XSTRS(NSTRS) 64 : REAL*8 XE(3,NBBB),DDHOMU(NSTRS,NSTRS) 65 : REAL*8 SHPWRK(6,NBNO),BGENE(LHOOK,LRE) 66 : REAL*8 XE1(3,NBBB),XE2(3,NBBB),xstrs2(NSTRS) 67 : REAL*8 xjac(3,3),valmat(20) 68 : ENDSEGMENT 69 : SEGMENT WRK2 70 : REAL*8 BGR(NGRA,LRE),BB(2,NGRA),gradi(ngra),R(ngra),u(ngra) 71 : REAL*8 TENS(9),tentra(9),xddls2(lre) 72 : ENDSEGMENT 73 : c 74 : SEGMENT WRK3 75 : REAL*8 BPSS(3,3),XEL(3,NBBB) 76 : REAL*8 XNTH(LRN,LRN),XNTB(LRN,LRN),XNTT(LRN) 77 : ENDSEGMENT 78 : c 79 : SEGMENT WRK5 80 : REAL*8 XGENE(NSTN,LRN) 81 : ENDSEGMENT 82 : c 83 : SEGMENT NOTYPE 84 : CHARACTER*16 TYPE(NBTYPE) 85 : ENDSEGMENT 86 : c 87 : SEGMENT MPTVAL 88 : INTEGER IPOS(NS),NSOF(NS) 89 : INTEGER IVAL(NCOSOU) 90 : CHARACTER*16 TYVAL(NCOSOU) 91 : ENDSEGMENT 92 : c 93 : SEGMENT MTRACE 94 : REAL*8 TRACE(NBPTEL) 95 : ENDSEGMENT 96 : 97 : CHARACTER*(NCONCH) CONM 98 : PARAMETER (NINF=3) 99 : DIMENSION A(4,60),BBX(3,60),UDPGE(3) 100 : INTEGER INFOS(NINF) 101 : LOGICAL BDPGE 102 : CHARACTER*8 CMATE 103 : 104 : 105 : DIMENSION IN(6),JN(6),ITAB(3,3) 106 : C 107 : DATA IN/1,2,3,1,1,2/ 108 : DATA JN/1,2,3,2,3,3/ 109 : C 110 : DATA ITAB(1,1),ITAB(1,2),ITAB(1,3)/1,4,5/ 111 : DATA ITAB(2,1),ITAB(2,2),ITAB(2,3)/4,2,6/ 112 : DATA ITAB(3,1),ITAB(3,2),ITAB(3,3)/5,6,3/ 113 : c 114 : 115 : c Introduction du point autour duquel se fait le mouvement 116 : c de la section en defo plane generalisee 117 : C En 1D : pas de rotation 118 : kerr=0 119 : BDPGE=.FALSE. 120 : NDPGE=0 121 : XDPGE=XZero 122 : YDPGE=XZero 123 : IF (IFOUR.EQ.-3) THEN 124 : BDPGE=.TRUE. 125 : NDPGE=3 126 : UDPGE(1)=UZDPG 127 : UDPGE(2)=RYDPG 128 : UDPGE(3)=RXDPG 129 : SEGACT,MCOORD 130 : IREF=(IIPDPG-1)*(IDIM+1) 131 : XDPGE=XCOOR(IREF+1) 132 : YDPGE=XCOOR(IREF+2) 133 : ELSE IF (IDIM.EQ.1) THEN 134 : IF (IFOUR.EQ. 7 .OR. IFOUR.EQ. 8 .OR. IFOUR.EQ. 9 .OR. 135 : . IFOUR.EQ.10 .OR. IFOUR.EQ.14) THEN 136 : BDPGE=.TRUE. 137 : NDPGE=1 138 : UDPGE(1)=UZDPG 139 : ELSE IF (IFOUR.EQ.11) THEN 140 : BDPGE=.TRUE. 141 : NDPGE=2 142 : UDPGE(1)=UZDPG 143 : UDPGE(2)=RXDPG 144 : ENDIF 145 : ENDIF 146 : c 147 : MELEME=IPMAIL 148 : NBNN=NUM(/1) 149 : NBELEM=NUM(/2) 150 : c 151 : NHRM=NIFOUR 152 : MINTE=IPMINT 153 : NBBB=NBNN 154 : c 155 : c_______________________________________________________________________ 156 : c 157 : c numero des etiquettes : 158 : c etiquettes de 1 a 98 pour traitement specifique a l element 159 : c dans la zone specifique a chaque element commencant par : 160 : c 5 continue 161 : c element 5 etiquettes 1005 2005 3005 4005 ... 162 : c 44 continue 163 : c element 44 etiquettes 1044 2044 3044 4044 ... 164 : c_______________________________________________________________________ 165 : c 166 : GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99, 167 : 1 99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 168 : 2 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 169 : 3 99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4,99,99, 4,99,99,79,79, 170 : 4 79,79,79,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 171 : 5 99,99,99,99,99,99,99,80,80,80, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 172 : 6 4, 4),MELE 173 : c 174 : IF (MELE.EQ.183.OR.MELE.EQ.184.OR. 175 : . MELE.EQ.193.OR.MELE.EQ.194) GOTO 4 176 : IF (MELE.GE.173.AND.MELE.LE.182) GOTO 173 177 : c 178 : GOTO 99 179 : 180 : c_______________________________________________________________________ 181 : c 182 : c elements massifs et elements incompressibles MECANIQUE 183 : c_______________________________________________________________________ 184 : c 185 : 4 CONTINUE 186 : IF (MFR.EQ.71 .OR. MFR.EQ.73) GOTO 97173 187 : IF( ideri.le.2.or.ideri.eq.5 ) then 188 : * ideri le 2 est pour lineaire et quadratique et =5 pour utlisateur 189 : 190 : C Elements massifs en FORMULATION 'MECANIQUE' 191 : C ------------------------------------------- 192 : NBNO=NBNN 193 : c* NDDD=NDEP 194 : c* IF (IFOUR.EQ.-3) NDDD=NDEP-3 195 : NDDD=NDEP-NDPGE 196 : c 197 : c Donnees liees a l'element de reference 198 : c 199 : SEGACT MINTE 200 : c 201 : SEGINI,WRK1 202 : IF (Ideri.eq.2) SEGINI,MTRACE 203 : c 204 : c boucle sur les elements 205 : c 206 : DO 3004 IB=1,NBELEM 207 : c 208 : c on cherche les deplacements 209 : c 210 : MPTVAL=IVADEP 211 : IE=1 212 : DO 4004 IGAU=1,NBNN 213 : DO 4004 ICOMP=1,NDDD 214 : MELVAL=IVAL(ICOMP) 215 : IGMN=MIN(IGAU,VELCHE(/1)) 216 : IBMN=MIN(IB ,VELCHE(/2)) 217 : XDDL(IE)=VELCHE(IGMN,IBMN) 218 : IE=IE+1 219 : 4004 CONTINUE 220 : IF (BDPGE) THEN 221 : DO i=1,NDPGE 222 : XDDL(IE)=UDPGE(i) 223 : IE=IE+1 224 : ENDDO 225 : ENDIF 226 : c 227 : c on cherche les coordonnees des noeuds de l element ib 228 : c 228 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 229 : if( ideri.eq.5) then 230 : * on se emet à mi-pas 231 : do iou=1,idim 232 : do iyu=1,nbnn 233 : XE(iou,iyu)= xe(iou,iyu) + xddl( iou+ (iyu-1)*nddd)/2.D0 234 : enddo 235 : enddo 236 : endif 237 : c 238 : c Calcul des coeff de modification de b-barre (elts incompres) 239 : c 240 : IF (MFR.EQ.31) THEN 240 : CALL BBCALC(XE,MELE,NBNN,IDIM,NBPGAU, 241 : 1 POIGAU,QSIGAU,ETAGAU,DZEGAU,NSTRS, 242 : 2 LRE,IFOUR,A,BBx,NHRM,SHPTOT,SHPWRK,XDPGE,YDPGE) 243 : ENDIF 244 : c 245 : c boucle sur les points de gauss 246 : c 247 : ISDJC=0 248 : C 249 : DO 5004 IGAU=1,NBPTEL 250 : C 250 : CALL BMATST(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU, 251 : 1 MELE,MFR,NBNN,LRE,IFOUR,NSTRS,NHRM,1.D0,XE, 252 : 2 SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 253 : 254 : IF (DJAC.EQ.0.D0) THEN 255 : INTERR(1)=IB 255 : CALL ERREUR(259) 256 : GOTO 9904 257 : ENDIF 258 : IF (DJAC.LT.0.D0) ISDJC=ISDJC+1 259 : 260 : C En cas d'elements incompressibles : BGENE selon la methode B-BARRE 261 : IF (MFR.EQ.31) THEN 261 : CALL BBAR(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU, 262 : & MELE,NBNN,LRE,IFOUR,NSTRS,XE,DJAC,A,BBX,BGENE) 263 : ENDIF 264 : c 264 : CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS) 265 : c 266 : c calcul des eps 2 267 : c 268 : IF (Ideri.eq.2) 268 : & CALL BST2(SHPWRK,XDDL,XE,NBNO,IFOUR,XSTRS,TRACE, 269 : & IGAU,XDPGE,YDPGE,UDPGE,NHRM) 270 : c 271 : c remplissage du segment contenant les deformations 272 : c 273 : MPTVAL=IVAEPS 274 : DO 7004 ICOMP=1,NSTRS 275 : MELVAL=IVAL(ICOMP) 276 : IBMN=MIN(IB,VELCHE(/2)) 277 : VELCHE(IGAU,IBMN)=XSTRS(ICOMP) 278 : 7004 CONTINUE 279 : c 280 : 5004 CONTINUE 281 : c 282 : c fin de la boucle sur les points de gauss 283 : c 284 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 285 : if (noer.eq.1) then 286 : kerr=195 287 : else 288 : INTERR(1)=IB 288 : CALL ERREUR(195) 289 : endif 290 : GOTO 9904 291 : ENDIF 292 : c 293 : c correction sur la partie quadratique de la deformation dans le cas 294 : c des elements incompressibles 295 : c 296 : IF (Ideri.eq.2) THEN 297 : IF (MFR.EQ.31) THEN 297 : CALL BBST2(TRACE,NBPTEL,IFOUR,MELE,POIGAU,QSIGAU, 298 : & ETAGAU,DZEGAU,SHPTOT,NBNO,SHPWRK,XE) 299 : L=2 300 : IF (IDIM.EQ.3 .OR. IFOUR.EQ.0) L=3 301 : DO 5005 ICOMP=1,L 302 : MELVAL=IVAL(ICOMP) 303 : IBMN=MIN(IB ,VELCHE(/2)) 304 : DO 5006 IGAU=1,NBPTEL 305 : VELCHE(IGAU,IBMN)=VELCHE(IGAU,IBMN)+TRACE(IGAU) 306 : 5006 CONTINUE 307 : 5005 CONTINUE 308 : ENDIF 309 : ENDIF 310 : 311 : 3004 CONTINUE 312 : 313 : c 314 : c fin de la boucle sur les elements 315 : c 316 : 9904 CONTINUE 317 : SEGDES MINTE 318 : SEGSUP WRK1 319 : IF (IREPS2.EQ.1) SEGSUP MTRACE 320 : 321 : * cas de la dérivée de Truesdell 322 : elseif( ideri.eq.3) then 323 : NBNO=NBNN 324 : NDDD=NDEP-NDPGE 325 : SEGACT MINTE 326 : SEGINI,WRK1 327 : * IF (IREPS2.EQ.1) SEGINI,MTRACE 328 : c 329 : c boucle sur les elements 330 : c 331 : DO 34 IB=1,NBELEM 332 : c 333 : c on cherche les deplacements 334 : c 335 : MPTVAL=IVADEP 336 : IE=1 337 : DO 44 IGAU=1,NBNN 338 : DO 44 ICOMP=1,NDDD 339 : MELVAL=IVAL(ICOMP) 340 : IGMN=MIN(IGAU,VELCHE(/1)) 341 : IBMN=MIN(IB ,VELCHE(/2)) 342 : XDDL(IE)=VELCHE(IGMN,IBMN) 343 : IE=IE+1 344 : 44 CONTINUE 345 : IF (BDPGE) THEN 346 : DO i=1,NDPGE 347 : XDDL(IE)=UDPGE(i) 348 : IE=IE+1 349 : ENDDO 350 : ENDIF 351 : c on cherche le max des variations des champs pour savoir s'il faut 352 : c appeler hookis plusieurs fois 353 : c 354 : nbgmat=0 355 : nelmat=0 356 : mptval=ivamat 357 : segact mptval 358 : DO IM=1,NMATT 359 : IF (IVAL(IM).NE.0) THEN 360 : MELVAL=IVAL(IM) 361 : nelmat=Max(nelmat ,VELCHE(/2)) 362 : nbgmat=Max(nbgmat,VELCHE(/1)) 363 : ENDIF 364 : ENDDO 365 : segdes mptval 366 : c 367 : c on cherche les coordonnees des noeuds de l element ib 368 : c 368 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 369 : C on ajoute aux coordonnées la moitié du deplacements pour faire 370 : C la configuration à mi-pas 371 : do iou=1,idim 372 : do iyu=1,nbnn 373 : XE(iou,iyu)= xe(iou,iyu) + xddl( iou+ (iyu-1)*nddd)/2.D0 374 : enddo 375 : enddo 376 : c 377 : c boucle sur les points de gauss 378 : c 379 : ISDJC=0 380 : C 381 : 382 : DO 54 IGAU=1,NBPTEL 382 : CALL BMATST(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU, 383 : 1 MELE,MFR,NBNN,LRE,IFOUR,NSTRS,NHRM,1.D0,XE, 384 : 2 SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 385 : 386 : c 387 : IF (DJAC.EQ.0.D0) THEN 388 : INTERR(1)=IB 388 : CALL ERREUR(259) 389 : GOTO 994 390 : ELSE IF (DJAC.LT.0.D0) THEN 391 : ISDJC=ISDJC+1 392 : ENDIF 393 : c 394 : c on cherche les matrices de Hooke 395 : c 396 : mptval=ivamat 397 : segact mptval 398 : DO 94 IM=1,NMATT 399 : IF (IVAL(IM).NE.0) THEN 400 : MELVAL=IVAL(IM) 401 : IBMN=MIN(IB ,VELCHE(/2)) 402 : IGMN=MIN(IGAU,VELCHE(/1)) 403 : 404 : VALMAT(IM)=VELCHE(IGMN,IBMN) 405 : ELSE 406 : VALMAT(IM)=0.D0 407 : ENDIF 408 : 94 CONTINUE 409 : segdes mptval 410 : kcas=2 411 : if(nbgmat+nelmat.gt.2 . or . ib+igau.eq.2) then 411 : CALL HOOKIS(VALMAT,VALCAR,VAR,MFR,IB,IGAU,EXCEN,EPAIST, 412 : + INAT,MELE,NPINT,IFOUR,KCAS,NBGMAT,Nelmat, 413 : + S,SECT,LHOOK,DDHOMU,DDHOOK, 414 : + COBMA,XMOB,IRETOU) 415 : endif 416 : do iou=1,nstrs 417 : do iyu=1,nstrs 418 : ddhomu(iyu,iou)=ddhook(iyu,iou) 419 : enddo 420 : enddo 421 : 421 : CALL DBST(BGENE,DDHomu,XDDL,LRE,NSTRS,XSTRS) 422 : c xstrs contient la contrainte on va faire pica xstrs zdep05 423 : DO 220 INO=1,NBNN 424 : DO 220 ID=1,IDIM 425 : XE1(ID,INO)=XE(ID,INO) 426 : XE2(ID,INO)=XE(ID,INO)-xddl( id+ (ino-1)*nddd)/2.D0 427 : 220 CONTINUE 428 : DO iou=1,3 429 : DO IYU=1,3 430 : XJAC(iou,iyu)=0.D0 431 : enddo 432 : enddo 432 : CALL ZERO(XJAC,3,3) 432 : CALL HPRIME(XE1,NBNN,IDIM,SHPtot,IGAU,SHpwrk,DJAC) 433 : C 434 : C CALCUL DE LA MATRICE F 435 : C 436 : DO 140 ID=1,NBNN 437 : DO 140 IE=1,IDIM 438 : DO 140 IF=1,IDIM 439 : XJAC(IE,IF)=SHpwrk(IF+1,ID)*XE2(IE,ID)+XJAC(IE,IF) 440 : 140 CONTINUE 441 : IF(IDIM.EQ.2) THEN 442 : XJAC(3,3)=1.D0 443 : IF(IFOUR.EQ.0) THEN 444 : C 445 : CC CAS AXISYMETRIQUE 446 : C 447 : R1=0.D0 448 : R2=0.D0 449 : DO 150 ID=1,NBNN 450 : R1=R1+SHpwrk(1,ID)*XE1(1,ID) 451 : R2=R2+SHpwrk(1,ID)*XE2(1,ID) 452 : 150 CONTINUE 453 : XJAC(3,3)=R2/(R1+1.D-20) 454 : ENDIF 455 : ENDIF 456 : CC CALCUL DE DETERMINANT DE F 457 : C 458 : IF(IDIM.EQ.2) THEN 459 : DETF=XJAC(1,1)*XJAC(2,2)-XJAC(1,2)*XJAC(2,1) 460 : DETF = DETF * XJAC (3,3) 461 : ENDIF 462 : IF(IDIM.EQ.3) THEN 463 : DETF=XJAC(1,1)*(XJAC(2,2)*XJAC(3,3)-XJAC(3,2)*XJAC(2,3)) 464 : DETF=DETF-XJAC(2,1)*(XJAC(1,2)*XJAC(3,3)-XJAC(3,2)*XJAC(1,3)) 465 : DETF=DETF+XJAC(3,1)*(XJAC(1,2)*XJAC(2,3)-XJAC(1,3)*XJAC(2,2)) 466 : ENDIF 467 : DETF=1.D0/(DETF+1.D-20) 468 : C 469 : C CALCUL DES CONTRAINTES DE CAUCHY 470 : C 471 : DO 160 ID=1,NSTRS 472 : IND=IN(ID) 473 : JND=JN(ID) 474 : xstrs2(ID)=0.D0 475 : DO 170 IE=1,IDIM 476 : DO 170 IF=1,IDIM 477 : ICO=ITAB(IE,IF) 478 : XsTRS2(ID)=XsTRS(ICO)*XJAC(IND,IE)*XJAC(JND,IF)*DETF 479 : 1 +xstrs2(ID) 480 : 170 CONTINUE 481 : 160 CONTINUE 482 : 483 : C 484 : C PEGON : ON NE FAIT PAS LA TRANSFORMATION SUR LA 3-EME COMPOSANTE 485 : C 486 : IF(IDIM.EQ.2) THEN 487 : xstrs2(3)=xstrs(3)*XJAC(3,3)*XJAC(3,3)*DETF 488 : ENDIF 489 : * fin du caldul de capi dans dans xstrs2 la contrainte de kirchoff 490 : * on continu en calculant epsi sur config initiale 491 : DO 221 INO=1,NBNN 492 : DO 221 ID=1,IDIM 493 : XE(ID,INO)=XE2(ID,INO)+xddl( id+ (ino-1)*nddd)/2.D0 494 : 221 CONTINUE 495 : * inversion loi de hook 495 : CALL INVALM(DDHOMU,LHOOK,LHOOK,KERRE,0.D0) 496 : DO 6000 I=1,LHOOK 497 : xstrs(I)=0.D0 498 : DO 60001 J=1,LHOOK 499 : xstrs(I)=xstrs(I)+DDHOMU(I,J)*xstrs2(J) 500 : 60001 CONTINUE 501 : 6000 CONTINUE 502 : c 503 : c remplissage du segment contenant les deformations 504 : c 505 : MPTVAL=IVAEPS 506 : DO 74 ICOMP=1,NSTRS 507 : MELVAL=IVAL(ICOMP) 508 : IBMN=MIN(IB,VELCHE(/2)) 509 : VELCHE(IGAU,IBMN)=XSTRS(ICOMP) 510 : 74 CONTINUE 511 : 54 continue 512 : 513 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 514 : if (noer.eq.1) then 515 : kerr=195 516 : else 517 : INTERR(1)=IB 517 : CALL ERREUR(195) 518 : GOTO 994 519 : endif 520 : ENDIF 521 : 34 CONTINUE 522 : 994 CONTINUE 523 : SEGSUP WRK1 524 : segdes minte 525 : * fin du truesdell 526 : * debut du jaumann 527 : elseif(ideri.eq.4) then 528 : C========================== 529 : NBNO=NBNN 530 : c* NDDD=NDEP 531 : c* IF (IFOUR.EQ.-3) NDDD=NDEP-3 532 : NDDD=NDEP-NDPGE 533 : c 534 : c Donnees liees a l'element de reference 535 : c 536 : SEGACT MINTE 537 : c 538 : SEGINI,WRK1 539 : SEGINI,MTRACE 540 : segini wrk2 541 : 542 : c boucle sur les elements 543 : c 544 : DO 394 IB=1,NBELEM 545 : c 546 : c on cherche les deplacements 547 : c 548 : MPTVAL=IVADEP 549 : IE=1 550 : DO 494 IGAU=1,NBNN 551 : DO 494 ICOMP=1,NDDD 552 : MELVAL=IVAL(ICOMP) 553 : IGMN=MIN(IGAU,VELCHE(/1)) 554 : IBMN=MIN(IB ,VELCHE(/2)) 555 : XDDL(IE)=VELCHE(IGMN,IBMN) 556 : IE=IE+1 557 : 494 CONTINUE 558 : IF (BDPGE) THEN 559 : DO i=1,NDPGE 560 : XDDL(IE)=UDPGE(i) 561 : IE=IE+1 562 : ENDDO 563 : ENDIF 564 : c 565 : c on cherche les coordonnees des noeuds de l element ib 566 : c 566 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 567 : * 568 : * on se met sur la config à mi pas (XE) xe1 est la config initiale 569 : * 570 : do iou=1,idim 571 : do iyu=1,nbnn 572 : XE1(iou,iyu)= xe(iou,iyu) 573 : XE(iou,iyu)= xe(iou,iyu) + xddl( iou+ (iyu-1)*nddd)/2.D0 574 : enddo 575 : enddo 576 : c 577 : c Calcul des coeff de modification de b-barre (elts incompres) 578 : c 579 : IF (MFR.EQ.31) THEN 579 : CALL BBCALC(XE,MELE,NBNN,IDIM,NBPGAU, 580 : 1 POIGAU,QSIGAU,ETAGAU,DZEGAU,NSTRS, 581 : 2 LRE,IFOUR,A,BBX,NHRM,SHPTOT,SHPWRK,XDPGE,YDPGE) 582 : ENDIF 583 : c 584 : c boucle sur les points de gauss 585 : c 586 : ISDJC=0 587 : C 588 : DO 594 IGAU=1,NBPTEL 589 : C 589 : CALL BMATST(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU, 590 : 1 MELE,MFR,NBNN,LRE,IFOUR,NSTRS,NHRM,1.D0,XE, 591 : 2 SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 592 : 593 : IF (DJAC.EQ.0.D0) THEN 594 : INTERR(1)=IB 594 : CALL ERREUR(259) 595 : GOTO 9964 596 : ENDIF 597 : IF (DJAC.LT.0.D0) ISDJC=ISDJC+1 598 : 599 : C En cas d'elements incompressibles : BGENE selon la methode B-BARRE 600 : IF (MFR.EQ.31) THEN 600 : CALL BBAR(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU, 601 : & MELE,NBNN,LRE,IFOUR,NSTRS,XE,DJAC,A,BBX,BGENE) 602 : ENDIF 603 : c 603 : CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS) 604 : * dans xstrs on a les deformations II sur config mi pas 605 : * on va calculer grad u/2 puis decomposition polaire puis rtens 606 : * on retravaille sur config initiale 607 : xxzero=0.d0 608 : iipdpg=0 608 : CALL BGRMAS(iGau,NOELE,NBNO,LRE,IFOUR,NGRA,NIFOUR,XE1, 609 : . xXZero,SHPTOT,SHPWRK,BB,BGR,DJAC,IIPDPG) 610 : do iou=1,lre 611 : xddls2(iou)= xddl(iou) / 2.D0 612 : enddo 612 : CALL BGRDEP(BGR,NGRA,XDDLs2,LRE,GRADI) 613 : * on ajoute l'identité au gradient 614 : if(idim.eQ.2) then 615 : gradi(1)=gradi(1)+1.D0 616 : gradi(4)=gradi(4)+1.D0 617 : ELSE IF(IDIM.EQ.3) THEN 618 : gradi(1)=gradi(1)+1.D0 619 : gradi(5)=gradi(5)+1.D0 620 : gradi(9)=gradi(9)+1.D0 621 : ENDIF 622 : 622 : CALL POLA2(gradi,R,U,IDIM) 623 : * fait le rtens Rt.A.R on utilise u pour mettre Rt 624 : * et on met le tenseur dans le tableau tens 625 : * attention vu le stockage R est en fait Rt 626 : if(idim.eq.2) then 627 : U(1)=r(1) 628 : u(2)=r(3) 629 : U(3)=R(2) 630 : u(4)=R(4) 631 : tens(1)=xstrs(1) 632 : tens(2)=xstrs(4)/2.d0 633 : tens(3)=xstrs(4)/2.D0 634 : tens(4)=xstrs(2) 635 : 636 : elseif(idim.eq.3) then 637 : U(1)=r(1) 638 : u(2)=r(4) 639 : U(3)=R(7) 640 : u(4)=R(2) 641 : u(5)=r(5) 642 : u(6)=r(8) 643 : u(7)=r(3) 644 : u(8)=r(6) 645 : u(9)=r(9) 646 : tens(1)=xstrs(1) 647 : tens(2)=xstrs(4)/2.D0 648 : tens(3)=xstrs(5)/2.D0 649 : tens(4)=tens(2) 650 : tens(5)=xstrs(2) 651 : tens(6)=xstrs(6)/2.D0 652 : tens(7)=tens(3) 653 : tens(8)=tens(6) 654 : tens(9)=xstrs(3) 655 : else 656 : write(6,*)' idim est ni 2 ni 3 stop' 657 : stop 658 : endif 659 : 659 : CALL MULMAT(tentra,tens,U,IDIM,IDIM,IDIM) 659 : CALL MULMAT(tens,R,Tentra,IDIM,IDIM,IDIM) 660 : * tens contient le nouveau tenseur on va remplir xstrs 661 : * en 2 D epzz ne change pas 662 : if(idim.eq.2) then 663 : xstrs(1)=tens(1) 664 : xstrs(2)=tens(4) 665 : xstrs(4)=tens(2)*2.D0 666 : else 667 : xstrs(1)=tens(1) 668 : xstrs(2)=tens(5) 669 : xstrs(3)=tens(9) 670 : xstrs(4)=tens(2)*2.D0 671 : xstrs(5)=tens(3)*2.D0 672 : xstrs(6)=tens(6)*2.D0 673 : endif 674 : 675 : c 676 : c remplissage du segment contenant les deformations 677 : C 678 : MPTVAL=IVAEPS 679 : DO 794 ICOMP=1,NSTRS 680 : MELVAL=IVAL(ICOMP) 681 : IBMN=MIN(IB,VELCHE(/2)) 682 : VELCHE(IGAU,IBMN)=XSTRS(ICOMP) 683 : 794 CONTINUE 684 : c 685 : 594 CONTINUE 686 : c 687 : c fin de la boucle sur les points de gauss 688 : c 689 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 690 : INTERR(1)=IB 691 : if (noer.eq.1) then 692 : kerr=195 693 : else 693 : CALL ERREUR(195) 694 : GOTO 9964 695 : endif 696 : ENDIF 697 : 698 : 394 CONTINUE 699 : 700 : c 701 : c fin de la boucle sur les elements 702 : c 703 : 9964 CONTINUE 704 : SEGDES MINTE 705 : SEGSUP WRK1,wrk2 706 : SEGSUP MTRACE 707 : endif 708 : c 709 : GOTO 510 710 : 711 : C Elements massifs en FORMULATIONs 'ELECTROSTATIQUE' et 'DIFFUSION' 712 : C ----------------------------------------------------------------- 713 : 97173 CONTINUE 714 : SEGACT,MINTE 715 : NBNO = NBNN 716 : NDDD = NDEP 717 : SEGINI,WRK1 718 : C------------------------- 719 : C Boucle sur les elements 720 : C------------------------- 721 : DO IEL = 1, NBELEM 722 : C - Recuperation des coordonnees des noeuds de l element IEL 722 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE) 723 : C - Recuperation des inconnues primales aux noeuds de l element IEL 724 : MPTVAL = IVADEP 725 : IE = 1 726 : DO IGAU = 1, NBNN 727 : DO ICOMP = 1, NDDD 728 : MELVAL = IVAL(ICOMP) 729 : IGMN = MIN(IGAU,VELCHE(/1)) 730 : IEMN = MIN(IEL ,VELCHE(/2)) 731 : XDDL(IE) = VELCHE(IGMN,IEMN) 732 : IE = IE+1 733 : ENDDO 734 : ENDDO 735 : C-- -- -- -- -- -- -- -- -- 736 : C - Boucle sur les points de Gauss 737 : C-- -- -- -- -- -- -- -- -- 738 : ISDJC=0 739 : DO IGAU = 1, NBPTEL 740 : C -- Calcul de la matrice B et du jacobien au point de Gauss IGAU 741 : IF (MFR.EQ.71) THEN 741 : CALL BELEC(XE,SHPTOT(1,1,IGAU),NBNN,LHOOK,-1, 742 : & SHPWRK,BGENE,DJAC) 743 : ELSE IF (MFR.EQ.73) THEN 743 : CALL BDIFF(XE,SHPTOT(1,1,IGAU),NBNN,LHOOK,-1, 744 : & SHPWRK,BGENE,DJAC) 745 : ENDIF 746 : IF (DJAC.EQ.0.D0) THEN 747 : INTERR(1) = IEL 747 : CALL ERREUR(259) 748 : GOTO 98173 749 : ENDIF 750 : IF (DJAC.LT.0.D0) ISDJC = ISDJC+1 750 : CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS) 751 : C -- Remplissage du segment contenant les "deformations" = -grad(.) 752 : MPTVAL = IVAEPS 753 : DO ICOMP = 1, NSTRS 754 : MELVAL = IVAL(ICOMP) 755 : IEMN = MIN(IEL,VELCHE(/2)) 756 : VELCHE(IGAU,IEMN) = XSTRS(ICOMP) 757 : ENDDO 758 : C-- -- -- -- -- -- -- -- -- 759 : ENDDO 760 : C-- -- -- -- -- -- -- -- -- 761 : IF (ISDJC.NE.0 .AND. ISDJC.NE.NBPGAU) THEN 762 : INTERR(1) = IEL 763 : if (noer.eq.1) then 764 : kerr=195 765 : else 765 : CALL ERREUR(195) 766 : GOTO 98173 767 : endif 768 : ENDIF 769 : C------------------------- 770 : ENDDO 771 : C------------------------- 772 : 98173 CONTINUE 773 : SEGDES,MINTE 774 : SEGSUP,WRK1 775 : GOTO 510 776 : 777 : c_______________________________________________________________________ 778 : c 779 : c milieux poreux 780 : c_______________________________________________________________________ 781 : c 782 : 79 CONTINUE 783 : c 784 : c pour ces elements nbbb = nombre de noeuds 785 : c nbno = nombre de fonctions de forme 786 : c 787 : NBNO=IPORE 788 : NSTN=1 789 : LRN=NBNO-NBBB 790 : LRB=LRE-LRN 791 : c 792 : SEGINI WRK1,WRK5 793 : c Initialisation de MTRACE necessaire mais inutilise pour ces elements 794 : IF (IREPS2.EQ.1) SEGINI MTRACE 795 : c 796 : DO 3079 IB=1,NBELEM 797 : c 798 : c on cherche les coordonnees des noeuds de l element ib 799 : c 799 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 800 : c 801 : c on cherche les deplacements 802 : c 803 : MPTVAL=IVADEP 804 : IE=1 805 : DO 4079 IGAU=1,NBNN 806 : DO 4079 ICOMP=1,NDEP-1 807 : MELVAL=IVAL(ICOMP) 808 : IGMN=MIN(IGAU,VELCHE(/1)) 809 : IBMN=MIN(IB ,VELCHE(/2)) 810 : XDDL(IE)=VELCHE(IGMN,IBMN) 811 : IE=IE+1 812 : 4079 CONTINUE 813 : c 814 : c puis les pressions 815 : c 816 : MELVAL=IVAL(NDEP) 817 : DO 4179 IGAU=1,LRN 818 : IGAUSO=IBSOM(NSPOS(IELE)+IGAU-1) 819 : IGMN=MIN(IGAUSO,VELCHE(/1)) 820 : IBMN=MIN(IB ,VELCHE(/2)) 821 : XDDL(IE)=VELCHE(IGMN,IBMN) 822 : IE=IE+1 823 : 4179 CONTINUE 824 : c 825 : c boucle sur les points de gauss 826 : c 827 : ISDJC=0 828 : c 829 : DO 5079 IGAU=1,NBPTEL 830 : c 830 : CALL BNPORE(IGAU,NBNO,NBBB,LRE,IFOUR,LHOOK,NSTN,NHRM, 831 : & 1.D0,XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,1) 832 : c 833 : IF (DJAC.EQ.0.D0) THEN 834 : INTERR(1)=IB 834 : CALL ERREUR(259) 835 : GOTO 9979 836 : ENDIF 837 : IF (DJAC.LT.0.D0) ISDJC=ISDJC+1 838 : c 838 : CALL BST(BGENE,XDDL,LRE,LHOOK,XSTRS) 839 : c 840 : c calcul des eps 2 841 : c 842 : IF (IREPS2.EQ.1) 842 : & CALL BST2(SHPWRK,XDDL,XE,NBNN,IFOUR,XSTRS,TRACE, 843 : & IGAU,XDPGE,YDPGE,UDPGE,NHRM) 844 : c 845 : c calcul de la pression 846 : c 847 : XP=0.D0 848 : DO 4279 ID=1,LRN 849 : XP=XP+XGENE(1,ID)*XDDL(LRB+ID) 850 : 4279 CONTINUE 851 : XSTRS(NSTRS)=XP 852 : c 853 : c remplissage du segment contenant les deformations 854 : c 855 : MPTVAL=IVAEPS 856 : DO 7079 ICOMP=1,NSTRS 857 : MELVAL=IVAL(ICOMP) 858 : IGMN=MIN(IGAU,VELCHE(/1)) 859 : IBMN=MIN(IB ,VELCHE(/2)) 860 : VELCHE(IGMN,IBMN)=XSTRS(ICOMP) 861 : 7079 CONTINUE 862 : c 863 : 5079 CONTINUE 864 : c 865 : c fin de la boucle sur les points de gauss 866 : c 867 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 868 : INTERR(1)=IB 869 : if (noer.eq.1) then 870 : kerr=195 871 : else 871 : CALL ERREUR(195) 872 : GOTO 9979 873 : endif 874 : ENDIF 875 : c 876 : 3079 CONTINUE 877 : c 878 : c fin de la boucle sur les elements 879 : c 880 : 9979 CONTINUE 881 : SEGSUP WRK1,WRK5 882 : IF (IREPS2.EQ.1) SEGSUP MTRACE 883 : c 884 : GOTO 510 885 : 886 : c_______________________________________________________________________ 887 : c 888 : c milieux poreux - SUITE 889 : c_______________________________________________________________________ 890 : c 891 : 173 CONTINUE 892 : c 893 : c pour ces elements nbbb = nombre de noeuds 894 : c nbno = nombre de fonctions de forme 895 : c 896 : IF (MELE.GE.173.AND.MELE.LE.177) THEN 897 : IDECAP = 2 898 : ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN 899 : IDECAP = 3 900 : ENDIF 901 : c 902 : NBNO=IPORE 903 : NSTN=IDECAP 904 : c 905 : LPP=NBNO-NBBB 906 : LRN=IDECAP*LPP 907 : LRB=LRE-LRN 908 : c 909 : SEGINI WRK1,WRK5 910 : c Initialise de MTRACE necessaire mais inutilise pour cet element 911 : IF (IREPS2.EQ.1) SEGINI MTRACE 912 : c 913 : DO 3173 IB=1,NBELEM 914 : c 915 : c on cherche les coordonnees des noeuds de l element ib 916 : c 916 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 917 : c 918 : c on cherche les deplacements 919 : c 920 : MPTVAL=IVADEP 921 : IE=1 922 : DO 4173 IGAU=1,NBNN 923 : DO 4173 ICOMP=1,NDEP-IDECAP 924 : MELVAL=IVAL(ICOMP) 925 : IGMN=MIN(IGAU,VELCHE(/1)) 926 : IBMN=MIN(IB ,VELCHE(/2)) 927 : XDDL(IE)=VELCHE(IGMN,IBMN) 928 : IE=IE+1 929 : 4173 CONTINUE 930 : c 931 : c puis les pressions 932 : c 933 : DO 4473 IPR = 1,IDECAP 934 : MELVAL=IVAL(NDEP-IDECAP+IPR) 935 : DO 4273 IGAU=1,LPP 936 : IGAUSO=IBSOM(NSPOS(IELE)+IGAU-1) 937 : IGMN=MIN(IGAUSO,VELCHE(/1)) 938 : IBMN=MIN(IB ,VELCHE(/2)) 939 : XDDL(IE)=VELCHE(IGMN,IBMN) 940 : IE=IE+1 941 : 4273 CONTINUE 942 : 4473 CONTINUE 943 : c 944 : c boucle sur les points de gauss 945 : c 946 : ISDJC=0 947 : c 948 : DO 5173 IGAU=1,NBPTEL 949 : c 949 : CALL BNQORE(IGAU,NBNO,NBBB,LRE,IFOUR,LHOOK,NSTN,NHRM, 950 : & 1.D0,XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,IDECAP,1) 951 : c 952 : IF (DJAC.EQ.0.D0) THEN 953 : INTERR(1)=IB 953 : CALL ERREUR(259) 954 : GOTO 9173 955 : ENDIF 956 : IF (DJAC.LT.0.D0) ISDJC=ISDJC+1 957 : c 957 : CALL BST(BGENE,XDDL,LRE,LHOOK,XSTRS) 958 : c 959 : c calcul des eps 2 960 : c 961 : IF (IREPS2.EQ.1) 961 : & CALL BST2(SHPWRK,XDDL,XE,NBNN,IFOUR,XSTRS,TRACE, 962 : & IGAU,XDPGE,YDPGE,UDPGE,NHRM) 963 : c 964 : c calcul des pressions 965 : c 966 : IE=LRB 967 : DO 4673 IPR=1,IDECAP 968 : XP=0.D0 969 : IPR1=(IPR-1)*LPP 970 : DO 4373 ID=1,LPP 971 : IE=IE+1 972 : XP=XP+XGENE(IPR,ID+IPR1)*XDDL(IE) 973 : 4373 CONTINUE 974 : XSTRS(NSTRS-IDECAP+IPR)=XP 975 : 4673 CONTINUE 976 : c 977 : c remplissage du segment contenant les deformations 978 : c 979 : MPTVAL=IVAEPS 980 : DO 7173 ICOMP=1,NSTRS 981 : MELVAL=IVAL(ICOMP) 982 : IGMN=MIN(IGAU,VELCHE(/1)) 983 : IBMN=MIN(IB ,VELCHE(/2)) 984 : VELCHE(IGMN,IBMN)=XSTRS(ICOMP) 985 : 7173 CONTINUE 986 : c 987 : 5173 CONTINUE 988 : c 989 : c fin de la boucle sur les points de gauss 990 : c 991 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 992 : INTERR(1)=IB 993 : if (noer.eq.1) then 994 : kerr=195 995 : else 995 : CALL ERREUR(195) 996 : GOTO 9173 997 : endif 998 : ENDIF 999 : c 1000 : 3173 CONTINUE 1001 : c 1002 : c fin de la boucle sur les elements 1003 : c 1004 : 9173 CONTINUE 1005 : SEGSUP WRK1,WRK5 1006 : IF (IREPS2.EQ.1) SEGSUP MTRACE 1007 : c 1008 : GOTO 510 1009 : 1010 : c_______________________________________________________________________ 1011 : c 1012 : c joints poreux 1013 : c_______________________________________________________________________ 1014 : c 1015 : 80 CONTINUE 1016 : c 1017 : c pour ces elements nbbb = nombre de noeuds 1018 : c nbno = nombre de fonctions de forme 1019 : c 1020 : NBNO=IPORE 1021 : NSTN=1 1022 : LRN=(NBNO-NBBB)*3/2 1023 : LRB=LRE-LRN 1024 : NFAC=(3*NBBB-NBNO)/2 1025 : c 1026 : SEGINI WRK1,WRK3,WRK5 1027 : c 1028 : DO 3080 IB=1,NBELEM 1029 : c 1030 : c on cherche d'abord les deplacements 1031 : c 1032 : MPTVAL=IVADEP 1033 : IE=1 1034 : DO 4180 IGAU=1,NFAC 1035 : DO 4280 ICOMP=1,NDEP-1 1036 : MELVAL=IVAL(ICOMP) 1037 : IGMN=MIN(IGAU,VELCHE(/1)) 1038 : IBMN=MIN(IB ,VELCHE(/2)) 1039 : XDDL(IE)=VELCHE(IGMN,IBMN) 1040 : IE=IE+1 1041 : 4280 CONTINUE 1042 : 4180 CONTINUE 1043 : c 1044 : c puis les pressions 1045 : c 1046 : MELVAL=IVAL(NDEP) 1047 : DO 4080 IGAU=1,NBNN 1048 : DO 4190 INSOM=1,NBSOM(IELE) 1049 : IF (IGAU.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 4191 1050 : 4190 CONTINUE 1051 : IF (IGAU.GT.NFAC) GO TO 4191 1052 : GO TO 4080 1053 : 4191 CONTINUE 1054 : IBMN=MIN(IB ,VELCHE(/2)) 1055 : IGMN=MIN(IGAU,VELCHE(/1)) 1056 : XDDL(IE)=VELCHE(IGMN,IBMN) 1057 : IE=IE+1 1058 : 4080 CONTINUE 1059 : c 1060 : c on cherche les coordonnees des noeuds de l element ib 1061 : c 1061 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 1062 : c 1063 : c calcul des exes locaux et des coordonnees locales 1064 : c 1064 : CALL JOPLOC(XE,SHPTOT,NBBB,NBNO,IFOUR,XEL,BPSS) 1065 : c 1065 : CALL INTDEL(XNTH,XNTB,XNTT,LRN,MELE) 1066 : c 1067 : c boucle sur les points de gauss 1068 : c 1069 : ISDJC=0 1070 : c 1071 : DO 5080 IGAU=1,NBPTEL 1072 : c 1072 : CALL BNPORJ(IGAU,NBNO,NBBB,LRE,IFOUR,LHOOK,NSTN,XE,XEL, 1073 : & SHPTOT,SHPWRK,BPSS,BGENE,XGENE,DJAC,1) 1074 : c 1075 : IF (DJAC.EQ.0.D0) THEN 1076 : INTERR(1)=IB 1076 : CALL ERREUR(259) 1077 : GOTO 9980 1078 : ENDIF 1079 : IF (DJAC.LT.0.D0) ISDJC=ISDJC+1 1080 : c 1080 : CALL BST(BGENE,XDDL,LRB,LHOOK,XSTRS) 1081 : c 1082 : c calcul de la pression 1083 : c 1084 : XP=0.D0 1085 : DO 4480 ID=1,LRN 1086 : XP=XP+XNTT(ID)*XGENE(1,ID)*XDDL(LRB+ID) 1087 : 4480 CONTINUE 1088 : XSTRS(NSTRS)=XP 1089 : c 1090 : c remplissage du segment contenant les deformations 1091 : c 1092 : MPTVAL=IVAEPS 1093 : DO 7080 ICOMP=1,NSTRS 1094 : MELVAL=IVAL(ICOMP) 1095 : IGMN=MIN(IGAU,VELCHE(/1)) 1096 : IBMN=MIN(IB ,VELCHE(/2)) 1097 : VELCHE(IGMN,IBMN)=XSTRS(ICOMP) 1098 : 7080 CONTINUE 1099 : c 1100 : 5080 CONTINUE 1101 : c 1102 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 1103 : INTERR(1)=IB 1104 : if (noer.eq.1) then 1105 : kerr=195 1106 : else 1106 : CALL ERREUR(195) 1107 : GOTO 9980 1108 : endif 1109 : ENDIF 1110 : c 1111 : 3080 CONTINUE 1112 : c 1113 : 9980 CONTINUE 1114 : SEGSUP WRK1,WRK3,WRK5 1115 : c 1116 : GOTO 510 1117 : 1118 : c____________________________________________________________________ 1119 : 99 CONTINUE 1120 : MOTERR(1:4)=NOMTP(MELE) 1121 : MOTERR(9:12)='EPSI' 1121 : CALL ERREUR(86) 1122 : 1123 : 510 CONTINUE 1124 : RETURN 1125 : END 1126 : 1127 : 1128 : 1129 : 1130 :
© Cast3M 2003 - All rights reserved.
Disclaimer