      SUBROUTINE ECRITAVOIR(FICH,LFICH,HED,NUMNP,NDSMAX,XYZ,IBC,NODE
     &                     ,NPR,NFPR,PR,NGROUP,NTYP,NEL,NDS,NUMSD
     &                     ,IMP,IENDIAN,IERR)
C
C Ecriture d'un avoir
C (par routines C -> conversion possible, bid endian, little endian)
C
      DIMENSION XYZ(3,*),PR(6,*)
      INTEGER   IBC(9,*),NODE(0:NDSMAX,*),NPR(*),NFPR(6,*)
     &         ,NGROUP(*),NTYP(*),NEL(*),NDS(*)
      CHARACTER*80  HED,CWORK
      CHARACTER*128 FICH
      LOGICAL IFPR
C
      REAL*4  WORK(100)
      INTEGER IWORK(100)
      EQUIVALENCE (IWORK(1),WORK(1))
      EQUIVALENCE (IWORK(1),CWORK)
C
      CALL PREMIER_LIBRE(LIBRE)
      IF (LIBRE.LT.0) THEN
        PRINT*,'*** Pas d''unité libre'
        STOP
      ENDIF
C
      IF (IENDIAN.EQ.1) THEN
        IOPTEC0 = 0
        IOPTEC1 = 1
      ELSE
        IOPTEC0 = 2
        IOPTEC1 = 2
      ENDIF
      CALL ouvrebin(LIBRE,FICH(1:LFICH)//CHAR(0),1,IERR)
      IF (IERR.NE.0) THEN
        PRINT*,'*** Erreur à l''ouverture de '//FICH(1:LFICH)
        IERR = -1
        RETURN
      ENDIF
      IF (IMP.GT.1) THEN
        NELTOT = 0
        DO NS=1,NUMSD
          NELTOT = NELTOT+NEL(NS)
        ENDDO
        NTOTAL = NELTOT+NUMNP
        NMOD = MAX(1000,NTOTAL/50)
        CALL INITFLUSH
      ENDIF
      CWORK = HED
      CALL ecritrecbin(LIBRE,IWORK,80,IOPTEC1)
      IWORK(1) = NUMNP
      IWORK(2) = 8
      CALL ecritrecbin(LIBRE,IWORK,8,IOPTEC0)
C
      IF (IENDIAN.EQ.1) THEN
        DO I=1,NUMNP
          WORK(1) = XYZ(1,I)
          WORK(2) = XYZ(2,I)
          WORK(3) = XYZ(3,I)
          DO K=1,9
            IWORK(K+3) = IBC(K,I)
          ENDDO
          CALL ecritrecbin(LIBRE,IWORK,48,IOPTEC0)
          IF (IMP.GT.1) THEN
            IF (MOD(I,NMOD).EQ.0)
     &           CALL MYFLUSH(100.*REAL(I)/REAL(NTOTAL))
          ENDIF
        ENDDO
      ELSE
        DO I=1,NUMNP
          WORK(1) = XYZ(1,I)
          WORK(2) = XYZ(2,I)
          WORK(3) = XYZ(3,I)
          DO K=1,9
            IWORK(K+3) = IBC(K,I)
          ENDDO
          CALL ecritrecbinspeed(LIBRE,IWORK,48)
          IF (IMP.GT.1) THEN
            IF (MOD(I,NMOD).EQ.0)
     &           CALL MYFLUSH(100.*REAL(I)/REAL(NTOTAL))
          ENDIF
        ENDDO
      ENDIF
      N = 0
      DO NS=1,NUMSD
        IWORK(1) = NGROUP(NS)
        IWORK(2) = NTYP(NS)
        IWORK(3) = NEL(NS)
        IWORK(4) = NDS(NS)
        CALL ecritrecbin(LIBRE,IWORK,16,IOPTEC0)
        LLL0 = 4*(NDS(NS)+1)
        LLL = LLL0
        IFPR = NDS(NS).EQ.3.OR.NDS(NS).EQ.4.OR.NDS(NS).EQ.8
     &     .OR.NDS(NS).EQ.6.OR.NDS(NS).EQ.16
        IF (IENDIAN.EQ.1) THEN
          DO I=1,NEL(NS)
            N = N+1
            DO K=0,NDS(NS)
              IWORK(K+1) = NODE(K,N)
            ENDDO
            IF (IFPR) THEN
              IWORK(NDS(NS)+2) = NPR(N)
              IF (NPR(N).GT.0) THEN
                DO K=1,NPR(N)
                  IWORK(NDS(NS)+1+2*K) = NFPR(K,N)
                  WORK(NDS(NS)+2+2*K)  = PR(K,N)
                ENDDO
              ENDIF
              LLL = LLL0+4*(1+NPR(N)*2)
            ENDIF
            CALL ecritrecbin(LIBRE,IWORK,LLL,IOPTEC0)
            IF (IMP.GT.1) THEN
              IF (MOD(N+NUMNP,NMOD).EQ.0)
     &             CALL MYFLUSH(100.*REAL(N+NUMNP)/REAL(NTOTAL))
            ENDIF
          ENDDO
        ELSE
          DO I=1,NEL(NS)
            N = N+1
            DO K=0,NDS(NS)
              IWORK(K+1) = NODE(K,N)
            ENDDO
            IF (IFPR) THEN
              IWORK(NDS(NS)+2) = NPR(N)
              IF (NPR(N).GT.0) THEN
                DO K=1,NPR(N)
                  IWORK(NDS(NS)+1+2*K) = NFPR(K,N)
                  WORK(NDS(NS)+2+2*K) = PR(K,N)
                ENDDO
              ENDIF
              LLL = LLL0+4*(1+NPR(N)*2)
            ENDIF
            CALL ecritrecbinspeed(LIBRE,IWORK,LLL)
            IF (IMP.GT.1) THEN
              IF (MOD(N+NUMNP,NMOD).EQ.0)
     &             CALL MYFLUSH(100.*REAL(N+NUMNP)/REAL(NTOTAL))
            ENDIF
          ENDDO
        ENDIF
      ENDDO
      CALL fermebin(LIBRE)
      IF (IMP.GT.1) CALL ENDFLUSH
      END
C---------------------------------------------------------------------
      SUBROUTINE ECRITAVOIR0(FICH,LFICH,HED,NUMNP,NDSMAX,XYZ,IBC,NODE
     &                      ,NPR,NFPR,PR,NGROUP,NTYP,NEL,NDS,NUMSD,IMP
     &                      ,IERR)
      DIMENSION XYZ(3,*),PR(6,*)
      INTEGER   IBC(9,*),NODE(0:NDSMAX,*),NPR(*),NFPR(6,*)
     &         ,NGROUP(*),NTYP(*),NEL(*),NDS(*)
      CHARACTER*80  HED
      CHARACTER*128 FICH
      LOGICAL IFPR
C
C Version avec ecriture fortran (tres lente)
C
      CALL PREMIER_LIBRE(LIBRE)
      IF (LIBRE.LT.0) THEN
        PRINT*,'*** Pas d''unité libre'
        STOP
      ENDIF
C
      OPEN(LIBRE,FILE=FICH(1:LFICH),FORM='UNFORMATTED',IOSTAT=IERR)   
      IF (IERR.NE.0) THEN
        PRINT*,'*** Erreur à l''ouverture de '//FICH(1:LFICH)
        IERR = -1
        RETURN
      ENDIF
C
      IF (IMP.GT.1) THEN
        NELTOT = 0
        DO NS=1,NUMSD
          NELTOT = NELTOT+NEL(NS)
        ENDDO
        NTOTAL = NELTOT+NUMNP
        NMOD = MAX(1000,NTOTAL/50)
        CALL INITFLUSH
      ENDIF
C
      WRITE(LIBRE) HED
      WRITE(LIBRE) NUMNP,8
      DO I=1,NUMNP
        WRITE(LIBRE) (XYZ(K,I),K=1,3),(IBC(K,I),K=1,9)
        IF (IMP.GT.1) THEN
          IF (MOD(I,NMOD).EQ.0)
     &         CALL MYFLUSH(100.*REAL(I)/REAL(NTOTAL))
        ENDIF
      ENDDO
      N = 0
      DO NS=1,NUMSD
        WRITE(LIBRE) NGROUP(NS),NTYP(NS),NEL(NS),NDS(NS)
        IFPR = NDS(NS).EQ.3.OR.NDS(NS).EQ.4.OR.NDS(NS).EQ.8
     &     .OR.NDS(NS).EQ.6.OR.NDS(NS).EQ.16
        DO I=1,NEL(NS)
          N = N+1
          IF (IFPR) THEN
            IF (NPR(N).GT.0) THEN
              WRITE(LIBRE) (NODE(K,N),K=0,NDS(NS)),NPR(N)
     &                ,(NFPR(K,N),PR(K,N),K=1,NPR(N))
            ELSE
              WRITE(LIBRE) (NODE(K,N),K=0,NDS(NS)),0
            ENDIF
          ELSE
            WRITE(LIBRE) (NODE(K,N),K=0,NDS(NS))
          ENDIF
          IF (IMP.GT.1) THEN
            IF (MOD(N+NUMNP,NMOD).EQ.0)
     &           CALL MYFLUSH(100.*REAL(N+NUMNP)/REAL(NTOTAL))
          ENDIF
        ENDDO
      ENDDO
      CLOSE(LIBRE)
      IF (IMP.GT.1) CALL ENDFLUSH
      END
C---------------------------------------------------------------------
      SUBROUTINE ECRITAVOIREASY(FICH,LFICH,HED,NUMNP,NEL,NDS,NDSM,X,Y,Z
     &                         ,IBC,NODE,IERR)
C
C Ecriture d'un avoir version simplifiee. Un seul sous-domaine
C pas de pressions, pas de traduction
C
      DIMENSION X(*),Y(*),Z(*)
      INTEGER   IBC(9,*),NODE(NDSM,*)
      CHARACTER*80  HED,CWORK
      CHARACTER*128 FICH
      LOGICAL IFPR
C
      REAL*4  WORK(50)
      INTEGER IWORK(50)
      EQUIVALENCE (IWORK(1),WORK(1))
      EQUIVALENCE (IWORK(1),CWORK)
C
      CALL PREMIER_LIBRE(LIBRE)
      IF (LIBRE.LT.0) THEN
        PRINT*,'*** Pas d''unité libre'
        STOP
      ENDIF
C
      CALL ouvrebin(LIBRE,FICH(1:LFICH)//CHAR(0),1,IERR)
      IF (IERR.NE.0) THEN
        PRINT*,'*** Erreur à l''ouverture de '//FICH(1:LFICH)
        IERR = -1
        RETURN
      ENDIF
      CWORK = HED
      CALL ecritrecbinspeed(LIBRE,IWORK,80)
      IWORK(1) = NUMNP
      IWORK(2) = 8
      CALL ecritrecbinspeed(LIBRE,IWORK,8)
C
      DO I=1,NUMNP
        WORK(1) = X(I)
        WORK(2) = Y(I)
        WORK(3) = Z(I)
        DO K=1,9
          IWORK(K+3) = IBC(K,I)
        ENDDO
        CALL ecritrecbinspeed(LIBRE,IWORK,48)
      ENDDO
      IWORK(1) = 1
      IWORK(2) = 1
      IWORK(3) = NEL
      IWORK(4) = NDS
      CALL ecritrecbinspeed(LIBRE,IWORK,16)
      IFPR = NDS.EQ.3.OR.NDS.EQ.4.OR.NDS.EQ.8
     &   .OR.NDS.EQ.6.OR.NDS.EQ.16
      IF (IFPR) THEN
        LLL = 4*(NDS+2)
      ELSE
        LLL = 4*(NDS+1)
      ENDIF
      DO N=1,NEL
        IWORK(1) = N
        DO K=1,NDS
          IWORK(K+1) = NODE(K,N)
        ENDDO
        IF (IFPR) IWORK(NDS+2) = 0
        CALL ecritrecbinspeed(LIBRE,IWORK,LLL)
      ENDDO
      CALL fermebin(LIBRE)
      END
