1 : C YLAP1A SOURCE MAGN 09/07/30 21:22:13 6458 2 : SUBROUTINE YLAP1A(MU,KAPPA,CV,IROC,IVITC,ITEMC, 3 : $ IGRVF,ICOGRV,ICOGRT, 4 : $ IVIMP,ITOIM,ITIMP,IQIMP,IMIXT,ICLAU, 5 : $ MELEMC,MELEMF,MELEFL,ISURF,INORM,IVOLU,NOMINC, 6 : $ IJACO) 7 : C*********************************************************************** 8 : C NOM : YLAP1A 9 : C DESCRIPTION : Calcul de la matrice jacobienne du résidu du laplacien 10 : C VF 2D. 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 : YLAP1B | 17 : C YLAP1C | Calcul des contributions à la matrice 18 : C YLAP1D | jacobienne du résidu du laplacien VF 2D. 19 : C YLAP1E | 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 IMIXT (type MCHPOI) : CL mixtes 53 : C ICLAU : option pour ne calculer 54 : c que la thermique 55 : C MELEMC (type MELEME) : maillage des centres des 56 : C éléments. 57 : C MELEMF (type MELEME) : maillage des faces des 58 : C éléments. 59 : C MELEFL (type MELEME) : connectivités face-(centre 60 : C gauche, centre droit). 61 : C ISURF (type MCHPOI) : surface des faces. 62 : C INORM (type MCHPOI) : normale aux faces. 63 : C IVOLU (type MCHPOI) : volume des éléments. 64 : C NOMINC (type MLMOTS) : noms des inconnues. 65 : C ENTREES/SORTIES : IJACO (type MATRIK) : matrice jacobienne du 66 : C résidu du laplacien VF 2D. 67 : C SORTIES : - 68 : C*********************************************************************** 69 : C VERSION : v1, 01/08/2001, version initiale 70 : C HISTORIQUE : v1, 01/08/2001, création 71 : C HISTORIQUE : v2, 11/02/2003 Ajout de l'OPTION 'MIXT' pour la température 72 : C HISTORIQUE : 73 : C*********************************************************************** 74 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 75 : C en cas de modification de ce sous-programme afin de faciliter 76 : C la maintenance ! 77 : C*********************************************************************** 78 : IMPLICIT INTEGER(I-N) 79 : -INC CCOPTIO 80 : -INC SMCOORD 81 : -INC SMCHPOI 82 : POINTEUR IROC.MCHPOI ,IVITC.MCHPOI ,ITEMC.MCHPOI 83 : POINTEUR IGRVF.MCHPOI 84 : POINTEUR IVIMP.MCHPOI ,ITOIM.MCHPOI 85 : POINTEUR ITIMP.MCHPOI ,IQIMP.MCHPOI,IMIXT.MCHPOI 86 : POINTEUR ISURF.MCHPOI ,INORM.MCHPOI ,IVOLU.MCHPOI 87 : POINTEUR MPROC.MPOVAL ,MPVITC.MPOVAL,MPTEMC.MPOVAL 88 : POINTEUR MPGRVF.MPOVAL 89 : POINTEUR MPVIMP.MPOVAL,MPTOIM.MPOVAL 90 : POINTEUR MPTIMP.MPOVAL,MPQIMP.MPOVAL,MPMIXT.MPOVAL 91 : POINTEUR MPSURF.MPOVAL,MPNORM.MPOVAL,MPVOLU.MPOVAL 92 : -INC SMCHAML 93 : POINTEUR ICOGRV.MCHELM,ICOGRT.MCHELM 94 : -INC SMELEME 95 : POINTEUR MELEMC.MELEME,MELEMF.MELEME,MELEFL.MELEME 96 : POINTEUR MELBID.MELEME 97 : POINTEUR MLVIMP.MELEME,MLTOIM.MELEME 98 : POINTEUR MLTIMP.MELEME,MLQIMP.MELEME,MLMIXT.MELEME 99 : -INC SMLENTI 100 : POINTEUR KRVIMP.MLENTI,KRTOIM.MLENTI 101 : POINTEUR KRTIMP.MLENTI,KRQIMP.MLENTI,KRMIXT.MLENTI 102 : POINTEUR KRCENT.MLENTI,KRFACE.MLENTI 103 : -INC SMLMOTS 104 : POINTEUR NOMINC.MLMOTS 105 : -INC SMMATRIK 106 : POINTEUR IJACO.MATRIK 107 : * 108 : REAL*8 MU,KAPPA,CV 109 : * 110 : INTEGER IMPR,IRET,ICLAU 111 : * 112 : LOGICAL LCLIMV,LCLITO 113 : LOGICAL LCLIMT,LCLIMQ,LMIXT 114 : * 115 : INTEGER NTOTPO 116 : C 117 : * 118 : * Executable statements 119 : * 120 : IMPR=0 121 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans ylap1a.eso' 122 : * Initialisation de la matrice jacobienne à zéro 122 : CALL ZERMAK(IJACO,IMPR,IRET) 123 : IF (IRET.NE.0) GOTO 9999 124 : * Lecture des données et initialisations de tableaux de travail 124 : CALL LICHT2(IROC,MPROC,MELBID,IMPR,IRET) 125 : IF (IRET.NE.0) GOTO 9999 125 : CALL LICHT2(IVITC,MPVITC,MELBID,IMPR,IRET) 126 : IF (IRET.NE.0) GOTO 9999 126 : CALL LICHT2(ITEMC,MPTEMC,MELBID,IMPR,IRET) 127 : IF (IRET.NE.0) GOTO 9999 127 : CALL LICHT2(IGRVF,MPGRVF,MELBID,IMPR,IRET) 128 : IF (IRET.NE.0) GOTO 9999 128 : CALL LICHT2(ISURF,MPSURF,MELBID,IMPR,IRET) 129 : IF (IRET.NE.0) GOTO 9999 129 : CALL LICHT2(INORM,MPNORM,MELBID,IMPR,IRET) 130 : IF (IRET.NE.0) GOTO 9999 130 : CALL LICHT2(IVOLU,MPVOLU,MELBID,IMPR,IRET) 131 : IF (IRET.NE.0) GOTO 9999 132 : LCLIMV=(IVIMP.NE.0) 133 : LCLITO=(ITOIM.NE.0) 134 : LCLIMT=(ITIMP.NE.0) 135 : LCLIMQ=(IQIMP.NE.0) 136 : LMIXT=(IMIXT.NE.0) 137 : NTOTPO=MCOORD.XCOOR(/1)/(IDIM+1) 138 : IF (LCLIMV) THEN 138 : CALL LICHT2(IVIMP,MPVIMP,MLVIMP,IMPR,IRET) 139 : IF (IRET.NE.0) GOTO 9999 140 : * In KRIPME : SEGINI KRVIMP 140 : CALL KRIPME(MLVIMP,NTOTPO,KRVIMP,IMPR,IRET) 141 : IF (IRET.NE.0) GOTO 9999 142 : ENDIF 143 : IF (LCLITO) THEN 143 : CALL LICHT2(ITOIM,MPTOIM,MLTOIM,IMPR,IRET) 144 : IF (IRET.NE.0) GOTO 9999 145 : * In KRIPME : SEGINI KRTOIM 145 : CALL KRIPME(MLTOIM,NTOTPO,KRTOIM,IMPR,IRET) 146 : IF (IRET.NE.0) GOTO 9999 147 : ENDIF 148 : IF (LCLIMT) THEN 148 : CALL LICHT2(ITIMP,MPTIMP,MLTIMP,IMPR,IRET) 149 : IF (IRET.NE.0) GOTO 9999 150 : * In KRIPME : SEGINI KRTIMP 150 : CALL KRIPME(MLTIMP,NTOTPO,KRTIMP,IMPR,IRET) 151 : IF (IRET.NE.0) GOTO 9999 152 : ENDIF 153 : IF (LCLIMQ) THEN 153 : CALL LICHT2(IQIMP,MPQIMP,MLQIMP,IMPR,IRET) 154 : IF (IRET.NE.0) GOTO 9999 155 : * In KRIPME : SEGINI KRQIMP 155 : CALL KRIPME(MLQIMP,NTOTPO,KRQIMP,IMPR,IRET) 156 : IF (IRET.NE.0) GOTO 9999 157 : ENDIF 158 : c ON EST ICI 159 : IF (LMIXT) THEN 159 : CALL LICHT2(IMIXT,MPMIXT,MLMIXT,IMPR,IRET) 160 : IF (IRET.NE.0) GOTO 9999 161 : * In KRIPME : SEGINI KRMIXT 161 : CALL KRIPME(MLMIXT,NTOTPO,KRMIXT,IMPR,IRET) 162 : IF (IRET.NE.0) GOTO 9999 163 : ENDIF 164 : * Repérage dans les faces, les centres 165 : * In KRIPME : SEGINI KRFACE 165 : CALL KRIPME(MELEMF,NTOTPO,KRFACE,IMPR,IRET) 166 : IF (IRET.NE.0) GOTO 9999 167 : * In KRIPME : SEGINI KRCENT 167 : CALL KRIPME(MELEMC,NTOTPO,KRCENT,IMPR,IRET) 168 : IF (IRET.NE.0) GOTO 9999 169 : * 170 : * Note : on pourrait regrouper les subroutines suivantes en une 171 : * seule pas trop longue, au prix d'un gros effort 172 : * (voir aussi la NOTE: dans ylap1c) 173 : * 174 : * Calcul des contributions 'simples' à la matrice jacobienne faisant 175 : * intervenir les coefficients pour le calcul des gradients de vitesse 176 : * (ICOGRV) 177 : * (contributions à (d Res_{\rho u} / d var) et (d Res_{\rho v} / d var) 178 : * var prenant successivement les valeurs : 179 : * \rho, \rho u, \rho v, \rho e_t ) 180 : * 181 : IF (ICLAU.EQ.0) THEN 181 : CALL YLAP1C(ICOGRV,MPROC,MPVITC, 182 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 183 : $ KRFACE,KRCENT,LCLIMV,KRVIMP,LCLITO,KRTOIM, 184 : $ NOMINC, 185 : $ MU, 186 : $ IJACO, 187 : $ IMPR,IRET) 188 : IF (IRET.NE.0) GOTO 9999 189 : ENDIF 190 : * 191 : * Calcul des contributions 'compliquées' à la matrice jacobienne faisant 192 : * intervenir les coefficients pour le calcul des gradients de vitesse 193 : * (ICOGRV) 194 : * (contributions à (d Res_{\rho e_t} / d var) 195 : * var prenant successivement les valeurs : 196 : * \rho, \rho u, \rho v, \rho e_t ) 197 : * Les contributions sont plus "compliquées" à calculer que les 198 : * simples car on a à dériver des produits de fonctions de la vitesse 199 : * d (f(u,v) * g(u,v)) / d var = f dg/dv + df/dv g 200 : * 201 : IF (ICLAU.EQ.0) THEN 201 : CALL YLAP1E(ICOGRV,MPGRVF,MPROC,MPVITC, 202 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 203 : $ KRFACE,KRCENT, 204 : $ LCLIMV,KRVIMP,MPVIMP, 205 : $ LCLITO,KRTOIM, 206 : $ NOMINC, 207 : $ MU, 208 : $ IJACO, 209 : $ IMPR,IRET) 210 : IF (IRET.NE.0) GOTO 9999 210 : CALL YLAP1D(ICOGRV,MPGRVF,MPROC,MPVITC, 211 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 212 : $ KRFACE,KRCENT, 213 : $ LCLIMV,KRVIMP, 214 : $ LCLITO,KRTOIM,MPTOIM, 215 : $ NOMINC, 216 : $ MU, 217 : $ IJACO, 218 : $ IMPR,IRET) 219 : IF (IRET.NE.0) GOTO 9999 220 : ENDIF 221 : * 222 : * Calcul des contributions à la matrice jacobienne faisant intervenir 223 : * les coefficients pour le calcul des gradients de température (ICOGRT) 224 : * (contributions à d Res_{\rho e_t} / d var 225 : * var prenant successivement les valeurs : 226 : * \rho, \rho u, \rho v, \rho e_t ) 227 : * 227 : CALL YLAP1B(ICOGRT,MPROC,MPVITC,MPTEMC, 228 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 229 : $ KRFACE,KRCENT,LCLIMT,KRTIMP,LCLIMQ,KRQIMP, 230 : $ LMIXT,KRMIXT, 231 : $ NOMINC,ICLAU, 232 : $ KAPPA,CV, 233 : $ IJACO, 234 : $ IMPR,IRET) 235 : IF (IRET.NE.0) GOTO 9999 236 : * 237 : * Destruction des tableaux de travail 238 : * 239 : SEGSUP KRCENT 240 : SEGSUP KRFACE 241 : IF (LCLIMQ) THEN 242 : SEGSUP KRQIMP 243 : ENDIF 244 : IF (LCLIMT) THEN 245 : SEGSUP KRTIMP 246 : ENDIF 247 : IF (LMIXT) THEN 248 : SEGSUP KRMIXT 249 : ENDIF 250 : IF (LCLITO) THEN 251 : SEGSUP KRTOIM 252 : ENDIF 253 : IF (LCLIMV) THEN 254 : SEGSUP KRVIMP 255 : ENDIF 256 : * 257 : * Normal termination 258 : * 259 : IRET=0 260 : RETURN 261 : * 262 : * Format handling 263 : * 264 : * 265 : * Error handling 266 : * 267 : 9999 CONTINUE 268 : IRET=1 269 : WRITE(IOIMP,*) 'An error was detected in subroutine ylap1a' 269 : CALL ERREUR(5) 270 : RETURN 271 : * 272 : * End of subroutine YLAP1A 273 : * 274 : END 275 : 276 : 277 : 278 : 279 : 280 : 281 : 282 : 283 : 284 :
© Cast3M 2003 - All rights reserved.
Disclaimer