C KRIPAD    SOURCE    PV        13/04/12    21:15:43     7756           
      SUBROUTINE KRIPAD(MELEM0,MLENTI)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C*************************************************************************
C  Cree et remplit un segment MLENTI avec le meleme qu'on lui envoie
C  Si le meleme envoyé n'est pas composé de POI1 On le cree
C  et on le detruit apres
C*************************************************************************
C HISTORIQUE : 26/10/98 : si on envoie un MELEM0 de pointeur 
C              nul alors le MLENTI en sortie ne contient que
C              des zeros.
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
-INC CCOPTIO
-INC SMCOORD
-INC SMLENTI
-INC SMELEME
      POINTEUR MELEM1.MELEME
      POINTEUR MELEM0.MELEME
      CHARACTER*8 TYPE
C***  
      JG=XCOOR(/1)/(IDIM+1)
      SEGINI MLENTI
      MELEM1=0
      MELEME=MELEM0
      IF (MELEME.NE.0) THEN
         SEGACT MELEME
         IF(ITYPEL.NE.1)THEN
            CALL ECRCHA('POI1')
            CALL ECROBJ('MAILLAGE',MELEME)
            CALL PRCHAN
            TYPE='MAILLAGE'
            CALL LIROBJ(TYPE,MELEM1,1,IRET)
            IF(IRET.EQ.0)THEN
               WRITE(IOIMP,*) 'On n''arrive pas a creer'
               WRITE(IOIMP,*) 'un MELEME de POI1.'
               MLENTI=0
C              SEGDES MELEM0
               GOTO 9999
            ENDIF
            MELEME=MELEM1
            SEGACT MELEME
         ENDIF
         NPTD=NUM(/2)
         CALL RSETXI(LECT,NUM,NPTD)
***      IF(MELEM1.NE.0)SEGSUP MELEM1
C        SEGDES MELEM0
      ENDIF
*
* Normal termination
*
      RETURN
*
* Error handling
*
 9999 CONTINUE
      WRITE(IOIMP,*) 'An error was detected in subroutine kripad'
      RETURN
      END