C PENDI2    SOURCE    BECC      05/01/20    21:15:14     5008           
      SUBROUTINE PENDI2(IDOMA)
C************************************************************************
C     
C PROJET            :  CASTEM 2000
C     
C NOM               :  PENDI2 
C     
C DESCRIPTION       :  Appelle par PENT
C     
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C     
C AUTEUR            :  A. BECCANTINI
C     
C************************************************************************
C     
C     
C************************************************************************
C     
C PHRASE D'APPEL (GIBIANE) :
C     
C 
C RCHPO1  RCHELEM1 = 'PENT'
C         MCLE1 MCLE2 MCLE3 TABDO LMOT1 LMOT2 CHPO1 CHPO2 CHPO3 ;
C
C ou
C
C RCHPO1  = 'PENT'
C        MCLE1 MCLE2 MCLE3 TABDO LMOT1 LMOT2 CHPO1 CHPO2 CHPO3 
C        MCLE5 RCHELEM1 ;
C
C
C Entrées:
C
C  TABDO   :  Donnée de la table domaine;
C
C  MCLE1   :  type du champ par point CHPO1. Pour le moment, seul le 
C             type 'FACE' est autorisé;
C
C  MCLE2   :  'DIAMANT'
C
C  MCLE3   :  Calcul ou non du limiteur : 'NOLIMITE'
C
C  LMOT1   :  Nom de composantes du champoint duquel on veut calculer 
C             le gradient
C
C  LMOT2   :  Nom de composantes du gradients 
C
C  CHPO1   :  CHAMPOINT centre du quel on veut calculer le gradient
C
C  CHPO2   :  Conditions aux limites de type Dirichlet
C
C  CHPO3   :  Conditions aux limites de type von Neumann (dans le repaire 
C             global)
C
C  MCLE4   :  Donnée ou non du RCHELEM1:
C             'GRADGEO' si donnée, vide sinon.
C
C
C E/S    :
C
C RCHELEM1: Champ par élément des coefficients géométriques pour le
C           calcul du gradient (et du hessien)
C           (entrée si MCLE4 = 'GRADGEO', sinon sortie).
C
C
C Sorties:
C
C RCHPO1 :  Champ par point contenant le gradient de CHPO1 (toujours
C           calculé) ;
C
C************************************************************************
C     
C HISTORIQUE (Anomalies et modifications éventuelles)
C     
C HISTORIQUE : Creé le 2/3/2001
C     
C************************************************************************
C     
C     
C     
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
-INC SMCHPOI
-INC SMLMOTS
C     
C**** Variables de COOPTIO
C     
      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
     &     ,IOTER,   IOLEC,  IOIMP,   IOCAR,  IOACQ
     &     ,IOPER,   IOSGB,  IOGRA,   IOSAU,  IORES
     &     ,IECHO,   IIMPI,  IOSPI
     &     ,IDIM
     &     ,MCOORD      
     &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
     &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
     &     ,NORINC,NORVAL,NORIND,NORVAD
     &     ,NUCROU, IPSAUV, IFICLE, IPREFI, IREFOR, ISAFOR
C     
      INTEGER IDOMA, IRET1, ICEN, IFAC, IFACEL, IFACEP, ISOMM, INORM
     &     ,ICHPO, ICHPL1, ICHPL2, LMOT, LMOTGR
     &     ,ISGLI1, ISGLI2, ICHGRA,  ICOEFF
     &     ,NSOUPO, IMAIL, JGN, JGM
C
      CHARACTER*(8)  MOT
      LOGICAL LOGCOE
C
      MOT='        '
C
C**** Lecture du MELEME SPG des points CENTRE.
C     
      CALL LEKTAB(IDOMA,'CENTRE',ICEN)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du MELEME SPG des points FACE.
C     
      CALL LEKTAB(IDOMA,'FACE',IFAC)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du MELEME SPG des points SOMMET
C     
      CALL LEKTAB(IDOMA,'SOMMET',ISOMM)
      IF(IERR .NE. 0) GOTO 9999
C     
C**** Lecture du MELEME de connect. FACEL
C     
      CALL LEKTAB(IDOMA,'FACEL',IFACEL)
      IF(IERR .NE. 0) GOTO 9999
C     
C**** Lecture du MELEME de connect. FACEP
C     
      CALL LEKTAB(IDOMA,'FACEP',IFACEP)
      IF(IERR .NE. 0) GOTO 9999
C     
C**** Lecture du MELEME MAILLAGE
C     
      CALL LEKTAB(IDOMA,'MAILLAGE',IMAIL)
      IF(IERR .NE. 0) GOTO 9999
