C XLAP1A    SOURCE    MAGN      09/07/30    21:21:17     6458           
      SUBROUTINE XLAP1A(IMUC,IKAPC,ICVC,IROC,IVITC,ITEMC,
     $     IGRVF,ICOGRV,ICOGRT,
     $     IVIMP,ITOIM,ITIMP,IQIMP,
     $     MELEMC,MELEMF,MELEFL,ISURF,INORM,IVOLU,NOMINC,
     $     IJACO)
C***********************************************************************
C NOM         : XLAP1A
C DESCRIPTION : Calcul de la matrice jacobienne du résidu du laplacien
C               VF 2D.
C     
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : XLAP1B |
C                    XLAP1C | Calcul des contributions à la matrice
C                    XLAP1D | jacobienne du résidu du laplacien VF 2D.
C                    XLAP1E |
C APPELES (UTIL)   : LICHT2 : Lecture des pointeurs (maillages, valeurs)
C                             d'un objet de type MCHPOI.
C                    KRIPME : Création d'un tableau de repérage dans un
C                             maillage de points.
C                    ZERMAK : Création d'un objet de type MATRIK vide.
C APPELES (STD)    : ERREUR : Gestion des erreurs par GIBI.
C APPELE PAR       : ZLAP11 : Chapeau de l'opérateur Gibiane 'LAPN'
C                             option 'VF'.
C***********************************************************************
C ENTREES            : IMUC  (type MCHPOI) : viscosité dynamique (SI).
C                      IKAPC (type MCHPOI) : conductivité thermique (SI)
C                      ICVC  (type MCHPOI) : chaleur spécifique à volume 
C                                            constant (SI).
C                      IROC (type MCHPOI) : masse volumique par élément.
C                      IVITC (type MCHPOI) : vitesse par élément.
C                      ITEMC (type MCHPOI) : température par élément.
C                      IGRVF (type MCHPOI) : gradient de la vitesse
C                                            aux interfaces.
C                      ICOGRV (type MCHELM) : coefficients pour le 
C                        calcul du gradient de la vitesse aux 
C                        interfaces.
C                      ICOGRT (type MCHELM) : coefficients pour le 
C                        calcul du gradient de la température aux
C                        interfaces.
C                      IVIMP (type MCHPOI) : CL de Dirichlet sur la 
C                                            vitesse.
C                      ITOIM (type MCHPOI) : CL de Dirichlet sur le 
C                                            tenseur des contraintes.
C                      ITIMP (type MCHPOI) : CL de Dirichlet sur la 
C                                            température.
C                      IQIMP (type MCHPOI) : CL de Dirichlet sur le 
C                                            flux de chaleur.
C                      MELEMC (type MELEME) : maillage des centres des
C                                             éléments.
C                      MELEMF (type MELEME) : maillage des faces des
C                                             éléments.
C                      MELEFL (type MELEME) : connectivités face-(centre
C                                             gauche, centre droit).
C                      ISURF (type MCHPOI) : surface des faces.
C                      INORM (type MCHPOI) : normale aux faces.
C                      IVOLU (type MCHPOI) : volume des éléments.
C                      NOMINC (type MLMOTS) : noms des inconnues.
C ENTREES/SORTIES    : IJACO (type MATRIK) : matrice jacobienne du 
C                        résidu du laplacien VF 2D.
C SORTIES            : -
C***********************************************************************
C VERSION    : v1, 01/01/2002, version initiale
C HISTORIQUE : v1, 01/01/2002, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
-INC SMCOORD
-INC SMCHPOI
      POINTEUR IMUC.MCHPOI  ,IKAPC.MCHPOI ,ICVC.MCHPOI
      POINTEUR IROC.MCHPOI  ,IVITC.MCHPOI ,ITEMC.MCHPOI
      POINTEUR IGRVF.MCHPOI
      POINTEUR IVIMP.MCHPOI ,ITOIM.MCHPOI
      POINTEUR ITIMP.MCHPOI ,IQIMP.MCHPOI
      POINTEUR ISURF.MCHPOI ,INORM.MCHPOI ,IVOLU.MCHPOI
      POINTEUR MPMUC.MPOVAL ,MPKAPC.MPOVAL,MPCVC.MCHPOI
      POINTEUR MPROC.MPOVAL ,MPVITC.MPOVAL,MPTEMC.MPOVAL
      POINTEUR MPGRVF.MPOVAL
      POINTEUR MPVIMP.MPOVAL,MPTOIM.MPOVAL
      POINTEUR MPTIMP.MPOVAL,MPQIMP.MPOVAL
      POINTEUR MPSURF.MPOVAL,MPNORM.MPOVAL,MPVOLU.MPOVAL
