      PROGRAM XD3D
C
C Main program of xd3d.
C xd3d was born in 1988 on IBM mainframe computers.
C It is a free software under the Gnu Public License since July 2003.
C Its main author is Francois Jouve <francois.jouve@polytechnique.fr>
C http://www.cmap.polytechnique.fr/~jouve/xd3d
C
      INCLUDE 'com_boutons.f'
      INCLUDE 'com_coor.f'
      INCLUDE 'com_faces.f'
      INCLUDE 'com_ombreiso.f'
      INCLUDE 'com_options.f'
      INCLUDE 'com_savetrace.f'
      INCLUDE 'com_vieucu.f'
ctrans      common / dirobs / obsobs(3),uuuu(3),vvvv(3)
C
      REAL*8        VEC0(3),VEC1(3),SEC0,SEC1
      DIMENSION     ROTA0(3,3),ROTAINV(3,3),SYM(3,4),XC(8),YC(8),ZC(8)
      CHARACTER*128 FICLEC,FICLEC2,CBIDON
      CHARACTER*7   CNUM
      CHARACTER*3   CNUM2,CNUM3
      CHARACTER*2   CC
      CHARACTER*1   CSOURI(5)
      LOGICAL*4     DEBUT,GEOM,GVESTLA
      DATA SYM / 1.,1.,1., 1.,-1.,1., -1.,1.,1., -1.,-1.,1. /
C
      INCLUDE 'Version.f'
      INCLUDE 'com_coul.f'
C
CC      DATA USR2 / 0.707106781186548 /
CC      DATA USR3 / 0.577350269189626 /
CC      DATA USR6 / 0.408248290463863 /
      DATA R2R3 / 0.816496580927726 /
cc      DATA RAC3 / 1.73205080756888  /
      DATA PI   / 3.14159265358979  /
      DATA CSOURI / '0','"','#','A','C' /
C 2^1/8
      DATA FACZOOM / 1.090507733 /
C
C Langue
C
      CALL perfide(ILANG,IDEBUG)
      ILANG0 = ILANG
      CALL BERLITZ(ILANG)
      CALL INITFLUSH
      CHEMDOC = '/home/jouve/Doc/xd3d_doc.ps'
      LENCHEM = 27
      PROG    = 'd3d'
      LPROG   = 3
      CALL LONGUEUR(PROBIG,LPRO)
C
      DFACX    = 0.
      DFACY    = 0.
      DFACZ    = 0.
      FACPTS   = 1.
      FACVIT0  = 1.
      IAUTORELOAD = 0
      IBATCH   = 0
      IBORD    = 0
      IBORDTHERMO = 1
      IBOUT    = 0
      ICALSU   = 0
      ICOLAR   = 2
      ICOLAX   = 7
      ICOLAXB  = 4
      ICOULTHERMO = 11
      ICPTS    = 1
      ICSEG    = 7
      IDEB     = 0
      IDEBRAP  = 0
      IDEROUL  = 0
      IDIRL    = 0
      IECBOI   = 0
      IELIMI   = 0
      IELISO   = 0
      IEPBOR   = 6
      IEPSEG   = 1
      IFC      = 1
      IFONT0   = 0
      IFONT1   = 1
      IFONT2   = 2
      IFONT3   = 3
      IFONT4   = 4
      IFONT5   = 5
      IFONT7   = 7
      IFONT8   = 8
      IFREEZE  = 0
      IFRONT   = 0
      IGOTO    = 1
      ILEG     = 0
      ILEGAUTO = 0
      ILEGMAN  = 0
      ILOGX    = 0
      ILOGY    = 0
      ILOGZ    = 0
      INUMINTER = 0
      IOPMAR   = 0
      IOPTFORME = 0
      IPARA    = 0
      IPROGRE  = 0
      IPROX    = 95
      IPROY    = 77
      IQUEST   = 0
      IREFRE   = 0
      IRQ      = 0
      ISAUVEGRAPH = 0
      ISOBID   = 0
      ISTDOUT  = 0
      ISYMR    = 0
      ITEMPS   = 0
      ITOUCHEX = 0
      ITOUCHNB = 0
      ITOUCHTAB = 0
      ITPTS    = 5
      ITYP     = 0
      IVIT     = 1
      IWAVE    = 0
      LONCOUR  = 0
      LONISO   = 0
      LONLEG   = 0
      LONPS    = 0
      LONVIT   = 0
      NBCOUL   = 64
      NODEPL   = 0
C
      BIG      = 1.E+14
      BIGS     = BIG
      USBIG    = 1./BIG
      XFMAX    = -BIG
      XFMIN    = BIG
      YFMAX    = -BIG
      YFMIN    = BIG
      VCOUPXYZ(1) = BIG
      VCOUPXYZ(2) = BIG
      VCOUPXYZ(3) = BIG
C
C Lecture de la ligne de commande
C
      IFC0 = IFC
      CALL LIOPT(FICLEC,FICLEC2,XINIT_ROTX,XINIT_ROTY,XINIT_ROTZ
     &          ,XINIT_VISO,XINIT_VMIN,XINIT_VMAX,XINIT_FACT
     &          ,XINIT_FACTX,XINIT_FACTY,XINIT_FACTZ,XINIT_FACV
     &          ,XINIT_XCUR,XINIT_YCUR,XINIT_ZOOM
     &          ,INIT_TABLE,INIT_ISO,INIT_FICH
     &          ,INIT_FICH2,INIT_BORD,INIT_DEFPS,INIT_NBCOUL
     &          ,INIT_FLECH,INIT_RECON,INIT_ISOBID,INIT_IBOITE
     &          ,INIT_IECBOI,INIT_FOND,INIT_IAXES,INIT_IPERSP
     &          ,INIT_DIRL,INIT_MODE,INIT_DEPL)
      IF (IFC.NE.IFC0) THEN
        ISAVEIFC = 1
      ELSE
        ISAVEIFC = 0
      ENDIF
C
C Evaluation de la memoire
C
      IF (ISTDOUT.EQ.0) CALL ECRMEM
C
C Initialisation
C
 1    IOPT   = 1
      GEOM   = .FALSE.
      IBORD0 = IBORD
      IFC0   = IFC
      CALL INITIAL(IPARA)
C common savetrace
      ICENTRISO0 = ICENTRISO
      INUMER0    = INUMER
      ISO0       = ISO
      IVALMAR0   = IVALMAR
      IVIT0      = IVIT
      IX00 = 0
      IX10 = 0
      IY00 = 0
      IY10 = 0
      PREM = .TRUE.
C
      IF (INIT_FOND.GE.0) ICTFON = INIT_FOND
      CALL MA_SOURIS(CSOURI(1),CSOURI(2),CSOURI(3),CSOURI(4),CSOURI(5))
      IF (ISAVEIFC.EQ.1) IFC = IFC0
C
C Opt forme
C
      IF (IOPTFORME.NE.0) THEN
        IF (IOPTFORME.EQ.1) THEN
          FICLEC = NOM_FICH(1:LONG-8)//'.theta'
          INIT_FICH = LONG-2
        ELSEIF(IOPTFORME.EQ.2) THEN
          FICLEC = NOM_FICH(1:LONG-8)//'.thetap'
          INIT_FICH = LONG-1
        ELSEIF(IOPTFORME.EQ.-3) THEN
          FICLEC = NOM_FICH(1:LONG-8)//'.v'
          INIT_FICH = LONG-6
        ELSE
cc          FICLEC = NOM_FICH(1:LONG-8)//'.levelset'
          FICLEC = NOM_FICH(1:LONG-8)//'.psi'
          INIT_FICH = LONG-4
        ENDIF
        CALL REMETFULLPATH(FICLEC,INIT_FICH)
        INIT_BORD = 3
        IF (IOPTFORME.GT.0) THEN
          IF (NOM_FICH(LONG-1:LONG).EQ.'3D') THEN
            IFC = -1
            XINIT_VISO = 0.3
            ICALSU = 2
          ELSE
            INIT_ISO = 11
          ENDIF
        ELSE
          IF (NOM_FICH(LONG-1:LONG).EQ.'3D') THEN
            IFC = -1
            IF (IOPTFORME.EQ.-1) THEN
              ICALSU = 1
            ELSEIF(IOPTFORME.EQ.-3) THEN
              ICALSU = 2
            ELSE
              ICALSU = 0
            ENDIF
            IF (IOPTFORME.EQ.-3) THEN
              XINIT_VISO = 0.5
            ELSE
              XINIT_VISO = 0.
            ENDIF
          ELSE
            IF (IOPTFORME.EQ.-1.OR.IOPTFORME.EQ.-3) THEN
              INIT_ISO = 2
              INIT_NBCOUL = 8
            ELSE
              INIT_ISO = 4
              INIT_NBCOUL = 1
              IEPISO = 0
              XINIT_VMIN = -1.
              XINIT_VMAX = 1.
            ENDIF
            ITOUCHNB = 1
          ENDIF
        ENDIF
      ENDIF
C
      IF (INIT_MODE.GE.0.AND.INIT_MODE.LT.1000) THEN
        IF (INIT_MODE.EQ.0) THEN
          FICLEC = NOM_FICH(1:LONG-8)//'.mode'
          INIT_FICH = LONG-3
        ELSE
          WRITE(CNUM2,'(I3.3)') INIT_MODE
          FICLEC = NOM_FICH(1:LONG-8)//'_'//CNUM2//'.mode'
          INIT_FICH = LONG+1
        ENDIF
        CALL REMETFULLPATH(FICLEC,INIT_FICH)
        ITOUCHEX = 1
        IF (XINIT_FACT.EQ.BIGS.OR.XINIT_FACT.EQ.311263.) XINIT_FACT = 1.
      ENDIF
C
      IF (INIT_DEPL.GE.0.AND.INIT_DEPL.LT.1000) THEN
        IF (INIT_DEPL.EQ.0) THEN
          FICLEC = NOM_FICH(1:LONG-8)//'.depl'
          INIT_FICH = LONG-3
        ELSE
          WRITE(CNUM2,'(I3.3)') INIT_DEPL
          FICLEC = NOM_FICH(1:LONG-8)//'_'//CNUM2//'.depl'
          INIT_FICH = LONG+1
        ENDIF
        CALL REMETFULLPATH(FICLEC,INIT_FICH)
        ITOUCHEX = 1
        IF (XINIT_FACT.EQ.BIGS) XINIT_FACT = 1.
      ENDIF
C
      IPFK = 9999
      IF (IPARA.EQ.0) DEBUT = .TRUE.
C
C Lecture des points
C
      CALL LECTURE(XINIT_FACT)
C
      IF (XINIT_ECH(1,1).NE.BIGS.OR.XINIT_ECH(2,1).NE.BIGS) THEN
        IF (XINIT_ECH(1,1).NE.BIGS) THEN
          XMI = XINIT_ECH(1,1)
        ELSE
          XMI = XMIN
        ENDIF
        IF (XINIT_ECH(2,1).NE.BIGS) THEN
          XMA = XINIT_ECH(2,1)
        ELSE
          XMA = XMAX
        ENDIF
        XBMIN = MIN(XMI,XMA)
        XBMAX = MAX(XMI,XMA)
        CALL ARONDI(XBMIN,XBMAX,XECH,PROPX,NECHX,NBECH)
        BX = (XBMAX-XBMIN)*0.5
        BX0 = BX
        IECHFX = 1
      ELSE
        IECHFX = 0
        XBMIN = 0.
        XBMAX = 0.
      ENDIF
      IF (XINIT_ECH(1,2).NE.BIGS.OR.XINIT_ECH(2,2).NE.BIGS) THEN
        IF (XINIT_ECH(1,2).NE.BIGS) THEN
          YMI = XINIT_ECH(1,2)
        ELSE
          YMI = YMIN
        ENDIF
        IF (XINIT_ECH(2,2).NE.BIGS) THEN
          YMA = XINIT_ECH(2,2)
        ELSE
          YMA = YMAX
        ENDIF
        YBMIN = MIN(YMI,YMA)
        YBMAX = MAX(YMI,YMA)
        CALL ARONDI(YBMIN,YBMAX,YECH,PROPY,NECHY,NBECH)
        BY = (YBMAX-YBMIN)*0.5
        BY0 = BY
        IECHFY = 1
      ELSE
        IECHFY = 0
        YBMIN = 0.
        YBMAX = 0.
      ENDIF
      IF (XINIT_ECH(1,3).NE.BIGS.OR.XINIT_ECH(2,3).NE.BIGS) THEN
        IF (XINIT_ECH(1,3).NE.BIGS) THEN
          ZMI = XINIT_ECH(1,3)
        ELSE
          ZMI = ZMIN
        ENDIF
        IF (XINIT_ECH(2,3).NE.BIGS) THEN
          ZMA = XINIT_ECH(2,3)
        ELSE
          ZMA = ZMAX
        ENDIF
        ZBMIN = MIN(ZMI,ZMA)
        ZBMAX = MAX(ZMI,ZMA)
        CALL ARONDI(ZBMIN,ZBMAX,ZECH,PROPZ,NECHZ,NBECH)
        BZ = (ZBMAX-ZBMIN)*0.5
        BZ0 = BZ
        BZ00 = BZ
        IECHFZ = 1
      ELSE
        IECHFZ = 0
        ZBMIN = 0.
        ZBMAX = 0.
      ENDIF
      IF (IECHFX.NE.0.OR.IECHFY.NE.0.OR.IECHFZ.NE.0) IFIX = 0
C
      IF (ICOURB.LE.0) THEN
        IF (XINIT_FACTX.EQ.BIGS) THEN
          XINIT_FACTX = 1.
        ELSEIF(XINIT_FACTX.EQ.0.) THEN
          XINIT_FACTX = EXAX0
        ENDIF
        IF (XINIT_FACTY.EQ.BIGS) THEN
          XINIT_FACTY = 1.
        ELSEIF(XINIT_FACTY.EQ.0.) THEN
          XINIT_FACTY = EXAY0
        ENDIF
        IF (XINIT_FACTZ.EQ.BIGS) THEN
          XINIT_FACTZ = 1.
        ELSEIF(XINIT_FACTZ.EQ.0.) THEN
          XINIT_FACTZ = EXAZ0
        ENDIF
      ENDIF
C
      IF (IPARA.NE.0) THEN
        IBORD = IBORD0
        IFC   = IFC0
      ENDIF
ctrans      dist000 = dist
ctrans      call calpup(xpup,dist,obsobs,uuuu,vvvv)
      IF (IPARA.EQ.0) THEN
        IF (I2D.EQ.0.AND.IPS2D.EQ.0
     &.AND.(ICOURB.GT.0.OR.IELIMI.EQ.0)) THEN
          IPERSP = -2
        ELSE
          IPERSP = 1
          IAXES = 0
          IBORD = 0
        ENDIF
      ELSEIF(IDEBRAP.NE.0) THEN
        IBORD = -1
        IFC = -1
      ENDIF
      IPERSP0 = IPERSP
      IF (INIT_IPERSP.NE.0) IPERSP = INIT_IPERSP
      CALL METLAPERSP
      CALL METLALIGHT
      IAXESDEF = IAXES
      IF (INIT_IAXES.GE.0) IAXES = INIT_IAXES
C
C Selection des faces exterieures
C
      IF (ICOURB.GT.0) THEN
        CALL ELIMIN
        IF (IREFRE.EQ.0) IBOITE = 0
      ELSE
        IF (ICOURB.EQ.-5) THEN
          CALL ELIMIN
        ELSE
          CALL ELIMIN2
        ENDIF
        IF (IREFRE.EQ.0) IBOITE = 1
      ENDIF
      IF ((IFRONT.EQ.-1.AND.NUMSD.LE.1)
     &.OR.(IFRONT.EQ.1.AND.IFBLO.EQ.0)) IFRONT = 0
      IF (IFRONT.EQ.3.AND.IFBLO.EQ.0) IFRONT = 2
C
      DO I=1,NUMSD
        ISDVU(I) = 1
      ENDDO
C
      IF (LONCOUR.GT.0) THEN
        IF (ICOURB.EQ.-5.or.ICOURB.GT.0) THEN
          CALL INV3X3(ROTA,ROTLOC,IERR)
          DO I=1,3
            DO J=1,3
              ROTA(J,I) = ROTLOC(J,I)
            ENDDO
          ENDDO
          CALL ROTATE(0)
          IF (NDS.EQ.3) THEN
            CALL LICOUR3(IRC)
          ELSE
            CALL LICOUR4(IRC)
          ENDIF
          CALL INV3X3(ROTA,ROTLOC,IERR)
          DO I=1,3
            DO J=1,3
              ROTA(J,I) = ROTLOC(J,I)
            ENDDO
          ENDDO
          CALL ROTATE(0)
        ELSE
          CALL LICOUR(IRC)
        ENDIF
        IF (IRC.NE.0) LONCOUR = 0
      ENDIF
C
      CALL INITBOUT
      IF (NDS.NE.3) THEN
        IF (NDS.EQ.4.AND.I2D.EQ.0.AND.ICOURB.GT.0) THEN
          IF (ELEMENTS(1:14).EQ.'Quadrangles 3D') THEN
            NDS = 4
          ELSE
            NDS = 3
          ENDIF
        ELSE
          NDS = 4
        ENDIF
      ENDIF
      NDS2 = NDS+1
C
C Reconstitution de l'oeil par symetrie
C
      CALL RECONS(NFACE,NF,NF4,NRECONMAX,XMED2,YMED2)
      IF (INIT_RECON.GT.1) NFACE = NF*MIN(NRECONMAX,INIT_RECON)
      IF (INIT_RECON.LT.0) NFACE = NF*NRECONMAX
      NRECON = NFACE/NF
C
      IF (NRECON.GT.1) THEN
        NF0 = NF
        NRECON0 = 1
        CALL SYMETRISE(NRECON0,1)
      ENDIF
C
C Champ de deplacement= vitesse
C
      IF (IFVIT.EQ.2) THEN
        DO I=1,NF
          DO J=1,NDS
            VITF(1,J,I) = VITN(1,NFAC(J,I))
            VITF(2,J,I) = VITN(2,NFAC(J,I))
            VITF(3,J,I) = VITN(3,NFAC(J,I))
            VALF(J,I) = VALX(NFAC(J,I))
          ENDDO
        ENDDO
        IF (ISYM.EQ.4) THEN
          IF (NRECONMAX.GT.1) THEN
            IF (IDEMI.EQ.2) THEN
              SYM(1,2) = -1.
              SYM(2,2) = 1.
            ENDIF
            DO I=NF+1,NF4
              II = 1+(I-1)/NF
              DO J=1,NDS
                VITF(1,J,I) = SYM(1,II)*VITN(1,NFAC(J,I))
                VITF(2,J,I) = SYM(2,II)*VITN(2,NFAC(J,I))
                VITF(3,J,I) = VITN(3,NFAC(J,I))
                VALF(J,I) = VALX(NFAC(J,I))
              ENDDO
            ENDDO
          ENDIF
        ELSE
          DO N=1,NRECONMAX-1
            IF (MOD(N,2).EQ.1) THEN
              ANG = REAL(2*(N+1))*PI/REAL(ISYM)
              COCO = COS(ANG)
              SISI = SIN(ANG)
              DO K=1,NF
                I = NF*N+K
                DO J=1,NDS
                  VITF(1,J,I) = COCO*VITN(1,NFAC(J,I))
     &                        + SISI*VITN(2,NFAC(J,I))
                  VITF(2,J,I) = SISI*VITN(1,NFAC(J,I))
     &                        - COCO*VITN(2,NFAC(J,I))
                  VITF(3,J,I) = VITN(3,NFAC(J,I))
                  VALF(J,I) = VALX(NFAC(J,I))
                ENDDO
              ENDDO
            ELSE
              ANG = REAL(2*N+4)*PI/REAL(ISYM)
              COCO = COS(ANG)
              SISI = SIN(ANG)
              DO K=1,NF
                I = NF*N+K
                II = NF+K
                DO J=1,NDS
                  VITF(1,J,I) = COCO*VITF(1,J,II)
     &                        + SISI*VITF(2,J,II)
                  VITF(2,J,I) = SISI*VITF(1,J,II)
     &                        - COCO*VITF(2,J,II)
                  VITF(3,J,I) = VITN(3,NFAC(J,I))
                  VALF(J,I) = VALX(NFAC(J,I))
                ENDDO
              ENDDO
            ENDIF
          ENDDO
        ENDIF
      ENDIF
