1 : C XLAP1A SOURCE MAGN 09/07/30 21:21:17 6458 2 : SUBROUTINE XLAP1A(IMUC,IKAPC,ICVC,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 : XLAP1A 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 : XLAP1B | 17 : C XLAP1C | Calcul des contributions à la matrice 18 : C XLAP1D | jacobienne du résidu du laplacien VF 2D. 19 : C XLAP1E | 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 : ZLAP11 : Chapeau de l'opérateur Gibiane 'LAPN' 27 : C option 'VF'. 28 : C*********************************************************************** 29 : C ENTREES : IMUC (type MCHPOI) : viscosité dynamique (SI). 30 : C IKAPC (type MCHPOI) : conductivité thermique (SI) 31 : C ICVC (type MCHPOI) : 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 2D. 64 : C SORTIES : - 65 : C*********************************************************************** 66 : C VERSION : v1, 01/01/2002, version initiale 67 : C HISTORIQUE : v1, 01/01/2002, 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 IMUC.MCHPOI ,IKAPC.MCHPOI ,ICVC.MCHPOI 80 : POINTEUR IROC.MCHPOI ,IVITC.MCHPOI ,ITEMC.MCHPOI 81 : POINTEUR IGRVF.MCHPOI 82 : POINTEUR IVIMP.MCHPOI ,ITOIM.MCHPOI 83 : POINTEUR ITIMP.MCHPOI ,IQIMP.MCHPOI 84 : POINTEUR ISURF.MCHPOI ,INORM.MCHPOI ,IVOLU.MCHPOI 85 : POINTEUR MPMUC.MPOVAL ,MPKAPC.MPOVAL,MPCVC.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 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 98 : -INC SMLENTI 99 : POINTEUR KRVIMP.MLENTI,KRTOIM.MLENTI 100 : POINTEUR KRTIMP.MLENTI,KRQIMP.MLENTI 101 : POINTEUR KRCENT.MLENTI,KRFACE.MLENTI 102 : -INC SMLMOTS 103 : POINTEUR NOMINC.MLMOTS 104 : -INC SMMATRIK 105 : POINTEUR IJACO.MATRIK 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 xlap1a.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(IMUC,MPMUC,MELBID,IMPR,IRET) 122 : IF (IRET.NE.0) GOTO 9999 122 : CALL LICHT2(IKAPC,MPKAPC,MELBID,IMPR,IRET) 123 : IF (IRET.NE.0) GOTO 9999 123 : CALL LICHT2(ICVC,MPCVC,MELBID,IMPR,IRET) 124 : IF (IRET.NE.0) GOTO 9999 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 : 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 : IF (LCLIMQ) THEN 152 : CALL LICHT2(IQIMP,MPQIMP,MLQIMP,IMPR,IRET) 153 : IF (IRET.NE.0) GOTO 9999 154 : * In KRIPME : SEGINI KRQIMP 154 : CALL KRIPME(MLQIMP,NTOTPO,KRQIMP,IMPR,IRET) 155 : IF (IRET.NE.0) GOTO 9999 156 : ENDIF 157 : * Repérage dans les faces, les centres 158 : * In KRIPME : SEGINI KRFACE 158 : CALL KRIPME(MELEMF,NTOTPO,KRFACE,IMPR,IRET) 159 : IF (IRET.NE.0) GOTO 9999 160 : * In KRIPME : SEGINI KRCENT 160 : CALL KRIPME(MELEMC,NTOTPO,KRCENT,IMPR,IRET) 161 : IF (IRET.NE.0) GOTO 9999 162 : * 163 : * Note : on pourrait regrouper les subroutines suivantes en une 164 : * seule pas trop longue, au prix d'un gros effort 165 : * (voir aussi la NOTE: dans xlap1c) 166 : * 167 : * Calcul des contributions 'simples' à la matrice jacobienne faisant 168 : * intervenir les coefficients pour le calcul des gradients de vitesse 169 : * (ICOGRV) 170 : * (contributions à (d Res_{\rho u} / d var) et (d Res_{\rho v} / d var) 171 : * var prenant successivement les valeurs : 172 : * \rho, \rho u, \rho v, \rho e_t ) 173 : * 173 : CALL XLAP1C(ICOGRV,MPROC,MPVITC, 174 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 175 : $ KRFACE,KRCENT,LCLIMV,KRVIMP,LCLITO,KRTOIM, 176 : $ NOMINC, 177 : $ MPMUC, 178 : $ IJACO, 179 : $ IMPR,IRET) 180 : IF (IRET.NE.0) GOTO 9999 181 : * 182 : * Calcul des contributions 'compliquées' à la matrice jacobienne faisant 183 : * intervenir les coefficients pour le calcul des gradients de vitesse 184 : * (ICOGRV) 185 : * (contributions à (d Res_{\rho e_t} / d var) 186 : * var prenant successivement les valeurs : 187 : * \rho, \rho u, \rho v, \rho e_t ) 188 : * Les contributions sont plus "compliquées" à calculer que les 189 : * simples car on a à dériver des produits de fonctions de la vitesse 190 : * d (f(u,v) * g(u,v)) / d var = f dg/dv + df/dv g 191 : * 191 : CALL XLAP1E(ICOGRV,MPGRVF,MPROC,MPVITC, 192 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 193 : $ KRFACE,KRCENT, 194 : $ LCLIMV,KRVIMP,MPVIMP, 195 : $ LCLITO,KRTOIM, 196 : $ NOMINC, 197 : $ MPMUC, 198 : $ IJACO, 199 : $ IMPR,IRET) 200 : IF (IRET.NE.0) GOTO 9999 200 : CALL XLAP1D(ICOGRV,MPGRVF,MPROC,MPVITC, 201 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 202 : $ KRFACE,KRCENT, 203 : $ LCLIMV,KRVIMP, 204 : $ LCLITO,KRTOIM,MPTOIM, 205 : $ NOMINC, 206 : $ MPMUC, 207 : $ IJACO, 208 : $ IMPR,IRET) 209 : IF (IRET.NE.0) GOTO 9999 210 : * 211 : * Calcul des contributions à la matrice jacobienne faisant intervenir 212 : * les coefficients pour le calcul des gradients de température (ICOGRT) 213 : * (contributions à d Res_{\rho e_t} / d var 214 : * var prenant successivement les valeurs : 215 : * \rho, \rho u, \rho v, \rho e_t ) 216 : * 216 : CALL XLAP1B(ICOGRT,MPROC,MPVITC,MPTEMC, 217 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 218 : $ KRFACE,KRCENT,LCLIMT,KRTIMP,LCLIMQ,KRQIMP, 219 : $ NOMINC, 220 : $ MPKAPC,MPCVC, 221 : $ IJACO, 222 : $ IMPR,IRET) 223 : IF (IRET.NE.0) GOTO 9999 224 : * 225 : * Destruction des tableaux de travail 226 : * 227 : SEGSUP KRCENT 228 : SEGSUP KRFACE 229 : IF (LCLIMQ) THEN 230 : SEGSUP KRQIMP 231 : ENDIF 232 : IF (LCLIMT) THEN 233 : SEGSUP KRTIMP 234 : ENDIF 235 : IF (LCLITO) THEN 236 : SEGSUP KRTOIM 237 : ENDIF 238 : IF (LCLIMV) THEN 239 : SEGSUP KRVIMP 240 : ENDIF 241 : * 242 : * Normal termination 243 : * 244 : IRET=0 245 : RETURN 246 : * 247 : * Format handling 248 : * 249 : * 250 : * Error handling 251 : * 252 : 9999 CONTINUE 253 : IRET=1 254 : WRITE(IOIMP,*) 'An error was detected in subroutine xlap1a' 254 : CALL ERREUR(5) 255 : RETURN 256 : * 257 : * End of subroutine XLAP1A 258 : * 259 : END 260 : 261 : 262 : 263 : 264 : 265 : 266 : 267 : 268 : 269 :
© Cast3M 2003 - All rights reserved.
Disclaimer