C FILLP1    SOURCE    PV        21/01/21    21:15:25     10862          
      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 PPARAM
-INC CCOPTIO
-INC SMELEME
-INC TMCOLAC
      SEGMENT ILISBB
           INTEGER ILISOB(MLON)
      ENDSEGMENT
      CHARACTER*8 CTYP
      DIMENSION ILENA(10)
      DATA CTYP/'MAILLAGE'/
      iun=1
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,iun)
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,iun)
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,iun)
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






 
 
 
