1 : C KONV14 SOURCE MAGN 09/07/30 21:18:31 6458 2 : SUBROUTINE KONV14() 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : KONV14 8 : C 9 : C DESCRIPTION : Subroutine appellée par KONV1 10 : C 11 : C Modelisation 2D/3D du transport des scalaires 12 : C 13 : C Calcul du residu / jacobien / DELTAT 14 : C 15 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 16 : C 17 : C AUTEUR : A. BECCANTINI, DM2S/SFME 18 : C 19 : C************************************************************************ 20 : C 21 : C APPELES (Calcul) : 22 : C 23 : C************************************************************************ 24 : C 25 : C*** SYNTAXE 26 : C 27 : C Discrétisation en VF "cell-centered" du transport des scalaires 28 : C --> ---> 29 : C d/dt S + u . grad (S) = 0 30 : C --> 31 : C avec div( u ) = 0 32 : C 33 : C RCHPO1 RFLOT1 = 'KONV' 'VF' 'CLAUDEIS' 'FACE' MOT1 MOT2 34 : C MOD1 CHPO1 MCHAM1 ; 35 : C 36 : C or 37 : C 38 : C RMAT1 = 'KONV' 'VF' 'CLAUDEIS' 'FACE' 'JACO' MOT2 39 : C MOD1 CHPO1 MCHAM1 ; 40 : C 41 : C ENTREES 42 : C 43 : C MOT1 : objet de type MOT 44 : C Il vaut 'RESI' si on veut calculer le résidu, 45 : C (i.e. l'increment des scalaires passives par unité 46 : C de temps) 47 : C Il vaut 'FLUX' si on veut calculer le flux 48 : C 49 : C MOT2 : objet de type MOT 50 : C Il indique la méthode de calcul du flux 51 : C Pour l'instant 52 : C 'UPWIND' 53 : C 'CENTERED' 54 : C 55 : C MOD1 : objet modele de type Navier_Stokes 56 : C 57 : C CHPO1 : CHPOINT contenant la vitesse aux FACEs 58 : C (SPG = l'indice 'FACE' de TAB1) 59 : C 2/3 composantes, 'UX', 'UY', 'UZ' 60 : C 61 : C MCHAM1 : MCHAML contenant les scalaires à transporter 62 : C SPG (support géométrique) l'indice 'FACEL' de 63 : C TAB1 64 : C 65 : C SORTIES 66 : C 67 : C RCHPO1 : objet de type CHPOINT (memes composantes que MCHAM1) 68 : C Residu si MOT2 = 'RESI' (SPG = TAB1 . 'CENTRE') 69 : C Flux si MOT2 = 'FLUX' (SPG = TAB1 . 'FACE') 70 : C 71 : C RFLOT1 : objet de type FLOTTANT 72 : C Il est le temps caracteristique associé à l'onde la plus 73 : C rapide. 74 : C 75 : C RMAT1 : objet de type MATRIK 76 : C (SPG = TAB1 . 'CENTRE') 77 : C (inconnues primales = inconnues duales = memes composantes 78 : C que MCHAM1) 79 : C 80 : C*********************************************************************** 81 : C 82 : C************************************************************************ 83 : C 84 : C HISTORIQUE (Anomalies et modifications éventuelles) 85 : C 86 : C HISTORIQUE : créée le 29.11.01 87 : C 88 : C************************************************************************ 89 : C 90 : IMPLICIT INTEGER(I-N) 91 : -INC CCOPTIO 92 : -INC SMLMOTS 93 : -INC SMCHAML 94 : -INC SMMATRIK 95 : -INC SMCHPOI 96 : POINTEUR MLMVIT.MLMOTS, MLMSF.MLMOTS 97 : C 98 : C**** Variables de COOPTIO 99 : C 100 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 101 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 102 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 103 : C & ,IECHO, IIMPI, IOSPI 104 : C & ,IDIM 105 : C & ,MCOORD 106 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 107 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 108 : C & ,NORINC,NORVAL,NORIND,NORVAD 109 : C & ,NUCROU, IPSAUV 110 : C 111 : INTEGER IDOMA, MELEMC, MELEMF, MELEFE, ICHPSU, ICHPDI , ICHPVO 112 : & , INORM, ICELL, NBMET, NBDIS,INDMET, IRES, IRET 113 : & , ISF 114 : & , INDIC, NBCOMP, IVN, IJACO 115 : & , JGM, JGN 116 : & , ICHFLU, ICHRES 117 : & , N1, N2, I1, INEFMD, ICOND 118 : C 119 : PARAMETER (NBMET=2,NBDIS=1) 120 : REAL*8 DT 121 : CHARACTER*8 LMETO(NBMET), TYPE, LVITE(NBDIS) 122 : CHARACTER*4 MOT, LFLUX(3) 123 : CHARACTER*(40) MESERR 124 : LOGICAL LOGAN 125 : C 126 : DATA LVITE/'FACE '/ 127 : DATA LMETO/'UPWIND ','CENTERED'/ 128 : DATA LFLUX/'FLUX','RESI','JACO'/ 129 : C 130 : C**** Initialisation des variables pour la gestion des erreurs. 131 : C 132 : LOGAN = .FALSE. 133 : MESERR = ' ' 134 : C 135 : C***** Vitesse aux faces??? 136 : C 136 : CALL LIRMOT(LVITE,NBDIS,ICELL,1) 137 : IF(IERR .NE. 0)GOTO 9999 138 : IF(ICELL .EQ. 0)THEN 139 : C 140 : C******** Message d'erreur standard 141 : C 251 2 142 : C Tentative d'utilisation d'une option non implémentée 143 : C 143 : CALL ERREUR(251) 144 : ENDIF 145 : C 146 : C******* Flux, residu, ou jacobien ??? 147 : C 147 : CALL LIRMOT(LFLUX,3,IRES,1) 148 : IF(IERR .NE. 0)GOTO 9999 149 : C 150 : C**** Metode utilisée 151 : C 151 : CALL LIRMOT(LMETO,NBMET,INDMET,1) 152 : IF(IERR .NE. 0)GOTO 9999 153 : IF(INDMET .EQ. 0)THEN 154 : C 155 : C******** Message d'erreur standard 156 : C 251 2 157 : C Tentative d'utilisation d'une option non implémentée 158 : C 158 : CALL ERREUR(251) 159 : ENDIF 160 : C 161 : C********************************** 162 : C**** Lecture de l'objet MODELE *** 163 : C********************************** 164 : C 165 : ICOND = 1 165 : CALL QUETYP(TYPE,ICOND,IRET) 166 : 167 : IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN 168 : WRITE(6,*)' On attend un objet MMODEL' 169 : RETURN 170 : ENDIF 170 : CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET) 171 : IF(IERR.NE.0)GOTO 9999 171 : CALL LEKMOD(MMODEL,IDOMA,INEFMD) 172 : IF(IERR.NE.0)GOTO 9999 173 : C 174 : C**** Centre, FACE, FACEL, ELTFA 175 : C 175 : CALL LEKTAB(IDOMA,'CENTRE',MELEMC) 176 : IF(IERR .NE. 0) GOTO 9999 177 : C 177 : CALL LEKTAB(IDOMA,'FACE',MELEMF) 178 : IF(IERR .NE. 0) GOTO 9999 179 : C 179 : CALL LEKTAB(IDOMA,'FACEL',MELEFE) 180 : IF(IERR .NE. 0) GOTO 9999 181 : C 182 : C**** Lecture du CHPOINT contenant les surfaces des faces. 183 : C 183 : CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU) 184 : IF(IERR .NE. 0) GOTO 9999 185 : INDIC = 1 186 : NBCOMP = 1 187 : MOT = 'SCAL' 187 : CALL QUEPOI(ICHPSU, MELEMF, INDIC, NBCOMP, MOT) 188 : IF(IERR .NE. 0) GOTO 9999 189 : C 190 : C**** Lecture du CHPOINT contenant les diametres minimums. 191 : C 191 : CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI) 192 : IF(IERR .NE. 0) GOTO 9999 193 : INDIC = 1 194 : NBCOMP = 1 195 : MOT = 'SCAL' 195 : CALL QUEPOI(ICHPDI, MELEMC, INDIC, NBCOMP, MOT) 196 : IF(IERR .NE. 0) GOTO 9999 197 : 198 : C 199 : C**** Lecture du CHPOINT contenant les volumes 200 : C 200 : CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO) 201 : IF(IERR .NE. 0) GOTO 9999 202 : INDIC = 1 203 : NBCOMP = 1 204 : MOT = 'SCAL' 204 : CALL QUEPOI(ICHPVO, MELEMC, INDIC, NBCOMP, MOT) 205 : IF(IERR .NE. 0) GOTO 9999 206 : C 207 : C**** Les normales aux faces 208 : C 209 : C Que les normales 209 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 210 : IF(IERR .NE. 0) GOTO 9999 211 : JGN = 4 212 : JGM = IDIM 213 : SEGINI MLMVIT 214 : MLMVIT.MOTS(1) = 'UX ' 215 : MLMVIT.MOTS(2) = 'UY ' 216 : IF(IDIM.EQ.3) MLMVIT.MOTS(3) = 'UZ ' 216 : CALL QUEPO1(INORM, MELEMF, MLMVIT) 217 : SEGSUP MLMVIT 218 : IF(IERR .NE. 0) GOTO 9999 219 : C 220 : C******************************** 221 : C**** Fin table domaine ********* 222 : C******************************** 223 : C 224 : C**** La vitesse aux faces 225 : C 226 : TYPE = 'CHPOINT ' 226 : CALL LIROBJ(TYPE,IVN,1,IRET) 227 : IF(IERR .NE. 0) GOTO 9999 228 : C 229 : JGN = 4 230 : JGM = IDIM 231 : SEGINI MLMVIT 232 : MLMVIT.MOTS(1) = 'UX ' 233 : MLMVIT.MOTS(2) = 'UY ' 234 : IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ ' 234 : CALL QUEPO1(IVN, MELEMF, MLMVIT) 235 : IF(IERR .NE. 0) GOTO 9999 236 : SEGSUP MLMVIT 237 : C 238 : C**** On va lire le pointeur du MCHAML 239 : C 240 : TYPE='MCHAML ' 240 : CALL LIROBJ(TYPE,ISF,1,IRET) 241 : IF(IERR.NE.0) GOTO 9999 242 : C 243 : C**** On lit les composantes du MCHAML 244 : C 245 : MCHELM=ISF 246 : SEGACT MCHELM 247 : N1=MCHELM.IMACHE(/1) 248 : IF(N1 .NE. 1)THEN 249 : MOTERR(1:40)='MCHAM1 = ??? ' 250 : WRITE(IOIMP,*) MOTERR 251 : C 252 : C******** Message d'erreur standard 253 : C 251 2 254 : C Tentative d'utilisation d'une option non implémentée 255 : C 255 : CALL ERREUR(251) 256 : GOTO 9999 257 : ENDIF 258 : MCHAML=MCHELM.ICHAML(1) 259 : SEGDES MCHELM 260 : SEGACT MCHAML 261 : N2=MCHAML.IELVAL(/1) 262 : JGN = 4 263 : JGM = N2 264 : SEGINI MLMSF 265 : DO I1=1,N2,1 266 : MLMSF.MOTS(I1) = MCHAML.NOMCHE(I1) 267 : ENDDO 268 : C 269 : C 270 : C**** Calcul du flux/residu 271 : C 272 : IF((IRES .EQ. 1) .OR. (IRES .EQ. 2))THEN 273 : IJACO=0 274 : TYPE = 'CHPOINT ' 274 : CALL KRCHP1(TYPE, MELEMF, ICHFLU, MLMSF) 275 : IF(IERR.NE.0) GOTO 9999 276 : C 276 : CALL KONSF1(INDMET,ISF,IVN,INORM,ICHPSU,ICHPDI, 277 : & MELEMC,MELEMF,MELEFE,ICHFLU,DT,LOGAN, 278 : & MESERR) 279 : IF(IERR.NE.0)GOTO 9999 280 : IF(LOGAN)THEN 281 : C 282 : C******* Anomalie detectée 283 : C 284 : C 285 : C******* Message d'erreur standard 286 : C -301 0 287 : C %m1:40 288 : C 289 : MOTERR(1:40) = MESERR(1:40) 290 : WRITE(IOIMP,*) MOTERR(1:40) 291 : C 292 : C******* Message d'erreur standard 293 : C 5 3 294 : C Erreur anormale.contactez votre support 295 : C 295 : CALL ERREUR(5) 296 : GOTO 9999 297 : ENDIF 298 : C 299 : C**** Calcul de residu (IRES=2) 300 : C 301 : IF(IRES .EQ. 2)THEN 302 : TYPE = 'CHPOINT ' 302 : CALL KRCHP1(TYPE, MELEMC, ICHRES, MLMSF) 303 : IF(IERR.NE.0)GOTO 9999 304 : C 304 : CALL KONRE1(MELEMC,MELEMF,MELEFE,ICHPVO, 305 : & ICHFLU, ICHRES, 306 : & LOGAN,MESERR) 307 : IF(IERR.NE.0)GOTO 9999 308 : ICHFLU=0 309 : IF(LOGAN)THEN 310 : C 311 : C******* Anomalie detectée 312 : C 313 : C 314 : C******* Message d'erreur standard 315 : C -301 0 316 : C %m1:40 317 : C 318 : MOTERR(1:40) = MESERR(1:40) 319 : WRITE(IOIMP,*) MOTERR(1:40) 320 : C 321 : C******* Message d'erreur standard 322 : C 5 3 323 : C Erreur anormale.contactez votre support 324 : C 324 : CALL ERREUR(5) 325 : GOTO 9999 326 : ENDIF 327 : ELSE 328 : ICHRES = 0 329 : ENDIF 330 : ELSEIF(IRES.EQ.3)THEN 331 : C 332 : C**** Calcul du jacobien 333 : C 334 : ICHRES=0 335 : ICHFLU=0 335 : CALL KONJS1(INDMET,MLMSF,ISF,IVN,INORM,ICHPVO, 336 : & ICHPSU,MELEMC,MELEMF,MELEFE,IJACO) 337 : IF(IERR .NE. 0) GOTO 9999 338 : ELSE 338 : CALL ERREUR(251) 339 : GOTO 9999 340 : ENDIF 341 : C 342 : SEGSUP MLMSF 343 : C 344 : C**** Ecriture des resultats 345 : C 345 : IF(IJACO .EQ. 0)CALL ECRREE(DT) 346 : TYPE = 'CHPOINT ' 346 : IF(ICHRES .NE. 0) CALL ECROBJ(TYPE,ICHRES) 346 : IF(ICHFLU .NE. 0) CALL ECROBJ(TYPE,ICHFLU) 347 : TYPE='MATRIK ' 347 : IF(IJACO .NE. 0) CALL ECROBJ(TYPE,IJACO) 348 : 9999 CONTINUE 349 : RETURN 350 : END 351 : 352 : 353 : 354 : 355 : 356 : 357 : 358 : 359 : 360 : 361 : 362 : 363 : 364 :
© Cast3M 2003 - All rights reserved.
Disclaimer