C
C Initialisation du graphique
C
      IF (IBATCH.EQ.0) THEN
        IF (DEBUT) THEN
          CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
          CALL x11nomicone('Xd3d'//char(0),4)
          CALL x11askbacking(IBACKINGSTORE)
C
C Il y a des pb avec les polygones convexes lorsqu'ils sont tres
C allonges. On reste donc avec l'hypothese de polygones Complex
C
CCC        CALL x11polyconvex(0)
          CALL GETIDX(IDX0,IDY0,IECX,IECY)
        ENDIF
        NBOGO = MYBOGOVITESSE()
        IF (I2D.EQ.0) THEN
          NBIGF = 8*NBOGO
        ELSE
          NBIGF = 5*NBOGO
        ENDIF
        NOUTLINEM = NBOGO/3
        CALL CALCOUTLINE(NFACE,0)
        IF (IPROGRE.EQ.0) THEN
          IF (NFACE.LE.NBIGF) THEN
            IF (ILANG.EQ.0) THEN
              PRINT*,'Double buffer (NFACE=',NFACE,', Seuil=',NBIGF,')'
            ELSE
              PRINT*,
     &           'Double buffer (NFACE=',NFACE,', Threshold=',NBIGF,')'
            ENDIF
            IPROGRE = -1
          ELSE
            IF (ILANG.EQ.0) THEN
              PRINT*,
     &      'Pas de double buffer (NFACE=',NFACE,', Seuil=',NBIGF,')'
            ELSE
              PRINT*,
     &      'No double buffer (NFACE=',NFACE,', Threshold=',NBIGF,')'
            ENDIF
            IPROGRE = 1
          ENDIF
        ENDIF
      ELSE
        CALL FSINN(IPROX,IPROY,PROBIG,-99,ITERMC)
      ENDIF
      IDEB = 1
      IF (I2D.EQ.0.AND.IPS2D.EQ.0.AND.(ICOURB.GT.0.OR.IELIMI.EQ.0)) THEN
        IRENO = 0
        IF (IPARA.NE.0) THEN
          NRECON = MIN(IPARA,NRECONMAX)
          NFACE = NF*NRECON
          CALL ROTATE(1)
        ELSEIF((NUMSD.EQ.1.OR.ICOURB.GT.0).AND.
     &         (ITERMC.EQ.1.OR.ITERMC.EQ.3.OR.ITERMC.EQ.4)) THEN
          ITABLE = 7
          ICTFAC = 99
        ELSE
          ITABLE = 1
          ICTFAC = 0
        ENDIF
      ELSE
        IF (IPARA.EQ.0) THEN
          ITABLE = 1
          ICTFAC = 0
        ENDIF
        IF (I2D.NE.0) THEN
          IRENO = I2D+1
        ELSE
          IRENO = 2
        ENDIF
        CALL CALROT(ROTLOC,IRENO)
        CALL ROTATE(1)
      ENDIF
      ICTFAC00 = ICTFAC
      IDIRL0 = IDIRL
      IF (INIT_DIRL.EQ.-1) THEN
        ICTFAC = 0
      ELSEIF(INIT_DIRL.GT.0) THEN
        IDIRL = INIT_DIRL
        CALL METLALIGHT
      ENDIF
C
      IF (MIN(XINIT_ROTX,XINIT_ROTY,XINIT_ROTZ).LT.BIGS) THEN
        CALL ARC(ANGX,ANGY,ANGZ)
        IF (XINIT_ROTX.NE.BIGS) ANGX = XINIT_ROTX
        IF (XINIT_ROTY.NE.BIGS) ANGY = XINIT_ROTY
        IF (XINIT_ROTZ.NE.BIGS) ANGZ = XINIT_ROTZ
        CALL INV3X3(ROTA,ROTLOC,IERR)
        CALL ROTATE(1)
        CALL ARCROT(ANGX,ANGY,ANGZ)
        CALL ROTATE(0)
      ENDIF
C
C Table de couleurs initiale : 75 couleurs
C
      IF (INIT_TABLE.NE.0) ITABLE = INIT_TABLE
      IF (INIT_NBCOUL.NE.0) NBCOUL = INIT_NBCOUL
      CALL CHNBCOL(NBCOUL,NVAL,0,ITABLE)
      IF (IBATCH.NE.0.AND.IPOSTCOL.EQ.1) CALL METIPOST(-2)
      CALL TABCOL(NVAL,IWAVE)
C
      IF (IPARA.NE.0) CALL EXAGERE(DFACX,DFACY,DFACZ,0)
      IF (INIT_FICH.GT.0) THEN
        IRC = 1
        CALL LIVAL(FICLEC,INIT_FICH,IVAL,ICLAS,ICONTR,NDSEL,IRC)
        IF (IVAL.NE.9999) THEN
          IGOTO = 0
          IF (XINIT_FACT.NE.BIGS
     &   .AND.XINIT_FACT.NE.311263.) FACEXA = XINIT_FACT
          CALL ACTLIVAL(IVAL,ICONTR,FICLEC,INIT_FICH,IREFRE,IGOTO)
        ENDIF
      ENDIF
      IF (INIT_FICH2.GT.0) THEN
        IRC = 1
        CALL LIVAL(FICLEC2,INIT_FICH2,IVAL,ICLAS,ICONTR,NDSEL,IRC)
        IF (IVAL.NE.9999) THEN
          IGOTO = 0
          IF (XINIT_FACT.NE.BIGS
     &   .AND.XINIT_FACT.NE.311263.) FACEXA = XINIT_FACT
          CALL ACTLIVAL(IVAL,ICONTR,FICLEC2,INIT_FICH2,IREFRE,IGOTO)
        ENDIF
      ENDIF
C///// changer ca
      IF (INIT_ISOBID.NE.0) THEN
        IF (I2D.NE.0.AND.INIT_ISOBID.EQ.1) THEN
          INIT_ISOBID = 0
        ELSE
          ISOBID = INIT_ISOBID
          CALL MYISO
        ENDIF
      ENDIF
      IF (INIT_ISO.NE.0) THEN
        IF (IFISO.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            IF (ISTDOUT.EQ.0) THEN
              PRINT*,'*** Pas de fichier scalaire'
              IF (INIT_ISO.LT.10) THEN
                WRITE(*,'(" *** Option -iso=",I1," ignorée")') INIT_ISO
              ELSE
                WRITE(*,'(" *** Option -iso=",I2," ignorée")') INIT_ISO
              ENDIF
            ELSE
              PRINT*,'*** No scalar field'
              IF (INIT_ISO.LT.10) THEN
                WRITE(*,'(" *** Option -iso=",I1," ignored")') INIT_ISO
              ELSE
                WRITE(*,'(" *** Option -iso=",I2," ignored")') INIT_ISO
              ENDIF
            ENDIF
          ENDIF
        ELSE
          IF (INIT_ISO.GE.6.AND.ICENTR.EQ.0) THEN
            II = INIT_ISO
            IF (INIT_ISO.EQ.11) THEN
              INIT_ISO = 1
            ELSE
              INIT_ISO = INIT_ISO-5
            ENDIF
            IF (ISTDOUT.EQ.0) THEN
              IF (ILANG.EQ.0) THEN
                PRINT*,'*** Pas de valeurs aux centres des cellules'
                PRINT*,
     &               '*** Option -iso=',II,' transformée en -iso='
     &               ,INIT_ISO
              ELSE
                PRINT*,'*** No piecewise constant field'
                PRINT*,
     &               '*** Option -iso=',II,' changed into -iso='
     &               ,INIT_ISO
              ENDIF
            ENDIF
          ENDIF
          II = INIT_ISO+1
          CALL ACTISO2(II)
          ISOINI = 0
          CALL ACTISO(ISOINI,NBCOUL,IWAVE,IGOTO)
          IF (INIT_NBCOUL.NE.0.OR.INIT_TABLE.NE.0) THEN
            IF (INIT_NBCOUL.NE.0) NBCOUL = INIT_NBCOUL
            IF (INIT_TABLE.NE.0)  ITABLE = INIT_TABLE
            IF (ITABLE.GT.2) THEN
              IIII = -100000-NBCOUL
            ELSE
              CALL CHNBCOL(NBCOUL,NVAL,1,ITABLE)
              IIII = -100000-NVAL
            ENDIF
            CALL TABCOL(IIII,IWAVE)
Cfj            CALL CHNBCOL(NBCOUL,NVAL,0,ITABLE)
Cfj            CALL TABCOL(NVAL,IWAVE)
          ENDIF
        ENDIF
      ENDIF
      IF (XINIT_VISO.NE.BIGS) THEN
        IF (IFISO.EQ.0) THEN
          IF (ISTDOUT.EQ.0) THEN
            IF (ILANG.EQ.0) THEN
              PRINT*,'*** Pas de fichier scalaire'
              PRINT*,'*** Option -isosurf ignorée'
            ELSE
              PRINT*,'*** No scalar field'
              PRINT*,'*** Option -isosurf ignored'
            ENDIF
          ENDIF
        ELSEIF(I2D.NE.0) THEN
          IF (ISTDOUT.EQ.0) THEN
            IF (ILANG.EQ.0) THEN
              PRINT*,'*** Maillage 2d'
              PRINT*,'*** Option -isosurf ignorée'
            ELSE
              PRINT*,'*** 2d mesh'
              PRINT*,'*** Option -isosurf ignored'
            ENDIF
          ENDIF
        ELSEIF((XINIT_VISO.GT.VMAX.OR.XINIT_VISO.LT.VMIN)
     &         .AND.ICALSU.EQ.0) THEN
          IF (ISTDOUT.EQ.0) THEN
            IF (ILANG.EQ.0) THEN
              PRINT*,'*** Isosurface',XINIT_VISO,' hors bornes'
     &             ,VMIN,VMAX
              PRINT*,'*** Option -isosurf ignorée'
            ELSE
              PRINT*,'*** Isosurface',XINIT_VISO,' out of bounds'
     &             ,VMIN,VMAX
              PRINT*,'*** Option -isosurf ignored'
            ENDIF
          ENDIF
        ELSE
          VISO = XINIT_VISO
          IBSOMB = 0
          IF (IBSOMB.EQ.0) THEN
            BSOMB = 0.5
          ELSEIF(IBSOMB.EQ.0) THEN
            BSOMB = 0.3
          ELSE
            BSOMB = 0.1
          ENDIF
          CALL CALSUR(1)
          ICSUR = 16
        ENDIF
      ENDIF
      IF (XINIT_VMIN.NE.BIGS) THEN
        IF (ISO.NE.0) THEN
          VMIN0 = VMIN
          VMIN = XINIT_VMIN
        ELSEIF(ISTDOUT.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,'*** Pas d''isovaleurs demandées'
            PRINT*,'*** Option -vmin=',XINIT_VMIN,' ignorée'
          ELSE
            PRINT*,'*** No contour plot asked'
            PRINT*,'*** Option -vmin=',XINIT_VMIN,' ignored'
          ENDIF
        ENDIF
      ENDIF
      IF (XINIT_VMAX.NE.BIGS) THEN
        IF (ISO.NE.0) THEN
          VMAX0 = VMAX
          VMAX = XINIT_VMAX
        ELSEIF(ISTDOUT.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,'*** Pas d''isovaleurs demandées'
            PRINT*,'*** Option -vmax=',XINIT_VMAX,' ignorée'
          ELSE
            PRINT*,'*** No contour plot asked'
            PRINT*,'*** Option -vmax=',XINIT_VMAX,' ignored'
          ENDIF
        ENDIF
      ENDIF
      IF (ISO.NE.0.AND.MIN(XINIT_VMIN,XINIT_VMAX).LT.BIGS) THEN
        IF (VMAX.EQ.VMIN) THEN
          VMIN = VMIN0
          VMAX = VMAX0
        ELSEIF(VMIN.GT.VMAX) THEN
          VMIN0 = VMIN
          VMIN = VMAX
          VMAX = VMIN0
        ENDIF
      ENDIF
      IF (INIT_FLECH.NE.0) THEN
        IF (IFVIT.NE.0) THEN
          IF (IVIT.GT.0) IVIT = -IVIT
          IF (XINIT_FACV.NE.0.) THEN
            FACVIT  = XINIT_FACV
            FACVIT0 = XINIT_FACV
          ENDIF
        ENDIF
      ENDIF
C
      IF (INIT_DEFPS.NE.9999) THEN
        CALL DEFPS(INIT_DEFPS,SIG,ANGPS,ICADPS,HELPPS,IDSEUL,0,ILANG)
        IDEFPS = INIT_DEFPS
      ENDIF
      IF (INIT_BORD.NE.9999) THEN
        II = INIT_BORD+1
        CALL ACTBOR2(II)
      ENDIF
C
      IF (ICOURB.LT.0.AND.(XINIT_FACTX.NE.1..OR.XINIT_FACTY.NE.1.
     &     .OR.XINIT_FACTZ.NE.1.)) THEN
        FACEXAX0 = FACEXAX
        FACEXAY0 = FACEXAY
        FACEXAZ0 = FACEXAZ
        FACEXAX = XINIT_FACTX
        FACEXAY = XINIT_FACTY
        FACEXAZ = XINIT_FACTZ
        DFACX = FACEXAX-FACEXAX0
        DFACY = FACEXAY-FACEXAY0
        DFACZ = FACEXAZ-FACEXAZ0
        CALL EXAGERE(DFACX,DFACY,DFACZ,0)
        VMINSAUV = VMIN
        VMAXSAUV = VMAX
        IF (ISOBID.NE.0) CALL MYISO
        VMIN = VMINSAUV
        VMAX = VMAXSAUV
        XINIT_FACTX = 1.
        XINIT_FACTY = 1.
        XINIT_FACTZ = 1.
      ENDIF
C
      IF (INIT_IBOITE.GE.0) THEN
        IBOITE = INIT_IBOITE
        IECBOI = INIT_IECBOI
      ENDIF
C
C Selection des faces dont la normale est contenue dans le 1/2 espace
C qui "regarde" l'observateur (si ifc.eq.1)
C
 5000 CALL PROJET(NBON,XMIN,XMAX,YMIN,YMAX)
C
C Classement des faces selectionnees selon la place de la projection
C du barycentre sur la droite passant par (0,0,0) et
C dirigee par (1,1,1) (direction d'observation)
C
      IF (I2D.EQ.0.OR.(IDEFOR.EQ.2.AND.FACEXA.NE.0.)) THEN
        IF (NSURF.GT.0.AND.IFC.LT.0) THEN
          CALL PROSUR(NBON)
          CALL RANGEMENT(NBON+NSURF)
c          CALL TEMPS(SEC0,IS)
          CALL CORRIGE(IORDRE,NBON,NSURF,NEIS,NSENS)
c          CALL TEMPS(SEC1,IS)
c          PRINT*,'Corrige =',SEC1-SEC0
        ELSE
          CALL RANGEMENT(NBON)
cguignard          do n=1,nbon
cguignard            nn = nproje(n)
cguignard            do i=1,4
cguignard              call zfictif(XF(I,Nn),YF(I,Nn),ZF(I,Nn),yy(i,n),zz(i,n))
cguignard            enddo
cguignard          enddo
cguignard          call mysort2(xx,yy,zz,iordre,nbon)
        ENDIF
      ELSE
        DO I=1,NBON
          IORDRE(I) = I
        ENDDO
      ENDIF
C
 5010 IF (DEBUT) THEN
        FACT = 1.08
        IF (IBOITE.NE.0) THEN
          CALL PROBOI(XC,YC,ZC)
          DO I=1,8
            XMAX = MAX(XMAX,XBOITE(I))
            XMIN = MIN(XMIN,XBOITE(I))
            YMAX = MAX(YMAX,YBOITE(I))
            YMIN = MIN(YMIN,YBOITE(I))
          ENDDO
          IF (MOD(IECBOI,2).EQ.0.AND.IECBOI.GT.0) FACT = 1.2
        ENDIF
        IF (IVIT.LT.0) THEN
          XMIN = MIN(XMIN,XFMIN)
          XMAX = MAX(XMAX,XFMAX)
          YMIN = MIN(YMIN,YFMIN)
          YMAX = MAX(YMAX,YFMAX)
        ENDIF
        XCUR = .5*(XMIN+XMAX)
        YCUR = .5*(YMIN+YMAX)
        XL = FACT*(XMAX-XCUR)
        YH = FACT*(YMAX-YCUR)
        IF (ICARRE.EQ.1) THEN
          XLARG = MAX(XL,YH)
        ELSE
          XLARG = MAX(XL,YH*HXA4/HYA4)
        ENDIF
        XLCRIT = XLARG*.5
        PASMIN2 = (.0025*XLARG)**2
        DEBUT = .FALSE.
      ELSE
        IF (I2D.EQ.0) THEN
          IRENO = 0
        ELSE
          IRENO = 1
        ENDIF
      ENDIF
C
      IF (IBATCH.EQ.1) THEN
c
c rajout un peu crade pour cadrer correctement les fleches
c quand on genere un ps directement
c
        IF (IVIT.LT.0) THEN
          CALL ACTPS(NBON,IWAVE,IGOTO)
          CALL TRACE(NBON,IOPT,GEOM,ITYP,IREFRE,IABAND,IBOUT,0)
          CALL FINDUPS(IPF)
          IF (LONPS.GT.0) CALL EXEC('/bin/rm -f '//NOMPS(1:LONPS))
          XMIN = MIN(XMIN,XFMIN)
          XMAX = MAX(XMAX,XFMAX)
          YMIN = MIN(YMIN,YFMIN)
          YMAX = MAX(YMAX,YFMAX)
          XCUR = .5*(XMIN+XMAX)
          YCUR = .5*(YMIN+YMAX)
          XL = FACT*(XMAX-XCUR)
          YH = FACT*(YMAX-YCUR)
          IF (ICARRE.EQ.1) THEN
            XLARG = MAX(XL,YH)
          ELSE
            XLARG = MAX(XL,YH*HXA4/HYA4)
          ENDIF
          XLCRIT = XLARG*.5
          PASMIN2 = (.0025*XLARG)**2
        ENDIF
        IBATCH = 2
        CALL ACTPS(NBON,IWAVE,IGOTO)
      ENDIF
      XLAREF = XLARG
      XCUREF = XCUR
      YCUREF = YCUR
      IF (XINIT_ZOOM.NE.BIGS) THEN
        XLARG = XLARG/XINIT_ZOOM
        XINIT_ZOOM = BIGS
      ENDIF
      IF (XINIT_XCUR.NE.BIGS) THEN
        XCUR = XINIT_XCUR
        XINIT_XCUR = BIGS
      ENDIF
      IF (XINIT_YCUR.NE.BIGS) THEN
        YCUR = XINIT_YCUR
        XINIT_YCUR = BIGS
      ENDIF
C
C Dessin ..........
C
 5001 CALL GSLW(0)
      CALL GSPAT(16)
      IF (XLARG.LE.XLCRIT) THEN
        CALL LIBERAL(1)
      ELSE
        CALL LIBERAL(0)
      ENDIF
      XDMIN0 = XDMIN
      YDMI20 = YDMI2
      ICTFAC0 = ICTFAC
      DXTRANS = 0.
      DYTRANS = 0.
      IF (IBACKINGSTORE.EQ.0) IREFRE = 1
      CALL TRACE(NBON,IOPT,GEOM,ITYP,IREFRE,IABAND,IBOUT,0)
      GEOM = .FALSE.
C
C Backing store manuel
C
      IF (IBACKINGSTORE.EQ.0.AND.IBATCH.EQ.0) CALL mybackingsave
C
      IF (IQUEST.NE.0) THEN
        IF (IQUEST.EQ.1900) GOTO 1900
        IF (IQUEST.EQ.2300) GOTO 2300
        IF (IQUEST.EQ.3501) GOTO 3501
        IF (IQUEST.EQ.3503) GOTO 3503
        IF (IQUEST.EQ.4900) GOTO 4900
      ENDIF
C
      IF (IABAND.NE.0) THEN
        IF (ILANG.EQ.0) THEN
          PRINT*,'Abandon de la sauvegarde PostScript et effacement de '
     &       //NOMPS(1:LONPS)
        ELSE
          PRINT*,'Cancelling PostScript generation and deleting '
     &       //NOMPS(1:LONPS)
        ENDIF
        CALL EXEC('/bin/rm -f '//NOMPS(1:LONPS))
        IPOST = 1
        IOPT = -3
        IREFRE = 1
        IMUL = IMULSAUV
        CALL x11allevents
        CALL CHANGE_CURS(1)
        GOTO 5001
      ENDIF
      IF (IOPT.EQ.-3) THEN
        CALL GSLT(0)
        IEPBOR = IEPBOR0
        CALL GSLW(IEPBOR)
        CALL GSBND(XCADRE(1),XCADRE(3),YDMIN,YDMAX)
        IF (IDEFPS.EQ.8) THEN
          CALL GSCOL(ICTFON)
          CALL GSPLNEC(4,XCADRE,YCADRE)
          CALL GSLW(0)
          IF (IAXES.NE.0) CALL AXES(XHELP,XDMAX,YDMIN,YDMAX)
          IF (ILEG.GT.0)
     &      CALL LEGENDE(XHELP,XDMAX,YDMIN,YDMAX,BID,BID,BID,BID,1)
          CALL LECADRE
        ELSE
          CALL GSCOL(ICOLAX)
          CALL GSPLNEC(4,XCADRE,YCADRE)
          CALL GSLW(0)
        ENDIF
        CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
        II = IABS(IBOUT)
        IF (II.NE.0) THEN
          IF (ITB(II).EQ.9) THEN
            CALL MYBORD(XBOUT(1,II),YBOUT(1,II),BID,0,1,0,0)
          ELSE
            CALL MYBORD(XBOUT(1,II),YBOUT(1,II),BID,0,ITOUR2,7,15)
          ENDIF
        ENDIF
        IX0 = IVRAIECOORD(XHELP)
        IX1 = IVRAIECOORD(XDMAX)
        PIPI = 2.*(XDMAX-XHELP)/REAL(IABS(IX0-IX1))
        XCADRE(1) = XPTHER - DXTHER*.5 - PIPI
        XCADRE(2) = XPTHER + DXTHER*.5 + PIPI
        YCADRE(1) = YPTHER - DYTHER*.5 - PIPI
        YCADRE(2) = YPTHER + DYTHER    + PIPI*3.5
        CALL GSPAT(8)
        CALL MY_GSAREA2(XCADRE,YCADRE)
        CALL GSBND(XDMIN,XDMAX,YDMIN,YDMAX)
        CALL METS_CURSEUR(XCUR,YCUR)
      ELSEIF(IPOST.EQ.1.AND.ITYP.GT.-13.AND.CLIGNE) THEN
        IX0 = IVRAIECOORD(XHELP)
        IX1 = IVRAIECOORD(XDMAX)
        PIPI = 2.*(XDMAX-XHELP)/REAL(IABS(IX0-IX1))
        XCADRE(1) = XPTHER - DXTHER*.5 - PIPI
        XCADRE(2) = XPTHER + DXTHER*.5 + PIPI
        YCADRE(1) = YPTHER - DYTHER*.5 - PIPI
        YCADRE(2) = YPTHER + DYTHER*.5 + PIPI
        CALL GSPAT(8)
        CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
        CALL MY_GSAREA2(XCADRE,YCADRE)
      ENDIF
      IREFRE = 0
      IPREM  = 0
      IBHELP = -9999
C
C Envoi du dessin sur l'ecran
C
 5002 IF (IBOUT.NE.0) THEN
        II = IABS(IBOUT)
        KB = KBOUT(II)
        IF (ITB(II).EQ.9) THEN
          ITO = 1
          IC1 = 0
          IC2 = 0
        ELSE
          ITO = ITOUR2
          IC1 = 7
          IC2 = 15
        ENDIF
        IF (IBOUT.GT.0) THEN
C
C mettre dans cette liste tous les boutons qui donnent un popup
C dans une fenetre separee.
C
          IF (IDEROUL.EQ.0.AND.KB.NE.-15.AND.KB.NE.13.AND.KB.NE.19
     &       .AND.KB.NE.21.AND.KB.NE.23.AND.KB.NE.36.AND.KB.NE.38) THEN
            ITYP = -13
          ELSE
            ITYP = 0
            IDEROUL = 0
            CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0,ITO,IC1,IC2)
            IBOUT = 0
          ENDIF
        ELSEIF(ITB(II).GT.0) THEN
          IF ((KB.EQ.-20.AND.IPROGRE.LT.0)
     &    .OR.(KB.EQ.-17.AND.ITITAV.LT.0)
     &    .OR.(KB.EQ.  4.AND.ISHRINK.LT.0)
     &    .OR.(KB.EQ.  6.AND.IFC.LT.0)
     &    .OR.(KB.EQ. 14.AND.ICARRE.LT.0)
     &    .OR.(KB.EQ. 31.AND.ISENS.LT.0)) THEN
cc     &    .OR.(KBOUT(II).EQ.-5.AND.IVIT.LT.0)
            CALL MYBORD(XBOUT(1,II),YBOUT(1,II),BID,0,ITO,IC2,IC1)
          ELSE
            CALL MYBORD(XBOUT(1,II),YBOUT(1,II),BID,0,ITO,IC1,IC2)
          ENDIF
          IF (KB.NE.2.AND.KB.NE.24) IBOUT = 0
          IDEROUL = 0
        ENDIF
        IF (IBACKINGSTORE.EQ.0.AND.IBATCH.EQ.0) THEN
          IF (KB.EQ. 2.OR.KB.EQ. 7.OR.KB.EQ.-20
     &    .OR.KB.EQ.13.OR.KB.EQ.19
     &    .OR.KB.EQ.24.OR.KB.EQ.32
     &    .OR.KB.EQ.36.OR.KB.EQ.38
     &    .OR.(KB.GE.28.AND.KB.LE.30)) THEN
            CALL MYBORD(XBOUT(1,II),YBOUT(1,II),BID,0,ITO,IC1,IC2)
            CALL mybackingsave
          ENDIF
        ENDIF
      ENDIF
      XCONT = XDMA2 - PIXEL*5.
      YCONT = .5*(YDMI2 + YDMIN)-PIXEL
      IF (I2D.NE.0) THEN
        CALL ASFCOL(0)
        IF (IFONT8.EQ.9) THEN
          CALL GSLSS(9)
        ELSE
          CALL GSLSS(0)
        ENDIF
        CALL GSPATF(8)
        CALL GSPAT(16)
      ENDIF
      IOPT = 1
      IF (IFREEZE.NE.0) THEN
        CALL GSQCUR(WIN,XCUCU,YCUCU)
        IF (XCUCU.LE.XHELP) THEN
          CALL CHANGE_CURS(2)
        ELSE
          CALL CHANGE_CURS(1)
        ENDIF
      ENDIF
C
      IF (IBRELON.EQ.0.OR.IBACKINGSTORE.EQ.0) THEN
        CALL AREFRESH(IRELIM,IRELIVA,IRELIVI)
        IF (IRELIM.NE.0.OR.IRELIVA.NE.0.OR.IRELIVI.NE.0) THEN
          IF (IAUTORELOAD.EQ.0) THEN
            CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,1,ITYP,0,IBREL)
          ELSE
            IBOUT = IBREL
            GOTO 4906
          ENDIF
        ENDIF
      ENDIF
      NBEV = 0
C
C//////////////////////////////////////////////////////////////
 5003 CALL ASREAD2(IIII,IPFK,ITYP)
C//////////////////////////////////////////////////////////////
      IF (IDEBUG.NE.0) PRINT*,'Après ASREAD2',IIII,IPFK,ITYP,IBOUT
      IF (IBATCH.EQ.2) STOP
C
      IF ((DXTRANS.NE.0..OR.DYTRANS.NE.0.)
     &     .AND.(IPFK.LT.549.OR.IPFK.GT.552)
     &     .AND.IPFK.NE.5.AND.IPFK.NE.-14
     &     .AND.(ITYP.NE.-14.OR.IPFK.NE.-9999)) THEN
cc        print*,'recalcule dim'
        DXTRANS = 0.
        DYTRANS = 0.
        CALL CALCDIM(YYLAR,0)
      ENDIF
C
      IF (IBRELON.EQ.0.OR.IBACKINGSTORE.EQ.0) THEN
        NBEV = NBEV+1
        IF (NBEV.GE.40.AND.IPFK.EQ.-9999.AND.ITYP.EQ.0
     & .AND.INUMINTER.EQ.0.AND.IPREM.EQ.0) THEN
          NBEV = 0
          CALL AREFRESH(IRELIM,IRELIVA,IRELIVI)
          IF (IRELIM.NE.0.OR.IRELIVA.NE.0.OR.IRELIVI.NE.0) THEN
            IF (IAUTORELOAD.EQ.0) THEN
              CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,1,ITYP,0,IBREL)
              CALL GSPATF(8)
            ELSE
              IBOUT = IBREL
              GOTO 4906
            ENDIF
          ENDIF
        ENDIF
      ENDIF
C
      IF (ITYP.EQ.0.AND.IPFK.EQ.-9999.AND.IFREEZE.EQ.0) THEN
        CALL GSQCUR(WIN,XCUCU,YCUCU)
        IF (IPREM.GE.1) THEN
          CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
          IF (IPREM.EQ.2) THEN
            CALL GSMOVE(XCUR0-XLARG0,YCUR0-YLARG0)
            CALL GSLINE(XCUR0+XLARG0,YCUR0-YLARG0)
            CALL GSLINE(XCUR0+XLARG0,YCUR0+YLARG0)
            CALL GSLINE(XCUR0-XLARG0,YCUR0+YLARG0)
            CALL GSLINE(XCUR0-XLARG0,YCUR0-YLARG0)
          ELSE
            IPREM = 2
            CALL GSLT(0)
            CALL GSCOL(5)
            IF (I2D.NE.0) THEN
              CALL ASFCOL(0)
              IF (IFONT8.EQ.9) THEN
                CALL GSLSS(9)
              ELSE
                CALL GSLSS(0)
              ENDIF
            ENDIF
          ENDIF
          XCUR2 = XCUCU
          YCUR2 = YCUCU
          XCUR0 = .5*(XCUR1+XCUR2)
          YCUR0 = .5*(YCUR1+YCUR2)
          XXLARG = .5*ABS(XCUR1-XCUR2)
          YYLARG = .5*ABS(YCUR1-YCUR2)
          IF (ICARRE.EQ.1) THEN
            XLARG0 = AMAX1(XXLARG,YYLARG)
            YLARG0 = XLARG0
          ELSE
            XLARG0 = AMAX1(XXLARG,YYLARG*HXA4/HYA4)
            YLARG0 = XLARG0*HYA4/HXA4
          ENDIF
          IF (XLARG0.EQ.0.) THEN
            XLARG0 = XLARG
            IF (ICARRE.EQ.1) THEN
              YLARG0 = XLARG0
            ELSE
              YLARG0 = XLARG0*HYA4/HXA4
            ENDIF
          ENDIF
          CALL GSMOVE(XCUR0-XLARG0,YCUR0-YLARG0)
          CALL GSLINE(XCUR0+XLARG0,YCUR0-YLARG0)
          CALL GSLINE(XCUR0+XLARG0,YCUR0+YLARG0)
          CALL GSLINE(XCUR0-XLARG0,YCUR0+YLARG0)
          CALL GSLINE(XCUR0-XLARG0,YCUR0-YLARG0)
          IF (I2D.NE.0) THEN
            CALL GSMIX(0)
            CALL AFFCOORD(XCONT,YCONT
     &                   ,XMED0+XCUCU*R2R3
     &                   ,YMED0+YCUCU*R2R3,BID,2,0)
            CALL GSMIX(1)
          ENDIF
        ELSEIF(INUMINTER.GT.0) THEN
          IF (INUMINTER.LE.2) THEN
            DISMIN = BIG
            NN = 0
            IOK = 0
            NOK = 0
            DO N=1,NBON
              DO I=1,NDS
                D2 = (XCUCU-XX(I,N))**2+(YCUCU-YY(I,N))**2
                IF (D2.LT.DISMIN) THEN
                  IOK = I
                  NOK = N
                  NE = NPROJE(N)
                  NN = NFAC(I,NE)
                  DISMIN = D2
                ENDIF
              ENDDO
            ENDDO
            XJEUNE = XX(IOK,NOK)
            YJEUNE = YY(IOK,NOK)
            CALL GSMS(5)
            CALL GSMB(PIPI*3.,PIPI*3.)
          ELSE
            DISMIN = BIG
            NN = 0
            IOK = 0
            NOK = 0
            IF (NDS.EQ.3) THEN
              XCUCU3 = 3.*XCUCU
              YCUCU3 = 3.*YCUCU
              DO N=1,NBON
                XCC = XX(1,N)+XX(2,N)+XX(3,N)
                YCC = YY(1,N)+YY(2,N)+YY(3,N)
                D2  = (XCUCU3-XCC)**2+(YCUCU3-YCC)**2
                IF (D2.LT.DISMIN) THEN
                  NOK = N
                  DISMIN = D2
                  XCCMIN = XCC/3.
                  YCCMIN = YCC/3.
                ENDIF
              ENDDO
            ELSE
              XCUCU4 = 4.*XCUCU
              YCUCU4 = 4.*YCUCU
              DO N=1,NBON
                XCC = XX(1,N)+XX(2,N)+XX(3,N)+XX(4,N)
                YCC = YY(1,N)+YY(2,N)+YY(3,N)+YY(4,N)
                D2  = (XCUCU4-XCC)**2+(YCUCU4-YCC)**2
                IF (D2.LT.DISMIN) THEN
                  NOK = N
                  DISMIN = D2
                  XCCMIN = XCC*.25
                  YCCMIN = YCC*.25
                ENDIF
              ENDDO
            ENDIF
            NE = NPROJE(NOK)
            NN = NNUMFA(NE)
            XJEUNE = XCCMIN
            YJEUNE = YCCMIN
          ENDIF
          IF (INUMINTER.GE.2) THEN
            IF (XJEUNE.NE.XVIEUX.OR.YJEUNE.NE.YVIEUX) THEN
              CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
              IF (INUMINTER.EQ.2) THEN
                CALL GSCOL(7)
                CALL GSMARK(XVIEUX,YVIEUX)
              ELSE
                CALL GSPATF(1)
                CALL GSPAT(16)
                CALL MY_GSAREA(0,XX(1,NNVIEUX),YY(1,NNVIEUX),NDS)
              ENDIF
              CALL GSCHAR3(XVIEUX,YVIEUX,L,CNUM,ICENT0,-1)
            ELSE
              GOTO 5003
            ENDIF
          ELSE
            INUMINTER = 2
            CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
            CALL METS_CURSEUR(XX(IOK,NOK),YY(IOK,NOK))
          ENDIF
          XVIEUX = XJEUNE
          YVIEUX = YJEUNE
          IF (INUMINTER.EQ.2) THEN
            NNVIEUX = NN
          ELSE
            NNVIEUX = NOK
          ENDIF
          IF (NN.LT.10) THEN
            WRITE(CNUM(1:1),'(I1)') NN
            L = 1
          ELSEIF(NN.LT.100) THEN
            WRITE(CNUM(1:2),'(I2)') NN
            L = 2
          ELSEIF(NN.LT.1000) THEN
            WRITE(CNUM(1:3),'(I3)') NN
            L = 3
          ELSEIF(NN.LT.10000) THEN
            WRITE(CNUM(1:4),'(I4)') NN
            L = 4
          ELSEIF(NN.LT.100000) THEN
            WRITE(CNUM(1:5),'(I5)') NN
            L = 5
          ELSEIF(NN.LT.1000000) THEN
            WRITE(CNUM(1:6),'(I6)') NN
            L = 6
          ELSE
            WRITE(CNUM(1:7),'(I7)') NN
            L = 7
          ENDIF
          IF (INUMINTER.EQ.2) THEN
            CALL GSCOL(7)
            CALL GSMARK(XVIEUX,YVIEUX)
          ELSE
            CALL GSPATF(1)
            CALL GSPAT(16)
            CALL MY_GSAREA(0,XX(1,NNVIEUX),YY(1,NNVIEUX),NDS)
          ENDIF
          CALL GSCHAR3(XVIEUX,YVIEUX,L,CNUM,ICENT,-1)
          ICENT0 = ICENT
          IF (I2D.NE.0) THEN
            IF (INUMINTER.EQ.2) THEN
              CALL AFFCOORD(XCONT,YCONT
     &                     ,XMED0+XX(IOK,NOK)*R2R3
     &                     ,YMED0+YY(IOK,NOK)*R2R3,BID,2,NN)
            ELSE
              CALL AFFCOORD(XCONT,YCONT
     &                     ,XMED0+XCUCU*R2R3
     &                     ,YMED0+YCUCU*R2R3,BID,2,NN)
            ENDIF
            CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
            CALL GSLSS(IFONT1)
            CALL ASFCOL(5)
          ELSEIF(INUMINTER.EQ.2) THEN
            CALL INV3X3(ROTA,ROTAINV,IERR)
            XINI = ROTAINV(1,1)*X(NN)
     &           + ROTAINV(1,2)*Y(NN) + ROTAINV(1,3)*Z(NN)
            YINI = ROTAINV(2,1)*X(NN)
     &           + ROTAINV(2,2)*Y(NN) + ROTAINV(2,3)*Z(NN)
            ZINI = ROTAINV(3,1)*X(NN)
     &           + ROTAINV(3,2)*Y(NN) + ROTAINV(3,3)*Z(NN)
            CALL AFFCOORD(XCONT,YCONT,XMED0+XINI,YMED0+YINI,ZMED0+ZINI,3
     &                   ,NN)
            CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
            CALL GSLSS(IFONT1)
            CALL ASFCOL(5)
          ENDIF
          GOTO 5003
        ELSEIF(XCUCU.GE.XHELP) THEN
          IF (IBHELP.GE.0) THEN
            IBHELP = -9999
            CALL CLNINF(1)
          ENDIF
          IF (I2D.NE.0) CALL AFFCOORD(XCONT,YCONT
     &                               ,XMED0+XCUCU*R2R3
     &                               ,YMED0+YCUCU*R2R3,BID,2,0)
        ELSE
          CALL QBOUT(XCUCU,YCUCU,IBBB)
          IF (IBBB.EQ.0) THEN
            IF (IBBB.NE.IBHELP) THEN
              IBHELP = 0
              CALL CLNINF(0)
            ENDIF
          ELSE
            IF (ITB(IBBB).EQ.6) THEN
              IF (IBHELP.NE.0) THEN
                IBHELP = 0
                CALL CLNINF(0)
              ENDIF
            ELSEIF(IBBB.NE.IBHELP) THEN
              IBHELP = IBBB
              CALL ECHELP(IBHELP,0)
            ENDIF
          ENDIF
        ENDIF
        GOTO 5003
      ELSEIF(IPREM.NE.0.AND.IPFK.NE.26.AND.IPFK.NE.0) THEN
        GOTO 5003
      ENDIF
      IF (INUMINTER.NE.0) THEN
        IF (IPFK.EQ.0.OR.IPFK.EQ.26) THEN
          CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
          CALL GSCHAR3(XVIEUX,YVIEUX,L,CNUM,ICENT,-1)
          CALL GSMIX(0)
          CALL GSBND(XDMIN,XHELP,YDMIN,YDMAX)
          CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0
     &               ,ITOUR2,7,15)
          IF (INUMINTER.EQ.2) THEN
            IF (I2D.EQ.0) THEN
              CALL AFFCOORD(XCONT,YCONT,BID,BID,BID,0,0)
              IF (ILANG.EQ.0) THEN
                PRINT*,'Dernier noeud :',NNVIEUX,' ('
     &               ,XMED0+XINI,',',YMED0+YINI,',',ZMED0+ZINI,')'
              ELSE
                PRINT*,'Last node:',NNVIEUX,' ('
     &               ,XMED0+XINI,',',YMED0+YINI,',',ZMED0+ZINI,')'
              ENDIF
            ELSE
              IF (ILANG.EQ.0) THEN
                PRINT*,'Dernier noeud :',NNVIEUX,' ('
     &           ,XMED0+XX(IOK,NOK)*R2R3,',',YMED0+YY(IOK,NOK)*R2R3,')'
              ELSE
                PRINT*,'Last node:',NNVIEUX,' ('
     &           ,XMED0+XX(IOK,NOK)*R2R3,',',YMED0+YY(IOK,NOK)*R2R3,')'
              ENDIF
            ENDIF
          ENDIF
          INUMINTER = 0
          CALL CLNINF(0)
          CALL CHANGE_CURS(1)
        ELSEIF(IPFK.EQ.-13) THEN
          IF (INUMINTER.EQ.2) THEN
            IF (I2D.EQ.0) CALL AFFCOORD(XCONT,YCONT,BID,BID,BID,0,0)
            INUMINTER = 3
            ICENT = 5
          ELSE
            INUMINTER = 2
            ICENT = 7
          ENDIF
          CALL GSMIX(0)
          CALL CLNINF(INUMINTER)
          CALL GSLSS(IFONT1)
          CALL GSMIX(1)
          CALL ASFCOL(5)
          CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
          GOTO 5003
        ELSE
          GOTO 5003
        ENDIF
      ENDIF
      CALL ASFCOL(ICOLAX)
      CALL GSMIX(0)
C
      IF (IIII.LT.0) THEN
        CALL x11szscrn(IDX2,IDY2)
        IF (IDX.NE.IDX2.OR.IDY.NE.IDY2) THEN
cc          GEOM = .FALSE.
          CALL GSCLR
          GOTO 5001
        ELSE
          GOTO 5003
        ENDIF
      ELSEIF(IPFK.EQ.9999) THEN
        IPOST = 1
        IOPT = -3
        IREFRE = 1
        IMUL = IMULSAUV
        CALL x11allevents
        GOTO 5001
      ELSEIF(IBOUT.GT.0.AND.ITB(IBOUT).GT.0) THEN
cc        CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
        IF ((KBOUT(IBOUT).EQ.-20.AND.IPROGRE.LT.0)
     &  .OR.(KBOUT(IBOUT).EQ.-17.AND.ITITAV.LT.0)
     &  .OR.(KBOUT(IBOUT).EQ. 4.AND.ISHRINK.LT.0)
     &  .OR.(KBOUT(IBOUT).EQ. 6.AND.IFC.LT.0)
     &  .OR.(KBOUT(IBOUT).EQ.14.AND.ICARRE.LT.0)
     &  .OR.(KBOUT(IBOUT).EQ.31.AND.ISENS.LT.0)) THEN
ccc     &  .OR.(KBOUT(IBOUT).EQ.-5.AND.IVIT.LT.0)
          CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0,ITOUR2,15,7)
        ELSEIF(ITB(IBOUT).EQ.9) THEN
          CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0,1,0,0)
        ELSE
          CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0,ITOUR2,7,15)
        ENDIF
        CALL viderbuff2
        IBOUT = 0
        ITYP  = 0
        GOTO 5002
      ELSEIF(ITYP.NE.0.AND.IFREEZE.EQ.0) THEN
        IF (IPFK.EQ.-9999) THEN
          IPFK = ITYP
        ELSE
          CALL CHANGE_CURS(1)
          IF (ITYP.EQ.-13) THEN
