C PRCMCT    SOURCE    GOUNAND   25/05/20    21:15:03     12271          
      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 PPARAM
-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
         ELSE
           CALL ACTOBJ('CHPOINT ',ICHP,1)
         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
         ELSE
            CALL ACTOBJ('CHPOINT ',ICHP,1)
         ENDIF
         CALL CMCT3(ICHP,IRIGC,IRIGB,IRIG2)
         IF (IERR.NE.0) RETURN
*
         CALL ACTOBJ('RIGIDITE',IRIG2,1)
         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