1 : C PRE12F SOURCE CHAT 06/03/29 21:29:27 5360 2 : SUBROUTINE PRE12F() 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : PRE12F 8 : C 9 : C DESCRIPTION : Voir PRE2F 10 : C 11 : C 1st order in space and time 12 : C 13 : C Creation of the objects MCHAML IALPHF, IUVF, IULF, 14 : C IPF, ITVF, ITLF, IRVF, IRLF 15 : C 16 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 17 : C 18 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF 19 : C Modified for two-fluid flow by 20 : C Jose R. Garcia Cascales 21 : C 22 : C************************************************************************ 23 : C 24 : C 25 : C APPELES (Outils) : LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ, 26 : C QUEPOI, ECROBJ 27 : C 28 : C APPELES (Calcul) : PRE22F (2D), PRE32F (3D) 29 : C 30 : C 31 : C************************************************************************ 32 : C 33 : C HISTORIQUE (Anomalies et modifications éventuelles) 34 : C 35 : C HISTORIQUE : Créée le 21/02/2002. 36 : C 37 : C************************************************************************ 38 : C 39 : C 40 : C**** Variables de COOPTIO 41 : C 42 : INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 43 : & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 44 : & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 45 : & ,IECHO, IIMPI, IOSPI 46 : & ,IDIM, IFICLE, IPREFI 47 : & ,MCOORD 48 : & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 49 : & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 50 : & ,NORINC,NORVAL,NORIND,NORVAD 51 : & ,NUCROU, IPSAUV 52 : C 53 : C**** Les variables 54 : C 55 : INTEGER ICOND, IRETOU, IERR0, INDIC, NBCOMP, 56 : & IDOMA, ICEN, IFACE, IFACEL, INORM, 57 : & IALPH, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC, 58 : & IALPHF, IUVF, IULF, IPF, ITVF, ITLF, IRVF, IRLF 59 : REAL*8 VALER, VAL1, VAL2 60 : CHARACTER*(4) NOMTOT(3) 61 : CHARACTER*(8) MTYPR 62 : CHARACTER*(40) MESERR 63 : LOGICAL LOGAN,LOGNEG, LOGBOR 64 : C 65 : C**** Les Includes 66 : C 67 : -INC CCOPTIO 68 : C 69 : C**** Initialisation des parametres d'erreur 70 : C 71 : LOGAN = .FALSE. 72 : LOGNEG = .FALSE. 73 : LOGBOR = .FALSE. 74 : MESERR = ' ' 75 : MOTERR(1:40) = MESERR(1:40) 76 : VALER = 0.0D0 77 : VAL1 = 0.0D0 78 : VAL2 = 0.0D0 79 : C 80 : C**** Initialisation des NOMTOT 81 : C 82 : NOMTOT(1) = ' ' 83 : NOMTOT(2) = ' ' 84 : NOMTOT(3) = ' ' 85 : C 86 : C**** Lecture de la TABLE domaine (IDOMA) 87 : C 88 : ICOND = 1 88 : CALL LIRTAB('DOMAINE',IDOMA,ICOND,IRETOU) 89 : IF (IERR .NE. 0) GOTO 9999 90 : C 91 : C**** Lecture du MELEME SPG des points CENTRE. 92 : C 93 : C 93 : C CALL LEKTAB(IDOMA,'CENTRE',IP) 94 : C 95 : C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas, 96 : C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL' 97 : C -> la correspondance global des noeuds saut! 98 : C 99 : C On peut utilizer ACCTAB ou ACMO 100 : C 101 : MTYPR = 'MAILLAGE' 101 : CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN) 102 : IF(IERR.NE.0)GOTO 9999 103 : C 104 : C**** Lecture du MELEME 'FACE' 105 : C 106 : MTYPR = 'MAILLAGE' 106 : CALL ACMO(IDOMA,'FACE',MTYPR,IFACE) 107 : IF(IERR.NE.0)GOTO 9999 108 : C 109 : C**** Lecture du MELEME 'FACEL' 110 : C 111 : MTYPR = 'MAILLAGE' 111 : CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL) 112 : IF(IERR.NE.0)GOTO 9999 113 : C 114 : C**** Lecture du CHPOINT contenant les normales aux faces 115 : C 116 : IF(IDIM .EQ. 2)THEN 117 : C Que les normales 117 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 118 : IF(IERR .NE. 0) GOTO 9999 119 : ELSE 120 : C Les normales et les tangentes 121 : MTYPR = ' ' 121 : CALL ACMO(IDOMA,'MATROT',MTYPR,INORM) 122 : IF (MTYPR .NE. 'CHPOINT ') THEN 122 : CALL MATRAN(IDOMA,INORM) 123 : IF(IERR .NE. 0) GOTO 9999 124 : ENDIF 125 : 126 : C 127 : ENDIF 128 : C 129 : C 130 : C**** Lecture du CHPOINT IALPH, VOID FRACTION 131 : C 132 : ICOND = 1 132 : CALL QUETYP(MTYPR,ICOND,IRETOU) 133 : IF(IERR .NE. 0)GOTO 9999 134 : IF(MTYPR .NE. 'CHPOINT ')THEN 135 : C 136 : C******* Message d'erreur standard 137 : C 37 2 138 : C On ne trouve pas d'objet de type %m1:8 139 : C 140 : MOTERR(1:8) = 'CHPOINT ' 140 : CALL ERREUR(37) 141 : GOTO 9999 142 : ELSE 143 : ICOND = 1 143 : CALL LIROBJ(MTYPR,IALPH,ICOND,IRETOU) 144 : IF (IERR.NE.0) GOTO 9999 145 : ENDIF 146 : C 147 : C**** Control du CHPOINT: QUEPOI 148 : C 149 : C INDIC = 1 -> on impose le pointeur du support geometrique (IM1) 150 : C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1) 151 : C 152 : C NBCOMP > 0 -> numero des composantes 153 : C 154 : C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes 155 : C 156 : INDIC = 1 157 : NBCOMP = 1 158 : NOMTOT(1) = 'SCAL' 158 : CALL QUEPOI(IALPH, ICEN, INDIC, NBCOMP, NOMTOT) 159 : IF(IERR .NE. 0)THEN 160 : IERR0 = IERR 161 : 162 : C 163 : C******* Message d'erreur standard 164 : C -301 0 %m1:40 165 : C 166 : MOTERR(1:40) = 'CHPO1 = ??? ' 166 : CALL ERREUR(-301) 167 : 168 : GOTO 9999 169 : ENDIF 170 : C 171 : C**** Lecture du CHPOINT IUVC, VAPOUR VELOCITY 172 : C 173 : ICOND = 1 173 : CALL QUETYP(MTYPR,ICOND,IRETOU) 174 : IF(IERR .NE. 0)GOTO 9999 175 : IF(MTYPR .NE. 'CHPOINT ')THEN 176 : C 177 : C******* Message d'erreur standard 178 : C 37 2 179 : C On ne trouve pas d'objet de type %m1:8 180 : C 181 : MOTERR(1:8) = 'CHPOINT ' 181 : CALL ERREUR(37) 182 : GOTO 9999 183 : ELSE 184 : ICOND = 1 184 : CALL LIROBJ('CHPOINT',IUVC,ICOND,IRETOU) 185 : IF (IERR.NE.0) GOTO 9999 186 : ENDIF 187 : C 188 : C**** Control du CHPOINT 189 : C 190 : INDIC = 1 191 : NBCOMP = IDIM 192 : NOMTOT(1) = 'UVX' 193 : NOMTOT(2) = 'UVY' 194 : IF(IDIM .EQ. 3) NOMTOT(3) = 'UVZ' 194 : CALL QUEPOI(IUVC, ICEN, INDIC, NBCOMP, NOMTOT) 195 : IF(IERR .NE. 0)THEN 196 : IERR0 = IERR 197 : 198 : C 199 : C******* Message d'erreur standard 200 : C -301 0 %m1:40 201 : C 202 : MOTERR(1:40) = 'CHPO2 = ??? ' 202 : CALL ERREUR(-301) 203 : 204 : GOTO 9999 205 : ENDIF 206 : C 207 : C**** Lecture du CHPOINT IULC, LIQUID VELOCITY 208 : C 209 : ICOND = 1 209 : CALL QUETYP(MTYPR,ICOND,IRETOU) 210 : IF(IERR .NE. 0)GOTO 9999 211 : IF(MTYPR .NE. 'CHPOINT ')THEN 212 : C 213 : C******* Message d'erreur standard 214 : C 37 2 215 : C On ne trouve pas d'objet de type %m1:8 216 : C 217 : MOTERR(1:8) = 'CHPOINT ' 217 : CALL ERREUR(37) 218 : GOTO 9999 219 : ELSE 220 : ICOND = 1 220 : CALL LIROBJ('CHPOINT',IULC,ICOND,IRETOU) 221 : IF (IERR.NE.0) GOTO 9999 222 : ENDIF 223 : C 224 : C**** Control du CHPOINT 225 : C 226 : INDIC = 1 227 : NBCOMP = IDIM 228 : NOMTOT(1) = 'ULX' 229 : NOMTOT(2) = 'ULY' 230 : IF(IDIM .EQ. 3) NOMTOT(3) = 'ULZ' 230 : CALL QUEPOI(IULC, ICEN, INDIC, NBCOMP, NOMTOT) 231 : IF(IERR .NE. 0)THEN 232 : IERR0 = IERR 233 : 234 : C 235 : C******* Message d'erreur standard 236 : C -301 0 %m1:40 237 : C 238 : MOTERR(1:40) = 'CHPO3 = ??? ' 238 : CALL ERREUR(-301) 239 : 240 : GOTO 9999 241 : ENDIF 242 : C 243 : C**** Lecture du CHPOINT IPC, PRESSURE 244 : C 245 : ICOND = 1 245 : CALL QUETYP(MTYPR,ICOND,IRETOU) 246 : IF(IERR .NE. 0)GOTO 9999 247 : IF(MTYPR .NE. 'CHPOINT ')THEN 248 : C 249 : C******* Message d'erreur standard 250 : C 37 2 251 : C On ne trouve pas d'objet de type %m1:8 252 : C 253 : MOTERR(1:8) = 'CHPOINT ' 253 : CALL ERREUR(37) 254 : GOTO 9999 255 : ELSE 256 : ICOND = 1 256 : CALL LIROBJ('CHPOINT',IPC,ICOND,IRETOU) 257 : IF (IERR.NE.0) GOTO 9999 258 : ENDIF 259 : C 260 : C**** Control du CHPOINT 261 : C 262 : INDIC = 1 263 : NBCOMP = 1 264 : NOMTOT(1) = 'SCAL' 264 : CALL QUEPOI(IPC, ICEN, INDIC, NBCOMP, NOMTOT) 265 : IF(IERR .NE. 0)THEN 266 : IERR0 = IERR 267 : 268 : C 269 : C******* Message d'erreur standard 270 : C -301 0 %m1:40 271 : C 272 : MOTERR(1:40) = 'CHPO4 = ??? ' 272 : CALL ERREUR(-301) 273 : 274 : GOTO 9999 275 : ENDIF 276 : C 277 : C**** Lecture du CHPOINT ITVC, VAPOUR TEMPERATURE 278 : C 279 : ICOND = 1 279 : CALL QUETYP(MTYPR,ICOND,IRETOU) 280 : IF(IERR .NE. 0)GOTO 9999 281 : IF(MTYPR .NE. 'CHPOINT ')THEN 282 : C 283 : C******* Message d'erreur standard 284 : C 37 2 285 : C On ne trouve pas d'objet de type %m1:8 286 : C 287 : MOTERR(1:8) = 'CHPOINT ' 287 : CALL ERREUR(37) 288 : GOTO 9999 289 : ELSE 290 : ICOND = 1 290 : CALL LIROBJ('CHPOINT',ITVC,ICOND,IRETOU) 291 : IF (IERR.NE.0) GOTO 9999 292 : ENDIF 293 : C 294 : C**** Control du CHPOINT 295 : C 296 : INDIC = 1 297 : NBCOMP = 1 298 : NOMTOT(1) = 'SCAL' 298 : CALL QUEPOI(ITVC, ICEN, INDIC, NBCOMP, NOMTOT) 299 : IF(IERR .NE. 0)THEN 300 : IERR0 = IERR 301 : 302 : C 303 : C******* Message d'erreur standard 304 : C -301 0 %m1:40 305 : C 306 : MOTERR(1:40) = 'CHPO5 = ??? ' 306 : CALL ERREUR(-301) 307 : 308 : GOTO 9999 309 : ENDIF 310 : C 311 : C**** Lecture du CHPOINT ITLC, LIQUID TEMPERATURE 312 : C 313 : ICOND = 1 313 : CALL QUETYP(MTYPR,ICOND,IRETOU) 314 : IF(IERR .NE. 0)GOTO 9999 315 : IF(MTYPR .NE. 'CHPOINT ')THEN 316 : C 317 : C******* Message d'erreur standard 318 : C 37 2 319 : C On ne trouve pas d'objet de type %m1:8 320 : C 321 : MOTERR(1:8) = 'CHPOINT ' 321 : CALL ERREUR(37) 322 : GOTO 9999 323 : ELSE 324 : ICOND = 1 324 : CALL LIROBJ('CHPOINT',ITLC,ICOND,IRETOU) 325 : IF (IERR.NE.0) GOTO 9999 326 : ENDIF 327 : C 328 : C**** Control du CHPOINT 329 : C 330 : INDIC = 1 331 : NBCOMP = 1 332 : NOMTOT(1) = 'SCAL' 332 : CALL QUEPOI(ITLC, ICEN, INDIC, NBCOMP, NOMTOT) 333 : IF(IERR .NE. 0)THEN 334 : IERR0 = IERR 335 : 336 : C 337 : C******* Message d'erreur standard 338 : C -301 0 %m1:40 339 : C 340 : MOTERR(1:40) = 'CHPO6 = ??? ' 340 : CALL ERREUR(-301) 341 : 342 : GOTO 9999 343 : ENDIF 344 : C 345 : C**** Lecture du CHPOINT IRVC, VAPOUR DENSITY 346 : C 347 : ICOND = 1 347 : CALL QUETYP(MTYPR,ICOND,IRETOU) 348 : IF(IERR .NE. 0)GOTO 9999 349 : IF(MTYPR .NE. 'CHPOINT ')THEN 350 : C 351 : C******* Message d'erreur standard 352 : C 37 2 353 : C On ne trouve pas d'objet de type %m1:8 354 : C 355 : MOTERR(1:8) = 'CHPOINT ' 355 : CALL ERREUR(37) 356 : GOTO 9999 357 : ELSE 358 : ICOND = 1 358 : CALL LIROBJ(MTYPR,IRVC,ICOND,IRETOU) 359 : IF (IERR.NE.0) GOTO 9999 360 : ENDIF 361 : 362 : INDIC = 1 363 : NBCOMP = 1 364 : NOMTOT(1) = 'SCAL' 364 : CALL QUEPOI(IRVC, ICEN, INDIC, NBCOMP, NOMTOT) 365 : IF(IERR .NE. 0)THEN 366 : IERR0 = IERR 367 : 368 : C 369 : C******* Message d'erreur standard 370 : C -301 0 %m1:40 371 : C 372 : MOTERR(1:40) = 'CHPO7 = ??? ' 372 : CALL ERREUR(-301) 373 : 374 : GOTO 9999 375 : ENDIF 376 : C 377 : C**** Lecture du CHPOINT IRLC, LIQUID DENSITY 378 : C 379 : ICOND = 1 379 : CALL QUETYP(MTYPR,ICOND,IRETOU) 380 : IF(IERR .NE. 0)GOTO 9999 381 : IF(MTYPR .NE. 'CHPOINT ')THEN 382 : C 383 : C******* Message d'erreur standard 384 : C 37 2 385 : C On ne trouve pas d'objet de type %m1:8 386 : C 387 : MOTERR(1:8) = 'CHPOINT ' 387 : CALL ERREUR(37) 388 : GOTO 9999 389 : ELSE 390 : ICOND = 1 390 : CALL LIROBJ(MTYPR,IRLC,ICOND,IRETOU) 391 : IF (IERR.NE.0) GOTO 9999 392 : ENDIF 393 : 394 : INDIC = 1 395 : NBCOMP = 1 396 : NOMTOT(1) = 'SCAL' 396 : CALL QUEPOI(IRLC, ICEN, INDIC, NBCOMP, NOMTOT) 397 : IF(IERR .NE. 0)THEN 398 : IERR0 = IERR 399 : 400 : C 401 : C******* Message d'erreur standard 402 : C -301 0 %m1:40 403 : C 404 : MOTERR(1:40) = 'CHPO8 = ??? ' 404 : CALL ERREUR(-301) 405 : IERR = IERR0 406 : GOTO 9999 407 : ENDIF 408 : C 409 : C**** Centre -> Face 410 : C 411 : IF(IDIM .EQ. 2)THEN 412 : C 413 : C******* Two Dimensions, 1st order in time and space 414 : C 414 : CALL PRE22F(ICEN,IFACE,IFACEL,INORM, 415 : & IALPH, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC, 416 : & IALPHF, IUVF, IULF, IPF, ITVF, ITLF, 417 : & IRVF, IRLF, 418 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 419 : ELSE 420 : C 421 : C******* Three dimensions, 1st order in time and space 422 : C 422 : CALL PRE32F(ICEN,IFACE,IFACEL,INORM, 423 : & IALPH, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC, 424 : & IALPHF, IUVF, IULF, IPF, ITVF, ITLF, 425 : & IRVF, IRLF, 426 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 427 : 428 : ENDIF 429 : C 430 : C**** Messages d'erreur 431 : C 432 : IF(LOGAN)THEN 433 : C 434 : C******* Anomalie detectée 435 : C 436 : C 437 : C******* Message d'erreur standard 438 : C -301 0 439 : C %m1:40 440 : C 441 : MOTERR(1:40) = MESERR(1:40) 441 : CALL ERREUR(-301) 442 : C 443 : C******* Message d'erreur standard 444 : C 5 3 445 : C Erreur anormale.contactez votre support 446 : C 446 : CALL ERREUR(5) 447 : GOTO 9999 448 : C 449 : ELSEIF(LOGNEG)THEN 450 : C 451 : C******* Message d'erreur standard 452 : C 41 2 453 : C %m1:8 = %r1 inférieur à %r2 454 : C 455 : MOTERR(1:8) = MESERR(1:8) 456 : REAERR(1) = REAL(VALER) 457 : REAERR(2) = 0.0 457 : CALL ERREUR(41) 458 : GOTO 9999 459 : ELSEIF(LOGBOR)THEN 460 : C 461 : C******* Message d'erreur standard 462 : C 42 2 463 : C %m1:8 = %r1 non compris entre %r2 et %r3 464 : C 465 : MOTERR(1:8) = MESERR(1:8) 466 : REAERR(1) = REAL(VALER) 467 : REAERR(2) = REAL(VAL1) 468 : REAERR(3) = REAL(VAL2) 468 : CALL ERREUR(42) 469 : GOTO 9999 470 : ELSE 471 : C 472 : C******* Ecriture de ROF, VITF, PF 473 : C 474 : MTYPR = 'MCHAML' 474 : CALL ECROBJ(MTYPR, IALPHF) 474 : CALL ECROBJ(MTYPR, IUVF) 474 : CALL ECROBJ(MTYPR, IULF) 474 : CALL ECROBJ(MTYPR, IPF) 474 : CALL ECROBJ(MTYPR, ITVF) 474 : CALL ECROBJ(MTYPR, ITLF) 474 : CALL ECROBJ(MTYPR, IRVF) 474 : CALL ECROBJ(MTYPR, IRLF) 475 : ENDIF 476 : C 477 : 9999 CONTINUE 478 : C 479 : RETURN 480 : END 481 : 482 : 483 : 484 : 485 : 486 :
© Cast3M 2003 - All rights reserved.
Disclaimer