Cfj            DO J=1,3
Cfj              DO I=1,3
Cfj                ROTA0(I,J) = ROTA(I,J)
Cfj                ROTA(I,J)  = ROTAINV(I,J)
Cfj              ENDDO
Cfj            ENDDO
Cfj            CALL ROTATE(0)
Cfj            DO J=1,3
Cfj              DO I=1,3
Cfj                ROTA(I,J) = ROTA0(I,J)
Cfj              ENDDO
Cfj            ENDDO
            CALL MULT(ROTAINV,ROTA)
            DO J=1,3
              DO I=1,3
                ROTA0(I,J) = ROTA(I,J)
                ROTA(I,J)  = ROTAINV(I,J)
              ENDDO
            ENDDO
Cfj
            CALL ROTATE(0)
            DO J=1,3
              DO I=1,3
                ROTA(I,J) = ROTA0(I,J)
              ENDDO
            ENDDO
            ITYP = 0
            IBOUT = IBROT
            GEOM = .TRUE.
            GOTO 5000
          ELSE
            ITYP = 0
            IREFRE = 1
            IOPT = -4
            GEOM = .TRUE.
            GOTO 5001
          ENDIF
        ENDIF
      ENDIF
C
C Zoom interactif (0) annule par Q
C
      IF (IPFK.EQ.0) THEN
        CALL GSQCUR(WIN,XCUCU,YCUCU)
        IF (XCUCU.LT.XHELP) THEN
          CALL QBOUT(XCUCU,YCUCU,IBBB)
Cfj          IF (IBBB.EQ.IBFREEZ) THEN
Cfj            CALL GSBND(XDMIN,XDMA2,YDMIN,YDMAX)
Cfj            CALL GSPAT(15)
Cfj            CALL GSMIX(1)
Cfj            CALL MY_GSAREA2B(XHELP,XDMA2,YDMIN,YDMAX)
Cfj            CALL GSMIX(0)
Cfj            IF (IFREEZE.EQ.0) THEN
Cfj              IFREEZE = 1
Cfj              IBOUBOU = 0
Cfj              CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,1,ITYP,IOPT,IBOUBOU)
Cfj              GOTO 5003
Cfj            ELSE
Cfj              IFREEZE = 0
Cfj              IBOUT = IBFREEZ
Cfj              CALL GSPAT(8)
Cfj              CALL MY_GSAREA2(XBOUT(1,IBOUT),YBOUT(1,IBOUT))
Cfj              IREFRE = 1
Cfj              GEOM = .FALSE.
Cfj              GOTO 5001
Cfj            ENDIF
Cfj          ELSEIF(IBBB.GT.0) THEN
          IF (IBBB.GT.0) THEN
