C XLAP2A SOURCE CB215821 20/11/25 13:43:17 10792 SUBROUTINE XLAP2A(IMUC,IKAPC,ICVC,IROC,IVITC,ITEMC, $ IGRVF,ICOGRV,ICOGRT, $ IVIMP,ITOIM,ITIMP,IQIMP, $ MELEMC,MELEMF,MELEFL,ISURF,INORM,IVOLU,NOMINC, $ IJACO) C*********************************************************************** C NOM : XLAP2A C DESCRIPTION : Calcul de la matrice jacobienne du résidu du laplacien C VF 3D. 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 : XLAP2B | C XLAP2C | Calcul des contributions à la matrice C XLAP2D | jacobienne du résidu du laplacien VF 3D. C XLAP2E | 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 3D. C SORTIES : - C*********************************************************************** C VERSION : v1, 01/03/2002, version initiale C HISTORIQUE : v1, 01/03/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 PPARAM -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 xlap2a.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=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 * 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 xlap2c) * * 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) * et (d Res_{\rho w} / d var) * var prenant successivement les valeurs : * \rho, \rho u, \rho v, \rho w \rho e_t ) * CALL XLAP2C(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 w, \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 XLAP2E(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 XLAP2D(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 w, \rho e_t ) * CALL XLAP2B(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 xlap2a' CALL ERREUR(5) RETURN * * End of subroutine XLAP2A * END