      SUBROUTINE LIISO(BIDON,CBIDON,LBID,IRC,ICONTR,IDEPL,IVAL)
C
      INCLUDE 'com_coor.f'
      INCLUDE 'com_faces.f'
      INCLUDE 'com_options.f'
      REAL*8 XBIDON,XXBIDON(27)
      DIMENSION XTRONC(27)
      CHARACTER*(*) CBIDON
      INTEGER IBIDON(2),IP8(4,6),ISHIFT(4,4)
      DIMENSION BIDON(*),BIDON2(2)
      EQUIVALENCE (BIDON2,IBIDON)
      DATA IP8  / 5,8,4,1
     &           ,2,3,7,6
     &           ,5,1,2,6
     &           ,4,8,7,3
     &           ,1,4,3,2
     &           ,8,5,6,7 /
      DATA ISHIFT / 1,2,3,4 , 4,1,2,3 , 3,4,1,2 , 2,3,4,1 /
C
      IFISO = 1
      IRC = 0
C
      IF (IARCH.LT.0) THEN
        CALL LITITRE(2,NUMNP2,IERR)
      ELSEIF(IARCH.EQ.1) THEN
        CALL litrecbin(2,BIDON2,LLL,0)
        NUMNP2 = IBIDON(1)
      ELSE
        READ(2) NUMNP2
      ENDIF
      IF (NUMNP2.EQ.NUMNP) THEN
        ICENTR = 0
      ELSEIF(NUMNP2.EQ.NEL.AND.IVAL.EQ.4) THEN
        ICENTR = 0
      ELSEIF(NUMNP2.EQ.NF.OR.NUMNP2.EQ.NEL) THEN
        ICENTR = 1
      ELSEIF(NUMNP2.GT.NUMNP) THEN
        ICENTR = 0
        IF (ISTDOUT.EQ.0) THEN
          PRINT*,' '
          IF (ILANG.EQ.0) THEN
            PRINT*,'*** Bizarre :',NUMNP,' noeuds et',NUMNP2,' valeurs'
          ELSE
            PRINT*,'*** Strange:',NUMNP,' nodes and',NUMNP2,' values'
          ENDIF
        ENDIF
      ELSE
        IF (ISTDOUT.EQ.0) THEN
          PRINT*,' '
          IF (ILANG.EQ.0) THEN
            PRINT*,'*** Fichier pas compatible. Il faut',NUMNP,
     &           ' noeuds et je n''en trouve que',NUMNP2
          ELSE
            PRINT*,'*** Bad file. I need',NUMNP,
     &           ' nodes and I found only',NUMNP2
          ENDIF
        ENDIF
        IRC = 1
        CALL TUELEGNEW
        RETURN
      ENDIF
      IF (ICENTR.EQ.0) THEN
        IF (ISTDOUT.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,'aux noeuds'
          ELSE
            PRINT*,'at nodes'
          ENDIF
        ENDIF
        IF (ISO.EQ.3) ISO = 1
        ICENTRISO = 0
      ELSE
        IF (ISTDOUT.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,'au centre des cellules'
          ELSE
            PRINT*,'piecewise constant'
          ENDIF
        ENDIF
        IF (ISO.NE.0.AND.ISO.NE.3) ISO = 3
      ENDIF
      VMIN = BIG
      VMAX = -BIG
      IFBIG = 0
      IF (ICENTR.EQ.0) THEN
C
C EF discontinus (pas fini)
C pas fait pour les Q2 27 noeuds
C En fait ca ne marche pour le moment que pour le 2d, i.e.
C triangles et quadrangles et Q2 (9 noeuds) (5/2002)
C et Q1 3d (8 noeuds)
C
C pas fait pour les fichiers binaires
C
        IF (IVAL.EQ.4) THEN
          IF (NUMNP2.EQ.NF) THEN
            DO I=1,NEL
              READ(2,*) (XXBIDON(K),K=1,NDSEL)
              DO K=1,NDSEL
                CALL TRONQUE(XXBIDON(K),VALF(K,I),IFBIG)
                VMIN = MIN(VMIN,VALF(K,I))
                VMAX = MAX(VMAX,VALF(K,I))
              ENDDO
            ENDDO
          ELSEIF(NDSEL.EQ.9) THEN
            J = 1
            DO I=1,NEL
              READ(2,*) (XXBIDON(K),K=1,NDSEL)
              DO K=1,NDSEL
                CALL TRONQUE(XXBIDON(K),XTRONC(K),IFBIG)
                VMIN = MIN(VMIN,XTRONC(K))
                VMAX = MAX(VMAX,XTRONC(K))
              ENDDO
              VALF(1,J) = XTRONC(9)
              VALF(2,J) = XTRONC(5)
              VALF(3,J) = XTRONC(2)
              VALF(4,J) = XTRONC(6)
              J = J+1
              VALF(1,J) = XTRONC(9)
              VALF(2,J) = XTRONC(6)
              VALF(3,J) = XTRONC(3)
              VALF(4,J) = XTRONC(7)
              J = J+1
              VALF(1,J) = XTRONC(9)
              VALF(2,J) = XTRONC(7)
              VALF(3,J) = XTRONC(4)
              VALF(4,J) = XTRONC(8)
              J = J+1
              VALF(1,J) = XTRONC(9)
              VALF(2,J) = XTRONC(8)
              VALF(3,J) = XTRONC(1)
              VALF(4,J) = XTRONC(5)
              J = J+1
            ENDDO
          ELSEIF(NDSEL.EQ.8) THEN
            JJMIN = 1
            DO I=1,NEL
              READ(2,*) (XXBIDON(K),K=1,NDSEL)
              DO K=1,NDSEL
                CALL TRONQUE(XXBIDON(K),XTRONC(K),IFBIG)
                VMIN = MIN(VMIN,XTRONC(K))
                VMAX = MAX(VMAX,XTRONC(K))
              ENDDO
              IIII = 0
              JMIN = JJMIN
              DO J=JMIN,NF
                IF (NNUMFA(J).EQ.I) THEN
                  IIII = IIII+1
                  N = NRFAC(J)
                  IF (N.GE.1.AND.N.LE.6) THEN
C
C a cause de la permutation initiale dans les noeuds des faces (ORDONN)
C on est oblige de faire ce trafic
C
                    II = (I-1)*NDSEL
                    MIMI = MIN(NODEL(II+IP8(1,N)),NODEL(II+IP8(2,N))
     &                        ,NODEL(II+IP8(3,N)),NODEL(II+IP8(4,N)))
                    IF (MIMI.EQ.NODEL(II+IP8(1,N))) THEN
cc                      IMI = 1
                      DO K=1,4
                        KK = IP8(K,N)
                        VALF(K,J) = XTRONC(KK)
                      ENDDO
                    ELSE
                      IF (MIMI.EQ.NODEL(II+IP8(2,N))) THEN
                        IMI = 2
                      ELSEIF(MIMI.EQ.NODEL(II+IP8(3,N))) THEN
                        IMI = 3
                      ELSE
                        IMI = 4
                      ENDIF
                      DO K=1,4
                        KK = IP8(K,N)
                        KKK = ISHIFT(K,IMI)
                        VALF(KKK,J) = XTRONC(KK)
                      ENDDO
                    ENDIF
                  ELSE
                    PRINT*,'*** biz',I,J,N
                  ENDIF
                  JJMIN = J+1
                  IF (IIII.EQ.-ITAB(I)) GOTO 1113
                ENDIF
              ENDDO
 1113         CONTINUE
            ENDDO
          ELSE
c
c revoir le 3d (4 noeuds tetra, 27)
c ???
            JJMIN = 1
            DO I=1,NEL
              READ(2,*) (XXBIDON(K),K=1,NDSEL)
              DO K=1,NDSEL
                CALL TRONQUE(XXBIDON(K),BID,IFBIG)
                VMIN = MIN(VMIN,BID)
                VMAX = MAX(VMAX,BID)
                IF (ITAB(I).GT.0) THEN
                  VALF(5,ITAB(I)) = BID
                ELSEIF(ITAB(I).LT.0) THEN
                  IIII = 0
                  JMIN = JJMIN
                  DO J=JMIN,NF
                    IF (NNUMFA(J).EQ.I) THEN
                      IIII = IIII+1
                      IF (J.EQ.JJMIN) JJMIN=JJMIN+1
c revoir (27 noeuds)
c                      VALF(K,J) = BID
                      IF (IIII.EQ.-ITAB(I)) GOTO 1114
                    ENDIF
                  ENDDO
                ENDIF
 1114           CONTINUE
              ENDDO
            ENDDO
          ENDIF
          CALL WARNINGBIG(IFBIG)
        ELSE
          IF (IARCH.LT.0) THEN
            DO I=1,NUMNP
              READ(2,*) XBIDON
              CALL TRONQUE(XBIDON,VALX(I),IFBIG)
              VMIN = MIN(VMIN,VALX(I))
              VMAX = MAX(VMAX,VALX(I))
            ENDDO
            CALL WARNINGBIG(IFBIG)
          ELSE
            IF (IARCH.EQ.1) THEN
              CALL litrecbin(2,VALX,LLL,0)
            ELSE
              READ(2) (VALX(I),I=1,NUMNP)
            ENDIF
            DO I=1,NUMNP
              VMIN = MIN(VMIN,VALX(I))
              VMAX = MAX(VMAX,VALX(I))
            ENDDO
          ENDIF
        ENDIF
      ELSE
        DO I=1,NUMNP
          ITOUCH(I) = 0
          VALX(I) = 0.
        ENDDO
        IF (NUMNP2.EQ.NF) THEN
          IF (IARCH.LT.0) THEN
            DO I=1,NF
              READ(2,*) XBIDON
              CALL TRONQUE(XBIDON,VALF(5,I),IFBIG)
              VMIN = MIN(VMIN,VALF(5,I))
              VMAX = MAX(VMAX,VALF(5,I))
              DO K=1,NDS
                N = NFAC(K,I)
                VALX(N) = VALX(N) + VALF(5,I)
                ITOUCH(N) = ITOUCH(N) + 1
              ENDDO
            ENDDO
          ELSE
            IF (IARCH.EQ.1) THEN
              CALL litrecbin(2,BIDON,LLL,0)
            ELSE
              READ(2) (BIDON(I),I=1,NF)
            ENDIF
            DO I=1,NF
              VALF(5,I) = BIDON(I)
              VMIN = MIN(VMIN,VALF(5,I))
              VMAX = MAX(VMAX,VALF(5,I))
              DO K=1,NDS
                N = NFAC(K,I)
                VALX(N) = VALX(N) + VALF(5,I)
                ITOUCH(N) = ITOUCH(N) + 1
              ENDDO
            ENDDO
          ENDIF
        ELSE
          IF (NDSEL.EQ.9) THEN
            J = 1
            IF (IARCH.LT.0) THEN
              DO I=1,NEL
                READ(2,*) XBIDON
                CALL TRONQUE(XBIDON,VALF(5,J),IFBIG)
                VMIN = MIN(VMIN,VALF(5,J))
                VMAX = MAX(VMAX,VALF(5,J))
                VALF(5,J+1) = VALF(5,J)
                VALF(5,J+2) = VALF(5,J)
                VALF(5,J+3) = VALF(5,J)
                II = (I-1)*NDSEL
                DO K=1,NDSEL
                  N = NODEL(II+K)
                  VALX(N) = VALX(N) + VALF(5,J)
                  ITOUCH(N) = ITOUCH(N) + 1
                ENDDO
                J = J+4
              ENDDO
            ELSE
              IF (IARCH.EQ.1) THEN
                CALL litrecbin(2,BIDON,LLL,0)
              ELSE
                READ(2) (BIDON(I),I=1,NEL)
              ENDIF
              DO I=1,NEL
                VALF(5,J) = BIDON(I)
                VMIN = MIN(VMIN,VALF(5,J))
                VMAX = MAX(VMAX,VALF(5,J))
                VALF(5,J+1) = VALF(5,J)
                VALF(5,J+2) = VALF(5,J)
                VALF(5,J+3) = VALF(5,J)
                II = (I-1)*NDSEL
                DO K=1,NDSEL
                  N = NODEL(II+K)
                  VALX(N) = VALX(N) + VALF(5,J)
                  ITOUCH(N) = ITOUCH(N) + 1
                ENDDO
                J = J+4
              ENDDO
            ENDIF
          ELSE
            JJMIN = 1
            IF (IARCH.LT.0) THEN
              DO I=1,NEL
                READ(2,*) XBIDON
                CALL TRONQUE(XBIDON,BID,IFBIG)
                VMIN = MIN(VMIN,BID)
                VMAX = MAX(VMAX,BID)
                IF (ITAB(I).GT.0) THEN
                  VALF(5,ITAB(I)) = BID
                ELSEIF(ITAB(I).LT.0) THEN
                  IIII = 0
                  JMIN = JJMIN
                  DO J=JMIN,NF
                    IF (NNUMFA(J).EQ.I) THEN
                      IIII = IIII+1
                      IF (J.EQ.JJMIN) JJMIN=JJMIN+1
                      VALF(5,J) = BID
                      IF (IIII.EQ.-ITAB(I)) GOTO 1111
                    ENDIF
                  ENDDO
                ENDIF
 1111           CONTINUE
                II = (I-1)*NDSEL
                DO K=1,NDSEL
                  N = NODEL(II+K)
                  VALX(N) = VALX(N) + BID
                  ITOUCH(N) = ITOUCH(N) + 1
                ENDDO
              ENDDO
            ELSE
              IF (IARCH.EQ.1) THEN
                CALL litrecbin(2,BIDON,LLL,0)
              ELSE
                READ(2) (BIDON(I),I=1,NEL)
              ENDIF
              DO I=1,NEL
                BID = BIDON(I)
                VMIN = MIN(VMIN,BID)
                VMAX = MAX(VMAX,BID)
                IF (ITAB(I).GT.0) THEN
                  VALF(5,ITAB(I)) = BID
                ELSEIF(ITAB(I).LT.0) THEN
                  IIII = 0
                  JMIN = JJMIN
                  DO J=JMIN,NF
                    IF (NNUMFA(J).EQ.I) THEN
                      IIII = IIII+1
                      IF (J.EQ.JJMIN) JJMIN=JJMIN+1
                      VALF(5,J) = BID
                      IF (IIII.EQ.-ITAB(I)) GOTO 1112
                    ENDIF
                  ENDDO
                ENDIF
 1112           CONTINUE
                II = (I-1)*NDSEL
                DO K=1,NDSEL
                  N = NODEL(II+K)
                  VALX(N) = VALX(N) + BID
                  ITOUCH(N) = ITOUCH(N) + 1
                ENDDO
              ENDDO
            ENDIF
          ENDIF
        ENDIF
        CALL WARNINGBIG(IFBIG)
        DO I=1,NUMNP
          IF (ITOUCH(I).GT.0) VALX(I) = VALX(I)/REAL(ITOUCH(I))
        ENDDO
      ENDIF
      CLOSE(2)
C
      IF (ICONTR.EQ.1) THEN
        IF (IVAL.EQ.4) THEN
          IF (NDS.EQ.3) THEN
            US3 = 1./3.
            DO I=1,NF
              VALF(5,I) = (VALF(1,I)+VALF(2,I)+VALF(3,I))*US3
            ENDDO
          ELSE
            DO I=1,NF
              VALF(5,I) = (VALF(1,I)+VALF(2,I)+VALF(3,I)+VALF(4,I))*0.25
            ENDDO
          ENDIF
          IF (NF.LT.NF4) THEN
            DO I=NF+1,NF4
              II = 1 + MOD(I-1,NF)
              IF (I.GT.3*NF) THEN
                DO K=1,NDS
                  VALF(K,I) = VALF(K,II)
                ENDDO
              ELSE
                VALF(1,I) = VALF(1,II)
                VALF(2,I) = VALF(NDS,II)
                VALF(3,I) = VALF(NDS-1,II)
                IF (NDS.NE.3) VALF(4,I) = VALF(2,II)
              ENDIF
              VALF(5,I) = VALF(5,II)
            ENDDO
          ENDIF
        ELSE
          DO I=1,NF4
            IF (I.GT.3*NF) THEN
              VALF(5,I) = VALF(5,I-3*NF)
            ELSEIF(I.GT.2*NF) THEN
              VALF(5,I) = VALF(5,I-2*NF)
            ELSEIF(I.GT.NF) THEN
              VALF(5,I) = VALF(5,I-NF)
            ENDIF
            DO K=1,NDS
              VALF(K,I) = VALX(NFAC(K,I))
            ENDDO
          ENDDO
        ENDIF
      ELSE
        IF (IVAL.EQ.4) THEN
          IF (NDS.EQ.3) THEN
            US3 = 1./3.
            DO I=1,NF
              VALF(5,I) = (VALF(1,I)+VALF(2,I)+VALF(3,I))*US3
            ENDDO
          ELSE
            DO I=1,NF
              VALF(5,I) = (VALF(1,I)+VALF(2,I)+VALF(3,I)+VALF(4,I))*0.25
            ENDDO
          ENDIF
          IF (NF.LT.NF4) THEN
            DO I=NF+1,NF4
              II = 1 + MOD(I-1,NF)
              IF (I.GT.3*NF) THEN
                DO K=1,NDS
                  VALF(K,I) = VALF(K,II)
                ENDDO
              ELSE
                VALF(1,I) = -VALF(1,II)
                VALF(2,I) = -VALF(NDS,II)
                VALF(3,I) = -VALF(NDS-1,II)
                IF (NDS.NE.3) VALF(4,I) = -VALF(2,II)
              ENDIF
              VALF(5,I) = VALF(5,II)
            ENDDO
          ENDIF
        ELSE
          DO I=1,NF4
            IF (I.GT.3*NF) THEN
              VALF(5,I) = VALF(5,I-3*NF)
              DO K=1,NDS
                VALF(K,I) = VALX(NFAC(K,I-3*NF))
              ENDDO
            ELSEIF(I.GT.2*NF) THEN
              VALF(5,I) = -VALF(5,I-2*NF)
              DO K=1,NDS
                IF (K.EQ.2) THEN
                  KK = 4
                ELSEIF(K.EQ.4) THEN
                  KK = 2
                ELSE
                  KK = K
                ENDIF
                VALF(K,I) = -VALX(NFAC(KK,I-2*NF))
              ENDDO
            ELSEIF(I.GT.NF) THEN
              VALF(5,I) = -VALF(5,I-NF)
              DO K=1,NDS
                IF (K.EQ.2) THEN
                  KK = 4
                ELSEIF(K.EQ.4) THEN
                  KK = 2
                ELSE
                  KK = K
                ENDIF
                VALF(K,I) = -VALX(NFAC(KK,I-NF))
              ENDDO
            ELSE
              DO K=1,NDS
                VALF(K,I) = VALX(NFAC(K,I))
              ENDDO
            ENDIF
          ENDDO
        ENDIF
      ENDIF
      IF (I2D.NE.0.AND.IDEFOR.NE.1.AND.IDEPL.EQ.1) THEN
        IEXAG = 1
        FACEXA = 0.
        IDEFOR = 2
        DO I=1,NUMNP
          DEPX(I) = 0.
          DEPY(I) = 0.
          DEPZ(I) = VALX(I)
        ENDDO
        DEPMAX = MAX(ABS(VMIN),ABS(VMAX))
      ENDIF
      VMIN0 = VMIN
      VMAX0 = VMAX
C
      NOM_ISO(1:LBID) = CBIDON(1:LBID)
      LONISO = LBID
      CALL datefichier(NOM_ISO(1:LONISO)//CHAR(0),ID,IRC)
      IF (IRC.EQ.0) IDISO = ID
C Levelset
      IF (LONISO.GT.4.AND.NOM_ISO(LONISO-3:LONISO).EQ.'.psi'
     &   .AND.ITABLE.EQ.34) THEN
        VMAMA = MAX(ABS(VMIN),VMAX)
        VMIN = -VMAMA
        VMAX = VMAMA
        IVFIXE = 0
      ENDIF
C
      CALL METLEGNEW
      ISOBID = 0
C
      END
C=======================================================================
      SUBROUTINE TRONQUE(XX,X,IFLAG)
      INCLUDE 'com_options.f'
      REAL*8 XX
C
      IF (ABS(XX).LE.USBIG) THEN
          X = 0.
      ELSEIF(ABS(XX).GE.BIG) THEN
        IFLAG = IFLAG+1
        IF (XX.GT.0.D0) THEN
          X = BIG
        ELSE
          X = -BIG
        ENDIF
      ELSE          
          X = REAL(XX)
      ENDIF
      END
C=======================================================================
      SUBROUTINE WARNINGBIG(IFBIG)
      INCLUDE 'com_options.f'
C
      IF (IFBIG.NE.0) THEN
        IF (ISTDOUT.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,'*** ATTENTION le fichier contient',IFBIG,
     &             ' valeurs très grandes qui ont été tronquées'
          ELSE
            PRINT*,'*** WARNING: the file contains',IFBIG,
     &             ' very large values (truncated)'
          ENDIF
        ENDIF
      ENDIF
      END
C=======================================================================
      SUBROUTINE TUELEGNEW
      CHARACTER*132 LEGBID
      COMMON /TITRENEW/ LEGBID,LONLEGNEW,ILEGNEW,FACLEGNEW
      LONLEGNEW = 0
      END
C=======================================================================
      SUBROUTINE METLEGNEW
      INCLUDE 'com_options.f'
      CHARACTER*132 LEGBID
      COMMON /TITRENEW/ LEGBID,LONLEGNEW,ILEGNEW,FACLEGNEW
C
      IF (LONLEGNEW.GT.0) THEN
        ILEGAUTO = 1
        ILEGMAN = 0
        LONLEG = LONLEGNEW
        LEG(1:LONLEG) = LEGBID(1:LONLEG)
        FACLEG = FACLEGNEW
        IF (ILEG.GE.0) ILEG = MAX(1,ILEGNEW)
Cfj      ELSE
Cfj        ILEG = 0
      ENDIF
      END
C=======================================================================
      SUBROUTINE LITITRE(IFICH,N,IERR)
      INCLUDE 'com_options.f'
      CHARACTER*132 CBID,LEGBID
      COMMON /TITRENEW/ LEGBID,LONLEGNEW,ILEGNEW,FACLEGNEW
C
      REWIND(IFICH)
      NTITR = 0
      IERR  = 0
  10  READ(IFICH,'(A)',END=20,ERR=20) CBID
      IF (CBID(1:1).EQ.'#') THEN
        FACLEG = 0.
        IF (CBID(2:2).EQ.'+') THEN
          FACLEG = 1./.65
        ELSEIF(CBID(2:2).EQ.'-') THEN
          FACLEG = .45/.65
        ELSEIF(CBID(2:2).EQ.'=') THEN
          FACLEG = 1.
        ELSEIF(CBID(2:2).EQ.'^') THEN
          FACLEG = (1./.65)**2
        ENDIF
        IF (FACLEG.NE.0.) THEN
          CBID(2:2) = ' '
          IF (CBID(3:3).EQ.'|') THEN
            CBID(3:3) = ' '
            ISLEG = 1
          ELSE
            ISLEG = 0
          ENDIF
        ELSE
          FACLEG = 1.
        ENDIF
        NTITR = NTITR+1
        IF (NTITR.EQ.1) THEN
          CBID(1:1) = ' '
          CALL ENLEVE_TOUS_BLANCS(CBID,LL,132)
          LEGBID(1:LL) = CBID(1:LL)
        ENDIF
        GOTO 10
      ENDIF
      BACKSPACE(IFICH)
      IF (NTITR.NE.0) THEN
        LONLEGNEW = LL
        ILEGNEW = MAX(1,ILEG)
        IF (LONLEGNEW.GT.50) THEN
          FACLEGNEW = .45/.65
        ELSEIF(LONLEGNEW.GT.32) THEN
          FACLEGNEW = MIN(1.,FACLEG)
        ELSE
          FACLEGNEW = FACLEG
        ENDIF
      ELSE
        LONLEGNEW = 0
        ILEGNEW = 0
      ENDIF
      READ(IFICH,*,END=20,ERR=20) N
      RETURN
  20  IERR = 1
      END
C=======================================================================
      SUBROUTINE LICOUR(IRC)
C
      INCLUDE 'com_coor.f'
      INCLUDE 'com_faces.f'
      INCLUDE 'com_options.f'
      CHARACTER*1 CC
      CHARACTER*64 CBID
C
C Pour maillages structurés (c3d)
C
      CALL PREMIER_LIBRE(IFICH)
      OPEN(IFICH,FILE=NOM_COUR(1:LONCOUR),STATUS='OLD',IOSTAT=IERR)
      IF (IERR.NE.0) THEN
        IRC = -1
        RETURN
      ENDIF
      IRC = 0
 10   READ(IFICH,'(A1)',END=11,ERR=11) CC
      IF (CC.EQ.'#'.OR.CC.EQ.'%') GOTO 10
      BACKSPACE(IFICH)
      NPSUR = 0
      NSSUR = 0
      NBTROU = 0
      ITROU = 0
 4201 READ(IFICH,FMT='(A)',END=4202,ERR=4202) CBID
      CALL LONGUEUR(CBID,L)
      IF (L.GT.0) THEN
        BACKSPACE(IFICH)
        READ(IFICH,*) XXX,YYY
        NPSUR = NPSUR+1
      ELSE
        ITROU = NPSUR
        NBTROU = NBTROU+1
        GOTO 4201
      ENDIF
      IF (NPSUR.GT.NPPM) GOTO 4202
      II = 0
      DO I=1,NUMX
        IF (XXX.LT.XSU(I)) THEN
          II = I
          GOTO 4203
        ENDIF
      ENDDO
 4203 JJ = 0
      DO J=1,NUMY
        IF (YYY.LT.YSU(J)) THEN
          JJ = J
          GOTO 4204
        ENDIF
      ENDDO
 4204 IF (II.EQ.1) THEN
        II = 2
      ELSEIF(II.EQ.0) THEN
        II = NUMX
      ENDIF
      IF (JJ.EQ.1) THEN
        JJ = 2
      ELSEIF(JJ.EQ.0) THEN
        JJ = NUMY
      ENDIF
      IFPOIN(NPSUR) = (JJ-2)*(NUMX-1) + II - 1
      IF (ITPTS.LT.0) THEN
        ITPOIN(NPSUR) = MOD(-ITPTS-1+NBTROU,13) + 1
      ELSE
        ITPOIN(NPSUR) = ITPTS
      ENDIF
      SPOIN(1,NPSUR) = (2.*XXX-XSU(II)-XSU(II-1))/(XSU(II)-XSU(II-1))
      SPOIN(2,NPSUR) = (2.*YYY-YSU(JJ)-YSU(JJ-1))/(YSU(JJ)-YSU(JJ-1))
      IF (ITROU.NE.NPSUR-1.AND.IEPSEG.GE.-1.AND.NSSUR.LT.NSSM-10) THEN
        I1 = MIN(IPRE,II)
        I2 = MAX(IPRE,II)
        J1 = MIN(JPRE,JJ)
        J2 = MAX(JPRE,JJ)
        IF ((I1.EQ.IPRE.AND.J1.EQ.JPRE).OR.
     &      (I1.EQ.II.AND.J1.EQ.JJ)) THEN
          IF (I1.EQ.IPRE.AND.J1.EQ.JPRE) THEN
            IFSEG(NSSUR+1) = IFPOIN(NPSUR-1)
            SSEG(3,NSSUR+1) = SPOIN(1,NPSUR-1)
            SSEG(4,NSSUR+1) = SPOIN(2,NPSUR-1)
            XA = XPRE
            YA = YPRE
            XB = XXX
            YB = YYY
          ELSE
            IFSEG(NSSUR+1) = IFPOIN(NPSUR)
            SSEG(3,NSSUR+1) = SPOIN(1,NPSUR)
            SSEG(4,NSSUR+1) = SPOIN(2,NPSUR)
            XB = XPRE
            YB = YPRE
            XA = XXX
            YA = YYY
          ENDIF
          JJ1 = J1
          JJ2 = J2
          IPAS = 1
        ELSE
          IF (I1.EQ.IPRE.AND.J1.EQ.JJ) THEN
            IFSEG(NSSUR+1) = IFPOIN(NPSUR-1)
            SSEG(3,NSSUR+1) = SPOIN(1,NPSUR-1)
            SSEG(4,NSSUR+1) = SPOIN(2,NPSUR-1)
            XA = XPRE
            YA = YPRE
            XB = XXX
            YB = YYY
          ELSE
            IFSEG(NSSUR+1) = IFPOIN(NPSUR)
            SSEG(3,NSSUR+1) = SPOIN(1,NPSUR)
            SSEG(4,NSSUR+1) = SPOIN(2,NPSUR)
            XB = XPRE
            YB = YPRE
            XA = XXX
            YA = YYY
          ENDIF
          JJ1 = J2
          JJ2 = J1
          IPAS = -1
        ENDIF
        IF (I1.NE.I2.OR.J1.NE.J2) THEN
          DO I=I1,I2
            X1 = XSU(I-1)
            X2 = XSU(I)
            DO J=JJ1,JJ2,IPAS
              Y1 = YSU(J-1)
              Y2 = YSU(J)
              IFLAG = 0
              DEL = (YB-YA)*(X2-X1)
              IF (DEL.NE.0.) THEN
                U = ((XB-XA)*(Y1-YA)-(X1-XA)*(YB-YA))/DEL
                IF (U.GE.0.AND.U.LE.1.) THEN
                  T = -(X1-X2)*(Y1-YA)/DEL
                  IF (T.GE.0.AND.T.LE.1.) THEN
                    IF (IFLAG.EQ.0) THEN
                      IFLAG = 1
                      NSSUR = NSSUR+1
                      IFSEG(NSSUR) = (J-2)*(NUMX-1) + I - 1
                    ELSE
                      IFLAG = 2
                    ENDIF
                    SSEG(2*IFLAG-1,NSSUR) = 2.*U-1.
                    SSEG(2*IFLAG,NSSUR) = -1.
                  ENDIF
                ENDIF
                U = ((XB-XA)*(Y2-YA)-(X1-XA)*(YB-YA))/DEL
                IF (U.GE.0.AND.U.LE.1.) THEN
                  T = -(X1-X2)*(Y2-YA)/DEL
                  IF (T.GE.0.AND.T.LE.1.) THEN
                    IF (IFLAG.EQ.0) THEN
                      IFLAG = 1
                      NSSUR = NSSUR+1
                      IFSEG(NSSUR) = (J-2)*(NUMX-1) + I - 1
                    ELSE
                      IFLAG = 2
                    ENDIF
                    SSEG(2*IFLAG-1,NSSUR) = 2.*U-1.
                    SSEG(2*IFLAG,NSSUR) = 1.
                  ENDIF
                ENDIF
              ENDIF
              DEL = (XB-XA)*(Y1-Y2)
              IF (DEL.NE.0.) THEN
                U = ((XB-XA)*(Y1-YA)-(X1-XA)*(YB-YA))/DEL
                IF (U.GE.0.AND.U.LE.1.) THEN
                  T = (X1-XA)*(Y1-Y2)/DEL
                  IF (T.GE.0.AND.T.LE.1.) THEN
                    IF (IFLAG.EQ.0) THEN
                      IFLAG = 1
                      NSSUR = NSSUR+1
                      IFSEG(NSSUR) = (J-2)*(NUMX-1) + I - 1
                    ELSE
                      IFLAG = 2
                    ENDIF
                    SSEG(2*IFLAG-1,NSSUR) = -1.
                    SSEG(2*IFLAG,NSSUR) = 2.*U-1.
                  ENDIF
                ENDIF
                U = ((XB-XA)*(Y1-YA)-(X2-XA)*(YB-YA))/DEL
                IF (U.GE.0.AND.U.LE.1.) THEN
                  T = (X2-XA)*(Y1-Y2)/DEL
                  IF (T.GE.0.AND.T.LE.1.) THEN
                    IF (IFLAG.EQ.0) THEN
                      IFLAG = 1
                      NSSUR = NSSUR+1
                      IFSEG(NSSUR) = (J-2)*(NUMX-1) + I - 1
                    ELSE
                      IFLAG = 2
                    ENDIF
                    SSEG(2*IFLAG-1,NSSUR) = 1.
                    SSEG(2*IFLAG,NSSUR) = 2.*U-1.
                  ENDIF
                ENDIF
              ENDIF
            ENDDO
          ENDDO
          IF (IPAS.EQ.1) THEN
            IF (I1.EQ.IPRE.AND.J1.EQ.JPRE) THEN
              SSEG(3,NSSUR) = SPOIN(1,NPSUR)
              SSEG(4,NSSUR) = SPOIN(2,NPSUR)
            ELSE
              SSEG(3,NSSUR) = SPOIN(1,NPSUR-1)
              SSEG(4,NSSUR) = SPOIN(2,NPSUR-1)
            ENDIF
          ELSE
            IF (I1.EQ.IPRE.AND.J1.EQ.JJ) THEN
              SSEG(3,NSSUR) = SPOIN(1,NPSUR)
              SSEG(4,NSSUR) = SPOIN(2,NPSUR)
            ELSE
              SSEG(3,NSSUR) = SPOIN(1,NPSUR-1)
              SSEG(4,NSSUR) = SPOIN(2,NPSUR-1)
            ENDIF
          ENDIF
        ELSE
          NSSUR = NSSUR+1
          IF (IPAS.EQ.1) THEN
            IF (I1.EQ.IPRE.AND.J1.EQ.JPRE) THEN
              SSEG(1,NSSUR) = SPOIN(1,NPSUR)
              SSEG(2,NSSUR) = SPOIN(2,NPSUR)
            ELSE
              SSEG(1,NSSUR) = SPOIN(1,NPSUR-1)
              SSEG(2,NSSUR) = SPOIN(2,NPSUR-1)
            ENDIF
          ELSE
            IF (I1.EQ.IPRE.AND.J1.EQ.JJ) THEN
              SSEG(1,NSSUR) = SPOIN(1,NPSUR)
              SSEG(2,NSSUR) = SPOIN(2,NPSUR)
            ELSE
              SSEG(1,NSSUR) = SPOIN(1,NPSUR-1)
              SSEG(2,NSSUR) = SPOIN(2,NPSUR-1)
            ENDIF
          ENDIF
        ENDIF
      ENDIF
      XPRE = XXX
      YPRE = YYY
      IPRE = II
      JPRE = JJ
      GOTO 4201
 4202 CLOSE(IFICH)
      IF (NBTROU.EQ.0) THEN
        IF (ISTDOUT.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,NPSUR,' points et',NSSUR,' segments'
          ELSE
            PRINT*,NPSUR,' points and',NSSUR,' segments'
          ENDIF
        ENDIF
      ELSE
        IF (ISTDOUT.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,
     &           NPSUR,' points,',NSSUR,' segments et',NBTROU,' trous'
          ELSE
            PRINT*,
     &           NPSUR,' points,',NSSUR,' segments and',NBTROU,' holes'
          ENDIF
        ENDIF
      ENDIF
      RETURN
 11   IRC = 1
      CLOSE(IFICH)
      END
C=======================================================================
      SUBROUTINE LICOUR4(IRC)
C
C Pour maillages quelconques en quadrangles
C
      INCLUDE 'com_coor.f'
      INCLUDE 'com_faces.f'
      INCLUDE 'com_options.f'
      CHARACTER*1 CC
      CHARACTER*64 CBID
      DIMENSION T(4)
      INTEGER   IAR(4)
      REAL*8    SS,TT,SS2,TT2
C
      CALL PREMIER_LIBRE(IFICH)
      OPEN(IFICH,FILE=NOM_COUR(1:LONCOUR),STATUS='OLD',IOSTAT=IERR)
      IF (IERR.NE.0) THEN
        IRC = -1
        RETURN
      ENDIF
      IRC = 0
 10   READ(IFICH,'(A1)',END=11,ERR=11) CC
      IF (CC.EQ.'#'.OR.CC.EQ.'%') GOTO 10
      BACKSPACE(IFICH)
      NPSUR = 0
      NSSUR = 0
      NBTROU = 0
      ITROU = 0
      XXX1 = 0.
      YYY1 = 0.
 4201 READ(IFICH,FMT='(A)',END=4202,ERR=4202) CBID
      CALL LONGUEUR(CBID,L)
      IF (L.GT.0) THEN
        BACKSPACE(IFICH)
        READ(IFICH,*) XXX2,YYY2
        XXX2 = XXX2-XMED
        YYY2 = YYY2-YMED
        NPSUR = NPSUR+1
      ELSE
        ITROU = NPSUR
        NBTROU = NBTROU+1
        GOTO 4201
      ENDIF
      IF (NPSUR.GT.NPPM-100) THEN
        PRINT*,'***'
        IF (ILANG.EQ.0) THEN
          PRINT*,'*** Trop de points (maximum',NPPM,')'
        ELSE
          PRINT*,'*** Too many points (maximum',NPPM,')'
        ENDIF
        PRINT*,'***'
        GOTO 4202
      ENDIF
      IF (NSSUR.GT.NSSM-100) THEN
        PRINT*,'***'
        IF (ILANG.EQ.0) THEN
          PRINT*,'*** Trop de segments (maximum',NSSM,')'
        ELSE
          PRINT*,'*** Too many segments (maximum',NSSM,')'
        ENDIF
        PRINT*,'***'
        GOTO 4202
      ENDIF
      IF (ITROU.LT.NPSUR-1) THEN
        DXX = XXX1-XXX2
        DYY = YYY1-YYY2
        NSSUR0 = NSSUR
        DO N=1,NFACE
          NC = 0
          DO I=1,NDS
            J = I+1
            IF (J.GT.NDS) J=1
            DX = XF(J,N)-XF(I,N)
            DY = YF(J,N)-YF(I,N)
            DELTA = DX*DYY-DXX*DY
            IF (DELTA.NE.0.) THEN
              T1 = ((XXX1-XF(I,N))*DYY-(YYY1-YF(I,N))*DXX)/DELTA
              IF (T1.GE.0..AND.T1.LE.1.) THEN
                T2 = ((YYY1-YF(I,N))*DX-(XXX1-XF(I,N))*DY)/DELTA
                IF (T2.GE.0..AND.T2.LE.1.) THEN
                  NC = NC+1
                  T(NC) = T1
                  IAR(NC) = I
                ENDIF
              ENDIF
            ENDIF
          ENDDO
          IF (NC.GT.0) THEN
            IF (NC.GT.2) THEN
 1            II = 0
              DO I=1,NC
                J = I+1
                IF (J.GT.NC) J=1
                IARSUIV = IAR(I)+1
                IF (IARSUIV.GT.NDS) IARSUIV=1
                IF (IAR(J).EQ.IARSUIV) THEN
                  IF (T(I).GT.0.999.AND.T(J).LT.0.001) II = I
                ENDIF
              ENDDO
              IF (II.NE.0) THEN
                IF (II.LT.NC-1) THEN
                  DO I=II+1,NC
                    T(I-1) = T(I)
                    IAR(I-1) = IAR(I)
                  ENDDO
                ENDIF
                NC = NC-1
                IF (NC.GT.2) GOTO 1
              ENDIF
            ENDIF
            IF (NC.LE.2) THEN
              NSSUR = NSSUR+1
              IFSEG(NSSUR) = N
              TT = 2.*T(1) - 1.
              IF (IAR(1).EQ.1) THEN
                SSEG(1,NSSUR) = TT
                SSEG(2,NSSUR) = -1.
              ELSEIF(IAR(1).EQ.2) THEN
                SSEG(1,NSSUR) = 1.
                SSEG(2,NSSUR) = TT
              ELSEIF(IAR(1).EQ.3) THEN
                SSEG(1,NSSUR) = -TT
                SSEG(2,NSSUR) = 1.
              ELSE
                SSEG(1,NSSUR) = -1.
                SSEG(2,NSSUR) = -TT
              ENDIF
              IF (NC.EQ.2) THEN
                TT = 2.*T(2) - 1.
                IF (IAR(2).EQ.1) THEN
                  SSEG(3,NSSUR) = TT
                  SSEG(4,NSSUR) = -1.
                ELSEIF(IAR(2).EQ.2) THEN
                  SSEG(3,NSSUR) = 1.
                  SSEG(4,NSSUR) = TT
                ELSEIF(IAR(2).EQ.3) THEN
                  SSEG(3,NSSUR) = -TT
                  SSEG(4,NSSUR) = 1.
                ELSE
                  SSEG(3,NSSUR) = -1.
                  SSEG(4,NSSUR) = -TT
                ENDIF
              ELSE
                CALL TROUVEST4(XF(1,N),YF(1,N),XXX1,YYY1,SS,TT,ITROUVE)
                IF (ITROUVE.EQ.0)
     &          CALL TROUVEST4(XF(1,N),YF(1,N),XXX2,YYY2,SS,TT,ITROUVE)
                IF (ITROUVE.EQ.0) THEN
                  PRINT*,'*** bug'
                ELSE
                  SSEG(3,NSSUR) = SS
                  SSEG(4,NSSUR) = TT
                  NPSUR = NPSUR+1
                  IFPOIN(NPSUR) = N
                  SPOIN(1,NPSUR) = SS
                  SPOIN(2,NPSUR) = TT
                  IF (ITPTS.LT.0) THEN
                    ITPOIN(NPSUR) = MOD(-ITPTS-1+NBTROU,13) + 1
                  ELSE
                    ITPOIN(NPSUR) = ITPTS
                  ENDIF
                ENDIF
              ENDIF
            ELSE
              if (nc.gt.2) PRINT*,'*** Bizarre',nc,(iar(k),t(k),k=1,nc)
            ENDIF
          ENDIF
        ENDDO
        IF (NSSUR.EQ.NSSUR0) THEN
          DO N=1,NFACE
            CALL TROUVEST4(XF(1,N),YF(1,N),XXX1,YYY1,SS,TT,ITROUVE)
            IF (ITROUVE.NE.0) THEN
              CALL TROUVEST4(XF(1,N),YF(1,N),XXX2,YYY2,SS2,TT2,ITROUVE)
              IF (ITROUVE.EQ.0) THEN
                PRINT*,'*** Bizarre bizarre...'
              ELSE
                NSSUR = NSSUR+1
                IFSEG(NSSUR) = N
                SSEG(1,NSSUR) = SS
                SSEG(2,NSSUR) = TT
                SSEG(3,NSSUR) = SS2
                SSEG(4,NSSUR) = TT2
                NPSUR = NPSUR+1
                IFPOIN(NPSUR) = N
                SPOIN(1,NPSUR) = SS
                SPOIN(2,NPSUR) = TT
                NPSUR = NPSUR+1
                IFPOIN(NPSUR) = N
                SPOIN(1,NPSUR) = SS2
                SPOIN(2,NPSUR) = TT2
              ENDIF
            ENDIF
          ENDDO
        ENDIF
cc        IF (NSSUR.EQ.NSSUR0) PRINT*,'*** Bizarre bizarre bizarre...'
        XXX1 = XXX2
        YYY1 = YYY2
      ELSEIF(ITROU.EQ.NPSUR-1) THEN
        XXX1 = XXX2
        YYY1 = YYY2
      ENDIF
      GOTO 4201
 4202 CLOSE(IFICH)
      IF (NBTROU.EQ.0) THEN
        IF (ISTDOUT.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,NPSUR,' points et',NSSUR,' segments'
          ELSE
            PRINT*,NPSUR,' points and',NSSUR,' segments'
          ENDIF
        ENDIF
      ELSE
        IF (ISTDOUT.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,
     &           NPSUR,' points,',NSSUR,' segments et',NBTROU,' trous'
          ELSE
            PRINT*,
     &           NPSUR,' points,',NSSUR,' segments and',NBTROU,' holes'
          ENDIF
        ENDIF
      ENDIF
      RETURN
 11   IRC = 1
      CLOSE(IFICH)
      END
C=======================================================================
      SUBROUTINE LICOUR3(IRC)
C
C Pour maillages quelconques en triangles
C
      INCLUDE 'com_coor.f'
      INCLUDE 'com_faces.f'
      INCLUDE 'com_options.f'
      CHARACTER*1 CC
      CHARACTER*64 CBID
      DIMENSION T(3)
      INTEGER   IAR(3)
      REAL*8    SS,TT,SS2,TT2
C
      CALL PREMIER_LIBRE(IFICH)
      OPEN(IFICH,FILE=NOM_COUR(1:LONCOUR),STATUS='OLD',IOSTAT=IERR)
      IF (IERR.NE.0) THEN
        IRC = -1
        RETURN
      ENDIF
      IRC = 0
 10   READ(IFICH,'(A1)',END=11,ERR=11) CC
      IF (CC.EQ.'#'.OR.CC.EQ.'%') GOTO 10
      BACKSPACE(IFICH)
      NPSUR = 0
      NSSUR = 0
      NBTROU = 0
      ITROU = 0
      XXX1 = 0.
      YYY1 = 0.
 4201 READ(IFICH,FMT='(A)',END=4202,ERR=4202) CBID
      CALL LONGUEUR(CBID,L)
      IF (L.GT.0) THEN
        BACKSPACE(IFICH)
        READ(IFICH,*) XXX2,YYY2
        XXX2 = XXX2-XMED
        YYY2 = YYY2-YMED
        NPSUR = NPSUR+1
      ELSE
        ITROU = NPSUR
        NBTROU = NBTROU+1
        GOTO 4201
      ENDIF
      IF (NPSUR.GT.NPPM-100) THEN
        PRINT*,'***'
        IF (ILANG.EQ.0) THEN
          PRINT*,'*** Trop de points (maximum',NPPM,')'
        ELSE
          PRINT*,'*** Too many points (maximum',NPPM,')'
        ENDIF
        PRINT*,'***'
        GOTO 4202
      ENDIF
      IF (NSSUR.GT.NSSM-100) THEN
        PRINT*,'***'
        IF (ILANG.EQ.0) THEN
          PRINT*,'*** Trop de segments (maximum',NSSM,')'
        ELSE
          PRINT*,'*** Too many segments (maximum',NSSM,')'
        ENDIF
        PRINT*,'***'
        GOTO 4202
      ENDIF
      IF (ITROU.LT.NPSUR-1) THEN
        DXX = XXX1-XXX2
        DYY = YYY1-YYY2
        NSSUR0 = NSSUR
        DO N=1,NFACE
          NC = 0
          DO I=1,NDS
            J = I+1
            IF (J.GT.NDS) J=1
            DX = XF(J,N)-XF(I,N)
            DY = YF(J,N)-YF(I,N)
            DELTA = DX*DYY-DXX*DY
            IF (DELTA.NE.0.) THEN
              T1 = ((XXX1-XF(I,N))*DYY-(YYY1-YF(I,N))*DXX)/DELTA
              IF (T1.GE.0..AND.T1.LE.1.) THEN
                T2 = ((YYY1-YF(I,N))*DX-(XXX1-XF(I,N))*DY)/DELTA
                IF (T2.GE.0..AND.T2.LE.1.) THEN
                  NC = NC+1
                  T(NC) = T1
                  IAR(NC) = I
                ENDIF
              ENDIF
            ENDIF
          ENDDO
          IF (NC.GT.0) THEN
            IF (NC.GT.2) THEN
 1            II = 0
              DO I=1,NC
                J = I+1
                IF (J.GT.NC) J=1
                IARSUIV = IAR(I)+1
                IF (IARSUIV.GT.NDS) IARSUIV=1
                IF (IAR(J).EQ.IARSUIV) THEN
                  IF (T(I).GT.0.999.AND.T(J).LT.0.001) II = I
                ENDIF
              ENDDO
              IF (II.NE.0) THEN
                IF (II.LT.NC-1) THEN
                  DO I=II+1,NC
                    T(I-1) = T(I)
                    IAR(I-1) = IAR(I)
                  ENDDO
                ENDIF
                NC = NC-1
                IF (NC.GT.2) GOTO 1
              ENDIF
            ENDIF
            IF (NC.LE.2) THEN
              NSSUR = NSSUR+1
              IFSEG(NSSUR) = N
              IF (IAR(1).EQ.1) THEN
                SSEG(1,NSSUR) = 1.-T(1)
                SSEG(2,NSSUR) = T(1)
              ELSEIF(IAR(1).EQ.2) THEN
                SSEG(1,NSSUR) = 0.
                SSEG(2,NSSUR) = 1.-T(1)
              ELSE
                SSEG(1,NSSUR) = T(1)
                SSEG(2,NSSUR) = 0.
              ENDIF
              IF (NC.EQ.2) THEN
                IF (IAR(2).EQ.1) THEN
                  SSEG(3,NSSUR) = 1.-T(2)
                  SSEG(4,NSSUR) = T(2)
                ELSEIF(IAR(2).EQ.2) THEN
                  SSEG(3,NSSUR) = 0.
                  SSEG(4,NSSUR) = 1.-T(2)
                ELSE
                  SSEG(3,NSSUR) = T(2)
                  SSEG(4,NSSUR) = 0.
                ENDIF
              ELSE
                CALL TROUVEST3(XF(1,N),YF(1,N),XXX1,YYY1,SS,TT,ITROUVE)
                IF (ITROUVE.EQ.0)
     &          CALL TROUVEST3(XF(1,N),YF(1,N),XXX2,YYY2,SS,TT,ITROUVE)
                IF (ITROUVE.EQ.0) THEN
                  PRINT*,'*** bug'
                ELSE
                  SSEG(3,NSSUR) = SS
                  SSEG(4,NSSUR) = TT
                  NPSUR = NPSUR+1
                  IFPOIN(NPSUR) = N
                  SPOIN(1,NPSUR) = SS
                  SPOIN(2,NPSUR) = TT
                  IF (ITPTS.LT.0) THEN
                    ITPOIN(NPSUR) = MOD(-ITPTS-1+NBTROU,13) + 1
                  ELSE
                    ITPOIN(NPSUR) = ITPTS
                  ENDIF
                ENDIF
              ENDIF
            ELSE
              if (nc.gt.2) PRINT*,'*** Bizarre',nc,(iar(k),t(k),k=1,nc)
            ENDIF
          ENDIF
        ENDDO
        IF (NSSUR.EQ.NSSUR0) THEN
          DO N=1,NFACE
            CALL TROUVEST3(XF(1,N),YF(1,N),XXX1,YYY1,SS,TT,ITROUVE)
            IF (ITROUVE.NE.0) THEN
              CALL TROUVEST3(XF(1,N),YF(1,N),XXX2,YYY2,SS2,TT2,ITROUVE)
              IF (ITROUVE.EQ.0) THEN
                PRINT*,'*** Bizarre bizarre...'
              ELSE
                NSSUR = NSSUR+1
                IFSEG(NSSUR) = N
                SSEG(1,NSSUR) = SS
                SSEG(2,NSSUR) = TT
                SSEG(3,NSSUR) = SS2
                SSEG(4,NSSUR) = TT2
                NPSUR = NPSUR+1
                IFPOIN(NPSUR) = N
                SPOIN(1,NPSUR) = SS
                SPOIN(2,NPSUR) = TT
                NPSUR = NPSUR+1
                IFPOIN(NPSUR) = N
                SPOIN(1,NPSUR) = SS2
                SPOIN(2,NPSUR) = TT2
              ENDIF
            ENDIF
          ENDDO
        ENDIF
cc        IF (NSSUR.EQ.NSSUR0) PRINT*,'*** Bizarre bizarre bizarre...'
        XXX1 = XXX2
        YYY1 = YYY2
      ELSEIF(ITROU.EQ.NPSUR-1) THEN
        XXX1 = XXX2
        YYY1 = YYY2
      ENDIF
      GOTO 4201
 4202 CLOSE(IFICH)
      IF (NBTROU.EQ.0) THEN
        IF (ISTDOUT.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,NPSUR,' points et',NSSUR,' segments'
          ELSE
            PRINT*,NPSUR,' points and',NSSUR,' segments'
          ENDIF
        ENDIF
      ELSE
        IF (ISTDOUT.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,
     &           NPSUR,' points,',NSSUR,' segments et',NBTROU,' trous'
          ELSE
            PRINT*,
     &           NPSUR,' points,',NSSUR,' segments and',NBTROU,' holes'
          ENDIF
        ENDIF
      ENDIF
      RETURN
 11   IRC = 1
      CLOSE(IFICH)
      END