Cfj
            IF (ITB(IBBB).NE.6.AND.ITB(IBBB).GT.0) THEN
              IF (IACTIF(IBBB).EQ.0) GOTO 5002
              IF (ITB(IBBB).GT.0) THEN
                CALL GSBND(XDMIN,XHELP,YDMIN,YDMAX)
                CALL MYBORD(XBOUT(1,IBBB),YBOUT(1,IBBB),BID,0,ITOUR2
     &                     ,15,7)
                CALL viderbuff2
              ENDIF
              IBOUT = IBBB
              IF (IBOUT.EQ.IBDOC) THEN
                CALL QUICESTCELUILA('gv',2,GVESTLA,0)
                IF (GVESTLA) THEN
                  CALL EXEC('gv '//CHEMDOC(1:LENCHEM)//'&')
                ELSE
                  CALL QUICESTCELUILA('ghostview',9,GVESTLA,0)
                  IF (GVESTLA)
     &              CALL EXEC('ghostview '//CHEMDOC(1:LENCHEM)//'&')
                ENDIF
                GOTO 5002
              ELSEIF(IBOUT.EQ.IBLANG) THEN
                GOTO 3505
              ELSE
                IPFK = KBOUT(IBOUT)
                IF (IMENU(IBOUT).NE.0) THEN
                  CALL GSBND(XDMIN,XDMAX,YDMI2,YDMAX)
                  CALL MENUS(IPFK,IBOUT,IDEROUL,IRC)
                  IF (IDEROUL.EQ.0) THEN
                    ITYP = 0
                    GOTO 5003
                  ENDIF
                  IF (IPFK.EQ.-18.AND.ICOURB.GT.0) THEN
                    IF (IDEROUL.GE.2) THEN
                      IF (IDEROUL.EQ.2) THEN
                        INUMER = -3
                      ELSEIF(IDEROUL.EQ.3) THEN
                        INUMER = 0
                      ELSEIF(IDEROUL.EQ.4) THEN
                        INUMER = -1
                      ELSEIF(IDEROUL.EQ.5) THEN
                        INUMER = 1
                      ELSE
                        INUMER = -2
                      ENDIF
                      GOTO 4903
                    ENDIF
                    IF (INUMINTER.EQ.0) THEN
                      INUMINTER = 1
                      CALL CHANGE_CURS(11)
                      CALL GSBND(XDMIN,XHELP,YDMIN,YDMAX)
                      CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0
     &                           ,ITOUR2,15,7)
                      CALL viderbuff2
                      CALL CLNINF(2)
                      CALL ASFCOL(5)
                      CALL GSMIX(1)
                      CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
                      IX0 = IVRAIECOORD(XHELP)
                      IX1 = IVRAIECOORD(XDMAX)
                      PIPI = 2.*(XDMAX-XHELP)/REAL(IABS(IX0-IX1))
                      CALL GSLSS(IFONT1)
                      ICENT = 7
                    ELSE
                      CALL ASFCOL(5)
                      CALL GSMIX(1)
                      CALL GSCHAR3(XVIEUX,YVIEUX,L,CNUM,ICENT,-1)
                      CALL GSMIX(0)
                      CALL GSBND(XDMIN,XHELP,YDMIN,YDMAX)
                      CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0
     &                           ,ITOUR2,7,15)
                      CALL viderbuff2
                      CALL CHANGE_CURS(2)
                      INUMINTER = 0
                    ENDIF
                    GOTO 5003
                  ELSEIF(IPFK.EQ.-6) THEN
                    IF (IDEROUL.EQ.1) THEN
                      GOTO 4100
                    ELSE
                      IDBID = MOD(IDEROUL-2,7) + 1
                      IF (IDEROUL.EQ.16) THEN
                        FFF = -1.
                      ELSEIF(IDBID.EQ.1) THEN
                        FFF = 1.1
                      ELSEIF(IDBID.EQ.2) THEN
                        FFF = 1.5
                      ELSEIF(IDBID.EQ.3) THEN
                        FFF = 2.
                      ELSEIF(IDBID.EQ.4) THEN
                        FFF = 3.
                      ELSEIF(IDBID.EQ.5) THEN
                        FFF = 4.
                      ELSEIF(IDBID.EQ.6) THEN
                        FFF = 5.
                      ELSE
                        FFF = 10.
                      ENDIF
                      IF (IDEROUL.LT.9) THEN
                        FACVIT  = FACVIT*FFF
                        FACVIT0 = FACVIT0*FFF
                      ELSE
                        FACVIT  = FACVIT/FFF
                        FACVIT0 = FACVIT0/FFF
                      ENDIF
                      GEOM = .TRUE.
                      GOTO 5001
                    ENDIF
                  ELSEIF(IPFK.EQ.-5) THEN
                    GOTO 4000
                  ELSEIF(IPFK.EQ.-2) THEN
                    GOTO 5000
                  ELSEIF(IPFK.EQ.3) THEN
                    GOTO 301
                  ELSEIF(IPFK.EQ.11) THEN
                    GOTO 1101
                  ELSEIF(IPFK.EQ.15.OR.IPFK.EQ.33.OR.IPFK.EQ.-1) THEN
                    GOTO 5001
                  ELSEIF(IPFK.EQ.17.AND.IACTIF(IBOUT).NE.0) THEN
                    ISOINI = IRC
                    GOTO 1701
                  ELSEIF(IPFK.EQ.22) THEN
                    GOTO 2200
                  ELSEIF(IPFK.EQ.25) THEN
                    GOTO 2502
                  ELSEIF(IPFK.EQ.27) THEN
                    ISOBID = IDEROUL
                    GOTO 2702
                  ELSEIF(IPFK.EQ.28) THEN
                    GOTO 2801
                  ENDIF
                ENDIF
                GOTO 7000
              ENDIF
            ENDIF
          ENDIF
        ELSEIF(IPREM.EQ.0.AND.XCUCU.GT.XDMAX) THEN
          GOTO 4300
        ELSEIF(IPREM.EQ.0.AND.IFREEZE.EQ.0) THEN
          IPREM = 1
          XCUR1 = XCUCU
          YCUR1 = YCUCU
          CALL ECHELP(NBOUT+1,1)
          CALL GSMIX(1)
          SIZMAR = .1*(XDMAX-XHELP)
          CALL GSMB(SIZMAR,SIZMAR)
          CALL GSMS(1)
          CALL GSCOL(7)
          CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
          CALL GSMARK(XCUR1,YCUR1)
          CALL GSMARK(XDMAX-(XCUR1-XHELP),YCUR1)
          CALL GSMARK(XDMAX-(XCUR1-XHELP),YDMAX-(YCUR1-YDMIN))
          CALL GSMARK(XCUR1,YDMAX-(YCUR1-YDMIN))
          IZOOMBID = 0
          GOTO 5003
        ELSEIF(IPREM.EQ.1) THEN
          IPFK = 26
          IZOOMBID = 1
        ELSEIF(IPREM.EQ.2) THEN
          XCUR = XCUR0
          YCUR = YCUR0
          FACVIT = FACVIT*XLARG/XLARG0
          XLARG = XLARG0
          PASMIN2 = (.0025*XLARG)**2
          ITYP   = 0
          IREFRE = 1
          IOPT = -4
          GEOM = .TRUE.
          CALL CHANGE_CURS(1)
          GOTO 5001
        ENDIF
      ENDIF
      IDEROUL = 0
 7000 IPOSTCOL = 0
      IF (IFREEZE.NE.0) THEN
        IF (IPFK.EQ.-9999) GOTO 5003
        IF (IPFK.EQ.0.OR.IPFK.EQ.-13.OR.IPFK.EQ.-14) THEN
          CALL GSQCUR(WIN,XCUCU,YCUCU)
          IF (XCUCU.GE.XHELP) GOTO 5003
        ELSE
          IBOUBOU = -6666
          DO I=1,NBOUT
            IF (KBOUT(I).EQ.IPFK.AND.IACTIF(I).NE.0) IBOUBOU=I
          ENDDO
          IF (IBOUBOU.EQ.-6666) GOTO 5003
        ENDIF
      ELSE
        IF (ITYP.EQ.0.AND.(IPFK.EQ.-13.OR.IPFK.EQ.-14)) THEN
          CALL GSQCUR(WIN,XCUCU,YCUCU)
          IF (XCUCU.GE.XDMAX) THEN
C
C Pour recalculer la position de la table...
C
            CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
            CALL INFO(XDMAX,XDMA2,YDMIN,YDMAX,NSURF)
            IF (ISO.NE.0.OR.ICTFAC.GE.0) THEN
              FACT = (YCUCU-YCOUL(1))/(YCOUL(NBCOL+1)-YCOUL(1))
              IF (ISO.EQ.2) THEN
                ICPOINT = 19+NINT(FACT*REAL(NBCOL-1))
              ELSE
                ICPOINT = 18+NINT(.5+FACT*REAL(NBCOL))
              ENDIF
              IF (ICPOINT.GE.19.AND.ICPOINT.LE.NBCOL+18) THEN
                YBIDONCOM = YCUCU
                IBOUT = 3333
                CALL GSBND(XDMIN,XDMA2,YDMI2,YDMAX)
                CALL MENUS(IPFK,IBOUT,IDEROUL,ICPOINT)
                IF (IDEROUL.GE.1.AND.IDEROUL.LE.16) THEN
                  CALL TABCOL(-(IDEROUL*1000+ICPOINT),IWAVE)
                  IF (ITERMC.EQ.4) THEN
                    GOTO 5001
                  ELSE
                    GOTO 5003
                  ENDIF
                ELSE
                  GOTO 5003
                ENDIF
              ELSE
                GOTO 5003
              ENDIF
            ELSE
                GOTO 5003
            ENDIF
          ENDIF
        ENDIF
      ENDIF
      NEGNEG = -21
      IF (IDEBUG.NE.0) PRINT*,'Avant GOTO, IPFK=',IPFK,' IBOUT=',IBOUT
      IF (IPFK.NE.NEGNEG.AND.IPFK.NE.2.AND.IPFK.NE.24.AND.IPFK.NE.28
     & .AND.IPFK.NE.9999.AND.IPFK.NE.-9.AND.IPFK.NE.26) NBPG = 0
      IF (IPFK.GE.NEGNEG.AND.IPFK.LE.39.AND.IPFK.NE.0) THEN
        IF (IBOUT.EQ.0) THEN
          DO I=1,NBOUT
            IF (KBOUT(I).EQ.IPFK.AND.KBOUT(I).GT.-10000
     &           .AND.LBOUT(I).GT.0) THEN
              IBOUT = -I
              IF (IPFK.NE.-9)
     &             CALL MYBORD(XBOUT(1,I),YBOUT(1,I),BID,0,ITOUR2,15,7)
              GOTO 7001
            ENDIF
          ENDDO
        ENDIF
 7001   GOTO (4906,4905,4904,4903,4902,4901,4900,501,4800,4700
     &       ,4600,4500,4400,4300,4200,4100,4000,3900,3800,3700,3600
     &       ,5003
     &       ,100,200,300,400,500,600,700,800,900,1000,1100,1200,1300
     &       ,1400,1500,1600,1700,1800,1900,2000,2100,2200,2300,2400
     &       ,2500,2600,2700,2800,2900,3000,3100,3200,3300,3400,3500
     &       ,3501,3502,3503,3504) IPFK+1-NEGNEG
C
C Fleches du clavier
C
      ELSEIF(IPFK.GE.549.AND.IPFK.LE.552.AND.IPROGRE.LT.0) THEN
        TRANS0 = (XDMAX-XHELP)*.0025
        IF (IPFK.EQ.549) THEN
          DYTRANS = DYTRANS+TRANS0
        ELSEIF(IPFK.EQ.550) THEN
          DXTRANS = DXTRANS-TRANS0
        ELSEIF(IPFK.EQ.551) THEN
          DXTRANS = DXTRANS+TRANS0
        ELSE
          DYTRANS = DYTRANS-TRANS0
        ENDIF
        XCUR = XMIL-DXTRANS
        YCUR = YMIL-DYTRANS
        GOTO 503
      ELSE
        GOTO 5003
      ENDIF
C//////////////////////////////////////////////////////////////
C
C Symetries (1)
C
 100  NF0 = NFACE
      NRECON0 = NRECON
      IF (IDEROUL.EQ.0) THEN
        NRECON = NRECON+1
        IF (NRECON.GT.NRECONMAX) NRECON=1
      ELSE
        NRECON = MIN(NRECONMAX,IDEROUL)
      ENDIF
      NFACE = NF*NRECON
C
      IF (NFACE.NE.NF0) THEN
        CALL SYMETRISE(NRECON0,0)
        IF (NSURF.GT.0) CALL CALSUR(1)
        GEOM = .TRUE.
        GOTO 5000
      ELSE
        GOTO 5003
      ENDIF
C
C Sauvegarde (Postscript et Postscript couleur) (2, O)
C
 200  CALL ACTPS(NBON,IWAVE,IGOTO)
      IF (IGOTO.EQ.5001) THEN
        GOTO 5001
      ELSE
        GOTO 5003
      ENDIF
C
C Fin ou annulation du zoom interactif (Q)
C
 2600 IF (IPREM.EQ.0) THEN
        GOTO 999
      ELSE
        IF (IZOOMBID.EQ.0) THEN
          CALL GSMIX(1)
          CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
          CALL GSMOVE(XCUR0-XLARG0,YCUR0-YLARG0)
          CALL GSLINE(XCUR0+XLARG0,YCUR0-YLARG0)
          CALL GSLINE(XCUR0+XLARG0,YCUR0+YLARG0)
          CALL GSLINE(XCUR0-XLARG0,YCUR0+YLARG0)
          CALL GSLINE(XCUR0-XLARG0,YCUR0-YLARG0)
          CALL GSCOL(7)
          CALL GSMARK(XCUR1,YCUR1)
          CALL GSMARK(XDMAX-(XCUR1-XHELP),YCUR1)
          CALL GSMARK(XDMAX-(XCUR1-XHELP),YDMAX-(YCUR1-YDMIN))
          CALL GSMARK(XCUR1,YDMAX-(YCUR1-YDMIN))
        ENDIF
        CALL GSMIX(0)
        CALL CLNINF(1)
        IPREM = 0
        GOTO 5003
      ENDIF
C
C Shrink (4)
C
 400  ISHRINK = -ISHRINK
      GEOM = .TRUE.
      GOTO 5000
C
C Translation de l'image (5)...
C
 500  CALL GSQCUR(WIN,XCUR,YCUR)
      CALL METS_CURSEUR(XMIL,YMIL)
 503  IF (XCUR.NE.XMIL.OR.YCUR.NE.YMIL) THEN
        DXTRANS = XMIL-XCUR
        DYTRANS = YMIL-YCUR
        XCUR = XMIL-DXTRANS
        YCUR = YMIL-DYTRANS
        CALL VRAIECOORD(XHELP,YDMAX,IX0,IY0)
        CALL VRAIECOORD(XDMAX,YDMIN,IX1,IY1)
        PIPI = .5*REAL(IEPBOR)*(XDMAX-XHELP)/REAL(IABS(IX0-IX1))
        ILARG = IX1-IX0-IEPBOR
        IHAUT = IY1-IY0-IEPBOR
        IX0 = IX0+IEPBOR/2
        IY0 = IY0+IEPBOR/2
        IX1 = IX1-IEPBOR/2
        IY1 = IY1-IEPBOR/2
        IX2OLD = IX0
        IY2OLD = IY0
        ILARGOLD = ILARG
        IHAUTOLD = IHAUT
        CALL GSBND(XHELP+PIPI,XDMAX-PIPI,YDMIN+PIPI,YDMAX-PIPI)
        GOTO 502
      ELSE
        GOTO 5003
      ENDIF
C
C ...ou par curseur (")
C
 501  CALL GSQCUR(WIN,XCUR111,YCUR111)
      IF (ITYP.EQ.0) THEN
        ITYP = -14
        DXTRANS = 0.
        DYTRANS = 0.
        DXTRAN0 = 0.
        DYTRAN0 = 0.
        CALL CHANGE_CURS(4)
CImage
        CALL VRAIECOORD(XHELP,YDMAX,IX0,IY0)
        CALL VRAIECOORD(XDMAX,YDMIN,IX1,IY1)
        PIPI = .5*REAL(IEPBOR)*(XDMAX-XHELP)/REAL(IABS(IX0-IX1))
        ILARG = IX1-IX0-IEPBOR
        IHAUT = IY1-IY0-IEPBOR
        IX0 = IX0+IEPBOR/2
        IY0 = IY0+IEPBOR/2
        IX1 = IX1-IEPBOR/2
        IY1 = IY1-IEPBOR/2
        IX2OLD = IX0
        IY2OLD = IY0
        ILARGOLD = ILARG
        IHAUTOLD = IHAUT
        CALL GSBND(XHELP+PIPI,XDMAX-PIPI,YDMIN+PIPI,YDMAX-PIPI)
      ELSE
        DXTRAN0 = DXTRANS
        DYTRAN0 = DYTRANS
        DDDX = XCUR111-XCUR000
        DDDY = YCUR111-YCUR000
        IF (I2D.NE.0) THEN
          CALL AFFCOORD(XCONT,YCONT,XMED0+XCUR111*R2R3
     &                             ,YMED0+YCUR111*R2R3,BID,2,0)
          CALL GSBND(XHELP+PIPI,XDMAX-PIPI,YDMIN+PIPI,YDMAX-PIPI)
        ENDIF
        IF ((DDDX**2+DDDY**2).GT.PASMIN2) THEN
          XCUR = XCUR-DDDX
          YCUR = YCUR-DDDY
          DXTRANS = DXTRANS+DDDX
          DYTRANS = DYTRANS+DDDY
        ELSE
          GOTO 5003
        ENDIF
      ENDIF
      XCUR000 = XCUR111
      YCUR000 = YCUR111
ctrans      ddxp = -usr2*dx - .5*r2r3*dy
ctrans      ddyp =  usr2*dx - .5*r2r3*dy
ctrans      ddzp = r2r3*dy
ctrans      xpup(1) = xpup(1) + ddxp
ctrans      xpup(2) = xpup(2) + ddyp
ctrans      xpup(3) = xpup(3) + ddzp
ctrans      call calpup(xpup,dist,obsobs,uuuu,vvvv)
C
cc      CALL GSPAT(ICTFON)
cc      CALL MY_GSAREA(0,XCADRE,YCADRE,4)
 502  IF (IPROGRE.GT.0) THEN
        CALL VRAIECOORD(XHELP+DXTRANS,YDMAX+DYTRANS,IX2,IY2)
        IX2 = IX2+IEPBOR/2
        IY2 = IY2+IEPBOR/2
        IF (IX2.GT.IX2OLD) THEN
          CALL x11clearrect(IX2OLD,IY0,IX2-IX2OLD,IHAUT)
        ELSEIF(MIN(IX1,IX2+ILARG).LT.IX2OLD+ILARGOLD) THEN
          III = MIN(IX1,IX2+ILARG)
          JJJ = IX2OLD+ILARGOLD-III
          CALL x11clearrect(III,IY0,JJJ,IHAUT)
        ENDIF
        IF (IY2.GT.IY2OLD) THEN
          CALL x11clearrect(IX0,IY2OLD,ILARG,IY2-IY2OLD)
        ELSEIF(MIN(IY1,IY2+IHAUT).LT.IY2OLD+IHAUTOLD) THEN
          III = MIN(IY1,IY2+IHAUT)
          JJJ = IY2OLD+IHAUTOLD-III
          CALL x11clearrect(IX0,III,ILARG,JJJ)
        ENDIF
        CALL x11metrect(IX2,IY2,ILARG,IHAUT)
        IX2OLD = MAX(IX2,IX0)
        IY2OLD = MAX(IY2,IY0)
        ILARGOLD = MIN(IX1,IX2OLD+ILARG) - IX2OLD
        IHAUTOLD = MIN(IY1,IY2OLD+IHAUT) - IY2OLD
      ELSE
        CALL VRAIECOORD(XHELP-DXTRANS,YDMAX-DYTRANS,IX2,IY2)
cc        print*,'passe par ici',IX2,IY2,XHELP,YDMAX,DXTRANS,DYTRANS
        IX2 = IX2+IEPBOR/2+ISHIFTX
        IY2 = IY2+IEPBOR/2+ISHIFTY
        CALL x11metrect2(IX2,IY2,ILARG,IHAUT,IX0,IY0)
      ENDIF
      GOTO 5003
C
C Parties cachees (6)
C
Cfj 600  IF (IPREFC.EQ.2) THEN
Cfj        IF (IFC.EQ.1) THEN
Cfj          IFC = 2
Cfj        ELSEIF(IFC.EQ.2) THEN
Cfj          IFC = -1
Cfj        ELSE
Cfj          IFC = 1
Cfj        ENDIF
Cfj      ELSE
Cfj        IFC = -IFC
Cfj      ENDIF
 600  IF (IPREFC.EQ.2) THEN
        IF (IFC.EQ.1) THEN
          IFC = 2
        ELSEIF(IFC.EQ.2) THEN
          IFC = -1
        ELSEIF(IFC.EQ.-1) THEN
          IF (I2D.EQ.0) THEN
            IFC = -2
          ELSE
            IFC = 1
          ENDIF
        ELSE
          IFC = 1
        ENDIF
      ELSE
        IF (IFC.EQ.1) THEN
          IFC = -1
        ELSEIF(IFC.EQ.-1) THEN
          IF (I2D.EQ.0) THEN
            IFC = -2
          ELSE
            IFC = 1
          ENDIF
        ELSE
          IFC = 1
        ENDIF
      ENDIF
      GEOM = .TRUE.
      GOTO 5000
C
C Rotation autour de Ox (7)
C
 700  CALL ROTX(IANG(IANGLE))
      IOPT = -2
      IBOUT = -IBROT
      GEOM = .TRUE.
      GOTO 5000
C
C Rotation autour de Oz (8)
C
 800  CALL ROTZ(IANG(IANGLE))
      IOPT = -2
      IBOUT = -IBROT
      GEOM = .TRUE.
      GOTO 5000
C
C Rotation autour de Oy (9)
C
 900  CALL ROTY(IANG(IANGLE))
      IOPT = -2
      IBOUT = -IBROT
      GEOM = .TRUE.
      GOTO 5000
C
C Zoom arriere  (A)
C
 1000 CALL GSQCUR(WIN,XCUR,YCUR)
      IF (IIII.EQ.0) THEN
        XLARG = XLARG*FACZOOM
        FACVIT = FACVIT/FACZOOM
      ELSE
        XLARG = XLARG*FACZOOM*FACZOOM
        FACVIT = FACVIT/(FACZOOM*FACZOOM)
      ENDIF
      IOPT = -4
      GEOM = .TRUE.
      IREFRE = 1
      GOTO 5001
C
C Changement de l'angle courant  (B)
C
 1100 IANGLE = IANGLE+1
      IOPT = 0
      IF (IANGLE.GT.14) IANGLE = 1
 1101 CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUT)
      GEOM = .TRUE.
      GOTO 5002
C
C Zoom avant (C)
C
 1200 CALL GSQCUR(WIN,XCUR,YCUR)
      IF (IIII.EQ.0) THEN
        XLARG = XLARG/FACZOOM
        FACVIT = FACVIT*FACZOOM
      ELSE
        XLARG = XLARG/(FACZOOM*FACZOOM)
        FACVIT = FACVIT*FACZOOM*FACZOOM
      ENDIF
      IOPT = -4
      GEOM = .TRUE.
      IREFRE = 1
      GOTO 5001
C
C Fichier d'isovaleurs de vitesses ou de forces (D)
C
 1300 IRC = 0
      LBID = 0
      CALL LIVAL(CBIDON,LBID,IVAL,ICLAS,ICONTR,NDSEL,IRC)
      IF (IVAL.EQ.9999) THEN
        IBOUT = ABS(IBOUT)
        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
        CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
        CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0,ITOUR2,7,15)
        CALL viderbuff2
        GOTO 5002
      ENDIF
      CALL ACTLIVAL(IVAL,ICONTR,CBIDON,LBID,IREFRE,IGOTO)
cc      IF (IFISO.NE.IFISO0) THEN
cc        CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBISO)
cc        CALL MYBORD(XBOUT(1,IBISO),YBOUT(1,IBISO),BID,0,ITOUR2
cc     &             ,7,15)
cc      ENDIF
      IF (IGOTO.EQ.1301) THEN
        GOTO 1300
      ELSE
        IF (IGOTO.EQ.5001) THEN
          GOTO 5001
        ELSE
          GOTO 5000
        ENDIF
      ENDIF
C
C Dessin carre ou rectangulaire  (E)
C
 1400 ICARRE = -ICARRE
      IF (ICARRE.EQ.1) THEN
        XLARG = XLARG*HYA4/HXA4
        IPROX  = 95
      ELSE
        XLARG = XLARG*HXA4/HYA4
        IPROX  = 80
      ENDIF
      IPROY  = 77
      PASMIN2 = (.0025*XLARG)**2
cc      IPIPIX = -NINT(REAL(IECX*IPROX)*.01)
cc      IPIPIY = -NINT(REAL(IECY*IPROY)*.01)
cc      CALL TAILLE_FEN(IPIPIX,IPIPIY,1)
      CALL TAILLE_FEN(IPROX,IPROY,1)
      CALL GSCLR
      GOTO 5001
C
C Frontieres de sous-domaines et frontieres referencees (F)
C
 1500 IF (ICOURB.GT.0) THEN
        IF (IFRONT.EQ.0) THEN
          IF (IFBLO.NE.0) THEN
            IFRONT = 1
          ELSE
            IFRONT = 2
          ENDIF
        ELSEIF(IFRONT.EQ.1) THEN
          IFRONT = 2
        ELSEIF(IFRONT.EQ.2) THEN
          IF (IFBLO.NE.0) THEN
            IFRONT = 3
          ELSE
            IF (NUMSD.GT.1) THEN
              IFRONT = -1
            ELSE
              IFRONT = 3
            ENDIF
          ENDIF
        ELSEIF(IFRONT.EQ.3) THEN
          IF (NUMSD.GT.1) THEN
            IFRONT = -1
          ELSE
            IFRONT = 0
          ENDIF
        ELSE
          IFRONT = 0
        ENDIF
        GOTO 5001
      ELSE
        IF (FACEXAX.NE.EXAX0
     &  .OR.FACEXAY.NE.EXAY0
     &  .OR.FACEXAZ.NE.EXAZ0) THEN
          EXAX00  = FACEXAX
          EXAY00  = FACEXAY
          EXAZ00  = FACEXAZ
          FACEXAX = EXAX0
          FACEXAY = EXAY0
          FACEXAZ = EXAZ0
          DFACX = FACEXAX-EXAX00
          DFACY = FACEXAY-EXAY00
          DFACZ = FACEXAZ-EXAZ00
        ELSE
          FACEXAX0 = FACEXAX
          FACEXAY0 = FACEXAY
          FACEXAZ0 = FACEXAZ
          FACEXAX = EXAX00
          FACEXAY = EXAY00
          FACEXAZ = EXAZ00
          DFACX = FACEXAX-FACEXAX0
          DFACY = FACEXAY-FACEXAY0
          DFACZ = FACEXAZ-FACEXAZ0
        ENDIF
        DEBUT = .TRUE.
        IREFRE = 1
        CALL EXAGERE(DFACX,DFACY,DFACZ,0)
        IF (ISOBID.NE.0) CALL MYISO
        GOTO 5000
      ENDIF
