1 : C KONJS1 SOURCE MAGN 09/07/30 21:18:25 6458 2 : SUBROUTINE KONJS1(INDMET,ILINC,ISF,IUN,INORM,ICHPVO 3 : $ ,ICHPSU,MELEMC,MELEMF,MELEFE,IMAT) 4 : C 5 : C************************************************************************ 6 : C 7 : C PROJET : CASTEM 2000 8 : C 9 : C NOM : KONJS1 10 : C 11 : C DESCRIPTION : Voir KONV15 12 : C Calcul du jacobien du résidu 13 : C Cas 2D/3D 14 : C 15 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 16 : C 17 : C AUTEUR : A. BECCANTINI, SFME/LTMF 18 : C 19 : C************************************************************************ 20 : C 21 : C 22 : C APPELES (Outils 23 : C CASTEM) : KRIPAD, LICHT, ERREUR 24 : C 25 : C APPELES (Calcul) : 26 : C 27 : C************************************************************************ 28 : C 29 : C ENTREES 30 : C 31 : C INDMET : type de Methode 32 : C 1 UPWIND 33 : C 2 CENTERED 34 : C 35 : C ILINC : liste des inconnues 36 : C 37 : C 1) Pointeurs des CHPOINT/CHAMELEM 38 : C 39 : C IUN : CHPOINT FACE contenant la vitesse ; 40 : C 41 : C ISF : CHAMELEM 'FACEL' contenant les scalaires à transporter 42 : C 43 : C INORM : CHPOINT FACE contenant les normales aux faces ; 44 : C 45 : C ICHPVO : CHPOINT VOLUME contenant le volume 46 : C 47 : C ICHPSU : CHPOINT FACE contenant la surface des faces 48 : C 49 : C 50 : C 2) Pointeurs de MELEME de la table DOMAINE 51 : C 52 : C MELEMC : MELEME 'CENTRE' du SPG des CENTRES 53 : C 54 : C MELEFE : MELEME 'FACEL' du connectivité Faces -> Elts 55 : C 56 : C SORTIES 57 : C 58 : C IMAT : pointeur de la MATRIK du jacobien du residu 59 : C 60 : C************************************************************************ 61 : C 62 : C HISTORIQUE (Anomalies et modifications éventuelles) 63 : C 64 : C HISTORIQUE : Créée le 03.12.01 65 : C 66 : C************************************************************************ 67 : C 68 : C 69 : C**** Variables de COOPTIO 70 : C 71 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 72 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 73 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 74 : C & ,IECHO, IIMPI, IOSPI 75 : C & ,IDIM 76 : C & ,MCOORD 77 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 78 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 79 : C & ,NORINC,NORVAL,NORIND,NORVAD 80 : C & ,NUCROU, IPSAUV 81 : C 82 : IMPLICIT INTEGER(I-N) 83 : INTEGER ILINC, ISF ,IUN, INORM,ICHPVO,ICHPSU 84 : & , IMAT, IGEOMC, IGEOMF 85 : & , NFAC, NBSOUS, NBREF, NBELEM, NBNN, NRIGE, NMATRI, NKID 86 : & , NKMT, NBME, NBEL, MP, NP 87 : & , IFAC, NGCF, NLCF, NGCG, NGCD, NLCG, NLCD, NINC, IINC 88 : & ,INDMET 89 : REAL*8 UNX, UNY, UNZ, UN, VOLG, VOLD 90 : & , SURF, CNX, CNY, CNZ, FUNCEL 91 : CHARACTER*8 TYPE 92 : C 93 : C**** LES INCLUDES 94 : C 95 : -INC CCOPTIO 96 : -INC SMCHPOI 97 : -INC SMMATRIK 98 : -INC SMELEME 99 : -INC SMLMOTS 100 : -INC SMLENTI 101 : POINTEUR MPUN.MPOVAL, 102 : & MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.MPOVAL 103 : POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME, 104 : & MELEDU.MELEME 105 : POINTEUR MLENTC.MLENTI, MLENTF.MLENTI 106 : POINTEUR MATSS.IZAFM 107 : POINTEUR MLMINC.MLMOTS 108 : C 109 : C**** KRIPAD pour la correspondance global/local des centres 110 : C 110 : CALL KRIPAD(MELEMC,MLENTC) 111 : C 112 : C SEGACT MLENTC 113 : SEGACT MELEMC 114 : C 115 : SEGACT MELEFE 116 : C 116 : CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF) 116 : CALL LICHT(INORM,MPNORM,TYPE,IGEOMF) 116 : CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC) 117 : C 118 : C**** LICHT active les MPOVALs en *MOD 119 : C 120 : C i.e. 121 : C 122 : C SEGACT MPOVSU*MOD 123 : C SEGACT MPOVNO*MOD 124 : C SEGACT MPVOLU*MOD 125 : C 126 : MELEMF = IGEOMF 126 : CALL KRIPAD(MELEMF,MLENTF) 127 : C 128 : C SEGACT MLENTF 129 : SEGACT MELEMF 130 : C 130 : CALL LICHT(IUN,MPUN,TYPE,IGEOMC) 131 : C 132 : C SEGACT MPUN*MOD 133 : C 134 : NFAC = MELEFE.NUM(/2) 135 : C 136 : C**** Maillage des inconnues primales 137 : C 138 : NBSOUS = 0 139 : NBREF = 0 140 : NBELEM = NFAC 141 : NBNN = 2 142 : C 143 : SEGINI MELEDU 144 : C MELEPR = MELEDU 145 : C 146 : C**** MELEDU = 'SEG2' 147 : C 148 : MELEDU.ITYPEL = 2 149 : C 150 : NRIGE = 7 151 : NMATRI = 1 152 : NKID = 9 153 : NKMT = 7 154 : C 155 : SEGINI MATRIK 156 : IMAT = MATRIK 157 : MATRIK.IRIGEL(1,1) = MELEDU 158 : MATRIK.IRIGEL(2,1) = MELEDU 159 : C 160 : C**** Matrice non symetrique 161 : C 162 : MATRIK.IRIGEL(7,1) = 2 163 : C 164 : MLMINC = ILINC 165 : SEGACT MLMINC 166 : NINC=MLMINC.MOTS(/2) 167 : NBME = NINC 168 : NBSOUS = 1 169 : SEGINI IMATRI 170 : MATRIK.IRIGEL(4,1) = IMATRI 171 : C 172 : NBEL = NBELEM 173 : NBSOUS = 1 174 : NP = 2 175 : MP = 2 176 : DO IINC=1,NINC,1 177 : IMATRI.LISPRI(IINC) = MLMINC.MOTS(IINC) 178 : IMATRI.LISDUA(IINC) = MLMINC.MOTS(IINC) 179 : SEGINI MATSS 180 : IMATRI.LIZAFM(1,IINC) = MATSS 181 : ENDDO 182 : C 183 : DO IFAC = 1, NFAC, 1 184 : NGCF = MELEFE.NUM(2,IFAC) 185 : NLCF = MLENTF.LECT(NGCF) 186 : IF(NLCF .NE. IFAC)THEN 187 : WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine' 187 : CALL ERREUR(5) 188 : GOTO 9999 189 : ENDIF 190 : NGCG = MELEFE.NUM(1,IFAC) 191 : NGCD = MELEFE.NUM(3,IFAC) 192 : SURF = MPOVSU.VPOCHA(NLCF,1) 193 : CNX = MPNORM.VPOCHA(NLCF,1) 194 : CNY = MPNORM.VPOCHA(NLCF,2) 195 : UNX = MPUN.VPOCHA(NLCF,1) 196 : UNY = MPUN.VPOCHA(NLCF,2) 197 : UN= (UNX*CNX) + (UNY*CNY) 198 : IF(IDIM .EQ. 3)THEN 199 : CNZ = MPNORM.VPOCHA(NLCF,3) 200 : UNZ = MPUN.VPOCHA(NLCF,3) 201 : UN=UN+(UNZ*CNZ) 202 : ENDIF 203 : IF(NGCG .NE. NGCD)THEN 204 : C 205 : C********** Les MELEMEs 206 : C 207 : MELEDU.NUM(1,IFAC) = NGCG 208 : MELEDU.NUM(2,IFAC) = NGCD 209 : C 210 : C********** Les etats G et D 211 : C 212 : NLCG = MLENTC.LECT(NGCG) 213 : NLCD = MLENTC.LECT(NGCD) 214 : VOLG = MPVOLU.VPOCHA(NLCG,1) 215 : VOLD = MPVOLU.VPOCHA(NLCD,1) 216 : C 217 : C********** MATSS.AM(IFAC,IPRIM,IDUAL) 218 : C IPRIM = 1, 2 -> G, D 219 : C IDUAL = 1, 2 -> G, D 220 : C 221 : C********** Dual RN 222 : C 223 : IF(INDMET .EQ. 1)THEN 224 : FUNCEL = SURF * UN 225 : IF(UN .GT. 0)THEN 226 : DO IINC=1,NINC,1 227 : MATSS=IMATRI.LIZAFM(1,IINC) 228 : MATSS.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 229 : MATSS.AM(IFAC,1,2) = FUNCEL / VOLD 230 : MATSS.AM(IFAC,2,1) = 0.0D0 231 : MATSS.AM(IFAC,2,2) = 0.0D0 232 : ENDDO 233 : ELSE 234 : DO IINC=1,NINC,1 235 : MATSS=IMATRI.LIZAFM(1,IINC) 236 : MATSS.AM(IFAC,2,2) = FUNCEL / VOLD 237 : MATSS.AM(IFAC,2,1) = -1.0D0 * FUNCEL / VOLG 238 : MATSS.AM(IFAC,1,1) = 0.0D0 239 : MATSS.AM(IFAC,1,2) = 0.0D0 240 : ENDDO 241 : ENDIF 242 : ELSEIF(INDMET .EQ.2)THEN 243 : FUNCEL = SURF * UN * 0.5D0 244 : DO IINC=1,NINC,1 245 : MATSS=IMATRI.LIZAFM(1,IINC) 246 : MATSS.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 247 : MATSS.AM(IFAC,1,2) = FUNCEL / VOLD 248 : MATSS.AM(IFAC,2,1) = -1.0D0 * FUNCEL /VOLG 249 : MATSS.AM(IFAC,2,2) = FUNCEL / VOLD 250 : ENDDO 251 : ELSE 251 : CALL ERREUR(251) 252 : GOTO 9999 253 : ENDIF 254 : ELSE 255 : C 256 : C********** Murs (NGCG = NGCD) 257 : C 258 : C 259 : C********** Les MELEMEs 260 : C 261 : MELEDU.NUM(1,IFAC) = NGCG 262 : MELEDU.NUM(2,IFAC) = NGCD 263 : NLCG = MLENTC.LECT(NGCG) 264 : VOLG = MPVOLU.VPOCHA(NLCG,1) 265 : C 266 : IF((INDMET .EQ. 1).OR.(INDMET .EQ. 2))THEN 267 : FUNCEL = SURF * UN 268 : DO IINC=1,NINC,1 269 : MATSS=IMATRI.LIZAFM(1,IINC) 270 : MATSS.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 271 : MATSS.AM(IFAC,1,2) = 0.0D0 272 : MATSS.AM(IFAC,2,1) = 0.0D0 273 : MATSS.AM(IFAC,2,2) = 0.0D0 274 : ENDDO 275 : ELSE 275 : CALL ERREUR(251) 276 : GOTO 9999 277 : ENDIF 278 : ENDIF 279 : ENDDO 280 : C 281 : SEGDES MELEMC 282 : SEGDES MELEFE 283 : SEGDES MELEMF 284 : C 285 : SEGDES MPOVSU 286 : SEGDES MPVOLU 287 : SEGDES MPNORM 288 : C 289 : SEGDES MPUN 290 : C 291 : SEGDES MELEDU 292 : SEGDES MATRIK 293 : DO IINC=1,NINC,1 294 : MATSS=IMATRI.LIZAFM(1,IINC) 295 : SEGDES MATSS 296 : ENDDO 297 : SEGDES IMATRI 298 : C 299 : SEGSUP MLENTC 300 : SEGSUP MLENTF 301 : SEGDES MLMINC 302 : 303 : 9999 CONTINUE 304 : RETURN 305 : END 306 : 307 : 308 : 309 : 310 : 311 :
© Cast3M 2003 - All rights reserved.
Disclaimer