C KOPDIA    SOURCE    GOUNAND   11/05/24    21:15:28     6976           
      SUBROUTINE KOPDIA
C     
C************************************************************************
C     
C PROJET            :  CASTEM 2000
C     
C NOM               :  KOPDIA
C     
C DESCRIPTION       :  Cette subroutine cree une matrice diagonale
C                      sous la forme des objets elementaires de type
C                      MATRIK, les coefficients sont donnés par un
C                      chpoi appuyé sur le support des inconnues
C     
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C     
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
C                      S. GOUNAND
C************************************************************************
C     
C     
C APPELES (Outils)  : 
C     
C APPELES (Calcul)  : 
C     
C     
C************************************************************************
C     
C PHRASE D'APPELLE GIBIANE
C
C MAT1 = 'KOPS' 'MATDIA' CH1 ('MATRIK') ;  
C
C ENTREES  : CH1     : champoint de coefficients sur la diagonale,
C                      appuyé sur le maillage primal
C     
C SORTIES:   MAT1    : objet de type RIGIDITE ou MATRIK, 
C                      qui contient la matrice diagonale
C     
C************************************************************************
C     
C HISTORIQUE (Anomalies et modifications éventuelles)
C     
C HISTORIQUE : Cree le 23-8-2000
C              Mis à jour le 02/05/2011
C************************************************************************
C     
C**** Les includes
C     
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
C  
C     
      CHARACTER*6 MOT(1)
      CHARACTER*8 MTYP
      DATA MOT/'MATRIK'/
C
      MTYP='CHPOINT '
      CALL LIROBJ(MTYP,MCHPOI,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
      CALL LIRMOT(MOT,1,IRAN,0)
      IF (IRAN.EQ.1) THEN
         CALL KOPDIK(MCHPOI,MATRIK)
         IF (IERR.NE.0) GOTO 9999
         CALL ECROBJ('MATRIK',MATRIK)
      ELSE
         CALL KOPDIR(MCHPOI,MRIGID)
         IF (IERR.NE.0) GOTO 9999
         CALL ECROBJ('RIGIDITE',MRIGID)
      ENDIF
C      
 9999 RETURN
      END