C
C Legendes (G)
C
 1600 CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
      IF (ILEG.EQ.0) THEN
        CALL FSTERM(1)
        CALL ECR16COUL(ICTLEG,ILANG)
        IF (ILANG.EQ.0) THEN
          CALL LIENTIER('Couleur de la légende ( < 0 = cancel) ?'
     &                 ,0,ICTLEG)
          IF (ICTLEG.LT.0.OR.ICTLEG.GT.15) GOTO 1601
          CALL LIENTIER
     &       ('Sens d''écriture (0:horizontal ; 1:vertical) ?',0,ISLEG)
          IF (ISLEG.NE.0) ISLEG = 1
          IF (ICTLEG.LT.0.OR.ICTLEG.GT.15) ICTLEG = 7
          CALL LIENTIER('Taille de la légende '//
     &       '(0:normale ; 1:grande ; 2:petite ; 3:monstre) ?',0,IIIII)
        ELSE
          CALL LIENTIER('Legend''s color ( < 0 = cancel) ?',0,ICTLEG)
          IF (ICTLEG.LT.0.OR.ICTLEG.GT.15) GOTO 1601
          CALL LIENTIER
     &       ('Writing direction (0:horizontal ; 1:vertical) ?',0,ISLEG)
          IF (ISLEG.NE.0) ISLEG = 1
          IF (ICTLEG.LT.0.OR.ICTLEG.GT.15) ICTLEG = 7
          CALL LIENTIER('Legend''s size '//
     &       '(0:normal ; 1:large ; 2:small ; 3:huge) ?',0,IIIII)
        ENDIF
        IF (IIIII.EQ.1) THEN
          FACLEG = 1./.65
        ELSEIF(IIIII.EQ.2) THEN
          FACLEG = .45/.65
        ELSEIF(IIIII.EQ.3) THEN
          FACLEG = (1./.65)**2
        ELSE
          FACLEG = 1.
        ENDIF
        IF (LONLEG.GT.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,'Légende précédente :'
          ELSE
            PRINT*,'Previous legend:'
          ENDIF
          PRINT*,LEG(1:LONLEG)
        ENDIF
        IF (ILANG.EQ.0) THEN
          CALL LILIGNE('Entrez la légende (maximum 132 caractères)'
     &                ,0,LEG,LONLEG)
        ELSE
          CALL LILIGNE('Type the legend (maximum 132 characters)'
     &                ,0,LEG,LONLEG)
        ENDIF
        ILEGMAN = 1
        ILEGAUTO = 0
 1601   CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
        CALL GSPATF(ICTFON)
        CALL GSLW(0)
        CALL GSPAT(16)
        ILEG = 1
        CALL LEGENDE(XHELP,XDMAX,YDMIN,YDMAX,BID,BID,BID,BID,1)
        CALL GSBND(XDMIN,XDMAX,YDMIN,YDMAX)
        GOTO 5002
      ELSEIF(ILEG.LT.0) THEN
        IF (LONLEG.GT.0) THEN
          ILEG = 1
        ELSE
          ILEG = 0
        ENDIF
      ELSEIF(IFREEZE.EQ.0) THEN
        ILEG = ILEG+1
        IF (ILEG.EQ.6) ILEG = 0
        CALL VRAIECOORD(XHELP,YDMAX,IX0,IY0)
        CALL VRAIECOORD(XDMAX,YDMIN,IX1,IY1)
        ILARG = IX1-IX0
        IHAUT = IY1-IY0
        CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
        CALL x11metrect2(IX0+ISHIFTX,IY0+ISHIFTY,ILARG,IHAUT,IX0,IY0)
Cfj
          IF (IAXES.NE.0) CALL AXES(XHELP,XDMAX,YDMIN,YDMAX)
          IF (ILEG.GT.0)
     &         CALL LEGENDE(XHELP,XDMAX,YDMIN,YDMAX,BID,BID,BID,BID,1)
          CALL LECADRE
          CALL GSBND(XDMIN,XDMAX,YDMIN,YDMAX)
          GOTO 5002
Cfj        ELSE
Cfj          GEOM = .TRUE.
Cfj          GOTO 5001
Cfj        ENDIF
      ELSE
        ILEG = ILEG+1
        IF (ILEG.EQ.6) ILEG = 0
        CALL GSBND(XDMIN,XDMAX,YDMIN,YDMAX)
        GOTO 5003
      ENDIF
C
C Isovaleurs (H)
C
 1700 ISOINI = ISO
 1701 CALL ACTISO(ISOINI,NBCOUL,IWAVE,IGOTO)
      IF (IGOTO.EQ.5000) THEN
        GOTO 5000
      ELSE
        GOTO 5002
      ENDIF
C
C Changement de couleur des traits (I)
C
 1800 ICT = ICT+1
      IF (ICT.EQ.17) ICT = 1
      ICOLAR = ICT-1
      GEOM = .TRUE.
      GOTO 5001
Cfj      CALL TABCOL(-(ICT*1000+3),IWAVE)
Cfj      CALL ASFCOL(ICT-1)
Cfj      IF (ITERMC.EQ.4) THEN
Cfj        GEOM = .TRUE.
Cfj        GOTO 5001
Cfj      ELSE
Cfj        IOPT = 0
Cfj        CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUT)
Cfj        GOTO 5002
Cfj      ENDIF
C
C Changement des bornes des iso (J)
C
 1900 IQUEST = 0
      IF (ISO.NE.0) THEN
        VMIN2 = VMIN
        VMAX2 = VMAX
        CALL QUEST_BORNES(ILANG,VMIN0,VMAX0,VMIN2,VMAX2,IRQ)
        IF (IRQ.EQ.-2) THEN
          IQUEST = 1900
        ELSE
          IQUEST = 0
        ENDIF
        IF (IRQ.NE.0.AND.IRQ.NE.-2) GOTO 5002
Cfj        CALL FSTERM(1)
Cfj        IF (ILANG.EQ.0) THEN
Cfj          PRINT*,'Anciennes bornes :',VMIN,VMAX
Cfj          PRINT*,'Bornes maximales :',VMIN0,VMAX0
Cfj          CALL LI2REEL1(
Cfj     &         'Nouvelles bornes ? (2 valeurs égales --> bornes max)'
Cfj     &         ,0,VMIN2,VMAX2)
Cfj        ELSE
Cfj          PRINT*,'Previous bounds:',VMIN,VMAX
Cfj          PRINT*,'Maximal bounds:',VMIN0,VMAX0
Cfj          CALL LI2REEL1(
Cfj     &         'New bounds? (2 equal values --> max bounds)'
Cfj     &         ,0,VMIN2,VMAX2)
Cfj        ENDIF
        IF (VMIN2.LT.VMAX2) THEN
          VMIN = VMIN2
          VMAX = VMAX2
        ELSEIF(VMAX2.LT.VMIN2) THEN
          VMIN = VMAX2
          VMAX = VMIN2
        ELSE
          VMIN = VMIN0
          VMAX = VMAX0
        ENDIF
        IVFIXE = 0
Cfj        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
        CALL GSPATF(ICTFON)
        CALL GSLW(0)
C        CALL GSCLP(1)
        GOTO 5001
      ELSE
        GOTO 5002
      ENDIF
C
C Modification de la table des couleurs (K)
C
 2000 IF (ISO.NE.0.OR.(IVIT.LT.0.AND.ICTFLE.GT.15)
     &            .OR.ICTFAC.GT.15) THEN
        ITOUCHTAB = 1
        IF (ITABLE.EQ.NTABMAX) THEN
          ITABLE = 1
        ELSEIF(ITABLE.EQ.52.OR.ITABLE.EQ.54) THEN
          ITABLE = ITABLE-1
        ELSE
          ITABLE = ITABLE+1
        ENDIF
        IF (ITABLE.GT.2) THEN
          IF (ITABLE.GE.33.AND.MOD(NBCOUL,2).EQ.1) NBCOUL = NBCOUL+1
          IIII = -100000-NBCOUL
        ELSE
          CALL CHNBCOL(NBCOUL,NVAL,1,ITABLE)
          IIII = -100000-NVAL
        ENDIF
        IWAVE = 0
        CALL TABCOL(IIII,IWAVE)
      ENDIF
      IF (ITERMC.EQ.4) THEN
        GOTO 5001
      ELSE
        IOPT = 0
        CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUT)
        GOTO 5002
      ENDIF
C
C Changement du nb de couleurs (L)
C
 2100 IF (ISO.NE.0.OR.ICTFAC.GT.15) THEN
        CALL QUEST_NBISO(ILANG,NBCOUL,IEPISO,IRQ)
        IF (IRQ.NE.0) GOTO 5002
        NBCOUL = MAX(2,MIN(NBCOUL,250))
        ITOUCHNB = 1
C
C Ne pas tout effacer. On peut reprendre la partie
C 'valeurs-limites pour chaque couleur'
C
Cfj        CALL FSTERM(1)
Cfj        IVFIXE = 0
Cfj        PRINT*,' '
Cfj        IF (ILANG.EQ.0) THEN
Cfj          PRINT*,'Pour contrôler l''épaisseur des isovaleurs au trait,'
Cfj          PRINT*,
Cfj     &     'mettez le signe "-" devant le nombre d''isovaleurs voulues'
Cfj        ELSE
Cfj          PRINT*,'To control the line thickness,'
Cfj          PRINT*,'type "-" number of wanted lines'
Cfj        ENDIF
Cfj 2101   IF (ILANG.EQ.0) THEN
Cfj          PRINT*,'Nombre de couleurs actuel =',NBCOUL
Cfj          CALL LIENTIER('Nombre d''isovaleurs ?',0,NBCOUL)
Cfj        ELSE
Cfj          PRINT*,'Current number of colors =',NBCOUL
Cfj          CALL LIENTIER('Number of colors ?',0,NBCOUL)
Cfj        ENDIF
Cfj        IF (NBCOUL.EQ.0) THEN
Cfj          IF (ILANG.EQ.0) THEN
Cfj            PRINT*,
Cfj     &'*** Vous pouvez rentrer les valeurs-limites pour chaque couleur'
Cfj            CALL LIENTIER(
Cfj     &'Nombre d''isovaleurs (0 pour l''échelonnage standard) ?'
Cfj     &           ,0,IREP)
Cfj          ELSE
Cfj            PRINT*,
Cfj     &'*** You can give the limit values for each color'
Cfj            CALL LIENTIER(
Cfj     &           'Number of colors (0 for the default scale) ?'
Cfj     &           ,0,IREP)
Cfj          ENDIF
Cfj          IF (IREP.EQ.0) THEN
Cfj            GOTO 2101
Cfj          ELSEIF(IREP.LT.0) THEN
Cfj            NBCOUL = -IREP
Cfj            IF (ILANG.EQ.0) THEN
Cfj              CALL LIENTIER('Epaisseur des iso au trait en pixels ?',0
Cfj     &             ,IEPISO)
Cfj            ELSE
Cfj              CALL LIENTIER(
Cfj     &        'Lines thickness for contour plot (pixels) ?',0,IEPISO)
Cfj            ENDIF
Cfj            IEPISO = MAX(-1,IEPISO)
Cfj          ELSE
Cfj            NBCOUL = IREP
Cfj            IEPISO = MIN(4,MAX(0,NINT(15./REAL(NBCOUL))))
Cfj            IF (NBCOUL.GE.100) IEPISO = -1
Cfj          ENDIF
Cfj          IF (NBCOUL.GT.1) THEN
Cfj            VAL(1) = VMIN
Cfj            VAL(NBCOUL+1) = VMAX
Cfj            IVFIXE = 1
Cfj            IF (ILANG.EQ.0) THEN
Cfj              PRINT*,
Cfj     & 'Bornes de l''intervalle de valeurs possibles :',VMIN,VMAX
Cfj            ELSE
Cfj              PRINT*,'Bounds allowed:',VMIN,VMAX
Cfj            ENDIF
Cfj            DO I=2,NBCOUL
Cfj              WRITE(CNUM2,'(I3)') I-1
Cfj              WRITE(CNUM3,'(I3)') I
Cfj 2102         IF (ILANG.EQ.0) THEN
Cfj                CALL LIREEL1(
Cfj     &               'Valeur de l''interface entre les couleurs '
Cfj     &               //CNUM2//' et '//CNUM3//' ?',0,VAVA)
Cfj              ELSE
Cfj                CALL LIREEL1(
Cfj     &               'Value for the interface between colors '
Cfj     &               //CNUM2//' and '//CNUM3//' ?',0,VAVA)
Cfj              ENDIF
Cfj              IF (VAVA.LT.VAL(I-1)) THEN
Cfj                IF (ILANG.EQ.0) THEN
Cfj                  PRINT*,'*** La valeur doit être >=',VAL(I-1)
Cfj                ELSE
Cfj                  PRINT*,'*** The value must be >=',VAL(I-1)
Cfj                ENDIF
Cfj                GOTO 2102
Cfj              ELSEIF(VAVA.GT.VMAX) THEN
Cfj                IF (ILANG.EQ.0) THEN
Cfj                  PRINT*,'*** La valeur doit être <=',VMAX
Cfj                ELSE
Cfj                  PRINT*,'*** The value must be <=',VMAX
Cfj                ENDIF
Cfj                GOTO 2102
Cfj              ELSE
Cfj                VAL(I) = VAVA
Cfj              ENDIF
Cfj            ENDDO
Cfj          ENDIF
Cfj        ELSEIF(NBCOUL.LT.0) THEN
Cfj          NBCOUL = -NBCOUL
Cfj          IF (ITABLE.GE.33.AND.MOD(NBCOUL,2).EQ.1) NBCOUL = NBCOUL+1
Cfj          IF (ILANG.EQ.0) THEN
Cfj            CALL LIENTIER('Epaisseur des iso au trait en pixels ?'
Cfj     &           ,0,IEPISO)
Cfj          ELSE
Cfj            CALL LIENTIER('Lines thickness for contour plot (pixels) ?'
Cfj     &           ,0,IEPISO)
Cfj          ENDIF
Cfj          IEPISO = MAX(-1,IEPISO)
Cfj        ELSE
          IF (ITABLE.GE.33.AND.MOD(NBCOUL,2).EQ.1) NBCOUL = NBCOUL+1
          IEPISO = MIN(4,MAX(0,NINT(15./REAL(NBCOUL))))
          IF (NBCOUL.GE.100) IEPISO = -1
Cfj        ENDIF
Cfj        NBCOUL = MIN(250,NBCOUL)
        ITT = ITABLE
        ITABLE = ITT-MOD(ITT+1,2)
        IF (ITABLE.EQ.1.OR.ITABLE.EQ.2) THEN
          CALL CHNBCOL(NBCOUL,NVAL,1,ITABLE)
          CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
          CALL GSPATF(ICTFON)
          CALL TABCOL(NVAL,IWAVE)
        ELSE
          CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
          CALL GSPATF(ICTFON)
          CALL TABCOL(NBCOUL,IWAVE)
        ENDIF
        IF (ITT.NE.ITABLE) THEN
          ITABLE = ITT
          IF (ITABLE.NE.2) THEN
            IIII = -100000-NBCOUL
          ELSE
            CALL CHNBCOL(NBCOUL,NVAL,1,ITABLE)
            IIII = -100000-NVAL
          ENDIF
          CALL TABCOL(IIII,IWAVE)
        ENDIF
        GOTO 5001
      ELSE
        GOTO 5002
      ENDIF
C
C Axes (M)
C
 2200 CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
      IF (IFREEZE.NE.0) THEN
        IF (IAXES.EQ.4) THEN
          IAXES = 0
        ELSE
          IAXES = IAXES+1
        ENDIF
        GOTO 5003
      ENDIF
      IF (IAXES.EQ.4) THEN
        IAXES = 0
      ELSE
        IAXES = IAXES+1
      ENDIF
      CALL VRAIECOORD(XHELP,YDMAX,IX0,IY0)
      CALL VRAIECOORD(XDMAX,YDMIN,IX1,IY1)
      ILARG = IX1-IX0
      IHAUT = IY1-IY0
      CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
      CALL x11metrect2(IX0+ISHIFTX,IY0+ISHIFTY,ILARG,IHAUT,IX0,IY0)
      IF (IAXES.NE.0) CALL AXES(XHELP,XDMAX,YDMIN,YDMAX)
      IF (ILEG.GT.0)
     &     CALL LEGENDE(XHELP,XDMAX,YDMIN,YDMAX,BID,BID,BID,BID,1)
      CALL LECADRE
      CALL GSBND(XDMIN,XDMAX,YDMIN,YDMAX)
      GOTO 5002
C
C Exageration (N)
C
 2300 IQUEST = 0
      IF (IEXAG.NE.0) THEN
        IF (ICOURB.GT.0) THEN
Cfj          CALL FSTERM(1)
          ITOUCHEX = 1
          FACEXA0 = FACEXA
          IF (DEPMAX.NE.0.) THEN
            CONSEIL = 0.3*DIMMAXREF/DEPMAX
          ELSE
            CONSEIL = 1.
          ENDIF
          CALL QUEST_EXAG(ILANG,DIMMAXREF,DIMMAX,DEPMAX,FACEXA,CONSEIL
     &                   ,IRQ)
          IF (IRQ.EQ.-2) THEN
            IQUEST = 2300
          ELSE
            IQUEST = 0
          ENDIF
Cfj          IF (ILANG.EQ.0) THEN
Cfj            PRINT*,
Cfj     &         'Dimension maximale de l''objet non-déformé =',DIMMAXREF
Cfj            PRINT*,
Cfj     &         'Dimension maximale de l''objet déformé     =',DIMMAX
Cfj            PRINT*,
Cfj     &         'Déplacement maximal                       =',DEPMAX
Cfj            PRINT*,
Cfj     &         'Facteur d''exagération précédent           =',FACEXA
Cfj            PRINT*,
Cfj     &         'Facteur d''exagération conseillé           =',CONSEIL
Cfj            CALL LIREEL1('Nouveau facteur d''exagération ?',0,FACEXA)
Cfj          ELSE
Cfj            PRINT*,
Cfj     &         'Maximum dimension of the undeformed object  =',DIMMAXREF
Cfj            PRINT*,
Cfj     &         'Maximum dimension of the deformed object    =',DIMMAX
Cfj            PRINT*,
Cfj     &         'Maximal displacement                        =',DEPMAX
Cfj            PRINT*,
Cfj     &         'Previous exageration factor                 =',FACEXA
Cfj            PRINT*,
Cfj     &         'Recommended exageration factor              =',CONSEIL
Cfj            CALL LIREEL1('New exageration factor?',0,FACEXA)
Cfj          ENDIF
          DFACX = FACEXA-FACEXA0
          DFACY = FACEXA-FACEXA0
          DFACZ = FACEXA-FACEXA0
          FACEXAX = FACEXA
          FACEXAY = FACEXA
          FACEXAZ = FACEXA
          IF (I2D.NE.0.AND.FACEXA0.EQ.0..AND.FACEXA.NE.0.
     &   .AND.IPERSP.EQ.1
     &   .AND.NOM_VIT(LONVIT-4:LONVIT).NE.'.depl'
     &   .AND.NOM_VIT(LONVIT-4:LONVIT).NE.'.mode') THEN
            IPERSP = -2
            CALL METLAPERSP
            IF (ICTFAC.LT.16) ICTFAC=99
            II = IABS(IBOUT)
            CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBPERSP)
            CALL MYBORD(XBOUT(1,IBPERSP),YBOUT(1,IBPERSP),BID,0,ITOUR2
     &                 ,7,15)
            CALL MYBORD(XBOUT(1,II),YBOUT(1,II),BID,0,ITOUR2,7,15)
            CALL viderbuff2
          ENDIF
        ELSE
Cfj          CALL FSTERM(1)
          FACEXAX0 = FACEXAX
          FACEXAY0 = FACEXAY
          FACEXAZ0 = FACEXAZ
Cfj          IF (ILANG.EQ.0) THEN
Cfj            PRINT*,'Dimensions de l''objet =',DIMMAXX,DIMMAXY,DIMMAXZ
Cfj            PRINT*,'Déplacements maximaux =',DEPXM,DEPYM,DEPZM
Cfj            PRINT*,'Facteurs d''exagération en x, y, et z précédents ='
Cfj     &           ,FACEXAX,FACEXAY,FACEXAZ
Cfj            CALL LI3REEL1('Facteurs d''exagération en x, y et z ?',0
Cfj     &           ,FACEXAX,FACEXAY,FACEXAZ)
Cfj          ELSE
Cfj            PRINT*,'Object''s dimensions          ='
Cfj     &           ,DIMMAXX,DIMMAXY,DIMMAXZ
Cfj            PRINT*,'Maximum displacements        =',DEPXM,DEPYM,DEPZM
Cfj            PRINT*,'Previous exageration factors ='
Cfj     &           ,FACEXAX,FACEXAY,FACEXAZ
Cfj            CALL LI3REEL1('Exageration factors for x, y and z ?',0
Cfj     &           ,FACEXAX,FACEXAY,FACEXAZ)
Cfj          ENDIF
          CALL QUEST_EXA3(ILANG,FACEXAX,FACEXAY,FACEXAZ,IRQ)
          IF (IRQ.EQ.0) THEN
            DFACX = FACEXAX-FACEXAX0
            DFACY = FACEXAY-FACEXAY0
            DFACZ = FACEXAZ-FACEXAZ0
          ENDIF
        ENDIF
        IF ((FACEXA.EQ.FACEXA0.AND.ICOURB.GT.0).OR.
     &      (FACEXAX.EQ.FACEXAX0.AND.
     &       FACEXAY.EQ.FACEXAY0.AND.
     &       FACEXAZ.EQ.FACEXAZ0.AND.ICOURB.LT.0) ) THEN
c          CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
          GOTO 5001
        ELSE
C Les isosurf se symetrisent mal si on va directement a
C une symetrie donnee, mais marchent bien si on suit la sequence
C 1/4 2/4 3/4 4/4 1/4
C C'est bizarre mais au lieu de reflechir, on fait comme ca:
C et comme il n'y a pas que les iso qui deconnent, on fait pareil pour le cas
C general
C
          IF (NRECON.GT.1) THEN
            NRECON0 = NRECON
            NFACE0 = NFACE
            NRECON = 1
            NFACE = NF
            CALL SYMETRISE(NRECON0,0)
            CALL EXAGERE(DFACX,DFACY,DFACZ,0)
            IF (NSURF.GT.0) CALL CALSUR(1)
            NRECON = NRECON0
            NFACE = NFACE0
            NRECON0 = 1
            CALL SYMETRISE(NRECON0,0)
            IF (NSURF.GT.0.AND.ICTFAC.GT.15.AND.ICTFAC.LE.97)
     &           CALL ELISO(IRC)
          ELSE
            CALL EXAGERE(DFACX,DFACY,DFACZ,0)
            IF (NSURF.GT.0) CALL CALSUR(1)
          ENDIF
cc          IF (ISOBID.NE.0) CALL MYISO
          IF (ISO.NE.0) CALL MYISO
          GOTO 5000
        ENDIF
      ELSE
        GOTO 5002
      ENDIF
C
C PostScript couleur (O)
C
 2400 IPOSTCOL = 1
      IPFK = 2
      GOTO 200
C
C Couleur des faces (P)
C
 2500 CALL FSTERM(1)
      CALL ECR16COUL(ICTFAC,ILANG)
      IF (ILANG.EQ.0) THEN
        PRINT*,
     &       '41 : Table progressive entre 2 couleurs données (en RVB)'
        PRINT*,'43 : Fusion de 2 tables de couleur'
        PRINT*,'45 : Table blanc -> couleur donnée -> noir'
        PRINT*,'99 : Réflectance normale'
        PRINT*,'98 : Réflectance forte'
        PRINT*,'97 : Lissage Gouraud'
        PRINT*,'96 : Lissage Gouraud réflectance forte'
        IF (I2D.EQ.0)
     &       PRINT*,'-1 : Coloriage en fonction des numéros de faces'
        IF (IFLAG3.NE.0)
     &       PRINT*,'-2 : Coloriage en fonction des matériaux'
        IF (NUMSD.GT.1)
     &       PRINT*,'-3 : Coloriage en fonction des sous-domaines'
      ELSE
        PRINT*,
     &       '41 : Progressive table between 2 given colors (RGB)'
        PRINT*,'43 : Fusion of 2 color tables'
        PRINT*,'45 : Table white -> given color -> black'
        PRINT*,'99 : Default reflectance'
        PRINT*,'98 : Strong reflectance'
        PRINT*,'97 : Gouraud smoothing'
        PRINT*,'96 : Gouraud smoothing with strong reflectance'
        IF (I2D.EQ.0)
     &       PRINT*,'-1 : Filling according to the facets numbers'
        IF (IFLAG3.NE.0)
     &       PRINT*,'-2 : Filling according to the materials numbers'
        IF (NUMSD.GT.1)
     &       PRINT*,'-3 : Filling according to the sub-domains numbers'
      ENDIF
      ICTFAC0 = ICTFAC
      PRINT*,' '
      IF (ILANG.EQ.0) THEN
        CALL LIENTIER('Couleur des faces ?',0,III)
      ELSE
        CALL LIENTIER('Facets color ?',0,III)
      ENDIF
C
C rajout provisoire pour table de couleurs perso de coul1-->coul2
C
      IF (III.EQ.41) THEN
        IF (ILANG.EQ.0) THEN
          CALL LI3ENTIER('RVB initiaux (3 entiers 0<256) ?',0
     &         ,IROUGE0,IVERT0,IBLEU0)
          CALL LI3ENTIER('RVB finaux (3 entiers 0<256) ?',0
     &         ,IROUGE1,IVERT1,IBLEU1)
        ELSE
          CALL LI3ENTIER('Initial RGB (3 integers 0<256) ?',0
     &         ,IROUGE0,IVERT0,IBLEU0)
          CALL LI3ENTIER('Final RGB (3 integers 0<256) ?',0
     &         ,IROUGE1,IVERT1,IBLEU1)
        ENDIF
        IROUGE0 = MIN(255,MAX(0,IROUGE0))
        IVERT0  = MIN(255,MAX(0,IVERT0))
        IBLEU0  = MIN(255,MAX(0,IBLEU0))
        IROUGE1 = MIN(255,MAX(0,IROUGE1))
        IVERT1  = MIN(255,MAX(0,IVERT1))
        IBLEU1  = MIN(255,MAX(0,IBLEU1))
        ITABLE = 51
        IIII = -100000-NBCOUL
        CALL TABCOL(IIII,IWAVE)
        GOTO 2503
C
C Deux tables bout a bout
C
      ELSEIF(III.EQ.43) THEN
        IF (ILANG.EQ.0) THEN
          CALL LIENTIER('Première table de couleurs ?',0,ITABLE1)
          CALL LIENTIER('Seconde table de couleurs ?',0,ITABLE2)
          PRINT*,'Il y a',NBCOUL,' couleurs -> prochain choix entre'
     &         ,2,' et',NBCOUL-1
          CALL LIENTIER('Limite entre les 2 tables ?',0,ILIMTAB)
        ELSE
          CALL LIENTIER('First color table ?',0,ITABLE1)
          CALL LIENTIER('Second color table ?',0,ITABLE2)
          PRINT*,'There are',NBCOUL,' colors -> next choice between'
     &         ,2,' and',NBCOUL-1
          CALL LIENTIER('Limit between the 2 tables ?',0,ILIMTAB)
        ENDIF
        ITABLE1 = MIN(NTABMAX,MAX(ITABLE1,1))
        ITABLE2 = MIN(NTABMAX,MAX(ITABLE2,1))
        ILIMTAB = MAX(2,MIN(NBCOUL-1,ILIMTAB))
        XLIMTAB = REAL(ILIMTAB)/REAL(NBCOUL)
        ITABLE = 53
        IIII = -100000-NBCOUL
        CALL TABCOL(IIII,IWAVE)
        GOTO 2503
C
C Table de couleurs perso de blanc-->coul-->noir
C
      ELSEIF(III.EQ.45) THEN
        IF (ILANG.EQ.0) THEN
          CALL LI3ENTIER('RVB couleur centrale (3 entiers 0<256) ?',0
     &         ,IROUGE0,IVERT0,IBLEU0)
        ELSE
          CALL LI3ENTIER('Central color RGB (3 integers 0<256) ?',0
     &         ,IROUGE0,IVERT0,IBLEU0)
        ENDIF
        IROUGE0 = MIN(255,MAX(0,IROUGE0))
        IVERT0  = MIN(255,MAX(0,IVERT0))
        IBLEU0  = MIN(255,MAX(0,IBLEU0))
        ITABLE = 55
        IIII = -100000-NBCOUL
        CALL TABCOL(IIII,IWAVE)
        GOTO 2503
      ENDIF
      ICTFAC = III
      IF ((ICTFAC.LT.-3).OR.
     &    (ICTFAC.EQ.-1.AND.I2D.NE.0).OR.
     &    (ICTFAC.EQ.-2.AND.IFLAG3.EQ.0).OR.
     &    (ICTFAC.EQ.-3.AND.NUMSD.LE.1).OR.
     &    (ICTFAC.GT.15.AND.(ICTFAC.LT.96.OR.ICTFAC.GT.99))) THEN
        ICTFAC = 0
      ENDIF
 2502 IF (ICTFAC.GE.-3.AND.ICTFAC.LE.-1) IFC = 1
      IF (NSURF.GT.0.AND.ICTFAC.GT.15.AND.ICTFAC.LE.97
     &    .AND.IELISO.EQ.0) THEN
        CALL ELISO(IRC)
        IF (IRC.EQ.0) THEN
          IELISO = 1
        ELSE
          ICTFAC = ICTFAC0
        ENDIF
      ENDIF
 2503 CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
      IF (ICTFAC.GT.15) THEN
Cfj        IF (ITABLE.NE.7.AND.ITABLE.NE.51) THEN
Cfj          ITABLE = 7
Cfj          IIII = -100000-NBCOUL
Cfj          CALL TABCOL(IIII,IWAVE)
Cfj        ENDIF
        GOTO 5000
      ELSE
        GOTO 5001
      ENDIF
C
C Couleur du fond (3)
C
 300  CALL FSTERM(1)
Cfj      ICTFON0 = ICTFON
      CALL ECR16COUL(ICTFON,ILANG)
      PRINT*,' '
      IF (ILANG.EQ.0) THEN
        CALL LIENTIER('Couleur du fond ?',0,ICTFON)
      ELSE
        CALL LIENTIER('Background color ?',0,ICTFON)
      ENDIF
      IF (ICTFON.LT.0.OR.ICTFON.GT.15) ICTFON = 0
      CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
CC      GEOM = .TRUE.
 301  IF (ICTFON.EQ.0.OR.ICTFON.EQ.3.OR.ICTFON.EQ.11
     &.OR.ICTFON.EQ.13.OR.ICTFON.EQ.14.OR.ICTFON.EQ.15) THEN
        ICOLAXB = 4
        ICOLAX  = 7
      ELSE
        ICOLAXB = 3
        ICOLAX  = 0
      ENDIF
      GOTO 5001
C
C Iso bidon (R)
C
 2700 IF (IDEROUL.EQ.0) THEN
 2701   ISOBID = ISOBID+1
        IF (ISOBID.GT.16) ISOBID = 1
        IF (ISOBID.EQ.1.AND.I2D.NE.0) GOTO 2701
        IF (ISOBID.GE.4.AND.ISOBID.LE.8.AND.IFVIT.EQ.0) GOTO 2701
        IF (ISOBID.EQ.4.AND.I2D.EQ.2) GOTO 2701
        IF (ISOBID.EQ.5.AND.I2D.EQ.3) GOTO 2701
        IF (ISOBID.EQ.6.AND.I2D.EQ.1) GOTO 2701
        IF (ISOBID.EQ.8.AND.I2D.EQ.0) GOTO 2701
        IF (ISOBID.GE.9.AND.ISOBID.LE.12.AND.NBCORN.EQ.0) GOTO 2701
        IF (ISOBID.GE.13.AND.ICOURB.LT.0) GOTO 2701
      ENDIF
cc      print*,isobid
 2702 CALL MYISO
      IF (ISO.EQ.0
     &.OR.(ISO.EQ.3.AND.ISOBID.LT.14)
     &.OR.(ISO.NE.3.AND.ISOBID.GE.14)) THEN
        IF (ISO.EQ.0) THEN
          ITABLE0 = ITABLE
          IF (ITABLE.NE.1) THEN
            NBCOUL = 20
            ITABLE = 1
            IIII = -100000-NBCOUL
            CALL TABCOL(IIII,IWAVE)
          ENDIF
        ENDIF
        IF (ISOBID.GE.14) THEN
          ISO = 3
        ELSE
          ISO = 1
        ENDIF
        ICADPS = 1
        IF (ICARRE.EQ.1) THEN
          ANGPS = -90.
        ELSE
          ANGPS = 0.
        ENDIF
        CALL DEFPS(IDEFPS,SIG,ANGPS,ICADPS,HELPPS,IDSEUL,1,ILANG)
        IF (I2D.NE.0) THEN
          IFC0 = IFC
          IFC = 1
        ENDIF
      ENDIF
      IF (ISOBID.GE.14) THEN
        ICENTR = 1
      ELSE
        ICENTR = 0
      ENDIF
      ICENTRISO = 0
      CALL INITBOUT
      IREFRE = 1
      IVFIXE = 0
      GOTO 5000
C
C Definition du Postscript : signature, cadre, orientation (S)
C
cc 2800 IDEFPS = IDEFPS+1
 2800 IDEFPS = IDEFPS+2
c      IF (IDEFPS.GE.10) IDEFPS = 0
      IF (IDEFPS.GE.10) IDEFPS = 1
 2801 IOPT = 0
      CALL DEFPS(IDEFPS,SIG,ANGPS,ICADPS,HELPPS,IDSEUL,0,ILANG)
      CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUT)
      GOTO 5002
