C ECDIFE    SOURCE    OF166741  24/12/18    21:15:03     12091          

      SUBROUTINE ECDIFE(NBAND,LMAX,ITAB,IFORM)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC CCFXDR

      EXTERNAL LONG

      DIMENSION ITAB(*)

      DIMENSION itabc(lmax+1)
      LOGICAL compr

      IF (LMAX.EQ.0) RETURN

C-BEBUT- Bloc pouvant faire l'objet d'un sous-programme generique -
      DIMATT=DIMATT+LMAX+1
      IF (DIMATT.GT.DIMFIC) THEN
c-dbg        dimatold = dimatt
        DIMATT=LMAX
        ll = LONG(NOMSAU)
        iprefi = iprefi+1
        if (iprefi.eq.1) then
          NOMSAU(ll+1:ll+2)='_1'
          ll=ll+2
        else if (iprefi.lt.10) then
          write(NOMSAU(ll:ll),fmt='(I1)') iprefi
        else if (iprefi.lt.100) then
          if (iprefi.eq.10) ll = ll + 1
          write(NOMSAU(ll-1:ll),fmt='(I2)') iprefi
        else if (iprefi.lt.1000) then
          if (iprefi.eq.100) ll = ll + 1
          write(NOMSAU(ll-2:ll),fmt='(I3)') iprefi
        else if (iprefi.lt.10000) then
          if (iprefi.eq.1000) ll = ll + 1
          write(NOMSAU(ll-3:ll),fmt='(I4)') iprefi
        else
          call erreur (945)
*          call erreur (1003)
          return
        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,*) 'ecdife : Ouverture du fichier : ',NOMSAU(1:ll)
c-dbg        write(ioimp,*) ' dimfic , dimatold , dimatt ',dimfic,dimatold,dimatt
      ENDIF

* Compression des donnees (depuis le niveau 20)
      IF (ionive.GE.20) THEN
      i   = 1
      icp = 1
      ic  = 2
      compr = .false.
      itabc(1) = -1
      itabc(2) = itab(1)

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

        if (itab(i).eq.itabc(ic)) then
*  on stocke le nb de termes identiques suivi de la valeur
          if (compr) then
            itabc(ic-1)=itabc(ic-1)+1
          else
            if (i.lt.lmax .and. itab(i+1).eq.itab(i)) then
              compr=.true.
              itabc(icp)=itabc(icp)+1
              itabc(ic+1)=itabc(ic)
              if (itabc(icp).ge.0) then
*  0 valeur differente avant. On efface le marqueur
                ic=ic-1
              endif
              itabc(ic)=2
              ic=ic+1
            else
* au moins 3 valeurs identiques pour comprimer
              itabc(icp)=itabc(icp)-1
              ic=ic+1
              itabc(ic)=itab(i)
            endif
          endif
        else
*  on stocke le nb de termes differents suivi des valeurs
          if (compr) then
            compr=.false.
            icp=ic+1
            itabc(icp)=-1
            ic=icp+1
            itabc(ic)=itab(i)
          else
            itabc(icp)=itabc(icp)-1
            ic=ic+1
            itabc(ic)=itab(i)
          endif
        endif
      GOTO 1954
 1955 CONTINUE
      DIMATT = DIMATT - LMAX + IC
      IF (IFORM.EQ.1) then
        IF (IONIVE .GE. 26) THEN
          WRITE(NBAND,8010) ic
          WRITE(NBAND,8010) (ITABC(i),i=1,ic)
 8010     FORMAT(10(1X,I12))
        ELSE
          WRITE(NBAND,8000) ic
          WRITE(NBAND,8000) (ITABC(i),i=1,ic)
 8000     FORMAT(10I8)
        ENDIF
      ENDIF
      IF (IFORM.EQ.0) then
        write(nband) ic
        WRITE(NBAND) (ITABC(i),i=1,ic)
      endif
      IF (iform.eq.2) then
        ios=IXDRINT ( ixdrw, ic)
        ios=IXDRIMAT( ixdrw, ic,itabc(1))
      ENDIF

* Sortie brute des donnees (avant le niveau 20)
      ELSE
        lmaxl = LMAX
        IF (IFORM.EQ.1)WRITE(NBAND,8001) (ITAB(i),i=1,lmaxl)
 8001   FORMAT(10I8)
        IF (IFORM.EQ.0)WRITE(NBAND) (ITAB(i),i=1,lmaxl)
        IF (iform.eq.2) ios=IXDRIMAT( ixdrw, lmaxl,itab(1))
      ENDIF

      RETURN

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

      END

 
