1 : C ZLAP1A SOURCE MAGN 09/07/30 21:23:35 6458 2 : SUBROUTINE ZLAP1A(PROPHY,IROC,ITEMC, 3 : $ ITIMP,IRIMP, 4 : $ MELEMC,MELEMF,MELEFL,ISURF,INORM,IVOLU,NOMINC, 5 : $ IJACO) 6 : C*********************************************************************** 7 : C NOM : ZLAP1A 8 : C DESCRIPTION : Calcul de la matrice jacobienne du résidu du laplacien 9 : C VF 2D (termes multi-espèces). 10 : C 11 : C LANGAGE : ESOPE 12 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 13 : C mél : gounand@semt2.smts.cea.fr 14 : C*********************************************************************** 15 : C APPELES : ZLAP1B | Calcul des contributions à la matrice 16 : C ZLAP1C | jacobienne du résidu du laplacien VF 2D. 17 : C APPELES (UTIL) : LICHT2 : Lecture des pointeurs (maillages, valeurs) 18 : C d'un objet de type MCHPOI. 19 : C KRIPME : Création d'un tableau de repérage dans un 20 : C maillage de points. 21 : C ZERMAK : Création d'un objet de type MATRIK vide. 22 : C APPELES (STD) : ERREUR : Gestion des erreurs par GIBI. 23 : C APPELE PAR : ZLAP11 : Chapeau de l'opérateur Gibiane 'LAPN' 24 : C option 'VF'. 25 : C*********************************************************************** 26 : C ENTREES : PROPHY (type PROPHY) : propriétés des espèces 27 : C IROC (type MCHPOI) : masse volumique par élément. 28 : C ITEMC (type MCHPOI) : température par élément. 29 : C ITIMP (type MCHPOI) : CL de Dirichlet sur la 30 : C température. 31 : C IRIMP (type MCHPOI) : CL de Dirichlet sur la 32 : C densité. 33 : C MELEMC (type MELEME) : maillage des centres des 34 : C éléments. 35 : C MELEMF (type MELEME) : maillage des faces des 36 : C éléments. 37 : C MELEFL (type MELEME) : connectivités face-(centre 38 : C gauche, centre droit). 39 : C ISURF (type MCHPOI) : surface des faces. 40 : C INORM (type MCHPOI) : normale aux faces. 41 : C IVOLU (type MCHPOI) : volume des éléments. 42 : C NOMINC (type MLMOTS) : noms des inconnues. 43 : C ENTREES/SORTIES : IJACO (type MATRIK) : matrice jacobienne du 44 : C résidu du laplacien VF 2D. 45 : C SORTIES : - 46 : C*********************************************************************** 47 : C VERSION : v1, 21/02/2002, version initiale 48 : C HISTORIQUE : v1, 21/02/2002, création 49 : C HISTORIQUE : 50 : C HISTORIQUE : 51 : C*********************************************************************** 52 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 53 : C en cas de modification de ce sous-programme afin de faciliter 54 : C la maintenance ! 55 : C*********************************************************************** 56 : IMPLICIT INTEGER(I-N) 57 : -INC CCOPTIO 58 : -INC SMCOORD 59 : -INC SMCHPOI 60 : POINTEUR IROC.MCHPOI,ITEMC.MCHPOI 61 : POINTEUR ICDIFF.MCHPOI,IYKC.MCHPOI,IGRYKF.MCHPOI 62 : POINTEUR ITIMP.MCHPOI ,IRIMP.MCHPOI,IYIMP.MCHPOI 63 : POINTEUR ISURF.MCHPOI ,INORM.MCHPOI ,IVOLU.MCHPOI 64 : POINTEUR MPROC.MPOVAL ,MPTEMC.MPOVAL 65 : POINTEUR MPCDIF.MPOVAL,MPYK.MPOVAL,MPGRYK.MPOVAL 66 : POINTEUR MPTIMP.MPOVAL,MPRIMP.MPOVAL,MPYIMP.MPOVAL 67 : POINTEUR MPSURF.MPOVAL,MPNORM.MPOVAL,MPVOLU.MPOVAL 68 : -INC SMELEME 69 : POINTEUR MELEMC.MELEME,MELEMF.MELEME,MELEFL.MELEME 70 : POINTEUR MELBID.MELEME 71 : POINTEUR MLTIMP.MELEME,MLRIMP.MELEME,MLYIMP.MELEME 72 : -INC SMLENTI 73 : POINTEUR KRTIMP.MLENTI,KRRIMP.MLENTI,KRYIMP.MLENTI 74 : POINTEUR KRCENT.MLENTI,KRFACE.MLENTI 75 : -INC SMLMOTS 76 : POINTEUR NOMINC.MLMOTS 77 : -INC SMMATRIK 78 : POINTEUR IJACO.MATRIK 79 : * 80 : INTEGER IMPR,IRET 81 : * 82 : LOGICAL LCLIMT,LCLIMR,LCLIMY 83 : * 84 : INTEGER NTOTPO 85 : INTEGER NESP 86 : SEGMENT PROPHY 87 : CHARACTER*4 NOMESP(NESP+1) 88 : REAL*8 CV(NESP+1) 89 : REAL*8 R(NESP+1) 90 : REAL*8 H0K(NESP+1) 91 : POINTEUR CDIFF(NESP+1).MCHPOI 92 : POINTEUR YK(NESP+1).MCHPOI 93 : POINTEUR GRADYK(NESP+1).MCHPOI 94 : POINTEUR CGRYK(NESP+1).MCHELM 95 : POINTEUR CLYK(NESP+1).MCHPOI 96 : ENDSEGMENT 97 : SEGMENT PROPH2 98 : POINTEUR MPDIFF(NESP+1).MPOVAL 99 : POINTEUR MPVALY(NESP+1).MPOVAL 100 : POINTEUR MPGRAD(NESP+1).MPOVAL 101 : LOGICAL LCLIM(NESP+1) 102 : POINTEUR KRCLIM(NESP+1).MLENTI 103 : ENDSEGMENT 104 : * 105 : INTEGER IESP 106 : * 107 : * Executable statements 108 : * 109 : IMPR=0 110 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans zlap1a.eso' 111 : * Lecture des données et initialisations de tableaux de travail 111 : CALL LICHT2(IROC,MPROC,MELBID,IMPR,IRET) 112 : IF (IRET.NE.0) GOTO 9999 112 : CALL LICHT2(ITEMC,MPTEMC,MELBID,IMPR,IRET) 113 : IF (IRET.NE.0) GOTO 9999 113 : CALL LICHT2(ISURF,MPSURF,MELBID,IMPR,IRET) 114 : IF (IRET.NE.0) GOTO 9999 114 : CALL LICHT2(INORM,MPNORM,MELBID,IMPR,IRET) 115 : IF (IRET.NE.0) GOTO 9999 115 : CALL LICHT2(IVOLU,MPVOLU,MELBID,IMPR,IRET) 116 : IF (IRET.NE.0) GOTO 9999 117 : LCLIMT=(ITIMP.NE.0) 118 : LCLIMR=(IRIMP.NE.0) 119 : NTOTPO=MCOORD.XCOOR(/1)/(IDIM+1) 120 : IF (LCLIMT) THEN 120 : CALL LICHT2(ITIMP,MPTIMP,MLTIMP,IMPR,IRET) 121 : IF (IRET.NE.0) GOTO 9999 122 : * In KRIPME : SEGINI KRTIMP 122 : CALL KRIPME(MLTIMP,NTOTPO,KRTIMP,IMPR,IRET) 123 : IF (IRET.NE.0) GOTO 9999 124 : ENDIF 125 : IF (LCLIMR) THEN 125 : CALL LICHT2(IRIMP,MPRIMP,MLRIMP,IMPR,IRET) 126 : IF (IRET.NE.0) GOTO 9999 127 : * In KRIPME : SEGINI KRRIMP 127 : CALL KRIPME(MLRIMP,NTOTPO,KRRIMP,IMPR,IRET) 128 : IF (IRET.NE.0) GOTO 9999 129 : ENDIF 130 : * Repérage dans les faces, les centres 131 : * In KRIPME : SEGINI KRFACE 131 : CALL KRIPME(MELEMF,NTOTPO,KRFACE,IMPR,IRET) 132 : IF (IRET.NE.0) GOTO 9999 133 : * In KRIPME : SEGINI KRCENT 133 : CALL KRIPME(MELEMC,NTOTPO,KRCENT,IMPR,IRET) 134 : IF (IRET.NE.0) GOTO 9999 135 : SEGACT PROPHY 136 : NESP=PROPHY.CV(/1)-1 137 : SEGINI PROPH2 138 : DO IESP=1,NESP+1 139 : ICDIFF=PROPHY.CDIFF(IESP) 139 : CALL LICHT2(ICDIFF,MPCDIF,MELBID,IMPR,IRET) 140 : IF (IRET.NE.0) GOTO 9999 141 : PROPH2.MPDIFF(IESP)=MPCDIF 142 : IYKC=PROPHY.YK(IESP) 142 : CALL LICHT2(IYKC,MPYK,MELBID,IMPR,IRET) 143 : IF (IRET.NE.0) GOTO 9999 144 : PROPH2.MPVALY(IESP)=MPYK 145 : IGRYKF=PROPHY.GRADYK(IESP) 145 : CALL LICHT2(IGRYKF,MPGRYK,MELBID,IMPR,IRET) 146 : IF (IRET.NE.0) GOTO 9999 147 : PROPH2.MPGRAD(IESP)=MPGRYK 148 : IYIMP=PROPHY.CLYK(IESP) 149 : LCLIMY=(IYIMP.NE.0) 150 : PROPH2.LCLIM(IESP)=LCLIMY 151 : IF (LCLIMY) THEN 151 : CALL LICHT2(IYIMP,MPYIMP,MLYIMP,IMPR,IRET) 152 : IF (IRET.NE.0) GOTO 9999 153 : * In KRIPME : SEGINI KRYIMP 153 : CALL KRIPME(MLYIMP,NTOTPO,KRYIMP,IMPR,IRET) 154 : IF (IRET.NE.0) GOTO 9999 155 : PROPH2.KRCLIM(IESP)=KRYIMP 156 : ENDIF 157 : ENDDO 158 : SEGDES PROPH2 159 : SEGDES PROPHY 160 : * Calcul des contributions suivantes à la matrice jacobienne faisant 161 : * intervenir les coefficients pour le calcul des gradients de Yk 162 : * (contributions à (d Res_{\rho Yk} / d var) 163 : * var prenant successivement les valeurs : 164 : * \rho, \rho Yk ) 165 : * 165 : CALL ZLAP1B(PROPHY,PROPH2,MPROC, 166 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 167 : $ KRFACE,KRCENT,LCLIMR,KRRIMP,MPRIMP, 168 : $ NOMINC, 169 : $ IJACO, 170 : $ IMPR,IRET) 171 : IF (IRET.NE.0) GOTO 9999 172 : * Calcul des contributions suivantes à la matrice jacobienne faisant 173 : * intervenir les coefficients pour le calcul des gradients de Yk 174 : * (contributions à (d Res_{\rho e_t} / d var) 175 : * var prenant successivement les valeurs : 176 : * \rho, \rho Yk ) 177 : * 177 : CALL ZLAP1C(PROPHY,PROPH2,MPROC,MPTEMC, 178 : $ MPVOLU,MPNORM,MPSURF,MELEFL, 179 : $ KRFACE,KRCENT, 180 : $ LCLIMR,KRRIMP,MPRIMP, 181 : $ LCLIMT,KRTIMP,MPTIMP, 182 : $ NOMINC, 183 : $ IJACO, 184 : $ IMPR,IRET) 185 : IF (IRET.NE.0) GOTO 9999 186 : * 187 : * Destruction des tableaux de travail 188 : * 189 : SEGACT PROPH2 190 : DO IESP=1,NESP+1 191 : LCLIMY=PROPH2.LCLIM(IESP) 192 : IF (LCLIMY) THEN 193 : KRYIMP=PROPH2.KRCLIM(IESP) 194 : SEGSUP KRYIMP 195 : ENDIF 196 : ENDDO 197 : SEGSUP PROPH2 198 : SEGSUP KRCENT 199 : SEGSUP KRFACE 200 : IF (LCLIMR) THEN 201 : SEGSUP KRRIMP 202 : ENDIF 203 : IF (LCLIMT) THEN 204 : SEGSUP KRTIMP 205 : ENDIF 206 : * 207 : * Normal termination 208 : * 209 : IRET=0 210 : RETURN 211 : * 212 : * Format handling 213 : * 214 : * 215 : * Error handling 216 : * 217 : 9999 CONTINUE 218 : IRET=1 219 : WRITE(IOIMP,*) 'An error was detected in subroutine zlap1a' 219 : CALL ERREUR(5) 220 : RETURN 221 : * 222 : * End of subroutine ZLAP1A 223 : * 224 : END 225 : 226 : 227 : 228 : 229 : 230 : 231 : 232 :
© Cast3M 2003 - All rights reserved.
Disclaimer