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