C HOOKE     SOURCE    PV        20/03/30    21:19:48     10567          
      SUBROUTINE HOOKE
C_______________________________________________________________________
C
C     Op{rateur de cr{ation d'un MCHAML de matrice de HOOKE
C
C     Nouvelle syntaxe:
C     _________________
C
C       HO1=HOOKE MOD1 CAR1 ( VA1 ) ;
C
C          MOD1 Pointeur sur un MMODEL
C          CAR1 Pointeur sur un MCHAML de caract{ristiques
C          VA1  Pointeur sur un MCHAML de variables internes(facultatif)
C          HO1  Pointeur sur un MCHAML de MATRICE DE HOOKE
C
C
C     CODE L.EBERSOLT MAI 84
C
C     Passage aux nouveaux CHAMELEMs par I.Monnier le 15.06.90
C
C_______________________________________________________________________
C
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
C
      CHARACTER*4 MOREFE(1)
      DATA MOREFE/'REFE'/
      segact mcoord
      IPCHE1=0
      IPCHE2=0
*
*  LECTURE DU MOT REFE EVENTUELLEMENT
*
      CALL LIRMOT(MOREFE,1,LASURF,0)
      IF (IERR.NE.0) RETURN
C
C     LECTURE DU MODELE
C
      CALL LIROBJ('MMODEL  ',IPMODL,0,IRT1)
      IF(IRT1 .EQ. 1) CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF (IERR.NE.0) RETURN
C
C       LECTURE DU MCHAML DE CARACTERISTIQUES GEOMETRIQUES ET MATERIELLE
C
      CALL LIROBJ('MCHAML  ',IPIN,1,IRT1)
      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 MCHAML DE VARIABLES INTERNES
C
      CALL LIROBJ('MCHAML  ',IPIN,0,IRT2)
      IF (IERR.NE.0) RETURN
      IPCHE2=0
      IF (IRT2 .EQ. 1) THEN
        CALL ACTOBJ('MCHAML  ',IPIN,1)
        CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
        IF(IR   .NE. 1) CALL ERREUR(KER)
        IF(IERR .NE. 0) RETURN
      ENDIF
C
C     CALCUL DE LA MATRICE DE HOOKE
C
      CALL HOOK2P(IPMODL,IPCHE1,IPCHE2,LASURF,IPCHOO,IRT1)
      IF(IERR .NE. 0) RETURN
      IF(IRT1.EQ.0) GOTO 666
C
C     ECRITURE DU RESULTAT
C
        CALL ACTOBJ('MCHAML  ',IPCHOO,1)
        CALL ECROBJ('MCHAML  ',IPCHOO)
  666 CONTINUE
      END