C FILLP1    SOURCE    CHAT      05/01/13    00:00:17     5004           
      SUBROUTINE FILLP1 (ICOLAC,IMAX)                                           
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
C=======================================================================        
C                                                                               
C        ON COMPLETE LA PILE DE MELEME                                          
C                         IMAX : NUMERO MAX DE POINT                            
C                                                                               
C    ECRIT PAR FARVACQUE -REPRIS PAR LENA                                       
C    APPELE PAR SAUVV                                                           
C    APPELLE : AJOUN  SNOM2 REPERT                                              
C=======================================================================        
-INC CCOPTIO
-INC SMELEME                                                                    
-INC TMCOLAC
      SEGMENT ILISBB
           INTEGER ILISOB(MLON)
      ENDSEGMENT                                
      CHARACTER*8 CTYP                                                          
      DIMENSION ILENA(10)                                                       
      DATA CTYP/'MAILLAGE'/                                                     
C                                                                               
C                                                                               
C  **** ON PREND TOUS LES MELEME DONT TOUS LES NOEUDS SONT INFERIEURS           
C  **** A IMAX . IL Y EN A IMAX2                                                
C                                                                               
      SEGACT ICOLAC 
      ILISSE=ILISSG
      SEGACT ILISSE*MOD                                                            
      CALL LISTOB(CTYP,MLON,ILENA,0)
      SEGINI ILISBB
      CALL LISTOB(CTYP,N,ILISOB,1)                                                                                
C      CALL REPERT (CTYP  ,N)                                                    
      IF (N.EQ.0) GO TO 100                                                     
      ICO=KCOLA(1)                                                              
      ITLACC =KCOLA (1)                                                         
      DO 200 M=1,N
      MELEME=ILISOB(M)                                                              
C      CALL LIROBJ(CTYP,MELEME,1,IRETOU)                                         
      IF(IERR.NE.0) RETURN                                                      
      CALL SNOM2 (MELEME,ITLACC,IRET)                                           
      IF (IRET.GT.0) GOTO 200                                                   
C --- LE MELEME N EST PAS DANS LA PILE                                          
C --- ON REGARDE SI SES NUMEROS SONT .LE.IMAX                                   
      SEGACT MELEME                                                             
C                                                                               
      IPT1=MELEME                                                               
      NTOTO=LISOUS(/1)                                                          
      KRET=0                                                                    
      IF(NTOTO.NE.0) GOTO 53                                                    
      CALL TESTNU (MELEME,IMAX,IRET)                                            
      KRET=IRET                                                                 
      GO TO 54                                                                  
   53 CONTINUE                                                                  
      DO 52 JJ=1,NTOTO                                                          
      MELEME=IPT1.LISOUS(JJ)                                                    
      CALL TESTNU (MELEME,IMAX,IRET)                                            
      KRET=KRET+IRET                                                            
 52   CONTINUE                                                                  
  54  MELEME=IPT1                                                               
      IF(KRET.NE.0) GOTO 51                                                     
C --- CE MELEME A SES NUM INFERIEURS OU EGAL A IMAX                             
C --- ON LE RAJOUTE DANS LA PILE 1                                              
C --- AINSI QUE SES LISOUS ET LISREF                                            
      IVA=IPT1                                                                  
      CALL AJOUN (ITLACC,IVA,ILISSE,1)                                                   
C                                                                               
      SEGACT MELEME                                                             
      IF(LISOUS(/1).EQ.0) GO TO 58                                              
      DO 59 I=1,LISOUS(/1)                                                      
      IVA=LISOUS(I)                                                             
      CALL AJOUN(ITLACC,IVA,ILISSE,1)                                                    
C     LISOUS(I)=IVA                                                             
 59   CONTINUE                                                                  
 58   IF(LISREF(/1).EQ.0) GOTO 64                                               
      DO 61 I=1,LISREF(/1)                                                      
      IVA=LISREF(I)                                                             
      CALL AJOUN(ITLACC,IVA,ILISSE,1)                                                    
C     LISREF(I)=IVA                                                             
 61   CONTINUE                                                                  
 64   SEGDES MELEME                                                             
 51   CONTINUE                                                                  
C-----------------ATTENTION Y A T IL PLUSIEURS NIVEAUX DE LISTREF               
C-----------------SI OUI OBLIGATION DE REFAIRE UN PASSAGE DANS FILLPI           
 200  CONTINUE                                                                  
C                                                                               
 100  CONTINUE 
      SEGSUP ILISBB
*      SEGDES ILISSE                                                                 
      SEGDES ICOLAC                                                             
      RETURN                                                                    
      END