C PENDI1    SOURCE    OF166741  24/12/13    21:16:51     12097          
      SUBROUTINE PENDI1(IMOT,IFAC,ICHPO,ICHCL,ICOEFF,ICHGRA)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PENDI1
C
C DESCRIPTION       :  Appelle par PENDIA
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI
C
C************************************************************************
C
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
      INTEGER JGN, JGM
-INC SMLMOTS
C
      INTEGER IMOT,IFAC,ICHPO,ICHCL,ICOEFF,ICHGRA,I1,I2,NCOMP
      CHARACTER*(8) MTYPE

      CHARACTER*4 NOMCOM(27)
      DATA NOMCOM  /'P1DX','P1DY','P1DZ',
     &     'P2DX','P2DY','P2DZ',
     &     'P3DX','P3DY','P3DZ',
     &     'P4DX','P4DY','P4DZ',
     &     'P5DX','P5DY','P5DZ',
     &     'P6DX','P6DY','P6DZ',
     &     'P7DX','P7DY','P7DZ',
     &     'P8DX','P8DY','P8DZ',
     &     'P9DX','P9DY','P9DZ'/
C
C
C***** Creation de ICHGRA (gradient aux faces)
C
      MLMOTS=IMOT
      SEGACT MLMOTS
      NCOMP=MLMOTS.MOTS(/2)
      SEGDES MLMOTS
      JGN=4
      JGM=NCOMP*IDIM
      SEGINI MLMOT1
      DO  I1 = 1, NCOMP
         DO  I2 = 1, IDIM
            MLMOT1.MOTS((I1-1)*IDIM+I2) = NOMCOM((I1-1)*3+I2)
         ENDDO
      ENDDO
C
      MTYPE='FACE    '
      CALL KRCHP1(MTYPE, IFAC, ICHGRA, MLMOT1)
      IF(IERR.NE.0) GOTO 9999
C
      CALL RLEXF2(ICHPO,ICHCL,ICOEFF,ICHGRA)
      IF(IERR.NE.0)GOTO 9999
C
      SEGSUP MLMOT1
C
 9999 RETURN
      END












 