C     
C**** Lecture des normales aux faces
C     
      CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
      IF(IERR .NE. 0) GOTO 9999
      JGN=4
      JGM=IDIM
      SEGINI MLMOTS
      MLMOTS.MOTS(1)='UX'
      MLMOTS.MOTS(2)='UY'
      IF(IDIM .EQ. 3) MLMOTS.MOTS(3)='UZ'
      CALL QUEPO1 (INORM, IFAC, MLMOTS)
      IF(IERR .NE. 0)GOTO 9999
      SEGSUP MLMOTS
C
C**** Lecture du CHPOINT dont on veut calculer le gradient!
C
      CALL LIROBJ('CHPOINT ',ICHPO,1,IRET1)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du CHPOINT des conditions limites de type Dirichlet
C
      CALL LIROBJ('CHPOINT ',ICHPL1,1,IRET1)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du CHPOINT des conditions limites de type von Neumann
C
      CALL LIROBJ('CHPOINT ',ICHPL2,1,IRET1)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture des noms des composantes du CHPOINT
C
      CALL LIROBJ('LISTMOTS',LMOT,1,IRET1)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture des noms des composantes du gradients
C
      CALL LIROBJ('LISTMOTS',LMOTGR,1,IRET1)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Compatibilité entre les liste de composantes
C
      MLMOT1=LMOT
      MLMOT2=LMOTGR
      SEGACT MLMOT1
      SEGACT MLMOT2
      IF(MLMOT2.MOTS(/2) .NE. (IDIM*MLMOT1.MOTS(/2)))THEN
         write(*,*) 'Composantes = ???'
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
C     
C**** Control de ICHPO
C     
      MLMOTS=LMOT
      CALL QUEPO1(ICHPO, ICEN, LMOT)
      IF (IERR .NE. 0) GOTO 9999
C     
C**** Control de ICHPL1
C     
      MCHPOI = ICHPL1
      SEGACT MCHPOI
      NSOUPO = MCHPOI.IPCHP(/1)
      IF(NSOUPO .EQ. 0) THEN
         ICHPL1=0
         ISGLI1=0
      ELSE
         MSOUPO=MCHPOI.IPCHP(1)
         SEGACT MSOUPO
         ISGLI1=MSOUPO.IGEOC
         SEGDES MSOUPO
         CALL QUEPO1(ICHPL1, 0, LMOT)
         IF (IERR .NE. 0) GOTO 9999
      ENDIF
C     
C**** Control de ICHPL2
C     
      MCHPOI = ICHPL2
      SEGACT MCHPOI
      NSOUPO = MCHPOI.IPCHP(/1)
      IF(NSOUPO .EQ. 0) THEN
         ICHPL2=0
         ISGLI2=0
      ELSE
         MSOUPO=MCHPOI.IPCHP(1)
         SEGACT MSOUPO
         ISGLI2=MSOUPO.IGEOC
         SEGDES MSOUPO
         CALL QUEPO1(ICHPL2, 0, LMOTGR)
         IF (IERR .NE. 0) GOTO 9999
      ENDIF
C     
C**** Lecture du MCHAMLs qui contiennent les elements de matrice
C     pour le calcul du gradient
C     
C     Si MOT = 'GRADGEO', on a ces MCHAMLs; sinon il faut le calculer
C     
      CALL LIRCHA(MOT,0,IRET1)
      IF(IERR .NE. 0) GOTO 9999
      IF(IRET1 .EQ. 0)THEN
         LOGCOE = .TRUE.
      ELSEIF(MOT .NE. 'GRADGEO')THEN
         CALL REFUS()
         LOGCOE=.TRUE.
      ELSE
         LOGCOE=.FALSE.
         CALL LIROBJ('MCHAML  ',ICOEFF,1,IRET1)
         IF(IERR .NE. 0) GOTO 9999
      ENDIF
      IF(LOGCOE)THEN
         CALL GRADI2(ICEN,ISOMM,IFACEL,IFACEP,ISGLI1,ISGLI2,INORM,
     &        ICOEFF)
         IF (IERR .NE. 0) GOTO 9999
      ENDIF
C
C**** Calcul de gradient
C     
      CALL PENDI3(LMOTGR,IFAC,ICHPO,ICHPL1,ICHPL2,INORM,ICOEFF,ICHGRA)
      IF(IERR .NE. 0) GOTO 9999
C     
C**** Ecriture de gradient, (hessian), (limiteur),
C     (MCHAMLs pour le calcul de gradient et/ou du hessian)
C     
      IF(MOT .NE. 'GRADGEO') THEN
         CALL ECROBJ('MCHAML',ICOEFF)
         IF(IERR .NE. 0) GOTO 9999
      ENDIF
      CALL ECROBJ('CHPOINT',ICHGRA)
      IF(IERR .NE. 0) GOTO 9999
C
      SEGDES MLMOTS
C     
C**** Sortie du programme
C     
 9999 CONTINUE
C     
      RETURN
      END