C KOPDIR    SOURCE    PV090527  26/04/30    21:15:46     12529          
      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 PPARAM
-INC CCOPTIO
-INC SMRIGID
-INC SMCOORD
-INC SMCHPOI
-INC SMELEME
-INC CCHAMP

      CHARACTER*4 MOMOT(1)
      CHARACTER*8 LETYPE
      DATA MOMOT(1) /'TYPE'/

* BP 01/04/2014 ajout d'un type a la rigidite (recopie de manuri.eso)
*     -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
      ITYP = 0
      CALL LIRMOT(MOMOT,1,ITYP,0)
      IF(ITYP.EQ.1) THEN
         ICODE = 1
         CALL LIRCHA (LETYPE,ICODE,IRETOU)
C        write(ioimp,*) 'lecture de TYPE et du type:',LETYPE,':'
         IF (IERR .NE. 0) RETURN
      ELSE
C ... Si on n'a rien trouvé, on met DIAGONAL dedans,
C     sinon il y a des cochonneries ...
         LETYPE='DIAGONAL'
      ENDIF
C Pour le mode de calcul, on prend celui du CHPOINT
*
* 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
c*         SEGDES MSOUPO
      ENDDO
      SEGINI MRIGID
      MTYMAT=LETYPE
      IFORIG=IFOPOI

      IRIG=0
C
      DO ISOUPO = 1, NSOUPO
         MSOUPO = IPCHP(ISOUPO)
c*         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
            RIGREL=0
            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