C ECDIFR    SOURCE    FANDEUR   22/03/10    21:15:03     11313          
      SUBROUTINE ECDIFR(NBAND,LMAX,R,IFORM)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC CCFXDR
      EXTERNAL LONG
      DIMENSION R(*)
      dimension rc(lmax+1)
      logical compr

      IF (LMAX.EQ.0) RETURN

      DIMATT=DIMATT+LMAX*2
      dimato= dimatt
      IF( DIMATT.GT.DIMFIC) THEN
        DIMATT=LMAX*2 +1
        ll = long(NOMSAU)
        iprefi=iprefi+1
        if(iprefi.eq.1) THEN
          NOMSAU(ll+1:ll+2)='_1'
          ll=ll+2
        elseif(iprefi.lt.10) then
          write(NOMSAU(ll:ll),fmt='(I1)')iprefi
        elseif(iprefi.lt.100) then
          if(iprefi.eq.10)ll = ll + 1
          write(NOMSAU(ll-1:ll),fmt='(I2)')iprefi
        elseif(iprefi.lt.1000) then
          if(iprefi.eq.100) ll = ll + 1
          write(NOMSAU(ll-2:ll),fmt='(I3)')iprefi
        elseif(iprefi.lt.10000) then
          if(iprefi.eq.1000) ll = ll + 1
          write(NOMSAU(ll-3:ll),fmt='(I4)')iprefi
        else
          call erreur (945)
          return
*          call erreur (1003)
        endif
        if (iform.ne.2) close (unit=nband)
        if (iform.eq.2) ios=IXDRCLOSE( ixdrw,.TRUE. )

        if(iform.eq.1) then
          OPEN (UNIT=NBAND,STATUS='UNKNOWN',FILE=NOMSAU(1:ll),
     #    IOSTAT=IOS,ERR=2000,FORM='FORMATTED')
        elseif (iform.eq.0) then
          OPEN (UNIT=NBAND,STATUS='UNKNOWN',FILE=NOMSAU(1:ll),
     #    IOSTAT=IOS,ERR=2000,FORM='UNFORMATTED')
        elseif (iform.eq.2) then
          ios= initxdr(NOMSAU(1:ll),'w',.TRUE.)
        endif
       write(ioimp,*) 'ecdifr : Ouverture du fichier : ',NOMSAU(1:ll)
*      write(ioimp,*) 'dimfic , dimatold , dimatt ',dimfic,dimato,dimatt
      endif
* compression des donnees
      if (lmax.eq.0) goto 10

      i=1
      icp=1
      ic=2
      compr=.false.
      rc(1)=-1.002017000000000000
      rc(2)=r(1)

1954  continue
      i=i+1
      if (i.gt.lmax) goto 1955

       if (r(i).eq.rc(ic)) then
*  on stocke le nb de terme identique suivi de la valeur
        if (compr) then
         rc(ic-1)=rc(ic-1)+1
        else
         if (i.lt.lmax.and.r(i+1).eq.r(i)) then
          compr=.true.
          rc(icp)=rc(icp)+1
          rc(ic+1)=rc(ic)
          if (rc(icp).gt.-0.5) then
*  0 valeurs differentes avant. On efface le marqueur
           ic=ic-1
          endif
          rc(ic)=2.0020170000000
          ic=ic+1
         else
* au moins 3 valeurs identiques pour comprimer
          rc(icp)=rc(icp)-1
          ic=ic+1
          rc(ic)=r(i)
         endif
        endif
       else
*  on stocke le nb de terme different suivi des valeurs
        if (compr) then
          compr=.false.
          icp=ic+1
          rc(icp)=-1.1
          ic=icp+1
          rc(ic)=r(i)
         else
          rc(icp)=rc(icp)-1
          ic=ic+1
          rc(ic)=r(i)
         endif
       endif
      goto 1954
1955  continue
1956  continue
**      write (6,*) 'ecdifr avant ',lmax
**      write (6,*) (r(i),i=1,min(lmax,255))
**      write (6,*) 'ecdifr apres ',ic
**      write (6,*) (rc(i),i=1,min(ic,255))

      IF(IONIVE.GT.19) THEN
        DIMATT = DIMATT - LMAX*2+IC*2
        IF(IFORM.EQ.1) then
         WRITE(NBAND,8004) ic
         WRITE(NBAND,8003) (Rc(I),I=1,ic)
        endif
        IF(IFORM.EQ.0) then
         WRITE(NBAND) ic
         WRITE(NBAND) (Rc(I),I=1,ic)
        endif
        if (iform.eq.2) then
* segmentation au dela de 500000000 de termes pour eviter une ecriture de plus de 2**32 octets
       if (ic.lt.500000000) then
         ios=IXDRint( ixdrw, ic)
         ios=IXDRDMAT( ixdrw, ic,rc(1))
       else
        nc=(ic-1)/500000000+1
        ios=IXDRINT ( ixdrw, -nc)
        do is=0,nc-1
         lc=min(500000000,ic-is*500000000)
**      write(6,*) ' ecriture n ',is,'nb termes ',lc,' nbtot ',ic
         ios=IXDRINT ( ixdrw, lc)
         ios=IXDRDMAT( ixdrw, lc,rc(1))
        enddo
       endif

      endif

 8004   FORMAT(i15)
 8003   FORMAT(1P,3E22.14)
      ELSE
        lmaxl=lmax
        IF(IFORM.EQ.1) WRITE(NBAND,8003) (R(I),I=1,lmaxl)
        IF(IFORM.EQ.0)WRITE(NBAND) (R(I),I=1,lmaxl)
        if (iform.eq.2) ios=IXDRDMAT( ixdrw, lmaxl,r(1))
      ENDIF
  10  continue
      RETURN

 2000 continue
      MOTERR=NOMSAU(1:ll)
      INTERR(1)=IOS
      CALL ERREUR(424)
      RETURN

      END