1 : C PRE32 SOURCE CHAT 06/08/24 21:59:12 5529 2 : SUBROUTINE PRE32(ORDTEM) 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : PRE32 8 : C 9 : C DESCRIPTION : Voir PRE3 10 : C 11 : C Gaz "thermally perfect" , mono/multi-especes. 12 : C 13 : C 2me ordre en espace (1er ou 2me ordre en temps) 14 : C 15 : C Creations des object MCHAML IROF, IVITF, IPF, 16 : C IYF, ISCAF 17 : C 18 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 19 : C 20 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF 21 : C 22 : C************************************************************************ 23 : C 24 : C 25 : C APPELES (Outils) : LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ, 26 : C ACMM, ACCTAB, QUEPO1, ECROBJ 27 : C 28 : C APPELES (Calcul) : PRE321 (2D), PRE322 (3D) 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 17.02.2000: 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 ORDTEM, ICOND, IRETOU, IERR0 58 : & ,IDOMA, ICEN, IFACE, IFACEL, INORM 59 : & ,IROC, IGRROC, IALROC 60 : & ,IVITC, IGRVC, IALVC 61 : & ,IPC ,IGRPC, IALPC 62 : & ,IGAMC, IROF, IVITF, IPF 63 : & ,IPGAS, NESP, NSCA 64 : & ,IYC, IGRYC, IALYC, IYF 65 : & ,ISCAC, IGRSC, IALSC, ISCAF 66 : & , I1, I2, ICEL, ICOM, INEFMD 67 : & ,MMODEL 68 : REAL*8 VALER, VAL1, VAL2, DELTAT 69 : CHARACTER*(4) NOMGRA(27),NOMLIM(9) 70 : CHARACTER*(8) MTYPR, TYPE 71 : CHARACTER*(40) MESERR 72 : LOGICAL LOGAN,LOGNEG, LOGBOR,LOGTEM 73 : & ,LGAMC,LSCAC,LYC 74 : C 75 : C**** Les Includes 76 : C 77 : -INC CCOPTIO 78 : INTEGER JGM, JGN 79 : -INC SMLMOTS 80 : POINTEUR MLMCOM.MLMOTS, MLMESP.MLMOTS, MLMSCA.MLMOTS 81 : POINTEUR MLMVIT.MLMOTS 82 : C 83 : C**** Nom de composantes de gradients (HP. <= 9 composantes) 84 : C 85 : DATA NOMGRA /'P1DX','P1DY','P1DZ', 86 : & 'P2DX','P2DY','P2DZ', 87 : & 'P3DX','P3DY','P3DZ', 88 : & 'P4DX','P4DY','P4DZ', 89 : & 'P5DX','P5DY','P5DZ', 90 : & 'P6DX','P6DY','P6DZ', 91 : & 'P7DX','P7DY','P7DZ', 92 : & 'P8DX','P8DY','P8DZ', 93 : & 'P9DX','P9DY','P9DZ'/ 94 : C 95 : DATA NOMLIM /'P1 ', 96 : & 'P2 ', 97 : & 'P3 ', 98 : & 'P4 ', 99 : & 'P5 ', 100 : & 'P6 ', 101 : & 'P7 ', 102 : & 'P8 ', 103 : & 'P9 '/ 104 : C 105 : C**** Initialisation des parametres d'erreur 106 : C 107 : LOGAN = .FALSE. 108 : LOGNEG = .FALSE. 109 : LOGBOR = .FALSE. 110 : MESERR = ' ' 111 : MOTERR(1:40) = MESERR(1:40) 112 : VALER = 0.0D0 113 : VAL1 = 0.0D0 114 : VAL2 = 0.0D0 115 : C 116 : C**** Lecture de l'objet MODELE 117 : C 118 : ICOND = 1 118 : CALL QUETYP(TYPE,ICOND,IRETOU) 119 : 120 : IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN 121 : WRITE(6,*)' On attend un objet MMODEL' 122 : RETURN 123 : ENDIF 123 : CALL LIROBJ('MMODEL',MMODEL,ICOND,IRETOU) 124 : IF(IERR.NE.0)GOTO 9999 124 : CALL LEKMOD(MMODEL,IDOMA,INEFMD) 125 : IF(IERR.NE.0)GOTO 9999 126 : C 127 : C**** Lecture du MELEME SPG des points CENTRE. 128 : C 129 : C 129 : C CALL LEKTAB(IDOMA,'CENTRE',IP) 130 : C 131 : C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas, 132 : C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL' 133 : C -> la correspondance global des noeuds saut! 134 : C 135 : C On peut utilizer ACCTAB ou ACMO 136 : C 137 : MTYPR = 'MAILLAGE' 137 : CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN) 138 : IF(IERR.NE.0)GOTO 9999 139 : C 140 : C**** Lecture du MELEME 'FACE' 141 : C 142 : MTYPR = 'MAILLAGE' 142 : CALL ACMO(IDOMA,'FACE',MTYPR,IFACE) 143 : IF(IERR.NE.0)GOTO 9999 144 : C 145 : C**** Lecture du MELEME 'FACEL' 146 : C 147 : MTYPR = 'MAILLAGE' 147 : CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL) 148 : IF(IERR.NE.0)GOTO 9999 149 : C 150 : C**** Lecture du CHPOINT contenant les normales (tangentes) aux faces 151 : C 152 : IF(IDIM .EQ. 2)THEN 153 : C Que les normales 153 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 154 : IF(IERR .NE. 0) GOTO 9999 155 : JGN = 4 156 : JGM = 2 157 : SEGINI MLMVIT 158 : MLMVIT.MOTS(1) = 'UX ' 159 : MLMVIT.MOTS(2) = 'UY ' 159 : CALL QUEPO1(INORM, IFACE, MLMVIT) 160 : SEGSUP MLMVIT 161 : IF(IERR.NE.0)GOTO 9999 162 : ELSE 163 : C Les normales et les tangentes 164 : MTYPR = ' ' 164 : CALL ACMO(IDOMA,'MATROT',MTYPR,INORM) 165 : IF (MTYPR .NE. 'CHPOINT ') THEN 165 : CALL MATRAN(IDOMA,INORM) 166 : IF(IERR .NE. 0) GOTO 9999 167 : ENDIF 168 : JGN = 4 169 : JGM = 9 170 : SEGINI MLMVIT 171 : MLMVIT.MOTS(1) = 'UX ' 172 : MLMVIT.MOTS(2) = 'UY ' 173 : MLMVIT.MOTS(3) = 'UZ ' 174 : MLMVIT.MOTS(4) = 'RX ' 175 : MLMVIT.MOTS(5) = 'RY ' 176 : MLMVIT.MOTS(6) = 'RZ ' 177 : MLMVIT.MOTS(7) = 'MX ' 178 : MLMVIT.MOTS(8) = 'MY ' 179 : MLMVIT.MOTS(9) = 'MZ ' 179 : CALL QUEPO1(INORM, IFACE, MLMVIT) 180 : SEGSUP MLMVIT 181 : IF(IERR.NE.0)GOTO 9999 182 : C 183 : ENDIF 184 : C 185 : C**** N.B. On veut lire les objets sequentiellement. 186 : C Donc on utilise QUETYP pour controler que 187 : C le type de l'objet soit le bon. 188 : C 189 : C 190 : C**** Lecture de la table des proprietes du gaz 191 : C 192 : C Cette table a ete deja controlle dans l'operateur PRIM; 193 : C donc on la controlle pas ici 194 : C 195 : ICOND = 1 195 : CALL QUETYP(MTYPR,ICOND,IRETOU) 196 : IF(IERR .NE. 0)GOTO 9999 197 : IF(MTYPR .NE. 'TABLE ')THEN 198 : C 199 : C******* Message d'erreur standard 200 : C 37 2 201 : C On ne trouve pas d'objet de type %m1:8 202 : C 203 : MOTERR(1:8) = 'TABLE ' 203 : CALL ERREUR(37) 204 : GOTO 9999 205 : ELSE 206 : ICOND = 1 206 : CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU) 207 : IF(IERR .NE. 0)GOTO 9999 208 : ENDIF 209 : C 210 : C**** Les especes qui sont dans les Equations d'Euler 211 : C 212 : MTYPR = ' ' 212 : CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMESP) 213 : IF(MTYPR .EQ. ' ')THEN 214 : NESP = 0 215 : IYC = 0 216 : IGRYC = 0 217 : IALYC = 0 218 : ELSEIF(MTYPR .NE. 'LISTMOTS')THEN 219 : C 220 : C******* Message d'erreur standard 221 : C -301 0 %m1:40 222 : C 223 : MOTERR(1:40) = 'TAB2 . ESPEULE = ??? ' 224 : WRITE(IOIMP,*) MOTERR 225 : C 226 : C******* Message d'erreur standard 227 : C 21 2 228 : C Données incompatibles 229 : C 229 : CALL ERREUR(21) 230 : GOTO 9999 231 : ELSE 232 : SEGACT MLMESP 233 : NESP = MLMESP.MOTS(/2) 234 : SEGDES MLMESP 235 : ENDIF 236 : C 237 : C**** Les scalaires passifs 238 : C 239 : MTYPR = ' ' 239 : CALL ACMO(IPGAS,'SCALPASS',MTYPR,MLMSCA) 240 : IF(MTYPR .EQ. ' ')THEN 241 : NSCA = 0 242 : ISCAC = 0 243 : ELSEIF(MTYPR .NE. 'LISTMOTS')THEN 244 : C 245 : C******* Message d'erreur standard 246 : C -301 0 %m1:40 247 : C 248 : MOTERR(1:40) = 'TAB2 . SCALPASS = ??? ' 249 : WRITE(IOIMP,*) MOTERR 250 : C 251 : C******* Message d'erreur standard 252 : C 21 2 253 : C Données incompatibles 254 : C 254 : CALL ERREUR(21) 255 : GOTO 9999 256 : ELSE 257 : SEGACT MLMSCA 258 : NSCA = MLMSCA.MOTS(/2) 259 : SEGDES MLMSCA 260 : ENDIF 261 : C 262 : C**** Lecture du CHPOINT ROC 263 : C 264 : ICOND = 1 264 : CALL QUETYP(MTYPR,ICOND,IRETOU) 265 : IF(IERR .NE. 0)GOTO 9999 266 : IF(MTYPR .NE. 'CHPOINT ')THEN 267 : C 268 : C******* Message d'erreur standard 269 : C 37 2 270 : C On ne trouve pas d'objet de type %m1:8 271 : C 272 : MOTERR(1:8) = 'CHPOINT ' 272 : CALL ERREUR(37) 273 : GOTO 9999 274 : ELSE 275 : ICOND = 1 275 : CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU) 276 : IF(IERR .NE. 0)GOTO 9999 277 : ENDIF 278 : C 279 : C**** Control du CHPOINT: QUEPO1 280 : C 281 : JGN=4 282 : JGM=1 283 : SEGINI MLMCOM 284 : MLMCOM.MOTS(1)='SCAL' 284 : CALL QUEPO1(IROC, ICEN, MLMCOM) 285 : SEGSUP MLMCOM 286 : IF(IERR .NE. 0)THEN 287 : IERR0 = IERR 288 : 289 : C 290 : C******* Message d'erreur standard 291 : C -301 0 %m1:40 292 : C 293 : MOTERR(1:40) = 'CHPO1 = ??? ' 294 : WRITE(IOIMP,*) MOTERR 295 : 296 : GOTO 9999 297 : ENDIF 298 : C 299 : C**** Lecture du CHPOINT GRADROC 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(MTYPR,IGRROC,ICOND,IRETOU) 313 : IF (IERR.NE.0) GOTO 9999 314 : ENDIF 315 : C 316 : C**** Control du CHPOINT: QUEPO1 317 : C 318 : JGN=4 319 : JGM=IDIM 320 : SEGINI MLMCOM 321 : MLMCOM.MOTS(1)='P1DX' 322 : MLMCOM.MOTS(2)='P1DY' 323 : IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'P1DZ' 323 : CALL QUEPO1(IGRROC, ICEN, MLMCOM) 324 : SEGSUP MLMCOM 325 : IF(IERR .NE. 0)THEN 326 : IERR0 = IERR 327 : 328 : C 329 : C******* Message d'erreur standard 330 : C -301 0 %m1:40 331 : C 332 : MOTERR(1:40) = 'CHPO2 = ??? ' 333 : WRITE(IOIMP,*) MOTERR 334 : 335 : GOTO 9999 336 : ENDIF 337 : C 338 : C**** Lecture du CHPOINT IALROC 339 : C 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(MTYPR,IALROC,ICOND,IRETOU) 352 : IF (IERR.NE.0) GOTO 9999 353 : ENDIF 354 : C 355 : C**** Control du CHPOINT: QUEPO1 356 : C 357 : JGN=4 358 : JGM=1 359 : SEGINI MLMCOM 360 : MLMCOM.MOTS(1)= 'P1 ' 360 : CALL QUEPO1(IALROC, ICEN, MLMCOM) 361 : SEGSUP MLMCOM 362 : IF(IERR .NE. 0)THEN 363 : IERR0 = IERR 364 : 365 : C 366 : C******* Message d'erreur standard 367 : C -301 0 %m1:40 368 : C 369 : MOTERR(1:40) = 'CHPO3 = ??? ' 370 : WRITE(IOIMP,*) MOTERR 371 : 372 : GOTO 9999 373 : ENDIF 374 : C 375 : C 376 : C**** Lecture du CHPOINT VITC 377 : C 378 : ICOND = 1 378 : CALL QUETYP(MTYPR,ICOND,IRETOU) 379 : IF(IERR .NE. 0)GOTO 9999 380 : IF(MTYPR .NE. 'CHPOINT ')THEN 381 : C 382 : C******* Message d'erreur standard 383 : C 37 2 384 : C On ne trouve pas d'objet de type %m1:8 385 : C 386 : MOTERR(1:8) = 'CHPOINT ' 386 : CALL ERREUR(37) 387 : GOTO 9999 388 : ELSE 389 : ICOND = 1 389 : CALL LIROBJ(MTYPR,IVITC,ICOND,IRETOU) 390 : IF (IERR.NE.0) GOTO 9999 391 : ENDIF 392 : C 393 : C**** Control du CHPOINT 394 : C 395 : JGN=4 396 : JGM=IDIM 397 : SEGINI MLMCOM 398 : MLMCOM.MOTS(1) = 'UX ' 399 : MLMCOM.MOTS(2) = 'UY ' 400 : IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'UZ ' 400 : CALL QUEPO1(IVITC, ICEN, MLMCOM) 401 : SEGSUP MLMCOM 402 : IF(IERR .NE. 0)THEN 403 : IERR0 = IERR 404 : 405 : C 406 : C******* Message d'erreur standard 407 : C -301 0 %m1:40 408 : C 409 : MOTERR(1:40) = 'CHPO4 = ??? ' 410 : WRITE(IOIMP,*) MOTERR 411 : 412 : GOTO 9999 413 : ENDIF 414 : C 415 : C**** Lecture du CHPOINT GRADVITC 416 : C 417 : ICOND = 1 417 : CALL QUETYP(MTYPR,ICOND,IRETOU) 418 : IF(IERR .NE. 0)GOTO 9999 419 : IF(MTYPR .NE. 'CHPOINT ')THEN 420 : C 421 : C******* Message d'erreur standard 422 : C 37 2 423 : C On ne trouve pas d'objet de type %m1:8 424 : C 425 : MOTERR(1:8) = 'CHPOINT ' 425 : CALL ERREUR(37) 426 : GOTO 9999 427 : ELSE 428 : ICOND = 1 428 : CALL LIROBJ(MTYPR,IGRVC,ICOND,IRETOU) 429 : IF (IERR.NE.0) GOTO 9999 430 : ENDIF 431 : C 432 : C**** Control du CHPOINT: QUEPO1 433 : C 434 : JGN=4 435 : IF(IDIM .EQ. 2)THEN 436 : JGM=4 437 : SEGINI MLMCOM 438 : MLMCOM.MOTS(1) = 'P1DX' 439 : MLMCOM.MOTS(2) = 'P1DY' 440 : MLMCOM.MOTS(3) = 'P2DX' 441 : MLMCOM.MOTS(4) = 'P2DY' 442 : ELSE 443 : JGM=9 444 : SEGINI MLMCOM 445 : MLMCOM.MOTS(1) = 'P1DX' 446 : MLMCOM.MOTS(2) = 'P1DY' 447 : MLMCOM.MOTS(3) = 'P1DZ' 448 : MLMCOM.MOTS(4) = 'P2DX' 449 : MLMCOM.MOTS(5) = 'P2DY' 450 : MLMCOM.MOTS(6) = 'P2DZ' 451 : MLMCOM.MOTS(7) = 'P3DX' 452 : MLMCOM.MOTS(8) = 'P3DY' 453 : MLMCOM.MOTS(9) = 'P3DZ' 454 : ENDIF 454 : CALL QUEPO1(IGRVC, ICEN, MLMCOM) 455 : SEGSUP MLMCOM 456 : IF(IERR .NE. 0)THEN 457 : IERR0 = IERR 458 : 459 : C 460 : C******* Message d'erreur standard 461 : C -301 0 %m1:40 462 : C 463 : MOTERR(1:40) = 'CHPO5 = ??? ' 464 : WRITE(IOIMP,*) MOTERR 465 : 466 : GOTO 9999 467 : ENDIF 468 : C 469 : C**** Lecture du CHPOINT IALVC 470 : C 471 : ICOND = 1 471 : CALL QUETYP(MTYPR,ICOND,IRETOU) 472 : IF(IERR .NE. 0)GOTO 9999 473 : IF(MTYPR .NE. 'CHPOINT ')THEN 474 : C 475 : C******* Message d'erreur standard 476 : C 37 2 477 : C On ne trouve pas d'objet de type %m1:8 478 : C 479 : MOTERR(1:8) = 'CHPOINT ' 479 : CALL ERREUR(37) 480 : GOTO 9999 481 : ELSE 482 : ICOND = 1 482 : CALL LIROBJ(MTYPR,IALVC,ICOND,IRETOU) 483 : IF (IERR.NE.0) GOTO 9999 484 : ENDIF 485 : C 486 : C**** Control du CHPOINT: QUEPO1 487 : C 488 : JGN=4 489 : JGM=IDIM 490 : SEGINI MLMCOM 491 : MLMCOM.MOTS(1) = 'P1 ' 492 : MLMCOM.MOTS(2) = 'P2 ' 493 : IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'P3 ' 493 : CALL QUEPO1(IALVC, ICEN, MLMCOM) 494 : SEGSUP MLMCOM 495 : IF(IERR .NE. 0)THEN 496 : IERR0 = IERR 497 : 498 : C 499 : C******* Message d'erreur standard 500 : C -301 0 %m1:40 501 : C 502 : MOTERR(1:40) = 'CHPO6 = ??? ' 503 : WRITE(IOIMP,*) MOTERR 504 : 505 : GOTO 9999 506 : ENDIF 507 : C 508 : C**** Lecture du CHPOINT PC 509 : C 510 : ICOND = 1 510 : CALL QUETYP(MTYPR,ICOND,IRETOU) 511 : IF(IERR .NE. 0)GOTO 9999 512 : IF(MTYPR .NE. 'CHPOINT ')THEN 513 : C 514 : C******* Message d'erreur standard 515 : C 37 2 516 : C On ne trouve pas d'objet de type %m1:8 517 : C 518 : MOTERR(1:8) = 'CHPOINT ' 518 : CALL ERREUR(37) 519 : GOTO 9999 520 : ELSE 521 : ICOND = 1 521 : CALL LIROBJ(MTYPR,IPC,ICOND,IRETOU) 522 : IF (IERR.NE.0) GOTO 9999 523 : ENDIF 524 : C 525 : C**** Control du CHPOINT 526 : C 527 : JGN=4 528 : JGM=1 529 : SEGINI MLMCOM 530 : MLMCOM.MOTS(1)='SCAL' 530 : CALL QUEPO1(IPC, ICEN, MLMCOM) 531 : SEGSUP MLMCOM 532 : IF(IERR .NE. 0)THEN 533 : IERR0 = IERR 534 : 535 : C 536 : C******* Message d'erreur standard 537 : C -301 0 %m1:40 538 : C 539 : MOTERR(1:40) = 'CHPO7 = ??? ' 540 : WRITE(IOIMP,*) MOTERR 541 : 542 : GOTO 9999 543 : ENDIF 544 : C 545 : C**** Lecture du CHPOINT GRADPC 546 : C 547 : ICOND = 1 547 : CALL QUETYP(MTYPR,ICOND,IRETOU) 548 : IF(IERR .NE. 0)GOTO 9999 549 : IF(MTYPR .NE. 'CHPOINT ')THEN 550 : C 551 : C******* Message d'erreur standard 552 : C 37 2 553 : C On ne trouve pas d'objet de type %m1:8 554 : C 555 : MOTERR(1:8) = 'CHPOINT ' 555 : CALL ERREUR(37) 556 : GOTO 9999 557 : ELSE 558 : ICOND = 1 558 : CALL LIROBJ(MTYPR,IGRPC,ICOND,IRETOU) 559 : IF (IERR.NE.0) GOTO 9999 560 : ENDIF 561 : C 562 : C**** Control du CHPOINT: QUEPO1 563 : C 564 : C 565 : JGN=4 566 : JGM=IDIM 567 : SEGINI MLMCOM 568 : MLMCOM.MOTS(1)='P1DX' 569 : MLMCOM.MOTS(2)='P1DY' 570 : IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'P1DZ' 570 : CALL QUEPO1(IGRPC, ICEN, MLMCOM) 571 : IF(IERR .NE. 0)THEN 572 : IERR0 = IERR 573 : 574 : C 575 : C******* Message d'erreur standard 576 : C -301 0 %m1:40 577 : C 578 : MOTERR(1:40) = 'CHPO8 = ??? ' 579 : WRITE(IOIMP,*) MOTERR 580 : 581 : GOTO 9999 582 : ENDIF 583 : C 584 : C**** Lecture du CHPOINT IALPC 585 : C 586 : ICOND = 1 586 : CALL QUETYP(MTYPR,ICOND,IRETOU) 587 : IF(IERR .NE. 0)GOTO 9999 588 : IF(MTYPR .NE. 'CHPOINT ')THEN 589 : C 590 : C******* Message d'erreur standard 591 : C 37 2 592 : C On ne trouve pas d'objet de type %m1:8 593 : C 594 : MOTERR(1:8) = 'CHPOINT ' 594 : CALL ERREUR(37) 595 : GOTO 9999 596 : ELSE 597 : ICOND = 1 597 : CALL LIROBJ(MTYPR,IALPC,ICOND,IRETOU) 598 : IF (IERR.NE.0) GOTO 9999 599 : ENDIF 600 : C 601 : C**** Control du CHPOINT: QUEPO1 602 : C 603 : JGN=4 604 : JGM=1 605 : SEGINI MLMCOM 606 : MLMCOM.MOTS(1)= 'P1 ' 606 : CALL QUEPO1(IALPC, ICEN, MLMCOM) 607 : SEGSUP MLMCOM 608 : IF(IERR .NE. 0)THEN 609 : IERR0 = IERR 610 : 611 : C 612 : C******* Message d'erreur standard 613 : C -301 0 %m1:40 614 : C 615 : MOTERR(1:40) = 'CHPO9 = ??? ' 616 : WRITE(IOIMP,*) MOTERR 617 : 618 : GOTO 9999 619 : ENDIF 620 : C 621 : C**** Lecture du CHPOINT YC 622 : C 623 : IF(NESP .EQ. 0)THEN 624 : LYC = .FALSE. 625 : ELSEIF(NESP .GT. 0)THEN 626 : ICOND = 1 626 : CALL QUETYP(MTYPR,ICOND,IRETOU) 627 : IF(IERR .NE. 0)GOTO 9999 628 : IF(MTYPR .NE. 'CHPOINT ')THEN 629 : C 630 : C******* Message d'erreur standard 631 : C 37 2 632 : C On ne trouve pas d'objet de type %m1:8 633 : C 634 : MOTERR(1:8) = 'CHPOINT ' 634 : CALL ERREUR(37) 635 : GOTO 9999 636 : ELSE 637 : ICOND = 1 637 : CALL LIROBJ(MTYPR,IYC,ICOND,IRETOU) 638 : IF (IERR.NE.0) GOTO 9999 639 : LYC=.TRUE. 640 : ENDIF 641 : C 642 : C**** Control du CHPOINT 643 : C 643 : CALL QUEPO1(IYC, ICEN, MLMESP) 644 : IF(IERR .NE. 0)THEN 645 : IERR0 = IERR 646 : 647 : C 648 : C******* Message d'erreur standard 649 : C -301 0 %m1:40 650 : C 651 : MOTERR(1:40) = 'CHPO10 = ??? ' 652 : WRITE(IOIMP,*) MOTERR 653 : 654 : GOTO 9999 655 : ENDIF 656 : C 657 : C**** Lecture du CHPOINT GRADYC 658 : C 659 : ICOND = 1 659 : CALL QUETYP(MTYPR,ICOND,IRETOU) 660 : IF(IERR .NE. 0)GOTO 9999 661 : IF(MTYPR .NE. 'CHPOINT ')THEN 662 : C 663 : C******* Message d'erreur standard 664 : C 37 2 665 : C On ne trouve pas d'objet de type %m1:8 666 : C 667 : MOTERR(1:8) = 'CHPOINT ' 667 : CALL ERREUR(37) 668 : GOTO 9999 669 : ELSE 670 : ICOND = 1 670 : CALL LIROBJ(MTYPR,IGRYC,ICOND,IRETOU) 671 : IF (IERR.NE.0) GOTO 9999 672 : ENDIF 673 : C 674 : C**** Control du CHPOINT: QUEPO1 675 : C 676 : JGN=4 677 : JGM=IDIM*NESP 678 : SEGINI MLMCOM 679 : C NESP < 10 680 : IF(NESP .GE. 10)THEN 681 : WRITE(IOIMP,*) 'NESP >= 10!' 682 : C 683 : C******* Message d'erreur standard 684 : C 21 2 685 : C Données incompatibles 686 : C 686 : CALL ERREUR(21) 687 : GOTO 9999 688 : ENDIF 689 : C 690 : ICEL = 0 691 : DO I1 = 1, NESP, 1 692 : DO I2 = 1, IDIM 693 : ICEL = ICEL + 1 694 : ICOM = 3 * (I1 -1) + I2 695 : MLMCOM.MOTS(ICEL) = NOMGRA(ICOM) 696 : ENDDO 697 : ENDDO 697 : CALL QUEPO1(IGRYC, ICEN, MLMCOM) 698 : SEGSUP MLMCOM 699 : IF(IERR .NE. 0)THEN 700 : IERR0 = IERR 701 : 702 : C 703 : C******* Message d'erreur standard 704 : C -301 0 %m1:40 705 : C 706 : MOTERR(1:40) = 'CHPO11 = ??? ' 707 : WRITE(IOIMP,*) MOTERR 708 : 709 : GOTO 9999 710 : ENDIF 711 : C 712 : C**** Lecture du CHPOINT IALYC 713 : C 714 : ICOND = 1 714 : CALL QUETYP(MTYPR,ICOND,IRETOU) 715 : IF(IERR .NE. 0)GOTO 9999 716 : IF(MTYPR .NE. 'CHPOINT ')THEN 717 : C 718 : C******* Message d'erreur standard 719 : C 37 2 720 : C On ne trouve pas d'objet de type %m1:8 721 : C 722 : MOTERR(1:8) = 'CHPOINT ' 722 : CALL ERREUR(37) 723 : GOTO 9999 724 : ELSE 725 : ICOND = 1 725 : CALL LIROBJ(MTYPR,IALYC,ICOND,IRETOU) 726 : IF (IERR.NE.0) GOTO 9999 727 : ENDIF 728 : C 729 : C**** Control du CHPOINT: QUEPO1 730 : C 731 : JGN = 4 732 : JGM = NESP 733 : SEGINI MLMCOM 734 : DO I1 = 1, NESP, 1 735 : MLMCOM.MOTS(I1)=NOMLIM(I1) 736 : ENDDO 736 : CALL QUEPO1(IALYC, ICEN, MLMCOM) 737 : SEGSUP MLMCOM 738 : IF(IERR .NE. 0)THEN 739 : IERR0 = IERR 740 : 741 : C 742 : C******* Message d'erreur standard 743 : C -301 0 %m1:40 744 : C 745 : MOTERR(1:40) = 'CHPO12 = ??? ' 746 : WRITE(IOIMP,*) MOTERR 747 : 748 : GOTO 9999 749 : ENDIF 750 : ENDIF 751 : C 752 : C**** Lecture du CHPOINT ISCAC 753 : C 754 : IF(NSCA .EQ. 0)THEN 755 : LSCAC=.FALSE. 756 : ELSEIF(NSCA .GT. 0)THEN 757 : ICOND = 1 757 : CALL QUETYP(MTYPR,ICOND,IRETOU) 758 : IF(IERR .NE. 0)GOTO 9999 759 : IF(MTYPR .NE. 'CHPOINT ')THEN 760 : C 761 : C******* Message d'erreur standard 762 : C 37 2 763 : C On ne trouve pas d'objet de type %m1:8 764 : C 765 : MOTERR(1:8) = 'CHPOINT ' 765 : CALL ERREUR(37) 766 : GOTO 9999 767 : ELSE 768 : ICOND = 1 768 : CALL LIROBJ(MTYPR,ISCAC,ICOND,IRETOU) 769 : IF (IERR.NE.0) GOTO 9999 770 : LSCAC=.TRUE. 771 : ENDIF 772 : C 773 : C**** Control du CHPOINT 774 : C 774 : CALL QUEPO1(ISCAC, ICEN, MLMSCA) 775 : IF(IERR .NE. 0)THEN 776 : IERR0 = IERR 777 : 778 : C 779 : C******* Message d'erreur standard 780 : C -301 0 %m1:40 781 : C 782 : MOTERR(1:40) = 'CHPO13 = ??? ' 783 : WRITE(IOIMP,*) MOTERR 784 : 785 : GOTO 9999 786 : ENDIF 787 : C 788 : C**** Lecture du CHPOINT GRADSC 789 : C 790 : ICOND = 1 790 : CALL QUETYP(MTYPR,ICOND,IRETOU) 791 : IF(IERR .NE. 0)GOTO 9999 792 : IF(MTYPR .NE. 'CHPOINT ')THEN 793 : C 794 : C******* Message d'erreur standard 795 : C 37 2 796 : C On ne trouve pas d'objet de type %m1:8 797 : C 798 : MOTERR(1:8) = 'CHPOINT ' 798 : CALL ERREUR(37) 799 : GOTO 9999 800 : ELSE 801 : ICOND = 1 801 : CALL LIROBJ(MTYPR,IGRSC,ICOND,IRETOU) 802 : IF (IERR.NE.0) GOTO 9999 803 : ENDIF 804 : C 805 : C**** Control du CHPOINT: QUEPO1 806 : C 807 : JGN=4 808 : JGM=IDIM*NSCA 809 : SEGINI MLMCOM 810 : C NSCA < 10 811 : IF(NSCA .GE. 10)THEN 812 : WRITE(IOIMP,*) 'NSCA >= 10!' 813 : C 814 : C******* Message d'erreur standard 815 : C 21 2 816 : C Données incompatibles 817 : C 817 : CALL ERREUR(21) 818 : GOTO 9999 819 : ENDIF 820 : ICEL = 0 821 : DO I1 = 1, NSCA, 1 822 : DO I2 = 1, IDIM 823 : ICEL = ICEL + 1 824 : ICOM = 3 * (I1 -1) + I2 825 : MLMCOM.MOTS(ICEL) = NOMGRA(ICOM) 826 : ENDDO 827 : ENDDO 827 : CALL QUEPO1(IGRSC, ICEN, MLMCOM) 828 : SEGSUP MLMCOM 829 : IF(IERR .NE. 0)THEN 830 : IERR0 = IERR 831 : 832 : C 833 : C******* Message d'erreur standard 834 : C -301 0 %m1:40 835 : C 836 : MOTERR(1:40) = 'CHPO14 = ??? ' 837 : WRITE(IOIMP,*) MOTERR 838 : 839 : GOTO 9999 840 : ENDIF 841 : C 842 : C**** Lecture du CHPOINT IALSC 843 : C 844 : ICOND = 1 844 : CALL QUETYP(MTYPR,ICOND,IRETOU) 845 : IF(IERR .NE. 0)GOTO 9999 846 : IF(MTYPR .NE. 'CHPOINT ')THEN 847 : C 848 : C******* Message d'erreur standard 849 : C 37 2 850 : C On ne trouve pas d'objet de type %m1:8 851 : C 852 : MOTERR(1:8) = 'CHPOINT ' 852 : CALL ERREUR(37) 853 : GOTO 9999 854 : ELSE 855 : ICOND = 1 855 : CALL LIROBJ(MTYPR,IALSC,ICOND,IRETOU) 856 : IF (IERR.NE.0) GOTO 9999 857 : ENDIF 858 : C 859 : C**** Control du CHPOINT: QUEPO1 860 : C 861 : JGN = 4 862 : JGM = NSCA 863 : SEGINI MLMCOM 864 : DO I1 = 1, NSCA, 1 865 : MLMCOM.MOTS(I1)=NOMLIM(I1) 866 : ENDDO 866 : CALL QUEPO1(IALSC, ICEN, MLMCOM) 867 : SEGSUP MLMCOM 868 : IF(IERR .NE. 0)THEN 869 : IERR0 = IERR 870 : 871 : C 872 : C******* Message d'erreur standard 873 : C -301 0 %m1:40 874 : C 875 : MOTERR(1:40) = 'CHPO15 = ??? ' 876 : WRITE(IOIMP,*) MOTERR 877 : 878 : GOTO 9999 879 : ENDIF 880 : ENDIF 881 : IF(ORDTEM .EQ. 1)THEN 882 : LOGTEM = .FALSE. 883 : DELTAT = 0.0D0 884 : IGAMC = 0 885 : LGAMC=.FALSE. 886 : ELSE 887 : C 888 : C**** Lecture du CHPOINT GAMC (dans le cas 2-eme ordre en temps) 889 : C 890 : ICOND = 1 890 : CALL QUETYP(MTYPR,ICOND,IRETOU) 891 : IF(IERR .NE. 0)GOTO 9999 892 : IF(MTYPR .NE. 'CHPOINT ')THEN 893 : C 894 : C******* Message d'erreur standard 895 : C 37 2 896 : C On ne trouve pas d'objet de type %m1:8 897 : C 898 : MOTERR(1:8) = 'CHPOINT ' 898 : CALL ERREUR(37) 899 : GOTO 9999 900 : ELSE 901 : ICOND = 1 901 : CALL LIROBJ(MTYPR,IGAMC,ICOND,IRETOU) 902 : IF (IERR.NE.0) GOTO 9999 903 : LGAMC=.TRUE. 904 : ENDIF 905 : C 906 : C**** Control du CHPOINT 907 : C 908 : JGN=4 909 : JGM=1 910 : SEGINI MLMCOM 911 : MLMCOM.MOTS(1)= 'SCAL' 911 : CALL QUEPO1(IGAMC, ICEN, MLMCOM) 912 : SEGSUP MLMCOM 913 : IF(IERR .NE. 0)THEN 914 : IERR0 = IERR 915 : 916 : C 917 : C******* Message d'erreur standard 918 : C -301 0 %m1:40 919 : C 920 : MOTERR(1:40) = 'CHPO16 = ??? ' 921 : WRITE(IOIMP,*) MOTERR 922 : 923 : GOTO 9999 924 : ENDIF 925 : LOGTEM = .TRUE. 926 : ICOND = 1 926 : CALL LIRREE(DELTAT,ICOND,IRETOU) 927 : IF(IERR .NE. 0)GOTO 9999 928 : ENDIF 929 : C 930 : C**** Centre -> Face 931 : C 932 : IF(IDIM .EQ. 2)THEN 933 : C 934 : C******* Deux Dimensions, Mono/Multi Especes, 2-eme ordre en espace, 1er/2-eme ordre en 935 : C temps 936 : C 936 : CALL PRE321(LOGTEM,LGAMC,LYC,LSCAC, 937 : & ICEN,IFACE,IFACEL,INORM, 938 : & IROC, IGRROC, IALROC, 939 : & IVITC, IGRVC, IALVC, 940 : & IPC ,IGRPC, IALPC, 941 : & IYC ,IGRYC, IALYC, 942 : & ISCAC ,IGRSC, IALSC, 943 : & IGAMC, 944 : & DELTAT, 945 : & IROF,IVITF,IPF,IYF,ISCAF, 946 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 947 : ELSE 948 : C 949 : C******* Trois Dimensions, Mono/Multi Especes, 1er ordre en espace, 1er ordre en 950 : C temps 951 : C 951 : CALL PRE322(LOGTEM,LGAMC,LYC,LSCAC, 952 : & ICEN,IFACE,IFACEL,INORM, 953 : & IROC, IGRROC, IALROC, 954 : & IVITC, IGRVC, IALVC, 955 : & IPC ,IGRPC, IALPC, 956 : & IYC ,IGRYC, IALYC, 957 : & ISCAC ,IGRSC, IALSC, 958 : & IGAMC, 959 : & DELTAT, 960 : & IROF,IVITF,IPF,IYF,ISCAF, 961 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 962 : ENDIF 963 : C 964 : C**** Messages d'erreur 965 : C 966 : IF(LOGAN)THEN 967 : C 968 : C******* Anomalie detectée 969 : C 970 : C 971 : C******* Message d'erreur standard 972 : C -301 0 973 : C %m1:40 974 : C 975 : MOTERR(1:40) = MESERR(1:40) 976 : WRITE(IOIMP,*) MOTERR 977 : C 978 : C******* Message d'erreur standard 979 : C 5 3 980 : C Erreur anormale.contactez votre support 981 : C 981 : CALL ERREUR(5) 982 : GOTO 9999 983 : C 984 : ELSEIF(LOGNEG)THEN 985 : C 986 : C******* Message d'erreur standard 987 : C 41 2 988 : C %m1:8 = %r1 inférieur à %r2 989 : C 990 : MOTERR(1:8) = MESERR(1:8) 991 : REAERR(1) = REAL(VALER) 992 : REAERR(2) = 0.0 992 : CALL ERREUR(41) 993 : GOTO 9999 994 : ELSEIF(LOGBOR)THEN 995 : C 996 : C******* Message d'erreur standard 997 : C 42 2 998 : C %m1:8 = %r1 non compris entre %r2 et %r3 999 : C 1000 : MOTERR(1:8) = MESERR(1:8) 1001 : REAERR(1) = REAL(VALER) 1002 : REAERR(2) = REAL(VAL1) 1003 : REAERR(3) = REAL(VAL2) 1003 : CALL ERREUR(42) 1004 : GOTO 9999 1005 : ELSE 1006 : C 1007 : C******* Ecriture de ROF, VITF, PF, YF (si existe) 1008 : C 1009 : MTYPR = 'MCHAML' 1009 : IF(ISCAF .NE. 0) CALL ECROBJ(MTYPR,ISCAF) 1009 : IF(IYF .NE. 0) CALL ECROBJ(MTYPR,IYF) 1009 : CALL ECROBJ(MTYPR,IPF) 1009 : CALL ECROBJ(MTYPR,IVITF) 1009 : CALL ECROBJ(MTYPR,IROF) 1010 : ENDIF 1011 : C 1012 : 9999 CONTINUE 1013 : C 1014 : RETURN 1015 : END 1016 : 1017 : 1018 : 1019 : 1020 : 1021 : 1022 : 1023 : 1024 : 1025 : 1026 : 1027 : 1028 : 1029 :
© Cast3M 2003 - All rights reserved.
Disclaimer