C
C Renormalisation echelle (T)
C
 2900 DEBUT = .TRUE.
      FACVIT = FACVIT0
      IOPT = -4
      IREFRE = 1
      GEOM = .TRUE.
      GOTO 5010
C
C Cadrage initial (U)
C
 3000 IF (IDEROUL.EQ.0) THEN
        IRENO = IRENO+1
        IF (IRENO.GT.8) IRENO = 1
      ELSE
        IRENO = IDEROUL
      ENDIF
      CALL INV3X3(ROTA,ROTLOC,IERR)
      CALL ROTATE(1)
      IF (IRENO.NE.1) THEN
        CALL CALROT(ROTLOC,IRENO)
        CALL ROTATE(1)
      ENDIF
      DEBUT = .TRUE.
      IOPT  = -5
      IREFRE = 1
      FACVIT = FACVIT0
ctrans      xpup(1) = dist000
ctrans      xpup(2) = dist000
ctrans      xpup(3) = dist000
ctrans      call calpup(xpup,dist,obs,u,v)
      GEOM = .TRUE.
      GOTO 5000
C
C Inversion du point de vue (V)
C
 3100 ISENS = -ISENS
      GEOM = .TRUE.
      GOTO 5000
C
C Rotation dans le plan de projection (perp. a (1,1,1)) (W)
C
CC 3200 IF (IBOUT.LE.0) CALL GSQCUR(WIN,XCUR,YCUR)
 3200 CALL ROTP(IANG(IANGLE))
      IOPT = -2
      GEOM = .TRUE.
      GOTO 5000
C
C Frontiere / mailles (X)
C
 3300 IF (IBORD.EQ.-1) THEN
        IF (IEPBOR2.EQ.1) THEN
          IEPBOR2 = 2
        ELSE
          IEPBOR2 = 1
          IBORD = 1
        ENDIF
      ELSE
        IBORD = IBORD-1
        IF (IBORD.EQ.-1) THEN
          IEPBOR2 = 1
        ELSE
          IEPBOR2 = 2
        ENDIF
      ENDIF
      IF (ISOCOUP.EQ.1) THEN
        IF (IBORD.NE.-1.AND.IMAILL.GT.0) THEN
          ICSUR = 8
        ELSE
          ICSUR = 16
        ENDIF
      ENDIF
      GEOM = .TRUE.
      GOTO 5001
C
C Taille papier (Y)
C
 3400 IF (HYA4.EQ.HYA4B) THEN
        HYA4 = HYA4A
        IPROY  = 68
      ELSE
        HYA4 = HYA4B
        IPROY  = 77
      ENDIF
      IF (ICARRE.EQ.1) THEN
        IPROX  = 95
      ELSE
        IPROX  = 80
      ENDIF
      CALL GSCLR
      CALL TAILLE_FEN(IPROX,IPROY,1)
      GOTO 5001
C
C Changement de fichier (Z)
C
 3500 CALL FSTERM(1)
      IF (I2D.EQ.0) THEN
        IF (ILANG.EQ.0) THEN
          CALL LIENTIER(
     &       'On conserve les paramètres d''affichage (1:oui ; 0:non) ?'
     &       ,0,IPARA)
        ELSE
          CALL LIENTIER(
     &       'Display parameters are preserved (1:yes ; 0:no) ?'
     &       ,0,IPARA)
        ENDIF
        IF (IPARA.NE.0) IPARA = NFACE/NF
      ELSE
        IPARA = 0
      ENDIF
      LONG = 0
      IREFRE = 1
ccc      CALL GSCLR
      GOTO 1
C
C Position angulaire donnee ({)
C
Cfj 3501 CALL FSTERM(1)
Cfj      CALL INV3X3(ROTA,ROTLOC,IERR)
Cfj      CALL ROTATE(1)
Cfj      IF (ILANG.EQ.0) THEN
Cfj        CALL LI3REEL1(
Cfj     &  'Pos. angulaires autour de Ox, Oy, Oz (3 valeurs en degrés) ?'
Cfj     &       ,0,ANGX,ANGY,ANGZ)
Cfj      ELSE
Cfj        CALL LI3REEL1(
Cfj     &  'Angular position about Ox, Oy, Oz (3 values in degrees) ?'
Cfj     &       ,0,ANGX,ANGY,ANGZ)
Cfj      ENDIF
Cfj      CALL ARCROT(ANGX,ANGY,ANGZ)
Cfj      CALL ROTATE(0)
Cfj      IOPT = -2
Cfj      GEOM = .TRUE.
Cfj      GOTO 5000
 3501 IQUEST = 0
      CALL ARC(ANGX,ANGY,ANGZ)
      CALL QUEST_POSANG(ILANG,ANGX,ANGY,ANGZ,IRQ)
      IF (IRQ.EQ.0.OR.IRQ.EQ.-2) THEN
        CALL INV3X3(ROTA,ROTLOC,IERR)
        CALL ROTATE(1)
        CALL ARCROT(ANGX,ANGY,ANGZ)
        CALL ROTATE(0)
        IOPT = -2
        GEOM = .TRUE.
        IF (IRQ.EQ.-2) THEN
          IQUEST = 3501
        ELSE
          IQUEST = 0
        ENDIF
        GOTO 5000
      ELSE
        IBOUT = ABS(IBOUT)
        CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
        CALL MYBORD(XBOUT(1,IBOUT),YBOUT(1,IBOUT),BID,0,ITOUR2,7,15)
        CALL viderbuff2
        GOTO 5002
      ENDIF
C
C Sauvegardes dans fichier(s) bitmap(s) (|)
C
 3502 CALL FSTERM(1)
      CALL FORMATS_BIT(IFORMAT,ILANG)
      IF (IFORMAT.LT.-1) THEN
        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
        GOTO 5002
      ELSE
        CALL BITMAPS(NBON,IFORMAT,GEOM,ITYP,IREFRE,IBOUT,IOPT)
        CALL TAILLE_FEN(IPROX,IPROY,1)
        CALL x11nomfenetre(PROBIG,LPRO)
        CALL x11szscrn(IDX,IDY)
        IREFRE = 1
        CALL GSCLR
        GOTO 5000
      ENDIF
C
C Echelles (surfaces) (/)
C
 3600 CALL FSTERM(1)
      IF (ILANG.EQ.0) THEN
        PRINT*,
     &'Contrôle de l''affichage de la "bounding box" et des échelles :'
        PRINT*,'  Types de boites disponibles :'
        PRINT*,'    0 : pas de boite'
        PRINT*,'    1 : boite "ouverte" vers l''observateur (3 faces)'
        PRINT*,'    2 : boite fermée (6 faces)'
        CALL LIENTIER('Type de boite ?',0,IBOITE)
      ELSE
        PRINT*,'Parameters for the bounding box and scales:'
        PRINT*,'  Boxes types:'
        PRINT*,'    0 : no boxes'
        PRINT*,'    1 : open box (3 facets)'
        PRINT*,'    2 : closed box (6 facets)'
        CALL LIENTIER('Box type ?',0,IBOITE)
      ENDIF
      IF (IBOITE.LE.0.OR.IBOITE.GT.2) THEN
        IBOITE = 0
      ELSE
Cfj        IF (ILANG.EQ.0) THEN
Cfj          PRINT*,'  Types d''échelles disponibles :'
Cfj          PRINT*,'    0 : pas d''échelle'
Cfj          PRINT*,'    1 : traits sur les axes sans chiffres'
Cfj          PRINT*,'    2 : traits sur les axes avec chiffres'
Cfj          PRINT*,'    3 : traits et grilles sur les faces sans chiffres'
Cfj          PRINT*,'    4 : traits et grilles sur les faces avec chiffres'
Cfj          CALL LIENTIER('Type d''échelles ?',0,IECBOI)
Cfj        ELSE
Cfj          PRINT*,'  Scales types:'
Cfj          PRINT*,'    0 : no scales'
Cfj          PRINT*,'    1 : scales on axis without numbers'
Cfj          PRINT*,'    2 : scales on axis with numbers'
Cfj          PRINT*,'    3 : scales on axis and grids without numbers'
Cfj          PRINT*,'    4 : scales on axis and grids with numbers'
Cfj          CALL LIENTIER('Scale type ?',0,IECBOI)
Cfj        ENDIF
Cfj        IF (IECBOI.LT.0.OR.IECBOI.GT.4) IECBOI = 0
        IF (ILANG.EQ.0) THEN
          CALL LIENTIER('Traits sur les axes (1:oui ; 0:non) ?',0,ITIC)
          CALL LIENTIER('Numéros sur les axes (1:oui ; 0:non) ?',0,INUM)
          CALL LIENTIER('Grilles (1:oui ; 0:non) ?',0,IGRI)
        ELSE
          CALL LIENTIER('Tics on axis (1:yes ; 0:no) ?',0,ITIC)
          CALL LIENTIER('Numbers on axis (1:yes ; 0:no) ?',0,INUM)
          CALL LIENTIER('Grids (1:yes ; 0:no) ?',0,IGRI)
        ENDIF
        IF (ITIC.NE.0.OR.INUM.NE.0.OR.IGRI.NE.0) THEN
          IECBOI = 1
          IF (ITIC.EQ.0) IECBOI = IECBOI+4
          IF (INUM.NE.0) IECBOI = IECBOI+1
          IF (IGRI.NE.0) IECBOI = IECBOI+2
        ELSE
          IECBOI = 0
        ENDIF
      ENDIF
      CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
      GOTO 5001
C
C Sous-domaines  (.)
C
 3700 IF (NUMSD.GT.1) THEN
        IF (NUMSD.GT.2) THEN
          IVU = 0
          IPREMVU = 0
          DO K=1,NUMSD
            IF (ISDVU(K).GT.0) THEN
              IVU = IVU+1
              IF (IPREMVU.EQ.0) IPREMVU = K
            ENDIF
          ENDDO
          IF (IVU.EQ.NUMSD.OR.IPREMVU.EQ.0) THEN
            ISDVU(1) = 1
            DO K=2,NUMSD
              ISDVU(K) = 0
            ENDDO
          ELSEIF(IPREMVU.EQ.NUMSD) THEN
            DO K=1,NUMSD
              ISDVU(K) = 1
            ENDDO
          ELSE
            DO K=1,NUMSD
              ISDVU(K) = 0
            ENDDO
            ISDVU(IPREMVU+1) = 1
          ENDIF
        ELSE
          IF (ISDVU(1).EQ.1.AND.ISDVU(2).EQ.1) THEN
            ISDVU(2) = 0
          ELSEIF(ISDVU(1).EQ.1.AND.ISDVU(2).EQ.0) THEN
            ISDVU(1) = 0
            ISDVU(2) = 1
          ELSE
            ISDVU(1) = 1
          ENDIF
        ENDIF
        GOTO 5000
      ELSE
        GOTO 5002
      ENDIF
C
C Mailles ou pas  (-)
C
 3800 IMAILL = -IMAILL
      IBOUT = -9999
      GEOM = .TRUE.
      GOTO 5000
C
C Shrink prop au champ scalaire (,)
C
 3900 IF ((IFISO*ICENTR).NE.0.AND.ISHRINK.LT.0) THEN
        IF (ISHPRO.GT.0) THEN
          ISHPRO = -1
        ELSEIF(ISHPRO.EQ.-1) THEN
          ISHPRO = -2
        ELSE
          ISHPRO = 1
        ENDIF
        IF (ISHPRO.LT.0) THEN
          CALL FSTERM(1)
          IF (ILANG.EQ.0) THEN
            CALL LIREEL1('Valeur minimale vue (0<V<1) ?',0,VSHPRO)
          ELSE
            CALL LIREEL1('Minimum value displayed (0<V<1) ?',0,VSHPRO)
          ENDIF
          CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
        ENDIF
        GEOM = .TRUE.
        GOTO 5000
      ELSE
        GOTO 5002
      ENDIF
C
C Vitesses, fleches (+)
C
 4000 IF (IFVIT.NE.0) THEN
        IVIT = -IVIT
        IF (IVIT.LT.0.AND.ICTFLE.GT.15) THEN
          VITCOUL = .TRUE.
        ELSE
          VITCOUL = .FALSE.
        ENDIF
        IF (ICTFLE.GT.15.AND.ISO.EQ.0) THEN
          IF (IVIT.LT.0) THEN
            ITABLE0 = ITABLE
            IF (ITABLE.NE.1) THEN
              ITABLE = 1
              IIII = -100000-NBCOUL
              CALL TABCOL(IIII,IWAVE)
            ENDIF
            ICADPS = 1
          ELSEIF(ITABLE.NE.ITABLE0) THEN
            ITABLE = ITABLE0
            IIII = -100000-NBCOUL
            CALL TABCOL(IIII,IWAVE)
          ENDIF
        ENDIF
        GEOM = .TRUE.
        GOTO 5000
      ELSE
        GOTO 5002
      ENDIF
C
C Taille des fleches (*)
C
 4100 IF (IFVIT.NE.0) THEN
        FFF = 1.
        CALL QUEST_EXAFLE(ILANG,FFF,IRQ)
        IF (FFF.EQ.1.) GOTO 5002
Cfj        CALL FSTERM(1)
Cfj        IF (ILANG.EQ.0) THEN
Cfj          CALL LIREEL1
Cfj     &     ('Facteur multiplicatif pour la taille des flèches ?',0,FFF)
Cfj        ELSE
Cfj          CALL LIREEL1
Cfj     &     ('Multiplicative factor for the arrows size ?',0,FFF)
Cfj        ENDIF
        IF (FFF.EQ.0.) FFF = 1.E-4
        FACVIT  = FACVIT*FFF
        FACVIT0 = FACVIT0*FFF
Cfj        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
        GEOM = .TRUE.
        GOTO 5001
      ELSE
        GOTO 5002
      ENDIF
C
C maillages : Comparaison de deux fichiers de valeurs ())
C surfaces : courbes sur la surface
C
 4200 IF (ICOURB.GT.0) THEN
        CALL FSTERM(1)
        CALL LIISO2S(ICLAS,IRC)
        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
        IF (IRC.NE.0) GOTO 5002
        IF (ISO.EQ.0) THEN
          GOTO 5001
        ELSE
          GOTO 5000
        ENDIF
      ENDIF
