Sources Esope | Cast3M

ylap1t
C YLAP1T    SOURCE    CB215821  20/11/25    13:44:11     10792          
C YLAP1A    SOURCE    LEPOTIER  02/12/17    21:18:56     4510
      SUBROUTINE YLAP1T(ITEMC,ICOGRT,ITIMP,IQIMP,IMIXT,
     $     MELEMC,MELEMF,MELEFL,ISURF,INORM,IVOLU,
     $     IJACO)
C***********************************************************************
C NOM         : YLAP1A
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          : YLA1BT |
C                    YLAP1C | Calcul des contributions à la matrice
C                    YLAP1D | jacobienne du résidu du laplacien VF 2D.
C                    YLAP1E |
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       : YLAP11 : Chapeau de l'opérateur Gibiane 'LAPN'
C                             option 'VF'.
C***********************************************************************
C ENTREES            : MU (type réel) : viscosité dynamique (SI).
C                      KAPPA (type réel) : conductivité thermique (SI)
C                      CV (type réel) : 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                      IMIXT (type MCHPOI) : CL mixtes
C                      ICLAU               : option pour ne calculer
c                                            que la thermique
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 ENTREES/SORTIES    : IJACO (type MATRIK) : matrice jacobienne du
C                        résidu du laplacien VF 2D.
C SORTIES            : -
C***********************************************************************
C VERSION    : v1, 01/08/2001, version initiale
C HISTORIQUE : v1, 01/08/2001, création
C HISTORIQUE : v2, 11/02/2003 Ajout de l'OPTION 'MIXT' pour la température
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 PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMCHPOI
      POINTEUR IROC.MCHPOI  ,IVITC.MCHPOI ,ITEMC.MCHPOI
      POINTEUR IGRVF.MCHPOI
      POINTEUR IVIMP.MCHPOI ,ITOIM.MCHPOI
      POINTEUR ITIMP.MCHPOI ,IQIMP.MCHPOI,IMIXT.MCHPOI
      POINTEUR ISURF.MCHPOI ,INORM.MCHPOI ,IVOLU.MCHPOI
      POINTEUR MPROC.MPOVAL ,MPVITC.MPOVAL,MPTEMC.MPOVAL
      POINTEUR MPGRVF.MPOVAL
      POINTEUR MPVIMP.MPOVAL,MPTOIM.MPOVAL
      POINTEUR MPTIMP.MPOVAL,MPQIMP.MPOVAL,MPMIXT.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,MLMIXT.MELEME
-INC SMLENTI
      POINTEUR KRVIMP.MLENTI,KRTOIM.MLENTI
      POINTEUR KRTIMP.MLENTI,KRQIMP.MLENTI,KRMIXT.MLENTI
      POINTEUR KRCENT.MLENTI,KRFACE.MLENTI
-INC SMMATRIK
      POINTEUR IJACO.MATRIK
*
      REAL*8 MU,KAPPA,CV
*
      INTEGER IMPR,IRET,ICLAU
*
      LOGICAL LCLIMV,LCLITO
      LOGICAL LCLIMT,LCLIMQ,LMIXT
*
      INTEGER NTOTPO
C
*
* Executable statements
*
      IMPR=0
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans ylap1a.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(ITEMC,MPTEMC,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
      LCLIMT=(ITIMP.NE.0)
      LCLIMQ=(IQIMP.NE.0)
      LMIXT=(IMIXT.NE.0)
      NTOTPO=nbpts
      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
c ON EST ICI
      IF (LMIXT) THEN
         CALL LICHT2(IMIXT,MPMIXT,MLMIXT,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*   In KRIPME : SEGINI KRMIXT
         CALL KRIPME(MLMIXT,NTOTPO,KRMIXT,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
*
* 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 YLA1BT(ICOGRT,MPTEMC,
     $     MPVOLU,MPNORM,MPSURF,MELEFL,
     $     KRFACE,KRCENT,LCLIMT,KRTIMP,LCLIMQ,KRQIMP,
     $     LMIXT,KRMIXT,
     $     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 (LMIXT) THEN
         SEGSUP KRMIXT
      ENDIF
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine ylap1t'
      CALL ERREUR(5)
      RETURN
*
* End of subroutine YLAP1T
*
      END