Cfj      SUBROUTINE REDUITC(C,L,L0)
Cfj      CHARACTER*1 C(*)
CfjC
Cfj      L0 = 0
Cfj 10   L0 = L0+1
Cfj      IF (C(L0).EQ.' ') GOTO 10
Cfj      IF (C(L0).EQ.'.'.AND.L0.GT.1) THEN
Cfj        L0 = L0-1
Cfj        C(L0) = '0'
Cfj      ENDIF
Cfj      LL = L
Cfj 1    CONTINUE
Cfj      IF (C(LL).EQ.' ') THEN
Cfj        LL = LL-1
Cfj        GOTO 1
Cfj      ENDIF
Cfj      IF (C(LL).EQ.'.') THEN
Cfj        C(LL) = ' '
Cfj        L = LL-1
Cfj        RETURN
Cfj      ELSE
Cfj        IAUTRE = 0
Cfj        IEXPO = 0
Cfj        DO I=L0,LL
Cfj          IF (C(I).NE.'-'.AND.C(I).NE.'+'.AND.C(I).NE.'.'
Cfj     &   .AND.C(I).NE.' '.AND.C(I).NE.'0'
Cfj     &   .AND.C(I).NE.'1'.AND.C(I).NE.'2'.AND.C(I).NE.'3'
Cfj     &   .AND.C(I).NE.'4'.AND.C(I).NE.'5'.AND.C(I).NE.'6'
Cfj     &   .AND.C(I).NE.'7'.AND.C(I).NE.'8'.AND.C(I).NE.'9') IAUTRE=1
Cfj          IF (C(I).EQ.'e'.OR.C(I).EQ.'E') IEXPO = I
Cfj        ENDDO
Cfj        IF (IAUTRE.NE.0) THEN
Cfj          IF (IEXPO.NE.0.AND.IEXPO+2.LE.LL
Cfj     &   .AND.(C(IEXPO+1).EQ.'+'.OR.C(IEXPO+1).EQ.'-')) THEN
Cfj            II = 0
Cfj 3          IF (C(IEXPO-II-1).EQ.'0') THEN
Cfj              II = II+1
Cfj              GOTO 3
Cfj            ENDIF
Cfj            IF (II.NE.0) THEN
Cfj              DO I=IEXPO-II,LL
Cfj                C(I) = C(I+II)
Cfj              ENDDO
Cfj              LL = LL-II
Cfj              IEXPO = IEXPO-II
Cfj            ENDIF
CfjC
Cfj            IDIX = 1
Cfj            IPUI = 0
Cfj            DO I=LL,IEXPO+2,-1
Cfj              IPUI = IPUI + IDIX*(ICHAR(C(I))-48)
Cfj              IDIX = IDIX*10
Cfj            ENDDO
Cfj            IF (IPUI.LE.4) THEN
Cfj              IPOINT = 0
Cfj              DO I=L0,IEXPO-1
Cfj                IF (C(I).EQ.'.') IPOINT=I
Cfj              ENDDO
Cfj              IF (C(IEXPO+1).EQ.'-') THEN
Cfj                IF (IPOINT.NE.0.AND.IEXPO-1.GE.IPOINT+1) THEN
Cfj                  DO I=IEXPO-1,IPOINT+1,-1
Cfj                    C(I+IPUI) = C(I)
Cfj                  ENDDO
Cfj                  DO I=1,IPUI
Cfj                    C(IPOINT+I) = '0'
Cfj                  ENDDO
Cfj                  LL = IEXPO-1+IPUI
Cfj                ENDIF
Cfj              ELSE
Cfj                IF (IPUI.GT.(IEXPO-IPOINT-1)) THEN
Cfj                  II = IPUI-IEXPO+IPOINT+1
Cfj                  DO I=1,II
Cfj                    C(IEXPO+I-1) = '0'
Cfj                  ENDDO
Cfj                  LL = IEXPO+II-1
Cfj                ELSE
Cfj                  LL = IEXPO-1
Cfj                ENDIF
Cfj                DO I=IPOINT,IPOINT+IPUI
Cfj                  C(I) = C(I+1)
Cfj                ENDDO
Cfj                C(IPOINT+IPUI+1) = '.'
Cfj                IF (C(LL).EQ.'.') LL = LL-1
Cfj                IF (C(L0).EQ.'0') THEN
Cfj                  DO I=L0+1,LL
Cfj                    C(I-1) = C(I)
Cfj                  ENDDO
Cfj                  LL = LL-1
Cfj                ENDIF
Cfj              ENDIF
Cfj            ENDIF
Cfj          ENDIF
Cfj          L = LL
Cfj          RETURN
Cfj        ENDIF
Cfj      ENDIF
Cfj      LL0 = LL
Cfj 2    CONTINUE
Cfj      IF (C(LL).EQ.'0') THEN
Cfj        LL = LL-1
Cfj        GOTO 2
Cfj      ELSEIF (C(LL).EQ.'.') THEN
Cfj        LL = LL-1
Cfj      ENDIF
Cfj      IF (LL.NE.LL0) THEN
Cfj        DO I=LL+1,LL0
Cfj          C(I) = ' '
Cfj        ENDDO
Cfj      ENDIF
Cfj      L = LL
Cfj      END
CfjC=======================================================================
      SUBROUTINE MYENCO(X,C)
      CHARACTER*7 C
