1 : C YLAP2A SOURCE MAGN 09/07/30 21:22:27 6458 2 : SUBROUTINE YLAP2A(MU,KAPPA,CV,IROC,IVITC,ITEMC, 3 : $ IGRVF,ICOGRV,ICOGRT, 4 : $ IVIMP,ITOIM,ITIMP,IQIMP, 5 : $ MELEMC,MELEMF,MELEFL,ISURF,INORM,IVOLU,NOMINC, 6 : $ IJACO) 7 : C*********************************************************************** 8 : C NOM : YLAP2A 9 : C DESCRIPTION : Calcul de la matrice jacobienne du résidu du laplacien 10 : C VF 3D. 11 : C 12 : C LANGAGE : ESOPE 13 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 14 : C mél : gounand@semt2.smts.cea.fr 15 : C*********************************************************************** 16 : C APPELES : YLAP2B | 17 : C YLAP2C | Calcul des contributions à la matrice 18 : C YLAP2D | jacobienne du résidu du laplacien VF 3D. 19 : C YLAP2E | 20 : C APPELES (UTIL) : LICHT2 : Lecture des pointeurs (maillages, valeurs) 21 : C d'un objet de type MCHPOI. 22 : C KRIPME : Création d'un tableau de repérage dans un 23 : C maillage de points. 24 : C ZERMAK : Création d'un objet de type MATRIK vide. 25 : C APPELES (STD) : ERREUR : Gestion des erreurs par GIBI. 26 : C APPELE PAR : YLAP11 : Chapeau de l'opérateur Gibiane 'LAPN' 27 : C option 'VF'. 28 : C*********************************************************************** 29 : C ENTREES : MU (type réel) : viscosité dynamique (SI). 30 : C KAPPA (type réel) : conductivité thermique (SI) 31 : C CV (type réel) : chaleur spécifique à volume 32 : C constant (SI). 33 : C IROC (type MCHPOI) : masse volumique par élément. 34 : C IVITC (type MCHPOI) : vitesse par élément. 35 : C ITEMC (type MCHPOI) : température par élément. 36 : C IGRVF (type MCHPOI) : gradient de la vitesse 37 : C aux interfaces. 38 : C ICOGRV (type MCHELM) : coefficients pour le 39 : C calcul du gradient de la vitesse aux 40 : C interfaces. 41 : C ICOGRT (type MCHELM) : coefficients pour le 42 : C calcul du gradient de la température aux 43 : C interfaces. 44 : C IVIMP (type MCHPOI) : CL de Dirichlet sur la 45 : C vitesse. 46 : C ITOIM (type MCHPOI) : CL de Dirichlet sur le 47 : C tenseur des contraintes. 48 : C ITIMP (type MCHPOI) : CL de Dirichlet sur la 49 : C température. 50 : C IQIMP (type MCHPOI) : CL de Dirichlet sur le 51 : C flux de chaleur. 52 : C MELEMC (type MELEME) : maillage des centres des 53 : C éléments. 54 : C MELEMF (type MELEME) : maillage des faces des 55 : C éléments. 56 : C MELEFL (type MELEME) : connectivités face-(centre 57 : C gauche, centre droit). 58 : C ISURF (type MCHPOI) : surface des faces. 59 : C INORM (type MCHPOI) : normale aux faces. 60 : C IVOLU (type MCHPOI) : volume des éléments. 61 : C NOMINC (type MLMOTS) : noms des inconnues. 62 : C ENTREES/SORTIES : IJACO (type MATRIK) : matrice jacobienne du 63 : C résidu du laplacien VF 3D. 64 : C SORTIES : - 65 : C*********************************************************************** 66 : C VERSION : v1, 28/08/2001, version initiale 67 : C HISTORIQUE : v1, 28/08/2001, création 68 : C HISTORIQUE : 69 : C HISTORIQUE : 70 : C*********************************************************************** 71 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 72 : C en cas de modification de ce sous-programme afin de faciliter 73 : C la maintenance ! 74 : C*********************************************************************** 75 : IMPLICIT INTEGER(I-N) 76 : -INC CCOPTIO 77 : -INC SMCOORD 78 : -INC SMCHPOI 79 : POINTEUR IROC.MCHPOI ,IVITC.MCHPOI ,ITEMC.MCHPOI 80 : POINTEUR IGRVF.MCHPOI 81 : POINTEUR IVIMP.MCHPOI ,ITOIM.MCHPOI 82 : POINTEUR ITIMP.MCHPOI ,IQIMP.MCHPOI 83 : POINTEUR ISURF.MCHPOI ,INORM.MCHPOI ,IVOLU.MCHPOI 84 : POINTEUR MPROC.MPOVAL ,MPVITC.MPOVAL,MPTEMC.MPOVAL 85 : POINTEUR MPGRVF.MPOVAL 86 : POINTEUR MPVIMP.MPOVAL,MPTOIM.MPOVAL 87 : POINTEUR MPTIMP.MPOVAL,MPQIMP.MPOVAL 88 : POINTEUR MPSURF.MPOVAL,MPNORM.MPOVAL,MPVOLU.MPOVAL 89 : -INC SMCHAML 90 : POINTEUR ICOGRV.MCHELM,ICOGRT.MCHELM 91 : -INC SMELEME 92 : POINTEUR MELEMC.MELEME,MELEMF.MELEME,MELEFL.MELEME 93 : POINTEUR MELBID.MELEME 94 : POINTEUR MLVIMP.MELEME,MLTOIM.MELEME 95 : POINTEUR MLTIMP.MELEME,MLQIMP.MELEME 96 : -INC SMLENTI 97 : POINTEUR KRVIMP.MLENTI,KRTOIM.MLENTI 98 : POINTEUR KRTIMP.MLENTI,KRQIMP.MLENTI 99 : POINTEUR KRCENT.MLENTI,KRFACE.MLENTI 100 : -INC SMLMOTS 101 : POINTEUR NOMINC.MLMOTS 102 : -INC SMMATRIK 103 : POINTEUR IJACO.MATRIK 104 : * 105 : REAL*8 MU,KAPPA,CV 106 : * 107 : INTEGER IMPR,IRET 108 : * 109 : LOGICAL LCLIMV,LCLITO 110 : LOGICAL LCLIMT,LCLIMQ 111 : * 112 : INTEGER NTOTPO 113 : C 114 : * 115 : * Executable statements 116 : * 117 : IMPR=0 118 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans ylap2a.eso' 119 : * Initialisation de la matrice jacobienne à zéro 119 : CALL ZERMAK(IJACO,IMPR,IRET) 120 : IF (IRET.NE.0) GOTO 9999 121 : * Lecture des données et initialisations de tableaux de travail 121 : CALL LICHT2(IROC,MPROC,MELBID,IMPR,IRET) 122 : IF (IRET.NE.0) GOTO 9999 122 : CALL LICHT2(IVITC,MPVITC,MELBID,IMPR,IRET) 123 : IF (IRET.NE.0) GOTO 9999 123 : CALL LICHT2(ITEMC,MPTEMC,MELBID,IMPR,IRET) 124 : IF (IRET.NE.0) GOTO 9999 124 : CALL LICHT2(IGRVF,MPGRVF,MELBID,IMPR,IRET) 125 : IF (IRET.NE.0) GOTO 9999 125 : CALL LICHT2(ISURF,MPSURF,MELBID,IMPR,IRET) 126 : IF (IRET.NE.0) GOTO 9999 126 : CALL LICHT2(INORM,MPNORM,MELBID,IMPR,IRET) 127 : IF (IRET.NE.0) GOTO 9999 127 : CALL LICHT2(IVOLU,MPVOLU,MELBID,IMPR,IRET) 128 : IF (IRET.NE.0) GOTO 9999 129 : LCLIMV=(IVIMP.NE.0) 130 : LCLITO=(ITOIM.NE.0) 131 : LCLIMT=(ITIMP.NE.0) 132 : LCLIMQ=(IQIMP.NE.0) 133 : NTOTPO=MCOORD.XCOOR(/1)/(IDIM+1) 134 : IF (LCLIMV) THEN 134 : CALL LICHT2(IVIMP,MPVIMP,MLVIMP,IMPR,IRET) 135 : IF (IRET.NE.0) GOTO 9999 136 : * In KRIPME : SEGINI KRVIMP 136 : CALL KRIPME(MLVIMP,NTOTPO,KRVIMP,IMPR,IRET) 137 : IF (IRET.NE.0) GOTO 9999 138 : ENDIF 139 : IF (LCLITO) THEN 139 : CALL LICHT2(ITOIM,MPTOIM,MLTOIM,IMPR,IRET) 140 : IF (IRET.NE.0) GOTO 9999 141 : * In KRIPME : SEGINI KRTOIM 141 : CALL KRIPME(MLTOIM,NTOTPO,KRTOIM,IMPR,IRET) 142 : IF (IRET.NE.0) GOTO 9999 143 : ENDIF 144 : IF (LCLIMT) THEN 144 : CALL LICHT2(ITIMP,MPTIMP,MLTIMP,IMPR,IRET) 145 : IF (IRET.NE.0) GOTO 9999 146 : * In KRIPME : SEGINI KRTIMP 146 : CALL KRIPME(MLTIMP,NTOTPO,KRTIMP,IMPR,IRET) 147 : IF (IRET.NE.0) GOTO 9999 148 : ENDIF 149 : IF (LCLIMQ) THEN 149 : CALL LICHT2(IQIMP,MPQIMP,MLQIMP,IMPR,IRET) 150 : IF (IRET.NE.0) GOTO 9999 151 : * In KRIPME : SEGINI KRQIMP 151 : CALL KRIPME(MLQIMP,NTOTPO,KRQIMP,IMPR,IRET) 152 : IF (IRET.NE.0) GOTO 9999 153 : ENDIF 154 : * Repérage dans les faces, les centres 155 : * In KRIPME : SEGINI KRFACE 155 : CALL KRIPME(MELEMF,NTOTPO,KRFACE,IMPR,IRET) 156 : IF (IRET.NE.0) GOTO 9999 157 : * In KRIPME : SEGINI KRCENT 157 : CALL KRIPME(MELEMC,NTOTPO,KRCENT,IMPR,IRET) 158 : IF (IRET.NE.0) GOTO 9999 159 : * 160 : * Note : on pourrait regrouper les subroutines suivantes en une 161 : * seule pas trop longue, au prix d'un gros effort 162 : * (voir aussi la NOTE: dans ylap2c) 163 : * 164 : * Calcul des contributions 'simples' à la matrice jacobienne faisant 165 : * intervenir les coefficients pour le calcul des gradients de vitesse 166 : * (ICOGRV) 167 : * (contributions à (d Res_{\rho u} / d var), (d Res_{\rho v} / d var) 168 : * et (d Res_{\rho w} / d var) 169 : * var prenant successivement les valeurs : 170 : * \rho, \rho u, \rho v, \rho w, \rho e_t ) 171 : * 171 : CALL YLAP2C(ICOGRV,MPROC,MPVITC, 172 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 173 : $ KRFACE,KRCENT,LCLIMV,KRVIMP,LCLITO,KRTOIM, 174 : $ NOMINC, 175 : $ MU, 176 : $ IJACO, 177 : $ IMPR,IRET) 178 : IF (IRET.NE.0) GOTO 9999 179 : * 180 : * Calcul des contributions 'compliquées' à la matrice jacobienne faisant 181 : * intervenir les coefficients pour le calcul des gradients de vitesse 182 : * (ICOGRV) 183 : * (contributions à (d Res_{\rho e_t} / d var) 184 : * var prenant successivement les valeurs : 185 : * \rho, \rho u, \rho v, \rho w, \rho e_t ) 186 : * Les contributions sont plus "compliquées" à calculer que les 187 : * simples car on a à dériver des produits de fonctions de la vitesse 188 : * d (f(u,v) * g(u,v)) / d var = f dg/dv + df/dv g 189 : * 189 : CALL YLAP2E(ICOGRV,MPGRVF,MPROC,MPVITC, 190 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 191 : $ KRFACE,KRCENT, 192 : $ LCLIMV,KRVIMP,MPVIMP, 193 : $ LCLITO,KRTOIM, 194 : $ NOMINC, 195 : $ MU, 196 : $ IJACO, 197 : $ IMPR,IRET) 198 : IF (IRET.NE.0) GOTO 9999 198 : CALL YLAP2D(ICOGRV,MPGRVF,MPROC,MPVITC, 199 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 200 : $ KRFACE,KRCENT, 201 : $ LCLIMV,KRVIMP, 202 : $ LCLITO,KRTOIM,MPTOIM, 203 : $ NOMINC, 204 : $ MU, 205 : $ IJACO, 206 : $ IMPR,IRET) 207 : IF (IRET.NE.0) GOTO 9999 208 : * 209 : * Calcul des contributions à la matrice jacobienne faisant intervenir 210 : * les coefficients pour le calcul des gradients de température (ICOGRT) 211 : * (contributions à d Res_{\rho e_t} / d var 212 : * var prenant successivement les valeurs : 213 : * \rho, \rho u, \rho v, \rho w, \rho e_t ) 214 : * 214 : CALL YLAP2B(ICOGRT,MPROC,MPVITC,MPTEMC, 215 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 216 : $ KRFACE,KRCENT,LCLIMT,KRTIMP,LCLIMQ,KRQIMP, 217 : $ NOMINC, 218 : $ KAPPA,CV, 219 : $ IJACO, 220 : $ IMPR,IRET) 221 : IF (IRET.NE.0) GOTO 9999 222 : * 223 : * Destruction des tableaux de travail 224 : * 225 : SEGSUP KRCENT 226 : SEGSUP KRFACE 227 : IF (LCLIMQ) THEN 228 : SEGSUP KRQIMP 229 : ENDIF 230 : IF (LCLIMT) THEN 231 : SEGSUP KRTIMP 232 : ENDIF 233 : IF (LCLITO) THEN 234 : SEGSUP KRTOIM 235 : ENDIF 236 : IF (LCLIMV) THEN 237 : SEGSUP KRVIMP 238 : ENDIF 239 : * 240 : * Normal termination 241 : * 242 : IRET=0 243 : RETURN 244 : * 245 : * Format handling 246 : * 247 : * 248 : * Error handling 249 : * 250 : 9999 CONTINUE 251 : IRET=1 252 : WRITE(IOIMP,*) 'An error was detected in subroutine ylap2a' 252 : CALL ERREUR(5) 253 : RETURN 254 : * 255 : * End of subroutine YLAP2A 256 : * 257 : END 258 : 259 : 260 : 261 : 262 : 263 : 264 : 265 : 266 :
© Cast3M 2003 - All rights reserved.
Disclaimer