1      PROGRAM XD3D
2C
3C Main program of xd3d.
4C xd3d was born in 1988 on IBM mainframe computers.
5C It is a free software under the Gnu Public License since July 2003.
6C Its main author is Francois Jouve <francois.jouve@polytechnique.fr>
7C http://www.cmap.polytechnique.fr/~jouve/xd3d
8C
9      INCLUDE 'com_boutons.f'
10      INCLUDE 'com_coor.f'
11      INCLUDE 'com_faces.f'
12      INCLUDE 'com_ombreiso.f'
13      INCLUDE 'com_options.f'
14      INCLUDE 'com_savetrace.f'
15      INCLUDE 'com_vieucu.f'
16ctrans      common / dirobs / obsobs(3),uuuu(3),vvvv(3)
17C
18      REAL*8        VEC0(3),VEC1(3),SEC0,SEC1
19      DIMENSION     ROTA0(3,3),ROTAINV(3,3),SYM(3,4),XC(8),YC(8),ZC(8)
20      CHARACTER*128 FICLEC,FICLEC2,CBIDON
21      CHARACTER*7   CNUM
22      CHARACTER*3   CNUM2,CNUM3
23      CHARACTER*2   CC
24      CHARACTER*1   CSOURI(5)
25      LOGICAL*4     DEBUT,GEOM,GVESTLA
26      DATA SYM / 1.,1.,1., 1.,-1.,1., -1.,1.,1., -1.,-1.,1. /
27C
28      INCLUDE 'Version.f'
29      INCLUDE 'com_coul.f'
30C
31CC      DATA USR2 / 0.707106781186548 /
32CC      DATA USR3 / 0.577350269189626 /
33CC      DATA USR6 / 0.408248290463863 /
34      DATA R2R3 / 0.816496580927726 /
35cc      DATA RAC3 / 1.73205080756888  /
36      DATA PI   / 3.14159265358979 /
37      DATA CSOURI / '0','"','#','A','C' /
38C 2^1/8
39      DATA FACZOOM / 1.090507733 /
40C
41C Langue
42C
43      CALL INIT_TEMPS
44      CALL perfide(ILANG,IDEBUG)
45      ILANG0 = ILANG
46      CALL BERLITZ(ILANG)
47      CALL INITFLUSH
48      CHEMDOC = '/home/jouve/Doc/xd3d_doc.ps'
49      LENCHEM = 27
50      PROG    = 'd3d'
51      LPROG   = 3
52      CALL LONGUEUR(PROBIG,LPRO)
53C
54cc      IFIXFIX  = 1
55      IFIXFIX  = 0
56      DFACX    = 0.
57      DFACY    = 0.
58      DFACZ    = 0.
59      FACPTS   = 1.
60      FACVIT0  = 1.
61      IAUTORELOAD = 0
62      IBATCH   = 0
63      IBORD    = 0
64      IBORDTHERMO = 1
65      IBOUT    = 0
66      ICALSU   = 0
67      ICOLAR   = 2
68      ICOLAX   = 7
69      ICOLAXB  = 4
70      ICOULTHERMO = 11
71      ICPTS    = 1
72      ICSEG    = 7
73      IDEB     = 0
74      IDEBRAP  = 0
75      IDEPOUILLE = 0
76      IDEROUL  = 0
77      IDIRL    = 0
78      IECBOI   = 0
79      IELIMI   = 0
80      IELISO   = 0
81      IEPBOR   = 6
82      IEPSEG   = 1
83      IFC      = 1
84      IFONT0   = 0
85      IFONT1   = 1
86      IFONT2   = 2
87      IFONT3   = 3
88      IFONT4   = 4
89      IFONT5   = 5
90      IFONT7   = 7
91      IFONT8   = 8
92      IFREEZE  = 0
93      IFRONT   = 0
94      IGOTO    = 1
95      ILEG     = 0
96      ILEGAUTO = 0
97      ILEGMAN  = 0
98      ILOGX    = 0
99      ILOGY    = 0
100      ILOGZ    = 0
101      INUMINTER = 0
102      IOPMAR   = 0
103      IOPTFORME = 0
104      IPARA    = 0
105      IPROGRE  = 0
106      IPROX    = 95
107      IPROY    = 77
108      IQUEST   = 0
109      IREFRE   = 0
110      IRQ      = 0
111      ISAUVEGRAPH = 0
112      ISAUVEMESH = 0
113      ISOBID   = 0
114      ISTDOUT  = 0
115      ISYMR    = 0
116      ITEMPS   = 0
117      ITOUCHEX = 0
118      ITOUCHNB = 0
119      ITOUCHTAB = 0
120      ITPTS    = 5
121      ITYP     = 0
122      IVIT     = 1
123      IWAVE    = 0
124      LONCOUR  = 0
125      LONISO   = 0
126      LONLEG   = 0
127      LONPS    = 0
128      LONVIT   = 0
129      NBCOUL   = 64
130      NODEPL   = 0
131C
132      BIG      = 1.E+14
133      BIGS     = BIG
134      USBIG    = 1./BIG
135      XFMAX    = -BIG
136      XFMIN    = BIG
137      YFMAX    = -BIG
138      YFMIN    = BIG
139      VCOUPXYZ(1) = BIG
140      VCOUPXYZ(2) = BIG
141      VCOUPXYZ(3) = BIG
142C
143C Lecture de la ligne de commande
144C
145      IFC0 = IFC
146      CALL LIOPT(FICLEC,FICLEC2,XINIT_ROTX,XINIT_ROTY,XINIT_ROTZ
147     &          ,XINIT_VISO,XINIT_VMIN,XINIT_VMAX,XINIT_FACT
148     &          ,XINIT_FACTX,XINIT_FACTY,XINIT_FACTZ,XINIT_FACV
149     &          ,XINIT_XCUR,XINIT_YCUR,XINIT_ZOOM
150     &          ,INIT_TABLE,INIT_ISO,INIT_FICH
151     &          ,INIT_FICH2,INIT_BORD,INIT_DEFPS,INIT_NBCOUL
152     &          ,INIT_FLECH,INIT_RECON,INIT_ISOBID,INIT_IBOITE
153     &          ,INIT_IECBOI,INIT_FOND,INIT_IAXES,INIT_IPERSP
154     &          ,INIT_DIRL,INIT_MODE,INIT_DEPL,INIT_SYMINV,INIT_ICTFAC)
155      IF (IFC.NE.IFC0) THEN
156        ISAVEIFC = 1
157      ELSE
158        ISAVEIFC = 0
159      ENDIF
160C
161C Evaluation de la memoire
162C
163      IF (ISTDOUT.EQ.0) CALL ECRMEM
164C
165C Initialisation
166C
167 1    IOPT   = 1
168      GEOM   = .FALSE.
169      IBORD0 = IBORD
170      IFC0   = IFC
171      CALL INITIAL(IPARA)
172C common savetrace
173      ICENTRISO0 = ICENTRISO
174      INUMER0    = INUMER
175      ISO0       = ISO
176      IVALMAR0   = IVALMAR
177      IVIT0      = IVIT
178      IX00 = 0
179      IX10 = 0
180      IY00 = 0
181      IY10 = 0
182      PREM = .TRUE.
183C
184      IF (INIT_FOND.GE.0) ICTFON = INIT_FOND
185      CALL MA_SOURIS(CSOURI(1),CSOURI(2),CSOURI(3),CSOURI(4),CSOURI(5))
186      IF (ISAVEIFC.EQ.1) IFC = IFC0
187C
188C Opt forme
189C
190      IF (IOPTFORME.NE.0) THEN
191        IF (IOPTFORME.EQ.1) THEN
192          FICLEC = NOM_FICH(1:LONG-8)//'.theta'
193          INIT_FICH = LONG-2
194        ELSEIF(IOPTFORME.EQ.2) THEN
195          FICLEC = NOM_FICH(1:LONG-8)//'.thetap'
196          INIT_FICH = LONG-1
197        ELSEIF(IOPTFORME.EQ.-3) THEN
198          FICLEC = NOM_FICH(1:LONG-8)//'.v'
199          INIT_FICH = LONG-6
200        ELSE
201cc          FICLEC = NOM_FICH(1:LONG-8)//'.levelset'
202          FICLEC = NOM_FICH(1:LONG-8)//'.psi'
203          INIT_FICH = LONG-4
204        ENDIF
205        CALL REMETFULLPATH(FICLEC,INIT_FICH)
206        INIT_BORD = 3
207        XINIT_FACT = 0.
208        IF (IOPTFORME.GT.0) THEN
209          IF (NOM_FICH(LONG-1:LONG).EQ.'3D') THEN
210            IFC = -1
211            XINIT_VISO = 0.3
212            ICALSU = 2
213          ELSE
214            INIT_ISO = 11
215          ENDIF
216        ELSE
217          IF (NOM_FICH(LONG-1:LONG).EQ.'3D') THEN
218            IFC = -1
219            IF (IOPTFORME.EQ.-1) THEN
220              ICALSU = 1
221            ELSEIF(IOPTFORME.EQ.-3) THEN
222              ICALSU = 2
223            ELSE
224              ICALSU = 0
225            ENDIF
226            IF (IOPTFORME.EQ.-3) THEN
227              XINIT_VISO = 0.5
228            ELSE
229              XINIT_VISO = 0.
230            ENDIF
231          ELSE
232            IF (IOPTFORME.EQ.-1.OR.IOPTFORME.EQ.-3) THEN
233              INIT_ISO = 2
234              INIT_NBCOUL = 8
235            ELSE
236              INIT_ISO = 4
237              INIT_NBCOUL = 1
238              IEPISO = 0
239              XINIT_VMIN = -1.
240              XINIT_VMAX = 1.
241            ENDIF
242            ITOUCHNB = 1
243          ENDIF
244        ENDIF
245      ENDIF
246C
247      IF (INIT_MODE.GE.0.AND.INIT_MODE.LT.1000) THEN
248        IF (INIT_MODE.EQ.0) THEN
249          FICLEC = NOM_FICH(1:LONG-8)//'.mode'
250          INIT_FICH = LONG-3
251        ELSE
252          WRITE(CNUM2,'(I3.3)') INIT_MODE
253          FICLEC = NOM_FICH(1:LONG-8)//'_'//CNUM2//'.mode'
254          INIT_FICH = LONG+1
255        ENDIF
256        CALL REMETFULLPATH(FICLEC,INIT_FICH)
257        ITOUCHEX = 1
258        IF (XINIT_FACT.EQ.BIGS.OR.XINIT_FACT.EQ.311263.) XINIT_FACT = 1.
259      ENDIF
260C
261      IF (INIT_DEPL.GE.0.AND.INIT_DEPL.LT.1000) THEN
262        IF (INIT_DEPL.EQ.0) THEN
263          FICLEC = NOM_FICH(1:LONG-8)//'.depl'
264          INIT_FICH = LONG-3
265        ELSE
266          WRITE(CNUM2,'(I3.3)') INIT_DEPL
267          FICLEC = NOM_FICH(1:LONG-8)//'_'//CNUM2//'.depl'
268          INIT_FICH = LONG+1
269        ENDIF
270        CALL REMETFULLPATH(FICLEC,INIT_FICH)
271        ITOUCHEX = 1
272        IF (XINIT_FACT.EQ.BIGS) XINIT_FACT = 1.
273      ENDIF
274C
275      IPFK = 9999
276      IF (IPARA.EQ.0) DEBUT = .TRUE.
277C
278C Lecture des points
279C
280      CALL LECTURE(XINIT_FACT)
281C
282      IF (INIT_SYMINV.NE.0.AND.IDEMI.EQ.0) IDEMI = 2
283      IF (XINIT_ECH(1,1).NE.BIGS.OR.XINIT_ECH(2,1).NE.BIGS) THEN
284        IF (XINIT_ECH(1,1).NE.BIGS) THEN
285          XMI = XINIT_ECH(1,1)
286        ELSE
287          XMI = XMIN
288        ENDIF
289        IF (XINIT_ECH(2,1).NE.BIGS) THEN
290          XMA = XINIT_ECH(2,1)
291        ELSE
292          XMA = XMAX
293        ENDIF
294        XBMIN = MIN(XMI,XMA)
295        XBMAX = MAX(XMI,XMA)
296        CALL ARONDI(XBMIN,XBMAX,XECH,PROPX,NECHX,NBECH)
297        BX = (XBMAX-XBMIN)*0.5
298        BX0 = BX
299        IECHFX = 1
300      ELSE
301        IECHFX = 0
302        XBMIN = 0.
303        XBMAX = 0.
304      ENDIF
305      IF (XINIT_ECH(1,2).NE.BIGS.OR.XINIT_ECH(2,2).NE.BIGS) THEN
306        IF (XINIT_ECH(1,2).NE.BIGS) THEN
307          YMI = XINIT_ECH(1,2)
308        ELSE
309          YMI = YMIN
310        ENDIF
311        IF (XINIT_ECH(2,2).NE.BIGS) THEN
312          YMA = XINIT_ECH(2,2)
313        ELSE
314          YMA = YMAX
315        ENDIF
316        YBMIN = MIN(YMI,YMA)
317        YBMAX = MAX(YMI,YMA)
318        CALL ARONDI(YBMIN,YBMAX,YECH,PROPY,NECHY,NBECH)
319        BY = (YBMAX-YBMIN)*0.5
320        BY0 = BY
321        IECHFY = 1
322      ELSE
323        IECHFY = 0
324        YBMIN = 0.
325        YBMAX = 0.
326      ENDIF
327      IF (XINIT_ECH(1,3).NE.BIGS.OR.XINIT_ECH(2,3).NE.BIGS) THEN
328        IF (XINIT_ECH(1,3).NE.BIGS) THEN
329          ZMI = XINIT_ECH(1,3)
330        ELSE
331          ZMI = ZMIN
332        ENDIF
333        IF (XINIT_ECH(2,3).NE.BIGS) THEN
334          ZMA = XINIT_ECH(2,3)
335        ELSE
336          ZMA = ZMAX
337        ENDIF
338        ZBMIN = MIN(ZMI,ZMA)
339        ZBMAX = MAX(ZMI,ZMA)
340        CALL ARONDI(ZBMIN,ZBMAX,ZECH,PROPZ,NECHZ,NBECH)
341        BZ = (ZBMAX-ZBMIN)*0.5
342        BZ0 = BZ
343        BZ00 = BZ
344        IECHFZ = 1
345      ELSE
346        IECHFZ = 0
347        ZBMIN = 0.
348        ZBMAX = 0.
349      ENDIF
350      IF (IECHFX.NE.0.OR.IECHFY.NE.0.OR.IECHFZ.NE.0) IFIX = 0
351C
352      IF (ICOURB.LE.0) THEN
353        IF (XINIT_FACTX.EQ.BIGS) THEN
354          XINIT_FACTX = 1.
355        ELSEIF(XINIT_FACTX.EQ.0.) THEN
356          XINIT_FACTX = EXAX0
357        ENDIF
358        IF (XINIT_FACTY.EQ.BIGS) THEN
359          XINIT_FACTY = 1.
360        ELSEIF(XINIT_FACTY.EQ.0.) THEN
361          XINIT_FACTY = EXAY0
362        ENDIF
363        IF (XINIT_FACTZ.EQ.BIGS) THEN
364          XINIT_FACTZ = 1.
365        ELSEIF(XINIT_FACTZ.EQ.0.) THEN
366          XINIT_FACTZ = EXAZ0
367        ENDIF
368      ENDIF
369C
370      IF (IPARA.NE.0) THEN
371        IBORD = IBORD0
372        IFC   = IFC0
373      ENDIF
374ctrans      dist000 = dist
375ctrans      call calpup(xpup,dist,obsobs,uuuu,vvvv)
376      IF (IPARA.EQ.0) THEN
377        IF (I2D.EQ.0.AND.IPS2D.EQ.0
378     &.AND.(ICOURB.GT.0.OR.IELIMI.EQ.0)) THEN
379          IPERSP = -2
380        ELSE
381          IPERSP = 1
382          IAXES = 0
383          IBORD = 0
384        ENDIF
385      ELSEIF(IDEBRAP.NE.0) THEN
386        IBORD = -1
387        IFC = -1
388      ENDIF
389      IPERSP0 = IPERSP
390      IF (INIT_IPERSP.NE.0) IPERSP = INIT_IPERSP
391      CALL METLAPERSP
392      CALL METLALIGHT
393      IAXESDEF = IAXES
394      IF (INIT_IAXES.GE.0) IAXES = INIT_IAXES
395C
396C Selection des faces exterieures
397C
398      IF (ICOURB.GT.0) THEN
399        CALL ELIMIN
400        IF (IREFRE.EQ.0) IBOITE = 0
401      ELSE
402        IF (ICOURB.EQ.-5) THEN
403          IF (ICOURXYZ.EQ.2) THEN
404            CALL ELIMIN3
405          ELSE
406            CALL ELIMIN
407          ENDIF
408        ELSE
409          CALL ELIMIN2
410        ENDIF
411        IF (IREFRE.EQ.0) IBOITE = 1
412      ENDIF
413      IF ((IFRONT.EQ.-1.AND.NUMSD.LE.1)
414     &.OR.(IFRONT.EQ.1.AND.IFBLO.EQ.0)) IFRONT = 0
415      IF (IFRONT.EQ.3.AND.IFBLO.EQ.0) IFRONT = 2
416C
417      DO I=1,NUMSD
418        ISDVU(I) = 1
419      ENDDO
420C
421      IF (LONCOUR.GT.0) THEN
422        IF (ICOURB.EQ.-5.or.ICOURB.GT.0) THEN
423          CALL INV3X3(ROTA,ROTLOC,IERR)
424          DO I=1,3
425            DO J=1,3
426              ROTA(J,I) = ROTLOC(J,I)
427            ENDDO
428          ENDDO
429          CALL ROTATE(0)
430          IF (NDS.EQ.3) THEN
431            CALL LICOUR3(IRC)
432          ELSE
433            CALL LICOUR4(IRC)
434          ENDIF
435          CALL INV3X3(ROTA,ROTLOC,IERR)
436          DO I=1,3
437            DO J=1,3
438              ROTA(J,I) = ROTLOC(J,I)
439            ENDDO
440          ENDDO
441          CALL ROTATE(0)
442        ELSE
443          CALL LICOUR(IRC)
444        ENDIF
445        IF (IRC.NE.0) LONCOUR = 0
446      ENDIF
447C
448      CALL INITBOUT
449      IF (NDS.NE.3) THEN
450        IF (NDS.EQ.4.AND.I2D.EQ.0.AND.ICOURB.GT.0) THEN
451          IF (ELEMENTS(1:14).EQ.'Quadrangles 3D') THEN
452            NDS = 4
453          ELSE
454            NDS = 3
455          ENDIF
456        ELSE
457          NDS = 4
458        ENDIF
459      ENDIF
460      NDS2 = NDS+1
461C
462C Reconstitution de l'oeil par symetrie
463C
464      CALL RECONS(NFACE,NF,NF4,NRECONMAX,XMED2,YMED2)
465      IF (INIT_RECON.GT.1) NFACE = NF*MIN(NRECONMAX,INIT_RECON)
466      IF (INIT_RECON.LT.0) NFACE = NF*NRECONMAX
467      NRECON = NFACE/NF
468C
469      IF (NRECON.GT.1) THEN
470        NF0 = NF
471        NRECON0 = 1
472        CALL SYMETRISE(NRECON0,1)
473      ENDIF
474C
475C Champ de deplacement= vitesse
476C
477      IF (IFVIT.EQ.2) THEN
478        DO I=1,NF
479          DO J=1,NDS
480            VITF(1,J,I) = VITN(1,NFAC(J,I))
481            VITF(2,J,I) = VITN(2,NFAC(J,I))
482            VITF(3,J,I) = VITN(3,NFAC(J,I))
483            VALF(J,I) = VALX(NFAC(J,I))
484          ENDDO
485        ENDDO
486        IF (ISYM.EQ.4) THEN
487          IF (NRECONMAX.GT.1) THEN
488            IF (IDEMI.EQ.2) THEN
489              SYM(1,2) = -1.
490              SYM(2,2) = 1.
491            ENDIF
492            DO I=NF+1,NF4
493              II = 1+(I-1)/NF
494              DO J=1,NDS
495                VITF(1,J,I) = SYM(1,II)*VITN(1,NFAC(J,I))
496                VITF(2,J,I) = SYM(2,II)*VITN(2,NFAC(J,I))
497                VITF(3,J,I) = VITN(3,NFAC(J,I))
498                VALF(J,I) = VALX(NFAC(J,I))
499              ENDDO
500            ENDDO
501          ENDIF
502        ELSE
503          DO N=1,NRECONMAX-1
504            IF (MOD(N,2).EQ.1) THEN
505              ANG = REAL(2*(N+1))*PI/REAL(ISYM)
506              COCO = COS(ANG)
507              SISI = SIN(ANG)
508              DO K=1,NF
509                I = NF*N+K
510                DO J=1,NDS
511                  VITF(1,J,I) = COCO*VITN(1,NFAC(J,I))
512     &                        + SISI*VITN(2,NFAC(J,I))
513                  VITF(2,J,I) = SISI*VITN(1,NFAC(J,I))
514     &                        - COCO*VITN(2,NFAC(J,I))
515                  VITF(3,J,I) = VITN(3,NFAC(J,I))
516                  VALF(J,I) = VALX(NFAC(J,I))
517                ENDDO
518              ENDDO
519            ELSE
520              ANG = REAL(2*N+4)*PI/REAL(ISYM)
521              COCO = COS(ANG)
522              SISI = SIN(ANG)
523              DO K=1,NF
524                I = NF*N+K
525                II = NF+K
526                DO J=1,NDS
527                  VITF(1,J,I) = COCO*VITF(1,J,II)
528     &                        + SISI*VITF(2,J,II)
529                  VITF(2,J,I) = SISI*VITF(1,J,II)
530     &                        - COCO*VITF(2,J,II)
531                  VITF(3,J,I) = VITN(3,NFAC(J,I))
532                  VALF(J,I) = VALX(NFAC(J,I))
533                ENDDO
534              ENDDO
535            ENDIF
536          ENDDO
537        ENDIF
538      ENDIF
539C
540C Initialisation du graphique
541C
542      IF (IBATCH.EQ.0) THEN
543        IF (DEBUT) THEN
544          CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
545          CALL x11nomicone('Xd3d'//char(0),4)
546          CALL x11askbacking(IBACKINGSTORE)
547C
548C Il y a des pb avec les polygones convexes lorsqu'ils sont tres
549C allonges. On reste donc avec l'hypothese de polygones Complex
550C
551CCC        CALL x11polyconvex(0)
552          CALL GETIDX(IDX0,IDY0,IECX,IECY)
553        ENDIF
554        NBOGO = MYBOGOVITESSE()
555        IF (I2D.EQ.0) THEN
556          NBIGF = 8*NBOGO
557        ELSE
558          NBIGF = 5*NBOGO
559        ENDIF
560        NOUTLINEM = NBOGO/3
561        CALL CALCOUTLINE(NFACE,0)
562        IF (IPROGRE.EQ.0) THEN
563          IF (NFACE.LE.NBIGF) THEN
564            IF (ILANG.EQ.0) THEN
565              PRINT*,'Double buffer (NFACE=',NFACE,', Seuil=',NBIGF,')'
566            ELSE
567              PRINT*,
568     &           'Double buffer (NFACE=',NFACE,', Threshold=',NBIGF,')'
569            ENDIF
570            IPROGRE = -1
571          ELSE
572            IF (ILANG.EQ.0) THEN
573              PRINT*,
574     &      'Pas de double buffer (NFACE=',NFACE,', Seuil=',NBIGF,')'
575            ELSE
576              PRINT*,
577     &      'No double buffer (NFACE=',NFACE,', Threshold=',NBIGF,')'
578            ENDIF
579            IPROGRE = 1
580          ENDIF
581        ENDIF
582      ELSE
583        CALL FSINN(IPROX,IPROY,PROBIG,-99,ITERMC)
584      ENDIF
585      IDEB = 1
586      IF (I2D.EQ.0.AND.IPS2D.EQ.0.AND.(ICOURB.GT.0.OR.IELIMI.EQ.0)) THEN
587        IRENO = 0
588        IF (IPARA.NE.0) THEN
589          NRECON = MIN(IPARA,NRECONMAX)
590          NFACE = NF*NRECON
591          CALL ROTATE(1)
592        ELSEIF((NUMSD.EQ.1.OR.ICOURB.GT.0).AND.
593     &         (ITERMC.EQ.1.OR.ITERMC.EQ.3.OR.ITERMC.EQ.4)) THEN
594          ITABLE = 7
595          IF (INIT_ICTFAC.EQ.0) THEN
596            ICTFAC = 99
597          ELSE
598            ICTFAC = INIT_ICTFAC
599          ENDIF
600        ELSE
601          ITABLE = 1
602          ICTFAC = 0
603        ENDIF
604      ELSE
605        IF (IPARA.EQ.0) THEN
606          ITABLE = 1
607          ICTFAC = 0
608        ENDIF
609        IF (I2D.NE.0) THEN
610          IRENO = I2D+1
611        ELSE
612          IRENO = 2
613        ENDIF
614        CALL CALROT(ROTLOC,IRENO)
615        CALL ROTATE(1)
616      ENDIF
617      ICTFAC00 = ICTFAC
618      IDIRL0 = IDIRL
619      IF (INIT_DIRL.EQ.-1) THEN
620        ICTFAC = 0
621      ELSEIF(INIT_DIRL.GT.0) THEN
622        IDIRL = INIT_DIRL
623        CALL METLALIGHT
624      ENDIF
625C
626      IF (MIN(XINIT_ROTX,XINIT_ROTY,XINIT_ROTZ).LT.BIGS) THEN
627        CALL ARC(ANGX,ANGY,ANGZ)
628        IF (XINIT_ROTX.NE.BIGS) ANGX = XINIT_ROTX
629        IF (XINIT_ROTY.NE.BIGS) ANGY = XINIT_ROTY
630        IF (XINIT_ROTZ.NE.BIGS) ANGZ = XINIT_ROTZ
631        CALL INV3X3(ROTA,ROTLOC,IERR)
632        CALL ROTATE(1)
633        CALL ARCROT(ANGX,ANGY,ANGZ)
634        CALL ROTATE(0)
635      ENDIF
636C
637C Table de couleurs initiale : 75 couleurs
638C
639      IF (INIT_TABLE.NE.0) ITABLE = INIT_TABLE
640      IF (INIT_NBCOUL.NE.0) NBCOUL = INIT_NBCOUL
641      CALL CHNBCOL(NBCOUL,NVAL,0,ITABLE)
642      IF (IBATCH.NE.0.AND.IPOSTCOL.EQ.1) CALL METIPOST(-2)
643      CALL TABCOL(NVAL,IWAVE)
644C
645      IF (IPARA.NE.0) CALL EXAGERE(DFACX,DFACY,DFACZ,0)
646      IF (INIT_FICH.GT.0) THEN
647        IRC = 1
648        CALL LIVAL(FICLEC,INIT_FICH,IVAL,ICLAS,ICONTR,NDSEL,IRC)
649        IF (IVAL.NE.9999) THEN
650          IGOTO = 0
651          IF (XINIT_FACT.NE.BIGS
652     &   .AND.XINIT_FACT.NE.311263.) FACEXA = XINIT_FACT
653          CALL ACTLIVAL(IVAL,ICONTR,FICLEC,INIT_FICH,IREFRE,IGOTO)
654        ENDIF
655      ENDIF
656      IF (INIT_FICH2.GT.0) THEN
657        IRC = 1
658        CALL LIVAL(FICLEC2,INIT_FICH2,IVAL,ICLAS,ICONTR,NDSEL,IRC)
659        IF (IVAL.NE.9999) THEN
660          IGOTO = 0
661          IF (XINIT_FACT.NE.BIGS
662     &   .AND.XINIT_FACT.NE.311263.) FACEXA = XINIT_FACT
663          CALL ACTLIVAL(IVAL,ICONTR,FICLEC2,INIT_FICH2,IREFRE,IGOTO)
664        ENDIF
665      ENDIF
666C///// changer ca
667      IF (INIT_ISOBID.NE.0) THEN
668        IF (I2D.NE.0.AND.INIT_ISOBID.EQ.1) THEN
669          INIT_ISOBID = 0
670        ELSE
671          ISOBID = INIT_ISOBID
672          CALL MYISO
673        ENDIF
674      ENDIF
675      IF (INIT_ISO.NE.0) THEN
676        IF (IFISO.EQ.0) THEN
677          IF (ILANG.EQ.0) THEN
678            IF (ISTDOUT.EQ.0) THEN
679              PRINT*,'*** Pas de fichier scalaire'
680              IF (INIT_ISO.LT.10) THEN
681                WRITE(*,'(" *** Option -iso=",I1," ignor�e")') INIT_ISO
682              ELSE
683                WRITE(*,'(" *** Option -iso=",I2," ignor�e")') INIT_ISO
684              ENDIF
685            ELSE
686              PRINT*,'*** No scalar field'
687              IF (INIT_ISO.LT.10) THEN
688                WRITE(*,'(" *** Option -iso=",I1," ignored")') INIT_ISO
689              ELSE
690                WRITE(*,'(" *** Option -iso=",I2," ignored")') INIT_ISO
691              ENDIF
692            ENDIF
693          ENDIF
694        ELSE
695          IF (INIT_ISO.GE.6.AND.ICENTR.EQ.0) THEN
696            II = INIT_ISO
697            IF (INIT_ISO.EQ.11) THEN
698              INIT_ISO = 1
699            ELSE
700              INIT_ISO = INIT_ISO-5
701            ENDIF
702            IF (ISTDOUT.EQ.0) THEN
703              IF (ILANG.EQ.0) THEN
704                PRINT*,'*** Pas de valeurs aux centres des cellules'
705                PRINT*,
706     &               '*** Option -iso=',II,' transform�e en -iso='
707     &               ,INIT_ISO
708              ELSE
709                PRINT*,'*** No piecewise constant field'
710                PRINT*,
711     &               '*** Option -iso=',II,' changed into -iso='
712     &               ,INIT_ISO
713              ENDIF
714            ENDIF
715          ENDIF
716          II = INIT_ISO+1
717          CALL ACTISO2(II)
718          ISOINI = 0
719          CALL ACTISO(ISOINI,NBCOUL,IWAVE,IGOTO)
720          IF (INIT_NBCOUL.NE.0.OR.INIT_TABLE.NE.0) THEN
721            IF (INIT_NBCOUL.NE.0) NBCOUL = INIT_NBCOUL
722            IF (INIT_TABLE.NE.0)  ITABLE = INIT_TABLE
723            IF (ITABLE.GT.2) THEN
724              IIII = -100000-NBCOUL
725            ELSE
726              CALL CHNBCOL(NBCOUL,NVAL,1,ITABLE)
727              IIII = -100000-NVAL
728            ENDIF
729            CALL TABCOL(IIII,IWAVE)
730Cfj            CALL CHNBCOL(NBCOUL,NVAL,0,ITABLE)
731Cfj            CALL TABCOL(NVAL,IWAVE)
732          ENDIF
733        ENDIF
734      ENDIF
735      IF (XINIT_VISO.NE.BIGS) THEN
736        IF (IFISO.EQ.0) THEN
737          IF (ISTDOUT.EQ.0) THEN
738            IF (ILANG.EQ.0) THEN
739              PRINT*,'*** Pas de fichier scalaire'
740              PRINT*,'*** Option -isosurf ignor�e'
741            ELSE
742              PRINT*,'*** No scalar field'
743              PRINT*,'*** Option -isosurf ignored'
744            ENDIF
745          ENDIF
746        ELSEIF(I2D.NE.0) THEN
747          IF (ISTDOUT.EQ.0) THEN
748            IF (ILANG.EQ.0) THEN
749              PRINT*,'*** Maillage 2d'
750              PRINT*,'*** Option -isosurf ignor�e'
751            ELSE
752              PRINT*,'*** 2d mesh'
753              PRINT*,'*** Option -isosurf ignored'
754            ENDIF
755          ENDIF
756        ELSEIF((XINIT_VISO.GT.VMAX.OR.XINIT_VISO.LT.VMIN)
757     &         .AND.ICALSU.EQ.0) THEN
758          IF (ISTDOUT.EQ.0) THEN
759            IF (ILANG.EQ.0) THEN
760              PRINT*,'*** Isosurface',XINIT_VISO,' hors bornes'
761     &             ,VMIN,VMAX
762              PRINT*,'*** Option -isosurf ignor�e'
763            ELSE
764              PRINT*,'*** Isosurface',XINIT_VISO,' out of bounds'
765     &             ,VMIN,VMAX
766              PRINT*,'*** Option -isosurf ignored'
767            ENDIF
768          ENDIF
769        ELSE
770          VISO = XINIT_VISO
771          IBSOMB = 0
772          IF (IBSOMB.EQ.0) THEN
773            BSOMB = 0.5
774          ELSEIF(IBSOMB.EQ.0) THEN
775            BSOMB = 0.3
776          ELSE
777            BSOMB = 0.1
778          ENDIF
779          CALL CALSUR(1)
780          ICSUR = 16
781        ENDIF
782      ENDIF
783      IF (XINIT_VMIN.NE.BIGS) THEN
784        IF (ISO.NE.0) THEN
785          VMIN0 = VMIN
786          VMIN = XINIT_VMIN
787        ELSEIF(ISTDOUT.EQ.0) THEN
788          IF (ILANG.EQ.0) THEN
789            PRINT*,'*** Pas d''isovaleurs demand�es'
790            PRINT*,'*** Option -vmin=',XINIT_VMIN,' ignor�e'
791          ELSE
792            PRINT*,'*** No contour plot asked'
793            PRINT*,'*** Option -vmin=',XINIT_VMIN,' ignored'
794          ENDIF
795        ENDIF
796      ENDIF
797      IF (XINIT_VMAX.NE.BIGS) THEN
798        IF (ISO.NE.0) THEN
799          VMAX0 = VMAX
800          VMAX = XINIT_VMAX
801        ELSEIF(ISTDOUT.EQ.0) THEN
802          IF (ILANG.EQ.0) THEN
803            PRINT*,'*** Pas d''isovaleurs demand�es'
804            PRINT*,'*** Option -vmax=',XINIT_VMAX,' ignor�e'
805          ELSE
806            PRINT*,'*** No contour plot asked'
807            PRINT*,'*** Option -vmax=',XINIT_VMAX,' ignored'
808          ENDIF
809        ENDIF
810      ENDIF
811      IF (ISO.NE.0.AND.MIN(XINIT_VMIN,XINIT_VMAX).LT.BIGS) THEN
812        IF (VMAX.EQ.VMIN) THEN
813          VMIN = VMIN0
814          VMAX = VMAX0
815        ELSEIF(VMIN.GT.VMAX) THEN
816          VMIN0 = VMIN
817          VMIN = VMAX
818          VMAX = VMIN0
819        ENDIF
820      ENDIF
821      IF (INIT_FLECH.NE.0) THEN
822        IF (IFVIT.NE.0) THEN
823          IF (IVIT.GT.0) IVIT = -IVIT
824          IF (XINIT_FACV.NE.0.) THEN
825            FACVIT  = XINIT_FACV
826            FACVIT0 = XINIT_FACV
827          ENDIF
828        ENDIF
829      ENDIF
830C
831      IF (INIT_DEFPS.NE.9999) THEN
832        CALL DEFPS(INIT_DEFPS,SIG,ANGPS,ICADPS,HELPPS,IDSEUL,0,ILANG)
833        IDEFPS = INIT_DEFPS
834      ENDIF
835      IF (INIT_BORD.NE.9999) THEN
836        II = INIT_BORD+1
837        CALL ACTBOR2(II)
838      ENDIF
839C
840      IF (ICOURB.LT.0.AND.(XINIT_FACTX.NE.1..OR.XINIT_FACTY.NE.1.
841     &     .OR.XINIT_FACTZ.NE.1.)) THEN
842        FACEXAX0 = FACEXAX
843        FACEXAY0 = FACEXAY
844        FACEXAZ0 = FACEXAZ
845        FACEXAX = XINIT_FACTX
846        FACEXAY = XINIT_FACTY
847        FACEXAZ = XINIT_FACTZ
848        DFACX = FACEXAX-FACEXAX0
849        DFACY = FACEXAY-FACEXAY0
850        DFACZ = FACEXAZ-FACEXAZ0
851        CALL EXAGERE(DFACX,DFACY,DFACZ,0)
852        VMINSAUV = VMIN
853        VMAXSAUV = VMAX
854        IF (ISOBID.NE.0) CALL MYISO
855        VMIN = VMINSAUV
856        VMAX = VMAXSAUV
857        XINIT_FACTX = 1.
858        XINIT_FACTY = 1.
859        XINIT_FACTZ = 1.
860      ENDIF
861C
862      IF (INIT_IBOITE.GE.0) THEN
863        IBOITE = INIT_IBOITE
864        IECBOI = INIT_IECBOI
865      ENDIF
866C
867C Selection des faces dont la normale est contenue dans le 1/2 espace
868C qui "regarde" l'observateur (si ifc.eq.1)
869C
870 5000 CALL PROJET(NBON,XMIN,XMAX,YMIN,YMAX)
871C
872C Classement des faces selectionnees selon la place de la projection
873C du barycentre sur la droite passant par (0,0,0) et
874C dirigee par (1,1,1) (direction d'observation)
875C
876      IF (I2D.EQ.0.OR.(IDEFOR.EQ.2.AND.FACEXA.NE.0.)) THEN
877        IF (NSURF.GT.0.AND.IFC.LT.0) THEN
878          CALL PROSUR(NBON)
879          CALL RANGEMENT(NBON+NSURF)
880c          CALL TEMPS(SEC0,IS)
881          CALL CORRIGE(IORDRE,NBON,NSURF,NEIS,NSENS)
882c          CALL TEMPS(SEC1,IS)
883c          PRINT*,'Corrige =',SEC1-SEC0
884        ELSE
885          CALL RANGEMENT(NBON)
886cguignard          do n=1,nbon
887cguignard            nn = nproje(n)
888cguignard            do i=1,4
889cguignard              call zfictif(XF(I,Nn),YF(I,Nn),ZF(I,Nn),yy(i,n),zz(i,n))
890cguignard            enddo
891cguignard          enddo
892cguignard          call mysort2(xx,yy,zz,iordre,nbon)
893        ENDIF
894      ELSE
895        DO I=1,NBON
896          IORDRE(I) = I
897        ENDDO
898      ENDIF
899C
900 5010 IF (DEBUT) THEN
901        FACT = 1.08
902        IF (IBOITE.NE.0) THEN
903          CALL PROBOI(XC,YC,ZC)
904          DO I=1,8
905            XMAX = MAX(XMAX,XBOITE(I))
906            XMIN = MIN(XMIN,XBOITE(I))
907            YMAX = MAX(YMAX,YBOITE(I))
908            YMIN = MIN(YMIN,YBOITE(I))
909          ENDDO
910          IF (MOD(IECBOI,2).EQ.0.AND.IECBOI.GT.0) FACT = 1.2
911        ENDIF
912        IF (IVIT.LT.0) THEN
913          XMIN = MIN(XMIN,XFMIN)
914          XMAX = MAX(XMAX,XFMAX)
915          YMIN = MIN(YMIN,YFMIN)
916          YMAX = MAX(YMAX,YFMAX)
917        ENDIF
918        XCUR = .5*(XMIN+XMAX)
919        YCUR = .5*(YMIN+YMAX)
920        XL = FACT*(XMAX-XCUR)
921        YH = FACT*(YMAX-YCUR)
922        IF (ICARRE.EQ.1) THEN
923          XLARG = MAX(XL,YH)
924        ELSE
925          XLARG = MAX(XL,YH*HXA4/HYA4)
926        ENDIF
927        XLCRIT = XLARG*.5
928        PASMIN2 = (.0025*XLARG)**2
929        DEBUT = .FALSE.
930      ELSE
931        IF (I2D.EQ.0) THEN
932          IRENO = 0
933        ELSE
934          IRENO = 1
935        ENDIF
936      ENDIF
937C
938      IF (IBATCH.EQ.1) THEN
939c
940c rajout un peu crade pour cadrer correctement les fleches
941c quand on genere un ps directement
942c
943        IF (IVIT.LT.0) THEN
944          CALL ACTPS(NBON,IWAVE,IGOTO)
945          CALL TRACE(NBON,IOPT,GEOM,ITYP,IREFRE,IABAND,IBOUT,0)
946          CALL FINDUPS(IPF)
947          IF (LONPS.GT.0) CALL EXEC('/bin/rm -f '//NOMPS(1:LONPS))
948          XMIN = MIN(XMIN,XFMIN)
949          XMAX = MAX(XMAX,XFMAX)
950          YMIN = MIN(YMIN,YFMIN)
951          YMAX = MAX(YMAX,YFMAX)
952          XCUR = .5*(XMIN+XMAX)
953          YCUR = .5*(YMIN+YMAX)
954          XL = FACT*(XMAX-XCUR)
955          YH = FACT*(YMAX-YCUR)
956          IF (ICARRE.EQ.1) THEN
957            XLARG = MAX(XL,YH)
958          ELSE
959            XLARG = MAX(XL,YH*HXA4/HYA4)
960          ENDIF
961          XLCRIT = XLARG*.5
962          PASMIN2 = (.0025*XLARG)**2
963        ENDIF
964        IBATCH = 2
965        CALL ACTPS(NBON,IWAVE,IGOTO)
966      ENDIF
967      XLAREF = XLARG
968      XCUREF = XCUR
969      YCUREF = YCUR
970      IF (XINIT_ZOOM.NE.BIGS) THEN
971        XLARG = XLARG/XINIT_ZOOM
972        XINIT_ZOOM = BIGS
973      ENDIF
974      IF (XINIT_XCUR.NE.BIGS) THEN
975        XCUR = XINIT_XCUR
976        XINIT_XCUR = BIGS
977      ENDIF
978      IF (XINIT_YCUR.NE.BIGS) THEN
979        YCUR = XINIT_YCUR
980        XINIT_YCUR = BIGS
981      ENDIF
982C
983C Dessin ..........
984C
985 5001 CALL GSLW(0)
986      CALL GSPAT(16)
987      IF (XLARG.LE.XLCRIT) THEN
988        CALL LIBERAL(1)
989      ELSE
990        CALL LIBERAL(0)
991      ENDIF
992      XDMIN0 = XDMIN
993      YDMI20 = YDMI2
994      ICTFAC0 = ICTFAC
995      DXTRANS = 0.
996      DYTRANS = 0.
997      IF (IBACKINGSTORE.EQ.0) IREFRE = 1
998      CALL TRACE(NBON,IOPT,GEOM,ITYP,IREFRE,IABAND,IBOUT,0)
999      GEOM = .FALSE.
1000C
1001C Backing store manuel
1002C
1003      IF (IBACKINGSTORE.EQ.0.AND.IBATCH.EQ.0) CALL mybackingsave
1004C
1005      IF (IQUEST.NE.0) THEN
1006        IF (IQUEST.EQ.1900) GOTO 1900
1007        IF (IQUEST.EQ.2300) GOTO 2300
1008        IF (IQUEST.EQ.3501) GOTO 3501
1009        IF (IQUEST.EQ.3503) GOTO 3503
1010        IF (IQUEST.EQ.4900) GOTO 4900
1011      ENDIF
1012C
1013      IF (IABAND.NE.0) THEN
1014        IF (ILANG.EQ.0) THEN
1015          PRINT*,'Abandon de la sauvegarde PostScript et effacement de '
1016     &       //NOMPS(1:LONPS)
1017        ELSE
1018          PRINT*,'Cancelling PostScript generation and deleting '
1019     &       //NOMPS(1:LONPS)
1020        ENDIF
1021        CALL EXEC('/bin/rm -f '//NOMPS(1:LONPS))
1022        IPOST = 1
1023        IOPT = -3
1024        IREFRE = 1
1025        IMUL = IMULSAUV
1026        CALL x11allevents
1027        CALL CHANGE_CURS(1)
1028        GOTO 5001
1029      ENDIF
1030      IF (IOPT.EQ.-3) THEN
1031        CALL GSLT(0)
1032        IEPBOR = IEPBOR0
1033        CALL GSLW(IEPBOR)
1034        CALL GSBND(XCADRE(1),XCADRE(3),YDMIN,YDMAX)
1035        IF (IDEFPS.EQ.8) THEN
1036          CALL GSCOL(ICTFON)
1037          CALL GSPLNEC(4,XCADRE,YCADRE)
1038          CALL GSLW(0)
1039          IF (IAXES.NE.0) CALL AXES(XHELP,XDMAX,YDMIN,YDMAX)
1040          IF (ILEG.GT.0)
1041     &      CALL LEGENDE(XHELP,XDMAX,YDMIN,YDMAX,BID,BID,BID,BID,1)
1042          CALL LECADRE
1043        ELSE
1044          CALL GSCOL(ICOLAX)
1045          CALL GSPLNEC(4,XCADRE,YCADRE)
1046          CALL GSLW(0)
1047        ENDIF
1048        CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
1049        II = IABS(IBOUT)
1050        IF (II.NE.0) THEN
1051          IF (ITB(II).EQ.9) THEN
1052            CALL MYBORD(XBOUT(1,II),YBOUT(1,II),BID,0,1,0,0)
1053          ELSE
1054            CALL MYBORD(XBOUT(1,II),YBOUT(1,II),BID,0,ITOUR2,7,15)
1055          ENDIF
1056        ENDIF
1057        IX0 = IVRAIECOORD(XHELP)
1058        IX1 = IVRAIECOORD(XDMAX)
1059        PIPI = 2.*(XDMAX-XHELP)/REAL(IABS(IX0-IX1))
1060        XCADRE(1) = XPTHER - DXTHER*.5 - PIPI
1061        XCADRE(2) = XPTHER + DXTHER*.5 + PIPI
1062        YCADRE(1) = YPTHER - DYTHER*.5 - PIPI
1063        YCADRE(2) = YPTHER + DYTHER    + PIPI*3.5
1064        CALL GSPAT(8)
1065        CALL MY_GSAREA2(XCADRE,YCADRE)
1066        CALL GSBND(XDMIN,XDMAX,YDMIN,YDMAX)
1067        CALL METS_CURSEUR(XCUR,YCUR)
1068      ELSEIF(IPOST.EQ.1.AND.ITYP.GT.-13.AND.CLIGNE) THEN
1069        IX0 = IVRAIECOORD(XHELP)
1070        IX1 = IVRAIECOORD(XDMAX)
1071        PIPI = 2.*(XDMAX-XHELP)/REAL(IABS(IX0-IX1))
1072        XCADRE(1) = XPTHER - DXTHER*.5 - PIPI
1073        XCADRE(2) = XPTHER + DXTHER*.5 + PIPI
1074        YCADRE(1) = YPTHER - DYTHER*.5 - PIPI
1075        YCADRE(2) = YPTHER + DYTHER*.5 + PIPI
1076        CALL GSPAT(8)
1077        CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
1078        CALL MY_GSAREA2(XCADRE,YCADRE)
1079      ENDIF
1080      IREFRE = 0
1081      IPREM  = 0
1082      IBHELP = -9999
1083C
1084C Envoi du dessin sur l'ecran
1085C
1086 5002 IF (IBOUT.NE.0) THEN
1087        II = IABS(IBOUT)
1088        KB = KBOUT(II)
1089        IF (ITB(II).EQ.9) THEN
1090          ITO = 1
1091          IC1 = 0
1092          IC2 = 0
1093        ELSE
1094          ITO = ITOUR2
1095          IC1 = 7
1096          IC2 = 15
1097        ENDIF
1098        IF (IBOUT.GT.0) THEN
1099C
1100C mettre dans cette liste tous les boutons qui donnent un popup
1101C dans une fenetre separee.
1102C
1103          IF (IDEROUL.EQ.0.AND.KB.NE.-15.AND.KB.NE.13.AND.KB.NE.19
1104     &       .AND.KB.NE.21.AND.KB.NE.23.AND.KB.NE.36.AND.KB.NE.38) THEN
1105            ITYP = -13
1106          ELSE
1107            ITYP = 0
1108            IDEROUL = 0
1109            CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0,ITO,IC1,IC2)
1110            IBOUT = 0
1111          ENDIF
1112        ELSEIF(ITB(II).GT.0) THEN
1113          IF ((KB.EQ.-20.AND.IPROGRE.LT.0)
1114     &    .OR.(KB.EQ.-17.AND.ITITAV.LT.0)
1115     &    .OR.(KB.EQ.  4.AND.ISHRINK.LT.0)
1116     &    .OR.(KB.EQ.  6.AND.IFC.LT.0)
1117     &    .OR.(KB.EQ. 14.AND.ICARRE.LT.0)
1118     &    .OR.(KB.EQ. 31.AND.ISENS.LT.0)) THEN
1119cc     &    .OR.(KBOUT(II).EQ.-5.AND.IVIT.LT.0)
1120            CALL MYBORD(XBOUT(1,II),YBOUT(1,II),BID,0,ITO,IC2,IC1)
1121          ELSE
1122            CALL MYBORD(XBOUT(1,II),YBOUT(1,II),BID,0,ITO,IC1,IC2)
1123          ENDIF
1124          IF (KB.NE.2.AND.KB.NE.24) IBOUT = 0
1125          IDEROUL = 0
1126        ENDIF
1127        IF (IBACKINGSTORE.EQ.0.AND.IBATCH.EQ.0) THEN
1128          IF (KB.EQ. 2.OR.KB.EQ. 7.OR.KB.EQ.-20
1129     &    .OR.KB.EQ.13.OR.KB.EQ.19
1130     &    .OR.KB.EQ.24.OR.KB.EQ.32
1131     &    .OR.KB.EQ.36.OR.KB.EQ.38
1132     &    .OR.(KB.GE.28.AND.KB.LE.30)) THEN
1133            CALL MYBORD(XBOUT(1,II),YBOUT(1,II),BID,0,ITO,IC1,IC2)
1134            CALL mybackingsave
1135          ENDIF
1136        ENDIF
1137      ENDIF
1138      XCONT = XDMA2 - PIXEL*5.
1139      YCONT = .5*(YDMI2 + YDMIN)-PIXEL
1140      IF (I2D.NE.0) THEN
1141        CALL ASFCOL(0)
1142        IF (IFONT8.EQ.9) THEN
1143          CALL GSLSS(9)
1144        ELSE
1145          CALL GSLSS(0)
1146        ENDIF
1147        CALL GSPATF(8)
1148        CALL GSPAT(16)
1149      ENDIF
1150      IOPT = 1
1151      IF (IFREEZE.NE.0) THEN
1152        CALL GSQCUR(WIN,XCUCU,YCUCU)
1153        IF (XCUCU.LE.XHELP) THEN
1154          CALL CHANGE_CURS(2)
1155        ELSE
1156          CALL CHANGE_CURS(1)
1157        ENDIF
1158      ENDIF
1159C
1160      IF (IBRELON.EQ.0.OR.IBACKINGSTORE.EQ.0) THEN
1161        CALL AREFRESH(IRELIM,IRELIVA,IRELIVI)
1162        IF (IRELIM.NE.0.OR.IRELIVA.NE.0.OR.IRELIVI.NE.0) THEN
1163          IF (IAUTORELOAD.EQ.0) THEN
1164            CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,1,ITYP,0,IBREL)
1165          ELSE
1166            IBOUT = IBREL
1167            GOTO 4906
1168          ENDIF
1169        ENDIF
1170      ENDIF
1171      NBEV = 0
1172C
1173C//////////////////////////////////////////////////////////////
1174 5003 CALL ASREAD2(IIII,IPFK,ITYP)
1175C//////////////////////////////////////////////////////////////
1176      IF (IDEBUG.NE.0) PRINT*,'Apr�s ASREAD2',IIII,IPFK,ITYP,IBOUT
1177      IF (IBATCH.EQ.2) STOP
1178C
1179      IF ((DXTRANS.NE.0..OR.DYTRANS.NE.0.)
1180     &     .AND.(IPFK.LT.549.OR.IPFK.GT.552)
1181     &     .AND.IPFK.NE.5.AND.IPFK.NE.-14
1182     &     .AND.(ITYP.NE.-14.OR.IPFK.NE.-9999)) THEN
1183cc        print*,'recalcule dim'
1184        DXTRANS = 0.
1185        DYTRANS = 0.
1186        CALL CALCDIM(YYLAR,0)
1187      ENDIF
1188C
1189      IF (IBRELON.EQ.0.OR.IBACKINGSTORE.EQ.0) THEN
1190        NBEV = NBEV+1
1191        IF (NBEV.GE.40.AND.IPFK.EQ.-9999.AND.ITYP.EQ.0
1192     & .AND.INUMINTER.EQ.0.AND.IPREM.EQ.0) THEN
1193          NBEV = 0
1194          CALL AREFRESH(IRELIM,IRELIVA,IRELIVI)
1195          IF (IRELIM.NE.0.OR.IRELIVA.NE.0.OR.IRELIVI.NE.0) THEN
1196            IF (IAUTORELOAD.EQ.0) THEN
1197              CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,1,ITYP,0,IBREL)
1198              CALL GSPATF(8)
1199            ELSE
1200              IBOUT = IBREL
1201              GOTO 4906
1202            ENDIF
1203          ENDIF
1204        ENDIF
1205      ENDIF
1206C
1207      IF (ITYP.EQ.0.AND.IPFK.EQ.-9999.AND.IFREEZE.EQ.0) THEN
1208        CALL GSQCUR(WIN,XCUCU,YCUCU)
1209        IF (IPREM.GE.1) THEN
1210          CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
1211          IF (IPREM.EQ.2) THEN
1212            CALL GSMOVE(XCUR0-XLARG0,YCUR0-YLARG0)
1213            CALL GSLINE(XCUR0+XLARG0,YCUR0-YLARG0)
1214            CALL GSLINE(XCUR0+XLARG0,YCUR0+YLARG0)
1215            CALL GSLINE(XCUR0-XLARG0,YCUR0+YLARG0)
1216            CALL GSLINE(XCUR0-XLARG0,YCUR0-YLARG0)
1217          ELSE
1218            IPREM = 2
1219            CALL GSLT(0)
1220            CALL GSCOL(5)
1221            IF (I2D.NE.0) THEN
1222              CALL ASFCOL(0)
1223              IF (IFONT8.EQ.9) THEN
1224                CALL GSLSS(9)
1225              ELSE
1226                CALL GSLSS(0)
1227              ENDIF
1228            ENDIF
1229          ENDIF
1230          XCUR2 = XCUCU
1231          YCUR2 = YCUCU
1232          XCUR0 = .5*(XCUR1+XCUR2)
1233          YCUR0 = .5*(YCUR1+YCUR2)
1234          XXLARG = .5*ABS(XCUR1-XCUR2)
1235          YYLARG = .5*ABS(YCUR1-YCUR2)
1236          IF (ICARRE.EQ.1) THEN
1237            XLARG0 = AMAX1(XXLARG,YYLARG)
1238            YLARG0 = XLARG0
1239          ELSE
1240            XLARG0 = AMAX1(XXLARG,YYLARG*HXA4/HYA4)
1241            YLARG0 = XLARG0*HYA4/HXA4
1242          ENDIF
1243          IF (XLARG0.EQ.0.) THEN
1244            XLARG0 = XLARG
1245            IF (ICARRE.EQ.1) THEN
1246              YLARG0 = XLARG0
1247            ELSE
1248              YLARG0 = XLARG0*HYA4/HXA4
1249            ENDIF
1250          ENDIF
1251          CALL GSMOVE(XCUR0-XLARG0,YCUR0-YLARG0)
1252          CALL GSLINE(XCUR0+XLARG0,YCUR0-YLARG0)
1253          CALL GSLINE(XCUR0+XLARG0,YCUR0+YLARG0)
1254          CALL GSLINE(XCUR0-XLARG0,YCUR0+YLARG0)
1255          CALL GSLINE(XCUR0-XLARG0,YCUR0-YLARG0)
1256          IF (I2D.NE.0) THEN
1257            CALL GSMIX(0)
1258            CALL AFFCOORD(XCONT,YCONT
1259     &                   ,XMED0+XCUCU*R2R3
1260     &                   ,YMED0+YCUCU*R2R3,BID,2,0)
1261            CALL GSMIX(1)
1262          ENDIF
1263        ELSEIF(INUMINTER.GT.0) THEN
1264          IF (INUMINTER.LE.2) THEN
1265            DISMIN = BIG
1266            NN = 0
1267            IOK = 0
1268            NOK = 0
1269            DO N=1,NBON
1270              DO I=1,NDS
1271                D2 = (XCUCU-XX(I,N))**2+(YCUCU-YY(I,N))**2
1272                IF (D2.LT.DISMIN) THEN
1273                  IOK = I
1274                  NOK = N
1275                  NE = NPROJE(N)
1276                  NN = NFAC(I,NE)
1277                  DISMIN = D2
1278                ENDIF
1279              ENDDO
1280            ENDDO
1281            XJEUNE = XX(IOK,NOK)
1282            YJEUNE = YY(IOK,NOK)
1283            CALL GSMS(5)
1284            CALL GSMB(PIPI*3.,PIPI*3.)
1285          ELSE
1286            DISMIN = BIG
1287            NN = 0
1288            IOK = 0
1289            NOK = 0
1290            IF (NDS.EQ.3) THEN
1291              XCUCU3 = 3.*XCUCU
1292              YCUCU3 = 3.*YCUCU
1293              DO N=1,NBON
1294                XCC = XX(1,N)+XX(2,N)+XX(3,N)
1295                YCC = YY(1,N)+YY(2,N)+YY(3,N)
1296                D2  = (XCUCU3-XCC)**2+(YCUCU3-YCC)**2
1297                IF (D2.LT.DISMIN) THEN
1298                  NOK = N
1299                  DISMIN = D2
1300                  XCCMIN = XCC/3.
1301                  YCCMIN = YCC/3.
1302                ENDIF
1303              ENDDO
1304            ELSE
1305              XCUCU4 = 4.*XCUCU
1306              YCUCU4 = 4.*YCUCU
1307              DO N=1,NBON
1308                XCC = XX(1,N)+XX(2,N)+XX(3,N)+XX(4,N)
1309                YCC = YY(1,N)+YY(2,N)+YY(3,N)+YY(4,N)
1310                D2  = (XCUCU4-XCC)**2+(YCUCU4-YCC)**2
1311                IF (D2.LT.DISMIN) THEN
1312                  NOK = N
1313                  DISMIN = D2
1314                  XCCMIN = XCC*.25
1315                  YCCMIN = YCC*.25
1316                ENDIF
1317              ENDDO
1318            ENDIF
1319            NE = NPROJE(NOK)
1320            NN = NNUMFA(NE)
1321            XJEUNE = XCCMIN
1322            YJEUNE = YCCMIN
1323          ENDIF
1324          IF (INUMINTER.GE.2) THEN
1325            IF (XJEUNE.NE.XVIEUX.OR.YJEUNE.NE.YVIEUX) THEN
1326              CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
1327              IF (INUMINTER.EQ.2) THEN
1328                CALL GSCOL(7)
1329                CALL GSMARK(XVIEUX,YVIEUX)
1330              ELSE
1331                CALL GSPATF(1)
1332                CALL GSPAT(16)
1333                CALL MY_GSAREA(0,XX(1,NNVIEUX),YY(1,NNVIEUX),NDS)
1334              ENDIF
1335              CALL GSCHAR3(XVIEUX,YVIEUX,L,CNUM,ICENT0,-1)
1336            ELSE
1337              GOTO 5003
1338            ENDIF
1339          ELSE
1340            INUMINTER = 2
1341            CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
1342            CALL METS_CURSEUR(XX(IOK,NOK),YY(IOK,NOK))
1343          ENDIF
1344          XVIEUX = XJEUNE
1345          YVIEUX = YJEUNE
1346          IF (INUMINTER.EQ.2) THEN
1347            NNVIEUX = NN
1348          ELSE
1349            NNVIEUX = NOK
1350          ENDIF
1351          IF (NN.LT.10) THEN
1352            WRITE(CNUM(1:1),'(I1)') NN
1353            L = 1
1354          ELSEIF(NN.LT.100) THEN
1355            WRITE(CNUM(1:2),'(I2)') NN
1356            L = 2
1357          ELSEIF(NN.LT.1000) THEN
1358            WRITE(CNUM(1:3),'(I3)') NN
1359            L = 3
1360          ELSEIF(NN.LT.10000) THEN
1361            WRITE(CNUM(1:4),'(I4)') NN
1362            L = 4
1363          ELSEIF(NN.LT.100000) THEN
1364            WRITE(CNUM(1:5),'(I5)') NN
1365            L = 5
1366          ELSEIF(NN.LT.1000000) THEN
1367            WRITE(CNUM(1:6),'(I6)') NN
1368            L = 6
1369          ELSE
1370            WRITE(CNUM(1:7),'(I7)') NN
1371            L = 7
1372          ENDIF
1373          IF (INUMINTER.EQ.2) THEN
1374            CALL GSCOL(7)
1375            CALL GSMARK(XVIEUX,YVIEUX)
1376          ELSE
1377            CALL GSPATF(1)
1378            CALL GSPAT(16)
1379            CALL MY_GSAREA(0,XX(1,NNVIEUX),YY(1,NNVIEUX),NDS)
1380          ENDIF
1381          CALL GSCHAR3(XVIEUX,YVIEUX,L,CNUM,ICENT,-1)
1382          ICENT0 = ICENT
1383          IF (I2D.NE.0) THEN
1384            IF (INUMINTER.EQ.2) THEN
1385              CALL AFFCOORD(XCONT,YCONT
1386     &                     ,XMED0+XX(IOK,NOK)*R2R3
1387     &                     ,YMED0+YY(IOK,NOK)*R2R3,BID,2,NN)
1388            ELSE
1389              CALL AFFCOORD(XCONT,YCONT
1390     &                     ,XMED0+XCUCU*R2R3
1391     &                     ,YMED0+YCUCU*R2R3,BID,2,NN)
1392            ENDIF
1393            CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
1394            CALL GSLSS(IFONT1)
1395            CALL ASFCOL(5)
1396          ELSEIF(INUMINTER.EQ.2) THEN
1397            CALL INV3X3(ROTA,ROTAINV,IERR)
1398            XINI = ROTAINV(1,1)*X(NN)
1399     &           + ROTAINV(1,2)*Y(NN) + ROTAINV(1,3)*Z(NN)
1400            YINI = ROTAINV(2,1)*X(NN)
1401     &           + ROTAINV(2,2)*Y(NN) + ROTAINV(2,3)*Z(NN)
1402            ZINI = ROTAINV(3,1)*X(NN)
1403     &           + ROTAINV(3,2)*Y(NN) + ROTAINV(3,3)*Z(NN)
1404            CALL AFFCOORD(XCONT,YCONT,XMED0+XINI,YMED0+YINI,ZMED0+ZINI,3
1405     &                   ,NN)
1406            CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
1407            CALL GSLSS(IFONT1)
1408            CALL ASFCOL(5)
1409          ENDIF
1410          GOTO 5003
1411        ELSEIF(XCUCU.GE.XHELP) THEN
1412          IF (IBHELP.GE.0) THEN
1413            IBHELP = -9999
1414            CALL CLNINF(1)
1415          ENDIF
1416          IF (I2D.NE.0) CALL AFFCOORD(XCONT,YCONT
1417     &                               ,XMED0+XCUCU*R2R3
1418     &                               ,YMED0+YCUCU*R2R3,BID,2,0)
1419        ELSE
1420          CALL QBOUT(XCUCU,YCUCU,IBBB)
1421          IF (IBBB.EQ.0) THEN
1422            IF (IBBB.NE.IBHELP) THEN
1423              IBHELP = 0
1424              CALL CLNINF(0)
1425            ENDIF
1426          ELSE
1427            IF (ITB(IBBB).EQ.6) THEN
1428              IF (IBHELP.NE.0) THEN
1429                IBHELP = 0
1430                CALL CLNINF(0)
1431              ENDIF
1432            ELSEIF(IBBB.NE.IBHELP) THEN
1433              IBHELP = IBBB
1434              CALL ECHELP(IBHELP,0)
1435            ENDIF
1436          ENDIF
1437        ENDIF
1438        GOTO 5003
1439      ELSEIF(IPREM.NE.0.AND.IPFK.NE.26.AND.IPFK.NE.0) THEN
1440        GOTO 5003
1441      ENDIF
1442      IF (INUMINTER.NE.0) THEN
1443        IF (IPFK.EQ.0.OR.IPFK.EQ.26) THEN
1444          CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
1445          CALL GSCHAR3(XVIEUX,YVIEUX,L,CNUM,ICENT,-1)
1446          CALL GSMIX(0)
1447          CALL GSBND(XDMIN,XHELP,YDMIN,YDMAX)
1448          CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0
1449     &               ,ITOUR2,7,15)
1450          IF (INUMINTER.EQ.2) THEN
1451            IF (I2D.EQ.0) THEN
1452              CALL AFFCOORD(XCONT,YCONT,BID,BID,BID,0,0)
1453              IF (ILANG.EQ.0) THEN
1454                PRINT*,'Dernier noeud :',NNVIEUX,' ('
1455     &               ,XMED0+XINI,',',YMED0+YINI,',',ZMED0+ZINI,')'
1456              ELSE
1457                PRINT*,'Last node:',NNVIEUX,' ('
1458     &               ,XMED0+XINI,',',YMED0+YINI,',',ZMED0+ZINI,')'
1459              ENDIF
1460            ELSE
1461              IF (ILANG.EQ.0) THEN
1462                PRINT*,'Dernier noeud :',NNVIEUX,' ('
1463     &           ,XMED0+XX(IOK,NOK)*R2R3,',',YMED0+YY(IOK,NOK)*R2R3,')'
1464              ELSE
1465                PRINT*,'Last node:',NNVIEUX,' ('
1466     &           ,XMED0+XX(IOK,NOK)*R2R3,',',YMED0+YY(IOK,NOK)*R2R3,')'
1467              ENDIF
1468            ENDIF
1469          ENDIF
1470          INUMINTER = 0
1471          CALL CLNINF(0)
1472          CALL CHANGE_CURS(1)
1473        ELSEIF(IPFK.EQ.-13) THEN
1474          IF (INUMINTER.EQ.2) THEN
1475            IF (I2D.EQ.0) CALL AFFCOORD(XCONT,YCONT,BID,BID,BID,0,0)
1476            INUMINTER = 3
1477            ICENT = 5
1478          ELSE
1479            INUMINTER = 2
1480            ICENT = 7
1481          ENDIF
1482          CALL GSMIX(0)
1483          CALL CLNINF(INUMINTER)
1484          CALL GSLSS(IFONT1)
1485          CALL GSMIX(1)
1486          CALL ASFCOL(5)
1487          CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
1488          GOTO 5003
1489        ELSE
1490          GOTO 5003
1491        ENDIF
1492      ENDIF
1493      CALL ASFCOL(ICOLAX)
1494      CALL GSMIX(0)
1495C
1496      IF (IIII.LT.0) THEN
1497        CALL x11szscrn(IDX2,IDY2)
1498        IF (IDX.NE.IDX2.OR.IDY.NE.IDY2) THEN
1499cc          GEOM = .FALSE.
1500          CALL GSCLR
1501          GOTO 5001
1502        ELSE
1503          GOTO 5003
1504        ENDIF
1505      ELSEIF(IPFK.EQ.9999) THEN
1506        IPOST = 1
1507        IOPT = -3
1508        IREFRE = 1
1509        IMUL = IMULSAUV
1510        CALL x11allevents
1511        GOTO 5001
1512      ELSEIF(IBOUT.GT.0.AND.ITB(IBOUT).GT.0) THEN
1513cc        CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
1514        IF ((KBOUT(IBOUT).EQ.-20.AND.IPROGRE.LT.0)
1515     &  .OR.(KBOUT(IBOUT).EQ.-17.AND.ITITAV.LT.0)
1516     &  .OR.(KBOUT(IBOUT).EQ. 4.AND.ISHRINK.LT.0)
1517     &  .OR.(KBOUT(IBOUT).EQ. 6.AND.IFC.LT.0)
1518     &  .OR.(KBOUT(IBOUT).EQ.14.AND.ICARRE.LT.0)
1519     &  .OR.(KBOUT(IBOUT).EQ.31.AND.ISENS.LT.0)) THEN
1520ccc     &  .OR.(KBOUT(IBOUT).EQ.-5.AND.IVIT.LT.0)
1521          CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0,ITOUR2,15,7)
1522        ELSEIF(ITB(IBOUT).EQ.9) THEN
1523          CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0,1,0,0)
1524        ELSE
1525          CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0,ITOUR2,7,15)
1526        ENDIF
1527        CALL viderbuff2
1528        IBOUT = 0
1529        ITYP  = 0
1530        GOTO 5002
1531      ELSEIF(ITYP.NE.0.AND.IFREEZE.EQ.0) THEN
1532        IF (IPFK.EQ.-9999) THEN
1533          IPFK = ITYP
1534        ELSE
1535          CALL CHANGE_CURS(1)
1536          IF (ITYP.EQ.-13) THEN
1537Cfj            DO J=1,3
1538Cfj              DO I=1,3
1539Cfj                ROTA0(I,J) = ROTA(I,J)
1540Cfj                ROTA(I,J)  = ROTAINV(I,J)
1541Cfj              ENDDO
1542Cfj            ENDDO
1543Cfj            CALL ROTATE(0)
1544Cfj            DO J=1,3
1545Cfj              DO I=1,3
1546Cfj                ROTA(I,J) = ROTA0(I,J)
1547Cfj              ENDDO
1548Cfj            ENDDO
1549            CALL MULT(ROTAINV,ROTA)
1550            DO J=1,3
1551              DO I=1,3
1552                ROTA0(I,J) = ROTA(I,J)
1553                ROTA(I,J)  = ROTAINV(I,J)
1554              ENDDO
1555            ENDDO
1556Cfj
1557            CALL ROTATE(0)
1558            DO J=1,3
1559              DO I=1,3
1560                ROTA(I,J) = ROTA0(I,J)
1561              ENDDO
1562            ENDDO
1563            ITYP = 0
1564            IBOUT = IBROT
1565            GEOM = .TRUE.
1566            GOTO 5000
1567          ELSE
1568            ITYP = 0
1569            IREFRE = 1
1570            IOPT = -4
1571            GEOM = .TRUE.
1572            GOTO 5001
1573          ENDIF
1574        ENDIF
1575      ENDIF
1576C
1577C Zoom interactif (0) annule par Q
1578C
1579      IF (IPFK.EQ.0) THEN
1580        CALL GSQCUR(WIN,XCUCU,YCUCU)
1581        IF (XCUCU.LT.XHELP) THEN
1582          CALL QBOUT(XCUCU,YCUCU,IBBB)
1583Cfj          IF (IBBB.EQ.IBFREEZ) THEN
1584Cfj            CALL GSBND(XDMIN,XDMA2,YDMIN,YDMAX)
1585Cfj            CALL GSPAT(15)
1586Cfj            CALL GSMIX(1)
1587Cfj            CALL MY_GSAREA2B(XHELP,XDMA2,YDMIN,YDMAX)
1588Cfj            CALL GSMIX(0)
1589Cfj            IF (IFREEZE.EQ.0) THEN
1590Cfj              IFREEZE = 1
1591Cfj              IBOUBOU = 0
1592Cfj              CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,1,ITYP,IOPT,IBOUBOU)
1593Cfj              GOTO 5003
1594Cfj            ELSE
1595Cfj              IFREEZE = 0
1596Cfj              IBOUT = IBFREEZ
1597Cfj              CALL GSPAT(8)
1598Cfj              CALL MY_GSAREA2(XBOUT(1,IBOUT),YBOUT(1,IBOUT))
1599Cfj              IREFRE = 1
1600Cfj              GEOM = .FALSE.
1601Cfj              GOTO 5001
1602Cfj            ENDIF
1603Cfj          ELSEIF(IBBB.GT.0) THEN
1604          IF (IBBB.GT.0) THEN
1605Cfj
1606            IF (ITB(IBBB).NE.6.AND.ITB(IBBB).GT.0) THEN
1607              IF (IACTIF(IBBB).EQ.0) GOTO 5002
1608              IF (ITB(IBBB).GT.0) THEN
1609                CALL GSBND(XDMIN,XHELP,YDMIN,YDMAX)
1610                CALL MYBORD(XBOUT(1,IBBB),YBOUT(1,IBBB),BID,0,ITOUR2
1611     &                     ,15,7)
1612                CALL viderbuff2
1613              ENDIF
1614              IBOUT = IBBB
1615              IF (IBOUT.EQ.IBDOC) THEN
1616                CALL QUICESTCELUILA('gv',2,GVESTLA,0)
1617                IF (GVESTLA) THEN
1618                  CALL EXEC('gv '//CHEMDOC(1:LENCHEM)//'&')
1619                ELSE
1620                  CALL QUICESTCELUILA('ghostview',9,GVESTLA,0)
1621                  IF (GVESTLA)
1622     &              CALL EXEC('ghostview '//CHEMDOC(1:LENCHEM)//'&')
1623                ENDIF
1624                GOTO 5002
1625              ELSEIF(IBOUT.EQ.IBLANG) THEN
1626                GOTO 3505
1627              ELSE
1628                IPFK = KBOUT(IBOUT)
1629                IF (IMENU(IBOUT).NE.0) THEN
1630                  CALL GSBND(XDMIN,XDMAX,YDMI2,YDMAX)
1631                  CALL MENUS(IPFK,IBOUT,IDEROUL,IRC)
1632                  IF (IDEROUL.EQ.0) THEN
1633                    ITYP = 0
1634                    GOTO 5003
1635                  ENDIF
1636                  IF (IPFK.EQ.-18.AND.ICOURB.GT.0) THEN
1637                    IF (IDEROUL.GE.2) THEN
1638                      IF (IDEROUL.EQ.2) THEN
1639                        INUMER = -3
1640                      ELSEIF(IDEROUL.EQ.3) THEN
1641                        INUMER = 0
1642                      ELSEIF(IDEROUL.EQ.4) THEN
1643                        INUMER = -1
1644                      ELSEIF(IDEROUL.EQ.5) THEN
1645                        INUMER = 1
1646                      ELSE
1647                        INUMER = -2
1648                      ENDIF
1649                      GOTO 4903
1650                    ENDIF
1651                    IF (INUMINTER.EQ.0) THEN
1652                      INUMINTER = 1
1653                      CALL CHANGE_CURS(11)
1654                      CALL GSBND(XDMIN,XHELP,YDMIN,YDMAX)
1655                      CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0
1656     &                           ,ITOUR2,15,7)
1657                      CALL viderbuff2
1658                      CALL CLNINF(2)
1659                      CALL ASFCOL(5)
1660                      CALL GSMIX(1)
1661                      CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
1662                      IX0 = IVRAIECOORD(XHELP)
1663                      IX1 = IVRAIECOORD(XDMAX)
1664                      PIPI = 2.*(XDMAX-XHELP)/REAL(IABS(IX0-IX1))
1665                      CALL GSLSS(IFONT1)
1666                      ICENT = 7
1667                    ELSE
1668                      CALL ASFCOL(5)
1669                      CALL GSMIX(1)
1670                      CALL GSCHAR3(XVIEUX,YVIEUX,L,CNUM,ICENT,-1)
1671                      CALL GSMIX(0)
1672                      CALL GSBND(XDMIN,XHELP,YDMIN,YDMAX)
1673                      CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0
1674     &                           ,ITOUR2,7,15)
1675                      CALL viderbuff2
1676                      CALL CHANGE_CURS(2)
1677                      INUMINTER = 0
1678                    ENDIF
1679                    GOTO 5003
1680                  ELSEIF(IPFK.EQ.-6) THEN
1681                    IF (IDEROUL.EQ.1) THEN
1682                      GOTO 4100
1683                    ELSE
1684                      IDBID = MOD(IDEROUL-2,7) + 1
1685                      IF (IDEROUL.EQ.16) THEN
1686                        FFF = -1.
1687                      ELSEIF(IDBID.EQ.1) THEN
1688                        FFF = 1.1
1689                      ELSEIF(IDBID.EQ.2) THEN
1690                        FFF = 1.5
1691                      ELSEIF(IDBID.EQ.3) THEN
1692                        FFF = 2.
1693                      ELSEIF(IDBID.EQ.4) THEN
1694                        FFF = 3.
1695                      ELSEIF(IDBID.EQ.5) THEN
1696                        FFF = 4.
1697                      ELSEIF(IDBID.EQ.6) THEN
1698                        FFF = 5.
1699                      ELSE
1700                        FFF = 10.
1701                      ENDIF
1702                      IF (IDEROUL.LT.9) THEN
1703                        FACVIT  = FACVIT*FFF
1704                        FACVIT0 = FACVIT0*FFF
1705                      ELSE
1706                        FACVIT  = FACVIT/FFF
1707                        FACVIT0 = FACVIT0/FFF
1708                      ENDIF
1709                      GEOM = .TRUE.
1710                      GOTO 5001
1711                    ENDIF
1712                  ELSEIF(IPFK.EQ.-5) THEN
1713                    GOTO 4000
1714                  ELSEIF(IPFK.EQ.-2) THEN
1715                    GOTO 5000
1716                  ELSEIF(IPFK.EQ.3) THEN
1717                    GOTO 301
1718                  ELSEIF(IPFK.EQ.11) THEN
1719                    GOTO 1101
1720                  ELSEIF(IPFK.EQ.15.OR.IPFK.EQ.33.OR.IPFK.EQ.-1) THEN
1721                    GOTO 5001
1722                  ELSEIF(IPFK.EQ.17.AND.IACTIF(IBOUT).NE.0) THEN
1723                    ISOINI = IRC
1724                    GOTO 1701
1725                  ELSEIF(IPFK.EQ.20.AND.ITABLE.GT.3000) THEN
1726                    ITABLE = ITABLE-4000
1727                    ICTFAC = ICTFAC+4000
1728                    GOTO 2500
1729                  ELSEIF(IPFK.EQ.22) THEN
1730                    GOTO 2200
1731                  ELSEIF(IPFK.EQ.25) THEN
1732                    IF (ICTFAC.GT.3000) THEN
1733                      GOTO 2500
1734                    ELSE
1735                      GOTO 2502
1736                    ENDIF
1737                  ELSEIF(IPFK.EQ.27) THEN
1738                    ISOBID = IDEROUL
1739                    GOTO 2702
1740                  ELSEIF(IPFK.EQ.28) THEN
1741                    GOTO 2801
1742                  ENDIF
1743                ENDIF
1744                GOTO 7000
1745              ENDIF
1746            ENDIF
1747          ENDIF
1748        ELSEIF(IPREM.EQ.0.AND.XCUCU.GT.XDMAX) THEN
1749          GOTO 4300
1750        ELSEIF(IPREM.EQ.0.AND.IFREEZE.EQ.0) THEN
1751          IPREM = 1
1752          XCUR1 = XCUCU
1753          YCUR1 = YCUCU
1754          CALL ECHELP(NBOUT+1,1)
1755          CALL GSMIX(1)
1756          SIZMAR = .1*(XDMAX-XHELP)
1757          CALL GSMB(SIZMAR,SIZMAR)
1758          CALL GSMS(1)
1759          CALL GSCOL(7)
1760          CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
1761          CALL GSMARK(XCUR1,YCUR1)
1762          CALL GSMARK(XDMAX-(XCUR1-XHELP),YCUR1)
1763          CALL GSMARK(XDMAX-(XCUR1-XHELP),YDMAX-(YCUR1-YDMIN))
1764          CALL GSMARK(XCUR1,YDMAX-(YCUR1-YDMIN))
1765          IZOOMBID = 0
1766          GOTO 5003
1767        ELSEIF(IPREM.EQ.1) THEN
1768          IPFK = 26
1769          IZOOMBID = 1
1770        ELSEIF(IPREM.EQ.2) THEN
1771          XCUR = XCUR0
1772          YCUR = YCUR0
1773          FACVIT = FACVIT*XLARG/XLARG0
1774          XLARG = XLARG0
1775          PASMIN2 = (.0025*XLARG)**2
1776          ITYP   = 0
1777          IREFRE = 1
1778          IOPT = -4
1779          GEOM = .TRUE.
1780          CALL CHANGE_CURS(1)
1781          GOTO 5001
1782        ENDIF
1783      ENDIF
1784      IDEROUL = 0
1785 7000 IPOSTCOL = 0
1786      IF (IFREEZE.NE.0) THEN
1787        IF (IPFK.EQ.-9999) GOTO 5003
1788        IF (IPFK.EQ.0.OR.IPFK.EQ.-13.OR.IPFK.EQ.-14) THEN
1789          CALL GSQCUR(WIN,XCUCU,YCUCU)
1790          IF (XCUCU.GE.XHELP) GOTO 5003
1791        ELSE
1792          IBOUBOU = -6666
1793          DO I=1,NBOUT
1794            IF (KBOUT(I).EQ.IPFK.AND.IACTIF(I).NE.0) IBOUBOU=I
1795          ENDDO
1796          IF (IBOUBOU.EQ.-6666) GOTO 5003
1797        ENDIF
1798      ELSE
1799        IF (ITYP.EQ.0.AND.(IPFK.EQ.-13.OR.IPFK.EQ.-14)) THEN
1800          CALL GSQCUR(WIN,XCUCU,YCUCU)
1801          IF (XCUCU.GE.XDMAX) THEN
1802C
1803C Pour recalculer la position de la table...
1804C
1805            CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
1806            CALL INFO(XDMAX,XDMA2,YDMIN,YDMAX,NSURF)
1807            IF (ISO.NE.0.OR.ICTFAC.GE.0) THEN
1808              FACT = (YCUCU-YCOUL(1))/(YCOUL(NBCOL+1)-YCOUL(1))
1809              IF (ISO.EQ.2) THEN
1810                ICPOINT = 19+NINT(FACT*REAL(NBCOL-1))
1811              ELSE
1812                ICPOINT = 18+NINT(.5+FACT*REAL(NBCOL))
1813              ENDIF
1814              IF (ICPOINT.GE.19.AND.ICPOINT.LE.NBCOL+18) THEN
1815                YBIDONCOM = YCUCU
1816                IBOUT = 3333
1817                CALL GSBND(XDMIN,XDMA2,YDMI2,YDMAX)
1818                CALL MENUS(IPFK,IBOUT,IDEROUL,ICPOINT)
1819                IF (IDEROUL.GE.1.AND.IDEROUL.LE.16) THEN
1820                  CALL TABCOL(-(IDEROUL*1000+ICPOINT),IWAVE)
1821                  IF (ITERMC.EQ.4) THEN
1822                    GOTO 5001
1823                  ELSE
1824                    GOTO 5003
1825                  ENDIF
1826                ELSE
1827                  GOTO 5003
1828                ENDIF
1829              ELSE
1830                GOTO 5003
1831              ENDIF
1832            ELSE
1833                GOTO 5003
1834            ENDIF
1835          ENDIF
1836        ENDIF
1837      ENDIF
1838      NEGNEG = -21
1839      IF (IDEBUG.NE.0) PRINT*,'Avant GOTO, IPFK=',IPFK,' IBOUT=',IBOUT
1840      IF (IPFK.NE.NEGNEG.AND.IPFK.NE.2.AND.IPFK.NE.24.AND.IPFK.NE.28
1841     & .AND.IPFK.NE.9999.AND.IPFK.NE.-9.AND.IPFK.NE.26) NBPG = 0
1842      IF (IPFK.GE.NEGNEG.AND.IPFK.LE.39.AND.IPFK.NE.0) THEN
1843        IF (IBOUT.EQ.0) THEN
1844          DO I=1,NBOUT
1845            IF (KBOUT(I).EQ.IPFK.AND.KBOUT(I).GT.-10000
1846     &           .AND.LBOUT(I).GT.0) THEN
1847              IBOUT = -I
1848              IF (IPFK.NE.-9)
1849     &             CALL MYBORD(XBOUT(1,I),YBOUT(1,I),BID,0,ITOUR2,15,7)
1850              GOTO 7001
1851            ENDIF
1852          ENDDO
1853        ENDIF
1854 7001   GOTO (4906,4905,4904,4903,4902,4901,4900,501,4800,4700
1855     &       ,4600,4500,4400,4300,4200,4100,4000,3900,3800,3700,3600
1856     &       ,5003
1857     &       ,100,200,300,400,500,600,700,800,900,1000,1100,1200,1300
1858     &       ,1400,1500,1600,1700,1800,1900,2000,2100,2200,2300,2400
1859     &       ,2500,2600,2700,2800,2900,3000,3100,3200,3300,3400,3500
1860     &       ,3501,3502,3503,3504) IPFK+1-NEGNEG
1861C
1862C Fleches du clavier
1863C
1864      ELSEIF(IPFK.GE.549.AND.IPFK.LE.552.AND.IPROGRE.LT.0) THEN
1865        TRANS0 = (XDMAX-XHELP)*.0025
1866        IF (IPFK.EQ.549) THEN
1867          DYTRANS = DYTRANS+TRANS0
1868        ELSEIF(IPFK.EQ.550) THEN
1869          DXTRANS = DXTRANS-TRANS0
1870        ELSEIF(IPFK.EQ.551) THEN
1871          DXTRANS = DXTRANS+TRANS0
1872        ELSE
1873          DYTRANS = DYTRANS-TRANS0
1874        ENDIF
1875        XCUR = XMIL-DXTRANS
1876        YCUR = YMIL-DYTRANS
1877        GOTO 503
1878      ELSE
1879        GOTO 5003
1880      ENDIF
1881C//////////////////////////////////////////////////////////////
1882C
1883C Symetries (1)
1884C
1885 100  NF0 = NFACE
1886      NRECON0 = NRECON
1887      IF (IDEROUL.EQ.0) THEN
1888        NRECON = NRECON+1
1889        IF (NRECON.GT.NRECONMAX) NRECON=1
1890      ELSE
1891        NRECON = MIN(NRECONMAX,IDEROUL)
1892      ENDIF
1893      NFACE = NF*NRECON
1894C
1895      IF (NFACE.NE.NF0) THEN
1896        CALL SYMETRISE(NRECON0,0)
1897        IF (NSURF.GT.0) CALL CALSUR(1)
1898        GEOM = .TRUE.
1899        GOTO 5000
1900      ELSE
1901        GOTO 5003
1902      ENDIF
1903C
1904C Sauvegarde (Postscript et Postscript couleur) (2, O)
1905C
1906 200  CALL ACTPS(NBON,IWAVE,IGOTO)
1907      IF (IGOTO.EQ.5001) THEN
1908        GOTO 5001
1909      ELSE
1910        GOTO 5003
1911      ENDIF
1912C
1913C Fin ou annulation du zoom interactif (Q)
1914C
1915 2600 IF (IPREM.EQ.0) THEN
1916        GOTO 999
1917      ELSE
1918        IF (IZOOMBID.EQ.0) THEN
1919          CALL GSMIX(1)
1920          CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
1921          CALL GSMOVE(XCUR0-XLARG0,YCUR0-YLARG0)
1922          CALL GSLINE(XCUR0+XLARG0,YCUR0-YLARG0)
1923          CALL GSLINE(XCUR0+XLARG0,YCUR0+YLARG0)
1924          CALL GSLINE(XCUR0-XLARG0,YCUR0+YLARG0)
1925          CALL GSLINE(XCUR0-XLARG0,YCUR0-YLARG0)
1926          CALL GSCOL(7)
1927          CALL GSMARK(XCUR1,YCUR1)
1928          CALL GSMARK(XDMAX-(XCUR1-XHELP),YCUR1)
1929          CALL GSMARK(XDMAX-(XCUR1-XHELP),YDMAX-(YCUR1-YDMIN))
1930          CALL GSMARK(XCUR1,YDMAX-(YCUR1-YDMIN))
1931        ENDIF
1932        CALL GSMIX(0)
1933        CALL CLNINF(1)
1934        IPREM = 0
1935        GOTO 5003
1936      ENDIF
1937C
1938C Shrink (4)
1939C
1940 400  ISHRINK = -ISHRINK
1941      GEOM = .TRUE.
1942      GOTO 5000
1943C
1944C Translation de l'image (5)...
1945C
1946 500  CALL GSQCUR(WIN,XCUR,YCUR)
1947      CALL METS_CURSEUR(XMIL,YMIL)
1948 503  IF (XCUR.NE.XMIL.OR.YCUR.NE.YMIL) THEN
1949        DXTRANS = XMIL-XCUR
1950        DYTRANS = YMIL-YCUR
1951        XCUR = XMIL-DXTRANS
1952        YCUR = YMIL-DYTRANS
1953        CALL VRAIECOORD(XHELP,YDMAX,IX0,IY0)
1954        CALL VRAIECOORD(XDMAX,YDMIN,IX1,IY1)
1955        PIPI = .5*REAL(IEPBOR)*(XDMAX-XHELP)/REAL(IABS(IX0-IX1))
1956        ILARG = IX1-IX0-IEPBOR
1957        IHAUT = IY1-IY0-IEPBOR
1958        IX0 = IX0+IEPBOR/2
1959        IY0 = IY0+IEPBOR/2
1960        IX1 = IX1-IEPBOR/2
1961        IY1 = IY1-IEPBOR/2
1962        IX2OLD = IX0
1963        IY2OLD = IY0
1964        ILARGOLD = ILARG
1965        IHAUTOLD = IHAUT
1966        CALL GSBND(XHELP+PIPI,XDMAX-PIPI,YDMIN+PIPI,YDMAX-PIPI)
1967        GOTO 502
1968      ELSE
1969        GOTO 5003
1970      ENDIF
1971C
1972C ...ou par curseur (")
1973C
1974 501  CALL GSQCUR(WIN,XCUR111,YCUR111)
1975      IF (ITYP.EQ.0) THEN
1976        ITYP = -14
1977        DXTRANS = 0.
1978        DYTRANS = 0.
1979        DXTRAN0 = 0.
1980        DYTRAN0 = 0.
1981        CALL CHANGE_CURS(4)
1982CImage
1983        CALL VRAIECOORD(XHELP,YDMAX,IX0,IY0)
1984        CALL VRAIECOORD(XDMAX,YDMIN,IX1,IY1)
1985        PIPI = .5*REAL(IEPBOR)*(XDMAX-XHELP)/REAL(IABS(IX0-IX1))
1986        ILARG = IX1-IX0-IEPBOR
1987        IHAUT = IY1-IY0-IEPBOR
1988        IX0 = IX0+IEPBOR/2
1989        IY0 = IY0+IEPBOR/2
1990        IX1 = IX1-IEPBOR/2
1991        IY1 = IY1-IEPBOR/2
1992        IX2OLD = IX0
1993        IY2OLD = IY0
1994        ILARGOLD = ILARG
1995        IHAUTOLD = IHAUT
1996        CALL GSBND(XHELP+PIPI,XDMAX-PIPI,YDMIN+PIPI,YDMAX-PIPI)
1997      ELSE
1998        DXTRAN0 = DXTRANS
1999        DYTRAN0 = DYTRANS
2000        DDDX = XCUR111-XCUR000
2001        DDDY = YCUR111-YCUR000
2002        IF (I2D.NE.0) THEN
2003          CALL AFFCOORD(XCONT,YCONT,XMED0+XCUR111*R2R3
2004     &                             ,YMED0+YCUR111*R2R3,BID,2,0)
2005          CALL GSBND(XHELP+PIPI,XDMAX-PIPI,YDMIN+PIPI,YDMAX-PIPI)
2006        ENDIF
2007        IF ((DDDX**2+DDDY**2).GT.PASMIN2) THEN
2008          XCUR = XCUR-DDDX
2009          YCUR = YCUR-DDDY
2010          DXTRANS = DXTRANS+DDDX
2011          DYTRANS = DYTRANS+DDDY
2012        ELSE
2013          GOTO 5003
2014        ENDIF
2015      ENDIF
2016      XCUR000 = XCUR111
2017      YCUR000 = YCUR111
2018ctrans      ddxp = -usr2*dx - .5*r2r3*dy
2019ctrans      ddyp =  usr2*dx - .5*r2r3*dy
2020ctrans      ddzp = r2r3*dy
2021ctrans      xpup(1) = xpup(1) + ddxp
2022ctrans      xpup(2) = xpup(2) + ddyp
2023ctrans      xpup(3) = xpup(3) + ddzp
2024ctrans      call calpup(xpup,dist,obsobs,uuuu,vvvv)
2025C
2026cc      CALL GSPAT(ICTFON)
2027cc      CALL MY_GSAREA(0,XCADRE,YCADRE,4)
2028 502  IF (IPROGRE.GT.0) THEN
2029        CALL VRAIECOORD(XHELP+DXTRANS,YDMAX+DYTRANS,IX2,IY2)
2030        IX2 = IX2+IEPBOR/2
2031        IY2 = IY2+IEPBOR/2
2032        IF (IX2.GT.IX2OLD) THEN
2033          CALL x11clearrect(IX2OLD,IY0,IX2-IX2OLD,IHAUT)
2034        ELSEIF(MIN(IX1,IX2+ILARG).LT.IX2OLD+ILARGOLD) THEN
2035          III = MIN(IX1,IX2+ILARG)
2036          JJJ = IX2OLD+ILARGOLD-III
2037          CALL x11clearrect(III,IY0,JJJ,IHAUT)
2038        ENDIF
2039        IF (IY2.GT.IY2OLD) THEN
2040          CALL x11clearrect(IX0,IY2OLD,ILARG,IY2-IY2OLD)
2041        ELSEIF(MIN(IY1,IY2+IHAUT).LT.IY2OLD+IHAUTOLD) THEN
2042          III = MIN(IY1,IY2+IHAUT)
2043          JJJ = IY2OLD+IHAUTOLD-III
2044          CALL x11clearrect(IX0,III,ILARG,JJJ)
2045        ENDIF
2046        CALL x11metrect(IX2,IY2,ILARG,IHAUT)
2047        IX2OLD = MAX(IX2,IX0)
2048        IY2OLD = MAX(IY2,IY0)
2049        ILARGOLD = MIN(IX1,IX2OLD+ILARG) - IX2OLD
2050        IHAUTOLD = MIN(IY1,IY2OLD+IHAUT) - IY2OLD
2051      ELSE
2052        CALL VRAIECOORD(XHELP-DXTRANS,YDMAX-DYTRANS,IX2,IY2)
2053cc        print*,'passe par ici',IX2,IY2,XHELP,YDMAX,DXTRANS,DYTRANS
2054        IX2 = IX2+IEPBOR/2+ISHIFTX
2055        IY2 = IY2+IEPBOR/2+ISHIFTY
2056        CALL x11metrect2(IX2,IY2,ILARG,IHAUT,IX0,IY0)
2057      ENDIF
2058      GOTO 5003
2059C
2060C Parties cachees (6)
2061C
2062Cfj 600  IF (IPREFC.EQ.2) THEN
2063Cfj        IF (IFC.EQ.1) THEN
2064Cfj          IFC = 2
2065Cfj        ELSEIF(IFC.EQ.2) THEN
2066Cfj          IFC = -1
2067Cfj        ELSE
2068Cfj          IFC = 1
2069Cfj        ENDIF
2070Cfj      ELSE
2071Cfj        IFC = -IFC
2072Cfj      ENDIF
2073 600  IF (IPREFC.EQ.2) THEN
2074        IF (IFC.EQ.1) THEN
2075          IFC = 2
2076        ELSEIF(IFC.EQ.2) THEN
2077          IFC = -1
2078        ELSEIF(IFC.EQ.-1) THEN
2079          IF (I2D.EQ.0) THEN
2080            IFC = -2
2081          ELSE
2082            IFC = 1
2083          ENDIF
2084        ELSE
2085          IFC = 1
2086        ENDIF
2087      ELSE
2088        IF (IFC.EQ.1) THEN
2089          IFC = -1
2090        ELSEIF(IFC.EQ.-1) THEN
2091          IF (I2D.EQ.0) THEN
2092            IFC = -2
2093          ELSE
2094            IFC = 1
2095          ENDIF
2096        ELSE
2097          IFC = 1
2098        ENDIF
2099      ENDIF
2100      GEOM = .TRUE.
2101      GOTO 5000
2102C
2103C Rotation autour de Ox (7)
2104C
2105 700  CALL ROTX(IANG(IANGLE))
2106      IOPT = -2
2107      IBOUT = -IBROT
2108      GEOM = .TRUE.
2109      GOTO 5000
2110C
2111C Rotation autour de Oz (8)
2112C
2113 800  CALL ROTZ(IANG(IANGLE))
2114      IOPT = -2
2115      IBOUT = -IBROT
2116      GEOM = .TRUE.
2117      GOTO 5000
2118C
2119C Rotation autour de Oy (9)
2120C
2121 900  CALL ROTY(IANG(IANGLE))
2122      IOPT = -2
2123      IBOUT = -IBROT
2124      GEOM = .TRUE.
2125      GOTO 5000
2126C
2127C Zoom arriere  (A)
2128C
2129 1000 CALL GSQCUR(WIN,XCUR,YCUR)
2130      IF (IIII.EQ.0) THEN
2131        XLARG = XLARG*FACZOOM
2132        FACVIT = FACVIT/FACZOOM
2133      ELSE
2134        XLARG = XLARG*FACZOOM*FACZOOM
2135        FACVIT = FACVIT/(FACZOOM*FACZOOM)
2136      ENDIF
2137      IOPT = -4
2138      GEOM = .TRUE.
2139      IREFRE = 1
2140      GOTO 5001
2141C
2142C Changement de l'angle courant  (B)
2143C
2144 1100 IANGLE = IANGLE+1
2145      IOPT = 0
2146      IF (IANGLE.GT.14) IANGLE = 1
2147 1101 CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUT)
2148      GEOM = .TRUE.
2149      GOTO 5002
2150C
2151C Zoom avant (C)
2152C
2153 1200 CALL GSQCUR(WIN,XCUR,YCUR)
2154      IF (IIII.EQ.0) THEN
2155        XLARG = XLARG/FACZOOM
2156        FACVIT = FACVIT*FACZOOM
2157      ELSE
2158        XLARG = XLARG/(FACZOOM*FACZOOM)
2159        FACVIT = FACVIT*FACZOOM*FACZOOM
2160      ENDIF
2161      IOPT = -4
2162      GEOM = .TRUE.
2163      IREFRE = 1
2164      GOTO 5001
2165C
2166C Fichier d'isovaleurs de vitesses ou de forces (D)
2167C
2168 1300 IRC = 0
2169      LBID = 0
2170      CALL LIVAL(CBIDON,LBID,IVAL,ICLAS,ICONTR,NDSEL,IRC)
2171      IF (IVAL.EQ.9999) THEN
2172        IBOUT = ABS(IBOUT)
2173        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
2174        CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
2175        CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0,ITOUR2,7,15)
2176        CALL viderbuff2
2177        GOTO 5002
2178      ENDIF
2179      CALL ACTLIVAL(IVAL,ICONTR,CBIDON,LBID,IREFRE,IGOTO)
2180cc      IF (IFISO.NE.IFISO0) THEN
2181cc        CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBISO)
2182cc        CALL MYBORD(XBOUT(1,IBISO),YBOUT(1,IBISO),BID,0,ITOUR2
2183cc     &             ,7,15)
2184cc      ENDIF
2185      IF (IGOTO.EQ.1301) THEN
2186        GOTO 1300
2187      ELSE
2188        IF (IGOTO.EQ.5001) THEN
2189          GOTO 5001
2190        ELSE
2191          GOTO 5000
2192        ENDIF
2193      ENDIF
2194C
2195C Dessin carre ou rectangulaire  (E)
2196C
2197 1400 ICARRE = -ICARRE
2198      IF (ICARRE.EQ.1) THEN
2199        XLARG = XLARG*HYA4/HXA4
2200        IPROX  = 95
2201      ELSE
2202        XLARG = XLARG*HXA4/HYA4
2203        IPROX  = 80
2204      ENDIF
2205      IPROY  = 77
2206      PASMIN2 = (.0025*XLARG)**2
2207cc      IPIPIX = -NINT(REAL(IECX*IPROX)*.01)
2208cc      IPIPIY = -NINT(REAL(IECY*IPROY)*.01)
2209cc      CALL TAILLE_FEN(IPIPIX,IPIPIY,1)
2210      CALL TAILLE_FEN(IPROX,IPROY,1)
2211      CALL GSCLR
2212      GOTO 5001
2213C
2214C Frontieres de sous-domaines et frontieres referencees (F)
2215C
2216 1500 IF (ICOURB.GT.0) THEN
2217        IF (IFRONT.EQ.0) THEN
2218          IF (IFBLO.NE.0) THEN
2219            IFRONT = 1
2220          ELSE
2221            IFRONT = 2
2222          ENDIF
2223        ELSEIF(IFRONT.EQ.1) THEN
2224          IFRONT = 2
2225        ELSEIF(IFRONT.EQ.2) THEN
2226          IF (IFBLO.NE.0) THEN
2227            IFRONT = 3
2228          ELSE
2229            IF (NUMSD.GT.1) THEN
2230              IFRONT = -1
2231            ELSE
2232              IFRONT = 3
2233            ENDIF
2234          ENDIF
2235        ELSEIF(IFRONT.EQ.3) THEN
2236          IF (NUMSD.GT.1) THEN
2237            IFRONT = -1
2238          ELSE
2239            IFRONT = 0
2240          ENDIF
2241        ELSE
2242          IFRONT = 0
2243        ENDIF
2244        GOTO 5001
2245      ELSE
2246        IF (FACEXAX.NE.EXAX0
2247     &  .OR.FACEXAY.NE.EXAY0
2248     &  .OR.FACEXAZ.NE.EXAZ0) THEN
2249          EXAX00  = FACEXAX
2250          EXAY00  = FACEXAY
2251          EXAZ00  = FACEXAZ
2252          FACEXAX = EXAX0
2253          FACEXAY = EXAY0
2254          FACEXAZ = EXAZ0
2255          DFACX = FACEXAX-EXAX00
2256          DFACY = FACEXAY-EXAY00
2257          DFACZ = FACEXAZ-EXAZ00
2258        ELSE
2259          FACEXAX0 = FACEXAX
2260          FACEXAY0 = FACEXAY
2261          FACEXAZ0 = FACEXAZ
2262          FACEXAX = EXAX00
2263          FACEXAY = EXAY00
2264          FACEXAZ = EXAZ00
2265          DFACX = FACEXAX-FACEXAX0
2266          DFACY = FACEXAY-FACEXAY0
2267          DFACZ = FACEXAZ-FACEXAZ0
2268        ENDIF
2269        DEBUT = .TRUE.
2270        IREFRE = 1
2271        CALL EXAGERE(DFACX,DFACY,DFACZ,0)
2272        IF (ISOBID.NE.0) CALL MYISO
2273        GOTO 5000
2274      ENDIF
2275C
2276C Legendes (G)
2277C
2278 1600 CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
2279      IF (ILEG.EQ.0) THEN
2280        CALL FSTERM(1)
2281        CALL ECR16COUL(ICTLEG,ILANG)
2282        IF (ILANG.EQ.0) THEN
2283          CALL LIENTIER('Couleur de la l�gende ( < 0 = cancel) ?'
2284     &                 ,0,ICTLEG)
2285          IF (ICTLEG.LT.0.OR.ICTLEG.GT.15) GOTO 1601
2286          CALL LIENTIER
2287     &       ('Sens d''�criture (0:horizontal ; 1:vertical) ?',0,ISLEG)
2288          IF (ISLEG.NE.0) ISLEG = 1
2289          IF (ICTLEG.LT.0.OR.ICTLEG.GT.15) ICTLEG = 7
2290          CALL LIENTIER('Taille de la l�gende '//
2291     &       '(0:normale ; 1:grande ; 2:petite ; 3:monstre) ?',0,IIIII)
2292        ELSE
2293          CALL LIENTIER('Legend''s color ( < 0 = cancel) ?',0,ICTLEG)
2294          IF (ICTLEG.LT.0.OR.ICTLEG.GT.15) GOTO 1601
2295          CALL LIENTIER
2296     &       ('Writing direction (0:horizontal ; 1:vertical) ?',0,ISLEG)
2297          IF (ISLEG.NE.0) ISLEG = 1
2298          IF (ICTLEG.LT.0.OR.ICTLEG.GT.15) ICTLEG = 7
2299          CALL LIENTIER('Legend''s size '//
2300     &       '(0:normal ; 1:large ; 2:small ; 3:huge) ?',0,IIIII)
2301        ENDIF
2302        IF (IIIII.EQ.1) THEN
2303          FACLEG = 1./.65
2304        ELSEIF(IIIII.EQ.2) THEN
2305          FACLEG = .45/.65
2306        ELSEIF(IIIII.EQ.3) THEN
2307          FACLEG = (1./.65)**2
2308        ELSE
2309          FACLEG = 1.
2310        ENDIF
2311        IF (LONLEG.GT.0) THEN
2312          IF (ILANG.EQ.0) THEN
2313            PRINT*,'L�gende pr�c�dente :'
2314          ELSE
2315            PRINT*,'Previous legend:'
2316          ENDIF
2317          PRINT*,LEG(1:LONLEG)
2318        ENDIF
2319        IF (ILANG.EQ.0) THEN
2320          CALL LILIGNE('Entrez la l�gende (maximum 132 caract�res)'
2321     &                ,0,LEG,LONLEG)
2322        ELSE
2323          CALL LILIGNE('Type the legend (maximum 132 characters)'
2324     &                ,0,LEG,LONLEG)
2325        ENDIF
2326        ILEGMAN = 1
2327        ILEGAUTO = 0
2328 1601   CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
2329        CALL GSPATF(ICTFON)
2330        CALL GSLW(0)
2331        CALL GSPAT(16)
2332        ILEG = 1
2333        CALL LEGENDE(XHELP,XDMAX,YDMIN,YDMAX,BID,BID,BID,BID,1)
2334        CALL GSBND(XDMIN,XDMAX,YDMIN,YDMAX)
2335        GOTO 5002
2336      ELSEIF(ILEG.LT.0) THEN
2337        IF (LONLEG.GT.0) THEN
2338          ILEG = 1
2339        ELSE
2340          ILEG = 0
2341        ENDIF
2342      ELSEIF(IFREEZE.EQ.0) THEN
2343        ILEG = ILEG+1
2344        IF (ILEG.EQ.6) ILEG = 0
2345        CALL VRAIECOORD(XHELP,YDMAX,IX0,IY0)
2346        CALL VRAIECOORD(XDMAX,YDMIN,IX1,IY1)
2347        ILARG = IX1-IX0
2348        IHAUT = IY1-IY0
2349        CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
2350        CALL x11metrect2(IX0+ISHIFTX,IY0+ISHIFTY,ILARG,IHAUT,IX0,IY0)
2351Cfj
2352          IF (IAXES.NE.0) CALL AXES(XHELP,XDMAX,YDMIN,YDMAX)
2353          IF (ILEG.GT.0)
2354     &         CALL LEGENDE(XHELP,XDMAX,YDMIN,YDMAX,BID,BID,BID,BID,1)
2355          CALL LECADRE
2356          CALL GSBND(XDMIN,XDMAX,YDMIN,YDMAX)
2357          GOTO 5002
2358Cfj        ELSE
2359Cfj          GEOM = .TRUE.
2360Cfj          GOTO 5001
2361Cfj        ENDIF
2362      ELSE
2363        ILEG = ILEG+1
2364        IF (ILEG.EQ.6) ILEG = 0
2365        CALL GSBND(XDMIN,XDMAX,YDMIN,YDMAX)
2366        GOTO 5003
2367      ENDIF
2368C
2369C Isovaleurs (H)
2370C
2371 1700 ISOINI = ISO
2372 1701 CALL ACTISO(ISOINI,NBCOUL,IWAVE,IGOTO)
2373      IF (IGOTO.EQ.5000) THEN
2374        GOTO 5000
2375      ELSE
2376        GOTO 5002
2377      ENDIF
2378C
2379C Changement de couleur des traits (I)
2380C
2381 1800 ICT = ICT+1
2382      IF (ICT.EQ.17) ICT = 1
2383      ICOLAR = ICT-1
2384      GEOM = .TRUE.
2385      GOTO 5001
2386Cfj      CALL TABCOL(-(ICT*1000+3),IWAVE)
2387Cfj      CALL ASFCOL(ICT-1)
2388Cfj      IF (ITERMC.EQ.4) THEN
2389Cfj        GEOM = .TRUE.
2390Cfj        GOTO 5001
2391Cfj      ELSE
2392Cfj        IOPT = 0
2393Cfj        CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUT)
2394Cfj        GOTO 5002
2395Cfj      ENDIF
2396C
2397C Changement des bornes des iso (J)
2398C
2399 1900 IQUEST = 0
2400      IF (ISO.NE.0) THEN
2401        VMIN2 = VMIN
2402        VMAX2 = VMAX
2403        CALL QUEST_BORNES(ILANG,VMIN0,VMAX0,VMIN2,VMAX2,IRQ)
2404        IF (IRQ.EQ.-2) THEN
2405          IQUEST = 1900
2406        ELSE
2407          IQUEST = 0
2408        ENDIF
2409        IF (IRQ.NE.0.AND.IRQ.NE.-2) GOTO 5002
2410Cfj        CALL FSTERM(1)
2411Cfj        IF (ILANG.EQ.0) THEN
2412Cfj          PRINT*,'Anciennes bornes :',VMIN,VMAX
2413Cfj          PRINT*,'Bornes maximales :',VMIN0,VMAX0
2414Cfj          CALL LI2REEL1(
2415Cfj     &         'Nouvelles bornes ? (2 valeurs �gales --> bornes max)'
2416Cfj     &         ,0,VMIN2,VMAX2)
2417Cfj        ELSE
2418Cfj          PRINT*,'Previous bounds:',VMIN,VMAX
2419Cfj          PRINT*,'Maximal bounds:',VMIN0,VMAX0
2420Cfj          CALL LI2REEL1(
2421Cfj     &         'New bounds? (2 equal values --> max bounds)'
2422Cfj     &         ,0,VMIN2,VMAX2)
2423Cfj        ENDIF
2424        IF (VMIN2.LT.VMAX2) THEN
2425          VMIN = VMIN2
2426          VMAX = VMAX2
2427        ELSEIF(VMAX2.LT.VMIN2) THEN
2428          VMIN = VMAX2
2429          VMAX = VMIN2
2430        ELSE
2431          VMIN = VMIN0
2432          VMAX = VMAX0
2433        ENDIF
2434        IVFIXE = 0
2435Cfj        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
2436        CALL GSPATF(ICTFON)
2437        CALL GSLW(0)
2438C        CALL GSCLP(1)
2439        GOTO 5001
2440      ELSE
2441        GOTO 5002
2442      ENDIF
2443C
2444C Modification de la table des couleurs (K)
2445C
2446 2000 IF (ISO.NE.0.OR.(IVIT.LT.0.AND.ICTFLE.GT.15)
2447     &            .OR.ICTFAC.GT.15) THEN
2448        ITOUCHTAB = 1
2449        IF (ITABLE.EQ.NTABMAX) THEN
2450          ITABLE = 1
2451        ELSEIF(ITABLE.EQ.52.OR.ITABLE.EQ.54) THEN
2452          ITABLE = ITABLE-1
2453        ELSE
2454          ITABLE = ITABLE+1
2455        ENDIF
2456        IF (ITABLE.GT.2) THEN
2457          IF (ITABLE.GE.33.AND.MOD(NBCOUL,2).EQ.1) NBCOUL = NBCOUL+1
2458          IIII = -100000-NBCOUL
2459        ELSE
2460          CALL CHNBCOL(NBCOUL,NVAL,1,ITABLE)
2461          IIII = -100000-NVAL
2462        ENDIF
2463        IWAVE = 0
2464        CALL TABCOL(IIII,IWAVE)
2465      ENDIF
2466      IF (ITERMC.EQ.4) THEN
2467        GOTO 5001
2468      ELSE
2469        IOPT = 0
2470        CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUT)
2471        GOTO 5002
2472      ENDIF
2473C
2474C Changement du nb de couleurs (L)
2475C
2476 2100 IF (ISO.NE.0.OR.ICTFAC.GT.15) THEN
2477        CALL QUEST_NBISO(ILANG,NBCOUL,IEPISO,IRQ)
2478        IF (IRQ.NE.0) GOTO 5002
2479        NBCOUL = MAX(2,MIN(NBCOUL,250))
2480        ITOUCHNB = 1
2481C
2482C Ne pas tout effacer. On peut reprendre la partie
2483C 'valeurs-limites pour chaque couleur'
2484C
2485Cfj        CALL FSTERM(1)
2486Cfj        IVFIXE = 0
2487Cfj        PRINT*,' '
2488Cfj        IF (ILANG.EQ.0) THEN
2489Cfj          PRINT*,'Pour contr�ler l''�paisseur des isovaleurs au trait,'
2490Cfj          PRINT*,
2491Cfj     &     'mettez le signe "-" devant le nombre d''isovaleurs voulues'
2492Cfj        ELSE
2493Cfj          PRINT*,'To control the line thickness,'
2494Cfj          PRINT*,'type "-" number of wanted lines'
2495Cfj        ENDIF
2496Cfj 2101   IF (ILANG.EQ.0) THEN
2497Cfj          PRINT*,'Nombre de couleurs actuel =',NBCOUL
2498Cfj          CALL LIENTIER('Nombre d''isovaleurs ?',0,NBCOUL)
2499Cfj        ELSE
2500Cfj          PRINT*,'Current number of colors =',NBCOUL
2501Cfj          CALL LIENTIER('Number of colors ?',0,NBCOUL)
2502Cfj        ENDIF
2503Cfj        IF (NBCOUL.EQ.0) THEN
2504Cfj          IF (ILANG.EQ.0) THEN
2505Cfj            PRINT*,
2506Cfj     &'*** Vous pouvez rentrer les valeurs-limites pour chaque couleur'
2507Cfj            CALL LIENTIER(
2508Cfj     &'Nombre d''isovaleurs (0 pour l''�chelonnage standard) ?'
2509Cfj     &           ,0,IREP)
2510Cfj          ELSE
2511Cfj            PRINT*,
2512Cfj     &'*** You can give the limit values for each color'
2513Cfj            CALL LIENTIER(
2514Cfj     &           'Number of colors (0 for the default scale) ?'
2515Cfj     &           ,0,IREP)
2516Cfj          ENDIF
2517Cfj          IF (IREP.EQ.0) THEN
2518Cfj            GOTO 2101
2519Cfj          ELSEIF(IREP.LT.0) THEN
2520Cfj            NBCOUL = -IREP
2521Cfj            IF (ILANG.EQ.0) THEN
2522Cfj              CALL LIENTIER('Epaisseur des iso au trait en pixels ?',0
2523Cfj     &             ,IEPISO)
2524Cfj            ELSE
2525Cfj              CALL LIENTIER(
2526Cfj     &        'Lines thickness for contour plot (pixels) ?',0,IEPISO)
2527Cfj            ENDIF
2528Cfj            IEPISO = MAX(-1,IEPISO)
2529Cfj          ELSE
2530Cfj            NBCOUL = IREP
2531Cfj            IEPISO = MIN(4,MAX(0,NINT(15./REAL(NBCOUL))))
2532Cfj            IF (NBCOUL.GE.100) IEPISO = -1
2533Cfj          ENDIF
2534Cfj          IF (NBCOUL.GT.1) THEN
2535Cfj            VAL(1) = VMIN
2536Cfj            VAL(NBCOUL+1) = VMAX
2537Cfj            IVFIXE = 1
2538Cfj            IF (ILANG.EQ.0) THEN
2539Cfj              PRINT*,
2540Cfj     & 'Bornes de l''intervalle de valeurs possibles :',VMIN,VMAX
2541Cfj            ELSE
2542Cfj              PRINT*,'Bounds allowed:',VMIN,VMAX
2543Cfj            ENDIF
2544Cfj            DO I=2,NBCOUL
2545Cfj              WRITE(CNUM2,'(I3)') I-1
2546Cfj              WRITE(CNUM3,'(I3)') I
2547Cfj 2102         IF (ILANG.EQ.0) THEN
2548Cfj                CALL LIREEL1(
2549Cfj     &               'Valeur de l''interface entre les couleurs '
2550Cfj     &               //CNUM2//' et '//CNUM3//' ?',0,VAVA)
2551Cfj              ELSE
2552Cfj                CALL LIREEL1(
2553Cfj     &               'Value for the interface between colors '
2554Cfj     &               //CNUM2//' and '//CNUM3//' ?',0,VAVA)
2555Cfj              ENDIF
2556Cfj              IF (VAVA.LT.VAL(I-1)) THEN
2557Cfj                IF (ILANG.EQ.0) THEN
2558Cfj                  PRINT*,'*** La valeur doit �tre >=',VAL(I-1)
2559Cfj                ELSE
2560Cfj                  PRINT*,'*** The value must be >=',VAL(I-1)
2561Cfj                ENDIF
2562Cfj                GOTO 2102
2563Cfj              ELSEIF(VAVA.GT.VMAX) THEN
2564Cfj                IF (ILANG.EQ.0) THEN
2565Cfj                  PRINT*,'*** La valeur doit �tre <=',VMAX
2566Cfj                ELSE
2567Cfj                  PRINT*,'*** The value must be <=',VMAX
2568Cfj                ENDIF
2569Cfj                GOTO 2102
2570Cfj              ELSE
2571Cfj                VAL(I) = VAVA
2572Cfj              ENDIF
2573Cfj            ENDDO
2574Cfj          ENDIF
2575Cfj        ELSEIF(NBCOUL.LT.0) THEN
2576Cfj          NBCOUL = -NBCOUL
2577Cfj          IF (ITABLE.GE.33.AND.MOD(NBCOUL,2).EQ.1) NBCOUL = NBCOUL+1
2578Cfj          IF (ILANG.EQ.0) THEN
2579Cfj            CALL LIENTIER('Epaisseur des iso au trait en pixels ?'
2580Cfj     &           ,0,IEPISO)
2581Cfj          ELSE
2582Cfj            CALL LIENTIER('Lines thickness for contour plot (pixels) ?'
2583Cfj     &           ,0,IEPISO)
2584Cfj          ENDIF
2585Cfj          IEPISO = MAX(-1,IEPISO)
2586Cfj        ELSE
2587          IF (ITABLE.GE.33.AND.MOD(NBCOUL,2).EQ.1) NBCOUL = NBCOUL+1
2588          IEPISO = MIN(4,MAX(0,NINT(15./REAL(NBCOUL))))
2589          IF (NBCOUL.GE.100) IEPISO = -1
2590Cfj        ENDIF
2591Cfj        NBCOUL = MIN(250,NBCOUL)
2592        ITT = ITABLE
2593        ITABLE = ITT-MOD(ITT+1,2)
2594        IF (ITABLE.EQ.1.OR.ITABLE.EQ.2) THEN
2595          CALL CHNBCOL(NBCOUL,NVAL,1,ITABLE)
2596          CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
2597          CALL GSPATF(ICTFON)
2598          CALL TABCOL(NVAL,IWAVE)
2599        ELSE
2600          CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
2601          CALL GSPATF(ICTFON)
2602          CALL TABCOL(NBCOUL,IWAVE)
2603        ENDIF
2604        IF (ITT.NE.ITABLE) THEN
2605          ITABLE = ITT
2606          IF (ITABLE.NE.2) THEN
2607            IIII = -100000-NBCOUL
2608          ELSE
2609            CALL CHNBCOL(NBCOUL,NVAL,1,ITABLE)
2610            IIII = -100000-NVAL
2611          ENDIF
2612          CALL TABCOL(IIII,IWAVE)
2613        ENDIF
2614        GOTO 5001
2615      ELSE
2616        GOTO 5002
2617      ENDIF
2618C
2619C Axes (M)
2620C
2621 2200 CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
2622      IF (I2D.EQ.0) THEN
2623        IAXESMAX = 4
2624      ELSE
2625        IAXESMAX = 5
2626      ENDIF
2627      IF (IFREEZE.NE.0) THEN
2628        IF (IAXES.EQ.4) THEN
2629          IAXES = 0
2630        ELSE
2631          IAXES = IAXES+1
2632        ENDIF
2633        GOTO 5003
2634      ENDIF
2635      IF (IAXES.GE.IAXESMAX) THEN
2636        IAXES = 0
2637      ELSE
2638        IAXES = IAXES+1
2639      ENDIF
2640      CALL VRAIECOORD(XHELP,YDMAX,IX0,IY0)
2641      CALL VRAIECOORD(XDMAX,YDMIN,IX1,IY1)
2642      ILARG = IX1-IX0
2643      IHAUT = IY1-IY0
2644      CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
2645      CALL x11metrect2(IX0+ISHIFTX,IY0+ISHIFTY,ILARG,IHAUT,IX0,IY0)
2646      IF (IAXES.NE.0) CALL AXES(XHELP,XDMAX,YDMIN,YDMAX)
2647      IF (ILEG.GT.0)
2648     &     CALL LEGENDE(XHELP,XDMAX,YDMIN,YDMAX,BID,BID,BID,BID,1)
2649      CALL LECADRE
2650      CALL GSBND(XDMIN,XDMAX,YDMIN,YDMAX)
2651      GOTO 5002
2652C
2653C Exageration (N)
2654C
2655 2300 IQUEST = 0
2656      IF (IEXAG.NE.0) THEN
2657        IF (ICOURB.GT.0) THEN
2658Cfj          CALL FSTERM(1)
2659          ITOUCHEX = 1
2660          FACEXA0 = FACEXA
2661          IF (DEPMAX.NE.0.) THEN
2662            CONSEIL = 0.3*DIMMAXREF/DEPMAX
2663          ELSE
2664            CONSEIL = 1.
2665          ENDIF
2666          CALL QUEST_EXAG(ILANG,DIMMAXREF,DIMMAX,DEPMAX,FACEXA,CONSEIL
2667     &                   ,IRQ)
2668          IF (IRQ.EQ.-2) THEN
2669            IQUEST = 2300
2670          ELSE
2671            IQUEST = 0
2672          ENDIF
2673Cfj          IF (ILANG.EQ.0) THEN
2674Cfj            PRINT*,
2675Cfj     &         'Dimension maximale de l''objet non-d�form� =',DIMMAXREF
2676Cfj            PRINT*,
2677Cfj     &         'Dimension maximale de l''objet d�form�     =',DIMMAX
2678Cfj            PRINT*,
2679Cfj     &         'D�placement maximal                       =',DEPMAX
2680Cfj            PRINT*,
2681Cfj     &         'Facteur d''exag�ration pr�c�dent           =',FACEXA
2682Cfj            PRINT*,
2683Cfj     &         'Facteur d''exag�ration conseill�           =',CONSEIL
2684Cfj            CALL LIREEL1('Nouveau facteur d''exag�ration ?',0,FACEXA)
2685Cfj          ELSE
2686Cfj            PRINT*,
2687Cfj     &         'Maximum dimension of the undeformed object  =',DIMMAXREF
2688Cfj            PRINT*,
2689Cfj     &         'Maximum dimension of the deformed object    =',DIMMAX
2690Cfj            PRINT*,
2691Cfj     &         'Maximal displacement                        =',DEPMAX
2692Cfj            PRINT*,
2693Cfj     &         'Previous exageration factor                 =',FACEXA
2694Cfj            PRINT*,
2695Cfj     &         'Recommended exageration factor              =',CONSEIL
2696Cfj            CALL LIREEL1('New exageration factor?',0,FACEXA)
2697Cfj          ENDIF
2698          DFACX = FACEXA-FACEXA0
2699          DFACY = FACEXA-FACEXA0
2700          DFACZ = FACEXA-FACEXA0
2701          FACEXAX = FACEXA
2702          FACEXAY = FACEXA
2703          FACEXAZ = FACEXA
2704          IF (I2D.NE.0.AND.FACEXA0.EQ.0..AND.FACEXA.NE.0.
2705     &   .AND.IPERSP.EQ.1
2706     &   .AND.NOM_VIT(LONVIT-4:LONVIT).NE.'.depl'
2707     &   .AND.NOM_VIT(LONVIT-4:LONVIT).NE.'.mode') THEN
2708            IPERSP = -2
2709            CALL METLAPERSP
2710            IF (ICTFAC.LT.16) ICTFAC=99
2711            II = IABS(IBOUT)
2712            CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBPERSP)
2713            CALL MYBORD(XBOUT(1,IBPERSP),YBOUT(1,IBPERSP),BID,0,ITOUR2
2714     &                 ,7,15)
2715            CALL MYBORD(XBOUT(1,II),YBOUT(1,II),BID,0,ITOUR2,7,15)
2716            CALL viderbuff2
2717          ENDIF
2718        ELSE
2719Cfj          CALL FSTERM(1)
2720          FACEXAX0 = FACEXAX
2721          FACEXAY0 = FACEXAY
2722          FACEXAZ0 = FACEXAZ
2723Cfj          IF (ILANG.EQ.0) THEN
2724Cfj            PRINT*,'Dimensions de l''objet =',DIMMAXX,DIMMAXY,DIMMAXZ
2725Cfj            PRINT*,'D�placements maximaux =',DEPXM,DEPYM,DEPZM
2726Cfj            PRINT*,'Facteurs d''exag�ration en x, y, et z pr�c�dents ='
2727Cfj     &           ,FACEXAX,FACEXAY,FACEXAZ
2728Cfj            CALL LI3REEL1('Facteurs d''exag�ration en x, y et z ?',0
2729Cfj     &           ,FACEXAX,FACEXAY,FACEXAZ)
2730Cfj          ELSE
2731Cfj            PRINT*,'Object''s dimensions          ='
2732Cfj     &           ,DIMMAXX,DIMMAXY,DIMMAXZ
2733Cfj            PRINT*,'Maximum displacements        =',DEPXM,DEPYM,DEPZM
2734Cfj            PRINT*,'Previous exageration factors ='
2735Cfj     &           ,FACEXAX,FACEXAY,FACEXAZ
2736Cfj            CALL LI3REEL1('Exageration factors for x, y and z ?',0
2737Cfj     &           ,FACEXAX,FACEXAY,FACEXAZ)
2738Cfj          ENDIF
2739          CALL QUEST_EXA3(ILANG,FACEXAX,FACEXAY,FACEXAZ,IRQ)
2740          IF (IRQ.EQ.0) THEN
2741            DFACX = FACEXAX-FACEXAX0
2742            DFACY = FACEXAY-FACEXAY0
2743            DFACZ = FACEXAZ-FACEXAZ0
2744          ENDIF
2745        ENDIF
2746        IF ((FACEXA.EQ.FACEXA0.AND.ICOURB.GT.0).OR.
2747     &      (FACEXAX.EQ.FACEXAX0.AND.
2748     &       FACEXAY.EQ.FACEXAY0.AND.
2749     &       FACEXAZ.EQ.FACEXAZ0.AND.ICOURB.LT.0) ) THEN
2750c          CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
2751          GOTO 5001
2752        ELSE
2753C Les isosurf se symetrisent mal si on va directement a
2754C une symetrie donnee, mais marchent bien si on suit la sequence
2755C 1/4 2/4 3/4 4/4 1/4
2756C C'est bizarre mais au lieu de reflechir, on fait comme ca:
2757C et comme il n'y a pas que les iso qui deconnent, on fait pareil pour le cas
2758C general
2759C
2760          IF (NRECON.GT.1) THEN
2761            NRECON0 = NRECON
2762            NFACE0 = NFACE
2763            NRECON = 1
2764            NFACE = NF
2765            CALL SYMETRISE(NRECON0,0)
2766            CALL EXAGERE(DFACX,DFACY,DFACZ,0)
2767            IF (NSURF.GT.0) CALL CALSUR(1)
2768            NRECON = NRECON0
2769            NFACE = NFACE0
2770            NRECON0 = 1
2771            CALL SYMETRISE(NRECON0,0)
2772            IF (NSURF.GT.0.AND.ICTFAC.GT.15.AND.ICTFAC.LE.97)
2773     &           CALL ELISO(IRC)
2774          ELSE
2775            CALL EXAGERE(DFACX,DFACY,DFACZ,0)
2776            IF (NSURF.GT.0) CALL CALSUR(1)
2777          ENDIF
2778          IF (ISOBID.NE.0) CALL MYISO
2779cc??          IF (ISO.NE.0) CALL MYISO
2780          GOTO 5000
2781        ENDIF
2782      ELSE
2783        GOTO 5002
2784      ENDIF
2785C
2786C PostScript couleur (O)
2787C
2788 2400 IPOSTCOL = 1
2789      IPFK = 2
2790      GOTO 200
2791C
2792C Couleur des faces (P)
2793C
2794 2500 CALL FSTERM(1)
2795      IF (ICTFAC.LT.3000) THEN
2796        CALL ECR16COUL(ICTFAC,ILANG)
2797        ICTFAC0 = ICTFAC
2798      ELSE
2799        ICTFAC0 = ICTFAC-4000
2800        PRINT*,' '
2801        IF (ILANG.EQ.0) THEN
2802          PRINT*,
2803     &'Options disponibles pour les tables de couleurs personnelles :'
2804        ELSE
2805          PRINT*,
2806     &'Available options for the personnal color tables:'
2807        ENDIF
2808        PRINT*,' '
2809      ENDIF
2810      IF (ILANG.EQ.0) THEN
2811        PRINT*,
2812     &       '41 : Table progressive entre 2 couleurs donn�es (en RVB)'
2813        PRINT*,'43 : Fusion de 2 tables de couleur'
2814        PRINT*,'45 : Table blanc -> couleur donn�e -> noir'
2815        IF (ICTFAC.LT.3000) THEN
2816          PRINT*,'99 : R�flectance normale'
2817          PRINT*,'98 : R�flectance forte'
2818          PRINT*,'97 : Lissage Gouraud'
2819          PRINT*,'96 : Lissage Gouraud r�flectance forte'
2820          IF (I2D.EQ.0)
2821     &         PRINT*,'-1 : Coloriage en fonction des num�ros de faces'
2822          IF (IFLAG3.NE.0)
2823     &         PRINT*,'-2 : Coloriage en fonction des mat�riaux'
2824          IF (NUMSD.GT.1)
2825     &         PRINT*,'-3 : Coloriage en fonction des sous-domaines'
2826        ENDIF
2827      ELSE
2828        PRINT*,
2829     &       '41 : Progressive table between 2 given colors (RGB)'
2830        PRINT*,'43 : Fusion of 2 color tables'
2831        PRINT*,'45 : Table white -> given color -> black'
2832        IF (ICTFAC.LT.3000) THEN
2833          PRINT*,'99 : Default reflectance'
2834          PRINT*,'98 : Strong reflectance'
2835          PRINT*,'97 : Gouraud smoothing'
2836          PRINT*,'96 : Gouraud smoothing with strong reflectance'
2837          IF (I2D.EQ.0)
2838     &         PRINT*,'-1 : Filling according to the facets numbers'
2839          IF (IFLAG3.NE.0)
2840     &         PRINT*,'-2 : Filling according to the materials numbers'
2841          IF (NUMSD.GT.1)
2842     &  PRINT*,'-3 : Filling according to the sub-domains numbers'
2843        ENDIF
2844      ENDIF
2845      PRINT*,' '
2846      IF (ICTFAC.LT.3000) THEN
2847        IF (ILANG.EQ.0) THEN
2848          CALL LIENTIER('Couleur des faces ?',0,III)
2849        ELSE
2850          CALL LIENTIER('Facets color ?',0,III)
2851        ENDIF
2852      ELSE
2853        IF (ILANG.EQ.0) THEN
2854          CALL LIENTIER('Table personnelle ?',0,III)
2855        ELSE
2856          CALL LIENTIER('Customized color table ?',0,III)
2857        ENDIF
2858      ENDIF
2859C
2860C rajout provisoire pour table de couleurs perso de coul1-->coul2
2861C
2862      IF (III.EQ.41) THEN
2863        IF (ILANG.EQ.0) THEN
2864          CALL LI3ENTIER('RVB initiaux (3 entiers 0<256) ?',0
2865     &         ,IROUGE0,IVERT0,IBLEU0)
2866          CALL LI3ENTIER('RVB finaux (3 entiers 0<256) ?',0
2867     &         ,IROUGE1,IVERT1,IBLEU1)
2868        ELSE
2869          CALL LI3ENTIER('Initial RGB (3 integers 0<256) ?',0
2870     &         ,IROUGE0,IVERT0,IBLEU0)
2871          CALL LI3ENTIER('Final RGB (3 integers 0<256) ?',0
2872     &         ,IROUGE1,IVERT1,IBLEU1)
2873        ENDIF
2874        IROUGE0 = MIN(255,MAX(0,IROUGE0))
2875        IVERT0  = MIN(255,MAX(0,IVERT0))
2876        IBLEU0  = MIN(255,MAX(0,IBLEU0))
2877        IROUGE1 = MIN(255,MAX(0,IROUGE1))
2878        IVERT1  = MIN(255,MAX(0,IVERT1))
2879        IBLEU1  = MIN(255,MAX(0,IBLEU1))
2880        ITABLE = 51
2881        IIII = -100000-NBCOUL
2882        CALL TABCOL(IIII,IWAVE)
2883        IF (ICTFAC.GT.3000) ICTFAC = ICTFAC0
2884        GOTO 2502
2885C
2886C Deux tables bout a bout
2887C
2888      ELSEIF(III.EQ.43) THEN
2889        IF (ILANG.EQ.0) THEN
2890          PRINT*,
2891     &'Nombre de tables de couleurs pr�d�finies disponibles =',NTABMAX
2892          CALL LIENTIER(
2893     &  'Num�ro de la premi�re table de couleurs ?',0,ITABLE1)
2894          CALL LIENTIER(
2895     &  'Num�ro de la seconde table de couleurs ?',0,ITABLE2)
2896          PRINT*,NBCOUL
2897     &         ,' couleurs dans la table -> prochain choix entre'
2898     &         ,2,' et',NBCOUL-1
2899          CALL LIENTIER('Limite entre les 2 tables ?',0,ILIMTAB)
2900        ELSE
2901          PRINT*,'Number of available color tables =',NTABMAX
2902          CALL LIENTIER('Number of the first color table ?',0,ITABLE1)
2903          CALL LIENTIER('Number of the second color table ?',0,ITABLE2)
2904          PRINT*,NBCOUL,' colors in the table -> next choice between'
2905     &         ,2,' and',NBCOUL-1
2906          CALL LIENTIER('Limit between the 2 tables ?',0,ILIMTAB)
2907        ENDIF
2908        ITABLE1 = MIN(NTABMAX,MAX(ITABLE1,1))
2909        ITABLE2 = MIN(NTABMAX,MAX(ITABLE2,1))
2910        ILIMTAB = MAX(2,MIN(NBCOUL-1,ILIMTAB))
2911        XLIMTAB = REAL(ILIMTAB)/REAL(NBCOUL)
2912        ITABLE = 53
2913        IIII = -100000-NBCOUL
2914        CALL TABCOL(IIII,IWAVE)
2915        IF (ICTFAC.GT.3000) ICTFAC = ICTFAC0
2916        GOTO 2502
2917C
2918C Table de couleurs perso de blanc-->coul-->noir
2919C
2920      ELSEIF(III.EQ.45) THEN
2921        IF (ILANG.EQ.0) THEN
2922          PRINT*,'Table : blanc - couleur - noir'
2923          CALL LI3ENTIER('RVB couleur centrale (3 entiers 0<256) ?',0
2924     &         ,IROUGE0,IVERT0,IBLEU0)
2925        ELSE
2926          PRINT*,'Table : white - color - black'
2927          CALL LI3ENTIER('Central color RGB (3 integers 0<256) ?',0
2928     &         ,IROUGE0,IVERT0,IBLEU0)
2929        ENDIF
2930        IROUGE0 = MIN(255,MAX(0,IROUGE0))
2931        IVERT0  = MIN(255,MAX(0,IVERT0))
2932        IBLEU0  = MIN(255,MAX(0,IBLEU0))
2933        ITABLE = 55
2934        IIII = -100000-NBCOUL
2935        CALL TABCOL(IIII,IWAVE)
2936        IF (ICTFAC.GT.3000) ICTFAC = ICTFAC0
2937        GOTO 2502
2938      ENDIF
2939      ICTFAC = III
2940      IF ((ICTFAC.LT.-3).OR.
2941     &    (ICTFAC.EQ.-1.AND.I2D.NE.0).OR.
2942     &    (ICTFAC.EQ.-2.AND.IFLAG3.EQ.0).OR.
2943     &    (ICTFAC.EQ.-3.AND.NUMSD.LE.1).OR.
2944     &    (ICTFAC.GT.15.AND.(ICTFAC.LT.96.OR.ICTFAC.GT.99))) THEN
2945        ICTFAC = 0
2946      ENDIF
2947 2502 IF (ICTFAC.GE.-3.AND.ICTFAC.LE.-1) IFC = 1
2948      IF (NSURF.GT.0.AND.ICTFAC.GT.15.AND.ICTFAC.LE.97
2949     &    .AND.IELISO.EQ.0) THEN
2950        CALL ELISO(IRC)
2951        IF (IRC.EQ.0) THEN
2952          IELISO = 1
2953        ELSE
2954          ICTFAC = ICTFAC0
2955        ENDIF
2956      ENDIF
2957 2503 CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
2958      IF (ICTFAC.GT.15) THEN
2959Cfj        IF (ITABLE.NE.7.AND.ITABLE.NE.51) THEN
2960Cfj          ITABLE = 7
2961Cfj          IIII = -100000-NBCOUL
2962Cfj          CALL TABCOL(IIII,IWAVE)
2963Cfj        ENDIF
2964        GOTO 5000
2965      ELSE
2966        GOTO 5001
2967      ENDIF
2968C
2969C Couleur du fond (3)
2970C
2971 300  CALL FSTERM(1)
2972Cfj      ICTFON0 = ICTFON
2973      CALL ECR16COUL(ICTFON,ILANG)
2974      PRINT*,' '
2975      IF (ILANG.EQ.0) THEN
2976        CALL LIENTIER('Couleur du fond ?',0,ICTFON)
2977      ELSE
2978        CALL LIENTIER('Background color ?',0,ICTFON)
2979      ENDIF
2980      IF (ICTFON.LT.0.OR.ICTFON.GT.15) ICTFON = 0
2981      CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
2982CC      GEOM = .TRUE.
2983 301  IF (ICTFON.EQ.0.OR.ICTFON.EQ.3.OR.ICTFON.EQ.11
2984     &.OR.ICTFON.EQ.13.OR.ICTFON.EQ.14.OR.ICTFON.EQ.15) THEN
2985        ICOLAXB = 4
2986        ICOLAX  = 7
2987      ELSE
2988        ICOLAXB = 3
2989        ICOLAX  = 0
2990      ENDIF
2991      GOTO 5001
2992C
2993C Iso bidon (R)
2994C
2995 2700 IF (IDEROUL.EQ.0) THEN
2996 2701   ISOBID = ISOBID+1
2997        IF (ISOBID.GT.16) ISOBID = 1
2998        IF (ISOBID.EQ.1.AND.I2D.NE.0) GOTO 2701
2999        IF (ISOBID.GE.4.AND.ISOBID.LE.8.AND.IFVIT.EQ.0) GOTO 2701
3000        IF (ISOBID.EQ.4.AND.I2D.EQ.2) GOTO 2701
3001        IF (ISOBID.EQ.5.AND.I2D.EQ.3) GOTO 2701
3002        IF (ISOBID.EQ.6.AND.I2D.EQ.1) GOTO 2701
3003        IF (ISOBID.EQ.8.AND.I2D.EQ.0) GOTO 2701
3004        IF (ISOBID.GE.9.AND.ISOBID.LE.12.AND.NBCORN.EQ.0) GOTO 2701
3005        IF (ISOBID.GE.13.AND.ICOURB.LT.0) GOTO 2701
3006      ENDIF
3007cc      print*,isobid
3008 2702 CALL MYISO
3009      IF (ISO.EQ.0
3010     &.OR.(ISO.EQ.3.AND.ISOBID.LT.14)
3011     &.OR.(ISO.NE.3.AND.ISOBID.GE.14)) THEN
3012        IF (ISO.EQ.0) THEN
3013          ITABLE0 = ITABLE
3014          IF (ITABLE.NE.1) THEN
3015            NBCOUL = 20
3016            ITABLE = 1
3017            IIII = -100000-NBCOUL
3018            CALL TABCOL(IIII,IWAVE)
3019          ENDIF
3020        ENDIF
3021        IF (ISOBID.GE.14) THEN
3022          ISO = 3
3023        ELSE
3024          ISO = 1
3025        ENDIF
3026        ICADPS = 1
3027        IF (ICARRE.EQ.1) THEN
3028          ANGPS = -90.
3029        ELSE
3030          ANGPS = 0.
3031        ENDIF
3032        CALL DEFPS(IDEFPS,SIG,ANGPS,ICADPS,HELPPS,IDSEUL,1,ILANG)
3033        IF (I2D.NE.0) THEN
3034          IFC0 = IFC
3035          IFC = 1
3036        ENDIF
3037      ENDIF
3038      IF (ISOBID.GE.14) THEN
3039        ICENTR = 1
3040      ELSE
3041        ICENTR = 0
3042      ENDIF
3043      ICENTRISO = 0
3044      CALL INITBOUT
3045      IREFRE = 1
3046      IVFIXE = 0
3047      GOTO 5000
3048C
3049C Definition du Postscript : signature, cadre, orientation (S)
3050C
3051cc 2800 IDEFPS = IDEFPS+1
3052 2800 IF (IDEFPS.GE.7) THEN
3053        IDEFPS = IDEFPS+1
3054      ELSE
3055        IDEFPS = IDEFPS+2
3056      ENDIF
3057c      IF (IDEFPS.GE.10) IDEFPS = 0
3058      IF (IDEFPS.GE.10) IDEFPS = 1
3059 2801 IOPT = 0
3060      CALL DEFPS(IDEFPS,SIG,ANGPS,ICADPS,HELPPS,IDSEUL,0,ILANG)
3061      CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUT)
3062      GOTO 5002
3063C
3064C Renormalisation echelle (T)
3065C
3066 2900 DEBUT = .TRUE.
3067      FACVIT = FACVIT0
3068      IOPT = -4
3069      IREFRE = 1
3070      GEOM = .TRUE.
3071      GOTO 5010
3072C
3073C Cadrage initial (U)
3074C
3075 3000 IF (IDEROUL.EQ.0) THEN
3076        IRENO = IRENO+1
3077        IF (IRENO.GT.8) IRENO = 1
3078      ELSE
3079        IRENO = IDEROUL
3080      ENDIF
3081      CALL INV3X3(ROTA,ROTLOC,IERR)
3082      CALL ROTATE(1)
3083      IF (IRENO.NE.1) THEN
3084        CALL CALROT(ROTLOC,IRENO)
3085        CALL ROTATE(1)
3086      ENDIF
3087      DEBUT = .TRUE.
3088      IOPT  = -5
3089      IREFRE = 1
3090      FACVIT = FACVIT0
3091ctrans      xpup(1) = dist000
3092ctrans      xpup(2) = dist000
3093ctrans      xpup(3) = dist000
3094ctrans      call calpup(xpup,dist,obs,u,v)
3095      GEOM = .TRUE.
3096      GOTO 5000
3097C
3098C Inversion du point de vue (V)
3099C
3100 3100 ISENS = -ISENS
3101      GEOM = .TRUE.
3102      GOTO 5000
3103C
3104C Rotation dans le plan de projection (perp. a (1,1,1)) (W)
3105C
3106CC 3200 IF (IBOUT.LE.0) CALL GSQCUR(WIN,XCUR,YCUR)
3107 3200 CALL ROTP(IANG(IANGLE))
3108      IOPT = -2
3109      GEOM = .TRUE.
3110      GOTO 5000
3111C
3112C Frontiere / mailles (X)
3113C
3114 3300 IF (IBORD.EQ.-1) THEN
3115        IF (IEPBOR2.EQ.1) THEN
3116          IEPBOR2 = 2
3117        ELSE
3118          IEPBOR2 = 1
3119          IBORD = 1
3120        ENDIF
3121      ELSE
3122        IBORD = IBORD-1
3123        IF (IBORD.EQ.-1) THEN
3124          IEPBOR2 = 1
3125        ELSE
3126          IEPBOR2 = 2
3127        ENDIF
3128      ENDIF
3129      IF (ISOCOUP.EQ.1) THEN
3130        IF (IBORD.NE.-1.AND.IMAILL.GT.0) THEN
3131          ICSUR = 8
3132        ELSE
3133          ICSUR = 16
3134        ENDIF
3135      ENDIF
3136      GEOM = .TRUE.
3137      GOTO 5001
3138C
3139C Taille papier (Y)
3140C
3141 3400 IF (HYA4.EQ.HYA4B) THEN
3142        HYA4 = HYA4A
3143        IPROY  = 68
3144      ELSE
3145        HYA4 = HYA4B
3146        IPROY  = 77
3147      ENDIF
3148      IF (ICARRE.EQ.1) THEN
3149        IPROX  = 95
3150      ELSE
3151        IPROX  = 80
3152      ENDIF
3153      CALL GSCLR
3154      CALL TAILLE_FEN(IPROX,IPROY,1)
3155      GOTO 5001
3156C
3157C Changement de fichier (Z)
3158C
3159 3500 CALL FSTERM(1)
3160      IF (I2D.EQ.0) THEN
3161        IF (ILANG.EQ.0) THEN
3162          CALL LIENTIER(
3163     &       'On conserve les param�tres d''affichage (1:oui ; 0:non) ?'
3164     &       ,0,IPARA)
3165        ELSE
3166          CALL LIENTIER(
3167     &       'Display parameters are preserved (1:yes ; 0:no) ?'
3168     &       ,0,IPARA)
3169        ENDIF
3170        IF (IPARA.NE.0) IPARA = NFACE/NF
3171      ELSE
3172        IPARA = 0
3173      ENDIF
3174      LONG = 0
3175      IREFRE = 1
3176ccc      CALL GSCLR
3177      GOTO 1
3178C
3179C Position angulaire donnee ({)
3180C
3181Cfj 3501 CALL FSTERM(1)
3182Cfj      CALL INV3X3(ROTA,ROTLOC,IERR)
3183Cfj      CALL ROTATE(1)
3184Cfj      IF (ILANG.EQ.0) THEN
3185Cfj        CALL LI3REEL1(
3186Cfj     &  'Pos. angulaires autour de Ox, Oy, Oz (3 valeurs en degr�s) ?'
3187Cfj     &       ,0,ANGX,ANGY,ANGZ)
3188Cfj      ELSE
3189Cfj        CALL LI3REEL1(
3190Cfj     &  'Angular position about Ox, Oy, Oz (3 values in degrees) ?'
3191Cfj     &       ,0,ANGX,ANGY,ANGZ)
3192Cfj      ENDIF
3193Cfj      CALL ARCROT(ANGX,ANGY,ANGZ)
3194Cfj      CALL ROTATE(0)
3195Cfj      IOPT = -2
3196Cfj      GEOM = .TRUE.
3197Cfj      GOTO 5000
3198 3501 IQUEST = 0
3199      CALL ARC(ANGX,ANGY,ANGZ)
3200      CALL QUEST_POSANG(ILANG,ANGX,ANGY,ANGZ,IRQ)
3201      IF (IRQ.EQ.0.OR.IRQ.EQ.-2) THEN
3202        CALL INV3X3(ROTA,ROTLOC,IERR)
3203        CALL ROTATE(1)
3204        CALL ARCROT(ANGX,ANGY,ANGZ)
3205        CALL ROTATE(0)
3206        IOPT = -2
3207        GEOM = .TRUE.
3208        IF (IRQ.EQ.-2) THEN
3209          IQUEST = 3501
3210        ELSE
3211          IQUEST = 0
3212        ENDIF
3213        GOTO 5000
3214      ELSE
3215        IBOUT = ABS(IBOUT)
3216        CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
3217        CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0,ITOUR2,7,15)
3218        CALL viderbuff2
3219        GOTO 5002
3220      ENDIF
3221C
3222C Sauvegardes dans fichier(s) bitmap(s) (|)
3223C
3224 3502 CALL FSTERM(1)
3225      CALL FORMATS_BIT(IFORMAT,ILANG)
3226      IF (IFORMAT.LT.-1) THEN
3227        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
3228        GOTO 5002
3229      ELSE
3230        CALL BITMAPS(NBON,IFORMAT,GEOM,ITYP,IREFRE,IBOUT,IOPT)
3231        CALL TAILLE_FEN(IPROX,IPROY,1)
3232        CALL x11nomfenetre(PROBIG,LPRO)
3233        CALL x11szscrn(IDX,IDY)
3234        IREFRE = 1
3235        CALL GSCLR
3236        GOTO 5000
3237      ENDIF
3238C
3239C Echelles (surfaces) (/)
3240C
3241 3600 CALL FSTERM(1)
3242      IF (ILANG.EQ.0) THEN
3243        PRINT*,
3244     &'Contr�le de l''affichage de la "bounding box" et des �chelles :'
3245        PRINT*,'  Types de boites disponibles :'
3246        PRINT*,'    0 : pas de boite'
3247        PRINT*,'    1 : boite "ouverte" vers l''observateur (3 faces)'
3248        PRINT*,'    2 : boite ferm�e (6 faces)'
3249        CALL LIENTIER('Type de boite ?',0,IBOITE)
3250      ELSE
3251        PRINT*,'Parameters for the bounding box and scales:'
3252        PRINT*,'  Boxes types:'
3253        PRINT*,'    0 : no boxes'
3254        PRINT*,'    1 : open box (3 facets)'
3255        PRINT*,'    2 : closed box (6 facets)'
3256        CALL LIENTIER('Box type ?',0,IBOITE)
3257      ENDIF
3258      IF (IBOITE.LE.0.OR.IBOITE.GT.2) THEN
3259        IBOITE = 0
3260      ELSE
3261Cfj        IF (ILANG.EQ.0) THEN
3262Cfj          PRINT*,'  Types d''�chelles disponibles :'
3263Cfj          PRINT*,'    0 : pas d''�chelle'
3264Cfj          PRINT*,'    1 : traits sur les axes sans chiffres'
3265Cfj          PRINT*,'    2 : traits sur les axes avec chiffres'
3266Cfj          PRINT*,'    3 : traits et grilles sur les faces sans chiffres'
3267Cfj          PRINT*,'    4 : traits et grilles sur les faces avec chiffres'
3268Cfj          CALL LIENTIER('Type d''�chelles ?',0,IECBOI)
3269Cfj        ELSE
3270Cfj          PRINT*,'  Scales types:'
3271Cfj          PRINT*,'    0 : no scales'
3272Cfj          PRINT*,'    1 : scales on axis without numbers'
3273Cfj          PRINT*,'    2 : scales on axis with numbers'
3274Cfj          PRINT*,'    3 : scales on axis and grids without numbers'
3275Cfj          PRINT*,'    4 : scales on axis and grids with numbers'
3276Cfj          CALL LIENTIER('Scale type ?',0,IECBOI)
3277Cfj        ENDIF
3278Cfj        IF (IECBOI.LT.0.OR.IECBOI.GT.4) IECBOI = 0
3279        IF (ILANG.EQ.0) THEN
3280          CALL LIENTIER('Traits sur les axes (1:oui ; 0:non) ?',0,ITIC)
3281          CALL LIENTIER('Num�ros sur les axes (1:oui ; 0:non) ?',0,INUM)
3282          CALL LIENTIER('Grilles (1:oui ; 0:non) ?',0,IGRI)
3283        ELSE
3284          CALL LIENTIER('Tics on axis (1:yes ; 0:no) ?',0,ITIC)
3285          CALL LIENTIER('Numbers on axis (1:yes ; 0:no) ?',0,INUM)
3286          CALL LIENTIER('Grids (1:yes ; 0:no) ?',0,IGRI)
3287        ENDIF
3288        IF (ITIC.NE.0.OR.INUM.NE.0.OR.IGRI.NE.0) THEN
3289          IECBOI = 1
3290          IF (ITIC.EQ.0) IECBOI = IECBOI+4
3291          IF (INUM.NE.0) IECBOI = IECBOI+1
3292          IF (IGRI.NE.0) IECBOI = IECBOI+2
3293        ELSE
3294          IECBOI = 0
3295        ENDIF
3296      ENDIF
3297      CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
3298      GOTO 5001
3299C
3300C Sous-domaines  (.)
3301C
3302 3700 IF (NUMSD.GT.1) THEN
3303        IF (NUMSD.GT.2) THEN
3304          IVU = 0
3305          IPREMVU = 0
3306          DO K=1,NUMSD
3307            IF (ISDVU(K).GT.0) THEN
3308              IVU = IVU+1
3309              IF (IPREMVU.EQ.0) IPREMVU = K
3310            ENDIF
3311          ENDDO
3312          IF (IVU.EQ.NUMSD.OR.IPREMVU.EQ.0) THEN
3313            ISDVU(1) = 1
3314            DO K=2,NUMSD
3315              ISDVU(K) = 0
3316            ENDDO
3317          ELSEIF(IPREMVU.EQ.NUMSD) THEN
3318            DO K=1,NUMSD
3319              ISDVU(K) = 1
3320            ENDDO
3321          ELSE
3322            DO K=1,NUMSD
3323              ISDVU(K) = 0
3324            ENDDO
3325            ISDVU(IPREMVU+1) = 1
3326          ENDIF
3327        ELSE
3328          IF (ISDVU(1).EQ.1.AND.ISDVU(2).EQ.1) THEN
3329            ISDVU(2) = 0
3330          ELSEIF(ISDVU(1).EQ.1.AND.ISDVU(2).EQ.0) THEN
3331            ISDVU(1) = 0
3332            ISDVU(2) = 1
3333          ELSE
3334            ISDVU(1) = 1
3335          ENDIF
3336        ENDIF
3337        GOTO 5000
3338      ELSE
3339        GOTO 5002
3340      ENDIF
3341C
3342C Mailles ou pas  (-)
3343C
3344 3800 IMAILL = -IMAILL
3345      IBOUT = -9999
3346      GEOM = .TRUE.
3347      GOTO 5000
3348C
3349C Shrink prop au champ scalaire (,)
3350C
3351 3900 IF ((IFISO*ICENTR).NE.0.AND.ISHRINK.LT.0) THEN
3352        IF (ISHPRO.GT.0) THEN
3353          ISHPRO = -1
3354        ELSEIF(ISHPRO.EQ.-1) THEN
3355          ISHPRO = -2
3356        ELSE
3357          ISHPRO = 1
3358        ENDIF
3359        IF (ISHPRO.LT.0) THEN
3360          CALL FSTERM(1)
3361          IF (ILANG.EQ.0) THEN
3362            CALL LIREEL1('Valeur minimale vue (0<V<1) ?',0,VSHPRO)
3363          ELSE
3364            CALL LIREEL1('Minimum value displayed (0<V<1) ?',0,VSHPRO)
3365          ENDIF
3366          CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
3367        ENDIF
3368        GEOM = .TRUE.
3369        GOTO 5000
3370      ELSE
3371        GOTO 5002
3372      ENDIF
3373C
3374C Vitesses, fleches (+)
3375C
3376 4000 IF (IFVIT.NE.0) THEN
3377        IVIT = -IVIT
3378        IF (IVIT.LT.0.AND.ICTFLE.GT.15) THEN
3379          VITCOUL = .TRUE.
3380        ELSE
3381          VITCOUL = .FALSE.
3382        ENDIF
3383        IF (ICTFLE.GT.15.AND.ISO.EQ.0) THEN
3384          IF (IVIT.LT.0) THEN
3385            ITABLE0 = ITABLE
3386            IF (ITABLE.NE.1) THEN
3387              ITABLE = 1
3388              IIII = -100000-NBCOUL
3389              CALL TABCOL(IIII,IWAVE)
3390            ENDIF
3391            ICADPS = 1
3392          ELSEIF(ITABLE.NE.ITABLE0) THEN
3393            ITABLE = ITABLE0
3394            IIII = -100000-NBCOUL
3395            CALL TABCOL(IIII,IWAVE)
3396          ENDIF
3397        ENDIF
3398        GEOM = .TRUE.
3399        GOTO 5000
3400      ELSE
3401        GOTO 5002
3402      ENDIF
3403C
3404C Taille des fleches (*)
3405C
3406 4100 IF (IFVIT.NE.0) THEN
3407        FFF = 1.
3408        CALL QUEST_EXAFLE(ILANG,FFF,IRQ)
3409        IF (FFF.EQ.1.) GOTO 5002
3410Cfj        CALL FSTERM(1)
3411Cfj        IF (ILANG.EQ.0) THEN
3412Cfj          CALL LIREEL1
3413Cfj     &     ('Facteur multiplicatif pour la taille des fl�ches ?',0,FFF)
3414Cfj        ELSE
3415Cfj          CALL LIREEL1
3416Cfj     &     ('Multiplicative factor for the arrows size ?',0,FFF)
3417Cfj        ENDIF
3418        IF (FFF.EQ.0.) FFF = 1.E-4
3419        FACVIT  = FACVIT*FFF
3420        FACVIT0 = FACVIT0*FFF
3421Cfj        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
3422        GEOM = .TRUE.
3423        GOTO 5001
3424      ELSE
3425        GOTO 5002
3426      ENDIF
3427C
3428C maillages : Comparaison de deux fichiers de valeurs ())
3429C surfaces : courbes sur la surface
3430C
3431 4200 IF (ICOURB.GT.0) THEN
3432        CALL FSTERM(1)
3433        CALL LIISO2S(ICLAS,IRC)
3434        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
3435        IF (IRC.NE.0) GOTO 5002
3436        IF (ISO.EQ.0) THEN
3437          GOTO 5001
3438        ELSE
3439          GOTO 5000
3440        ENDIF
3441      ENDIF
3442C
3443C On se branche ici pour l'option secrete "`" (Bob)
3444C
3445      CALL FSTERM(1)
3446 4201 IF (ILANG.EQ.0) THEN
3447        CALL LIFICHTAB(
3448     &       'Nom du fichier de points ?',0,NOM_COUR,LONCOUR,0)
3449      ELSE
3450        CALL LIFICHTAB(
3451     &       'Name of the points file ?',0,NOM_COUR,LONCOUR,0)
3452      ENDIF
3453      IF (LONCOUR.LT.0) THEN
3454        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
3455        GOTO 5002
3456      ENDIF
3457      IF (ICOURB.EQ.-5.OR.ICOURB.GT.0) THEN
3458        CALL INV3X3(ROTA,ROTLOC,IERR)
3459        DO I=1,3
3460          DO J=1,3
3461            ROTA(J,I) = ROTLOC(J,I)
3462          ENDDO
3463        ENDDO
3464        CALL ROTATE(0)
3465        IF (NDS.EQ.3) THEN
3466          CALL LICOUR3(IRC)
3467        ELSE
3468          CALL LICOUR4(IRC)
3469        ENDIF
3470        CALL INV3X3(ROTA,ROTLOC,IERR)
3471        DO I=1,3
3472          DO J=1,3
3473            ROTA(J,I) = ROTLOC(J,I)
3474          ENDDO
3475        ENDDO
3476        CALL ROTATE(0)
3477      ELSE
3478        CALL LICOUR(IRC)
3479      ENDIF
3480      IF (IRC.NE.0) THEN
3481        IF (ILANG.EQ.0) THEN
3482          PRINT*,'*** Mauvais fichier'
3483        ELSE
3484          PRINT*,'*** Bad file'
3485        ENDIF
3486        GOTO 4201
3487      ENDIF
3488      CALL ECR16COULB(ILANG)
3489      IF (ILANG.EQ.0) THEN
3490        CALL LIENTIER('Couleur des points de la courbe ?',0,ICPTS)
3491        IF (ICPTS.LT.0.OR.ICPTS.GT.15) ICPTS = 1
3492        CALL LIENTIER('Couleur des lignes de la courbe ?',0,ICSEG)
3493        IF (ICSEG.LT.0.OR.ICSEG.GT.15) ICSEG = 7
3494        CALL LIREEL1('Taille des points (1. --> d�faut) ?',0,FACPTS)
3495        FACPTS = MAX(0.,FACPTS)
3496        CALL LIENTIER(
3497     &       'Epaisseur des lignes (<-1 ==> pas de lignes) ?',0,IEPSEG)
3498        PRINT*,'Les types de marqueurs sont :'
3499        PRINT*,'   0 : pas de marqueur'
3500        PRINT*,'   1 : +'
3501        PRINT*,'   2 : x'
3502        PRINT*,'   3 : *'
3503        PRINT*,'   4 : o'
3504        PRINT*,'   5 : o plein'
3505        PRINT*,'   6 : carr� plein'
3506        PRINT*,'   7 : carr� vide'
3507        PRINT*,'   8 : losange'
3508        PRINT*,'   9 : losange plein'
3509        PRINT*,'  10 : triangle'
3510        PRINT*,'  11 : triangle plein'
3511        PRINT*,'  12 : triangle invers�'
3512        PRINT*,'  13 : triangle invers� plein'
3513        CALL LIENTIER(
3514     &  'Types des marqueurs aux points (<0 -> variable) ?',0,ITPTS)
3515        CALL LIENTIER(
3516     &       'Marqueurs cach�s (0) ou toujours vus (1) ?',0,IOPMAR)
3517      ELSE
3518        CALL LIENTIER('Dots color?',0,ICPTS)
3519        IF (ICPTS.LT.0.OR.ICPTS.GT.15) ICPTS = 1
3520        CALL LIENTIER('Lines color?',0,ICSEG)
3521        IF (ICSEG.LT.0.OR.ICSEG.GT.15) ICSEG = 7
3522        CALL LIREEL1('Dots size (1. --> default) ?',0,FACPTS)
3523        FACPTS = MAX(0.,FACPTS)
3524        CALL LIENTIER(
3525     &       'Lines thickness (<-1 ==> no lines) ?',0,IEPSEG)
3526        PRINT*,'Marker types:'
3527        PRINT*,'   0 : no markers'
3528        PRINT*,'   1 : +'
3529        PRINT*,'   2 : x'
3530        PRINT*,'   3 : *'
3531        PRINT*,'   4 : o'
3532        PRINT*,'   5 : o filled'
3533        PRINT*,'   6 : filled square'
3534        PRINT*,'   7 : empty square'
3535        PRINT*,'   8 : losange'
3536        PRINT*,'   9 : filled losange'
3537        PRINT*,'  10 : triangle'
3538        PRINT*,'  11 : filled triangle'
3539        PRINT*,'  12 : upsidedown triangle'
3540        PRINT*,'  13 : filled upsidedown triangle'
3541        CALL LIENTIER(
3542     &       'Markers type (<0 -> variable)?',0,ITPTS)
3543        CALL LIENTIER(
3544     &       'Hidden markers (0) or always seen (1)?',0,IOPMAR)
3545      ENDIF
3546      CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
3547      GEOM = .TRUE.
3548      GOTO 5000
3549Cfj      ELSE
3550Cfj        GOTO 5002
3551Cfj      ENDIF
3552C
3553C Infos dans le cadre a droite (()
3554C
3555 4300 IF (IINFO.GT.0) THEN
3556        IINFO = -1
3557      ELSEIF(IINFO.EQ.-1) THEN
3558        IINFO = -2
3559      ELSE
3560        IINFO = 1
3561      ENDIF
3562      IOPT = -1
3563      GEOM = .TRUE.
3564      IBOUT = -9999
3565      GOTO 5001
3566C
3567C Affichage des valeurs sur le graphique (')
3568C
3569 4400 IF (ISO.NE.0) THEN
3570        CALL FINDFA(XCU,YCU,NBON,IORDRE,NN,NDS,XX,YY,VALGRA
3571     &             ,ISO,NPROJE,VALF,0)
3572        IF (NN.NE.0) THEN
3573          NE = NNUMFA(NPROJE(NN))
3574          IF (ILANG.EQ.0) THEN
3575            IF (NN.EQ.NE) THEN
3576              PRINT*,'Valeur =',VALGRA,' (�l�ment',NN,')'
3577            ELSE
3578              PRINT*,'Valeur =',VALGRA,' (�l�ment',NE,', face',NN,')'
3579            ENDIF
3580          ELSE
3581            IF (NN.EQ.NE) THEN
3582              PRINT*,'Value =',VALGRA,' (element',NN,')'
3583            ELSE
3584              PRINT*,'Value =',VALGRA,' (element',NE,', face',NN,')'
3585            ENDIF
3586          ENDIF
3587          CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
3588          CALL ECRVAL(XCU,YCU,VALGRA)
3589          NBPG = NBPG+1
3590          IF (NBPG.GT.NBPGM) THEN
3591            NBPG = NBPGM
3592            DO I=1,NBPGM-1
3593              VALG(I) = VALG(I+1)
3594              XXXG(I) = XXXG(I+1)
3595              YYYG(I) = YYYG(I+1)
3596            ENDDO
3597          ENDIF
3598          VALG(NBPG) = VALGRA
3599          XXXG(NBPG) = XCU
3600          YYYG(NBPG) = YCU
3601        ENDIF
3602      ENDIF
3603      GOTO 5003
3604C
3605C Orientation de la lumiere (&)
3606C
3607 4500 IDIRL = IDIRL+1
3608      IF (IDIRL.GT.6) IDIRL = 0
3609      CALL METLALIGHT
3610      IF (ICTFAC0.GT.15.OR.ICTFAC.NE.ICTFAC0) THEN
3611        GEOM = .TRUE.
3612        IF (ICTFAC.NE.ICTFAC0) THEN
3613          CALL INITBOUT
3614          IREFRE = 1
3615        ENDIF
3616        GOTO 5000
3617      ELSE
3618        GOTO 5002
3619      ENDIF
3620C
3621C Perspective (%)
3622C
3623 4600 IF (IPERSP.EQ.1) THEN
3624        IPERSP = -1
3625      ELSEIF(IPERSP.EQ.-1) THEN
3626        IPERSP = -2
3627      ELSEIF(IPERSP.EQ.-2) THEN
3628        IPERSP = -3
3629      ELSEIF(IPERSP.EQ.-3) THEN
3630        IPERSP = 1
3631      ENDIF
3632      CALL METLAPERSP
3633ctrans      dist000 = dist
3634ctrans      call calpup(xpup,dist,obs,u,v)
3635      GEOM = .TRUE.
3636      GOTO 5000
3637C
3638C Couleurs imposees ($)
3639C
3640 4700 CALL FSTERM(1)
3641      IF (ILANG.EQ.0) THEN
3642        PRINT*,'Couleurs impos�es :'
3643        CALL ECR16COULB(ILANG)
3644        CALL LIENTIER('Nombre de couleurs impos�es ?',0,NCIMP)
3645      ELSE
3646        PRINT*,'Imposed colors:'
3647        CALL ECR16COULB(ILANG)
3648        CALL LIENTIER('Number of imposed colors?',0,NCIMP)
3649      ENDIF
3650      NCIMP = MIN(NBCOUL,MAX(0,NCIMP))
3651      IF (NCIMP.GT.0) THEN
3652        IF (ILANG.EQ.0) THEN
3653          PRINT*,'On va imposer',NCIMP,' valeurs'
3654          CALL LIENTIER('Ok (1:oui, 0:non) ?',0,IOK)
3655        ELSE
3656          PRINT*,'We are going to impose',NCIMP,' values'
3657          CALL LIENTIER('Ok (1:yes, 0:no)?',0,IOK)
3658        ENDIF
3659        IF (IOK.EQ.0) NCIMP = 0
3660      ENDIF
3661      IF (NCIMP.GT.0) THEN
3662        IF (ILANG.EQ.0) THEN
3663          PRINT*,'Les valeurs � rep�rer doivent �tre comprises entre'
3664     &        ,VMIN,' et',VMAX
3665        ELSE
3666          PRINT*,'Values must lie between',VMIN,' and',VMAX
3667        ENDIF
3668        NNN = 0
3669        DO I=1,NCIMP
3670          IF (NCIMP.EQ.1) THEN
3671            IF (ILANG.EQ.0) THEN
3672              CALL LI2REEL1(
3673     & 'Entrez la valeur � rep�rer et sa nouvelle couleur',0,VVVV,XK2)
3674            ELSE
3675              CALL LI2REEL1(
3676     & 'Type the value to mark and its new color',0,VVVV,XK2)
3677            ENDIF
3678          ELSE
3679            IF (I.EQ.1) THEN
3680              IF (ILANG.EQ.0) THEN
3681                CALL LI2REEL1(
3682     & 'Entrez la premiere valeur � rep�rer et sa nouvelle couleur'
3683     &               ,0,VVVV,XK2)
3684              ELSE
3685                CALL LI2REEL1(
3686     & 'Type first the value to mark and its new color',0,VVVV,XK2)
3687              ENDIF
3688            ELSE
3689              IF (I.LT.10) THEN
3690                WRITE(CNUM(1:2),'(I2)') I
3691                LL = 2
3692              ELSEIF(I.LT.100) THEN
3693                WRITE(CNUM(1:3),'(I3)') I
3694                LL = 3
3695              ELSE
3696                WRITE(CNUM(1:4),'(I4)') I
3697                LL = 4
3698              ENDIF
3699              IF (ILANG.EQ.0) THEN
3700                CALL LI2REEL1('Entrez la'//CNUM(1:LL)//
3701     &               '�me valeur � rep�rer et sa nouvelle couleur'
3702     &               ,0,VVVV,XK2)
3703              ELSE
3704                CALL LI2REEL1('Type the '//CNUM(1:LL)//
3705     &               'th value to mark and its new color',0,VVVV,XK2)
3706            ENDIF
3707            ENDIF
3708          ENDIF
3709          K2 = NINT(XK2)
3710          IF (VVVV.GE.VMIN.AND.VVVV.LE.VMAX) THEN
3711            NNN = NNN+1
3712            K2 = 1+MIN(15,MAX(0,K2))
3713            K1 = 18 + NINT(.5+REAL(NBCOUL)*(VVVV-VMIN)/(VMAX-VMIN))
3714            IF (ILANG.EQ.0) THEN
3715              PRINT*,'Couleur',K1-18,' chang�e en',K2-1
3716            ELSE
3717              PRINT*,'Color',K1-18,' changed into',K2-1
3718            ENDIF
3719            CALL TABCOL(-(K2*1000+K1),IWAVE)
3720          ELSE
3721            IF (ILANG.EQ.0) THEN
3722              PRINT*,'Valeur en dehors des bornes'
3723            ELSE
3724              PRINT*,'Values off the bounds'
3725            ENDIF
3726          ENDIF
3727        ENDDO
3728        IF (ILANG.EQ.0) THEN
3729          PRINT*,NNN,' couleurs modifi�es'
3730        ELSE
3731          PRINT*,NNN,' modified colors'
3732        ENDIF
3733      ENDIF
3734      CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
3735      IF (NNN.GT.0) THEN
3736        IF (ITERMC.EQ.4) THEN
3737CC          GEOM = .FALSE.
3738          GOTO 5001
3739        ELSE
3740          IOPT = 0
3741          CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUT)
3742          GOTO 5002
3743        ENDIF
3744      ELSE
3745        GOTO 5002
3746      ENDIF
3747C
3748C Rotation a la souris (#)
3749C
3750 4800 CALL GSQCUR(WIN,XCUR111,YCUR111)
3751      IF (ITYP.EQ.0) THEN
3752        CALL CHANGE_CURS(3)
3753        CALL VEC23(XCUR111,YCUR111,VEC1)
3754        DO J=1,3
3755          VEC0(J) = VEC1(J)
3756        ENDDO
3757        ITYP = -13
3758        CALL INV3X3(ROTA,ROTAINV,IERR)
3759        XCUR000 = XCUR111
3760        YCUR000 = YCUR111
3761        CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
3762        CALL GSPAT(ICTFON)
3763        XCADRE(1) = XHELP
3764        XCADRE(2) = XDMAX
3765        XCADRE(3) = XDMAX
3766        XCADRE(4) = XHELP
3767        YCADRE(1) = YDMIN
3768        YCADRE(2) = YDMIN
3769        YCADRE(3) = YDMAX
3770        YCADRE(4) = YDMAX
3771        CALL MY_GSAREA(0,XCADRE,YCADRE,4)
3772      ELSE
3773        TOTO = (XCUR111-XCUR000)**2+(YCUR111-YCUR000)**2
3774        IF (TOTO.GT.PASMIN2) THEN
3775          CALL VEC23(XCUR111,YCUR111,VEC1)
3776          CALL ROTINT(VEC0,VEC1)
3777          DO J=1,3
3778            VEC0(J) = VEC1(J)
3779          ENDDO
3780          XCUR000 = XCUR111
3781          YCUR000 = YCUR111
3782          CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUT)
3783        ELSE
3784          GOTO 5003
3785        ENDIF
3786      ENDIF
3787      CALL ECHEL(-2,BIDON)
3788      IF (IAXES.NE.0.AND.IAXES.LT.5) CALL AXES(XHELP,XDMAX,YDMIN,YDMAX)
3789      CALL GSLW(IEPBOR)
3790      CALL GSPLNEC(4,XCADRE,YCADRE)
3791      CALL GSLW(0)
3792      GOTO 5003
3793C
3794C Maillages 3d : Isosurface (!)
3795C Surfaces     : coupes suivant Ox ou Oy et appel de xgraphic (!)
3796C
3797 4900 IF (ICOURB.GT.0) THEN
3798        IQUEST = 0
3799        IF (I2D.EQ.0) THEN
3800C Maillages 3d : Isosurface (!)
3801          IF (IFISO.NE.0.AND.IVOL.NE.0.AND.VMINISO.LT.VMAXISO) THEN
3802            III = 0
3803            IF (LONISO.GT.5) THEN
3804              IF (NOM_ISO(LONISO-5:LONISO).EQ.'.theta') III = 1
3805            ENDIF
3806            IF (LONISO.GT.6) THEN
3807              IF (NOM_ISO(LONISO-6:LONISO).EQ.'.thetap') III = 1
3808            ENDIF
3809            IF (LONISO.GT.3) THEN
3810              IF (NOM_ISO(LONISO-3:LONISO).EQ.'.psi') III = 2
3811            ENDIF
3812            CALL QUEST_ISOSURF(ILANG,VMINISO,VMAXISO,NSURF,VISO,ICALSU
3813     &                        ,BSOMB,ICSUR,III,IRQ)
3814            IF (IRQ.EQ.0.OR.IRQ.EQ.-2) THEN
3815              ISOCOUP = 2
3816              IF (IRQ.EQ.-2) THEN
3817                IQUEST = 4900
3818              ELSE
3819                IQUEST = 0
3820              ENDIF
3821c              GEOM = .TRUE.
3822              IF (IFC.GT.0) IFC = -1
3823              IF ((VISO.LT.VMINISO.AND.(ICALSU.EQ.0.OR.ICALSU.EQ.1))
3824     &        .OR.(VISO.GT.VMAXISO.AND.(ICALSU.EQ.0.OR.ICALSU.EQ.2)))
3825     &             THEN
3826                NSURF = 0
3827              ELSE
3828                CALL CALSUR(1)
3829              ENDIF
3830              GOTO 5000
3831            ELSE
3832              GOTO 5002
3833            ENDIF
3834Cfj            CALL FSTERM(1)
3835Cfj            IF (ILANG.EQ.0) THEN
3836Cfj              PRINT*,'Bornes des valeurs',VMINISO,VMAXISO
3837Cfj              IF (NSURF.GT.0) THEN
3838Cfj                IF (ICALSU.EQ.0) THEN
3839Cfj                  PRINT*,'Isosurface actuelle =',VISO
3840Cfj                ELSEIF(ICALSU.EQ.1) THEN
3841Cfj                  PRINT*,'Isosurface actuelle <=',VISO
3842Cfj                ELSE
3843Cfj                  PRINT*,'Isosurface actuelle >=',VISO
3844Cfj                ENDIF
3845Cfj              ENDIF
3846Cfj              CALL LIREEL1('Valeur de l''isosurface ?',0,VISO)
3847Cfj            ELSE
3848Cfj              PRINT*,'Bounds of the values',VMINISO,VMAXISO
3849Cfj              IF (NSURF.GT.0) THEN
3850Cfj                IF (ICALSU.EQ.0) THEN
3851Cfj                  PRINT*,'Current surface =',VISO
3852Cfj                ELSEIF(ICALSU.EQ.1) THEN
3853Cfj                  PRINT*,'Current surface <=',VISO
3854Cfj                ELSE
3855Cfj                  PRINT*,'Current surface >=',VISO
3856Cfj                ENDIF
3857Cfj              ENDIF
3858Cfj              CALL LIREEL1('Isosurface''s value?',0,VISO)
3859Cfj            ENDIF
3860Cfj            IF (VISO.LT.VMINISO.OR.VISO.GT.VMAXISO) THEN
3861Cfj              NSURF = 0
3862Cfj              CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
3863Cfj              GOTO 5001
3864Cfj            ELSE
3865Cfj              IF (ILANG.EQ.0) THEN
3866Cfj                CALL LIENTIER('Juste l''iso (0) <iso (1) >iso (2) ?'
3867Cfj     &                       ,0,ICALSU)
3868Cfj              ELSE
3869Cfj                CALL LIENTIER('Surface only (0) <iso (1) >iso (2) ?'
3870Cfj     &                       ,0,ICALSU)
3871Cfj              ENDIF
3872Cfj              IF (ICALSU.NE.1.AND.ICALSU.NE.2) ICALSU = 0
3873Cfj              IF (ICALSU.NE.0) THEN
3874Cfj                IF (ILANG.EQ.0) THEN
3875Cfj                  CALL LIENTIER(
3876Cfj     & 'Bord du domaine clair (0), moyen (1) ou sombre (2) ?',0,IBSOMB)
3877Cfj                ELSE
3878Cfj                  CALL LIENTIER(
3879Cfj     & 'Domain''s boundaries light (0), medium (1) or dark (2) ?'
3880Cfj     &                 ,0,IBSOMB)
3881Cfj                ENDIF
3882Cfj                IF (IBSOMB.EQ.0) THEN
3883Cfj                  BSOMB = 0.5
3884Cfj                ELSEIF(IBSOMB.EQ.1) THEN
3885Cfj                  BSOMB = 0.3
3886Cfj                ELSE
3887Cfj                  BSOMB = 0.1
3888Cfj                ENDIF
3889Cfj              ENDIF
3890Cfj              CALL CALSUR(1)
3891Cfj              IF (NSURF.GT.0) THEN
3892Cfj                ICSUR = 16
3893Cfj                CALL ECR16COUL(ICSUR,ILANG)
3894Cfj                IF (ILANG.EQ.0) THEN
3895Cfj                  PRINT*,'>15 : pas de trac� des ar�tes'
3896Cfj                  CALL LIENTIER('Couleur des ar�tes de l''isosurface ?'
3897Cfj     &                 ,0,ICSUR)
3898Cfj                ELSE
3899Cfj                  PRINT*,'>15 : no vertex drawn'
3900Cfj                  CALL LIENTIER('Vertices color?',0,ICSUR)
3901Cfj                ENDIF
3902Cfj                IF (ICSUR.LT.0) ICSUR = 16
3903Cfj                ifc = -1
3904Cfj                CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
3905Cfj                GOTO 5000
3906Cfj              ELSE
3907Cfj                CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
3908Cfj                GOTO 5001
3909Cfj              ENDIF
3910Cfj            ENDIF
3911          ELSE
3912            CALL FSALRM
3913            GOTO 5002
3914          ENDIF
3915        ELSE
3916C
3917C Maillages 2d : affichage en 3d suivant le champ scalaire (a faire)
3918C
3919          GOTO 5002
3920        ENDIF
3921      ELSEIF(ICOURB.NE.-5) THEN
3922C
3923C Surfaces     : coupes suivant Ox ou Oy et appel de xgraphic (!)
3924C
3925        CALL QUICESTCELUILA('xgraphic',8,GVESTLA,0)
3926        IF (.NOT.GVESTLA) THEN
3927          IF (ILANG.EQ.0) THEN
3928            PRINT*,'*** Pas de xgraphic, pas de coupes...'
3929          ELSE
3930            PRINT*,'*** No xgraphic, no cross-sections...'
3931          ENDIF
3932          GOTO 5002
3933        ENDIF
3934        CALL FSTERM(1)
3935        IF (ILANG.EQ.0) THEN
3936          CALL LIENTIER(
3937     &   'Nombre de coupes (>0 fichiers temporaires, <0 on les garde) ?'
3938     &  ,0,NCOUP)
3939        ELSE
3940          CALL LIENTIER(
3941     &   'Number of cross-sections (>0 scratch files, <0 files saved)?'
3942     &  ,0,NCOUP)
3943        ENDIF
3944        IF (NCOUP.NE.0) THEN
3945          CALL ARC(ANGX,ANGY,ANGZ)
3946          CALL INV3X3(ROTA,ROTLOC,IERR)
3947          CALL ROTATE(1)
3948          CALL PREMIER_LIBRE(ICOUP)
3949          DO I=1,IABS(NCOUP)
3950            WRITE(CC,'(I2.2)') I
3951            IF (NCOUP.GT.0) THEN
3952              OPEN(ICOUP,FILE='/tmp/coupe'//CC//'.'//MOI)
3953            ELSE
3954              OPEN(ICOUP,FILE=NOM_FICH(1:LONG2)//'.coupe'//CC)
3955            ENDIF
3956            IF (ILANG.EQ.0) THEN
3957              CALL LIENTIER('Coupe // Ox (0) ou // Oy (1) ?',0,IPL)
3958            ELSE
3959              CALL LIENTIER(
3960     &             'Cross-section // Ox (0) or // Oy (1) ?',0,IPL)
3961            ENDIF
3962            IF (IPL.EQ.0) THEN
3963              IF (ILANG.EQ.0) THEN
3964                PRINT*,'Bornes en Y :',YMIREE,YMAREE
3965                CALL LIREEL1('Valeur de Y ?',0,YCOUP)
3966                YCOUP = MIN(MAX(YCOUP,YMIREE),YMAREE)
3967                YCOUP = YCOUP-YMED
3968                WRITE(ICOUP,'(A,G11.5)')
3969     &   '# Coupe du fichier '//NOM_FICH(1:LONG)//' par le plan Y ='
3970     &               ,YCOUP+YMED
3971              ELSE
3972                PRINT*,'Y bounds:',YMIREE,YMAREE
3973                CALL LIREEL1('Y value?',0,YCOUP)
3974                YCOUP = MIN(MAX(YCOUP,YMIREE),YMAREE)
3975                YCOUP = YCOUP-YMED
3976                WRITE(ICOUP,'(A,G11.5)')
3977     &   '# Cross-section of'//NOM_FICH(1:LONG)//' / plan Y ='
3978     &               ,YCOUP+YMED
3979              ENDIF
3980              KK = 0
3981              J = 1
3982              DO K=1,NUMY-1
3983                IF (KK.EQ.0.AND.Y(J).LE.YCOUP.AND.Y(J+NUMX).GE.YCOUP)
3984     &               KK = K
3985                J = J+NUMX
3986              ENDDO
3987              FAC = (YCOUP-Y((KK-1)*NUMX+1))/(Y(KK*NUMX+1)-Y(KK))
3988              IF (KK.EQ.0.OR.FAC.GT.1..OR.FAC.LT.0.) THEN
3989                IF (ILANG.EQ.0) THEN
3990                  PRINT*,'*** Probl�me',KK,FAC
3991                ELSE
3992                  PRINT*,'*** Error',KK,FAC
3993                ENDIF
3994              ENDIF
3995              DO K=1,NUMX
3996                J1 = (KK-1)*NUMX + K
3997                J2 = J1+NUMX
3998                WRITE(ICOUP,*) X(K)+XMED0,FAC*Z(J2)+(1.-FAC)*Z(J1)+ZMED0
3999              ENDDO
4000            ELSE
4001              IF (ILANG.EQ.0) THEN
4002                PRINT*,'Bornes en X :',XMIREE,XMAREE
4003                CALL LIREEL1('Valeur de X ?',0,XCOUP)
4004                XCOUP = MIN(MAX(XCOUP,XMIREE),XMAREE)
4005                XCOUP = XCOUP-XMED0
4006                WRITE(ICOUP,'(A,G11.5)')
4007     &     '# Coupe du fichier '//NOM_FICH(1:LONG)//' par le plan X ='
4008     &             ,XCOUP+XMED0
4009              ELSE
4010                PRINT*,'X bounds:',XMIREE,XMAREE
4011                CALL LIREEL1('X value?',0,XCOUP)
4012                XCOUP = MIN(MAX(XCOUP,XMIREE),XMAREE)
4013                XCOUP = XCOUP-XMED0
4014                WRITE(ICOUP,'(A,G11.5)')
4015     &     '# Cross-section of '//NOM_FICH(1:LONG)//' / plan X ='
4016     &             ,XCOUP+XMED0
4017              ENDIF
4018              KK = 0
4019              DO K=1,NUMX-1
4020                IF (KK.EQ.0.AND.X(K).LE.XCOUP.AND.X(K+1).GE.XCOUP)
4021     &               KK = K
4022              ENDDO
4023              FAC = (XCOUP-X(KK))/(X(KK+1)-X(KK))
4024              IF (KK.EQ.0.OR.FAC.GT.1..OR.FAC.LT.0.) THEN
4025                IF (ILANG.EQ.0) THEN
4026                  PRINT*,'*** Probl�me',KK,FAC
4027                ELSE
4028                  PRINT*,'*** Error',KK,FAC
4029                ENDIF
4030              ENDIF
4031              DO K=1,NUMY
4032                J1 = (K-1)*NUMX + KK
4033                J2 = J1+1
4034                WRITE(ICOUP,*) Y(J1)+YMED0
4035     &                        ,FAC*Z(J2)+(1.-FAC)*Z(J1)+ZMED0
4036              ENDDO
4037            ENDIF
4038            CLOSE(ICOUP)
4039          ENDDO
4040          IF (NCOUP.GT.0) THEN
4041            CALL EXEC('xgraphic -win65 /tmp/coupe*'//MOI//'>/dev/null&')
4042            CALL EXEC(
4043     &            'sleep 5 ; /bin/rm -f /tmp/coupe*'//MOI//'>/dev/null')
4044          ELSE
4045            CALL EXEC(
4046     &      'xgraphic -win65 '//NOM_FICH(1:LONG2)//'.coupe*>/dev/null&')
4047          ENDIF
4048          CALL ARCROT(ANGX,ANGY,ANGZ)
4049          CALL ROTATE(0)
4050        ENDIF
4051        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
4052        GOTO 5002
4053      ELSE
4054        GOTO 5002
4055      ENDIF
4056C
4057C touche secrete (`)
4058C
4059 4901 CALL FSTERM(1)
4060      IF (ILANG.EQ.0) THEN
4061        PRINT*,'*** Options secr�tes !'
4062        PRINT*,'*** Espace r�serv� aux experts...'
4063        PRINT*,'Options possibles :'
4064        PRINT*,'1: Courbes sur maillage.'
4065        PRINT*,'2: Sauvegarde des segments dans un fichier de points.'
4066        PRINT*,'autre: abandon et retour au mode normal.'
4067      ELSE
4068        PRINT*,'*** Hidden options !'
4069        PRINT*,'*** Experts only...'
4070        PRINT*,'Available options:'
4071        PRINT*,'1: Curves on mesh.'
4072        PRINT*,'2: Save segments in a file.'
4073        PRINT*,'others: cancel and return to normal mode.'
4074      ENDIF
4075      CALL LIENTIER('Option ?',0,III)
4076C
4077C courbes sur maillage (identique aux courbes sur les surfaces)
4078C
4079      IF (III.EQ.1) THEN
4080        GOTO 4201
4081C
4082C fichier pour xgraphic (marc) (`)
4083C
4084      ELSEIF(III.EQ.2) THEN
4085        IF (IPERSP.EQ.1) THEN
4086          FAFA = R2R3
4087        ELSE
4088          FAFA = .5*RAC3
4089        ENDIF
4090        IF (ISO.EQ.0) THEN
4091          TITRE = NOM_FICH
4092          LLL   = LONG
4093        ELSE
4094          TITRE = NOM_FICH(1:LONG)//' - '//NOM_ISO(1:LONISO)
4095          LLL = LONG + 3 + LONISO
4096        ENDIF
4097        LPOINT = LONG
4098 4911   IF (NOM_FICH(LPOINT:LPOINT).NE.'.'.AND.LPOINT.GT.1) THEN
4099          LPOINT = LPOINT-1
4100          GOTO 4911
4101        ENDIF
4102        IF (LPOINT.EQ.1) THEN
4103          LPOINT = LONG
4104        ELSE
4105          LPOINT = LPOINT-1
4106        ENDIF
4107        CALL INITSAUVE(NOM_FICH(1:LPOINT)//'.graph',LPOINT+6,XMED0,YMED0
4108     &                ,FAFA,TITRE,LLL)
4109        ISAUVEGRAPH = 1
4110        GEOM = .TRUE.
4111        GOTO 5001
4112      ELSE
4113        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
4114        GOTO 5002
4115      ENDIF
4116C
4117C Titre du avoir3D (_)
4118C
4119 4902 IF (LONTIT.GT.0) THEN
4120        ITITAV = -ITITAV
4121        IF (IFREEZE.NE.0) GOTO 5003
4122        IF (ITITAV.LT.0) THEN
4123          CALL TITIT(XHELP,XDMAX,YDMIN,YDMAX)
4124          GOTO 5002
4125        ELSE
4126          GEOM = .TRUE.
4127          GOTO 5001
4128        ENDIF
4129      ELSE
4130        GOTO 5002
4131      ENDIF
4132C
4133C Numeros (^) (maillages only)
4134C
4135 4903 IF (ICOURB.GT.0) THEN
4136C
4137C INUMER = 0 : Pas de numeros
4138C        = 1 : elements
4139C        = -1 : noeuds
4140C        = -2 : references
4141C        = -3 : references non nulles
4142C
4143        IF (INUMER.EQ.0) THEN
4144          INUMER = -1
4145        ELSEIF(INUMER.EQ.-1) THEN
4146          INUMER = 1
4147        ELSEIF(INUMER.EQ.1) THEN
4148          INUMER = -2
4149        ELSEIF(INUMER.EQ.-2) THEN
4150          INUMER = -3
4151        ELSE
4152          INUMER = 0
4153        ENDIF
4154        GEOM = .TRUE.
4155        GOTO 5000
4156      ELSE
4157        GOTO 5003
4158      ENDIF
4159C
4160C Tables oscillantes (]) provisoire pour Alexandre
4161C
4162 4904 IWAVE = IWAVE+1
4163      IF (IWAVE.EQ.11.OR.IWAVE.GT.NBCOUL/5) IWAVE=0
4164      IIII = -100000-NBCOUL
4165      CALL TABCOL(IIII,IWAVE)
4166      IF (ITERMC.EQ.4) THEN
4167        GOTO 5001
4168      ELSE
4169        IOPT = 0
4170        GOTO 5002
4171      ENDIF
4172C
4173C Mode progressif ou non (\)
4174C
4175 4905 IPROGRE = -IPROGRE
4176      IF (IPROGRE.LT.0) THEN
4177        CALL VRAIECOORD(XHELP,YDMAX,IX0,IY0)
4178        CALL VRAIECOORD(XDMAX,YDMIN,IX1,IY1)
4179        PIPI = .5*REAL(IEPBOR)*(XDMAX-XHELP)/REAL(IABS(IX0-IX1))
4180        ILARG = IX1-IX0-IEPBOR
4181        IHAUT = IY1-IY0-IEPBOR
4182        IX0 = IX0+IEPBOR/2
4183        IY0 = IY0+IEPBOR/2
4184        IX1 = IX1-IEPBOR/2
4185        IY1 = IY1-IEPBOR/2
4186        IX0S = IX0+ISHIFTX
4187        IY0S = IY0+ISHIFTY
4188        CALL GSPROGRE(2)
4189        CALL GSPATF(ICTFON)
4190        CALL GSPAT(16)
4191        CALL GSBND(XHELP*2.-XDMAX,XDMAX*2.-XHELP
4192     &            ,YDMIN*2.-YDMAX,YDMAX*2.-YDMIN)
4193        CALL MY_GSAREA2B(XHELP*2.-XDMAX,XDMAX*2.-XHELP
4194     &                  ,YDMIN*2.-YDMAX,YDMAX*2.-YDMIN)
4195        CALL GSPROGRE(0)
4196        CALL x11garderect2(IX0,IY0,ILARG,IHAUT,IX0S,IY0S)
4197      ENDIF
4198      GOTO 5002
4199C
4200C Mise a jour des fichiers ouverts ([) (refresh/reload)
4201C
4202 4906 CALL GSBND(XDMIN,XHELP,YDMIN,YDMAX)
4203      CALL MYBORD(XBOUT(1,IBREL),YBOUT(1,IBREL),BID,0,ITOUR2,15,7)
4204      CALL viderbuff2
4205      CALL AREFRESH(IRELIM,IRELIVA,IRELIVI)
4206CC      print*,IRELIM,IRELIVA,IRELIVI
4207      IF (IRELIVI.NE.0) THEN
4208        IRC = 1
4209Cfj        IF (NOM_ISO(1:1).NE.'$') THEN
4210Cfj          CALL LIVAL(NOM_ISO,LONISO,IVAL,ICLAS,ICONTR,NDSEL,IRC)
4211Cfj          IF (IVAL.EQ.-1) THEN
4212Cfj            III = 2
4213Cfj          ELSE
4214Cfj            III = 0
4215Cfj          ENDIF
4216Cfj        ELSE
4217          III = 0
4218Cfj        ENDIF
4219        LBID = LONISO
4220        IF (LBID.GT.0) CBIDON(1:LBID) = NOM_ISO(1:LONISO)
4221        CALL LIVAL(NOM_VIT,LONVIT,IVAL,ICLAS,ICONTR,NDSEL,IRC)
4222        IF (FACEXA.EQ.0..OR.I2D.EQ.0) THEN
4223          CALL LIVIT(ICLAS,III,NOM_VIT,LONVIT,IRC,0,0)
4224        ELSE
4225          CALL LIVIT(ICLAS,III,NOM_VIT,LONVIT,IRC,0,1)
4226        ENDIF
4227        LONISO = LBID
4228        IF (LBID.GT.0) NOM_ISO(1:LONISO) = CBIDON(1:LBID)
4229      ENDIF
4230      IF (IRELIVA.NE.0) THEN
4231        IRC = 1
4232        CALL LIVAL(NOM_ISO,LONISO,IVAL,ICLAS,ICONTR,NDSEL,IRC)
4233        IF (I2D.NE.0.AND.FACEXA.NE.0.) THEN
4234          DFACX = -FACEXA
4235          DFACY = -FACEXA
4236          DFACZ = -FACEXA
4237          CALL EXAGERE(DFACX,DFACY,DFACZ,0)
4238          FACEXA0 = FACEXA
4239          IEXA = 1
4240        ELSE
4241          IEXA = 0
4242        ENDIF
4243        CALL LIISO(ICLAS,NOM_ISO,LONISO,IRC,ICONTR,1,IVAL)
4244        IF (IEXA.EQ.1) THEN
4245          FACEXA = FACEXA0
4246          DFACX = FACEXA
4247          DFACY = FACEXA
4248          DFACZ = FACEXA
4249          CALL EXAGERE(DFACX,DFACY,DFACZ,0)
4250        ENDIF
4251        IF (ISO.EQ.0.AND.(IVAL.EQ.1.OR.IVAL.EQ.4).AND.NSURF.LE.0) THEN
4252          IOPT = -1
4253        ELSE
4254ccc          IF (IREP.EQ.0.AND.(VISO.LT.VMINISO.OR.VISO.GT.VMAXISO)) THEN
4255          IF ((VISO.LT.VMINISO.AND.(ICALSU.EQ.0.OR.ICALSU.EQ.1))
4256     &    .OR.(VISO.GT.VMAXISO.AND.(ICALSU.EQ.0.OR.ICALSU.EQ.2))) THEN
4257            NSURF = 0
4258          ELSEif(nsurf.gt.0) then
4259            print*,'passe',nrecon,nsurf,nf
4260            if (nrecon.gt.1) then
4261Cfj              nrecon0 = nrecon
4262Cfj              nface0 = nface
4263Cfj              nrecon = 1
4264Cfj              nface = nf
4265Cfj              call symetrise(nrecon0,0)
4266Cfjc              call exagere(-facexa,-facexa,-facexa,0)
4267              if (nsurf.gt.0) call calsur(0)
4268Cfj              nrecon = nrecon0
4269Cfj              nface = nface0
4270Cfj              nrecon0 = 1
4271Cfj              call symetrise(nrecon0,0)
4272Cfj              if (nsurf.gt.0.and.ictfac.gt.15.and.ictfac.le.97)
4273Cfj     &             call eliso(irc)
4274              GEOM = .TRUE.
4275            else
4276              CALL CALSUR(0)
4277            endif
4278cc            IF (NSURF.GT.0) CALL CALSUR(1)
4279          ENDIF
4280        ENDIF
4281      ENDIF
4282C
4283      IF (IRELIM.EQ.0) THEN
4284        IF (IRELIVA.EQ.0.AND.IRELIVI.EQ.0) THEN
4285          GOTO 5002
4286        ELSE
4287          IF (NBPG.GT.0) THEN
4288            DO I=1,NBPG
4289              CALL FINDFA(XXXG(I),YYYG(I),NBON,IORDRE,NN,NDS,XX,YY
4290     &                   ,VALGRA,ISO,NPROJE,VALF,1)
4291              IF (NN.NE.0) THEN
4292                NE = NNUMFA(NPROJE(NN))
4293                IF (ILANG.EQ.0) THEN
4294                  IF (NN.EQ.NE) THEN
4295                    PRINT*,'Nouvelle valeur =',VALGRA,' (�l�ment',NN,')'
4296                  ELSE
4297                    PRINT*,
4298     &    'Nouvelle valeur =',VALGRA,' (�l�ment',NE,', face',NN,')'
4299                  ENDIF
4300                ELSE
4301                  IF (NN.EQ.NE) THEN
4302                    PRINT*,'New value =',VALGRA,' (element',NN,')'
4303                  ELSE
4304                    PRINT*,
4305     &    'New value =',VALGRA,' (element',NE,', face',NN,')'
4306                  ENDIF
4307                ENDIF
4308              ELSE
4309                PRINT*,'*** Biz',I
4310              ENDIF
4311              VALG(I) = VALGRA
4312            ENDDO
4313          ENDIF
4314          IF (ILANG.EQ.0) THEN
4315            PRINT*,'--- fin relecture ---'
4316          ELSE
4317            PRINT*,'--- end of reload ---'
4318          ENDIF
4319          IF (ISO.EQ.0.AND.(IVAL.EQ.1.OR.IVAL.EQ.4).AND.NSURF.LE.0) THEN
4320            GOTO 5001
4321          ELSE
4322            GOTO 5000
4323          ENDIF
4324        ENDIF
4325      ELSE
4326        IF (ILANG.EQ.0) THEN
4327          PRINT*,'--- fin relecture ---'
4328        ELSE
4329          PRINT*,'--- end of reload ---'
4330        ENDIF
4331        IPARA = -NFACE/NF
4332        IREFRE = 1
4333        NOM_FICH(1:LONG0) = NOMF0(1:LONG0)
4334        LONG = LONG0
4335        GOTO 1
4336      ENDIF
4337C
4338C Coupes (})
4339C
4340 3503 IQUEST = 0
4341      IF (ICOURB.GT.0.AND.I2D.EQ.0.AND.IVOL.NE.0) THEN
4342        CALL INV3X3(ROTA,ROTLOC,IERR)
4343        CALL ROTATE(1)
4344        CALL INV3X3(ROTLOC,ROTA,IERR)
4345        VMINXYZ(1) = BIG
4346        VMAXXYZ(1) = -BIG
4347        VMINXYZ(2) = BIG
4348        VMAXXYZ(2) = -BIG
4349        VMINXYZ(3) = BIG
4350        VMAXXYZ(3) = -BIG
4351        DO I=1,NUMNP
4352          VMINXYZ(1) = MIN(VMINXYZ(1),X(I))
4353          VMAXXYZ(1) = MAX(VMAXXYZ(1),X(I))
4354          VMINXYZ(2) = MIN(VMINXYZ(2),Y(I))
4355          VMAXXYZ(2) = MAX(VMAXXYZ(2),Y(I))
4356          VMINXYZ(3) = MIN(VMINXYZ(3),Z(I))
4357          VMAXXYZ(3) = MAX(VMAXXYZ(3),Z(I))
4358        ENDDO
4359        VMINXYZ(1) = VMINXYZ(1) + XMED0
4360        VMAXXYZ(1) = VMAXXYZ(1) + XMED0
4361        VMINXYZ(2) = VMINXYZ(2) + YMED0
4362        VMAXXYZ(2) = VMAXXYZ(2) + YMED0
4363        VMINXYZ(3) = VMINXYZ(3) + ZMED0
4364        VMAXXYZ(3) = VMAXXYZ(3) + ZMED0
4365        IF (VCOUPXYZ(1).EQ.BIG) VCOUPXYZ(1) = (VMINXYZ(1)+VMAXXYZ(1))*.5
4366        IF (VCOUPXYZ(2).EQ.BIG) VCOUPXYZ(2) = (VMINXYZ(2)+VMAXXYZ(2))*.5
4367        IF (VCOUPXYZ(3).EQ.BIG) VCOUPXYZ(3) = (VMINXYZ(3)+VMAXXYZ(3))*.5
4368        IPCOUP0 = IPCOUP
4369        IF (IPCOUP.EQ.0) IPCOUP = 3
4370        CALL QUEST_COUPE(ILANG,VMINXYZ,VMAXXYZ,VCOUPXYZ,VCOUP
4371     &                  ,IPCOUP,IPCOUP0,ICOUPSU,IRQ)
4372        IF (IRQ.EQ.0.OR.IRQ.EQ.-2) THEN
4373          ISOCOUP = 1
4374          BSOMB = 0.3
4375          IF (IBORD.NE.-1.AND.IMAILL.GT.0) THEN
4376            ICSUR = 8
4377          ELSE
4378            ICSUR = 16
4379          ENDIF
4380          VCOUPXYZ(IPCOUP) = VCOUP
4381          IF (IFC.GT.0) IFC = -1
4382          IF ((VCOUP.LT.VMINXYZ(IPCOUP)
4383     &         .AND.(ICOUPSU.EQ.0.OR.ICOUPSU.EQ.1))
4384     &    .OR.(VCOUP.GT.VMAXXYZ(IPCOUP)
4385     &         .AND.(ICOUPSU.EQ.0.OR.ICOUPSU.EQ.2))) THEN
4386            NSURF = 0
4387          ELSE
4388            DO I=1,NUMNP
4389              VALXB(I) = VALX(I)
4390            ENDDO
4391            IF (IPCOUP.EQ.1) THEN
4392              DO I=1,NUMNP
4393                VALX(I) = X(I) + XMED0
4394              ENDDO
4395            ELSEIF(IPCOUP.EQ.2) THEN
4396              DO I=1,NUMNP
4397                VALX(I) = Y(I) + YMED0
4398              ENDDO
4399            ELSE
4400              DO I=1,NUMNP
4401                VALX(I) = Z(I) + ZMED0
4402              ENDDO
4403            ENDIF
4404            ICALSU = ICOUPSU
4405            VISO = VCOUP
4406            IFVISO = 1
4407            CALL CALSUR(1)
4408            DO I=1,NUMNP
4409              VALX(I) = VALXB(I)
4410            ENDDO
4411          ENDIF
4412          IF (IRQ.EQ.-2) THEN
4413            IQUEST = 3503
4414          ELSE
4415            IQUEST = 0
4416          ENDIF
4417c          GEOM = .TRUE.
4418          CALL ROTATE(0)
4419          GOTO 5000
4420        ELSE
4421          CALL ROTATE(0)
4422          GOTO 5002
4423        ENDIF
4424      ELSE
4425        GOTO 5002
4426      ENDIF
4427C
4428C Type de fleche (~) (dernier caractere dispo)
4429C
4430 3504 IF (IFVIT.NE.0) THEN
4431        III = IABS(ITYPFL)
4432        III = III+1
4433        IF (III.GT.4) III = 1
4434        IF (ITYPFL.GT.0) THEN
4435          ITYPFL = III
4436        ELSE
4437          ITYPFL = -III
4438        ENDIF
4439        GOTO 5001
4440      ELSE
4441        GOTO 5002
4442      ENDIF
4443C
4444C Anglais / Francais
4445C
4446 3505 IF (ILANG.EQ.0) THEN
4447        ILANG = 1
4448        IF (ELEMENTS.EQ.'Hexa�dres 27 noeuds')
4449     &       ELEMENTS = 'Hexaedrons 27 nodes'
4450        IF (ELEMENTS.EQ.'Hexa�dres 8 noeuds')
4451     &       ELEMENTS = 'Hexaedrons 8 nodes'
4452        IF (ELEMENTS.EQ.'Tetra�dres') THEN
4453          ELEMENTS = 'Tetraedrons'
4454          LELEM = 11
4455        ENDIF
4456      ELSE
4457        ILANG = 0
4458        IF (ELEMENTS.EQ.'Hexaedrons 27 nodes')
4459     &       ELEMENTS = 'Hexa�dres 27 noeuds'
4460        IF (ELEMENTS.EQ.'Hexaedrons 8 nodes')
4461     &       ELEMENTS = 'Hexa�dres 8 noeuds'
4462        IF (ELEMENTS.EQ.'Tetraedrons') THEN
4463          ELEMENTS = 'Tetra�dres'
4464          LELEM = 10
4465        ENDIF
4466      ENDIF
4467      IREFRE = 1
4468      CALL INFO(XDMAX,XDMA2,YDMIN,YDMAX,NSURF)
4469      CALL INITBOUT
4470      IBOUBOU = 0
4471      CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUBOU)
4472      GOTO 5002
4473C
4474 999  CALL TABCOL(0,IWAVE)
4475      CALL FSTERM(0)
4476      CALL ECOPT(0)
4477      END
4478C-----------------------------------------------------------------------
4479      SUBROUTINE ECRMEM
4480      INCLUDE 'com_coor.f'
4481      INCLUDE 'com_faces.f'
4482      INCLUDE 'com_options.f'
4483C
4484      XMPO = ( 44.*REAL(NPMAX) )*4./1048576.
4485      XMFA = ( 84.*REAL(NFMAX) + 4.*REAL(NTMAX)
4486     &           + REAL(NEMAX) + 8.*REAL(NCMAX)
4487     &                         +14.*REAL(NOMAX) )*4./1048576.
4488      IF (ILANG.EQ.0) THEN
4489        WRITE(*,3131) NPMAX,XMPO,NFMAX,XMFA,XMPO+XMFA
4490      ELSE
4491        WRITE(*,3132) NPMAX,XMPO,NFMAX,XMFA,XMPO+XMFA
4492      ENDIF
4493 3131 FORMAT(/'Nombre max de noeuds : NPMAX =',I8,' -->',F6.1,' Mo',
4494     &       /'Nombre max de faces  : NFMAX =',I8,' -->',F6.1,' Mo',
4495     &       /'                     ---> M�moire totale >',F6.1,' Mo',/)
4496 3132 FORMAT(/'Max number of nodes:  NPMAX =',I8,' -->',F6.1,' Mo',
4497     &       /'Max number of facets: NFMAX =',I8,' -->',F6.1,' Mo',
4498     &       /'                      ---> Total memory >',F6.1,' Mo',/)
4499      END
4500C-----------------------------------------------------------------------
4501      SUBROUTINE AFFCOORD(XCONT,YCONT,V1,V2,V3,IDIM,NUM)
4502      INCLUDE 'com_options.f'
4503      CHARACTER*40 CCOOR
4504C
4505      PIPI = PIXEL*2.
4506      CALL GSBND(XHELP+PIPI,XDMA2-PIPI,YDMI2+PIPI,YDMIN-PIPI)
4507      IF (IDIM.EQ.0) THEN
4508        CCOOR = '                                        '
4509        LL = 39
4510      ELSE
4511        IF (NUM.EQ.0) THEN
4512          LL = 0
4513        ELSE
4514          LL = 8
4515           WRITE(CCOOR(1:8),'(I7," ")') NUM
4516        ENDIF
4517        IF (IDIM.EQ.2) THEN
4518          WRITE(CCOOR(LL+1:LL+29),'("(",G13.5,",",G13.5,")")') V1,V2
4519          LL = LL+29
4520        ELSEIF(IDIM.EQ.3) THEN
4521          WRITE(CCOOR(LL+1:LL+31),'("(",2(G9.3,","),G9.3,")")') V1,V2,V3
4522          LL = LL+31
4523        ENDIF
4524      ENDIF
4525      CALL ASFCOL(0)
4526      CALL GSPATF(8)
4527      IF (IFONT8.EQ.9) THEN
4528        CALL GSLSS(9)
4529      ELSE
4530        CALL GSLSS(0)
4531      ENDIF
4532      CALL AFFICHE_COMPTEUR(XCONT,YCONT,LL,CCOOR,6)
4533      END
4534