C
C On se branche ici pour l'option secrete "`" (Bob)
C
      CALL FSTERM(1)
 4201 IF (ILANG.EQ.0) THEN
        CALL LIFICHTAB(
     &       'Nom du fichier de points ?',0,NOM_COUR,LONCOUR,0)
      ELSE
        CALL LIFICHTAB(
     &       'Name of the points file ?',0,NOM_COUR,LONCOUR,0)
      ENDIF
      IF (LONCOUR.LT.0) THEN
        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
        GOTO 5002
      ENDIF
      IF (ICOURB.EQ.-5.OR.ICOURB.GT.0) THEN
        CALL INV3X3(ROTA,ROTLOC,IERR)
        DO I=1,3
          DO J=1,3
            ROTA(J,I) = ROTLOC(J,I)
          ENDDO
        ENDDO
        CALL ROTATE(0)
        IF (NDS.EQ.3) THEN
          CALL LICOUR3(IRC)
        ELSE
          CALL LICOUR4(IRC)
        ENDIF
        CALL INV3X3(ROTA,ROTLOC,IERR)
        DO I=1,3
          DO J=1,3
            ROTA(J,I) = ROTLOC(J,I)
          ENDDO
        ENDDO
        CALL ROTATE(0)
      ELSE
        CALL LICOUR(IRC)
      ENDIF
      IF (IRC.NE.0) THEN
        IF (ILANG.EQ.0) THEN
          PRINT*,'*** Mauvais fichier'
        ELSE
          PRINT*,'*** Bad file'
        ENDIF
        GOTO 4201
      ENDIF
      CALL ECR16COULB(ILANG)
      IF (ILANG.EQ.0) THEN
        CALL LIENTIER('Couleur des points de la courbe ?',0,ICPTS)
        IF (ICPTS.LT.0.OR.ICPTS.GT.15) ICPTS = 1
        CALL LIENTIER('Couleur des lignes de la courbe ?',0,ICSEG)
        IF (ICSEG.LT.0.OR.ICSEG.GT.15) ICSEG = 7
        CALL LIREEL1('Taille des points (1. --> défaut) ?',0,FACPTS)
        FACPTS = MAX(0.,FACPTS)
        CALL LIENTIER(
     &       'Epaisseur des lignes (<-1 ==> pas de lignes) ?',0,IEPSEG)
        PRINT*,'Les types de marqueurs sont :'
        PRINT*,'   0 : pas de marqueur'
        PRINT*,'   1 : +'
        PRINT*,'   2 : x'
        PRINT*,'   3 : *'
        PRINT*,'   4 : o'
        PRINT*,'   5 : o plein'
        PRINT*,'   6 : carré plein'
        PRINT*,'   7 : carré vide'
        PRINT*,'   8 : losange'
        PRINT*,'   9 : losange plein'
        PRINT*,'  10 : triangle'
        PRINT*,'  11 : triangle plein'
        PRINT*,'  12 : triangle inversé'
        PRINT*,'  13 : triangle inversé plein'
        CALL LIENTIER(
     &  'Types des marqueurs aux points (<0 -> variable) ?',0,ITPTS)
        CALL LIENTIER(
     &       'Marqueurs cachés (0) ou toujours vus (1) ?',0,IOPMAR)
      ELSE
        CALL LIENTIER('Dots color?',0,ICPTS)
        IF (ICPTS.LT.0.OR.ICPTS.GT.15) ICPTS = 1
        CALL LIENTIER('Lines color?',0,ICSEG)
        IF (ICSEG.LT.0.OR.ICSEG.GT.15) ICSEG = 7
        CALL LIREEL1('Dots size (1. --> default) ?',0,FACPTS)
        FACPTS = MAX(0.,FACPTS)
        CALL LIENTIER(
     &       'Lines thickness (<-1 ==> no lines) ?',0,IEPSEG)
        PRINT*,'Marker types:'
        PRINT*,'   0 : no markers'
        PRINT*,'   1 : +'
        PRINT*,'   2 : x'
        PRINT*,'   3 : *'
        PRINT*,'   4 : o'
        PRINT*,'   5 : o filled'
        PRINT*,'   6 : filled square'
        PRINT*,'   7 : empty square'
        PRINT*,'   8 : losange'
        PRINT*,'   9 : filled losange'
        PRINT*,'  10 : triangle'
        PRINT*,'  11 : filled triangle'
        PRINT*,'  12 : upsidedown triangle'
        PRINT*,'  13 : filled upsidedown triangle'
        CALL LIENTIER(
     &       'Markers type (<0 -> variable)?',0,ITPTS)
        CALL LIENTIER(
     &       'Hidden markers (0) or always seen (1)?',0,IOPMAR)
      ENDIF
      CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
      GEOM = .TRUE.
      GOTO 5000
