C KOPDIR    SOURCE    GOUNAND   11/05/25    21:15:18     6980           
      SUBROUTINE KOPDIR(MCHPOI,MRIGID)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : KOPDIR
C DESCRIPTION : Transforme un CHPOINt MCHPOI en matrice 
C               diagonale MRIGID
C
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 ENTREES            : MCHPOI
C ENTREES/SORTIES    :
C SORTIES            : MRIGID
C***********************************************************************
C VERSION    : v1, 10/05/2011, version initiale
C HISTORIQUE : v1, 10/05/2011, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
-INC CCOPTIO
-INC SMRIGID
-INC SMCHPOI
-INC SMELEME
-INC CCHAMP
*     
* Executable statements
*
      SEGACT MCHPOI
      NSOUPO = IPCHP(/1)
C On compte le nombre de matrices à générer
      NRIGEL=0
      DO ISOUPO = 1, NSOUPO
         MSOUPO = IPCHP(ISOUPO)
         SEGACT MSOUPO
         NC=NOCOMP(/2)
         NRIGEL=NRIGEL+NC
         SEGDES MSOUPO
      ENDDO
      SEGINI MRIGID
      MTYMAT='DIAGONAL'
      IRIG=0
C
      DO ISOUPO = 1, NSOUPO
         MSOUPO = IPCHP(ISOUPO)
         SEGACT MSOUPO
         NC=NOCOMP(/2)
         MELEME=IGEOC
         SEGACT MELEME
         NBEL=NUM(/2)
         SEGDES MELEME
         MPOVAL=IPOVAL
         SEGACT MPOVAL
         DO IC=1,NC
            IRIG=IRIG+1
            COERIG(IRIG)=1.D0
            IRIGEL(1,IRIG)=MELEME
            NLIGRP=1
            NLIGRD=1
            SEGINI DESCR
            LISINC(1)=NOCOMP(IC)
            CALL PLACE(NOMDD,LNOMDD,idx,NOCOMP(IC))
            IF (idx.NE.0) THEN
               LISDUA(1)=NOMDU(idx)
            ELSE
               LISDUA(1)=NOCOMP(IC)
            ENDIF
            NOELEP(1)=1
            NOELED(1)=1
            SEGDES DESCR
            IRIGEL(3,IRIG)=DESCR
            NELRIG=NBEL
            SEGINI XMATRI
            DO IBEL=1,NBEL
               RE(1,1,IBEL)=VPOCHA(IBEL,IC)
            ENDDO
            SEGDES XMATRI
            IRIGEL(4,IRIG)=XMATRI
         ENDDO
         SEGDES MPOVAL
         SEGDES MSOUPO
      ENDDO
      SEGDES MRIGID
      SEGDES MCHPOI
*
* Normal termination
*
      RETURN
*
* End of subroutine KOPDIR
*
      END