C KOPDIK    SOURCE    CB215821  20/11/25    13:32:43     10792          
      SUBROUTINE KOPDIK(MCHPOI,MATRIK)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : KOPDIK
C DESCRIPTION : Transforme un CHPOINt MCHPOI en matrice
C               diagonale MATRIK
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            : MATRIK
C***********************************************************************
C VERSION    : v1, 10/05/2011, version initiale
C HISTORIQUE : v1, 10/05/2011, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
-INC PPARAM
-INC CCOPTIO
-INC SMMATRIK
-INC SMCHPOI
-INC SMELEME
*
* Executable statements
*
      SEGACT MCHPOI
      NSOUPO = IPCHP(/1)
      NRIGE = 7
      NMATRI = NSOUPO
      NKID = 9
      NKMT = 7
      SEGINI MATRIK
C
      DO ISOUPO = 1, NSOUPO
         MSOUPO = IPCHP(ISOUPO)
         SEGACT MSOUPO
         NC=NOCOMP(/2)
         NBME=NC
         NBSOUS=1
         SEGINI IMATRI
         IRIGEL(4,ISOUPO)=IMATRI
         MELEME=IGEOC
         MPOVAL=IPOVAL
         SEGACT MPOVAL
         IRIGEL(1,ISOUPO)=MELEME
         IRIGEL(2,ISOUPO)=MELEME
* Diagonal
         IRIGEL(7,ISOUPO)=5
         SEGACT MELEME
         NBEL=NUM(/2)
         SEGDES MELEME
         NP=1
         MP=1
         DO IC=1,NC
            LISPRI(IC)=NOCOMP(IC)
            LISDUA(IC)=NOCOMP(IC)
            SEGINI IZAFM
            LIZAFM(1,IC)=IZAFM
            DO IBEL=1,NBEL
               AM(IBEL,1,1)=VPOCHA(IBEL,IC)
            ENDDO
            SEGDES IZAFM
         ENDDO
         SEGDES MPOVAL
         SEGDES IMATRI
         SEGDES MSOUPO
      ENDDO
      SEGDES MATRIK
      SEGDES MCHPOI
*
* Normal termination
*
      RETURN
*
* End of subroutine KOPDIK
*
      END