1 SUBROUTINE LECTURE(XINIT_FACT) 2C 3 INCLUDE 'com_coor.f' 4 INCLUDE 'com_faces.f' 5 INCLUDE 'com_options.f' 6 CHARACTER*256 MOELLE 7 COMMON / SOUTERRAIN / MOELLE,LMOELLE,INOMBRE_VAR 8C 9 CHARACTER*80 HED 10 INTEGER IBC(9) 11C 12 PARAMETER (LWORK=NPMAX) 13 DIMENSION WORK(LWORK) 14 INTEGER IWORK(LWORK) 15 CHARACTER*1 CWORK(4*NPMAX) 16 EQUIVALENCE (IWORK(1),WORK(1)) 17 EQUIVALENCE (IWORK(1),CWORK(1)) 18 EQUIVALENCE (IBC(1),IWORK(4)) 19 CHARACTER*256 LIGNE 20 CHARACTER*20 CEXP 21 REAL*8 T1,T2 22 LOGICAL EGAL 23 DATA PI / 3.14159265358979 / 24C 25 1 DO I=1,80 26 HED(I:I) = ' ' 27 ENDDO 28 INOMBRE_VAR = 2 29 XMIN = BIG 30 XMAX = -BIG 31 YMIN = BIG 32 YMAX = -BIG 33 ZMIN = BIG 34 ZMAX = -BIG 35 MATMIN = 9999 36 MATMAX = -9999 37 IDEFOR = 0 38 IGROUP = 1 39 LONTIT = 0 40 ICOURXYZ = 0 41 IFIX = 0 42 IF (ICOURB.GT.-2.AND.IARCH.EQ.0) REWIND(IFAC) 43C 44C Maillage 45C 46 IF (ICOURB.GT.0) THEN 47 IF (IARCH.EQ.0) THEN 48 READ(IFAC) HED 49 ELSE 50 CALL litrecbin(IFAC,IWORK,LLL,1) 51 DO I=1,80 52 HED(I:I) = CWORK(I) 53 ENDDO 54 ENDIF 55 CALL FILTRE_BAD_CHAR(HED,80) 56 CALL ENLEVE_TOUS_BLANCS(HED,LONTIT,80) 57 IF (LONTIT.NE.0.AND.ISTDOUT.EQ.0) WRITE(*,1000) HED(1:LONTIT) 58 IF (IARCH.EQ.0) THEN 59 READ(IFAC) NUMNP,MNDOF 60 ELSE 61 CALL litrecbin(IFAC,IWORK,LLL,0) 62 NUMNP = IWORK(1) 63cc MNDOF = IWORK(2) 64 ENDIF 65 IF (NUMNP.GT.NPMAX) CALL TROPDEPOINTS(NUMNP,0,0) 66 NBCORN = 0 67 IPS2D = 1 68 DO 9 N=1,NUMNP 69 IF (IARCH.EQ.0) THEN 70 READ(IFAC) X(N),Y(N),Z(N),IBC 71 ELSE 72 CALL litrecbin(IFAC,IWORK,LLL,0) 73 X(N) = WORK(1) 74 Y(N) = WORK(2) 75 Z(N) = WORK(3) 76 ENDIF 77 IREF(N) = IBC(4) 78 IREF3(N) = IBC(5) 79 MATMIN = MIN(MATMIN,IREF3(N)) 80 MATMAX = MAX(MATMAX,IREF3(N)) 81Cfj IF (ABS(IBC(8)).LT.1000) THEN 82Cfj IREF2(N) = IBC(8)+2 83Cfj ELSEIF(IBC(8).GT.0) THEN 84Cfj IREF2(N) = 13 85Cfj ELSE 86Cfj IREF2(N) = 14 87Cfj ENDIF 88 IBC9 = MOD(IABS(IBC(9)),1000) 89 IF (IBC9.EQ.111.AND.IFIX.LE.0) THEN 90 IFIX = N 91 ELSEIF(IBC9.EQ.110.AND.IFIX.EQ.0) THEN 92 IFIX = -N 93 ENDIF 94 IBC9B = IABS(IBC(9))/1000 95 IPS2D = MIN(IPS2D,MOD(IBC9,2)) 96 IBLOQ(N) = 8*IBC9B + 4*MOD(IBC9,2) + 2*MOD(IBC9/10,2) 97 & + MOD(IBC9/100,2) 98C 99C Deplacement unilat�ral 100C 101 IF (IBC(8).GE.9901.AND.IBC(8).LE.9906) THEN 102 IBLOQ(N) = IBLOQ(N) + 100*(IBC(8)-9900) 103C 104C Contact unilat�ral 105C 106 ELSEIF(IBC(8).GE.8801.AND.IBC(8).LE.8899) THEN 107 IBCC = IBC(8)-8800 108 IBLOQ(N) = IBLOQ(N) + 10000*IBCC 109C 110C Contact bilat�ral 111C 112 ELSEIF(IBC(8).GE.-8899.AND.IBC(8).LE.-8801) THEN 113 IBCC = ABS(IBC(8))-8800 114 IBLOQ(N) = IBLOQ(N) + 1000000*IBCC 115 ENDIF 116 IF (MOD(IBC(5),2).EQ.1.AND.(IBC(4).EQ.8.OR.IBC(4).EQ.11)) THEN 117 NBCORN = NBCORN+1 118 ICOR(N) = 1 119 IF (IBC(1).EQ.1.AND.IBC(2).EQ.1) THEN 120 XCCOR = X(N) 121 YCCOR = Y(N) 122 ZCCOR = Z(N) 123 ENDIF 124 ELSE 125 ICOR(N) = 0 126 ENDIF 127 XMIN = AMIN1(XMIN,X(N)) 128 XMAX = AMAX1(XMAX,X(N)) 129 YMIN = AMIN1(YMIN,Y(N)) 130 YMAX = AMAX1(YMAX,Y(N)) 131 ZMIN = AMIN1(ZMIN,Z(N)) 132 ZMAX = AMAX1(ZMAX,Z(N)) 133 9 CONTINUE 134 IF (IEXAG.EQ.0.AND.IPS2D.NE.0.AND.IWILD.NE.0 135 & .AND.NOM_FICH(LONG-7:LONG).EQ.'.avoir3D') THEN 136 CALL PREMIER_LIBRE(IBID) 137 OPEN(IBID,FILE=NOM_FICH(1:LONG-2)//'2D',FORM='UNFORMATTED' 138 & ,STATUS='OLD',IOSTAT=IERR) 139 CLOSE(IBID) 140 IF (IERR.EQ.0) THEN 141 NOM_FICH(LONG-1:LONG-1) = '2' 142 IF (ISTDOUT.EQ.0) THEN 143 IF (ILANG.EQ.0) THEN 144 PRINT*,'En fait on pr�f�re ouvrir '//NOM_FICH(1:LONG) 145 ELSE 146 PRINT*,'I preferred opening '//NOM_FICH(1:LONG) 147 ENDIF 148 ENDIF 149 IF (IARCH.EQ.0) THEN 150 OPEN(IFAC,FILE=NOM_FICH(1:LONG),FORM='UNFORMATTED' 151 & ,STATUS='OLD') 152 ELSE 153 CALL ouvrebin(IFAC,NOM_FICH(1:LONG)//CHAR(0),0,IRC) 154 ENDIF 155 GOTO 1 156 ENDIF 157 ENDIF 158 IF (IEXAG.NE.0) THEN 159 XMIN0 = BIG 160 XMAX0 = -BIG 161 YMIN0 = BIG 162 YMAX0 = -BIG 163 IDEFOR = 1 164 IF (XINIT_FACT.NE.BIGS) THEN 165 IF (XINIT_FACT.EQ.311263.) THEN 166 FACEXA = 1. 167 ELSE 168 FACEXA = XINIT_FACT 169 ENDIF 170 ELSE 171 FACEXA = 1. 172 ENDIF 173 IF (IEXAG.EQ.1) THEN 174 IF (IARCH.EQ.0) THEN 175 REWIND(IFAC2) 176 READ(IFAC2) HED 177 ELSE 178 CALL litrecbin(IFAC2,IWORK,LLL,1) 179 DO I=1,80 180 HED(I:I) = CWORK(I) 181 ENDDO 182 ENDIF 183 CALL ENLEVE_TOUS_BLANCS(HED,LONTIT,80) 184 IF (LONTIT.NE.0) WRITE(*,1000) HED(1:LONTIT) 185 IF (IARCH.EQ.0) THEN 186 READ(IFAC2) NNN,MNDOF 187 ELSE 188 CALL litrecbin(IFAC2,IWORK,LLL,0) 189 NNN = IWORK(1) 190cc MNDOF = IWORK(2) 191 ENDIF 192 IF (NNN.NE.NUMNP) THEN 193 IF (ILANG.EQ.0) THEN 194 PRINT*, 195 & '*** Fichier .avoir incompatible avec le .deformee' 196 ELSE 197 PRINT*, 198 & '*** File .avoir not compatible with the .deformee' 199 ENDIF 200 IEXAG = 0 201 GOTO 10 202 ENDIF 203 DO N=1,NUMNP 204 IF (IARCH.EQ.0) THEN 205 READ(IFAC2) XN,YN,ZN 206 ELSE 207 CALL litrecbin(IFAC2,IWORK,LLL,0) 208 XN = WORK(1) 209 YN = WORK(2) 210 ZN = WORK(3) 211 ENDIF 212 DEPX(N) = X(N)-XN 213 DEPY(N) = Y(N)-YN 214 DEPZ(N) = Z(N)-ZN 215 IF (FACEXA.NE.1.) THEN 216 X(N) = XN + FACEXA*DEPX(N) 217 Y(N) = YN + FACEXA*DEPY(N) 218 Z(N) = ZN + FACEXA*DEPZ(N) 219 ENDIF 220 XMIN0 = AMIN1(XMIN0,XN) 221 XMAX0 = AMAX1(XMAX0,XN) 222 YMIN0 = AMIN1(YMIN0,YN) 223 YMAX0 = AMAX1(YMAX0,YN) 224 ENDDO 225 ELSE 226cc READ(IFAC2,*) NNN 227 CALL LITITRE(IFAC2,NNN,IERR) 228 IF (NNN.NE.NUMNP) THEN 229 IF (ISTDOUT.EQ.0) THEN 230 IF (ISTDOUT.EQ.0) THEN 231 IF (ILANG.EQ.0) THEN 232 PRINT*, 233 & '*** Fichier .depl incompatible avec le maillage' 234 ELSE 235 PRINT*, 236 & '*** File .depl not compatible with the mesh file' 237 ENDIF 238 ENDIF 239 ENDIF 240 IEXAG = 0 241 CALL TUELEGNEW 242 GOTO 10 243 ENDIF 244 IF (IEXAG.EQ.2) THEN 245 DO N=1,NUMNP 246 READ(IFAC2,*) DEPX(N),DEPY(N) 247 DEPZ(N) = 0. 248 ENDDO 249 ELSE 250 DO N=1,NUMNP 251 READ(IFAC2,*) DEPX(N),DEPY(N),DEPZ(N) 252 ENDDO 253 ENDIF 254 XMIN0 = XMIN 255 XMAX0 = XMAX 256 YMIN0 = YMIN 257 YMAX0 = YMAX 258 XMIN = BIG 259 XMAX = -BIG 260 YMIN = BIG 261 YMAX = -BIG 262 ZMIN = BIG 263 ZMAX = -BIG 264 DO N=1,NUMNP 265 X(N) = X(N) + FACEXA*DEPX(N) 266 Y(N) = Y(N) + FACEXA*DEPY(N) 267 Z(N) = Z(N) + FACEXA*DEPZ(N) 268 XMIN = AMIN1(XMIN,X(N)) 269 XMAX = AMAX1(XMAX,X(N)) 270 YMIN = AMIN1(YMIN,Y(N)) 271 YMAX = AMAX1(YMAX,Y(N)) 272 ZMIN = AMIN1(ZMIN,Z(N)) 273 ZMAX = AMAX1(ZMAX,Z(N)) 274 ENDDO 275 ENDIF 276 10 CLOSE(IFAC2) 277 VITMIN = BIG 278 VITMAX = -BIG 279 DO N=1,NUMNP 280 VITN(1,N) = DEPX(N) 281 VITN(2,N) = DEPY(N) 282 VITN(3,N) = DEPZ(N) 283 TOTO = SQRT(DEPX(N)**2+DEPY(N)**2+DEPZ(N)**2) 284 VALX(N) = TOTO 285 VITMIN = MIN(VITMIN,TOTO) 286 VITMAX = MAX(VITMAX,TOTO) 287 ENDDO 288 IFVIT = 2 289 IFISO = 1 290 IF (NOM_FICH(LONG-7:LONG-7).EQ.'.') THEN 291 NOM_VIT = NOM_FICH(1:LONG-7)//'depl' 292 LONVIT = LONG-3 293 ELSE 294 NOM_VIT = NOM_FICH(1:LONG) 295 LONVIT = LONG 296 ENDIF 297 NOM_ISO = '$|'//NOM_VIT(1:LONVIT)//'|' 298 LONISO = LONVIT+3 299 VMIN = VITMIN 300 VMAX = VITMAX 301 VMIN0 = VMIN 302 VMAX0 = VMAX 303 VMINISO = VMIN 304 VMAXISO = VMAX 305 ISOBID = 7 306 CALL METLEGNEW 307 ENDIF 308 IF (ZMIN.NE.ZMAX.AND.NBCORN.NE.0) 309 & CALL RAYTMS(X,Y,Z,ICOR,RAYON0,BIG,NUMNP,NBCORN) 310C 311C Courbe(s) 3d dans un fichier 312C 313 ELSEIF(ICOURB.EQ.-1) THEN 314 IF (IARCH.EQ.0) THEN 315 READ(IFAC) NUMX,NUMY 316 ELSE 317 CALL litrecbin(IFAC,IWORK,LLL,0) 318 NUMX = IWORK(1) 319 NUMY = IWORK(2) 320 ENDIF 321 IF (NUMX.EQ.0) THEN 322 IOPTCO = NUMY 323 IF (IARCH.EQ.0) THEN 324 READ(IFAC) NUMX,NUMY 325 ELSE 326 CALL litrecbin(IFAC,IWORK,LLL,0) 327 NUMX = IWORK(1) 328 NUMY = IWORK(2) 329 ENDIF 330 ELSE 331 IOPTCO = 0 332 ENDIF 333C 334 NUMNP0 = NUMX*NUMY 335 IF (NUMX.GT.NXYMAX.OR.NUMY.GT.NXYMAX) THEN 336 IF (ILANG.EQ.0) THEN 337 PRINT*, 338 & '*** Votre fichier comprend',NUMX,' x',NUMY,' points' 339 PRINT*,'*** Alors que le maximum permis est',NXYMAX 340 ELSE 341 PRINT*,'*** Your file contains',NUMX,' x',NUMY,' points' 342 PRINT*,'*** Maximum allowed =',NXYMAX 343 ENDIF 344 STOP 345 ENDIF 346 IF (NUMNP0.GT.NPMAX) CALL TROPDEPOINTS(NUMNP0,0,0) 347 IF (IARCH.EQ.0) THEN 348 READ(IFAC) (XSU(I),I=1,NUMX),(YSU(I),I=1,NUMY) 349 ELSE 350 CALL litrecbin(IFAC,IWORK,LLL,0) 351 DO I=1,NUMX 352 XSU(I) = WORK(I) 353 ENDDO 354 DO I=1,NUMY 355 YSU(I) = WORK(I+NUMX) 356 ENDDO 357 ENDIF 358 IF (IOPTCO.NE.0) THEN 359 IF (IARCH.EQ.0) THEN 360 READ(IFAC) (Z(NPMAX+I),I=1,NUMNP0) 361 ELSE 362 CALL litrecbin(IFAC,IWORK,LLL,0) 363 DO I=1,NUMNP0 364 Z(NPMAX+I) = WORK(I) 365 ENDDO 366 ENDIF 367 NUMSD = 1 368 NUMNP = NUMNP0 369 DO I=1,NUMNP 370 IREF(I) = 0 371 IREF3(I) = 0 372 IBLOQ(I) = 0 373 ENDDO 374C 375C Coordonnees cylindriques r=f(theta,z) 376C 377 IF (IOPTCO.EQ.1) THEN 378 IF (ISTDOUT.EQ.0) THEN 379 IF (ILANG.EQ.0) THEN 380 PRINT*,'Courbe en coordonn�es cylindriques r=f(theta,z)' 381 ELSE 382 PRINT*,'Cylindrical coordinates r=f(theta,z)' 383 ENDIF 384 ENDIF 385 RMOY = 0. 386 DO I=1,NUMNP 387 THETA = XSU(1+MOD(I-1,NUMX)) 388 X(I) = Z(NPMAX+I)*COS(THETA) 389 Y(I) = Z(NPMAX+I)*SIN(THETA) 390 Z(I) = YSU(1+(I-1)/NUMX) 391 XMIN = MIN(XMIN,X(I)) 392 XMAX = MAX(XMAX,X(I)) 393 YMIN = MIN(YMIN,Y(I)) 394 YMAX = MAX(YMAX,Y(I)) 395 ZMIN = MIN(ZMIN,Z(I)) 396 ZMAX = MAX(ZMAX,Z(I)) 397 RMOY = RMOY+Z(NPMAX+I) 398 ENDDO 399 RMOY = RMOY/REAL(NUMNP) 400 DO I=1,NUMNP 401 THETA = XSU(1+MOD(I-1,NUMX)) 402 DEPX(I) = X(I)-RMOY*COS(THETA) 403 DEPY(I) = Y(I)-RMOY*SIN(THETA) 404 DEPZ(I) = 0. 405 ISD(I) = 1 406 ENDDO 407 XMIREE = XMIN 408 XMAREE = XMAX 409 YMIREE = YMIN 410 YMAREE = YMAX 411C 412C Coordonnees spheriques 413C 414 ELSEIF(IOPTCO.EQ.2) THEN 415 IF (ILANG.EQ.0) THEN 416 PRINT*,'Courbe en coordon�ees sph�riques r=f(theta,phi)' 417 ELSE 418 PRINT*,'Spherical coordinates r=f(theta,phi)' 419 ENDIF 420 RMOY = 0. 421 DO I=1,NUMNP 422 THETA = XSU(1+MOD(I-1,NUMX)) 423 PHI = YSU(1+(I-1)/NUMX) 424 X(I) = Z(NPMAX+I)*SIN(PHI)*COS(THETA) 425 Y(I) = Z(NPMAX+I)*SIN(PHI)*SIN(THETA) 426 Z(I) = Z(NPMAX+I)*COS(PHI) 427 XMIN = MIN(XMIN,X(I)) 428 XMAX = MAX(XMAX,X(I)) 429 YMIN = MIN(YMIN,Y(I)) 430 YMAX = MAX(YMAX,Y(I)) 431 ZMIN = MIN(ZMIN,Z(I)) 432 ZMAX = MAX(ZMAX,Z(I)) 433 RMOY = RMOY+Z(NPMAX+I) 434 ENDDO 435 RMOY = RMOY/REAL(NUMNP) 436 DO I=1,NUMNP 437 THETA = XSU(1+MOD(I-1,NUMX)) 438 PHI = YSU(1+(I-1)/NUMX) 439 DEPX(I) = X(I)-RMOY*SIN(PHI)*COS(THETA) 440 DEPY(I) = Y(I)-RMOY*SIN(PHI)*SIN(THETA) 441 DEPZ(I) = Z(I)-RMOY*COS(PHI) 442 ISD(I) = 1 443 ENDDO 444 XMIREE = XMIN 445 XMAREE = XMAX 446 YMIREE = YMIN 447 YMAREE = YMAX 448C 449C Coordonnees cylindriques z=f(r,theta) 450C 451 ELSE 452 IF (ISTDOUT.EQ.0) THEN 453 IF (ILANG.EQ.0) THEN 454 PRINT*,'Courbe en coordonn�es cylindriques z=f(r,theta)' 455 ELSE 456 PRINT*,'Cylindric coordinates z=f(r,theta)' 457 ENDIF 458 ENDIF 459 ZMOY = 0. 460 DO I=1,NUMNP 461 RRR = XSU(1+MOD(I-1,NUMX)) 462 THETA = YSU(1+(I-1)/NUMX) 463 X(I) = RRR*COS(THETA) 464 Y(I) = RRR*SIN(THETA) 465 Z(I) = Z(NPMAX+I) 466 XMIN = MIN(XMIN,X(I)) 467 XMAX = MAX(XMAX,X(I)) 468 YMIN = MIN(YMIN,Y(I)) 469 YMAX = MAX(YMAX,Y(I)) 470 ZMIN = MIN(ZMIN,Z(I)) 471 ZMAX = MAX(ZMAX,Z(I)) 472 ZMOY = ZMOY+Z(I) 473 ENDDO 474 ZMOY = ZMOY/REAL(NUMNP) 475 DO I=1,NUMNP 476 THETA = YSU(1+(I-1)/NUMX) 477 DEPX(I) = X(I) 478 DEPY(I) = Y(I) 479 DEPZ(I) = Z(I) - ZMOY 480 ISD(I) = 1 481 ENDDO 482 ENDIF 483 XMIREE = XMIN 484 XMAREE = XMAX 485 YMIREE = YMIN 486 YMAREE = YMAX 487C 488C Coordonnees cartesiennes 489C 490 ELSE 491 IF (ISTDOUT.EQ.0) THEN 492 IF (ILANG.EQ.0) THEN 493 PRINT*,'Courbe en coordonn�es cart�siennes z=f(x,y)' 494 ELSE 495 PRINT*,'Cartesian coordinates z=f(x,y)' 496 ENDIF 497 ENDIF 498 NUMNP = 0 499 IF (IARCH.EQ.0) THEN 500 100 READ(IFAC,END=101,ERR=101) (Z(NUMNP+I),I=1,NUMNP0) 501 NUMNP = NUMNP+NUMNP0 502 GOTO 100 503 ELSE 504 200 CALL litrecbin(IFAC,IWORK,LLL,0) 505 IF (LLL.GT.0) THEN 506 DO I=1,NUMNP0 507 Z(I+NUMNP) = WORK(I) 508 ENDDO 509 NUMNP = NUMNP+NUMNP0 510 GOTO 200 511 ENDIF 512 ENDIF 513 101 NUMSD = NUMNP/NUMNP0 514 IGROUP = NUMSD 515 DO J=1,NUMY 516 YMIN = MIN(YMIN,YSU(J)) 517 YMAX = MAX(YMAX,YSU(J)) 518 ENDDO 519 DO I=1,NUMX 520 XMIN = MIN(XMIN,XSU(I)) 521 XMAX = MAX(XMAX,XSU(I)) 522 ENDDO 523 XMIREE = XMIN 524 XMAREE = XMAX 525 YMIREE = YMIN 526 YMAREE = YMAX 527 II = 0 528 DO N=1,NUMSD 529 DO I=1,NUMNP0 530 II = II+1 531 ISD(II) = N 532 ENDDO 533 ENDDO 534 IF (NUMSD.EQ.1) THEN 535 DO I=1,NUMNP 536 ZMIN = MIN(ZMIN,Z(I)) 537 ZMAX = MAX(ZMAX,Z(I)) 538 X(I) = XSU(1+MOD(I-1,NUMX)) 539 Y(I) = YSU(1+(I-1)/NUMX) 540 DEPX(I) = X(I) 541 DEPY(I) = Y(I) 542 DEPZ(I) = Z(I) 543 ENDDO 544 XMIN0 = 0. 545 XMAX0 = 0. 546 YMIN0 = 0. 547 YMAX0 = 0. 548 ELSE 549 IFRONT = -1 550 DO I=1,NUMNP0 551 XI = XSU(1+MOD(I-1,NUMX)) 552 YI = YSU(1+(I-1)/NUMX) 553 XMIMI = BIG 554 XMAMA = -BIG 555 YMIMI = BIG 556 YMAMA = -BIG 557 ZMIMI = BIG 558 ZMAMA = -BIG 559 DO K=1,NUMSD 560 II = I+(K-1)*NUMNP0 561 ZMIN = MIN(ZMIN,Z(II)) 562 ZMAX = MAX(ZMAX,Z(II)) 563 XMIMI = MIN(XMIMI,X(II)) 564 XMAMA = MAX(XMAMA,X(II)) 565 YMIMI = MIN(YMIMI,Y(II)) 566 YMAMA = MAX(YMAMA,Y(II)) 567 ZMIMI = MIN(ZMIMI,Z(II)) 568 ZMAMA = MAX(ZMAMA,Z(II)) 569 X(II) = XI 570 Y(II) = YI 571 ENDDO 572 XMIDMID = .5*(XMIMI+XMAMA) 573 YMIDMID = .5*(YMIMI+YMAMA) 574 ZMIDMID = .5*(ZMIMI+ZMAMA) 575 DO K=1,NUMSD 576 II = I+(K-1)*NUMNP0 577 DEPX(II) = X(II)-XMIDMID 578 DEPY(II) = Y(II)-YMIDMID 579 DEPZ(II) = Z(II)-ZMIDMID 580 ENDDO 581 ENDDO 582 XMIN0 = XMIDMID 583 XMAX0 = XMIDMID 584 YMIN0 = YMIDMID 585 YMAX0 = YMIDMID 586 ENDIF 587 ENDIF 588 CLOSE(IFAC) 589 ELSEIF(ICOURB.EQ.-2) THEN 590C 591C Fonction tapee au clavier z=f(x,y) 592C 593 NUMSD = 1 594 27 IF (ILANG.EQ.0) THEN 595 CALL LIENTIER('Nombre de points en X ?',0,NUMX) 596 CALL LIENTIER('Nombre de points en Y ?',0,NUMY) 597 ELSE 598 CALL LIENTIER('Number of points in the X direction ?',0,NUMX) 599 CALL LIENTIER('Number of points in the Y direction ?',0,NUMY) 600 ENDIF 601 NUMX = MAX(NUMX,3) 602 NUMY = MAX(NUMY,3) 603 IF (NUMX.GT.NXYMAX.OR.NUMY.GT.NXYMAX) THEN 604 IF (ILANG.EQ.0) THEN 605 PRINT*,'*** Trop de points dans une direction' 606 PRINT*,'*** Maximum permis :',NXYMAX 607 ELSE 608 PRINT*,'*** Too many points in one direction' 609 PRINT*,'*** Maximum allowed:',NXYMAX 610 ENDIF 611 GOTO 27 612 ENDIF 613 NUMNP = NUMX*NUMY 614 IF (NUMNP.GT.NPMAX) THEN 615 CALL TROPDEPOINTS(NUMNP,0,1) 616 GOTO 27 617 ENDIF 618 28 IF (ILANG.EQ.0) THEN 619 CALL LI2REEL1('Entrez Xmin et Xmax',0,XMIN,XMAX) 620 ELSE 621 CALL LI2REEL1('Enter Xmin and Xmax',0,XMIN,XMAX) 622 ENDIF 623 IF (XMIN.GT.XMAX) THEN 624 CALL ECHR(XMIN,XMAX) 625 ELSEIF(XMIN.EQ.XMAX) THEN 626 GOTO 28 627 ENDIF 628 IF (ILANG.EQ.0) THEN 629 CALL LI2REEL1('Entrez Ymin et Ymax',0,YMIN,YMAX) 630 ELSE 631 CALL LI2REEL1('Enter Ymin and Ymax',0,YMIN,YMAX) 632 ENDIF 633 IF (YMIN.GT.YMAX) THEN 634 CALL ECHR(YMIN,YMAX) 635 ELSEIF(YMIN.EQ.YMAX) THEN 636 GOTO 28 637 ENDIF 638 XMIREE = XMIN 639 XMAREE = XMAX 640 YMIREE = YMIN 641 YMAREE = YMAX 642 CALL INITIS(WORK,LWORK,0,0) 643 30 CONTINUE 644 IF (ILANG.EQ.0) THEN 645 PRINT*,'>>> Tapez l''expression ;', 646 &' (une seule ligne, syntaxe Fortran, variables x,y)' 647 ELSE 648 PRINT*,'>>> Type the expression ;', 649 &' (one line, Fortran syntax, variables x,y)' 650 ENDIF 651 LFON = 400 652 CALL FONINI(WORK,LFON,ICODE) 653 CALL FONDEF(WORK,CEXP,IFON,ICODE) 654 IF (ICODE.NE.0) GOTO 30 655 CALL FONDRL(LIGNE) 656 XL = XMAX-XMIN 657 YL = YMAX-YMIN 658 PASX = XL/REAL(NUMX-1) 659 PASY = YL/REAL(NUMY-1) 660 DO I=1,NUMX 661 XSU(I) = XMIN + REAL(I-1)*PASX 662 ENDDO 663 DO I=1,NUMY 664 YSU(I) = YMIN + REAL(I-1)*PASY 665 ENDDO 666 DO I=1,NUMNP 667 X(I) = XSU(1+MOD(I-1,NUMX)) 668 Y(I) = YSU(1+(I-1)/NUMX) 669 IREF(I) = 0 670 IREF3(I) = 0 671 IBLOQ(I) = 0 672 CALL FON2RR(WORK,IFON,X(I),Y(I),Z(I),ICODE) 673 ZMIN = MIN(ZMIN,Z(I)) 674 ZMAX = MAX(ZMAX,Z(I)) 675 DEPX(I) = X(I) 676 DEPY(I) = Y(I) 677 DEPZ(I) = Z(I) 678 ENDDO 679 XMIN0 = 0. 680 XMAX0 = 0. 681 YMIN0 = 0. 682 YMAX0 = 0. 683 ILEG = 1 684 ICTLEG = 7 685 LEG(1:LMOELLE) = MOELLE(1:LMOELLE) 686 LONLEG = LMOELLE 687 IF (LONLEG.GT.50) FACLEG = .45/.65 688 ELSEIF(ICOURB.EQ.-3) THEN 689C 690C Fonction parametree tapee au clavier 691C 692 NUMSD = 1 693 37 IF (ILANG.EQ.0) THEN 694 CALL LIENTIER('Nombre de points en U ?',0,NUMX) 695 CALL LIENTIER('Nombre de points en V ?',0,NUMY) 696 ELSE 697 CALL LIENTIER('Number of points along U ?',0,NUMX) 698 CALL LIENTIER('Number of points along V ?',0,NUMY) 699 ENDIF 700 NUMX = MAX(NUMX,3) 701 NUMY = MAX(NUMY,3) 702 IF (NUMX.GT.NXYMAX.OR.NUMY.GT.NXYMAX) THEN 703 IF (ILANG.EQ.0) THEN 704 PRINT*,'*** Trop de points dans une direction' 705 PRINT*,'*** Maximum permis :',NXYMAX 706 ELSE 707 PRINT*,'*** Too many points in one direction' 708 PRINT*,'*** Maximum allowed :',NXYMAX 709 ENDIF 710 GOTO 37 711 ENDIF 712 NUMNP = NUMX*NUMY 713 IF (NUMNP.GT.NPMAX) THEN 714 CALL TROPDEPOINTS(NUMNP,0,1) 715 GOTO 37 716 ENDIF 717 38 IF (ILANG.EQ.0) THEN 718 CALL LI2REEL1('Entrez Umin et Umax',0,UMIN,UMAX) 719 ELSE 720 CALL LI2REEL1('Enter Umin and Umax',0,UMIN,UMAX) 721 ENDIF 722 IF (UMIN.GT.UMAX) THEN 723 CALL ECHR(UMIN,UMAX) 724 ELSEIF(UMIN.EQ.UMAX) THEN 725 GOTO 38 726 ENDIF 727 IF (ILANG.EQ.0) THEN 728 CALL LI2REEL1('Entrez Vmin et Vmax',0,VMIN,VMAX) 729 ELSE 730 CALL LI2REEL1('Enter Vmin and Vmax',0,VMIN,VMAX) 731 ENDIF 732 IF (VMIN.GT.VMAX) THEN 733 CALL ECHR(VMIN,VMAX) 734 ELSEIF(VMIN.EQ.VMAX) THEN 735 GOTO 38 736 ENDIF 737 XMIREE = XMIN 738 XMAREE = XMAX 739 YMIREE = YMIN 740 YMAREE = YMAX 741 CALL INITIS(WORK,LWORK,0,0) 742 LFON = 400 743 UL = UMAX-UMIN 744 VL = VMAX-VMIN 745 PASU = UL/REAL(NUMX-1) 746 PASV = VL/REAL(NUMY-1) 747 DO I=1,NUMX 748 UUU(I) = UMIN + REAL(I-1)*PASU 749 ENDDO 750 DO I=1,NUMY 751 VVV(I) = VMIN + REAL(I-1)*PASV 752 ENDDO 753 IIII = 0 754 40 IIII = IIII+1 755 IF (ILANG.EQ.0) THEN 756 IF (IIII.EQ.1) THEN 757 PRINT*,'>>> Tapez l''expression de X ;', 758 & ' (une seule ligne, syntaxe Fortran)' 759 ELSEIF(IIII.EQ.2) THEN 760 PRINT*,'>>> Tapez l''expression de Y ;', 761 & ' (une seule ligne, syntaxe Fortran)' 762 ELSE 763 PRINT*,'>>> Tapez l''expression de Z ;', 764 & ' (une seule ligne, syntaxe Fortran)' 765 ENDIF 766 ELSE 767 IF (IIII.EQ.1) THEN 768 PRINT*,'>>> Type the expression for X ;', 769 & ' (one ligne, Fortran syntax)' 770 ELSEIF(IIII.EQ.2) THEN 771 PRINT*,'>>> Type the expression for Y ;', 772 & ' (one ligne, Fortran syntax)' 773 ELSE 774 PRINT*,'>>> Type the expression for Z ;', 775 & ' (one ligne, Fortran syntax)' 776 ENDIF 777 ENDIF 778 CALL FONINI(WORK,LFON,ICODE) 779 CALL FONDEF(WORK,CEXP,IFON,ICODE) 780 IF (ICODE.NE.0) GOTO 40 781 CALL FONDRL(LIGNE) 782 IF (IIII.EQ.1) THEN 783 DO I=1,NUMNP 784 IREF(I) = 0 785 IREF3(I) = 0 786 IBLOQ(I) = 0 787 CALL FON2RR(WORK,IFON 788 & ,UUU(1+MOD(I-1,NUMX)),VVV(1+(I-1)/NUMX),X(I),ICODE) 789 XMIN = MIN(XMIN,X(I)) 790 XMAX = MAX(XMAX,X(I)) 791 DEPX(I) = X(I) 792 ENDDO 793 GOTO 40 794 ELSEIF(IIII.EQ.2) THEN 795 DO I=1,NUMNP 796 IREF(I) = 0 797 IREF3(I) = 0 798 IBLOQ(I) = 0 799 CALL FON2RR(WORK,IFON 800 & ,UUU(1+MOD(I-1,NUMX)),VVV(1+(I-1)/NUMX),Y(I),ICODE) 801 YMIN = MIN(YMIN,Y(I)) 802 YMAX = MAX(YMAX,Y(I)) 803 DEPY(I) = Y(I) 804 ENDDO 805 GOTO 40 806 ELSE 807 DO I=1,NUMNP 808 IREF(I) = 0 809 IREF3(I) = 0 810 IBLOQ(I) = 0 811 CALL FON2RR(WORK,IFON 812 & ,UUU(1+MOD(I-1,NUMX)),VVV(1+(I-1)/NUMX),Z(I),ICODE) 813 ZMIN = MIN(ZMIN,Z(I)) 814 ZMAX = MAX(ZMAX,Z(I)) 815 DEPZ(I) = Z(I) 816 ENDDO 817 ENDIF 818 XMIN0 = 0. 819 XMAX0 = 0. 820 YMIN0 = 0. 821 YMAX0 = 0. 822c ILEG = 1 823c ICTLEG = 7 824c LEG(1:LMOELLE) = MOELLE(1:LMOELLE) 825c LONLEG = LMOELLE 826C 827C Bitmap (pbm - dithered, ou pgm - niveaux de gris) 828C 829 ELSEIF(ICOURB.EQ.-4) THEN 830 NBCOM = 0 831 3232 READ(IFAC,'(A1)') HED(3:3) 832 IF (HED(3:3).EQ.'#') THEN 833 NBCOM = NBCOM+1 834 GOTO 3232 835 ELSE 836 BACKSPACE(IFAC) 837 ENDIF 838 IF (IPBM.NE.0) THEN 839 READ(IFAC,*) NUMX,NUMY 840 MAXVAL = 0 841 ELSE 842 READ(IFAC,*) NUMX,NUMY,MAXVAL 843 ENDIF 844 NUMNP = NUMX*NUMY 845 IF (NUMX.GT.NXYMAX.OR.NUMY.GT.NXYMAX) THEN 846 IF (ILANG.EQ.0) THEN 847 PRINT*, 848 & '*** Votre fichier comprend',NUMX,' x',NUMY,' points' 849 PRINT*,'*** Alors que le maximum permis est',NXYMAX 850 ELSE 851 PRINT*, 852 & '*** Your file contains',NUMX,' x',NUMY,' points' 853 PRINT*,'*** Maximum allowed =',NXYMAX 854 ENDIF 855 STOP 856 ENDIF 857 IF (NUMNP.GT.NPMAX) CALL TROPDEPOINTS(NUMNP,0,0) 858 IF (ISTDOUT.EQ.0) THEN 859 IF (ILANG.EQ.0) THEN 860 PRINT*,'Fichier Bitmap' 861 ELSE 862 PRINT*,'Bitmap file' 863 ENDIF 864 ENDIF 865C 866C Raw 867C 868 IF (IPBM.EQ.2.OR.IPGM.EQ.2) THEN 869 CLOSE(IFAC) 870 NBCOM = NBCOM+4 871 IF (NBCOM.LT.10) THEN 872 WRITE(CEXP(1:6),'(2H +,I1,3H )') NBCOM 873 ELSEIF(NBCOM.LT.100) THEN 874 WRITE(CEXP(1:6),'(2H +,I2,2H )') NBCOM 875 ELSE 876 WRITE(CEXP(1:6),'(2H +,I3,1H )') NBCOM 877 ENDIF 878 PRINT*, 879 & 'tail'//CEXP(1:6)//NOM_FICH(1:LONG)//'> /tmp/bidonbidon' 880 CALL EXEC( 881 & 'tail'//CEXP(1:6)//NOM_FICH(1:LONG)//'> /tmp/bidonbidon') 882 CALL ouvrebin(IFAC,'/tmp/bidonbidon'//CHAR(0),0,IRC) 883C Raw pbm 884 IF (IPBM.EQ.2) THEN 885 IF (MOD(NUMNP,8).EQ.0) THEN 886 N = NUMNP/8 887 ELSE 888 N = 1+NUMNP/8 889 ENDIF 890 CALL litduncoup(IFAC,CWORK,N) 891 NN = 0 892 DO I=1,N 893 K = ICHAR(CWORK(I)) 894 DO J=8,1,-1 895 Z(NN+J) = MOD(K,2) 896 K = K/2 897 ENDDO 898 NN = NN+8 899 ENDDO 900C Raw pgm 901 ELSEIF(IPGM.EQ.2) THEN 902 IF (MAXVAL.LT.256) THEN 903 CALL litduncoup(IFAC,CWORK,NUMNP) 904 DO I=1,NUMNP 905 Z(I) = ICHAR(CWORK(I)) 906 ENDDO 907 ELSE 908 CALL litduncoup(IFAC,CWORK,2*NUMNP) 909 DO I=1,NUMNP 910 II = 2*I-1 911 Z(I) = 256*ICHAR(CWORK(II)) + ICHAR(CWORK(II+2)) 912 ENDDO 913 ENDIF 914 ENDIF 915 CALL fermebin(IFAC) 916 CALL EXEC('/bin/rm -f /tmp/bidonbidon') 917 ELSE 918 READ(IFAC,*) (Z(I),I=1,NUMNP) 919 ENDIF 920 XMIN = 0. 921 YMIN = 0. 922 DX = 1. 923 DY = 1. 924 IF (IPBM.NE.2.AND.IPGM.NE.2) THEN 925 READ(IFAC,*,ERR=3131,END=3131) XMIN,DX,YMIN,DY 926 3131 CLOSE(IFAC) 927 ENDIF 928 XMAX = XMIN+DX*REAL(NUMX-1) 929 YMAX = YMIN+DY*REAL(NUMY-1) 930 XMIREE = XMIN 931 XMAREE = XMAX 932 YMIREE = YMIN 933 YMAREE = YMAX 934 DO I=1,NUMX 935 XSU(I) = XMIN+DX*REAL(I-1) 936 ENDDO 937 DO I=1,NUMY 938 YSU(I) = YMIN+DY*REAL(I-1) 939 ENDDO 940 ZMIN = BIG 941 ZMAX = -BIG 942 NN = (NUMY/2)*NUMX 943 DO I=1,NUMNP 944 IF (I.LE.NN) THEN 945 P = 1 + MOD(I-1,NUMX) 946 Q = 1 + (I-1)/NUMX 947 II = (NUMY-Q)*NUMX + P 948 CALL ECHR(Z(I),Z(II)) 949 ENDIF 950 ZMIN = MIN(ZMIN,Z(I)) 951 ZMAX = MAX(ZMAX,Z(I)) 952 X(I) = XSU(1+MOD(I-1,NUMX)) 953 Y(I) = YSU(1+(I-1)/NUMX) 954 IREF(I) = 0 955 IREF3(I) = 0 956 IBLOQ(I) = 0 957 DEPX(I) = X(I) 958 DEPY(I) = Y(I) 959 DEPZ(I) = Z(I) 960 ENDDO 961 XMIN0 = 0. 962 XMAX0 = 0. 963 YMIN0 = 0. 964 YMAX0 = 0. 965 I2D = 0 966 NUMSD = 1 967 ELSEIF(ICOURB.EQ.-5) THEN 968C 969C Fichier de points xyz (generation d'un maillage Delaunay -> nappe) 970C ou bien courbe (1d) dans l'espace si le fichier commence par #+ 971C ou bien succession de //l�l�pip�des si le fichier commence par #< 972C 973 3333 READ(IFAC,'(A2)') HED(1:2) 974 IF (HED(1:1).EQ.'#') THEN 975 IF (HED(2:2).EQ.'+') ICOURXYZ = 1 976 IF (HED(2:2).EQ.'<') THEN 977 ICOURXYZ = 2 978 BACKSPACE(IFAC) 979 READ(IFAC,'(A80)') HED 980 CALL ENLEVE_TOUS_BLANCS(HED(3:80),L,78) 981 IF (L.GT.0) THEN 982 READ(HED(3:L+2),*) DCUBEX,DCUBEY,DCUBEZ 983 print*,DCUBEX,DCUBEY,DCUBEZ 984 ELSE 985 DCUBEX = 0. 986 DCUBEY = 0. 987 DCUBEZ = 0. 988 ENDIF 989 ENDIF 990 GOTO 3333 991 ELSE 992 BACKSPACE(IFAC) 993 ENDIF 994 NUMNP = 0 995 XMIN = BIG 996 XMAX = -BIG 997 YMIN = BIG 998 YMAX = -BIG 999 ZMIN = BIG 1000 ZMAX = -BIG 1001 IF (ICOURXYZ.EQ.2) THEN 1002 NPMAX2 = MIN(NFMAX/6,NPMAX/8) 1003 I = 1 1004 DO J=1,NPMAX2 1005 READ(IFAC,*,END=3335,ERR=3335) X(I),Y(I),Z(I) 1006 XMIN = MIN(XMIN,X(I)) 1007 XMAX = MAX(XMAX,X(I)) 1008 YMIN = MIN(YMIN,Y(I)) 1009 YMAX = MAX(YMAX,Y(I)) 1010 ZMIN = MIN(ZMIN,Z(I)) 1011 ZMAX = MAX(ZMAX,Z(I)) 1012 IREF(I) = 0 1013 IREF3(I) = 0 1014 IBLOQ(I) = 0 1015 DEPX(I) = X(I) 1016 DEPY(I) = Y(I) 1017 DEPZ(I) = Z(I) 1018 NUMNP = NUMNP+1 1019 I = I+8 1020 ENDDO 1021 3335 IF (DCUBEX.LE.0.) THEN 1022 NX = MAX(NINT(REAL(NUMNP)**(0.3333)),3) 1023 DCUBEX = (XMAX-XMIN)/REAL(NX) 1024 DCUBEY = (YMAX-YMIN)/REAL(NX) 1025 DCUBEZ = (ZMAX-ZMIN)/REAL(NX) 1026 ENDIF 1027 DCUBEX2 = 0.5*DCUBEX 1028 DCUBEY2 = 0.5*DCUBEY 1029 DCUBEZ2 = 0.5*DCUBEZ 1030 DO I=1,NUMNP 1031 J = 8*I-7 1032 X(J) = X(J)-DCUBEX2 1033 Y(J) = Y(J)-DCUBEY2 1034 Z(J) = Z(J)-DCUBEZ2 1035C 1036 X(J+1) = X(J)+DCUBEX 1037 X(J+2) = X(J)+DCUBEX 1038 X(J+3) = X(J) 1039 X(J+4) = X(J) 1040 X(J+5) = X(J+1) 1041 X(J+6) = X(J+2) 1042 X(J+7) = X(J+3) 1043C 1044 Y(J+1) = Y(J) 1045 Y(J+2) = Y(J)+DCUBEY 1046 Y(J+3) = Y(J)+DCUBEY 1047 Y(J+4) = Y(J) 1048 Y(J+5) = Y(J+1) 1049 Y(J+6) = Y(J+2) 1050 Y(J+7) = Y(J+3) 1051C 1052 Z(J+1) = Z(J) 1053 Z(J+2) = Z(J) 1054 Z(J+3) = Z(J) 1055 Z(J+4) = Z(J)+DCUBEZ 1056 Z(J+5) = Z(J)+DCUBEZ 1057 Z(J+6) = Z(J)+DCUBEZ 1058 Z(J+7) = Z(J)+DCUBEZ 1059C 1060 DEPX(J) = -DCUBEX2 1061 DEPY(J) = -DCUBEY2 1062 DEPZ(J) = -DCUBEZ2 1063 DEPX(J+1) = DCUBEX2 1064 DEPY(J+1) = -DCUBEY2 1065 DEPZ(J+1) = -DCUBEZ2 1066 DEPX(J+2) = DCUBEX2 1067 DEPY(J+2) = DCUBEY2 1068 DEPZ(J+2) = -DCUBEZ2 1069 DEPX(J+3) = -DCUBEX2 1070 DEPY(J+2) = DCUBEY2 1071 DEPZ(J+2) = -DCUBEZ2 1072 DEPX(J+4) = -DCUBEX2 1073 DEPY(J+4) = -DCUBEY2 1074 DEPZ(J+4) = DCUBEZ2 1075 DEPX(J+5) = DCUBEX2 1076 DEPY(J+5) = -DCUBEY2 1077 DEPZ(J+5) = DCUBEZ2 1078 DEPX(J+6) = DCUBEX2 1079 DEPY(J+6) = DCUBEY2 1080 DEPZ(J+6) = DCUBEZ2 1081 DEPX(J+7) = -DCUBEX2 1082 DEPY(J+7) = DCUBEY2 1083 DEPZ(J+7) = DCUBEZ2 1084 ENDDO 1085 XMIN = XMIN-DCUBEX2 1086 XMAX = XMAX+DCUBEX2 1087 YMIN = YMIN-DCUBEY2 1088 YMAX = YMAX+DCUBEZ2 1089 ZMIN = ZMIN-DCUBEZ2 1090 ZMAX = ZMAX+DCUBEZ2 1091 ELSE 1092 NPMAX2 = MIN(NFMAX/2,NPMAX) 1093cc? 7/07 NPMAX2 = MIN(1+NFMAX/2,NPMAX) 1094 DO I=1,NPMAX2 1095 READ(IFAC,*,END=3334,ERR=3334) X(I),Y(I),Z(I) 1096 XMIN = MIN(XMIN,X(I)) 1097 XMAX = MAX(XMAX,X(I)) 1098 YMIN = MIN(YMIN,Y(I)) 1099 YMAX = MAX(YMAX,Y(I)) 1100 ZMIN = MIN(ZMIN,Z(I)) 1101 ZMAX = MAX(ZMAX,Z(I)) 1102 IREF(I) = 0 1103 IREF3(I) = 0 1104 IBLOQ(I) = 0 1105 DEPX(I) = X(I) 1106 DEPY(I) = Y(I) 1107 DEPZ(I) = Z(I) 1108 NUMNP = NUMNP+1 1109 ENDDO 1110 ENDIF 1111 3334 XMIN0 = 0. 1112 XMAX0 = 0. 1113 YMIN0 = 0. 1114 YMAX0 = 0. 1115 CLOSE(IFAC) 1116 I2D = 0 1117 NUMSD = 1 1118 IF (ISTDOUT.EQ.0) THEN 1119 IF (ILANG.EQ.0) THEN 1120 PRINT*,NUMNP,' points lus' 1121 ELSE 1122 PRINT*,NUMNP,' points red' 1123 ENDIF 1124 ENDIF 1125 IF (ICOURXYZ.EQ.2) NUMNP = NUMNP*8 1126 IF (NUMNP.EQ.NPMAX2) THEN 1127 IF (ISTDOUT.EQ.0) THEN 1128 IF (ILANG.EQ.0) THEN 1129 PRINT*, 1130 & '*** ATTENTION on n''a peut-�tre pas lu tout le fichier :' 1131 PRINT*,'*** Nombre maximal de points NPMAX2 =',NPMAX2 1132 ELSE 1133 PRINT*, 1134 & '*** WARNING the file may be truncated:' 1135 PRINT*,'*** Maximal number of points NPMAX2 =',NPMAX2 1136 ENDIF 1137 ENDIF 1138 ENDIF 1139C 1140 IF (ILOGX.NE.0) THEN 1141 IF (XMIN.GT.0.) THEN 1142 DO I=1,NUMNP 1143 X(I) = LOG10(X(I)) 1144 DEPX(I) = X(I) 1145 ENDDO 1146 XMIN = LOG10(XMIN) 1147 XMAX = LOG10(XMAX) 1148 ELSE 1149 IF (ILANG.EQ.0) THEN 1150 PRINT*,'*** Echelle Logarithmique en x impossible' 1151 ELSE 1152 PRINT*,'*** Logarithmic scale in x impossible' 1153 ENDIF 1154 ILOGX = 0 1155 ENDIF 1156 ENDIF 1157 IF (ILOGY.NE.0) THEN 1158 IF (YMIN.GT.0.) THEN 1159 DO I=1,NUMNP 1160 Y(I) = LOG10(Y(I)) 1161 DEPY(I) = Y(I) 1162 ENDDO 1163 YMIN = LOG10(YMIN) 1164 YMAX = LOG10(YMAX) 1165 ELSE 1166 IF (ILANG.EQ.0) THEN 1167 PRINT*,'*** Echelle Logarithmique en y impossible' 1168 ELSE 1169 PRINT*,'*** Logarithmic scale in y impossible' 1170 ENDIF 1171 ILOGY = 0 1172 ENDIF 1173 ENDIF 1174 IF (ILOGZ.NE.0) THEN 1175 IF (ZMIN.GT.0.) THEN 1176 DO I=1,NUMNP 1177 Z(I) = LOG10(Z(I)) 1178 DEPZ(I) = Z(I) 1179 ENDDO 1180 ZMIN = LOG10(ZMIN) 1181 ZMAX = LOG10(ZMAX) 1182 ELSE 1183 IF (ILANG.EQ.0) THEN 1184 PRINT*,'*** Echelle Logarithmique en z impossible' 1185 ELSE 1186 PRINT*,'*** Logarithmic scale in z impossible' 1187 ENDIF 1188 ILOGZ = 0 1189 ENDIF 1190 ENDIF 1191C 1192 IF (ICOURXYZ.EQ.0) THEN 1193 CALL TEMPS(T1,I) 1194 CALL DELAUN2(X,Y,NUMNP,NELDEL,XF,YF,ITAB,NTET,IORDRE,VITF 1195 & ,ICLAS,ILANG) 1196 CALL TEMPS(T2,I) 1197 IF (ISTDOUT.EQ.0) THEN 1198 IF (ILANG.EQ.0) THEN 1199 PRINT*,NELDEL,' triangles g�n�r�s en',REAL(T2-T1),' s' 1200 ELSE 1201 PRINT*,NELDEL,' triangles generated in',REAL(T2-T1),' s' 1202 ENDIF 1203 ENDIF 1204 ELSEIF(ICOURXYZ.EQ.1) THEN 1205 NELDEL = NUMNP-1 1206 DO I=1,NELDEL 1207 ICLAS(1,I) = I 1208 ICLAS(2,I) = I+1 1209 ICLAS(3,I) = I+1 1210 ICLAS(4,I) = 0 1211 ICLAS(5,I) = 0 1212 ICLAS(6,I) = 0 1213 ICLAS(7,I) = 0 1214 ENDDO 1215 ELSEIF(ICOURXYZ.EQ.2) THEN 1216 DO I=1,NUMNP 1217 IREF(I) = 0 1218 IREF3(I) = 0 1219 IBLOQ(I) = 0 1220 ENDDO 1221 ENDIF 1222 IF (ISTDOUT.EQ.0) THEN 1223 IF (ILANG.EQ.0) THEN 1224 PRINT*,'Dimensions du domaine :' 1225 & ,XMAX-XMIN,' x',YMAX-YMIN,' x',ZMAX-ZMIN 1226 ELSE 1227 PRINT*,'Domain dimensions:' 1228 & ,XMAX-XMIN,' x',YMAX-YMIN,' x',ZMAX-ZMIN 1229 ENDIF 1230 ENDIF 1231 ENDIF 1232C 1233C Changement d'origine 1234C 1235 IF (IEXAG.NE.0) THEN 1236 DEPXM = -BIG 1237 DEPYM = -BIG 1238 DEPZM = -BIG 1239 XMINREF = BIG 1240 XMAXREF = -BIG 1241 YMINREF = BIG 1242 YMAXREF = -BIG 1243 ZMINREF = BIG 1244 ZMAXREF = -BIG 1245 DO I=1,NUMNP 1246 DEPXM = MAX(DEPXM,ABS(DEPX(I))) 1247 DEPYM = MAX(DEPYM,ABS(DEPY(I))) 1248 DEPZM = MAX(DEPZM,ABS(DEPZ(I))) 1249 XMINREF = AMIN1(XMINREF,X(I)-FACEXA*DEPX(I)) 1250 XMAXREF = AMAX1(XMAXREF,X(I)-FACEXA*DEPX(I)) 1251 YMINREF = AMIN1(YMINREF,Y(I)-FACEXA*DEPY(I)) 1252 YMAXREF = AMAX1(YMAXREF,Y(I)-FACEXA*DEPY(I)) 1253 ZMINREF = AMIN1(ZMINREF,Z(I)-FACEXA*DEPZ(I)) 1254 ZMAXREF = AMAX1(ZMAXREF,Z(I)-FACEXA*DEPZ(I)) 1255 ENDDO 1256 ELSE 1257 DEPXM = 0. 1258 DEPYM = 0. 1259 DEPZM = 0. 1260 XMINREF = XMIN 1261 XMAXREF = XMAX 1262 YMINREF = YMIN 1263 YMAXREF = YMAX 1264 ZMINREF = ZMIN 1265 ZMAXREF = ZMAX 1266 ENDIF 1267 DEPMAX = MAX(DEPXM,DEPYM,DEPZM) 1268 DIMMAXXREF = XMAXREF-XMINREF 1269 DIMMAXYREF = YMAXREF-YMINREF 1270 DIMMAXZREF = ZMAXREF-ZMINREF 1271 DIMMAXREF = MAX(DIMMAXXREF,DIMMAXYREF,DIMMAXZREF) 1272C 1273 IF (XINIT_FACT.EQ.311263..AND.DEPMAX.GT.0.) THEN 1274 CONSEIL = 0.3*DIMMAXREF/DEPMAX 1275 DFAC = CONSEIL-FACEXA 1276 FACEXA = CONSEIL 1277 XMIN = BIG 1278 XMAX = -BIG 1279 YMIN = BIG 1280 YMAX = -BIG 1281 ZMIN = BIG 1282 ZMAX = -BIG 1283 DO N=1,NUMNP 1284 X(N) = X(N) + DFAC*DEPX(N) 1285 Y(N) = Y(N) + DFAC*DEPY(N) 1286 Z(N) = Z(N) + DFAC*DEPZ(N) 1287 XMIN = AMIN1(XMIN,X(N)) 1288 XMAX = AMAX1(XMAX,X(N)) 1289 YMIN = AMIN1(YMIN,Y(N)) 1290 YMAX = AMAX1(YMAX,Y(N)) 1291 ZMIN = AMIN1(ZMIN,Z(N)) 1292 ZMAX = AMAX1(ZMAX,Z(N)) 1293 ENDDO 1294 ELSE 1295 ITOUCHEX = 0 1296 ENDIF 1297C 1298 DIMMAXX = XMAX-XMIN 1299 DIMMAXY = YMAX-YMIN 1300 DIMMAXZ = ZMAX-ZMIN 1301 DIMMAX = MAX(DIMMAXX,DIMMAXY,DIMMAXZ) 1302C 1303 IF (ZMIN.EQ.ZMAX.AND.ICOURB.NE.-5) THEN 1304 I2D = 1 1305 DIM1 = DIMMAXX 1306 DIM2 = DIMMAXY 1307 DIM1REF = DIMMAXXREF 1308 DIM2REF = DIMMAXYREF 1309 ELSEIF(YMIN.EQ.YMAX) THEN 1310 I2D = 3 1311 DIM1 = DIMMAXX 1312 DIM2 = DIMMAXZ 1313 DIM1REF = DIMMAXXREF 1314 DIM2REF = DIMMAXZREF 1315 ELSEIF(XMIN.EQ.XMAX) THEN 1316 I2D = 2 1317 DIM1 = DIMMAXY 1318 DIM2 = DIMMAXZ 1319 DIM1REF = DIMMAXYREF 1320 DIM2REF = DIMMAXZREF 1321 ELSEIF(ICOURB.NE.-5) THEN 1322 I2D = 0 1323 IF (ISTDOUT.EQ.0) THEN 1324 IF (DEPMAX.EQ.0.) THEN 1325 IF (ILANG.EQ.0) THEN 1326 PRINT*,'Dimensions du domaine :' 1327 & ,DIMMAXX,' x',DIMMAXY,' x',DIMMAXZ 1328 ELSE 1329 PRINT*,'Domain dimensions:' 1330 & ,DIMMAXX,' x',DIMMAXY,' x',DIMMAXZ 1331 ENDIF 1332 ELSE 1333 IF (ILANG.EQ.0) THEN 1334 PRINT*,'Dimensions du domaine de r�f�rence :' 1335 & ,DIMMAXXREF,' x',DIMMAXYREF,' x',DIMMAXZREF 1336 PRINT*,'Dimensions du domaine d�form� : ' 1337 & ,DIMMAXX,' x',DIMMAXY,' x',DIMMAXZ 1338 ELSE 1339 PRINT*,'Reference domain dimensions:' 1340 & ,DIMMAXXREF,' x',DIMMAXYREF,' x',DIMMAXZREF 1341 PRINT*,'Deformed domain dimensions: ' 1342 & ,DIMMAXX,' x',DIMMAXY,' x',DIMMAXZ 1343 ENDIF 1344 ENDIF 1345 ENDIF 1346 ENDIF 1347C 1348 IF (IFIX.LT.0) THEN 1349 IF (I2D.EQ.0) THEN 1350 IFIX = 0 1351 ELSE 1352 IFIX = -IFIX 1353 ENDIF 1354 ENDIF 1355C 1356 IF (I2D.NE.0) THEN 1357 IF (ISTDOUT.EQ.0) THEN 1358 IF (DEPMAX.EQ.0.) THEN 1359 IF (ILANG.EQ.0) THEN 1360 PRINT*,'Dimensions du domaine :',DIM1,' x',DIM2 1361 ELSE 1362 PRINT*,'Domain dimensions:',DIM1,' x',DIM2 1363 ENDIF 1364 ELSE 1365 IF (ILANG.EQ.0) THEN 1366 PRINT*,'Dimensions du domaine de r�f�rence :' 1367 & ,DIM1REF,' x',DIM2REF 1368 PRINT*,'Dimensions du domaine d�form� : ' 1369 & ,DIM1,' x',DIM2 1370 ELSE 1371 PRINT*,'Reference domain dimensions:' 1372 & ,DIM1REF,' x',DIM2REF 1373 PRINT*,'Deformed domain dimensions: ' 1374 & ,DIM1,' x',DIM2 1375 ENDIF 1376 ENDIF 1377 ENDIF 1378 ENDIF 1379C 1380 IF (IPS2D.NE.0.OR.I2D.NE.0) THEN 1381 DO I=1,NUMNP 1382 JJJ = IBLOQ(I)/100 1383 KKK = MOD(IBLOQ(I),100) 1384 III = KKK/8 1385 IF (III.NE.0) III = 1 1386 IBLOQ(I) = 100*JJJ + 8*III + MOD(KKK,4) 1387 ENDDO 1388 ENDIF 1389 IF (I2D.EQ.0) THEN 1390 IF (ICOURB.GT.0) THEN 1391 IBORD = 1 1392 ELSEIF(ICOURB.EQ.-4) THEN 1393 IBORD = -1 1394 ICOURB = -1 1395 ELSE 1396 IBORD = 0 1397 ENDIF 1398 ELSE 1399 IFC = -1 1400 IBORD = 0 1401 ENDIF 1402C 1403 IFBLO = 0 1404 DO I=1,NUMNP 1405 IFBLO = MAX(IFBLO,IBLOQ(I)) 1406 ENDDO 1407C 1408 CALL ARONDI(XMIN,XMAX,XECH,PROPX,NECHX,NBECH) 1409 CALL ARONDI(YMIN,YMAX,YECH,PROPY,NECHY,NBECH) 1410 CALL ARONDI(ZMIN,ZMAX,ZECH,PROPZ,NECHZ,NBECH) 1411 IF (ICOURB.LT.0) THEN 1412 TOTO = MIN((XMAX-XMIN),(YMAX-YMIN),(ZMAX-ZMIN)) 1413 EXAX0 = TOTO/(XMAX-XMIN) 1414 EXAY0 = TOTO/(YMAX-YMIN) 1415 EXAZ0 = TOTO/(ZMAX-ZMIN) 1416 EXAX00 = 1. 1417 EXAY00 = 1. 1418 EXAZ00 = 1. 1419 ENDIF 1420 XMED2= XMIN+XMAX 1421 YMED2= YMIN+YMAX 1422 XMED = .5*XMED2 1423 YMED = .5*YMED2 1424 ZMED = .5*(ZMIN+ZMAX) 1425 XMED0 = XMED 1426 YMED0 = YMED 1427 ZMED0 = ZMED 1428 BX = (XMAX-XMIN)*.5 1429 BY = (YMAX-YMIN)*.5 1430 BZ = (ZMAX-ZMIN)*.5 1431 IF (ICOURXYZ.NE.0) THEN 1432 BX = BX*1.2 1433 BY = BY*1.2 1434 BZ = BZ*1.2 1435 ENDIF 1436 BNOR = SQRT(BX**2+BY**2+BZ**2) 1437 BX0 = BX 1438 BY0 = BY 1439 BZ0 = BZ 1440 XCCOR = XCCOR-XMED 1441 YCCOR = YCCOR-YMED 1442 ZCCOR = ZCCOR-ZMED 1443C 1444 ISYM = 4 1445 TOL = 1.E-5 1446 EPSX = TOL*(XMAXREF-XMINREF) 1447 EPSY = TOL*(YMAXREF-YMINREF) 1448 IF (YMINREF.GT.-EPSY) THEN 1449 IF (XMINREF.GT.-EPSX) THEN 1450 IDEMI = 0 1451C 1452C symetries .ne. 4 1453C 1454 IF (HED(77:78).EQ.'#S') THEN 1455 READ(HED(79:80),FMT='(I2)',ERR=3737) II 1456 IF (II.GT.1.AND.MOD(II,2).EQ.0) ISYM = II 1457 3737 CONTINUE 1458 ENDIF 1459 ELSE 1460 IDEMI = 1 1461 ENDIF 1462 ELSE 1463 IF (XMINREF.GT.-EPSX) THEN 1464 IDEMI = 2 1465 ELSE 1466 IDEMI = 3 1467 ENDIF 1468 ENDIF 1469C 1470 IF (ISYM.EQ.4) THEN 1471 DIRX = 1. 1472 DIRY = 0. 1473 ELSE 1474 DIRX = SIN(PI/REAL(ISYM/2)) 1475 DIRY = COS(PI/REAL(ISYM/2)) 1476 IF (ISYM.EQ.6) THEN 1477 XMINS = BIG 1478 XMAXS = -BIG 1479 YMINS = BIG 1480 YMAXS = -BIG 1481 XMINR = BIG 1482 XMAXR = -BIG 1483 YMINR = BIG 1484 YMAXR = -BIG 1485 DO N=1,NUMNP 1486 XS = DIRX*Y(N) - DIRY*X(N) 1487 YS = DIRX*X(N) + DIRY*Y(N) 1488 XR = DIRX*X(N) - DIRY*Y(N) 1489 YR = DIRX*Y(N) + DIRY*X(N) 1490 XMINS = MIN(XMINS,XS) 1491 XMAXS = MAX(XMAXS,XS) 1492 YMINS = MIN(YMINS,YS) 1493 YMAXS = MAX(YMAXS,YS) 1494 XMINR = MIN(XMINR,XR) 1495 XMAXR = MAX(XMAXR,XR) 1496 YMINR = MIN(YMINR,YR) 1497 YMAXR = MAX(YMAXR,YR) 1498 ENDDO 1499 BXSYM = (XMAXS-XMINS)*0.5 1500 BYSYM = (YMAXS-YMINS)*0.5 1501 ENDIF 1502 ENDIF 1503 DO N=1,NUMNP 1504 IF (ABS(Y(N)).LT.EPSY) THEN 1505 IF (ABS(X(N)).LT.EPSX) THEN 1506 IPLAN(N) = 3 1507 ELSE 1508 IPLAN(N) = 1 1509 ENDIF 1510 ELSEIF(EGAL(DIRX*X(N),DIRY*Y(N))) THEN 1511 IPLAN(N) = 2 1512 ELSE 1513 IPLAN(N) = 0 1514 ENDIF 1515 X(N) = X(N)-XMED 1516 Y(N) = Y(N)-YMED 1517 Z(N) = Z(N)-ZMED 1518 ENDDO 1519 XORIG = -XMED 1520 YORIG = -YMED 1521 ZORIG = -ZMED 1522C 1523 DIST0 = SQRT((XMAX-XMIN)**2+(YMAX-YMIN)**2+(ZMAX-ZMIN)**2) 1524 DIST = DIST0 1525 XPUP(1) = DIST 1526 XPUP(2) = DIST 1527 XPUP(3) = DIST 1528 IF (MATMIN.NE.MATMAX 1529 &.AND.MATMIN.NE.9999.AND.MATMAX.NE.-9999) THEN 1530 IF (ISTDOUT.EQ.0) THEN 1531 IF (ILANG.EQ.0) THEN 1532 PRINT*,'Mat�riaux entre',MATMIN,' et',MATMAX 1533 ELSE 1534 PRINT*,'Material numbers between',MATMIN,' and',MATMAX 1535 ENDIF 1536 ENDIF 1537 IFLAG3 = 1 1538 ELSE 1539 IFLAG3 = 0 1540 ENDIF 1541C 1542 IF (ICOURB.NE.-5) THEN 1543 ILOGX = 0 1544 ILOGY = 0 1545 ILOGZ = 0 1546 ENDIF 1547C 1548 IF (LONTIT.GT.0) THEN 1549 TITAV(1:LONTIT) = HED(1:LONTIT) 1550 ELSE 1551 TITAV = ' ' 1552 ENDIF 1553C 1554 CALL datefichier(NOM_FICH(1:LONG)//CHAR(0),ID,IRC) 1555 IF (IRC.EQ.0) IDFICH = ID 1556 IF (IEXAG.GE.2) THEN 1557 CALL datefichier(NOM_FICH(1:LONG-7)//'depl'//CHAR(0),ID,IRC) 1558 IF (IRC.EQ.0) IDDEPL = ID 1559 ENDIF 1560 IF (IDVIT.NE.0) THEN 1561 IRC = 1 1562 CALL LIVAL(NOM_ISO,LONISO,IVAL,ICLAS,ICONTR,NDSEL,IRC) 1563 IF (IVAL.EQ.-1) THEN 1564 III = 2 1565 ELSE 1566 III = 0 1567 ENDIF 1568 CALL LIVIT(ICLAS,III,NOM_VIT,LONVIT,IRC,0,0) 1569 ENDIF 1570 IF (IDISO.NE.0) THEN 1571 IRC = 1 1572 CALL LIVAL(NOM_ISO,LONISO,IVAL,ICLAS,ICONTR,NDSEL,IRC) 1573 CALL LIISO(ICLAS,NOM_ISO,LONISO,IRC,ICONTR,1,IVAL) 1574 IF (ISO.EQ.0.AND.(IVAL.EQ.1.OR.IVAL.EQ.4).AND.NSURF.LE.0) THEN 1575cc?? IOPT = -1 1576 ELSE 1577 IF (NSURF.GT.0) CALL CALSUR(1) 1578 ENDIF 1579 ENDIF 1580C 1581 1000 FORMAT('"',A,'"') 1582 END 1583C----------------------------------------------------------------------- 1584 SUBROUTINE TROPDEPOINTS(N,INODE,IOPT) 1585 INCLUDE 'com_coor.f' 1586 INCLUDE 'com_faces.f' 1587 INCLUDE 'com_options.f' 1588C 1589 IF (ILANG.EQ.0) THEN 1590 IF (INODE.EQ.0) THEN 1591 PRINT*,'*** Votre fichier comprend',N,' points' 1592 PRINT*,'*** Alors que le maximum permis est',NPMAX 1593 ELSEIF(INODE.GT.0) THEN 1594 PRINT*,'*** Trop d''�l�ments �',INODE,' noeuds :',N 1595 PRINT*,'*** Alors que le maximum permis est',NEMAX/INODE 1596 ELSEIF(INODE.EQ.-1) THEN 1597 PRINT*,'*** Trop de faces :',NFACE 1598 PRINT*,'*** Alors que le maximum permis est',NFMAX 1599 ELSEIF(INODE.EQ.-2) THEN 1600 PRINT*,'*** Trop de tetra�dres' 1601 ENDIF 1602 PRINT*,'*** Essayez de recompiler "'//PROGEFF(1:LPROGEFF) 1603 & //'" avec plus de m�moire' 1604 ELSE 1605 IF (INODE.EQ.0) THEN 1606 PRINT*,'*** Your file contains',N,' nodes' 1607 PRINT*,'*** Maximum allowed =',NPMAX 1608 ELSEIF(INODE.GT.0) THEN 1609 PRINT*,'*** Too many',INODE,'-nodes elements',N 1610 PRINT*,'*** Maximum allowed =',NEMAX/INODE 1611 ELSEIF(INODE.EQ.-1) THEN 1612 PRINT*,'*** Too many facets:',NFACE 1613 PRINT*,'*** Maximum allowed =',NFMAX 1614 ELSEIF(INODE.EQ.-2) THEN 1615 PRINT*,'*** Too many tetraedrons' 1616 ENDIF 1617 PRINT*,'*** Try to recompile "'//PROGEFF(1:LPROGEFF) 1618 & //'" with more memory' 1619 ENDIF 1620 IF (IOPT.EQ.0) STOP 1621 END 1622