C      
      IF (X.LT.0.0001.OR.X.GT.99999.) THEN
        WRITE (C,'(G7.1)') X
      ELSE
        IF (X.GT.1000.) THEN
          WRITE (C,'(F7.0)') X
        ELSEIF (X.GE.100.) THEN
          WRITE (C,'(F7.2)') X
        ELSEIF (X.GE.10.) THEN
          WRITE (C,'(F7.3)') X
        ELSEIF (X.GE.1.) THEN
          WRITE (C,'(F7.4)') X
        ELSE
          WRITE (C,'(F7.5)') X
        ENDIF
      ENDIF
      END
      SUBROUTINE ECR16COUL(I,ILANG)
C
      IF (ILANG.EQ.0) THEN
      PRINT*,'Couleurs disponibles (couleur courante',I,') :'
      PRINT*,' 0 : Noir (Blanc) |  1 : Rouge        |  2 : Vert'
      PRINT*,' 3 : Bleu         |  4 : Cyan         |  5 : Jaune'
      PRINT*,' 6 : Magenta      |  7 : Blanc (noir) |  8 : Gris clair'
      PRINT*,' 9 : Framboise    | 10 : Vert pâle    | 11 : Bleu gris'
      PRINT*,'12 : Bleu pâle    | 13 : Cyan foncé   | 14 : Mauve'
      PRINT*,'15 : Gris foncé'
      ELSE
      PRINT*,'Available colors: (current color',I,') :'
      PRINT*,' 0 : Black (white) |  1 : Red           |  2 : Green'
      PRINT*,' 3 : Blue          |  4 : Cyan          |  5 : Yellow'
      PRINT*,' 6 : Magenta       |  7 : White (black) |  8 : Light gray'
      PRINT*,' 9 : Deep pink     | 10 : Light green   | 11 : Slate blue'
      PRINT*,'12 : Light blue    | 13 : Dark cyan     | 14 : Purple'
      PRINT*,'15 : Dark gray'
      ENDIF
      END
C-----------------------------------------------------------------------
      SUBROUTINE ECR16COULB(ILANG)
