C EXTIPD    SOURCE    PV        20/09/26    21:16:51     10724          
      SUBROUTINE EXTIPD
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : EXTIPD
C DESCRIPTION : Extrait les noms d'inconnues primales ou duales
C               d'un MATRIK, on réduit à CH*4 pour des raisons
C               de compatibilité
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          :
C APPELES (E/S)    :
C APPELES (BLAS)   :
C APPELES (CALCUL) :
C APPELE PAR       :
C***********************************************************************
C SYNTAXE GIBIANE    :
C    LMOT1  = 'KOPS'  'EXTRINPR'  MATRIK1  ;
C    LMOT1  = 'KOPS'  'EXTRINDU'  MATRIK1  ;
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            :
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 10/05/2006, version initiale
C HISTORIQUE : v1, 10/05/2006, création
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 PPARAM
-INC CCOPTIO
-INC SMMATRIK
-INC SMLMOTS
      POINTEUR LINC.MLMOTS
      POINTEUR LINC2.MLMOTS
*
      INTEGER IMPR,IRET
*
* Executable statements
*
      IMPR=0
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans extipd.eso'
      CALL LIROBJ('MATRIK  ',MATRIK,1,IRETOU)
      IF (IERR.NE.0) RETURN
* D'abord les primales puis les duales
* On renverse l'ordre car ecrobj écrit sur une pile
      DO IPRIDU=2,1,-1
*
* Dim max de LINC
*
         JGM=0
         SEGACT MATRIK
         NMAT=IRIGEL(/2)
         DO IMAT=1,NMAT
            IMATRI=IRIGEL(4,IMAT)
            SEGACT IMATRI
            JGM=JGM+LIZAFM(/2)
         ENDDO
*
* Remplissage de LINC
*
         JGN=4
         IGM=0
         SEGINI LINC
         DO IMAT=1,NMAT
            IMATRI=IRIGEL(4,IMAT)
            NBME=LIZAFM(/2)
            DO IBME=1,NBME
               IGM=IGM+1
               IF (IPRIDU.EQ.1) THEN
                  LINC.MOTS(IGM)=LISPRI(IBME)
               ELSEIF (IPRIDU.EQ.2) THEN
                  LINC.MOTS(IGM)=LISDUA(IBME)
               ELSE
                  GOTO 9999
               ENDIF
            ENDDO
            SEGDES IMATRI
         ENDDO
         SEGDES MATRIK
*
* Enlever les doublons dans LINC
*
         SEGINI,LINC2=LINC
         CALL CUNIQ(LINC2.MOTS,LINC2.MOTS(/1),LINC2.MOTS(/2),
     $        LINC.MOTS,NIUNIQ,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         JGN=4
         JGM=NIUNIQ
         SEGADJ,LINC
         SEGSUP LINC2
         SEGDES LINC
         CALL ECROBJ('LISTMOTS',LINC)
      ENDDO
*
* Normal termination
*
*      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
*      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine extipd'
      CALL ERREUR(5)
      RETURN
*
* End of subroutine EXTIPD
*
      END