C KOPSID    SOURCE    GOUNAND   11/05/24    21:15:38     6976           
      SUBROUTINE KOPSID
C     
C************************************************************************
C     
C PROJET            :  CASTEM 2000
C     
C NOM               :  KOPSID
C     
C DESCRIPTION       :  Cette subroutine cree la matrice identité
C                      sous la forme des objets elementaires de type
C                      MATRIK
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' 'MATIDE' LMOT1 GEO1 ('MATRIK') ;  
C
C ENTREES  : LMOT1   : objet de type LISTMOTS des variables primales (et 
C                      duales)
C     
C            GEO1    : objet de type MAILLAGE, des variables primales
C                      (et duales) 
C     
C SORTIES:   MAT1    : objet de type RIGIDITE ou MATRIK, 
C                      qui contient la matrice identité
C              Mis à jour le 18/05/2011
C************************************************************************
C     
C HISTORIQUE (Anomalies et modifications éventuelles)
C     
C HISTORIQUE : Cree le 23-8-2000
C     
C************************************************************************
C     
C**** Les includes
C     
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
C  
      CHARACTER*6 MOT(1)
      CHARACTER*8 MTYP
      DATA MOT/'MATRIK'/
C
      CALL QUETYP(MTYP,0,IRET)
      IF(IRET.EQ.0)THEN
         MOTERR(1:8) = 'LISTMOTS'
C
C******* Message d'erreur
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         CALL ERREUR(37)
         GOTO 9999
      ELSEIF(MTYP .EQ. 'LISTMOTS')THEN
         CALL LIROBJ('LISTMOTS',LPRIM,1,IRET)
      ELSE
         MOTERR(1:8) = 'LISTMOTS'
C
C******* Message d'erreur
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         CALL ERREUR(37)
         GOTO 9999
      ENDIF
C     
      CALL QUETYP(MTYP,0,IRET)
      IF(IRET.EQ.0)THEN
         MOTERR(1:8) = 'MAILLAGE'
C
C******* Message d'erreur
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         CALL ERREUR(37)
         GOTO 9999
      ELSEIF(MTYP .EQ. 'MAILLAGE')THEN
         CALL LIROBJ('MAILLAGE',IGEOM,1,IRET)
      ELSE
         MOTERR(1:8) = 'MAILLAGE'
C
C******* Message d'erreur
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         CALL ERREUR(37)
         GOTO 9999
      ENDIF
*
      CALL LIRMOT(MOT,1,IRAN,0)
      IF (IRAN.EQ.1) THEN
         CALL KOPIDK(IGEOM,LPRIM,MATRIK)
         IF (IERR.NE.0) GOTO 9999
         CALL ECROBJ('MATRIK',MATRIK)
      ELSE
         CALL KOPIDR(IGEOM,LPRIM,MRIGID)
         IF (IERR.NE.0) GOTO 9999
         CALL ECROBJ('RIGIDITE',MRIGID)
      ENDIF
C      
 9999 RETURN
      END