C WORK      SOURCE    CB215821  19/08/01    21:16:46     10279          
      SUBROUTINE WORK
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C=======================================================================
C
C                   DENSITE D'ENERGIE
C     CALCULE LE MCHAML   PRODUIT   SIGMA * GRADIENT
C
C              SYNTAXE  WORK1=WORK MODL1  SIG1  GRAD1( GRAF1)
C      MODL1= OBJET DE TYPE MMODEL
C      SIG1 = CHAMP DE CONTRAINTE (TYPE MCHAML)
C      GRAD1= CHAMP DE GRADIENT (TYPE MCHAML)
C      GRAF1= CHAMP DE GRADIENT DE FLEXION (TYPE MCHAML)
C      WORK1=CHAMP DE DENSITE D'ENERGIE (TYPE MCHAML)
C     CODE DE SUO X.Z.
C     PASSAGE AUX NOUVEAUX CHAMELEMS PAR P. DOWLATYARI LE 25/4/91
C=======================================================================
C

-INC PPARAM
-INC CCOPTIO
C
       IPMODL=0
       IPCHE1=0
       IPCHE2=0
       IPCHE3=0
       IPCHE4=0
C
C    LECTURE D'UN OBJET MMODEL
C
       CALL LIROBJ('MMODEL  ',IPMODL,1,IRET)
       CALL ACTOBJ('MMODEL  ',IPMODL,1)
       IF(IERR.NE.0)RETURN
C
C  ****  LECTURE DU PREMIER CHAMP/ELEMENT
C
        CALL LIROBJ('MCHAML  ',IPIN,1,IRET)
        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 DEUXIEME CHAMP/ELEMENT
C
        CALL LIROBJ('MCHAML  ',IPIN,1,IRET)
        CALL ACTOBJ('MCHAML  ',IPIN,1)
        IF(IERR.NE.0) RETURN
        CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
        IF(IR   .NE. 1) CALL ERREUR(KER)
        IF(IERR .NE. 0) RETURN
C
C
C  ****  LECTURE DU TROISIEME CHAMP SI COQUE , QUI DOIT ETRE GRAF
C
        CALL LIROBJ('MCHAML  ',IPIN,0,IRET)
        IF(IERR.NE.0)RETURN
        IPCHE3=0
        IF (IRET .EQ. 1) THEN
          CALL ACTOBJ('MCHAML  ',IPIN,1)
          CALL REDUAF(IPIN,IPMODL,IPCHE3,0,IR,KER)
          IF(IR   .NE. 1) CALL ERREUR(KER)
          IF(IERR .NE. 0) RETURN
        ENDIF
C
      CALL WORKP(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCHE4,IRET)
C
      IF(IRET.NE.0) THEN
        CALL ACTOBJ('MCHAML  ',IPCHE4,1)
        CALL ECROBJ('MCHAML  ',IPCHE4)
      ENDIF

      END