C
      IF (ILANG.EQ.0) THEN
      PRINT*,'Couleurs disponibles :'
      PRINT*,' 0 : Noir         |  1 : Rouge        |  2 : Vert'
      PRINT*,' 3 : Bleu         |  4 : Cyan         |  5 : Jaune'
      PRINT*,' 6 : Magenta      |  7 : Blanc        |  8 : Gris clair'
      PRINT*,' 9 : Framboise    | 10 : Vert pâle    | 11 : Bleu gris'
      PRINT*,'12 : Bleu pâle    | 13 : Cyan foncé   | 14 : Mauve'
      PRINT*,'15 : Gris foncé'
      ELSE
      PRINT*,'Available colors:'
      PRINT*,' 0 : Black         |  1 : Red           |  2 : Green'
      PRINT*,' 3 : Blue          |  4 : Cyan          |  5 : Yellow'
      PRINT*,' 6 : Magenta       |  7 : White         |  8 : Light gray'
      PRINT*,' 9 : Deep pink     | 10 : Light green   | 11 : Slate blue'
      PRINT*,'12 : Light blue    | 13 : Dark cyan     | 14 : Purple'
      PRINT*,'15 : Dark gray'
      ENDIF
      END
C-----------------------------------------------------------------------
      SUBROUTINE ECRIT(XC,YC,DX,I)
      CHARACTER*5  CNUMER
      WRITE(CNUMER,'(I5)') I
      IF (I.GT.9999) THEN
        CALL GSCHAR(XC-5.*DX,YC,5,CNUMER)
      ELSEIF (I.GT.999) THEN
        CALL GSCHAR(XC-4.*DX,YC,4,CNUMER(2:5))
      ELSEIF (I.GT.99) THEN
        CALL GSCHAR(XC-3.*DX,YC,3,CNUMER(3:5))
      ELSEIF (I.GT.9) THEN
        CALL GSCHAR(XC-2.*DX,YC,2,CNUMER(4:5))
      ELSE
        CALL GSCHAR(XC-DX,YC,1,CNUMER(5:5))
      ENDIF
      END
C-----------------------------------------------------------------------
      SUBROUTINE TRATMP(NOM_FICH,BIDON,LONG,LONGB)
      CHARACTER*128 NOM_FICH,BIDON
      ISLASH = 0
      DO I=1,LONG
        IF (NOM_FICH(I:I).EQ.'/') ISLASH = I
      ENDDO
      LONGB = LONG-ISLASH+5
      BIDON(1:LONGB) = '/tmp/'//NOM_FICH(ISLASH+1:LONG)
      END
C-----------------------------------------------------------------------
      SUBROUTINE LISTEFICH(ILANG,SUF,LSUF,NBSUF)
      CHARACTER*512 BID
      CHARACTER*8 SUF(*)
      INTEGER     LSUF(*)
C
      PRINT*,' '
      IF (ILANG.EQ.0) THEN
        PRINT*,'Liste des fichiers valides :'
      ELSE
        PRINT*,'Valid list of files:'
      ENDIF
      PRINT*,' '
      BID(1:2) = 'ls'
      L = 3
      DO K=1,NBSUF
        LL = L + LSUF(K) + 2
        BID(L:LL) = ' *.'//SUF(K)(1:LSUF(K))
        L = LL+1
      ENDDO
      CALL EXEC(BID(1:LL))
      PRINT*,' '
      END
C=======================================================================
      SUBROUTINE ECHR(X,Y)
      XBID = X
      X = Y
      Y = XBID
      END
C=======================================================================
      subroutine delaun2(x,y,numnp,nbt,cr,xh,ic,itri,iref,itmp,iclas
     &                  ,ilang)
      dimension x(*),y(*),cr(2,*),xh(*)
      integer   isd(2,1),iar(2,1),ic(*),itri(*),iref(*)
     &         ,itmp(*),iclas(7,*)
c
c
c On essaie d'eviter le message 'points confondus' quand on a des
c domaines tres alonges
c
      xmin = 1.e30
      xmax = -1.e30
      ymin = 1.e30
      ymax = -1.e30
      do i=1,numnp
        xmin = min(xmin,x(i))
        xmax = max(xmax,x(i))
        ymin = min(ymin,y(i))
        ymax = max(ymax,y(i))
      enddo
      rap = (xmax-xmin)/(ymax-ymin)
