1 : C CRCOUP SOURCE CHAT 11/09/22 21:15:01 7136 2 : C CALCUL D'UN OBJET COUPE VIRTUEL 3 : C 4 : C CRCOUP REMPLACE MELEME PAR L'OBJET COUPE 5 : C MCOUP ET LE DERNIER COMPOSANT DE MELEME REMPLACE DECRIVENT 6 : C L'INTERSECTION 7 : C IL FAUDRA METTRE UNE INDICATION AUX TRIANGLES SE TROUVANT DANS LE PLA 8 : C DE COUPE POUR REUSSIR LES PARTIES VUES PARTIES CACHEES 9 : SUBROUTINE CRCOUP(JOEIL,ICOUP1,ICOUP2,ICOUP3,MELEME,MCOUP,VCHCA, 10 : # MELEM2,MCOU2,mchamo,isect) 11 : IMPLICIT INTEGER(I-N) 12 : -INC CCGEOME 13 : -INC CCOPTIO 14 : -INC SMCOORD 15 : -INC SMELEME 16 : -INC SMCHAML 17 : REAL*8 XN,YN,ZN,SIGA,SIGB,SIGC,SIGRAV 18 : SEGMENT VCHCA(0) 19 : SEGMENT ITR(0) 20 : SEGMENT ITRT(0) 21 : SEGMENT XTR(0) 22 : SEGMENT XTRT(0) 23 : SEGMENT IQUAT(0) 24 : SEGMENT XQUAT(0) 25 : SEGMENT ISEGM(0) 26 : SEGMENT XSEGM(NBPOIN) 27 : SEGMENT MCOUP(0) 28 : SEGMENT IJGRAV(2,100) 29 : DIMENSION JTT(9),ISEG(9) 30 : LOGICAL VOLUM 31 : n2ptel=0 32 : mcham=mchamo 33 : MEDSAU=0 34 : SEGINI ITR,ISEGM,MCOUP,IJGRAV,ITRT,IQUAT 35 : SEGACT MCOORD 36 : NBPOIN=XCOOR(/1)/4 37 : if (mcham.ne.0) segini xtr,xtrt,xquat,xsegm 38 : IREF=(JOEIL-1)*4 39 : XO=XCOOR(IREF+1) 40 : YO=XCOOR(IREF+2) 41 : ZO=XCOOR(IREF+3) 42 : IREF=(ICOUP1-1)*4 43 : XCT=XCOOR(IREF+1) 44 : YCT=XCOOR(IREF+2) 45 : ZCT=XCOOR(IREF+3) 46 : IREF=(ICOUP2-1)*4 47 : XC2=XCOOR(IREF+1) 48 : YC2=XCOOR(IREF+2) 49 : ZC2=XCOOR(IREF+3) 50 : IREF=(ICOUP3-1)*4 51 : XC3=XCOOR(IREF+1) 52 : YC3=XCOOR(IREF+2) 53 : ZC3=XCOOR(IREF+3) 54 : C NORMALE AU PLAN : 55 : XV=XC2-XCT 56 : YV=YC2-YCT 57 : ZV=ZC2-ZCT 58 : XW=XC3-XCT 59 : YW=YC3-YCT 60 : ZW=ZC3-ZCT 61 : XN=YV*ZW-ZV*YW 62 : YN=ZV*XW-XV*ZW 63 : ZN=XV*YW-YV*XW 64 : RN=XN**2+YN**2+ZN**2 64 : IF (RN.EQ.0.) CALL ERREUR(21) 65 : IF (IERR.NE.0) RETURN 66 : RN=SQRT(RN) 67 : XN=XN/RN 68 : YN=YN/RN 69 : ZN=ZN/RN 70 : SIG=(XO-XCT)*XN+(YO-YCT)*YN+(ZO-ZCT)*ZN 71 : IF (SIG.LE.0.) THEN 72 : XN=-XN 73 : YN=-YN 74 : ZN=-ZN 75 : ENDIF 76 : 5000 CONTINUE 77 : SEGACT MELEME 78 : NBSOU=LISOUS(/1) 79 : NBSOUS=MAX(2,NBSOU+1) 80 : NBREF=0 81 : if (mcham.ne.0) nbref=nbsous 82 : NBNN=0 83 : NBELEM=0 84 : SEGINI IPT8 85 : IPT1=MELEME 86 : ISU=0 87 : * prob optimiseur 88 : C melva1=meleme 89 : C melva2=meleme 90 : DO 10 ISOUS=1,MAX(1,NBSOU) 91 : IF (NBSOU.NE.0) THEN 92 : IPT1=LISOUS(ISOUS) 93 : if (mcham.ne.0) then 94 : melva1=lisref(isous) 95 : segact melva1 96 : lva1=melva1.velche(/1) 97 : endif 98 : SEGACT IPT1 99 : ENDIF 100 : NBREF=0 101 : NBSOUS=0 102 : NBNN=IPT1.NUM(/1) 103 : NBELEM=IPT1.NUM(/2) 104 : SEGINI IPT2 105 : IPT2.ITYPEL=IPT1.ITYPEL 106 : if (mcham.ne.0) then 107 : n1ptel=nbnn 108 : n1el=nbelem 109 : n2ptel=0 110 : n2el=0 111 : segini melva2 112 : segact melva1 113 : idi2= melva1.velche(/2) 114 : endif 115 : JELN=0 116 : DO 20 JEL=1,NBELEM 117 : DO 25 INOEU=1,NBNN 118 : IPT=IPT1.NUM(INOEU,JEL) 119 : IREF=4*(IPT-1) 120 : XP=XCOOR(IREF+1) 121 : YP=XCOOR(IREF+2) 122 : ZP=XCOOR(IREF+3) 123 : SIG=(XP-XCT)*XN+(YP-YCT)*YN+(ZP-ZCT)*ZN 124 : IF (SIG.GT.0.) GOTO 30 125 : 25 CONTINUE 126 : * tous les points sont du bon cote du plan de coupe 127 : if (isect.ne.0) goto 20 128 : JELN=JELN+1 129 : DO 27 INOEU=1,NBNN 130 : IPT2.NUM(INOEU,JELN)=IPT1.NUM(INOEU,JEL) 131 : if (mcham.ne.0) 132 : > melva2.velche(INOEU,JELN)=melva1.velche(min(INOEU,lva1),JEL) 133 : 27 CONTINUE 134 : IPT2.ICOLOR(JELN)=IPT1.ICOLOR(JEL) 135 : GOTO 20 136 : 30 CONTINUE 137 : VOLUM=KSURF(IPT1.ITYPEL).NE.IPT1.ITYPEL 138 : * IF (VOLUM) THEN 139 : IPT=IPT1.NUM(1,JEL) 140 : IREF=(IPT-1)*4 141 : XGRAV=XCOOR(IREF+1) 142 : YGRAV=XCOOR(IREF+2) 143 : ZGRAV=XCOOR(IREF+3) 144 : IF (VCHCA.NE.0) VGRAV=VCHCA(IPT) 145 : if (mcham.ne.0) chgrav=melva1.velche(1,min(JEL,idi2)) 146 : DO 21 INOEU=2,NBNN 147 : IPT=IPT1.NUM(INOEU,JEL) 148 : IREF=(IPT-1)*4 149 : XGRAV=XGRAV+XCOOR(IREF+1) 150 : YGRAV=YGRAV+XCOOR(IREF+2) 151 : ZGRAV=ZGRAV+XCOOR(IREF+3) 152 : IF (VCHCA.NE.0) VGRAV=VGRAV+VCHCA(IPT) 153 : if (mcham.ne.0) chgrav=chgrav+melva1.velche(min(INOEU,lva1), 154 : $ min(idi2,JEL)) 155 : 21 CONTINUE 156 : XGRAV=XGRAV/NBNN 157 : YGRAV=YGRAV/NBNN 158 : ZGRAV=ZGRAV/NBNN 159 : C ON PREND COMME POINT DU PLAN LA PROJECTION DU CENTRE GRAVITE 160 : SIGRAV=(XGRAV-XCT)*XN+(YGRAV-YCT)*YN+(ZGRAV-ZCT)*ZN 161 : XCT=XGRAV-SIGRAV*XN 162 : YCT=YGRAV-SIGRAV*YN 163 : ZCT=ZGRAV-SIGRAV*ZN 164 : SIGRAV=(XGRAV-XCT)*XN+(YGRAV-YCT)*YN+(ZGRAV-ZCT)*ZN 165 : IF (ABS(SIGRAV).LE.1E-30) SIGRAV=1E-30 166 : NJGRAV=0 167 : IF (VCHCA.NE.0) VGRAV=VGRAV/NBNN 168 : if (mcham.ne.0) CHGRAV=CHGRAV/NBNN 169 : * ENDIF 170 : C DECOMPOSITION EN FACE PUIS EN TRIANGLE 171 : NBFAC=LTEL(1,IPT1.ITYPEL) 172 : IAD=LTEL(2,IPT1.ITYPEL)-1 173 : IF (NBFAC.EQ.0) GOTO 20 174 : DO 161 IFAC=1,NBFAC 175 : ITYP=LDEL(1,IAD+IFAC) 176 : JAD=LDEL(2,IAD+IFAC)-1 177 : NPFAC=KDFAC(1,ITYP) 178 : IDEP=KDFAC(2,ITYP) 179 : IFEP=IDEP+3*(KDFAC(3,ITYP)-1) 180 : DO 160 ITRIAN=IDEP,IFEP,3 181 : JFA=JAD+KFAC(ITRIAN) 182 : JFB=JAD+KFAC(ITRIAN+1) 183 : JFC=JAD+KFAC(ITRIAN+2) 184 : ISEG(1)=0 185 : ISEG(2)=0 186 : ISEG(3)=0 187 : ISEG(4)=0 188 : ISEG1=0 189 : ISEG2=0 190 : ISEG3=0 191 : IF (MOD(JFB-JFA+NPFAC,NPFAC).EQ.1) ISEG1=1 192 : IF (MOD(JFB-JFA+NPFAC,NPFAC).EQ.NPFAC-1) ISEG1=1 193 : IF (MOD(JFC-JFB+NPFAC,NPFAC).EQ.1) ISEG2=1 194 : IF (MOD(JFC-JFB+NPFAC,NPFAC).EQ.NPFAC-1) ISEG2=1 195 : IF (MOD(JFA-JFC+NPFAC,NPFAC).EQ.1) ISEG3=1 196 : IF (MOD(JFA-JFC+NPFAC,NPFAC).EQ.NPFAC-1) ISEG3=1 197 : IAFA=LFAC(JFA) 198 : IBFA=LFAC(JFB) 199 : ICFA=LFAC(JFC) 200 : IA=IPT1.NUM(IAFA,JEL) 201 : IB=IPT1.NUM(IBFA,JEL) 202 : IC=IPT1.NUM(ICFA,JEL) 203 : IREF=4*(IA-1) 204 : XA=XCOOR(IREF+1) 205 : YA=XCOOR(IREF+2) 206 : ZA=XCOOR(IREF+3) 207 : IREF=4*(IB-1) 208 : XB=XCOOR(IREF+1) 209 : YB=XCOOR(IREF+2) 210 : ZB=XCOOR(IREF+3) 211 : IREF=4*(IC-1) 212 : XC=XCOOR(IREF+1) 213 : YC=XCOOR(IREF+2) 214 : ZC=XCOOR(IREF+3) 215 : C TESTONS SI LES POINTS SONT DU BON COTE 216 : SIGA=(XA-XCT)*XN+(YA-YCT)*YN+(ZA-ZCT)*ZN 217 : IF (ABS(SIGA).LE.1E-30) SIGA=1E-30 218 : SIGB=(XB-XCT)*XN+(YB-YCT)*YN+(ZB-ZCT)*ZN 219 : IF (ABS(SIGB).LE.1E-30) SIGB=1E-30 220 : SIGC=(XC-XCT)*XN+(YC-YCT)*YN+(ZC-ZCT)*ZN 221 : IF (ABS(SIGC).LE.1E-30) SIGC=1E-30 222 : * if (isect.eq.1) goto 350 223 : IF (SIGA.GT.0..OR.SIGB.GT.0..OR.SIGC.GT.0.) GOTO 103 224 : IF (VOLUM) THEN 225 : IA1=MIN(IA,IB,IC) 226 : IB1=MAX(IA,IB,IC) 227 : IC1=IA+IB+IC 228 : DO 102 IDJF=ITRT(/1)-4,1,-5 229 : ITR1=MIN(ITRT(IDJF),ITRT(IDJF+1),ITRT(IDJF+2)) 230 : ITR2=MAX(ITRT(IDJF),ITRT(IDJF+1),ITRT(IDJF+2)) 231 : ITR3=ITRT(IDJF)+ITRT(IDJF+1)+ITRT(IDJF+2) 232 : IF (IA1.NE.ITR1) GOTO 102 233 : IF (IB1.NE.ITR2) GOTO 102 234 : IF (IC1.NE.ITR3) GOTO 102 235 : * WRITE (6,*) ' TRIANGLE EN DOUBLE CAS 1 ',IA,IB,IC 236 : C LE TRIANGLE EST DECLARE NON TRACABLE 237 : ITRT(IDJF+4)=MOD(ITRT(IDJF+4),16)+16 238 : GOTO 301 239 : 102 CONTINUE 240 : ENDIF 241 : if (isect.eq.0) then 242 : * WRITE (6,*) ' NOUVEAU TRIANGLE ',IA,IB,IC 243 : ITRT(**)=IA 244 : ITRT(**)=IB 245 : ITRT(**)=IC 246 : ITRT(**)=IPT1.ICOLOR(JEL) 247 : ITRT(**)=ISEG1+2*ISEG2+4*ISEG3 248 : if (mcham.ne.0) then 249 : xtrt(**)=melva1.velche(min(lva1,iafa),min(idi2,jel)) 250 : xtrt(**)=melva1.velche(min(lva1,ibfa),min(idi2,jel)) 251 : xtrt(**)=melva1.velche(min(lva1,icfa),min(idi2,jel)) 252 : endif 253 : endif 254 : 301 CONTINUE 255 : GOTO 101 256 : 103 CONTINUE 257 : IF (SIGA.GT.0..AND.SIGB.GT.0..AND.SIGC.GT.0.) GOTO 101 258 : IPOS=0 259 : IF (SIGA.LE.0.) THEN 260 : IPOS=IPOS+1 261 : JTT(IPOS)=IA 262 : ISEG(IPOS)=ISEG1 263 : if(mcham.ne.0)xsegm(ia)= 264 : $ melva1.velche(min(lva1,iafa),min(idi2,jel)) 265 : ENDIF 266 : IF (SIGA*SIGB.LT.0..AND.(.NOT.(SIGA.LE.0..AND.SIGB.LE.0.))) THEN 267 : IA1=MIN(IA,IB) 268 : IB1=MAX(IA,IB) 269 : DO 104 NSEGM=ISEGM(/1)-2,1,-3 270 : IF (IA1.NE.ISEGM(NSEGM)) GOTO 104 271 : IF (IB1.NE.ISEGM(NSEGM+1)) GOTO 104 272 : ISUP=ISEGM(NSEGM+2) 273 : if (mcham.ne.0) 274 : > xsegm(isup)=(melva1.velche(min(lva1,iafa),min(idi2,jel))*sigb- 275 : > melva1.velche(min(lva1,ibfa),min(idi2,jel))*siga)/(sigb-siga) 276 : * WRITE (6,*) ' POINT EN DOUBLE ',IA1,IB1,ISUP 277 : GOTO 105 278 : 104 CONTINUE 279 : NBPTS=XCOOR(/1)/4+1 280 : SEGADJ MCOORD 281 : XCOOR((NBPTS-1)*4+1)=(XA*SIGB-XB*SIGA)/(SIGB-SIGA) 282 : XCOOR((NBPTS-1)*4+2)=(YA*SIGB-YB*SIGA)/(SIGB-SIGA) 283 : XCOOR((NBPTS-1)*4+3)=(ZA*SIGB-ZB*SIGA)/(SIGB-SIGA) 284 : XCOOR(NBPTS*(IDIM+1))=0. 285 : IF (VCHCA.NE.0) 286 : # VCHCA(**)=(VCHCA(IA)*SIGB-VCHCA(IB)*SIGA)/(SIGB-SIGA) 287 : ISUP=NBPTS 288 : ISEGM(**)=IA1 289 : ISEGM(**)=IB1 290 : ISEGM(**)=ISUP 291 : if (mcham.ne.0) 292 : > xsegm(**)=(melva1.velche(min(lva1,iafa),min(idi2,jel))*sigb- 293 : > melva1.velche(min(lva1,ibfa),min(idi2,jel))*siga)/(sigb-siga) 294 : 105 CONTINUE 295 : IPOS=IPOS+1 296 : JTT(IPOS)=ISUP 297 : IF (SIGB.LE.0.) THEN 298 : ISEG(IPOS)=ISEG1 299 : ELSE 300 : ISEG(IPOS)=1 301 : ENDIF 302 : ENDIF 303 : IF (SIGB.LE.0.) THEN 304 : IPOS=IPOS+1 305 : JTT(IPOS)=IB 306 : ISEG(IPOS)=ISEG2 307 : if (mcham.ne.0) xsegm(ib)=melva1.velche(min(lva1,ibfa), 308 : $ min(idi2,jel)) 309 : ENDIF 310 : IF (SIGB*SIGC.LT.0..AND.(.NOT.(SIGB.LE.0..AND.SIGC.LE.0.))) THEN 311 : IB1=MIN(IB,IC) 312 : IC1=MAX(IB,IC) 313 : DO 106 NSEGM=ISEGM(/1)-2,1,-3 314 : IF (IB1.NE.ISEGM(NSEGM)) GOTO 106 315 : IF (IC1.NE.ISEGM(NSEGM+1)) GOTO 106 316 : ISUP=ISEGM(NSEGM+2) 317 : if (mcham.ne.0) 318 : > xsegm(isup)=(melva1.velche(min(lva1,ibfa),min(idi2,jel))*sigc- 319 : > melva1.velche(min(lva1,icfa),min(idi2,jel))*sigb)/(sigc-sigb) 320 : * WRITE (6,*) ' POINT EN DOUBLE ',IB1,IC1,ISUP 321 : GOTO 107 322 : 106 CONTINUE 323 : NBPTS=XCOOR(/1)/4+1 324 : SEGADJ MCOORD 325 : XCOOR((NBPTS-1)*4+1)=(XB*SIGC-XC*SIGB)/(SIGC-SIGB) 326 : XCOOR((NBPTS-1)*4+2)=(YB*SIGC-YC*SIGB)/(SIGC-SIGB) 327 : XCOOR((NBPTS-1)*4+3)=(ZB*SIGC-ZC*SIGB)/(SIGC-SIGB) 328 : XCOOR(NBPTS*4)=0. 329 : IF (VCHCA.NE.0) 330 : # VCHCA(**)=(VCHCA(IB)*SIGC-VCHCA(IC)*SIGB)/(SIGC-SIGB) 331 : ISUP=NBPTS 332 : ISEGM(**)=IB1 333 : ISEGM(**)=IC1 334 : ISEGM(**)=ISUP 335 : if (mcham.ne.0) 336 : > xsegm(**)=(melva1.velche(min(lva1,ibfa),min(idi2,jel))*sigc- 337 : > melva1.velche(min(lva1,icfa),min(idi2,jel))*sigb)/(sigc-sigb) 338 : 107 CONTINUE 339 : IPOS=IPOS+1 340 : JTT(IPOS)=ISUP 341 : IF (SIGC.LE.0.) THEN 342 : ISEG(IPOS)=ISEG2 343 : ELSE 344 : ISEG(IPOS)=1 345 : ENDIF 346 : ENDIF 347 : IF (SIGC.LE.0.) THEN 348 : IPOS=IPOS+1 349 : JTT(IPOS)=IC 350 : ISEG(IPOS)=ISEG3 351 : if (mcham.ne.0)xsegm(ic)=melva1.velche(min(lva1,icfa), 352 : $ min(idi2,jel)) 353 : ENDIF 354 : IF (SIGC*SIGA.LT.0..AND.(.NOT.(SIGC.LE.0..AND.SIGA.LE.0.))) THEN 355 : IC1=MIN(IC,IA) 356 : IA1=MAX(IC,IA) 357 : DO 108 NSEGM=ISEGM(/1)-2,1,-3 358 : IF (IC1.NE.ISEGM(NSEGM)) GOTO 108 359 : IF (IA1.NE.ISEGM(NSEGM+1)) GOTO 108 360 : ISUP=ISEGM(NSEGM+2) 361 : if (mcham.ne.0) 362 : > xsegm(isup)=(melva1.velche(min(lva1,icfa),min(idi2,jel))*siga- 363 : > melva1.velche(min(lva1,iafa),min(idi2,jel))*sigc)/(siga-sigc) 364 : * WRITE (6,*) ' POINT EN DOUBLE ',IC1,IA1,ISUP 365 : GOTO 109 366 : 108 CONTINUE 367 : NBPTS=XCOOR(/1)/4+1 368 : SEGADJ MCOORD 369 : XCOOR((NBPTS-1)*4+1)=(XC*SIGA-XA*SIGC)/(SIGA-SIGC) 370 : XCOOR((NBPTS-1)*4+2)=(YC*SIGA-YA*SIGC)/(SIGA-SIGC) 371 : XCOOR((NBPTS-1)*4+3)=(ZC*SIGA-ZA*SIGC)/(SIGA-SIGC) 372 : XCOOR(NBPTS*4)=0. 373 : IF (VCHCA.NE.0) 374 : # VCHCA(**)=(VCHCA(IC)*SIGA-VCHCA(IA)*SIGC)/(SIGA-SIGC) 375 : ISUP=NBPTS 376 : ISEGM(**)=IC1 377 : ISEGM(**)=IA1 378 : ISEGM(**)=ISUP 379 : if (mcham.ne.0) 380 : > xsegm(**)=(melva1.velche(min(lva1,icfa),min(idi2,jel))*siga- 381 : > melva1.velche(min(lva1,iafa),min(idi2,jel))*sigc)/(siga-sigc) 382 : 109 CONTINUE 383 : IPOS=IPOS+1 384 : JTT(IPOS)=ISUP 385 : IF (SIGA.LE.0.) THEN 386 : ISEG(IPOS)=ISEG3 387 : ELSE 388 : ISEG(IPOS)=1 389 : ENDIF 390 : ENDIF 391 : IF (IPOS.GT.4) WRITE (6,*) ' ANOMALIE IPOS SURFACE ',IPOS 392 : IF (IPOS.LT.3) WRITE (6,*) ' ANOMALIE IPOS SURFACE ',IPOS 393 : IF (IPOS.LT.3) GOTO 101 394 : IF (IPOS.EQ.3) THEN 395 : IF (VOLUM) THEN 396 : IA1=MIN(JTT(1),JTT(2),JTT(3)) 397 : IB1=MAX(JTT(1),JTT(2),JTT(3)) 398 : IC1=JTT(1)+JTT(2)+JTT(3) 399 : DO 110 IDJF=ITRT(/1)-4,1,-5 400 : ITR1=MIN(ITRT(IDJF),ITRT(IDJF+1),ITRT(IDJF+2)) 401 : ITR2=MAX(ITRT(IDJF),ITRT(IDJF+1),ITRT(IDJF+2)) 402 : ITR3=ITRT(IDJF)+ITRT(IDJF+1)+ITRT(IDJF+2) 403 : IF (IA1.NE.ITR1) GOTO 110 404 : IF (IB1.NE.ITR2) GOTO 110 405 : IF (IC1.NE.ITR3) GOTO 110 406 : * WRITE (6,*) ' TRIANGLE EN DOUBLE CAS 2 ',JTT(1),JTT(2),JTT(3) 407 : C LE TRIANGLE EST DECLARE NON TRACABLE 408 : ITRT(IDJF+4)=MOD(ITRT(IDJF+4),16)+16 409 : GOTO 303 410 : 110 CONTINUE 411 : ENDIF 412 : * WRITE (6,*) ' NOUVEAU TRIANGLE ',JTT(1),JTT(2),JTT(3) 413 : if (isect.eq.1.and.jtt(1).le.nbpoin) jtt(1)=isup 414 : ITRT(**)=JTT(1) 415 : if (isect.eq.1.and.jtt(2).le.nbpoin) jtt(2)=isup 416 : ITRT(**)=JTT(2) 417 : if (isect.eq.1.and.jtt(3).le.nbpoin) jtt(3)=isup 418 : ITRT(**)=JTT(3) 419 : ITRT(**)=IPT1.ICOLOR(JEL) 420 : ITRT(**)=ISEG(1)+2*ISEG(2)+4*ISEG(3) 421 : if (mcham.ne.0) then 422 : xtrt(**)=xsegm(jtt(1)) 423 : xtrt(**)=xsegm(jtt(2)) 424 : xtrt(**)=xsegm(jtt(3)) 425 : endif 426 : ENDIF 427 : 303 CONTINUE 428 : IF (IPOS.EQ.4) THEN 429 : IF (VOLUM) THEN 430 : IA1=MIN(JTT(1),JTT(2),JTT(3),JTT(4)) 431 : IB1=MAX(JTT(1),JTT(2),JTT(3),JTT(4)) 432 : IC1=JTT(1)+JTT(2)+JTT(3)+JTT(4) 433 : ID1=JTT(1)*JTT(2)*JTT(3)*JTT(4) 434 : DO 111 IDJF=IQUAT(/1)-5,1,-6 435 : ITR1=MIN(IQUAT(IDJF),IQUAT(IDJF+1),IQUAT(IDJF+2),IQUAT(IDJF+3)) 436 : ITR2=MAX(IQUAT(IDJF),IQUAT(IDJF+1),IQUAT(IDJF+2),IQUAT(IDJF+3)) 437 : ITR3=IQUAT(IDJF)+IQUAT(IDJF+1)+IQUAT(IDJF+2)+IQUAT(IDJF+3) 438 : ITR4=IQUAT(IDJF)*IQUAT(IDJF+1)*IQUAT(IDJF+2)*IQUAT(IDJF+3) 439 : IF (IA1.NE.ITR1) GOTO 111 440 : IF (IB1.NE.ITR2) GOTO 111 441 : IF (IC1.NE.ITR3) GOTO 111 442 : IF (ID1.NE.ITR4) GOTO 111 443 : * WRITE (6,*) ' QUADRILA EN DOUBLE ',JTT(1),JTT(2),JTT(3),JTT(4) 444 : C LE QUADRILATERE EST DECLARE NON TRACABLE 445 : IQUAT(IDJF+5)=MOD(IQUAT(IDJF+5),16)+16 446 : GOTO 302 447 : 111 CONTINUE 448 : ENDIF 449 : * WRITE (6,*) ' NOUVEAU QUADRILATERE ',JTT(1),JTT(2),JTT(3),JTT(4) 450 : if (isect.eq.1.and.jtt(1).le.nbpoin) jtt(1)=isup 451 : IQUAT(**)=JTT(1) 452 : if (isect.eq.1.and.jtt(2).le.nbpoin) jtt(2)=isup 453 : IQUAT(**)=JTT(2) 454 : if (isect.eq.1.and.jtt(3).le.nbpoin) jtt(3)=isup 455 : IQUAT(**)=JTT(3) 456 : if (isect.eq.1.and.jtt(4).le.nbpoin) jtt(4)=isup 457 : IQUAT(**)=JTT(4) 458 : IQUAT(**)=IPT1.ICOLOR(JEL) 459 : IQUAT(**)=ISEG(1)+2*ISEG(2)+4*ISEG(3)+8*ISEG(4) 460 : if (mcham.ne.0) then 461 : xquat(**)=xsegm(jtt(1)) 462 : xquat(**)=xsegm(jtt(2)) 463 : xquat(**)=xsegm(jtt(3)) 464 : xquat(**)=xsegm(jtt(4)) 465 : endif 466 : ENDIF 467 : 302 CONTINUE 468 : GOTO 101 469 : 101 CONTINUE 470 : 350 CONTINUE 471 : IF (.NOT.VOLUM) GOTO 160 472 : C ETUDE POUR LE CAS DES VOLUMES DU TETRAEDRE S'APPUYANT SUR LE 473 : C TRIANGLE ET LE CENTRE DE GRAVITE 474 : C TETRAEDRE 475 : IF (SIGA.LT.0..AND.SIGB.LT.0..AND.SIGC.LT.0..AND.SIGRAV 476 : # .LT.0.) GOTO 160 477 : IF (SIGA.GT.0..AND.SIGB.GT.0..AND.SIGC.GT.0..AND.SIGRAV 478 : # .GT.0.) GOTO 160 479 : IPOS=0 480 : ISEG(1)=0 481 : ISEG(2)=0 482 : ISEG(3)=0 483 : ISEG(4)=0 484 : IF (SIGRAV*SIGA.LE.0.) THEN 485 : IF (SIGA.EQ.0.) THEN 486 : ISUP=IA 487 : if (mcham.ne.0) 488 : > xsegm(isup)=melva1.velche(min(lva1,iafa),min(idi2,jel)) 489 : GOTO 359 490 : ENDIF 491 : DO 358 NSEGM=1,NJGRAV 492 : IF (IA.NE.IJGRAV(1,NSEGM)) GOTO 358 493 : ISUP=IJGRAV(2,NSEGM) 494 : if (mcham.ne.0) 495 : > xsegm(isup)=(melva1.velche(min(lva1,iafa),min(idi2,jel))*sigrav- 496 : > chgrav*siga)/(sigrav-siga) 497 : GOTO 359 498 : 358 CONTINUE 499 : NBPTS=XCOOR(/1)/4+1 500 : SEGADJ MCOORD 501 : XCOOR((NBPTS-1)*4+1)=(XA*SIGRAV-XGRAV*SIGA)/(SIGRAV-SIGA) 502 : XCOOR((NBPTS-1)*4+2)=(YA*SIGRAV-YGRAV*SIGA)/(SIGRAV-SIGA) 503 : XCOOR((NBPTS-1)*4+3)=(ZA*SIGRAV-ZGRAV*SIGA)/(SIGRAV-SIGA) 504 : XCOOR(NBPTS*4)=0. 505 : IF (VCHCA.NE.0) 506 : # VCHCA(**)=(VCHCA(IA)*SIGRAV-VGRAV*SIGA)/(SIGRAV-SIGA) 507 : if (mcham.ne.0) 508 : > xsegm(**)=(melva1.velche(min(lva1,iafa),min(idi2,jel))*sigrav- 509 : > chgrav*siga)/(sigrav-siga) 510 : ISUP=NBPTS 511 : NJGRAV=NJGRAV+1 512 : IJGRAV(1,NJGRAV)=IA 513 : IJGRAV(2,NJGRAV)=ISUP 514 : 359 CONTINUE 515 : IPOS=IPOS+1 516 : JTT(IPOS)=ISUP 517 : ENDIF 518 : IF (SIGA*SIGB.LT.0..AND. 519 : # (.NOT.(SIGRAV*SIGA.LE.0..AND.SIGRAV*SIGB.LE.0.))) THEN 520 : IA1=MIN(IA,IB) 521 : IB1=MAX(IA,IB) 522 : DO 404 NSEGM=ISEGM(/1)-2,1,-3 523 : IF (IA1.NE.ISEGM(NSEGM)) GOTO 404 524 : IF (IB1.NE.ISEGM(NSEGM+1)) GOTO 404 525 : ISUP=ISEGM(NSEGM+2) 526 : * WRITE (6,*) ' POINT EN DOUBLE ',IA1,IB1,ISUP 527 : if (mcham.ne.0) 528 : > xsegm(isup)=(melva1.velche(min(lva1,iafa),min(idi2,jel))*sigb- 529 : > melva1.velche(min(lva1,ibfa),min(idi2,jel))*siga)/(sigb-siga) 530 : GOTO 405 531 : 404 CONTINUE 532 : NBPTS=XCOOR(/1)/4+1 533 : SEGADJ MCOORD 534 : XCOOR((NBPTS-1)*4+1)=(XA*SIGB-XB*SIGA)/(SIGB-SIGA) 535 : XCOOR((NBPTS-1)*4+2)=(YA*SIGB-YB*SIGA)/(SIGB-SIGA) 536 : XCOOR((NBPTS-1)*4+3)=(ZA*SIGB-ZB*SIGA)/(SIGB-SIGA) 537 : XCOOR(NBPTS*4)=0. 538 : IF (VCHCA.NE.0) 539 : # VCHCA(**)=(VCHCA(IA)*SIGB-VCHCA(IB)*SIGA)/(SIGB-SIGA) 540 : ISUP=NBPTS 541 : ISEGM(**)=IA1 542 : ISEGM(**)=IB1 543 : ISEGM(**)=ISUP 544 : if (mcham.ne.0) 545 : > xsegm(**)=(melva1.velche(min(lva1,iafa),jel)*sigb- 546 : > melva1.velche(min(lva1,ibfa),jel)*siga)/(sigb-siga) 547 : 405 CONTINUE 548 : IPOS=IPOS+1 549 : JTT(IPOS)=ISUP 550 : IF (SIGRAV*SIGB.GT.0.) THEN 551 : ISEG(IPOS)=1 552 : ENDIF 553 : ENDIF 554 : IF (SIGRAV*SIGB.LE.0.) THEN 555 : IF (SIGB.EQ.0.) THEN 556 : ISUP=IB 557 : if (mcham.ne.0) 558 : > xsegm(isup)=melva1.velche(min(lva1,ibfa),min(idi2,jel)) 559 : GOTO 369 560 : ENDIF 561 : DO 368 NSEGM=1,NJGRAV 562 : IF (IB.NE.IJGRAV(1,NSEGM)) GOTO 368 563 : ISUP=IJGRAV(2,NSEGM) 564 : GOTO 369 565 : 368 CONTINUE 566 : NBPTS=XCOOR(/1)/4+1 567 : SEGADJ MCOORD 568 : XCOOR((NBPTS-1)*4+1)=(XB*SIGRAV-XGRAV*SIGB)/(SIGRAV-SIGB) 569 : XCOOR((NBPTS-1)*4+2)=(YB*SIGRAV-YGRAV*SIGB)/(SIGRAV-SIGB) 570 : XCOOR((NBPTS-1)*4+3)=(ZB*SIGRAV-ZGRAV*SIGB)/(SIGRAV-SIGB) 571 : XCOOR(NBPTS*4)=0. 572 : IF (VCHCA.NE.0) 573 : # VCHCA(**)=(VCHCA(IB)*SIGRAV-VGRAV*SIGB)/(SIGRAV-SIGB) 574 : if (mcham.ne.0) 575 : > xsegm(**)=(melva1.velche(min(lva1,ibfa),min(idi2,jel))*sigrav- 576 : > chgrav*sigb)/(sigrav-sigb) 577 : ISUP=NBPTS 578 : NJGRAV=NJGRAV+1 579 : IJGRAV(1,NJGRAV)=IB 580 : IJGRAV(2,NJGRAV)=ISUP 581 : 369 CONTINUE 582 : IPOS=IPOS+1 583 : JTT(IPOS)=ISUP 584 : if (mcham.ne.0) 585 : > xsegm(isup)=(melva1.velche(min(lva1,ibfa),min(idi2,jel))*sigrav- 586 : > chgrav*sigb)/(sigrav-sigb) 587 : ENDIF 588 : IF (SIGB*SIGC.LT.0..AND. 589 : # (.NOT.(SIGRAV*SIGB.LE.0..AND.SIGRAV*SIGC.LE.0.))) THEN 590 : IB1=MIN(IB,IC) 591 : IC1=MAX(IB,IC) 592 : DO 406 NSEGM=ISEGM(/1)-2,1,-3 593 : IF (IB1.NE.ISEGM(NSEGM)) GOTO 406 594 : IF (IC1.NE.ISEGM(NSEGM+1)) GOTO 406 595 : ISUP=ISEGM(NSEGM+2) 596 : * WRITE (6,*) ' POINT EN DOUBLE ',IB1,IC1,ISUP 597 : if (mcham.ne.0) 598 : > xsegm(isup)=(melva1.velche(min(lva1,ibfa),min(idi2,jel))*sigc- 599 : > melva1.velche(min(lva1,icfa),min(idi2,jel))*sigb)/(sigc-sigb) 600 : GOTO 407 601 : 406 CONTINUE 602 : NBPTS=XCOOR(/1)/4+1 603 : SEGADJ MCOORD 604 : XCOOR((NBPTS-1)*4+1)=(XB*SIGC-XC*SIGB)/(SIGC-SIGB) 605 : XCOOR((NBPTS-1)*4+2)=(YB*SIGC-YC*SIGB)/(SIGC-SIGB) 606 : XCOOR((NBPTS-1)*4+3)=(ZB*SIGC-ZC*SIGB)/(SIGC-SIGB) 607 : XCOOR(NBPTS*4)=0. 608 : IF (VCHCA.NE.0) 609 : # VCHCA(**)=(VCHCA(IB)*SIGC-VCHCA(IC)*SIGB)/(SIGC-SIGB) 610 : ISUP=NBPTS 611 : ISEGM(**)=IB1 612 : ISEGM(**)=IC1 613 : ISEGM(**)=ISUP 614 : if (mcham.ne.0) 615 : > xsegm(**)=(melva1.velche(min(lva1,ibfa),min(idi2,jel))*sigc- 616 : > melva1.velche(min(lva1,icfa),min(idi2,jel))*sigb)/(sigc-sigb) 617 : 407 CONTINUE 618 : IPOS=IPOS+1 619 : JTT(IPOS)=ISUP 620 : IF (SIGRAV*SIGC.GT.0.) THEN 621 : ISEG(IPOS)=1 622 : ENDIF 623 : ENDIF 624 : IF (SIGRAV*SIGC.LE.0.) THEN 625 : IF (SIGC.EQ.0.) THEN 626 : ISUP=IC 627 : if (mcham.ne.0) 628 : > xsegm(isup)=melva1.velche(min(lva1,icfa),min(idi2,jel)) 629 : GOTO 379 630 : ENDIF 631 : DO 378 NSEGM=1,NJGRAV 632 : IF (IC.NE.IJGRAV(1,NSEGM)) GOTO 378 633 : ISUP=IJGRAV(2,NSEGM) 634 : if (mcham.ne.0) 635 : > xsegm(isup)=(melva1.velche(min(lva1,icfa),min(idi2,jel))*sigrav- 636 : > chgrav*sigc)/(sigrav-sigc) 637 : GOTO 379 638 : 378 CONTINUE 639 : NBPTS=XCOOR(/1)/4+1 640 : SEGADJ MCOORD 641 : XCOOR((NBPTS-1)*4+1)=(XC*SIGRAV-XGRAV*SIGC)/(SIGRAV-SIGC) 642 : XCOOR((NBPTS-1)*4+2)=(YC*SIGRAV-YGRAV*SIGC)/(SIGRAV-SIGC) 643 : XCOOR((NBPTS-1)*4+3)=(ZC*SIGRAV-ZGRAV*SIGC)/(SIGRAV-SIGC) 644 : XCOOR(NBPTS*4)=0. 645 : IF (VCHCA.NE.0) 646 : # VCHCA(**)=(VCHCA(IC)*SIGRAV-VGRAV*SIGC)/(SIGRAV-SIGC) 647 : if (mcham.ne.0) 648 : > xsegm(**)=(melva1.velche(min(lva1,icfa),min(idi2,jel))*sigrav- 649 : > chgrav*sigc)/(sigrav-sigc) 650 : ISUP=NBPTS 651 : NJGRAV=NJGRAV+1 652 : IJGRAV(1,NJGRAV)=IC 653 : IJGRAV(2,NJGRAV)=ISUP 654 : 379 CONTINUE 655 : IPOS=IPOS+1 656 : JTT(IPOS)=ISUP 657 : ENDIF 658 : IF (SIGC*SIGA.LT.0..AND. 659 : # (.NOT.(SIGRAV*SIGC.LE.0..AND.SIGRAV*SIGA.LE.0.))) THEN 660 : IC1=MIN(IC,IA) 661 : IA1=MAX(IC,IA) 662 : DO 408 NSEGM=ISEGM(/1)-2,1,-3 663 : IF (IC1.NE.ISEGM(NSEGM)) GOTO 408 664 : IF (IA1.NE.ISEGM(NSEGM+1)) GOTO 408 665 : ISUP=ISEGM(NSEGM+2) 666 : * WRITE (6,*) ' POINT EN DOUBLE ',IC1,IA1,ISUP 667 : if (mcham.ne.0) 668 : > xsegm(isup)=(melva1.velche(min(lva1,icfa),min(idi2,jel))*siga- 669 : > melva1.velche(min(lva1,iafa),min(idi2,jel))*sigc)/(siga-sigc) 670 : GOTO 409 671 : 408 CONTINUE 672 : NBPTS=XCOOR(/1)/4+1 673 : SEGADJ MCOORD 674 : XCOOR((NBPTS-1)*4+1)=(XC*SIGA-XA*SIGC)/(SIGA-SIGC) 675 : XCOOR((NBPTS-1)*4+2)=(YC*SIGA-YA*SIGC)/(SIGA-SIGC) 676 : XCOOR((NBPTS-1)*4+3)=(ZC*SIGA-ZA*SIGC)/(SIGA-SIGC) 677 : XCOOR(NBPTS*4)=0. 678 : IF (VCHCA.NE.0) 679 : # VCHCA(**)=(VCHCA(IC)*SIGA-VCHCA(IA)*SIGC)/(SIGA-SIGC) 680 : ISUP=NBPTS 681 : ISEGM(**)=IC1 682 : ISEGM(**)=IA1 683 : ISEGM(**)=ISUP 684 : if (mcham.ne.0) 685 : > xsegm(**)=(melva1.velche(min(lva1,icfa),min(idi2,jel))*siga- 686 : > melva1.velche(min(lva1,iafa),min(idi2,jel))*sigc)/(siga-sigc) 687 : 409 CONTINUE 688 : IPOS=IPOS+1 689 : JTT(IPOS)=ISUP 690 : IF (SIGRAV*SIGA.GT.0.) THEN 691 : ISEG(IPOS)=1 692 : ENDIF 693 : ENDIF 694 : IF (IPOS.GT.4) WRITE (6,*) ' ANOMALIE IPOS VOLUME ',IPOS 695 : IF (IPOS.LT.3) WRITE (6,*) ' ANOMALIE IPOS VOLUME ',IPOS 696 : IF (IPOS.LT.3) GOTO 160 697 : ITR(**)=JTT(1) 698 : ITR(**)=JTT(2) 699 : ITR(**)=JTT(3) 700 : ITR(**)=IPT1.ICOLOR(JEL) 701 : if (mcham.ne.0) then 702 : xtr(**)=xsegm(jtt(1)) 703 : xtr(**)=xsegm(jtt(2)) 704 : xtr(**)=xsegm(jtt(3)) 705 : endif 706 : * WRITE (6,*) ' TRIANGLE (CAS 1) DU PLAN DE COUPE ' 707 : * WRITE (6,*) JTT(1),JTT(2),JTT(3) 708 : C TRIANGLE DU PLAN DE COUPE 709 : IF (IPOS.EQ.3) THEN 710 : MCOUP(**)=ISEG(1)+2*ISEG(2)+4*ISEG(3)+8 711 : ELSE 712 : MCOUP(**)=ISEG(1)+2*ISEG(2)+4*0 +8 713 : ENDIF 714 : 403 CONTINUE 715 : IF (IPOS.GE.4) THEN 716 : ITR(**)=JTT(1) 717 : ITR(**)=JTT(3) 718 : ITR(**)=JTT(4) 719 : ITR(**)=IPT1.ICOLOR(JEL) 720 : if (mcham.ne.0) then 721 : xtr(**)=xsegm(jtt(1)) 722 : xtr(**)=xsegm(jtt(3)) 723 : xtr(**)=xsegm(jtt(4)) 724 : endif 725 : * WRITE (6,*) ' TRIANGLE (CAS 2) DU PLAN DE COUPE ' 726 : * WRITE (6,*) JTT(1),JTT(3),JTT(4) 727 : C TRIANGLE DU PLAN DE COUPE 728 : MCOUP(**)=0 +2*ISEG(3)+4*ISEG(4)+8 729 : ENDIF 730 : 402 CONTINUE 731 : 160 CONTINUE 732 : 161 CONTINUE 733 : 20 CONTINUE 734 : NBELEM=JELN 735 : SEGADJ IPT2 736 : ISU=ISU+1 737 : IPT8.LISOUS(ISU)=IPT2 738 : if (mcham.ne.0) then 739 : n1el=nbelem 740 : segadj melva2 741 : ipt8.lisref(isu)=melva2 742 : endif 743 : SEGDES IPT1 744 : 10 CONTINUE 745 : IF (NBSOU.NE.0) SEGDES MELEME 746 : NBSOUS=ISU+1 747 : * IF (ITR(/1).EQ.0) NBSOUS=ISU 748 : NBELEM=0 749 : NBNN=0 750 : NBREF=0 751 : if (mcham.ne.0) nbref=nbsous 752 : SEGADJ IPT8 753 : MELEME=IPT8 754 : * IF (ITR(/1).EQ.0) RETURN 755 : * WRITE(6,*) ' NOMBRE DE TRIANGLE ENGENDREES DANS LE PLAN DE COUPE', 756 : * # ITR(/1)/4 757 : * WRITE(6,*) ' NOMBRE DE TRIANGLE ENGENDREES HORS LE PLAN DE COUPE', 758 : * # ITRT(/1)/5 759 : * WRITE(6,*) ' NOMBRE DE QUADRILA ENGENDREES HORS LE PLAN DE COUPE', 760 : * # IQUAT(/1)/6 761 : NBELEM=ITR(/1)/4+ITRT(/1)/5+(IQUAT(/1)/6)*2 762 : NBNN=3 763 : NBREF=0 764 : NBSOUS=0 765 : SEGINI IPT4 766 : IPT4.ITYPEL=4 767 : if (mcham.ne.0) then 768 : n1el=nbelem 769 : n1ptel=nbnn 770 : segini melva4 771 : endif 772 : ITRL1=ITR(/1)/4 773 : DO 200 IEL=1,ITRL1 774 : DO 201 NBNN=1,3 775 : IPT4.NUM(NBNN,IEL)=ITR((IEL-1)*4+NBNN) 776 : if (mcham.ne.0) melva4.velche(nbnn,iel)=xtr((IEL-1)*3+nbnn) 777 : 201 CONTINUE 778 : IPT4.ICOLOR(IEL)=ITR(IEL*4) 779 : 200 CONTINUE 780 : ITRL2=ITRT(/1)/5 781 : DO 202 IEL=1,ITRL2 782 : DO 203 NBNN=1,3 783 : IPT4.NUM(NBNN,IEL+ITRL1)=ITRT((IEL-1)*5+NBNN) 784 : if (mcham.ne.0) 785 : > melva4.velche(nbnn,iel+itrl1)=xtrt((IEL-1)*3+nbnn) 786 : 203 CONTINUE 787 : IPT4.ICOLOR(IEL+ITRL1)=ITRT(IEL*5-1) 788 : MCOUP(**)=ITRT(IEL*5) 789 : 202 CONTINUE 790 : ITRL3=(IQUAT(/1)/6) 791 : DO 204 IEL=1,ITRL3 792 : IEL1=2*IEL-1 793 : DO 205 NBNN=1,3 794 : IPT4.NUM(NBNN,IEL1+ITRL1+ITRL2)=IQUAT((IEL-1)*6+NBNN) 795 : if (mcham.ne.0) 796 : > melva4.velche(nbnn,iel1+itrl1+itrl2)=xquat((IEL-1)*4+nbnn) 797 : 205 CONTINUE 798 : IPT4.ICOLOR(IEL1+ITRL1+ITRL2)=IQUAT(IEL*6-1) 799 : MCOUP(**)=MOD(IQUAT(IEL*6),4)+16*(IQUAT(IEL*6)/16) 800 : IEL2=2*IEL 801 : IPT4.NUM(1,IEL2+ITRL1+ITRL2)=IQUAT((IEL-1)*6+1) 802 : IPT4.NUM(2,IEL2+ITRL1+ITRL2)=IQUAT((IEL-1)*6+3) 803 : IPT4.NUM(3,IEL2+ITRL1+ITRL2)=IQUAT((IEL-1)*6+4) 804 : IPT4.ICOLOR(IEL2+ITRL1+ITRL2)=IQUAT(IEL*6-1) 805 : MCOUP(**)=0+MOD(IQUAT(IEL*6)/4,2)*2+MOD(IQUAT(IEL*6)/8,2)*4 806 : # +16*(IQUAT(IEL*6)/16) 807 : if (mcham.ne.0) then 808 : melva4.velche(1,iel2+itrl1+itrl2)=xquat((IEL-1)*4+1) 809 : melva4.velche(2,iel2+itrl1+itrl2)=xquat((IEL-1)*4+3) 810 : melva4.velche(3,iel2+itrl1+itrl2)=xquat((IEL-1)*4+4) 811 : endif 812 : 204 CONTINUE 813 : * WRITE (6,*) ' LISTE DES ELEMENTS RAJOUTES ' 814 : * DO 9834 J=1,NBELEM 815 : * WRITE (6,*) (IPT4.NUM(I,J),I=1,3) 816 : *9834 CONTINUE 817 : LISOUS(ISU+1)=IPT4 818 : if (mcham.ne.0) lisref(ISU+1)=melva4 819 : IF (MELEM2.NE.0) THEN 820 : IF (MEDSAU.EQ.0) THEN 821 : C ON COUPE MELEM2 822 : mcham=0 823 : MEDSAU=MELEME 824 : MEDCOU=MCOUP 825 : MELEME=MELEM2 826 : SEGSUP ITR,ITRT,IQUAT 827 : SEGINI MCOUP,ITR,ITRT,IQUAT 828 : GOTO 5000 829 : ELSE 830 : MELEM2=MELEME 831 : MELEME=MEDSAU 832 : MCOU2=MCOUP 833 : MCOUP=MEDCOU 834 : ENDIF 835 : ENDIF 836 : SEGSUP ITR,ISEGM,IJGRAV,ITRT,IQUAT 837 : if (mchamo.ne.0) segsup xtr,xtrt,xquat,xsegm 838 : END 839 : 840 : 841 : 842 : 843 : 844 : 845 : 846 : 847 : 848 : 849 : 850 : 851 : 852 : 853 : 854 : 855 :
© Cast3M 2003 - All rights reserved.
Disclaimer