-INC SMCHAML
      POINTEUR ICOGRV.MCHELM,ICOGRT.MCHELM
-INC SMELEME
      POINTEUR MELEMC.MELEME,MELEMF.MELEME,MELEFL.MELEME
      POINTEUR MELBID.MELEME
      POINTEUR MLVIMP.MELEME,MLTOIM.MELEME
      POINTEUR MLTIMP.MELEME,MLQIMP.MELEME
-INC SMLENTI
      POINTEUR KRVIMP.MLENTI,KRTOIM.MLENTI
      POINTEUR KRTIMP.MLENTI,KRQIMP.MLENTI
      POINTEUR KRCENT.MLENTI,KRFACE.MLENTI
-INC SMLMOTS
      POINTEUR NOMINC.MLMOTS
-INC SMMATRIK
      POINTEUR IJACO.MATRIK
*     
      INTEGER IMPR,IRET
*     
      LOGICAL LCLIMV,LCLITO
      LOGICAL LCLIMT,LCLIMQ
*
      INTEGER NTOTPO
C     
*     
* Executable statements
*     
      IMPR=0
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans xlap1a.eso' 
* Initialisation de la matrice jacobienne à zéro
      CALL ZERMAK(IJACO,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* Lecture des données et initialisations de tableaux de travail
      CALL LICHT2(IMUC,MPMUC,MELBID,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL LICHT2(IKAPC,MPKAPC,MELBID,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL LICHT2(ICVC,MPCVC,MELBID,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL LICHT2(IROC,MPROC,MELBID,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL LICHT2(IVITC,MPVITC,MELBID,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL LICHT2(ITEMC,MPTEMC,MELBID,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL LICHT2(IGRVF,MPGRVF,MELBID,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL LICHT2(ISURF,MPSURF,MELBID,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL LICHT2(INORM,MPNORM,MELBID,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL LICHT2(IVOLU,MPVOLU,MELBID,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      LCLIMV=(IVIMP.NE.0)
      LCLITO=(ITOIM.NE.0)
      LCLIMT=(ITIMP.NE.0)
      LCLIMQ=(IQIMP.NE.0)
      NTOTPO=MCOORD.XCOOR(/1)/(IDIM+1)
      IF (LCLIMV) THEN
         CALL LICHT2(IVIMP,MPVIMP,MLVIMP,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*   In KRIPME : SEGINI KRVIMP
         CALL KRIPME(MLVIMP,NTOTPO,KRVIMP,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ENDIF
      IF (LCLITO) THEN
         CALL LICHT2(ITOIM,MPTOIM,MLTOIM,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*   In KRIPME : SEGINI KRTOIM
         CALL KRIPME(MLTOIM,NTOTPO,KRTOIM,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ENDIF
      IF (LCLIMT) THEN
         CALL LICHT2(ITIMP,MPTIMP,MLTIMP,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*   In KRIPME : SEGINI KRTIMP
         CALL KRIPME(MLTIMP,NTOTPO,KRTIMP,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ENDIF
      IF (LCLIMQ) THEN
         CALL LICHT2(IQIMP,MPQIMP,MLQIMP,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*   In KRIPME : SEGINI KRQIMP
         CALL KRIPME(MLQIMP,NTOTPO,KRQIMP,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ENDIF
* Repérage dans les faces, les centres
*   In KRIPME : SEGINI KRFACE
      CALL KRIPME(MELEMF,NTOTPO,KRFACE,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*   In KRIPME : SEGINI KRCENT
      CALL KRIPME(MELEMC,NTOTPO,KRCENT,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*
* Note : on pourrait regrouper les subroutines suivantes en une
*        seule pas trop longue, au prix d'un gros effort
*        (voir aussi la NOTE: dans xlap1c)
*     
* Calcul des contributions 'simples' à la matrice jacobienne faisant
* intervenir les coefficients pour le calcul des gradients de vitesse
* (ICOGRV) 
* (contributions à (d Res_{\rho u} / d var) et (d Res_{\rho v} / d var) 
*      var prenant successivement les valeurs : 
*      \rho,   \rho u,    \rho v,     \rho e_t )
*     
      CALL XLAP1C(ICOGRV,MPROC,MPVITC,
     $     MPVOLU,MPNORM,MPSURF,MELEFL,
     $     KRFACE,KRCENT,LCLIMV,KRVIMP,LCLITO,KRTOIM,
     $     NOMINC,
     $     MPMUC,
     $     IJACO,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*     
* Calcul des contributions 'compliquées' à la matrice jacobienne faisant
* intervenir les coefficients pour le calcul des gradients de vitesse
* (ICOGRV) 
* (contributions à (d Res_{\rho e_t} / d var)  
*      var prenant successivement les valeurs : 
*      \rho,   \rho u,    \rho v,     \rho e_t )
* Les contributions sont plus "compliquées" à calculer que les
* simples car on a à dériver des produits de fonctions de la vitesse
* d (f(u,v) * g(u,v)) / d var = f dg/dv + df/dv g
*     
      CALL XLAP1E(ICOGRV,MPGRVF,MPROC,MPVITC,
     $     MPVOLU,MPNORM,MPSURF,MELEFL,
     $     KRFACE,KRCENT,
     $     LCLIMV,KRVIMP,MPVIMP,
     $     LCLITO,KRTOIM,
     $     NOMINC,
     $     MPMUC,
     $     IJACO,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL XLAP1D(ICOGRV,MPGRVF,MPROC,MPVITC,
     $     MPVOLU,MPNORM,MPSURF,MELEFL,
     $     KRFACE,KRCENT,
     $     LCLIMV,KRVIMP,
     $     LCLITO,KRTOIM,MPTOIM,
     $     NOMINC,
     $     MPMUC,
     $     IJACO,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*     
* Calcul des contributions à la matrice jacobienne faisant intervenir
* les coefficients pour le calcul des gradients de température (ICOGRT)
* (contributions à d Res_{\rho e_t} / d var
*      var prenant successivement les valeurs : 
*      \rho,   \rho u,    \rho v,     \rho e_t )
*     
      CALL XLAP1B(ICOGRT,MPROC,MPVITC,MPTEMC,
     $     MPVOLU,MPNORM,MPSURF,MELEFL,
     $     KRFACE,KRCENT,LCLIMT,KRTIMP,LCLIMQ,KRQIMP,
     $     NOMINC,
     $     MPKAPC,MPCVC,
     $     IJACO,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*
* Destruction des tableaux de travail
*
      SEGSUP KRCENT
      SEGSUP KRFACE
      IF (LCLIMQ) THEN
         SEGSUP KRQIMP
      ENDIF
      IF (LCLIMT) THEN
         SEGSUP KRTIMP
      ENDIF
      IF (LCLITO) THEN
         SEGSUP KRTOIM
      ENDIF
      IF (LCLIMV) THEN
         SEGSUP KRVIMP
      ENDIF
*     
* Normal termination
*     
      IRET=0
      RETURN
*     
* Format handling
*     
*     
* Error handling
*     
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine xlap1a'
      CALL ERREUR(5)
      RETURN
*     
* End of subroutine XLAP1A
*     
      END