C CORIOL    SOURCE    CB215821  19/08/01    21:15:33     10279          
      SUBROUTINE CORIOL

C***********************************************************************
C                                                                      *
C  Première option :                                                   *
C                                                                      *
C      FABRICATION DE LA MATRICE DE COUPLAGE DE CORIOLIS DANS          *
C      LE REPERE TOURNANT (ELEM BARR, POUT, TUYAU, COQUE, MASSIF 3D)   *
C                                                                      *
C  Syntaxe :                                                           *
C  --------                                                            *
C                                                                      *
C    RIG1 = CORI MODL1 MAT1  VEC1                                      *
C                                                                      *
C  RIG1 : matrice d'amortissement construite (TYPE rigidité, SOUS-TYPE *
C         amortissement)                                               *
C  MODL1: objet MMODEL, modèle                                         *
C  MAT1 : objet MCHAML, caractéristiques matériau                      *
C  VEC1 : objet POINT, vecteur rotation                                *
C                                                                      *
C                                                                      *
C                     Didier COMBESCURE mars 2003                      *
C                                                                      *
C***********************************************************************

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)


-INC PPARAM
-INC CCOPTIO
c
      CHARACTER*4 LISMO1(1),LISMO2(1)
      DATA LISMO1 / 'HARM' /
      DATA LISMO2 / 'FLAM' /

      IPMODL = 0
      IPCHE1 = 0
      IPROTA = 0

      NUMLI1 = 0
      NUMLI2 = 0

      IPRIG  = 0
C
C  lecture du modèle
C
      CALL LIROBJ('MMODEL  ',IPMODL,1,iretou)
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF (IERR.NE.0) RETURN
C
C  lecture du mchaml de caractéristiques matériau
C
      CALL LIROBJ('MCHAML',IPIN,1,iretou)
      CALL ACTOBJ('MCHAML',IPIN,1)
      IF (IERR.NE.0) RETURN
      CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
      IF(IR   .NE. 1) CALL ERREUR(KER)
      IF(IERR .NE. 0) RETURN
c
C  lecture du point vecteur de rotation
C
      CALL LIROBJ('POINT',IPROTA,0,iretou)
      IF (IERR.NE.0) RETURN
C
C  lecture du mot clé pour le calcul direct d'impedance (pour Fourier)
C
      CALL LIRMOT(LISMO1,1,NUMLI1,0)
      IF (IERR.NE.0) RETURN
      CALL LIRMOT(LISMO2,1,NUMLI2,0)
      IF (IERR.NE.0) RETURN
C
*********************************************
*    Matrice de couplage de Coriolis
**********************************************
      CALL CORIO1(IPMODL,IPCHE1,IPROTA,NUMLI1,NUMLI2, IPRIG)
C
      IF (IPRIG.NE.0 .AND. IERR.EQ.0) THEN
        CALL ECROBJ('RIGIDITE',IPRIG)
      ENDIF

      END