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