C COMPAC    SOURCE    PV        13/10/14    21:17:44     7838           
      SUBROUTINE COMPAC(VAL,NBPAR,KIVPO,KIVLO,NVALL,IPPVV,
     >                  IZROFS,NA,PREC,imasq)
******                                                                          
*  COMPACTE UNE LIGNE DE LA MATRICE. TOUTES SEQUENCES DE IZROFS VALEURS         
*  INFERIEURES A PREC SONT ELIMINEES
*                                                                               
******                                                                          
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC CCHOLE
      DIMENSION VAL(*),KIVPO(*),KIVLO(*),IPPVV(*),imasq(*)
      IDECI=0                                                                   
      NBPAR=0                                                                   
      DO 140 KHG=1,NA                                                           
      LHG=IPPVV(KHG)+1                                                          
      VAL(LHG-IDECI)=VAL(LHG)                                                   
      IBL=LHG+1                                                                 
      NBPAR=NBPAR+1                                                             
      KIVPO(NBPAR)=LHG                                                          
      KIVLO(NBPAR)=LHG-IDECI                                                    
      IDEB=IZROFS+LHG                                                           
      IPPVV(KHG)=NBPAR                                                          
      IFIN=IPPVV(KHG+1)                                                         
   1  CONTINUE                                                                  
* ON SUPPOSE ICI QUE TOUT CE QUI EST JUSQU'A ( IDEB-IZROFS)                     
* EST BIEN PLACE                                                                
* IBL INDIQUE LA PREMIERE VALEUR NON TRAITE DANS LE DECALAGE                    
* IDECI EST LA VALEUR DU DECALAGE A FAIRE                                       
      DO 2 I=IDEB,IFIN-1,IZROFS                                                 
      IF(ABS(VAL(I)).LT.PREC ) THEN
        I1=I-IZROFS+1                                                           
        I2=I                                                                    
        GO TO 10                                                                
      ENDIF                                                                     
   2  CONTINUE                                                                  
      IF( IDECI.EQ.0) GO TO 140                                                 
      DO 3 J=IBL,IFIN                                                           
      VAL(J-IDECI)=VAL(J)                                                       
   3  CONTINUE                                                                  
      GO TO 140                                                                 
*                                                                               
*  ON EST EN PRESENCE D'UN 'ZERO' IL FAUT TESTER SI TOUTES LES VALEURS          
*  SONT NULLES                                                                  
*                                                                               
  10  CONTINUE
**    JCOU=( I2 + I1) /2
**    IF(JCOU.EQ.I1) GO TO 20
**    IF(ABS(VAL(JCOU)).GT.PREC ) THEN
*  ON REPREND LA BOUCLE INITIALE A PARTIR DE CETTE VALEUR NON NULLE             
**      IDEB= JCOU
**      GO TO 1
**    ENDIF
**    I2= JCOU
**    GO TO 10
   20  CONTINUE                                                                 
* PAR DICHOTOMIE ON A TROUVE QUE DES VALEURS NULLES, ON PART EN TEST            
* CONTINU A PARTIR DE I1                                                        
*
*  plus de dichotomie, mais
*  utilisation de itmasq pour accelerer la recherche
*
      DO 24 I = I1,min((i1/masdim+1)*masdim,ifin)
      IF(ABS(VAL(I)).GT.PREC) THEN
        I3= I                                                                   
        GO TO 30                                                                
      ENDIF                                                                     
   24 CONTINUE
      ipr=i1/masdim+1
   27 continue
      do 25 im=ipr,ifin/masdim
       if (imasq(im+1).gt.0) goto 26
       if (imasq(im+1).lt.0) then
        ipr=-(imasq(im+1)/masdim)+1
***     write (6,*) ' compac acceleration ',im,ipr
        goto 27
       endif

  25  continue
  26  continue
      i1b=im*masdim
      DO 21 I = I1b,IFIN
      IF(ABS(VAL(I)).GT.PREC) THEN
        I3= I                                                                   
        GO TO 30                                                                
      ENDIF                                                                     
   21 CONTINUE                                                                  
*  SI QUE DES VALEURS NULLES GARDER DERNIERE SINON PLOUFPLOUF DANS CHOLE        
      I3=IFIN                                                                   
      GOTO 30                                                                   
* IL N'Y A QUE DES VALEURS NULLES ON MET A JOUR IDECI ET ON SORT                
*     IDECI = IDECI + IFIN - I1 +1                                              
*     RETURN                                                                    
   30 CONTINUE                                                                  
* IL FAUT SAVOIR SI I3 -I1 EST SUPERIEUR A EST IZROFS                           
      IF(I3-I1.GE.IZROFS) THEN                                                  
* OUI IL FAUT COMPACTER LE PRECEDENT ET POSITIONNER I3                          
        IF(IDECI.NE.0) THEN                                                     
            DO 33 J=IBL,I1-1                                                    
            VAL(J-IDECI)=VAL(J)                                                 
   33       CONTINUE                                                            
         ENDIF                                                                  
         IBL=I3+1                                                               
         IDECI=IDECI+I3-I1                                                      
         VAL(I3-IDECI)=VAL(I3)                                                  
         NBPAR=NBPAR+1                                                          
         KIVPO(NBPAR)=I3                                                        
         KIVLO(NBPAR)=I3-IDECI                                                  
      ENDIF                                                                     
         IDEB=I3+IZROFS                                                         
        GO TO 1                                                                 
 140  CONTINUE                                                                  
      NBPAR=NBPAR+1                                                             
      KIVPO(NBPAR)=IPPVV(NA+1)+1                                                
      IPPVV(NA+1)=NBPAR                                                         
      NVALL=IFIN-IDECI                                                          
      KIVLO(NBPAR)=NVALL+1                                                      
      RETURN                                                                    
      END