Cfj      ELSE
Cfj        GOTO 5002
Cfj      ENDIF
C
C Infos dans le cadre a droite (()
C
 4300 IF (IINFO.GT.0) THEN
        IINFO = -1
      ELSEIF(IINFO.EQ.-1) THEN
        IINFO = -2
      ELSE
        IINFO = 1
      ENDIF
      IOPT = -1
      GEOM = .TRUE.
      IBOUT = -9999
      GOTO 5001
C
C Affichage des valeurs sur le graphique (')
C
 4400 IF (ISO.NE.0) THEN
        CALL FINDFA(XCU,YCU,NBON,IORDRE,NN,NDS,XX,YY,VALGRA
     &             ,ISO,NPROJE,VALF,0)
        IF (NN.NE.0) THEN
          NE = NNUMFA(NPROJE(NN))
          IF (ILANG.EQ.0) THEN
            IF (NN.EQ.NE) THEN
              PRINT*,'Valeur =',VALGRA,' (élément',NN,')'
            ELSE
              PRINT*,'Valeur =',VALGRA,' (élément',NE,', face',NN,')'
            ENDIF
          ELSE
            IF (NN.EQ.NE) THEN
              PRINT*,'Value =',VALGRA,' (element',NN,')'
            ELSE
              PRINT*,'Value =',VALGRA,' (element',NE,', face',NN,')'
            ENDIF
          ENDIF
          CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
          CALL ECRVAL(XCU,YCU,VALGRA)
          NBPG = NBPG+1
          IF (NBPG.GT.NBPGM) THEN
            NBPG = NBPGM
            DO I=1,NBPGM-1
              VALG(I) = VALG(I+1)
              XXXG(I) = XXXG(I+1)
              YYYG(I) = YYYG(I+1)
            ENDDO
          ENDIF
          VALG(NBPG) = VALGRA
          XXXG(NBPG) = XCU
          YYYG(NBPG) = YCU
        ENDIF
      ENDIF
      GOTO 5003
C
C Orientation de la lumiere (&)
C
 4500 IDIRL = IDIRL+1
      IF (IDIRL.GT.6) IDIRL = 0
      CALL METLALIGHT
      IF (ICTFAC0.GT.15.OR.ICTFAC.NE.ICTFAC0) THEN
        GEOM = .TRUE.
        IF (ICTFAC.NE.ICTFAC0) THEN
          CALL INITBOUT
          IREFRE = 1
        ENDIF
        GOTO 5000
      ELSE
        GOTO 5002
      ENDIF
C
C Perspective (%)
C
 4600 IF (IPERSP.EQ.1) THEN
        IPERSP = -1
      ELSEIF(IPERSP.EQ.-1) THEN
        IPERSP = -2
      ELSEIF(IPERSP.EQ.-2) THEN
        IPERSP = -3
      ELSEIF(IPERSP.EQ.-3) THEN
        IPERSP = 1
      ENDIF
      CALL METLAPERSP
ctrans      dist000 = dist
ctrans      call calpup(xpup,dist,obs,u,v)
      GEOM = .TRUE.
      GOTO 5000
C
C Couleurs imposees ($)
C
 4700 CALL FSTERM(1)
      IF (ILANG.EQ.0) THEN
        PRINT*,'Couleurs imposées :'
        CALL ECR16COULB(ILANG)
        CALL LIENTIER('Nombre de couleurs imposées ?',0,NCIMP)
      ELSE
        PRINT*,'Imposed colors:'
        CALL ECR16COULB(ILANG)
        CALL LIENTIER('Number of imposed colors?',0,NCIMP)
      ENDIF
      NCIMP = MIN(NBCOUL,MAX(0,NCIMP))
      IF (NCIMP.GT.0) THEN
        IF (ILANG.EQ.0) THEN
          PRINT*,'On va imposer',NCIMP,' valeurs'
          CALL LIENTIER('Ok (1:oui, 0:non) ?',0,IOK)
        ELSE
          PRINT*,'We are going to impose',NCIMP,' values'
          CALL LIENTIER('Ok (1:yes, 0:no)?',0,IOK)
        ENDIF
        IF (IOK.EQ.0) NCIMP = 0
      ENDIF
      IF (NCIMP.GT.0) THEN
        IF (ILANG.EQ.0) THEN
          PRINT*,'Les valeurs à repérer doivent être comprises entre'
     &        ,VMIN,' et',VMAX
        ELSE
          PRINT*,'Values must lie between',VMIN,' and',VMAX
        ENDIF
        NNN = 0
        DO I=1,NCIMP
          IF (NCIMP.EQ.1) THEN
            IF (ILANG.EQ.0) THEN
              CALL LI2REEL1(
     & 'Entrez la valeur à repérer et sa nouvelle couleur',0,VVVV,XK2)
            ELSE
              CALL LI2REEL1(
     & 'Type the value to mark and its new color',0,VVVV,XK2)
            ENDIF
          ELSE
            IF (I.EQ.1) THEN
              IF (ILANG.EQ.0) THEN
                CALL LI2REEL1(
     & 'Entrez la premiere valeur à repérer et sa nouvelle couleur'
     &               ,0,VVVV,XK2)
              ELSE
                CALL LI2REEL1(
     & 'Type first the value to mark and its new color',0,VVVV,XK2)
              ENDIF
            ELSE
              IF (I.LT.10) THEN
                WRITE(CNUM(1:2),'(I2)') I
                LL = 2
              ELSEIF(I.LT.100) THEN
                WRITE(CNUM(1:3),'(I3)') I
                LL = 3
              ELSE
                WRITE(CNUM(1:4),'(I4)') I
                LL = 4
              ENDIF
              IF (ILANG.EQ.0) THEN
                CALL LI2REEL1('Entrez la'//CNUM(1:LL)//
     &               'ème valeur à repérer et sa nouvelle couleur'
     &               ,0,VVVV,XK2)
              ELSE
                CALL LI2REEL1('Type the '//CNUM(1:LL)//
     &               'th value to mark and its new color',0,VVVV,XK2)
            ENDIF
            ENDIF
          ENDIF
          K2 = NINT(XK2)
          IF (VVVV.GE.VMIN.AND.VVVV.LE.VMAX) THEN
            NNN = NNN+1
            K2 = 1+MIN(15,MAX(0,K2))
            K1 = 18 + NINT(.5+REAL(NBCOUL)*(VVVV-VMIN)/(VMAX-VMIN))
            IF (ILANG.EQ.0) THEN
              PRINT*,'Couleur',K1-18,' changée en',K2-1
            ELSE
              PRINT*,'Color',K1-18,' changed into',K2-1
            ENDIF
            CALL TABCOL(-(K2*1000+K1),IWAVE)
          ELSE
            IF (ILANG.EQ.0) THEN
              PRINT*,'Valeur en dehors des bornes'
            ELSE
              PRINT*,'Values off the bounds'
            ENDIF
          ENDIF
        ENDDO
        IF (ILANG.EQ.0) THEN
          PRINT*,NNN,' couleurs modifiées'
        ELSE
          PRINT*,NNN,' modified colors'
        ENDIF
      ENDIF
      CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
      IF (NNN.GT.0) THEN
        IF (ITERMC.EQ.4) THEN
CC          GEOM = .FALSE.
          GOTO 5001
        ELSE
          IOPT = 0
          CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUT)
          GOTO 5002
        ENDIF
      ELSE
        GOTO 5002
      ENDIF
C
C Rotation a la souris (#)
C
 4800 CALL GSQCUR(WIN,XCUR111,YCUR111)
      IF (ITYP.EQ.0) THEN
        CALL CHANGE_CURS(3)
        CALL VEC23(XCUR111,YCUR111,VEC1)
        DO J=1,3
          VEC0(J) = VEC1(J)
        ENDDO
        ITYP = -13
        CALL INV3X3(ROTA,ROTAINV,IERR)
        XCUR000 = XCUR111
        YCUR000 = YCUR111
        CALL GSBND(XHELP,XDMAX,YDMIN,YDMAX)
        CALL GSPAT(ICTFON)
        XCADRE(1) = XHELP
        XCADRE(2) = XDMAX
        XCADRE(3) = XDMAX
        XCADRE(4) = XHELP
        YCADRE(1) = YDMIN
        YCADRE(2) = YDMIN
        YCADRE(3) = YDMAX
        YCADRE(4) = YDMAX
        CALL MY_GSAREA(0,XCADRE,YCADRE,4)
      ELSE
        TOTO = (XCUR111-XCUR000)**2+(YCUR111-YCUR000)**2
        IF (TOTO.GT.PASMIN2) THEN
          CALL VEC23(XCUR111,YCUR111,VEC1)
          CALL ROTINT(VEC0,VEC1)
          DO J=1,3
            VEC0(J) = VEC1(J)
          ENDDO
          XCUR000 = XCUR111
          YCUR000 = YCUR111
          CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUT)
        ELSE
          GOTO 5003
        ENDIF
      ENDIF
      CALL ECHEL(-2,BIDON)
      IF (IAXES.NE.0) CALL AXES(XHELP,XDMAX,YDMIN,YDMAX)
      CALL GSLW(IEPBOR)
      CALL GSPLNEC(4,XCADRE,YCADRE)
      CALL GSLW(0)
      GOTO 5003
C
C Maillages 3d : Isosurface (!)
C Surfaces     : coupes suivant Ox ou Oy et appel de xgraphic (!)
C
 4900 IF (ICOURB.GT.0) THEN
        IQUEST = 0
        IF (I2D.EQ.0) THEN
C Maillages 3d : Isosurface (!)
          IF (IFISO.NE.0.AND.IVOL.NE.0.AND.VMINISO.LT.VMAXISO) THEN
            III = 0
            IF (LONISO.GT.5) THEN
              IF (NOM_ISO(LONISO-5:LONISO).EQ.'.theta') III = 1
            ENDIF
            IF (LONISO.GT.6) THEN
              IF (NOM_ISO(LONISO-6:LONISO).EQ.'.thetap') III = 1
            ENDIF
            IF (LONISO.GT.3) THEN
              IF (NOM_ISO(LONISO-3:LONISO).EQ.'.psi') III = 2
            ENDIF
            CALL QUEST_ISOSURF(ILANG,VMINISO,VMAXISO,NSURF,VISO,ICALSU
     &                        ,BSOMB,ICSUR,III,IRQ)
            IF (IRQ.EQ.0.OR.IRQ.EQ.-2) THEN
              ISOCOUP = 2
              IF (IRQ.EQ.-2) THEN
                IQUEST = 4900
              ELSE
                IQUEST = 0
              ENDIF
c              GEOM = .TRUE.
              IF (IFC.GT.0) IFC = -1
              IF ((VISO.LT.VMINISO.AND.(ICALSU.EQ.0.OR.ICALSU.EQ.1))
     &        .OR.(VISO.GT.VMAXISO.AND.(ICALSU.EQ.0.OR.ICALSU.EQ.2)))
     &             THEN
                NSURF = 0
              ELSE
                CALL CALSUR(1)
              ENDIF
              GOTO 5000
            ELSE
              GOTO 5002
            ENDIF
Cfj            CALL FSTERM(1)
Cfj            IF (ILANG.EQ.0) THEN
Cfj              PRINT*,'Bornes des valeurs',VMINISO,VMAXISO
Cfj              IF (NSURF.GT.0) THEN
Cfj                IF (ICALSU.EQ.0) THEN
Cfj                  PRINT*,'Isosurface actuelle =',VISO
Cfj                ELSEIF(ICALSU.EQ.1) THEN
Cfj                  PRINT*,'Isosurface actuelle <=',VISO
Cfj                ELSE
Cfj                  PRINT*,'Isosurface actuelle >=',VISO
Cfj                ENDIF
Cfj              ENDIF
Cfj              CALL LIREEL1('Valeur de l''isosurface ?',0,VISO)
Cfj            ELSE
Cfj              PRINT*,'Bounds of the values',VMINISO,VMAXISO
Cfj              IF (NSURF.GT.0) THEN
Cfj                IF (ICALSU.EQ.0) THEN
Cfj                  PRINT*,'Current surface =',VISO
Cfj                ELSEIF(ICALSU.EQ.1) THEN
Cfj                  PRINT*,'Current surface <=',VISO
Cfj                ELSE
Cfj                  PRINT*,'Current surface >=',VISO
Cfj                ENDIF
Cfj              ENDIF
Cfj              CALL LIREEL1('Isosurface''s value?',0,VISO)
Cfj            ENDIF
Cfj            IF (VISO.LT.VMINISO.OR.VISO.GT.VMAXISO) THEN
Cfj              NSURF = 0
Cfj              CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
Cfj              GOTO 5001
Cfj            ELSE
Cfj              IF (ILANG.EQ.0) THEN
Cfj                CALL LIENTIER('Juste l''iso (0) <iso (1) >iso (2) ?'
Cfj     &                       ,0,ICALSU)
Cfj              ELSE
Cfj                CALL LIENTIER('Surface only (0) <iso (1) >iso (2) ?'
Cfj     &                       ,0,ICALSU)
Cfj              ENDIF
Cfj              IF (ICALSU.NE.1.AND.ICALSU.NE.2) ICALSU = 0
Cfj              IF (ICALSU.NE.0) THEN
Cfj                IF (ILANG.EQ.0) THEN
Cfj                  CALL LIENTIER(
Cfj     & 'Bord du domaine clair (0), moyen (1) ou sombre (2) ?',0,IBSOMB)
Cfj                ELSE
Cfj                  CALL LIENTIER(
Cfj     & 'Domain''s boundaries light (0), medium (1) or dark (2) ?'
Cfj     &                 ,0,IBSOMB)
Cfj                ENDIF
Cfj                IF (IBSOMB.EQ.0) THEN
Cfj                  BSOMB = 0.5
Cfj                ELSEIF(IBSOMB.EQ.1) THEN
Cfj                  BSOMB = 0.3
Cfj                ELSE
Cfj                  BSOMB = 0.1
Cfj                ENDIF
Cfj              ENDIF
Cfj              CALL CALSUR(1)
Cfj              IF (NSURF.GT.0) THEN
Cfj                ICSUR = 16
Cfj                CALL ECR16COUL(ICSUR,ILANG)
Cfj                IF (ILANG.EQ.0) THEN
Cfj                  PRINT*,'>15 : pas de tracé des arêtes'
Cfj                  CALL LIENTIER('Couleur des arêtes de l''isosurface ?'
Cfj     &                 ,0,ICSUR)
Cfj                ELSE
Cfj                  PRINT*,'>15 : no vertex drawn'
Cfj                  CALL LIENTIER('Vertices color?',0,ICSUR)
Cfj                ENDIF
Cfj                IF (ICSUR.LT.0) ICSUR = 16
Cfj                ifc = -1
Cfj                CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
Cfj                GOTO 5000
Cfj              ELSE
Cfj                CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
Cfj                GOTO 5001
Cfj              ENDIF
Cfj            ENDIF
          ELSE
            CALL FSALRM
            GOTO 5002
          ENDIF
        ELSE
C
C Maillages 2d : affichage en 3d suivant le champ scalaire (a faire)
C
          GOTO 5002
        ENDIF
      ELSEIF(ICOURB.NE.-5) THEN
C
C Surfaces     : coupes suivant Ox ou Oy et appel de xgraphic (!)
C
        CALL QUICESTCELUILA('xgraphic',8,GVESTLA,0)
        IF (.NOT.GVESTLA) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,'*** Pas de xgraphic, pas de coupes...'
          ELSE
            PRINT*,'*** No xgraphic, no cross-sections...'
          ENDIF
          GOTO 5002
        ENDIF
        CALL FSTERM(1)
        IF (ILANG.EQ.0) THEN
          CALL LIENTIER(
     &   'Nombre de coupes (>0 fichiers temporaires, <0 on les garde) ?'
     &  ,0,NCOUP)
        ELSE
          CALL LIENTIER(
     &   'Number of cross-sections (>0 scratch files, <0 files saved)?'
     &  ,0,NCOUP)
        ENDIF
        IF (NCOUP.NE.0) THEN
          CALL ARC(ANGX,ANGY,ANGZ)
          CALL INV3X3(ROTA,ROTLOC,IERR)
          CALL ROTATE(1)
          CALL PREMIER_LIBRE(ICOUP)
          DO I=1,IABS(NCOUP)
            WRITE(CC,'(I2.2)') I
            IF (NCOUP.GT.0) THEN
              OPEN(ICOUP,FILE='/tmp/coupe'//CC//'.'//MOI)
            ELSE
              OPEN(ICOUP,FILE=NOM_FICH(1:LONG2)//'.coupe'//CC)
            ENDIF
            IF (ILANG.EQ.0) THEN
              CALL LIENTIER('Coupe // Ox (0) ou // Oy (1) ?',0,IPL)
            ELSE
              CALL LIENTIER(
     &             'Cross-section // Ox (0) or // Oy (1) ?',0,IPL)
            ENDIF
            IF (IPL.EQ.0) THEN
              IF (ILANG.EQ.0) THEN
                PRINT*,'Bornes en Y :',YMIREE,YMAREE
                CALL LIREEL1('Valeur de Y ?',0,YCOUP)
                YCOUP = MIN(MAX(YCOUP,YMIREE),YMAREE)
                YCOUP = YCOUP-YMED
                WRITE(ICOUP,'(A,G11.5)')
     &   '# Coupe du fichier '//NOM_FICH(1:LONG)//' par le plan Y ='
     &               ,YCOUP+YMED
              ELSE
                PRINT*,'Y bounds:',YMIREE,YMAREE
                CALL LIREEL1('Y value?',0,YCOUP)
                YCOUP = MIN(MAX(YCOUP,YMIREE),YMAREE)
                YCOUP = YCOUP-YMED
                WRITE(ICOUP,'(A,G11.5)')
     &   '# Cross-section of'//NOM_FICH(1:LONG)//' / plan Y ='
     &               ,YCOUP+YMED
              ENDIF
              KK = 0
              J = 1
              DO K=1,NUMY-1
                IF (KK.EQ.0.AND.Y(J).LE.YCOUP.AND.Y(J+NUMX).GE.YCOUP)
     &               KK = K
                J = J+NUMX
              ENDDO
              FAC = (YCOUP-Y((KK-1)*NUMX+1))/(Y(KK*NUMX+1)-Y(KK))
              IF (KK.EQ.0.OR.FAC.GT.1..OR.FAC.LT.0.) THEN
                IF (ILANG.EQ.0) THEN
                  PRINT*,'*** Problème',KK,FAC
                ELSE
                  PRINT*,'*** Error',KK,FAC
                ENDIF
              ENDIF
              DO K=1,NUMX
                J1 = (KK-1)*NUMX + K
                J2 = J1+NUMX
                WRITE(ICOUP,*) X(K)+XMED0,FAC*Z(J2)+(1.-FAC)*Z(J1)+ZMED0
              ENDDO
            ELSE
              IF (ILANG.EQ.0) THEN
                PRINT*,'Bornes en X :',XMIREE,XMAREE
                CALL LIREEL1('Valeur de X ?',0,XCOUP)
                XCOUP = MIN(MAX(XCOUP,XMIREE),XMAREE)
                XCOUP = XCOUP-XMED0
                WRITE(ICOUP,'(A,G11.5)')
     &     '# Coupe du fichier '//NOM_FICH(1:LONG)//' par le plan X ='
     &             ,XCOUP+XMED0
              ELSE
                PRINT*,'X bounds:',XMIREE,XMAREE
                CALL LIREEL1('X value?',0,XCOUP)
                XCOUP = MIN(MAX(XCOUP,XMIREE),XMAREE)
                XCOUP = XCOUP-XMED0
                WRITE(ICOUP,'(A,G11.5)')
     &     '# Cross-section of '//NOM_FICH(1:LONG)//' / plan X ='
     &             ,XCOUP+XMED0
              ENDIF
              KK = 0
              DO K=1,NUMX-1
                IF (KK.EQ.0.AND.X(K).LE.XCOUP.AND.X(K+1).GE.XCOUP)
     &               KK = K
              ENDDO
              FAC = (XCOUP-X(KK))/(X(KK+1)-X(KK))
              IF (KK.EQ.0.OR.FAC.GT.1..OR.FAC.LT.0.) THEN
                IF (ILANG.EQ.0) THEN
                  PRINT*,'*** Problème',KK,FAC
                ELSE
                  PRINT*,'*** Error',KK,FAC
                ENDIF
              ENDIF
              DO K=1,NUMY
                J1 = (K-1)*NUMX + KK
                J2 = J1+1
                WRITE(ICOUP,*) Y(J1)+YMED0
     &                        ,FAC*Z(J2)+(1.-FAC)*Z(J1)+ZMED0
              ENDDO
            ENDIF
            CLOSE(ICOUP)
          ENDDO
          IF (NCOUP.GT.0) THEN
            CALL EXEC('xgraphic -win65 /tmp/coupe*'//MOI//'>/dev/null&')
            CALL EXEC(
     &            'sleep 5 ; /bin/rm -f /tmp/coupe*'//MOI//'>/dev/null')
          ELSE
            CALL EXEC(
     &      'xgraphic -win65 '//NOM_FICH(1:LONG2)//'.coupe*>/dev/null&')
          ENDIF
          CALL ARCROT(ANGX,ANGY,ANGZ)
          CALL ROTATE(0)
        ENDIF
        CALL FSINN(IPROX,IPROY,PROBIG,IDEB,ITERMC)
        GOTO 5002
      ELSE
        GOTO 5002
      ENDIF
C
C fichier pour xgraphic (marc) (`)
C
Cfj 4901 IF (IPERSP.EQ.1) THEN
Cfj        FAFA = R2R3
Cfj      ELSE
Cfj        FAFA = .5*RAC3
Cfj      ENDIF
Cfj      IF (ISO.EQ.0) THEN
Cfj        TITRE = NOM_FICH
Cfj        LLL   = LONG
Cfj      ELSE
Cfj        TITRE = NOM_FICH(1:LONG)//' - '//NOM_ISO(1:LONISO)
Cfj        LLL = LONG + 3 + LONISO
Cfj      ENDIF
Cfj      LPOINT = LONG
Cfj 4911 IF (NOM_FICH(LPOINT:LPOINT).NE.'.'.AND.LPOINT.GT.1) THEN
Cfj        LPOINT = LPOINT-1
Cfj        GOTO 4911
Cfj      ENDIF
Cfj      IF (LPOINT.EQ.1) THEN
Cfj        LPOINT = LONG
Cfj      ELSE
Cfj        LPOINT = LPOINT-1
Cfj      ENDIF
Cfj      CALL INITSAUVE(NOM_FICH(1:LPOINT)//'.graph',LPOINT+6,XMED0,YMED0
Cfj     &              ,FAFA,TITRE,LLL)
Cfj      ISAUVEGRAPH = 1
Cfj      GEOM = .TRUE.
Cfj      GOTO 5001
C
C On reutilise cette touche (`) pour les courbes sur maillage (identique
C aux courbes sur les surfaces)
C
 4901 CALL FSTERM(1)
      GOTO 4201
C
C Titre du avoir3D (_)
C
 4902 IF (LONTIT.GT.0) THEN
        ITITAV = -ITITAV
        IF (IFREEZE.NE.0) GOTO 5003
        IF (ITITAV.LT.0) THEN
          CALL TITIT(XHELP,XDMAX,YDMIN,YDMAX)
          GOTO 5002
        ELSE
          GEOM = .TRUE.
          GOTO 5001
        ENDIF
      ELSE
        GOTO 5002
      ENDIF
C
C Numeros (^) (maillages only)
C
 4903 IF (ICOURB.GT.0) THEN
C
C INUMER = 0 : Pas de numeros
C        = 1 : elements
C        = -1 : noeuds
C        = -2 : references
C        = -3 : references non nulles
C
        IF (INUMER.EQ.0) THEN
          INUMER = -1
        ELSEIF(INUMER.EQ.-1) THEN
          INUMER = 1
        ELSEIF(INUMER.EQ.1) THEN
          INUMER = -2
        ELSEIF(INUMER.EQ.-2) THEN
          INUMER = -3
        ELSE
          INUMER = 0
        ENDIF
        GEOM = .TRUE.
        GOTO 5000
      ELSE
        GOTO 5003
      ENDIF
C
C Tables oscillantes (]) provisoire pour Alexandre
C
 4904 IWAVE = IWAVE+1
      IF (IWAVE.EQ.11.OR.IWAVE.GT.NBCOUL/5) IWAVE=0
      IIII = -100000-NBCOUL
      CALL TABCOL(IIII,IWAVE)
      IF (ITERMC.EQ.4) THEN
        GOTO 5001
      ELSE
        IOPT = 0
        GOTO 5002
      ENDIF
C
C Mode progressif ou non (\)
C
 4905 IPROGRE = -IPROGRE
      IF (IPROGRE.LT.0) THEN
        CALL VRAIECOORD(XHELP,YDMAX,IX0,IY0)
        CALL VRAIECOORD(XDMAX,YDMIN,IX1,IY1)
        PIPI = .5*REAL(IEPBOR)*(XDMAX-XHELP)/REAL(IABS(IX0-IX1))
        ILARG = IX1-IX0-IEPBOR
        IHAUT = IY1-IY0-IEPBOR
        IX0 = IX0+IEPBOR/2
        IY0 = IY0+IEPBOR/2
        IX1 = IX1-IEPBOR/2
        IY1 = IY1-IEPBOR/2
        IX0S = IX0+ISHIFTX
        IY0S = IY0+ISHIFTY
        CALL GSPROGRE(2)
        CALL GSPATF(ICTFON)
        CALL GSPAT(16)
        CALL GSBND(XHELP*2.-XDMAX,XDMAX*2.-XHELP
     &            ,YDMIN*2.-YDMAX,YDMAX*2.-YDMIN)
        CALL MY_GSAREA2B(XHELP*2.-XDMAX,XDMAX*2.-XHELP
     &                  ,YDMIN*2.-YDMAX,YDMAX*2.-YDMIN)
        CALL GSPROGRE(0)
        CALL x11garderect2(IX0,IY0,ILARG,IHAUT,IX0S,IY0S)
      ENDIF
      GOTO 5002
C
C Mise a jour des fichiers ouverts ([) (refresh)
C
 4906 CALL GSBND(XDMIN,XHELP,YDMIN,YDMAX)
      CALL MYBORD(XBOUT(1,IBREL),YBOUT(1,IBREL),BID,0,ITOUR2,15,7)
      CALL viderbuff2
      CALL AREFRESH(IRELIM,IRELIVA,IRELIVI)
c      print*,IRELIM,IRELIVA,IRELIVI
      IF (IRELIVI.NE.0) THEN
        IRC = 1
Cfj        IF (NOM_ISO(1:1).NE.'$') THEN
Cfj          CALL LIVAL(NOM_ISO,LONISO,IVAL,ICLAS,ICONTR,NDSEL,IRC)
Cfj          IF (IVAL.EQ.-1) THEN
Cfj            III = 2
Cfj          ELSE
Cfj            III = 0
Cfj          ENDIF
Cfj        ELSE
          III = 0
Cfj        ENDIF
        LBID = LONISO
        IF (LBID.GT.0) CBIDON(1:LBID) = NOM_ISO(1:LONISO)
        CALL LIVAL(NOM_VIT,LONVIT,IVAL,ICLAS,ICONTR,NDSEL,IRC)
        IF (FACEXA.EQ.0..OR.I2D.EQ.0) THEN
          CALL LIVIT(ICLAS,III,NOM_VIT,LONVIT,IRC,0,0)
        ELSE
          CALL LIVIT(ICLAS,III,NOM_VIT,LONVIT,IRC,0,1)
        ENDIF
        LONISO = LBID
        IF (LBID.GT.0) NOM_ISO(1:LONISO) = CBIDON(1:LBID)
      ENDIF
      IF (IRELIVA.NE.0) THEN
        IRC = 1
        CALL LIVAL(NOM_ISO,LONISO,IVAL,ICLAS,ICONTR,NDSEL,IRC)
        IF (I2D.NE.0.AND.FACEXA.NE.0.) THEN
          DFACX = -FACEXA
          DFACY = -FACEXA
          DFACZ = -FACEXA
          CALL EXAGERE(DFACX,DFACY,DFACZ,0)
          FACEXA0 = FACEXA
          IEXA = 1
        ELSE
          IEXA = 0
        ENDIF
        CALL LIISO(ICLAS,NOM_ISO,LONISO,IRC,ICONTR,1,IVAL)
        IF (IEXA.EQ.1) THEN
          FACEXA = FACEXA0
          DFACX = FACEXA
          DFACY = FACEXA
          DFACZ = FACEXA
          CALL EXAGERE(DFACX,DFACY,DFACZ,0)
        ENDIF
        IF (ISO.EQ.0.AND.(IVAL.EQ.1.OR.IVAL.EQ.4).AND.NSURF.LE.0) THEN
          IOPT = -1
        ELSE
ccc          IF (IREP.EQ.0.AND.(VISO.LT.VMINISO.OR.VISO.GT.VMAXISO)) THEN
          IF ((VISO.LT.VMINISO.AND.(ICALSU.EQ.0.OR.ICALSU.EQ.1))
     &    .OR.(VISO.GT.VMAXISO.AND.(ICALSU.EQ.0.OR.ICALSU.EQ.2))) THEN
            NSURF = 0
          ELSE
            IF (NSURF.GT.0) CALL CALSUR(1)
          ENDIF
        ENDIF
      ENDIF
C
      IF (IRELIM.EQ.0) THEN
        IF (IRELIVA.EQ.0.AND.IRELIVI.EQ.0) THEN
          GOTO 5002
        ELSE
          IF (NBPG.GT.0) THEN
            DO I=1,NBPG
              CALL FINDFA(XXXG(I),YYYG(I),NBON,IORDRE,NN,NDS,XX,YY
     &                   ,VALGRA,ISO,NPROJE,VALF,1)
              IF (NN.NE.0) THEN
                NE = NNUMFA(NPROJE(NN))
                IF (ILANG.EQ.0) THEN
                  IF (NN.EQ.NE) THEN
                    PRINT*,'Nouvelle valeur =',VALGRA,' (élément',NN,')'
                  ELSE
                    PRINT*,
     &    'Nouvelle valeur =',VALGRA,' (élément',NE,', face',NN,')'
                  ENDIF
                ELSE
                  IF (NN.EQ.NE) THEN
                    PRINT*,'New value =',VALGRA,' (element',NN,')'
                  ELSE
                    PRINT*,
     &    'New value =',VALGRA,' (element',NE,', face',NN,')'
                  ENDIF
                ENDIF
              ELSE
                PRINT*,'*** Biz',I
              ENDIF
              VALG(I) = VALGRA
            ENDDO
          ENDIF
          IF (ILANG.EQ.0) THEN
            PRINT*,'--- fin relecture ---'
          ELSE
            PRINT*,'--- end of reload ---'
          ENDIF
          IF (ISO.EQ.0.AND.(IVAL.EQ.1.OR.IVAL.EQ.4).AND.NSURF.LE.0) THEN
            GOTO 5001
          ELSE
            GOTO 5000
          ENDIF
        ENDIF
      ELSE
        IF (ILANG.EQ.0) THEN
          PRINT*,'--- fin relecture ---'
        ELSE
          PRINT*,'--- end of reload ---'
        ENDIF
        IPARA = -NFACE/NF
        IREFRE = 1
        NOM_FICH(1:LONG0) = NOMF0(1:LONG0)
        LONG = LONG0
        GOTO 1
      ENDIF
C
C Coupes (})
C
 3503 IQUEST = 0
      IF (ICOURB.GT.0.AND.I2D.EQ.0.AND.IVOL.NE.0) THEN
        CALL INV3X3(ROTA,ROTLOC,IERR)
        CALL ROTATE(1)
        CALL INV3X3(ROTLOC,ROTA,IERR)
        VMINXYZ(1) = BIG
        VMAXXYZ(1) = -BIG
        VMINXYZ(2) = BIG
        VMAXXYZ(2) = -BIG
        VMINXYZ(3) = BIG
        VMAXXYZ(3) = -BIG
        DO I=1,NUMNP
          VMINXYZ(1) = MIN(VMINXYZ(1),X(I))
          VMAXXYZ(1) = MAX(VMAXXYZ(1),X(I))
          VMINXYZ(2) = MIN(VMINXYZ(2),Y(I))
          VMAXXYZ(2) = MAX(VMAXXYZ(2),Y(I))
          VMINXYZ(3) = MIN(VMINXYZ(3),Z(I))
          VMAXXYZ(3) = MAX(VMAXXYZ(3),Z(I))
        ENDDO
        VMINXYZ(1) = VMINXYZ(1) + XMED0
        VMAXXYZ(1) = VMAXXYZ(1) + XMED0
        VMINXYZ(2) = VMINXYZ(2) + YMED0
        VMAXXYZ(2) = VMAXXYZ(2) + YMED0
        VMINXYZ(3) = VMINXYZ(3) + ZMED0
        VMAXXYZ(3) = VMAXXYZ(3) + ZMED0
        IF (VCOUPXYZ(1).EQ.BIG) VCOUPXYZ(1) = (VMINXYZ(1)+VMAXXYZ(1))*.5
        IF (VCOUPXYZ(2).EQ.BIG) VCOUPXYZ(2) = (VMINXYZ(2)+VMAXXYZ(2))*.5
        IF (VCOUPXYZ(3).EQ.BIG) VCOUPXYZ(3) = (VMINXYZ(3)+VMAXXYZ(3))*.5
        IPCOUP0 = IPCOUP
        IF (IPCOUP.EQ.0) IPCOUP = 3
        CALL QUEST_COUPE(ILANG,VMINXYZ,VMAXXYZ,VCOUPXYZ,VCOUP
     &                  ,IPCOUP,IPCOUP0,ICOUPSU,IRQ)
        IF (IRQ.EQ.0.OR.IRQ.EQ.-2) THEN
          ISOCOUP = 1
          BSOMB = 0.3
          IF (IBORD.NE.-1.AND.IMAILL.GT.0) THEN
            ICSUR = 8
          ELSE
            ICSUR = 16
          ENDIF
          VCOUPXYZ(IPCOUP) = VCOUP
          IF (IFC.GT.0) IFC = -1
          IF ((VCOUP.LT.VMINXYZ(IPCOUP)
     &         .AND.(ICOUPSU.EQ.0.OR.ICOUPSU.EQ.1))
     &    .OR.(VCOUP.GT.VMAXXYZ(IPCOUP)
     &         .AND.(ICOUPSU.EQ.0.OR.ICOUPSU.EQ.2))) THEN
            NSURF = 0
          ELSE
            DO I=1,NUMNP
              VALXB(I) = VALX(I)
            ENDDO
            IF (IPCOUP.EQ.1) THEN
              DO I=1,NUMNP
                VALX(I) = X(I) + XMED0
              ENDDO
            ELSEIF(IPCOUP.EQ.2) THEN
              DO I=1,NUMNP
                VALX(I) = Y(I) + YMED0
              ENDDO
            ELSE
              DO I=1,NUMNP
                VALX(I) = Z(I) + ZMED0
              ENDDO
            ENDIF
            ICALSU = ICOUPSU
            VISO = VCOUP
            IFVISO = 1
            CALL CALSUR(1)
            DO I=1,NUMNP
              VALX(I) = VALXB(I)
            ENDDO
          ENDIF
          IF (IRQ.EQ.-2) THEN
            IQUEST = 3503
          ELSE
            IQUEST = 0
          ENDIF
c          GEOM = .TRUE.
          CALL ROTATE(0)
          GOTO 5000
        ELSE
          CALL ROTATE(0)
          GOTO 5002
        ENDIF
      ELSE
        GOTO 5002
      ENDIF
C
C Type de fleche (~) (dernier caractere dispo)
C
 3504 IF (IFVIT.NE.0) THEN
        III = IABS(ITYPFL)
        III = III+1
        IF (III.GT.4) III = 1
        IF (ITYPFL.GT.0) THEN
          ITYPFL = III
        ELSE
          ITYPFL = -III
        ENDIF
        GOTO 5001
      ELSE
        GOTO 5002
      ENDIF
C
C Anglais / Francais
C
 3505 IF (ILANG.EQ.0) THEN
        ILANG = 1
        IF (ELEMENTS.EQ.'Hexaèdres 27 noeuds')
     &       ELEMENTS = 'Hexaedrons 27 nodes'
        IF (ELEMENTS.EQ.'Hexaèdres 8 noeuds')
     &       ELEMENTS = 'Hexaedrons 8 nodes'
        IF (ELEMENTS.EQ.'Tetraèdres') THEN
          ELEMENTS = 'Tetraedrons'
          LELEM = 11
        ENDIF
      ELSE
        ILANG = 0
        IF (ELEMENTS.EQ.'Hexaedrons 27 nodes')
     &       ELEMENTS = 'Hexaèdres 27 noeuds'
        IF (ELEMENTS.EQ.'Hexaedrons 8 nodes')
     &       ELEMENTS = 'Hexaèdres 8 noeuds'
        IF (ELEMENTS.EQ.'Tetraedrons') THEN
          ELEMENTS = 'Tetraèdres'
          LELEM = 10
        ENDIF
      ENDIF
      IREFRE = 1
      CALL INFO(XDMAX,XDMA2,YDMIN,YDMAX,NSURF)
      CALL INITBOUT
      IBOUBOU = 0
      CALL HELP(XDMIN,XHELP,YDMI2,YDMAX,IREFRE,ITYP,IOPT,IBOUBOU)
      GOTO 5002
C
 999  CALL TABCOL(0,IWAVE)
      CALL FSTERM(0)
      CALL ECOPT(0)
      END
C-----------------------------------------------------------------------
      SUBROUTINE ECRMEM
      INCLUDE 'com_coor.f'
      INCLUDE 'com_faces.f'
      INCLUDE 'com_options.f'
C
      XMPO = ( 44.*REAL(NPMAX) )*4./1048576.
      XMFA = ( 84.*REAL(NFMAX) + 4.*REAL(NTMAX)
     &           + REAL(NEMAX) + 8.*REAL(NCMAX)
     &                         +14.*REAL(NOMAX) )*4./1048576.
      IF (ILANG.EQ.0) THEN
        WRITE(*,3131) NPMAX,XMPO,NFMAX,XMFA,XMPO+XMFA
      ELSE
        WRITE(*,3132) NPMAX,XMPO,NFMAX,XMFA,XMPO+XMFA
      ENDIF
 3131 FORMAT(/'Nombre max de noeuds : NPMAX =',I8,' -->',F6.1,' Mo',
     &       /'Nombre max de faces  : NFMAX =',I8,' -->',F6.1,' Mo',
     &       /'                     ---> Mémoire totale >',F6.1,' Mo',/)
 3132 FORMAT(/'Max number of nodes:  NPMAX =',I8,' -->',F6.1,' Mo',
     &       /'Max number of facets: NFMAX =',I8,' -->',F6.1,' Mo',
     &       /'                      ---> Total memory >',F6.1,' Mo',/)
      END
C-----------------------------------------------------------------------
      SUBROUTINE AFFCOORD(XCONT,YCONT,V1,V2,V3,IDIM,NUM)
      INCLUDE 'com_options.f'
      CHARACTER*40 CCOOR
C
      PIPI = PIXEL*2.
      CALL GSBND(XHELP+PIPI,XDMA2-PIPI,YDMI2+PIPI,YDMIN-PIPI)
      IF (IDIM.EQ.0) THEN
        CCOOR = '                                        '
        LL = 39
      ELSE
        IF (NUM.EQ.0) THEN
          LL = 0
        ELSE
          LL = 8
           WRITE(CCOOR(1:8),'(I7," ")') NUM
        ENDIF
        IF (IDIM.EQ.2) THEN
          WRITE(CCOOR(LL+1:LL+29),'("(",G13.5,",",G13.5,")")') V1,V2
          LL = LL+29
        ELSEIF(IDIM.EQ.3) THEN
          WRITE(CCOOR(LL+1:LL+31),'("(",2(G9.3,","),G9.3,")")') V1,V2,V3
          LL = LL+31
        ENDIF
      ENDIF
      CALL ASFCOL(0)
      CALL GSPATF(8)
      IF (IFONT8.EQ.9) THEN
        CALL GSLSS(9)
      ELSE
        CALL GSLSS(0)
      ENDIF
      CALL AFFICHE_COMPTEUR(XCONT,YCONT,LL,CCOOR,6)
      END
