1 : C PRE31 SOURCE FANDEUR 13/01/29 21:16:15 7683 2 : SUBROUTINE PRE31() 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : PRE31 8 : C 9 : C DESCRIPTION : Voir PRE3 10 : C 11 : C Cas gaz "thermally perfect" mono/multi-especes 12 : C 13 : C 1er ordre en espace, 1er ordre en temps 14 : C 15 : C Creations des object MCHAML IROF, IVITF, IPF, IYF 16 : C 17 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 18 : C 19 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF 20 : C 21 : C************************************************************************ 22 : C 23 : C 24 : C APPELES (Outils) : LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ, 25 : C QUEPO1, ECROBJ 26 : C 27 : C APPELES (Calcul) : PRE311 (2D), PRE312 (3D) 28 : C 29 : C 30 : C************************************************************************ 31 : C 32 : C HISTORIQUE (Anomalies et modifications éventuelles) 33 : C 34 : C HISTORIQUE : Créée le 18.12.98. 35 : C 36 : C 06.02.00 transport des scalaires passifs 37 : C 38 : C************************************************************************ 39 : C 40 : C 41 : C**** Variables de COOPTIO 42 : C 43 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 44 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 45 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 46 : C & ,IECHO, IIMPI, IOSPI 47 : C & ,IDIM 48 : C & ,MCOORD 49 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 50 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 51 : C & ,NORINC,NORVAL,NORIND,NORVAD 52 : C & ,NUCROU, IPSAUV, IFICLE, IPREFI 53 : C 54 : C**** Les variables 55 : C 56 : IMPLICIT INTEGER(I-N) 57 : INTEGER ICOND, IRETOU, IERR0 58 : & ,IDOMA, ICEN, IFACE, IFACEL, INORM, IROC, IVITC, IPC 59 : & ,IYC, ISCAC, IROF, IVITF, IPF, IYF, IPGAS, NESP, ISCAF 60 : & ,NSCA, INEFMD 61 : & ,MMODEL 62 : REAL*8 VALER, VAL1, VAL2 63 : CHARACTER*(8) MTYPR, TYPE 64 : CHARACTER*(40) MESERR 65 : LOGICAL LOGAN,LOGNEG, LOGBOR 66 : C 67 : C**** Les Includes 68 : C 69 : -INC CCOPTIO 70 : INTEGER JGM, JGN 71 : -INC SMLMOTS 72 : POINTEUR MLMCOM.MLMOTS, MLMESP.MLMOTS, MLMSCA.MLMOTS 73 : POINTEUR MLMVIT.MLMOTS 74 : C 75 : C**** Initialisation des parametres d'erreur 76 : C 77 : LOGAN = .FALSE. 78 : LOGNEG = .FALSE. 79 : LOGBOR = .FALSE. 80 : MESERR = ' ' 81 : MOTERR(1:40) = MESERR(1:40) 82 : VALER = 0.0D0 83 : VAL1 = 0.0D0 84 : VAL2 = 0.0D0 85 : C 86 : C**** Lecture de l'objet MODELE 87 : C 88 : ICOND = 1 88 : CALL QUETYP(TYPE,ICOND,IRETOU) 89 : 90 : IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN 91 : WRITE(6,*)' On attend un objet MMODEL' 92 : RETURN 93 : ENDIF 93 : CALL LIROBJ('MMODEL',MMODEL,ICOND,IRETOU) 94 : IF(IERR.NE.0)GOTO 9999 94 : CALL LEKMOD(MMODEL,IDOMA,INEFMD) 95 : IF(IERR.NE.0)GOTO 9999 96 : C 97 : C**** Lecture du MELEME SPG des points CENTRE. 98 : C 99 : C 99 : C CALL LEKTAB(IDOMA,'CENTRE',IP) 100 : C 101 : C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas, 102 : C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL' 103 : C -> la correspondance global des noeuds saut! 104 : C 105 : C On peut utilizer ACCTAB ou ACMO 106 : C 107 : MTYPR = 'MAILLAGE' 107 : CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN) 108 : IF(IERR.NE.0)GOTO 9999 109 : C 110 : C**** Lecture du MELEME 'FACE' 111 : C 112 : MTYPR = 'MAILLAGE' 112 : CALL ACMO(IDOMA,'FACE',MTYPR,IFACE) 113 : IF(IERR.NE.0)GOTO 9999 114 : C 115 : C**** Lecture du MELEME 'FACEL' 116 : C 117 : MTYPR = 'MAILLAGE' 117 : CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL) 118 : IF(IERR.NE.0)GOTO 9999 119 : C 120 : C**** Lecture du CHPOINT contenant les normales (tangentes) aux faces 121 : C 122 : IF(IDIM .EQ. 2)THEN 123 : C Que les normales 123 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 124 : IF(IERR .NE. 0) GOTO 9999 125 : JGN = 4 126 : JGM = 2 127 : SEGINI MLMVIT 128 : MLMVIT.MOTS(1) = 'UX ' 129 : MLMVIT.MOTS(2) = 'UY ' 129 : CALL QUEPO1(INORM, IFACE, MLMVIT) 130 : SEGSUP MLMVIT 131 : IF(IERR.NE.0)GOTO 9999 132 : ELSE 133 : MTYPR = ' ' 133 : CALL ACMO(IDOMA,'MATROT',MTYPR,INORM) 134 : IF (MTYPR .NE. 'CHPOINT ') THEN 134 : CALL MATRAN(IDOMA,INORM) 135 : IF(IERR .NE. 0) GOTO 9999 136 : ENDIF 137 : JGN = 4 138 : JGM = 9 139 : SEGINI MLMVIT 140 : MLMVIT.MOTS(1) = 'UX ' 141 : MLMVIT.MOTS(2) = 'UY ' 142 : MLMVIT.MOTS(3) = 'UZ ' 143 : MLMVIT.MOTS(4) = 'RX ' 144 : MLMVIT.MOTS(5) = 'RY ' 145 : MLMVIT.MOTS(6) = 'RZ ' 146 : MLMVIT.MOTS(7) = 'MX ' 147 : MLMVIT.MOTS(8) = 'MY ' 148 : MLMVIT.MOTS(9) = 'MZ ' 148 : CALL QUEPO1(INORM, IFACE, MLMVIT) 149 : SEGSUP MLMVIT 150 : IF(IERR.NE.0)GOTO 9999 151 : C 152 : ENDIF 153 : C 154 : C**** Lecture de la table des proprietes du gaz 155 : C 156 : ICOND = 1 156 : CALL QUETYP(MTYPR,ICOND,IRETOU) 157 : IF(IERR .NE. 0)GOTO 9999 158 : IF(MTYPR .NE. 'TABLE ')THEN 159 : C 160 : C******* Message d'erreur standard 161 : C 37 2 162 : C On ne trouve pas d'objet de type %m1:8 163 : C 164 : MOTERR(1:8) = 'TABLE ' 164 : CALL ERREUR(37) 165 : GOTO 9999 166 : ELSE 167 : ICOND = 1 167 : CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU) 168 : IF(IERR .NE. 0)GOTO 9999 169 : ENDIF 170 : C 171 : C**** Les especes qui sont dans les Equations d'Euler 172 : C 173 : MTYPR = ' ' 173 : CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMESP) 174 : IF(MTYPR .EQ. ' ')THEN 175 : NESP = 0 176 : IYC = 0 177 : ELSEIF(MTYPR .NE. 'LISTMOTS')THEN 178 : C 179 : C******* Message d'erreur standard 180 : C -301 0 %m1:40 181 : C 182 : MOTERR(1:40) = 'TAB2 . ESPEULE = ??? ' 183 : WRITE(IOIMP,*) MOTERR 184 : C 185 : C******* Message d'erreur standard 186 : C 21 2 187 : C Données incompatibles 188 : C 188 : CALL ERREUR(21) 189 : GOTO 9999 190 : ELSE 191 : SEGACT MLMESP 192 : NESP = MLMESP.MOTS(/2) 193 : SEGDES MLMESP 194 : ENDIF 195 : C 196 : C**** Les scalaires passifs 197 : C 198 : MTYPR = ' ' 198 : CALL ACMO(IPGAS,'SCALPASS',MTYPR,MLMSCA) 199 : IF(MTYPR .EQ. ' ')THEN 200 : NSCA = 0 201 : ISCAC = 0 202 : ELSEIF(MTYPR .NE. 'LISTMOTS')THEN 203 : C 204 : C******* Message d'erreur standard 205 : C -301 0 %m1:40 206 : C 207 : MOTERR(1:40) = 'TAB2 . SCALPASS = ??? ' 208 : WRITE(IOIMP,*) MOTERR 209 : C 210 : C******* Message d'erreur standard 211 : C 21 2 212 : C Données incompatibles 213 : C 213 : CALL ERREUR(21) 214 : GOTO 9999 215 : ELSE 216 : SEGACT MLMSCA 217 : NSCA = MLMSCA.MOTS(/2) 218 : SEGDES MLMSCA 219 : ENDIF 220 : C 221 : C**** Lecture du CHPOINT ROC 222 : C 223 : ICOND = 1 223 : CALL QUETYP(MTYPR,ICOND,IRETOU) 224 : IF(IERR .NE. 0)GOTO 9999 225 : IF(MTYPR .NE. 'CHPOINT ')THEN 226 : C 227 : C******* Message d'erreur standard 228 : C 37 2 229 : C On ne trouve pas d'objet de type %m1:8 230 : C 231 : MOTERR(1:8) = 'CHPOINT ' 231 : CALL ERREUR(37) 232 : GOTO 9999 233 : ELSE 234 : ICOND = 1 234 : CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU) 235 : IF (IERR.NE.0) GOTO 9999 236 : ENDIF 237 : C 238 : C**** Control du CHPOINT: QUEPO1 239 : C 240 : JGN=4 241 : JGM=1 242 : SEGINI MLMCOM 243 : MLMCOM.MOTS(1)='SCAL' 243 : CALL QUEPO1(IROC, ICEN, MLMCOM) 244 : SEGSUP MLMCOM 245 : IF(IERR .NE. 0)THEN 246 : IERR0 = IERR 247 : 248 : C 249 : C******* Message d'erreur standard 250 : C -301 0 %m1:40 251 : C 252 : MOTERR(1:40) = 'CHPO1 = ??? ' 253 : $ 254 : WRITE(IOIMP,*) MOTERR 255 : 256 : GOTO 9999 257 : ENDIF 258 : C 259 : C**** Lecture du CHPOINT VITC 260 : C 261 : ICOND = 1 261 : CALL QUETYP(MTYPR,ICOND,IRETOU) 262 : IF(IERR .NE. 0)GOTO 9999 263 : IF(MTYPR .NE. 'CHPOINT ')THEN 264 : C 265 : C******* Message d'erreur standard 266 : C 37 2 267 : C On ne trouve pas d'objet de type %m1:8 268 : C 269 : MOTERR(1:8) = 'CHPOINT ' 269 : CALL ERREUR(37) 270 : GOTO 9999 271 : ELSE 272 : ICOND = 1 272 : CALL LIROBJ('CHPOINT',IVITC,ICOND,IRETOU) 273 : IF (IERR.NE.0) GOTO 9999 274 : ENDIF 275 : C 276 : C**** Control du CHPOINT 277 : C 278 : JGN=4 279 : JGM=IDIM 280 : SEGINI MLMCOM 281 : MLMCOM.MOTS(1) = 'UX ' 282 : MLMCOM.MOTS(2) = 'UY ' 283 : IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'UZ ' 283 : CALL QUEPO1(IVITC, ICEN, MLMCOM) 284 : SEGSUP MLMCOM 285 : IF(IERR .NE. 0)THEN 286 : IERR0 = IERR 287 : 288 : C 289 : C******* Message d'erreur standard 290 : C -301 0 %m1:40 291 : C 292 : MOTERR(1:40) = 'CHPO2 = ??? ' 293 : $ 294 : WRITE(IOIMP,*) MOTERR 295 : 296 : GOTO 9999 297 : ENDIF 298 : C 299 : C**** Lecture du CHPOINT PC 300 : C 301 : ICOND = 1 301 : CALL QUETYP(MTYPR,ICOND,IRETOU) 302 : IF(IERR .NE. 0)GOTO 9999 303 : IF(MTYPR .NE. 'CHPOINT ')THEN 304 : C 305 : C******* Message d'erreur standard 306 : C 37 2 307 : C On ne trouve pas d'objet de type %m1:8 308 : C 309 : MOTERR(1:8) = 'CHPOINT ' 309 : CALL ERREUR(37) 310 : GOTO 9999 311 : ELSE 312 : ICOND = 1 312 : CALL LIROBJ('CHPOINT',IPC,ICOND,IRETOU) 313 : IF (IERR.NE.0) GOTO 9999 314 : ENDIF 315 : C 316 : C**** Control du CHPOINT 317 : C 318 : JGN=4 319 : JGM=1 320 : SEGINI MLMCOM 321 : MLMCOM.MOTS(1)='SCAL' 321 : CALL QUEPO1(IPC, ICEN, MLMCOM) 322 : SEGSUP MLMCOM 323 : IF(IERR .NE. 0)THEN 324 : IERR0 = IERR 325 : 326 : C 327 : C******* Message d'erreur standard 328 : C -301 0 %m1:40 329 : C 330 : MOTERR(1:40) = 'CHPO3 = ??? ' 331 : $ 332 : WRITE(IOIMP,*) MOTERR 333 : 334 : GOTO 9999 335 : ENDIF 336 : C 337 : C**** Lecture du CHPOINT YC 338 : C 339 : IF(NESP .GT. 0)THEN 340 : ICOND = 1 340 : CALL QUETYP(MTYPR,ICOND,IRETOU) 341 : IF(IERR .NE. 0)GOTO 9999 342 : IF(MTYPR .NE. 'CHPOINT ')THEN 343 : C 344 : C******* Message d'erreur standard 345 : C 37 2 346 : C On ne trouve pas d'objet de type %m1:8 347 : C 348 : MOTERR(1:8) = 'CHPOINT ' 348 : CALL ERREUR(37) 349 : GOTO 9999 350 : ELSE 351 : ICOND = 1 351 : CALL LIROBJ('CHPOINT',IYC,ICOND,IRETOU) 352 : IF (IERR.NE.0) GOTO 9999 353 : ENDIF 354 : C 355 : C**** Control du CHPOINT (on ne controlle que le maillage) 356 : C 356 : CALL QUEPO1(IYC, ICEN, MLMESP) 357 : IF(IERR .NE. 0)THEN 358 : IERR0 = IERR 359 : 360 : C 361 : C******* Message d'erreur standard 362 : C -301 0 %m1:40 363 : C 364 : MOTERR(1:40) = 'CHPO4 = ??? ' 365 : WRITE(IOIMP,*) MOTERR 366 : 367 : GOTO 9999 368 : ENDIF 369 : ENDIF 370 : C 371 : C**** Lecture du CHPOINT ISCAC 372 : C 373 : IF(NSCA .GT. 0)THEN 374 : ICOND = 1 374 : CALL QUETYP(MTYPR,ICOND,IRETOU) 375 : IF(IERR .NE. 0)GOTO 9999 376 : IF(MTYPR .NE. 'CHPOINT ')THEN 377 : C 378 : C******* Message d'erreur standard 379 : C 37 2 380 : C On ne trouve pas d'objet de type %m1:8 381 : C 382 : MOTERR(1:8) = 'CHPOINT ' 382 : CALL ERREUR(37) 383 : GOTO 9999 384 : ELSE 385 : ICOND = 1 385 : CALL LIROBJ('CHPOINT',ISCAC,ICOND,IRETOU) 386 : IF (IERR.NE.0) GOTO 9999 387 : ENDIF 388 : C 389 : C**** Control du CHPOINT (on ne controlle que le maillage) 390 : C 390 : CALL QUEPO1(ISCAC, ICEN, MLMSCA) 391 : IF(IERR .NE. 0)THEN 392 : IERR0 = IERR 393 : 394 : C 395 : C******* Message d'erreur standard 396 : C -301 0 %m1:40 397 : C 398 : MOTERR(1:40) = 'CHPO5 = ??? ' 399 : WRITE(IOIMP,*) MOTERR 400 : 401 : GOTO 9999 402 : ENDIF 403 : ENDIF 404 : C 405 : C**** Centre -> Face 406 : C 407 : IF(IDIM .EQ. 2)THEN 408 : C 409 : C******* Deux Dimensions, Mono/Multi Especes, 1er ordre en espace, 1er ordre en 410 : C temps 411 : C 411 : CALL PRE311(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IYC,ISCAC, 412 : & IROF,IVITF,IPF,IYF,ISCAF, 413 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 414 : ELSE 415 : C 416 : C******* Trois Dimensions, Mono/Multi Especes, 1er ordre en espace, 417 : C 1er ordre en temps 418 : C 419 : C 419 : CALL PRE312(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IYC,ISCAC, 420 : & IROF,IVITF,IPF,IYF,ISCAF, 421 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 422 : ENDIF 423 : C 424 : C**** Messages d'erreur 425 : C 426 : IF(LOGAN)THEN 427 : C 428 : C******* Anomalie detectée 429 : C 430 : C 431 : C******* Message d'erreur standard 432 : C -301 0 433 : C %m1:40 434 : C 435 : MOTERR(1:40) = MESERR(1:40) 436 : WRITE(IOIMP,*) MOTERR 437 : C 438 : C******* Message d'erreur standard 439 : C 5 3 440 : C Erreur anormale.contactez votre support 441 : C 441 : CALL ERREUR(5) 442 : GOTO 9999 443 : C 444 : ELSEIF(LOGNEG)THEN 445 : C 446 : C******* Message d'erreur standard 447 : C 41 2 448 : C %m1:8 = %r1 inférieur à %r2 449 : C 450 : MOTERR(1:8) = MESERR(1:8) 451 : REAERR(1) = REAL(VALER) 452 : REAERR(2) = 0.0 452 : CALL ERREUR(41) 453 : GOTO 9999 454 : ELSEIF(LOGBOR)THEN 455 : C 456 : C******* Message d'erreur standard 457 : C 42 2 458 : C %m1:8 = %r1 non compris entre %r2 et %r3 459 : C 460 : MOTERR(1:8) = MESERR(1:8) 461 : REAERR(1) = REAL(VALER) 462 : REAERR(2) = REAL(VAL1) 463 : REAERR(3) = REAL(VAL2) 463 : CALL ERREUR(42) 464 : GOTO 9999 465 : ELSE 466 : C 467 : C******* Ecriture de ROF, VITF, PF, YF, GAMMAF 468 : C 469 : MTYPR = 'MCHAML' 469 : IF(ISCAF .NE. 0) CALL ECROBJ(MTYPR,ISCAF) 469 : IF(IYF .NE. 0) CALL ECROBJ(MTYPR,IYF) 469 : CALL ECROBJ(MTYPR,IPF) 469 : CALL ECROBJ(MTYPR,IVITF) 469 : CALL ECROBJ(MTYPR,IROF) 470 : ENDIF 471 : C 472 : 9999 CONTINUE 473 : C 474 : RETURN 475 : END 476 : 477 :
© Cast3M 2003 - All rights reserved.
Disclaimer