C YLAP1A SOURCE CB215821 20/11/25 13:44:04 10792 SUBROUTINE YLAP1A(MU,KAPPA,CV,IROC,IVITC,ITEMC, $ IGRVF,ICOGRV,ICOGRT, $ IVIMP,ITOIM,ITIMP,IQIMP,IMIXT,ICLAU, $ MELEMC,MELEMF,MELEFL,ISURF,INORM,IVOLU,NOMINC, $ 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 : YLAP1B | 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 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/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 SMLMOTS POINTEUR NOMINC.MLMOTS -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(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) LMIXT=(IMIXT.NE.0) NTOTPO=nbpts 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 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 * * Note : on pourrait regrouper les subroutines suivantes en une * seule pas trop longue, au prix d'un gros effort * (voir aussi la NOTE: dans ylap1c) * * 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 ) * IF (ICLAU.EQ.0) THEN CALL YLAP1C(ICOGRV,MPROC,MPVITC, $ MPVOLU,MPNORM,MPSURF,MELEFL, $ KRFACE,KRCENT,LCLIMV,KRVIMP,LCLITO,KRTOIM, $ NOMINC, $ MU, $ IJACO, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ENDIF * * 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 * IF (ICLAU.EQ.0) THEN CALL YLAP1E(ICOGRV,MPGRVF,MPROC,MPVITC, $ MPVOLU,MPNORM,MPSURF,MELEFL, $ KRFACE,KRCENT, $ LCLIMV,KRVIMP,MPVIMP, $ LCLITO,KRTOIM, $ NOMINC, $ MU, $ IJACO, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL YLAP1D(ICOGRV,MPGRVF,MPROC,MPVITC, $ MPVOLU,MPNORM,MPSURF,MELEFL, $ KRFACE,KRCENT, $ LCLIMV,KRVIMP, $ LCLITO,KRTOIM,MPTOIM, $ NOMINC, $ MU, $ IJACO, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ENDIF * * 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 YLAP1B(ICOGRT,MPROC,MPVITC,MPTEMC, $ MPVOLU,MPNORM,MPSURF,MELEFL, $ KRFACE,KRCENT,LCLIMT,KRTIMP,LCLIMQ,KRQIMP, $ LMIXT,KRMIXT, $ NOMINC,ICLAU, $ KAPPA,CV, $ 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 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 ylap1a' CALL ERREUR(5) RETURN * * End of subroutine YLAP1A * END