1 : C CLIM22 SOURCE MAGN 09/07/30 21:16:21 6458 2 : SUBROUTINE CLIM22(IJAC) 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : CLIM22 8 : C 9 : C DESCRIPTION : Subroutine appellée par CLIM2 10 : C 11 : C Modelisation 2D/3D des equations d'Euler 12 : C Conditions aux limites 13 : C 14 : C Calcul du flux/residu/jacobian de flux 15 : C 16 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 17 : C 18 : C AUTEUR : S. Kudriakov, DEN/DM2S/SFME/LTMF 19 : C 20 : C************************************************************************ 21 : C 22 : C 23 : C SORTIES 24 : C 25 : C RCHPLI : on donne densité, vitesse, pression 26 : C et les fractions massiques sur le bord 27 : C (SPG = $TAB2 . 'CENTRE', composantes en LMOTP) 28 : C 29 : C RCHPRE : residu (SPG = $TAB1 . 'CENTRE', composantes en LMOTC) 30 : C 31 : C************************************************************************ 32 : C 33 : C HISTORIQUE (Anomalies et modifications éventuelles) 34 : C 35 : C HISTORIQUE : 3/12/03 - for the 'INRI' and 'OUTP' there was 36 : C implemented option for k-\eps model 37 : C (k and \eps are treated as a passive scalars) 38 : C 39 : C 20/12/04 - generalisation de 'OUTP' for the 40 : C CREBCOM model (k, \eps and K0 are treated 41 : C as a passive scalars) 42 : C 43 : C 03/02/06 - implementation of boundary conditions of 44 : C 'RESE'rvoir in the explicit case without 45 : C passive scalars. 46 : C************************************************************************ 47 : -INC CCOPTIO 48 : -INC SMLMOTS 49 : -INC SMELEME 50 : -INC SMLENTI 51 : -INC SMMATRIK 52 : POINTEUR MLMVIT.MLMOTS 53 : C 54 : C**** Variables de COOPTIO 55 : C 56 : INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 57 : & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 58 : & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 59 : & ,IECHO, IIMPI, IOSPI 60 : & ,IDIM, IFICLE, IPREFI 61 : & ,MCOORD 62 : & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 63 : & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 64 : & ,NORINC,NORVAL,NORIND,NORVAD 65 : & ,NUCROU, IPSAUV 66 : C 67 : INTEGER IJAC, IJACO, I, NESP,NSP 68 : & ,IDOMA, IDBOR, IRET, MELEMC, MELEFE, MELEMF, ICHPVO, INORM 69 : & ,ICHPSU, MELECB, NBCOMP, INDIC, MELEFC, MELRES 70 : & ,JGN, JGM, NBELEM, NBNN, NBSOUS, NBREF, NGF, NLC 71 : & ,I1, ICEN, N1, ILIINP 72 : & ,ILIINC, IROC, IVITC, IPC, ICHLIM, NBOPT, ILIM 73 : & ,ICHRES, ICHRLI, IYN, IKAN, IEPSN, IK0N 74 : & ,NKID,NKMT,NMATRI,NRIGE,MMODEL,INEFMD 75 : & ,JG, ICOND, IRETOU, ICP, ICV, IPGAS,IKEPS,ICREB 76 : PARAMETER (NBOPT=9) 77 : CHARACTER*8 LOPT(NBOPT) 78 : CHARACTER*4 MOT 79 : CHARACTER*(4) MOT1(3), CELLCH 80 : CHARACTER*8 TYPE 81 : REAL*8 CP, CV 82 : C---------------------------------------------------- 83 : C************ Variables en ACCTAB ****************** 84 : C---------------------------------------------------- 85 : INTEGER IVALI, IRETI, IVALR, IRETR 86 : REAL*8 XVALI,XVALR 87 : LOGICAL LOGII, LOGIR 88 : CHARACTER*(8) CHARR,MTYPI, MTYPR 89 : C----------------------------------------------------- 90 : DATA LOPT/'INRI ','OUTRI ','INJE ','OUTP ', 91 : & 'INSU ','INOU ','INSS ','OUTSS ', 92 : & 'RESE '/ 93 : C--------------------------------------------------- 94 : -INC SMLREEL 95 : POINTEUR MLRECP.MLREEL, MLRECV.MLREEL 96 : C----------------------------------------- 97 : C Initialisation des variables en ACCTAB 98 : C----------------------------------------- 99 : IVALI = 0 100 : IVALR = 0 101 : XVALI = 0.0D0 102 : XVALR = 0.0D0 103 : LOGII = .FALSE. 104 : LOGIR = .FALSE. 105 : IRETI = 0 106 : IRETR = 0 107 : CHARR = ' ' 108 : C------------------------------------------- 109 : C If IKEPS = 0 then there is now passive 110 : C scalars, otherwise IKEPS = 1 111 : C ...same about ICREB 112 : C------------------------------------------- 113 : IKEPS = 0 114 : ICREB = 0 115 : C******************************* 116 : C**** La table domaine ********* 117 : C******************************* 118 : C 118 : CALL LIROBJ('MMODEL',MMODEL,1,IRET) 119 : IF(IERR.NE.0)GOTO 9999 119 : CALL LEKMOD(MMODEL,IDOMA,INEFMD) 120 : C INEFMD inutilisé 121 : IF(IERR .NE. 0)GOTO 9999 122 : C----------------------------------------- 122 : CALL LEKTAB(IDOMA,'CENTRE',MELEMC) 123 : IF(IERR .NE. 0) GOTO 9999 124 : C----------------------------------------- 124 : CALL LEKTAB(IDOMA,'FACE',MELEMF) 125 : IF(IERR .NE. 0) GOTO 9999 126 : C--------------------------------------------- 127 : C**** Lecture du CHPOINT contenant les volumes 128 : C--------------------------------------------- 128 : CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO) 129 : IF(IERR .NE. 0) GOTO 9999 130 : INDIC = 1 131 : NBCOMP = 1 132 : MOT = 'SCAL' 132 : CALL QUEPOI(ICHPVO, MELEMC, INDIC, NBCOMP, MOT) 133 : IF(IERR .NE. 0) GOTO 9999 134 : C--------------------------------------------- 134 : CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU) 135 : IF(IERR .NE. 0) GOTO 9999 136 : INDIC = 1 137 : NBCOMP = 1 138 : MOT = 'SCAL' 138 : CALL QUEPOI(ICHPSU, MELEMF, INDIC, NBCOMP, MOT) 139 : IF(IERR .NE. 0) GOTO 9999 140 : C-------------------------------------------- 141 : C**** Les normales aux faces 142 : C-------------------------------------------- 143 : IF(IDIM .EQ. 2)THEN 144 : C Que les normales 144 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 145 : IF(IERR .NE. 0) GOTO 9999 146 : JGN = 4 147 : JGM = 2 148 : SEGINI MLMVIT 149 : MLMVIT.MOTS(1) = 'UX ' 150 : MLMVIT.MOTS(2) = 'UY ' 150 : CALL QUEPO1(INORM, MELEMF, MLMVIT) 151 : SEGDES MLMVIT 152 : IF(IERR .NE. 0) GOTO 9999 153 : ELSE 154 : C 155 : C**** Les normales ('MX ', ...) 156 : C Les tangentes ('RX ', ...) 157 : C 158 : TYPE = ' ' 158 : CALL ACMO(IDOMA,'MATROT',TYPE,INORM) 159 : IF (TYPE .NE. 'CHPOINT ') THEN 159 : CALL MATRAN(IDOMA,INORM) 160 : IF(IERR .NE. 0) GOTO 9999 161 : ENDIF 162 : JGN = 4 163 : JGM = 9 164 : SEGINI MLMVIT 165 : MLMVIT.MOTS(1) = 'MX ' 166 : MLMVIT.MOTS(2) = 'MY ' 167 : MLMVIT.MOTS(3) = 'MZ ' 168 : MLMVIT.MOTS(4) = 'RX ' 169 : MLMVIT.MOTS(5) = 'RY ' 170 : MLMVIT.MOTS(6) = 'RZ ' 171 : MLMVIT.MOTS(7) = 'UX ' 172 : MLMVIT.MOTS(8) = 'UY ' 173 : MLMVIT.MOTS(9) = 'UZ ' 173 : CALL QUEPO1(INORM, MELEMF, MLMVIT) 174 : SEGDES MLMVIT 175 : ENDIF 176 : c-------------------------------------------------------- 177 : C********************************** 178 : C**** La table domaine du bord **** 179 : C********************************** 180 : C 180 : CALL LIROBJ('MMODEL',MMODEL,1,IRET) 181 : IF(IERR.NE.0)GOTO 9999 181 : CALL LEKMOD(MMODEL,IDBOR,INEFMD) 182 : C INEFMD inutilisé 183 : IF(IERR .NE. 0)GOTO 9999 184 : C 184 : CALL LEKTAB(IDBOR,'CENTRE',MELECB) 185 : IF(IERR .NE. 0) GOTO 9999 186 : C 187 : TYPE = ' ' 187 : CALL ACMO(IDBOR,'FACCEN',TYPE,MELEFC) 188 : IF (TYPE.NE.'MAILLAGE') THEN 189 : C 189 : CALL LEKTAB(IDOMA,'FACEL',MELEFE) 190 : IF(IERR .NE. 0) GOTO 9999 191 : C 192 : C******* On cree la connectivité face-centre 193 : C 194 : IPT1=MELECB 195 : IPT2=MELEFE 196 : SEGACT IPT1 197 : SEGACT IPT2 197 : CALL KRIPAD(IPT1,MLENTI) 198 : C SEGINI MLENTI 199 : NBELEM=IPT1.NUM(/2) 200 : NBNN=2 201 : NBSOUS=0 202 : NBREF=0 203 : SEGINI IPT3 204 : IPT3.ITYPEL=2 205 : N1=IPT2.NUM(/2) 206 : ICEN=0 207 : DO I1=1,N1,1 208 : NGF=IPT2.NUM(2,I1) 209 : NLC=MLENTI.LECT(NGF) 210 : IF(NLC.NE.0)THEN 211 : ICEN=ICEN+1 212 : IPT3.NUM(1,ICEN)=NGF 213 : IPT3.NUM(2,ICEN)=IPT2.NUM(1,I1) 214 : IF(IPT2.NUM(1,I1) .NE. IPT2.NUM(3,I1))THEN 215 : C Interior point 216 : C Donné incompatible 217 : WRITE(IOIMP,*) 'Internal boundary condition!!!' 217 : CALL ERREUR(21) 218 : ENDIF 219 : ENDIF 220 : ENDDO 221 : C 222 : IF(ICEN .NE. NBELEM)THEN 222 : CALL ERREUR(5) 223 : ENDIF 224 : SEGDES IPT1 225 : SEGDES IPT2 226 : SEGDES IPT3 227 : SEGDES MLENTI 228 : C 229 : MELEFC=IPT3 229 : CALL ECMO(IDBOR,'FACCEN','MAILLAGE',IPT3) 230 : ENDIF 231 : C------------------------------------------------- 232 : C**** Le SPG du residu 233 : C------------------------------------------------- 234 : IPT1=MELEFC 235 : SEGACT IPT1 236 : NBELEM=IPT1.NUM(/2) 237 : NBNN=1 238 : NBSOUS=0 239 : NBREF=0 240 : SEGINI IPT2 241 : IPT2.ITYPEL=1 242 : DO I1=1,NBELEM,1 243 : IPT2.NUM(1,I1)=IPT1.NUM(2,I1) 244 : ENDDO 245 : MELRES=IPT2 246 : SEGDES IPT1 247 : SEGDES IPT2 248 : C------------------------------------------------- 249 : C*** Reading the table PGAS ********************* 250 : C------------------------------------------------- 251 : ICOND = 1 251 : CALL QUETYP(MTYPR,ICOND,IRETOU) 252 : IF(IERR .NE. 0)GOTO 9999 253 : IF(MTYPR .NE. 'TABLE ')THEN 254 : C--------------------------------------- 255 : C Message d'erreur standard 256 : C 37 2 257 : C On ne trouve pas d'objet de type %m1:8 258 : C--------------------------------------- 259 : MOTERR(1:8) = 'TABLE ' 259 : CALL ERREUR(37) 260 : GOTO 9999 261 : ELSE 262 : ICOND = 1 262 : CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU) 263 : IF(IERR .NE. 0)GOTO 9999 264 : ENDIF 265 : C------------------------------------------- 266 : C******** Reading the CPs ***************** 267 : C------------------------------------------- 268 : MTYPR = ' ' 268 : CALL ACMO(IPGAS,'CP',MTYPR,ICP) 269 : IF(MTYPR .NE. 'TABLE ')THEN 270 : C-------------------------------- 271 : C Message d'erreur standard 272 : C -301 0 %m1:40 273 : C-------------------------------- 274 : MOTERR(1:40) = 'TAB1 . CP = ??? ' 275 : WRITE(IOIMP,*) MOTERR(1:40) 276 : C--------------------------------- 277 : C Message d'erreur standard 278 : C 21 2 279 : C Données incompatibles 280 : C-------------------------------- 280 : CALL ERREUR(21) 281 : GOTO 9999 282 : ENDIF 283 : C------------------------------------------- 284 : C******** Reading the CVs ***************** 285 : C------------------------------------------- 286 : MTYPR = ' ' 286 : CALL ACMO(IPGAS,'CV',MTYPR,ICV) 287 : IF(MTYPR .NE. 'TABLE ')THEN 288 : C-------------------------------- 289 : C Message d'erreur standard 290 : C -301 0 %m1:40 291 : C-------------------------------- 292 : MOTERR(1:40) = 'TAB1 . CV = ??? ' 293 : WRITE(IOIMP,*) MOTERR(1:40) 294 : C--------------------------------- 295 : C Message d'erreur standard 296 : C 21 2 297 : C Données incompatibles 298 : C-------------------------------- 298 : CALL ERREUR(21) 299 : GOTO 9999 300 : ENDIF 301 : C--------------------------------------------------------- 302 : C Reading Les especes qui sont dans les Equations d'Euler 303 : C--------------------------------------------------------- 304 : MTYPR = ' ' 304 : CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMOT1) 305 : IF(MTYPR .NE. 'LISTMOTS')THEN 306 : C--------------------------- 307 : C Message d'erreur standard 308 : C -301 0 %m1:40 309 : C--------------------------- 310 : MOTERR(1:40) = 'TAB1 . ESPEULE = ??? ' 311 : WRITE(IOIMP,*) MOTERR(1:40) 312 : C--------------------------- 313 : C Message d'erreur standard 314 : C 21 2 315 : C Données incompatibles 316 : C-------------------------- 316 : CALL ERREUR(21) 317 : GOTO 9999 318 : ENDIF 319 : C----------------------------------------------------------------- 320 : C Reading Nom de l'espece qui n'est pas dans les equations d'Euler 321 : C----------------------------------------------------------------- 322 : MTYPI = 'MOT ' 323 : MTYPR = ' ' 323 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE', LOGII,IRETI, 324 : & MTYPR,IVALR,XVALR ,CELLCH,LOGIR,IRETR) 325 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'MOT ')) THEN 326 : C------------------------------- 327 : C Message d'erreur standard 328 : C -301 0 %m1:40 329 : C------------------------------- 330 : MOTERR = 'TAB1 . ESPNEULE = ??? ' 331 : WRITE(IOIMP,*) MOTERR(1:40) 332 : C------------------------------ 333 : C Message d'erreur standard 334 : C 21 2 335 : C Données incompatibles 336 : C------------------------------ 336 : CALL ERREUR(21) 337 : GOTO 9999 338 : ENDIF 339 : C------------------------------ 340 : SEGACT MLMOT1 341 : NESP = MLMOT1.MOTS(/2) 342 : NSP=NESP+1 343 : C---------------------- 344 : C** List de CP et CV ** 345 : C---------------------- 346 : JG = NESP+1 347 : SEGINI MLRECP 348 : SEGINI MLRECV 349 : DO I1 = 1, NESP 350 : C------------------------------- 351 : C N.B. MOT1 est un CHARACTER*(4) 352 : C------------------------------- 353 : MOT1(1) = MLMOT1.MOTS(I1) 354 : MTYPI = 'MOT ' 355 : MTYPR = ' ' 355 : CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI, 356 : & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR) 357 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN 358 : C------------------------------ 359 : C Message d'erreur standard 360 : C -301 0 %m1:40 361 : C------------------------------ 362 : MOTERR = 'TAB1 . CP , TAB1 . ESPEULE = ??? ' 363 : WRITE(IOIMP,*) MOTERR(1:40) 364 : C------------------------------ 365 : C Message d'erreur standard 366 : C 21 2 367 : C Données incompatibles 368 : C------------------------------ 368 : CALL ERREUR(21) 369 : GOTO 9999 370 : ENDIF 371 : MLRECP.PROG(I1) = CP 372 : C------------------------------------------- 372 : CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI, 373 : & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR) 374 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN 375 : C--------------------------- 376 : C Message d'erreur standard 377 : C -301 0 %m1:40 378 : C--------------------------- 379 : MOTERR = 'TAB1 . CV , TAB1 . ESPEULE = ??? ' 380 : WRITE(IOIMP,*) MOTERR(1:40) 381 : C--------------------------- 382 : C Message d'erreur standard 383 : C 21 2 384 : C Données incompatibles 385 : C--------------------------- 385 : CALL ERREUR(21) 386 : GOTO 9999 387 : ENDIF 388 : MLRECV.PROG(I1) = CV 389 : ENDDO 390 : MTYPI = 'MOT ' 391 : MTYPR = ' ' 391 : CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI, 392 : & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR) 393 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN 394 : C--------------------------- 395 : C Message d'erreur standard 396 : C -301 0 %m1:40 397 : C--------------------------- 398 : MOTERR = 'TAB1 . CP , TAB1 . ESPNEULE = ??? ' 399 : WRITE(IOIMP,*) MOTERR(1:40) 400 : C--------------------------- 401 : C Message d'erreur standard 402 : C 21 2 403 : C Données incompatibles 404 : C--------------------------- 404 : CALL ERREUR(21) 405 : GOTO 9999 406 : ENDIF 407 : MLRECP.PROG(JG) = CP 408 : C 409 : MTYPI = 'MOT ' 410 : MTYPR = ' ' 410 : CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI, 411 : & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR) 412 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN 413 : C---------------------------- 414 : C Message d'erreur standard 415 : C -301 0 %m1:40 416 : C---------------------------- 417 : MOTERR = 'TAB1 . CV , TAB1 . ESPNEULE = ??? ' 418 : WRITE(IOIMP,*) MOTERR(1:40) 419 : C---------------------------- 420 : C Message d'erreur standard 421 : C 21 2 422 : C Données incompatibles 423 : C---------------------------- 423 : CALL ERREUR(21) 424 : GOTO 9999 425 : ENDIF 426 : MLRECV.PROG(JG) = CV 427 : C------------------------------------------------- 428 : C**** Noms de variables conservatives 429 : C------------------------------------------------- 430 : TYPE='LISTMOTS' 430 : CALL LIROBJ(TYPE,ILIINC,1,IRET) 431 : IF(IERR .NE. 0) GOTO 9999 432 : MLMOTS = ILIINC 433 : SEGACT MLMOTS 434 : NBCOMP = MLMOTS.MOTS(/2) 435 : SEGDES MLMOTS 436 : *--------------------------------------------- 437 : IF(NBCOMP .EQ. (IDIM+4+NESP)) IKEPS = 1 438 : IF(NBCOMP .EQ. (IDIM+5+NESP)) ICREB = 1 439 : *--------------------------------------------- 440 : IF((IKEPS .EQ. 0) .AND. (ICREB .EQ. 0)) THEN 441 : IF(NBCOMP .NE. (IDIM+2+NESP))THEN 442 : MOTERR(1:40) = 'LISTINCO = ???' 443 : WRITE(IOIMP,*) MOTERR 444 : C----------------------------- 445 : C** Message d'erreur standard 446 : C 21 2 447 : C Données incompatibles 448 : C----------------------------- 448 : CALL ERREUR(21) 449 : GOTO 9999 450 : ENDIF 451 : ENDIF 452 : C-------------------------------------------------------- 453 : C**** Noms de variables primitives 454 : C-------------------------------------------------------- 455 : TYPE='LISTMOTS' 455 : CALL LIROBJ(TYPE,ILIINP,1,IRET) 456 : IF(IERR .NE. 0) GOTO 9999 457 : MLMOTS = ILIINP 458 : SEGACT MLMOTS 459 : NBCOMP = MLMOTS.MOTS(/2) 460 : SEGDES MLMOTS 461 : IF((IKEPS .EQ. 0) .AND. (ICREB .EQ. 0)) THEN 462 : IF(NBCOMP .NE. (IDIM+2+NESP))THEN 463 : MOTERR(1:40) = 'LISTPRIM = ???' 464 : WRITE(IOIMP,*) MOTERR 465 : C----------------------------- 466 : C** Message d'erreur standard 467 : C 21 2 468 : C Données incompatibles 469 : C----------------------------- 469 : CALL ERREUR(21) 470 : GOTO 9999 471 : ENDIF 472 : ENDIF 473 : C-------------------------------------------------------- 474 : C**** Lecture du CHPOINT RN 475 : C-------------------------------------------------------- 476 : TYPE='CHPOINT ' 476 : CALL LIROBJ(TYPE,IROC,1,IRET) 477 : IF (IERR.NE.0) GOTO 9999 478 : C----------------------------- 479 : C** Control du CHPOINT: QUEPOI 480 : C 481 : C INDIC = 1 -> on impose le pointeur du support geometrique 482 : C NBCOMP > 0 -> nombre des composantes 483 : C----------------------------- 484 : INDIC = 1 485 : NBCOMP = 1 486 : MOT = 'SCAL' 486 : CALL QUEPOI(IROC, MELEMC, INDIC, NBCOMP, MOT) 487 : IF(IERR .NE. 0)GOTO 9999 488 : C------------------------------------------------------ 489 : C**** Lecture du CHPOINT VITC 490 : C------------------------------------------------------ 490 : CALL LIROBJ('CHPOINT',IVITC,1,IRET) 491 : IF (IERR.NE.0) GOTO 9999 492 : C----------------------- 493 : C**** Control du CHPOINT 494 : C----------------------- 495 : JGN = 4 496 : JGM = IDIM 497 : SEGINI MLMVIT 498 : MLMVIT.MOTS(1) = 'UX ' 499 : MLMVIT.MOTS(2) = 'UY ' 500 : IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ ' 500 : CALL QUEPO1(IVITC, MELEMC, MLMVIT) 501 : SEGDES MLMVIT 502 : IF(IERR .NE. 0)GOTO 9999 503 : C------------------------------------------------------- 504 : C**** Lecture du CHPOINT PC 505 : C------------------------------------------------------- 505 : CALL LIROBJ('CHPOINT',IPC,1,IRET) 506 : IF (IERR.NE.0) GOTO 9999 507 : C----------------------- 508 : C**** Control du CHPOINT 509 : C----------------------- 510 : INDIC = 1 511 : NBCOMP = 1 512 : MOT = 'SCAL' 512 : CALL QUEPOI(IPC, MELEMC, INDIC, NBCOMP, MOT) 513 : IF(IERR .NE. 0)GOTO 9999 514 : C----------------------------- 515 : C*** Fraction massiques 516 : C*** des especes "splittees" 517 : C----------------------------- 518 : TYPE = 'CHPOINT ' 518 : CALL LIROBJ(TYPE,IYN,1,IRET) 519 : IF(IERR .NE. 0) GOTO 9999 519 : CALL QUEPO1(IYN, MELEMC, MLMOT1) 520 : IF(IERR .NE. 0) THEN 521 : MOTERR = 'CHPO FR.MAS. = ?????' 522 : WRITE(IOIMP,*) MOTERR(1:40) 522 : CALL ERREUR(21) 523 : GOTO 9999 524 : ENDIF 525 : C----------------------------------- 526 : c Turbulent kinetic energy 527 : c----------------------------------- 528 : IF((IKEPS .GT. 0) .OR. (ICREB .GT. 0)) THEN 529 : TYPE = 'CHPOINT ' 529 : CALL LIROBJ(TYPE,IKAN,1,IRET) 530 : INDIC = 1 531 : NBCOMP = 1 532 : MOT = 'SCAL' 532 : CALL QUEPOI(IKAN, MELEMC, INDIC, NBCOMP, MOT) 533 : IF(IERR .NE. 0)GOTO 9999 534 : C-------------------------------------- 535 : c Rate of Turbulent energy dissipation 536 : c-------------------------------------- 537 : TYPE = 'CHPOINT ' 537 : CALL LIROBJ(TYPE,IEPSN,1,IRET) 538 : INDIC = 1 539 : NBCOMP = 1 540 : MOT = 'SCAL' 540 : CALL QUEPOI(IEPSN, MELEMC, INDIC, NBCOMP, MOT) 541 : IF(IERR .NE. 0)GOTO 9999 542 : ENDIF 543 : C-------------------------------------- 544 : c K0 K0 K0 K0 545 : c-------------------------------------- 546 : IF(ICREB .GT. 0) THEN 547 : TYPE = 'CHPOINT ' 547 : CALL LIROBJ(TYPE,IK0N,1,IRET) 548 : INDIC = 1 549 : NBCOMP = 1 550 : MOT = 'SCAL' 550 : CALL QUEPOI(IK0N, MELEMC, INDIC, NBCOMP, MOT) 551 : IF(IERR .NE. 0)GOTO 9999 552 : ELSE 553 : IK0N = 0 554 : ENDIF 555 : C------------------------------------------------------ 556 : C**** CHPOINT condition limite 557 : C------------------------------------------------------ 557 : CALL LIROBJ('CHPOINT',ICHLIM,1,IRET) 558 : IF (IERR.NE.0) GOTO 9999 559 : C----------------------------------------------------- 560 : C**** Resultats 561 : C----------------------------------------------------- 562 : IF(IJAC .EQ.0)THEN 563 : TYPE=' ' 563 : CALL KRCHP1(TYPE,MELRES,ICHRES,ILIINC) 564 : C 565 : TYPE=' ' 565 : CALL KRCHP1(TYPE,MELECB,ICHRLI,ILIINP) 566 : ELSE 567 : ICHRES=0 568 : ICHRLI=0 569 : ENDIF 570 : C--------------------------------------------------------- 571 : C**** TYPE DE CONDITION LIMITE 572 : C--------------------------------------------------------- 572 : CALL LIRMOT(LOPT,NBOPT,ILIM,1) 573 : IF(IERR .NE. 0) GOTO 9999 574 : IF(ILIM .EQ. 1)THEN 575 : C------------------------------------------------- 576 : C******** 'INRI ' ???????????????????????????? 577 : C------------------------------------------------- 578 : JGN = 4 579 : JGM = IDIM+2+NESP 580 : IF(IKEPS .GT. 0) JGM = IDIM+4+NESP 581 : SEGINI MLMVIT 582 : MLMOTS = ILIINP 583 : SEGACT MLMOTS 584 : NBCOMP = MLMOTS.MOTS(/2) 585 : DO 7 I=1,NBCOMP 586 : MLMVIT.MOTS(I)=MLMOTS.MOTS(I) 587 : 7 CONTINUE 588 : SEGDES MLMOTS 588 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 589 : SEGDES MLMVIT 590 : IF (IERR.NE.0) GOTO 9999 591 : C-------------------------------------------------------- 592 : IF(IJAC.EQ.0)THEN 593 : IF(IKEPS .GT. 0) THEN 593 : CALL CL221T(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO 594 : $ ,ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN,IKAN,IEPSN 595 : $ ,ICHLIM,ICHRES,ICHRLI) 596 : ELSE 596 : CALL CLI221(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO 597 : $ ,ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN,ICHLIM 598 : $ ,ICHRES,ICHRLI) 599 : ENDIF 600 : ELSE 601 : IF(IDIM.EQ.2)THEN 601 : CALL CLI223(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM, 602 : & ICHPVO,ICHPSU,MLRECP,MLRECV, 603 : & IROC,IVITC,IPC,IYN,ICHLIM,ILIINC,ILIINP,IJAC,IJACO) 604 : ENDIF 605 : IF(IERR.NE.0)GOTO 9999 606 : ENDIF 607 : ELSEIF(ILIM .EQ. 2)THEN 608 : C------------------------------------------------- 609 : C******** 'OUTRI ' 610 : C------------------------------------------------- 611 : JGN = 4 612 : JGM = IDIM+2+NESP 613 : SEGINI MLMVIT 614 : MLMOTS = ILIINP 615 : SEGACT MLMOTS 616 : NBCOMP = MLMOTS.MOTS(/2) 617 : DO 77 I=1,NBCOMP 618 : MLMVIT.MOTS(I)=MLMOTS.MOTS(I) 619 : 77 CONTINUE 620 : SEGDES MLMOTS 620 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 621 : SEGDES MLMVIT 622 : IF (IERR.NE.0) GOTO 9999 623 : C-------------------------------------------------------- 624 : IF(IJAC.EQ.0)THEN 624 : CALL CLI222(NSP,MELEMF,MELEMC,MELECB, 625 : & MELEFC,INORM,ICHPVO,ICHPSU, 626 : & MLRECP,MLRECV,IROC,IVITC,IPC,IYN,ICHLIM,ICHRES,ICHRLI) 627 : IF(IERR.NE.0)GOTO 9999 628 : ENDIF 629 : C-------------------------------------------------------- 630 : ELSEIF(ILIM .EQ. 3)THEN 631 : C------------------------ 632 : C******** 'INJE ' 633 : C------------------------ 634 : JGN = 4 635 : JGM = 2+NESP 636 : SEGINI MLMVIT 637 : MLMVIT.MOTS(1) = 'MOME' 638 : MLMVIT.MOTS(2) = 'RT ' 639 : MLMOTS = ILIINP 640 : SEGACT MLMOTS 641 : DO 78 I=1,NESP 642 : MLMVIT.MOTS(2+I)=MLMOTS.MOTS(IDIM+2+I) 643 : 78 CONTINUE 643 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 644 : SEGDES MLMVIT 645 : IF (IERR.NE.0) GOTO 9999 646 : C----------------------------------------------------- 647 : C----------------------------------------------------- 648 : IF(IJAC.EQ.0)THEN 648 : CALL CLI271(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO, 649 : & ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,ICHLIM,ICHRES 650 : $ ,ICHRLI) 651 : IF(IERR.NE.0)GOTO 9999 652 : ELSE 653 : IF(IDIM.EQ.2)THEN 653 : CALL CLI272(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM, 654 : & ICHPVO,ICHPSU,MLRECP,MLRECV, 655 : & IROC,IVITC,IPC,IYN,ICHLIM,ILIINC,ILIINP,IJAC,IJACO) 656 : c ELSE 656 : c CALL CLI173(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 657 : c $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 658 : c $ ,ILIINP,IJAC,IJACO) 659 : ENDIF 660 : ENDIF 661 : C-------------------------- 662 : C**** 'OUTP ' ********* 663 : C-------------------------- 664 : ELSEIF(ILIM .EQ. 4)THEN 665 : JGN = 4 666 : JGM = 1 667 : SEGINI MLMVIT 668 : MLMVIT.MOTS(1)='PN ' 668 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 669 : SEGDES MLMVIT 670 : IF (IERR.NE.0) GOTO 9999 671 : C 672 : IF(IJAC.EQ.0)THEN 673 : IF((IKEPS .GT. 0) .OR. (ICREB .GT. 0)) THEN 673 : CALL CL251T(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO, 674 : & ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN, 675 : & IKAN,IEPSN,IK0N,ICHLIM,ICHRES,ICHRLI) 676 : ELSE 676 : CALL CLI251(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO, 677 : & ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN,ICHLIM 678 : $ ,ICHRES,ICHRLI) 679 : ENDIF 680 : IF(IERR.NE.0)GOTO 9999 681 : ELSE 682 : IF(IDIM.EQ.2)THEN 682 : CALL CLI252(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM, 683 : & ICHPVO,ICHPSU,MLRECP,MLRECV, 684 : & IROC,IVITC,IPC,IYN,ICHLIM,ILIINC,ILIINP,IJAC,IJACO) 685 : ENDIF 686 : ENDIF 687 : ELSEIF(ILIM .EQ. 5)THEN 688 : C----------------------------- 689 : C******** 'INSU ' 690 : C----------------------------- 691 : JGN = 4 692 : JGM = 2+NESP 693 : SEGINI MLMVIT 694 : MLMVIT.MOTS(1) = 'HT ' 695 : MLMVIT.MOTS(2) = 'S ' 696 : MLMOTS = ILIINP 697 : SEGACT MLMOTS 698 : DO 79 I=1,NESP 699 : MLMVIT.MOTS(2+I)=MLMOTS.MOTS(IDIM+2+I) 700 : 79 CONTINUE 700 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 701 : SEGDES MLMVIT 702 : IF (IERR.NE.0) GOTO 9999 703 : C 704 : IF(IJAC.EQ.0)THEN 704 : CALL CLI261(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO, 705 : & ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN,ICHLIM,ICHRES 706 : $ ,ICHRLI) 707 : IF(IERR.NE.0)GOTO 9999 708 : ELSE 709 : IF(IDIM.EQ.2)THEN 709 : CALL CLI262(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM, 710 : & ICHPVO,ICHPSU,MLRECP,MLRECV, 711 : & IROC,IVITC,IPC,IYN,ICHLIM,ILIINC,ILIINP,IJAC,IJACO) 712 : ENDIF 713 : ENDIF 714 : ELSEIF(ILIM .EQ. 6)THEN 715 : C------------------------------------------------- 716 : C******** 'INOU ' 717 : C------------------------------------------------- 718 : JGN = 4 719 : JGM = NESP+3 720 : SEGINI MLMVIT 721 : MLMVIT.MOTS(1) = 'HT ' 722 : MLMVIT.MOTS(2) = 'S ' 723 : MLMOTS = ILIINP 724 : SEGACT MLMOTS 725 : DO 770 I=1,NESP 726 : MLMVIT.MOTS(I+2)=MLMOTS.MOTS(IDIM+2+I) 727 : 770 CONTINUE 728 : MLMVIT.MOTS(3+NESP)= 'PN ' 729 : SEGDES MLMOTS 729 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 730 : SEGDES MLMVIT 731 : IF (IERR.NE.0) GOTO 9999 732 : C-------------------------------------------------------- 733 : IF(IJAC.EQ.0)THEN 733 : CALL CLI281(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO 734 : $ ,ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN,ICHLIM,ICHRES 735 : $ ,ICHRLI) 736 : IF(IERR.NE.0)GOTO 9999 737 : ELSE 738 : IF(IDIM.EQ.2)THEN 738 : CALL CLI282(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM, 739 : & ICHPVO,ICHPSU,MLRECP,MLRECV, 740 : & IROC,IVITC,IPC,IYN,ICHLIM,ILIINC,ILIINP,IJAC,IJACO) 741 : ENDIF 742 : ENDIF 743 : C-------------------------------------------------------- 744 : ELSEIF(ILIM .EQ. 7)THEN 745 : C-------------------------------------- 746 : C****** 'INSS' ********************** 747 : C-------------------------------------- 748 : JGN = 4 749 : JGM = IDIM+2+NESP 750 : IF(IKEPS .GT. 0) JGM = IDIM+4+NESP 751 : SEGINI MLMVIT 752 : MLMOTS = ILIINP 753 : SEGACT MLMOTS 754 : NBCOMP = MLMOTS.MOTS(/2) 755 : DO 775 I=1,NBCOMP 756 : MLMVIT.MOTS(I)=MLMOTS.MOTS(I) 757 : 775 CONTINUE 758 : SEGDES MLMOTS 758 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 759 : SEGDES MLMVIT 760 : IF (IERR.NE.0) GOTO 9999 761 : C-------------------------------------------------------- 762 : IF(IJAC.EQ.0)THEN 763 : IF(IKEPS .GT. 0) THEN 763 : CALL CL281T(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO 764 : $ ,ICHPSU,MLRECP,MLRECV,ICHLIM,ICHRES,ICHRLI) 765 : ENDIF 766 : ENDIF 767 : C-------------------------- 768 : C**** 'OUTSS ' ********* 769 : C-------------------------- 770 : ELSEIF(ILIM .EQ. 8)THEN 771 : IF(IJAC.EQ.0)THEN 772 : IF(IKEPS .GT. 0) THEN 772 : CALL CL291T(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO, 773 : & ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN, 774 : & IKAN,IEPSN,ICHLIM,ICHRES,ICHRLI) 775 : ENDIF 776 : ENDIF 777 : ELSEIF(ILIM .EQ. 9)THEN 778 : C------------------------------------------------- 779 : C******** 'RESE ' **************************** 780 : C------------------------------------------------- 781 : IF((IJAC .NE. 0) .OR. (IKEPS .NE. 0) .OR. (ICREB .GT. 0)) THEN 782 : WRITE(IOIMP,*) 'RESI implemented in explicit case only!' 783 : WRITE(IOIMP,*) 'No passive scalars!' 783 : CALL ERREUR(21) 784 : C Données incompatibles 785 : GOTO 9999 786 : ENDIF 787 : C 788 : C 789 : JGN = 4 790 : JGM = 2+NESP 791 : SEGINI MLMVIT 792 : MLMOTS = ILIINP 793 : SEGACT MLMOTS 794 : MLMVIT.MOTS(1)='RN ' 795 : MLMVIT.MOTS(2)='PN ' 796 : C 797 : DO 8 I=1,NESP 798 : MLMVIT.MOTS(2+I)=MLMOTS.MOTS(2+I+IDIM) 799 : 8 CONTINUE 800 : SEGDES MLMOTS 801 : C 801 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 802 : SEGSUP MLMVIT 803 : IF (IERR.NE.0) GOTO 9999 804 : C 804 : CALL CLI22R(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU 805 : $ ,MLRECP,MLRECV,IPC,ICHLIM,ICHRES,ICHRLI) 806 : IF(IERR.NE.0)GOTO 9999 807 : C-------------------------------------------------------- 808 : ENDIF 809 : C-------------------------------------------------------- 810 : IF(IJAC .EQ. 0) THEN 811 : TYPE = 'CHPOINT ' 811 : CALL ECROBJ(TYPE,ICHRES) 811 : CALL ECROBJ(TYPE,ICHRLI) 812 : ELSE 812 : CALL ECROBJ('MATRIK ',IJACO) 813 : ENDIF 814 : 9999 CONTINUE 815 : RETURN 816 : END 817 : 818 : 819 : 820 :
© Cast3M 2003 - All rights reserved.
Disclaimer