c      print*,rap
      if (rap.gt.10.) then
        raprap = rap*0.1
        do i=1,numnp
          cr(1,i) = x(i)
          cr(2,i) = y(i)*raprap
        enddo
      elseif(rap.lt.0.1) then
        raprap = rap*10.
        do i=1,numnp
          cr(1,i) = x(i)*raprap
          cr(2,i) = y(i)
        enddo
      else
        do i=1,numnp
          cr(1,i) = x(i)
          cr(2,i) = y(i)
        enddo
      endif
cc      nnh = nn+1
      do i=1,numnp-1
        xh(i) = sqrt(.5*((cr(1,i)-cr(1,i+1))**2+(cr(2,i)-cr(2,i+1))**2))
      enddo
      xh(numnp) = xh(numnp-1)
      nba = 0
      isd(1,1) = -1
      isd(2,1) = 1
      nbsd = 1
      iop = 5
      puis = .25
      coef = 0.75
Cfj      nnc = nn+1
Cfj      nntri = nnc+2*numnp
Cfj      nnref = nntri+4*numnp+2
Cfj      nchck = nnref+2*numnp
      nbs = numnp
      nbsmx = nbs
      call mshptg(cr,xh,ic,itmp,nbs,nbsmx,itri,iar,nba,isd,nbsd,iref
     &           ,nbt,coef,puis,iop,ierr,ilang)
      if (ierr.ne.0) then
        print*,'**** Code retour',ierr,nbs,nbt
        stop
      endif
      nn = 0
      do i=1,nbt
        nn = nn+1
        iclas(1,i) = itmp(nn)
        nn = nn+1
        iclas(2,i) = itmp(nn)
        nn = nn+1
        iclas(3,i) = itmp(nn)
        iclas(4,i) = 0
        iclas(5,i) = 0
        iclas(6,i) = 0
        iclas(7,i) = 0
      enddo
      end
C=======================================================================
      SUBROUTINE LONGUEUR(CHAINE,LONG)
      CHARACTER*64 CHAINE
      IDEB=0
 10   IDEB=IDEB+1
      IF(CHAINE(IDEB:IDEB).EQ.' ') GOTO 10
C
      IFIN = 65-IDEB
 20   IFIN=IFIN-1
      IF(CHAINE(IFIN:IFIN).EQ.' ') GOTO 20
C
      LONG = IFIN+1-IDEB
      END
C=======================================================================
      SUBROUTINE ORDONN(N1,N2,N3,N4,M1,M2,M3,M4)
      INTEGER N(4),ISUIV(4)
      DATA ISUIV / 2,3,4,1 /
C
      N(1) = N1
      N(2) = N2
      N(3) = N3
      N(4) = N4
      NMIN = N(1)
      IMIN = 1
      DO I=2,4
        IF (N(I).LT.NMIN) THEN
          NMIN = N(I)
          IMIN = I
        ENDIF
      ENDDO
      M1 = N(IMIN)
      I = ISUIV(IMIN)
      M2 = N(I)
      I = ISUIV(I)
      M3 = N(I)
      M4 = N(ISUIV(I))
      END
C=======================================================================
      SUBROUTINE ORDON2(N1,N2,N3,M1,M2,M3)
      INTEGER N(3),ISUIV(3)
      DATA ISUIV / 2,3,1 /
C
      N(1) = N1
      N(2) = N2
      N(3) = N3
      NMIN = N(1)
      IMIN = 1
      DO I=2,3
        IF (N(I).LT.NMIN) THEN
          NMIN = N(I)
          IMIN = I
        ENDIF
      ENDDO
      M1 = N(IMIN)
      I = ISUIV(IMIN)
      M2 = N(I)
      M3 = N(ISUIV(I))
      END
