C PRCMCT    SOURCE    GOUNAND   11/05/25    21:15:27     6980           
      SUBROUTINE PRCMCT()
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : PRCMCT
C DESCRIPTION : Préparation du calcul de CD-1Bt, on effectue les boucles
C               sur les matrices élémentaires.  
C     
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : PROMAT
C APPELES (E/S)    : LIROBJ, ECROBJ
C APPELES (STAT)   : INMSTA, PRMSTA, SUMSTA
C APPELE PAR       : RYO2V
C***********************************************************************
C SYNTAXE GIBIANE    : MATCDB = 'KOPS' 'CMCT' MATC MATB CHPOD
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 28/01/2000, version initiale réécrite
C HISTORIQUE : v1, 28/01/2000, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
-INC CCOPTIO
*     
      INTEGER IMPR,IRET
      CHARACTER*8 MONTYP
*
* Executable statements
*     
      IMPR=IIMPI
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prcmct'
*     
* Lecture des arguments
*     
      CALL QUETYP(MONTYP,0    ,IRETOU)                                          
      IF (IRETOU.EQ.0) THEN                                                     
         CALL ERREUR(533)                                                       
         RETURN                                                                 
      ENDIF       
* Deux matrices : C et B
*
* Avec des MATRIK
*
      IF (MONTYP.EQ.'MATRIK  ') THEN
         CALL LIROBJ('MATRIK  ',MATC,1,IRETOU)
         IF (IERR.NE.0) RETURN
         CALL LIROBJ('MATRIK  ',MATB,1,IRET)
         IF (IERR.NE.0) RETURN
* Le chpoint matrice-masse diagonale D
         CALL LIROBJ('CHPOINT ',ICHP,0,IRET)
         IF (IRET.EQ.0) THEN
            ICHP=0
         ENDIF
*
         CALL PRCMCK(MATC,MATB,ICHP,MATCDB,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*     
         CALL ECROBJ('MATRIK  ',MATCDB)
*
* Avec des RIGIDITE
*
      ELSEIF (MONTYP.EQ.'RIGIDITE') THEN
         CALL LIROBJ('RIGIDITE',IRIGC,1,IRET)
         IF (IERR.NE.0) RETURN
         CALL LIROBJ('RIGIDITE',IRIGB,1,IRET)
         IF (IERR.NE.0) RETURN
* Le chpoint matrice-masse diagonale D
         CALL LIROBJ('CHPOINT ',ICHP,0,IRET)
         IF (IRET.EQ.0) THEN
            ICHP=0
         ENDIF
         CALL CMCT3(ICHP,IRIGC,IRIGB,IRIG2)
         IF (IERR.NE.0) RETURN
*
         CALL ECROBJ('RIGIDITE',IRIG2)
      ELSE
         MOTERR(1:8)=MONTYP
         CALL ERREUR(39)
      ENDIF
*     
* Normal termination
*     
*      IRET=0
      RETURN
*     
* Format handling
*     
*     
* Error handling
*     
 9999 CONTINUE
*     IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine prcmct'
      CALL ERREUR(5)
      RETURN
*     
* End of subroutine PRCMCT
*     
      END