1 : C PRE22 SOURCE BECC 10/10/07 21:15:14 6774 2 : SUBROUTINE PRE22(ORDTEM) 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : PRE22 8 : C 9 : C DESCRIPTION : Voir PRE2 10 : C 11 : C Gas gaz parfait, 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 IGAMF, IYF 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, QUEPOI, ECROBJ 27 : C 28 : C 29 : C APPELES (Calcul) : PRE221 (2D) 30 : C 31 : C 32 : C************************************************************************ 33 : C 34 : C HISTORIQUE (Anomalies et modifications éventuelles) 35 : C 36 : C HISTORIQUE : Créée le 10.7.98. 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, INDIC, NBCOMP 58 : & ,IDOMA, ICEN, IFACE, IFACEL, INORM 59 : & ,IROC, IGRROC, IALROC 60 : & ,IVITC, IGRVC, IALVC 61 : & ,IPC ,IGRPC, IALPC 62 : & ,IGAMC, IROF, IVITF, IPF, IGAMF 63 : & ,IPGAS, ICP, ICV, NESP, I1, JG 64 : & ,IYC, IGRYC, IALYC, IYF 65 : & ,JGM,JGN,MMODEL, I2, ICEL 66 : REAL*8 VALER, VAL1, VAL2, DELTAT, CP, CV 67 : CHARACTER*(4) NOMTOT(9), CELLCH 68 : CHARACTER*(8) MTYPR, TYPE 69 : CHARACTER*(40) MESERR 70 : CHARACTER*(4) NOMGRA(27),NOMLIM(9) 71 : LOGICAL LOGAN,LOGNEG, LOGBOR,LOGTEM 72 : C 73 : C**** Variables en ACCTAB 74 : C 75 : INTEGER IVALI, IRETI,IVALR, IRETR, INEFMD 76 : REAL*8 XVALI,XVALR 77 : LOGICAL LOGII, LOGIR 78 : CHARACTER*(8) CHARR,MTYPI 79 : C 80 : C**** Nom de composantes de gradients (HP. <= 9 composantes) 81 : C 82 : DATA NOMGRA /'P1DX','P1DY','P1DZ', 83 : & 'P2DX','P2DY','P2DZ', 84 : & 'P3DX','P3DY','P3DZ', 85 : & 'P4DX','P4DY','P4DZ', 86 : & 'P5DX','P5DY','P5DZ', 87 : & 'P6DX','P6DY','P6DZ', 88 : & 'P7DX','P7DY','P7DZ', 89 : & 'P8DX','P8DY','P8DZ', 90 : & 'P9DX','P9DY','P9DZ'/ 91 : C 92 : DATA NOMLIM /'P1 ', 93 : & 'P2 ', 94 : & 'P3 ', 95 : & 'P4 ', 96 : & 'P5 ', 97 : & 'P6 ', 98 : & 'P7 ', 99 : & 'P8 ', 100 : & 'P9 '/ 101 : C 102 : C**** Les Includes 103 : C 104 : -INC CCOPTIO 105 : -INC SMLMOTS 106 : -INC SMLREEL 107 : POINTEUR MLRECP.MLREEL, MLRECV.MLREEL 108 : POINTEUR MLMVIT.MLMOTS, MLMCOM.MLMOTS 109 : POINTEUR MLMESP.MLMOTS 110 : C 111 : C**** Initialisation des parametres d'erreur 112 : C 113 : LOGAN = .FALSE. 114 : LOGNEG = .FALSE. 115 : LOGBOR = .FALSE. 116 : MESERR = ' ' 117 : MOTERR(1:40) = MESERR(1:40) 118 : VALER = 0.0D0 119 : VAL1 = 0.0D0 120 : VAL2 = 0.0D0 121 : C 122 : C**** Initialisation des NOMTOT 123 : C 124 : NOMTOT(1) = ' ' 125 : NOMTOT(2) = ' ' 126 : NOMTOT(3) = ' ' 127 : NOMTOT(4) = ' ' 128 : NOMTOT(5) = ' ' 129 : NOMTOT(6) = ' ' 130 : NOMTOT(7) = ' ' 131 : NOMTOT(8) = ' ' 132 : NOMTOT(9) = ' ' 133 : C 134 : C**** Lecture de l'objet MODELE 135 : C 136 : ICOND = 1 136 : CALL QUETYP(TYPE,ICOND,IRETOU) 137 : 138 : IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN 139 : WRITE(6,*)' On attend un objet MMODEL' 140 : RETURN 141 : ENDIF 141 : CALL LIROBJ('MMODEL',MMODEL,ICOND,IRETOU) 142 : IF(IERR.NE.0)GOTO 9999 142 : CALL LEKMOD(MMODEL,IDOMA,INEFMD) 143 : IF(IERR.NE.0)GOTO 9999 144 : C 145 : C**** Lecture du MELEME SPG des points CENTRE. 146 : C 147 : C 147 : C CALL LEKTAB(IDOMA,'CENTRE',IP) 148 : C 149 : C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas, 150 : C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL' 151 : C -> la correspondance global des noeuds saut! 152 : C 153 : C On peut utilizer ACCTAB ou ACMO 154 : C 155 : MTYPR = 'MAILLAGE' 155 : CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN) 156 : IF(IERR.NE.0)GOTO 9999 157 : C 158 : C**** Lecture du MELEME 'FACE' 159 : C 160 : MTYPR = 'MAILLAGE' 160 : CALL ACMO(IDOMA,'FACE',MTYPR,IFACE) 161 : IF(IERR.NE.0)GOTO 9999 162 : C 163 : C**** Lecture du MELEME 'FACEL' 164 : C 165 : MTYPR = 'MAILLAGE' 165 : CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL) 166 : IF(IERR.NE.0)GOTO 9999 167 : C 168 : C**** Lecture du CHPOINT contenant les normales aux faces 169 : C 170 : IF(IDIM .EQ. 2)THEN 171 : C Que les normales 171 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 172 : IF(IERR .NE. 0) GOTO 9999 173 : JGN = 4 174 : JGM = 2 175 : SEGINI MLMVIT 176 : MLMVIT.MOTS(1) = 'UX ' 177 : MLMVIT.MOTS(2) = 'UY ' 177 : CALL QUEPO1(INORM, IFACE, MLMVIT) 178 : SEGSUP MLMVIT 179 : IF(IERR.NE.0)GOTO 9999 180 : ELSE 181 : C Les normales et les tangentes 182 : MTYPR = ' ' 182 : CALL ACMO(IDOMA,'MATROT',MTYPR,INORM) 183 : IF (MTYPR .NE. 'CHPOINT ') THEN 183 : CALL MATRAN(IDOMA,INORM) 184 : IF(IERR .NE. 0) GOTO 9999 185 : ENDIF 186 : JGN = 4 187 : JGM = 9 188 : SEGINI MLMVIT 189 : MLMVIT.MOTS(1) = 'UX ' 190 : MLMVIT.MOTS(2) = 'UY ' 191 : MLMVIT.MOTS(3) = 'UZ ' 192 : MLMVIT.MOTS(4) = 'RX ' 193 : MLMVIT.MOTS(5) = 'RY ' 194 : MLMVIT.MOTS(6) = 'RZ ' 195 : MLMVIT.MOTS(7) = 'MX ' 196 : MLMVIT.MOTS(8) = 'MY ' 197 : MLMVIT.MOTS(9) = 'MZ ' 197 : CALL QUEPO1(INORM, IFACE, MLMVIT) 198 : SEGSUP MLMVIT 199 : IF(IERR.NE.0)GOTO 9999 200 : C 201 : ENDIF 202 : C 203 : C**** N.B. On veut lire les objets sequentiellement. 204 : C Donc on utilise QUETYP pour controler que 205 : C le type de l'objet soit le bon. 206 : C 207 : C**** Lecture de la table des proprietes du gaz 208 : C 209 : ICOND = 1 209 : CALL QUETYP(MTYPR,ICOND,IRETOU) 210 : IF(IERR .NE. 0)GOTO 9999 211 : IF(MTYPR .NE. 'TABLE ')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) = 'TABLE ' 217 : CALL ERREUR(37) 218 : GOTO 9999 219 : ELSE 220 : ICOND = 1 220 : CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU) 221 : IF(IERR .NE. 0)GOTO 9999 222 : ENDIF 223 : C 224 : C N.B: la table des propietes des gaz a ete deja controlle en PRIMIT 225 : C donc on ne la controlle pas ici!!! 226 : C 227 : C**** Les CPs 228 : C 229 : MTYPR = ' ' 229 : CALL ACMO(IPGAS,'CP',MTYPR,ICP) 230 : IF(IERR .NE. 0)GOTO 9999 231 : C 232 : C**** Les CVs 233 : C 234 : MTYPR = ' ' 234 : CALL ACMO(IPGAS,'CV',MTYPR,ICV) 235 : IF(IERR .NE. 0)GOTO 9999 236 : C 237 : C**** Les especes qui sont dans les Equations d'Euler 238 : C 239 : MTYPR = ' ' 239 : CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMESP) 240 : IF(IERR .NE. 0)GOTO 9999 241 : C 242 : C**** Nom de l'espece qui n'est pas dans les equations d'Euler 243 : C 244 : MTYPI = 'MOT ' 245 : MTYPR = 'MOT ' 245 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE',LOGII,IRETI, 246 : & MTYPR,IVALR,XVALR,CELLCH,LOGIR,IRETR) 247 : IF(IERR .NE. 0)GOTO 9999 248 : C 249 : C**** Control de compatibilite des donnes de la table 250 : C et creation des LISTREELs avec CP et CV 251 : C 252 : SEGACT MLMESP 253 : C 254 : C**** NESP = nombre d'especes dans lesequation d'Euler 255 : C 256 : NESP = MLMESP.MOTS(/2) 257 : C 258 : C**** List de CP et CV 259 : C 260 : JG = NESP+1 261 : SEGINI MLRECP 262 : SEGINI MLRECV 263 : DO I1 = 1, NESP 264 : C 265 : C******* N.B. NOMTOT est un CHARACTER*(4) 266 : C 267 : NOMTOT(1) = MLMESP.MOTS(I1) 268 : C 268 : C******* CALL ACMF(ICP,NOMC,CP) ne marche pas parce que on a 269 : C des blanches dans nos composantes 270 : C 271 : MTYPI = 'MOT ' 272 : MTYPR = ' ' 272 : CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,NOMTOT(1), LOGII,IRETI, 273 : & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR) 274 : IF(IERR .NE. 0)GOTO 9999 275 : MLRECP.PROG(I1) = CP 276 : C 277 : MTYPI = 'MOT ' 278 : MTYPR = ' ' 278 : CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,NOMTOT(1), LOGII,IRETI, 279 : & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR) 280 : IF(IERR .NE. 0)GOTO 9999 281 : MLRECV.PROG(I1) = CV 282 : ENDDO 283 : MTYPI = 'MOT ' 284 : MTYPR = ' ' 284 : CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI, 285 : & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR) 286 : IF(IERR .NE. 0)GOTO 9999 287 : MLRECP.PROG(JG) = CP 288 : C 289 : MTYPI = 'MOT ' 290 : MTYPR = ' ' 290 : CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI, 291 : & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR) 292 : IF(IERR .NE. 0)GOTO 9999 293 : MLRECV.PROG(JG) = CV 294 : C 295 : C**** Lecture du CHPOINT ROC 296 : C 297 : ICOND = 1 297 : CALL QUETYP(MTYPR,ICOND,IRETOU) 298 : IF(IERR .NE. 0)GOTO 9999 299 : IF(MTYPR .NE. 'CHPOINT ')THEN 300 : C 301 : C******* Message d'erreur standard 302 : C 37 2 303 : C On ne trouve pas d'objet de type %m1:8 304 : C 305 : MOTERR(1:8) = 'CHPOINT ' 305 : CALL ERREUR(37) 306 : GOTO 9999 307 : ELSE 308 : ICOND = 1 308 : CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU) 309 : IF(IERR .NE. 0)GOTO 9999 310 : ENDIF 311 : C 312 : C**** Control du CHPOINT: QUEPOI 313 : C 314 : C INDIC = 1 -> on impose le pointeur du support geometrique (IM1) 315 : C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1) 316 : C 317 : C NBCOMP > 0 -> numero des composantes 318 : C 319 : C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes 320 : C 321 : INDIC = 1 322 : NBCOMP = 1 323 : NOMTOT(1) = 'SCAL' 323 : CALL QUEPOI(IROC, ICEN, INDIC, NBCOMP, NOMTOT) 324 : IF(IERR .NE. 0)THEN 325 : IERR0 = IERR 326 : 327 : C 328 : C******* Message d'erreur standard 329 : C -301 0 %m1:40 330 : C 331 : MOTERR(1:40) = 'CHPO1 = ??? ' 331 : CALL ERREUR(-301) 332 : 333 : GOTO 9999 334 : ENDIF 335 : C 336 : C**** Lecture du CHPOINT GRADROC 337 : C 338 : ICOND = 1 338 : CALL QUETYP(MTYPR,ICOND,IRETOU) 339 : IF(IERR .NE. 0)GOTO 9999 340 : IF(MTYPR .NE. 'CHPOINT ')THEN 341 : C 342 : C******* Message d'erreur standard 343 : C 37 2 344 : C On ne trouve pas d'objet de type %m1:8 345 : C 346 : MOTERR(1:8) = 'CHPOINT ' 346 : CALL ERREUR(37) 347 : GOTO 9999 348 : ELSE 349 : ICOND = 1 349 : CALL LIROBJ(MTYPR,IGRROC,ICOND,IRETOU) 350 : IF (IERR.NE.0) GOTO 9999 351 : ENDIF 352 : C 353 : C**** Control du CHPOINT: QUEPOI 354 : C 355 : C INDIC = 1 -> on impose le pointeur du support geometrique (IM1) 356 : C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1) 357 : C 358 : C NBCOMP = 2 -> on teste le noms des composantes 359 : C 360 : C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes 361 : C 362 : JGN=4 363 : JGM=IDIM 364 : SEGINI MLMCOM 365 : MLMCOM.MOTS(1)='P1DX' 366 : MLMCOM.MOTS(2)='P1DY' 367 : IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'P1DZ' 367 : CALL QUEPO1(IGRROC, ICEN, MLMCOM) 368 : SEGSUP MLMCOM 369 : IF(IERR .NE. 0)THEN 370 : IERR0 = IERR 371 : 372 : C 373 : C******* Message d'erreur standard 374 : C -301 0 %m1:40 375 : C 376 : MOTERR(1:40) = 'CHPO2 = ??? ' 376 : CALL ERREUR(-301) 377 : 378 : GOTO 9999 379 : ENDIF 380 : C 381 : C**** Lecture du CHPOINT IALROC 382 : C 383 : ICOND = 1 383 : CALL QUETYP(MTYPR,ICOND,IRETOU) 384 : IF(IERR .NE. 0)GOTO 9999 385 : IF(MTYPR .NE. 'CHPOINT ')THEN 386 : C 387 : C******* Message d'erreur standard 388 : C 37 2 389 : C On ne trouve pas d'objet de type %m1:8 390 : C 391 : MOTERR(1:8) = 'CHPOINT ' 391 : CALL ERREUR(37) 392 : GOTO 9999 393 : ELSE 394 : ICOND = 1 394 : CALL LIROBJ(MTYPR,IALROC,ICOND,IRETOU) 395 : IF (IERR.NE.0) GOTO 9999 396 : ENDIF 397 : C 398 : C**** Control du CHPOINT: QUEPOI 399 : C 400 : INDIC = 1 401 : NBCOMP = 1 402 : NOMTOT(1) = 'P1' 402 : CALL QUEPOI(IALROC, ICEN, INDIC, NBCOMP, NOMTOT) 403 : IF(IERR .NE. 0)THEN 404 : IERR0 = IERR 405 : 406 : C 407 : C******* Message d'erreur standard 408 : C -301 0 %m1:40 409 : C 410 : MOTERR(1:40) = 'CHPO3 = ??? ' 410 : CALL ERREUR(-301) 411 : 412 : GOTO 9999 413 : ENDIF 414 : C 415 : C 416 : C**** Lecture du CHPOINT VITC 417 : C 418 : ICOND = 1 418 : CALL QUETYP(MTYPR,ICOND,IRETOU) 419 : IF(IERR .NE. 0)GOTO 9999 420 : IF(MTYPR .NE. 'CHPOINT ')THEN 421 : C 422 : C******* Message d'erreur standard 423 : C 37 2 424 : C On ne trouve pas d'objet de type %m1:8 425 : C 426 : MOTERR(1:8) = 'CHPOINT ' 426 : CALL ERREUR(37) 427 : GOTO 9999 428 : ELSE 429 : ICOND = 1 429 : CALL LIROBJ(MTYPR,IVITC,ICOND,IRETOU) 430 : IF (IERR.NE.0) GOTO 9999 431 : ENDIF 432 : C 433 : C**** Control du CHPOINT 434 : C 435 : JGN=4 436 : JGM=IDIM 437 : SEGINI MLMCOM 438 : MLMCOM.MOTS(1) = 'UX ' 439 : MLMCOM.MOTS(2) = 'UY ' 440 : IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'UZ ' 440 : CALL QUEPO1(IVITC, ICEN, MLMCOM) 441 : SEGSUP MLMCOM 442 : IF(IERR .NE. 0)THEN 443 : IERR0 = IERR 444 : 445 : C 446 : C******* Message d'erreur standard 447 : C -301 0 %m1:40 448 : C 449 : MOTERR(1:40) = 'CHPO4 = ??? ' 449 : CALL ERREUR(-301) 450 : 451 : GOTO 9999 452 : ENDIF 453 : C 454 : C**** Lecture du CHPOINT GRADVITC 455 : C 456 : ICOND = 1 456 : CALL QUETYP(MTYPR,ICOND,IRETOU) 457 : IF(IERR .NE. 0)GOTO 9999 458 : IF(MTYPR .NE. 'CHPOINT ')THEN 459 : C 460 : C******* Message d'erreur standard 461 : C 37 2 462 : C On ne trouve pas d'objet de type %m1:8 463 : C 464 : MOTERR(1:8) = 'CHPOINT ' 464 : CALL ERREUR(37) 465 : GOTO 9999 466 : ELSE 467 : ICOND = 1 467 : CALL LIROBJ(MTYPR,IGRVC,ICOND,IRETOU) 468 : IF (IERR.NE.0) GOTO 9999 469 : ENDIF 470 : C 471 : C**** Control du CHPOINT: QUEPOI 472 : C 473 : JGN=4 474 : IF(IDIM .EQ. 2)THEN 475 : JGM=4 476 : SEGINI MLMCOM 477 : MLMCOM.MOTS(1) = 'P1DX' 478 : MLMCOM.MOTS(2) = 'P1DY' 479 : MLMCOM.MOTS(3) = 'P2DX' 480 : MLMCOM.MOTS(4) = 'P2DY' 481 : ELSE 482 : JGM=9 483 : SEGINI MLMCOM 484 : MLMCOM.MOTS(1) = 'P1DX' 485 : MLMCOM.MOTS(2) = 'P1DY' 486 : MLMCOM.MOTS(3) = 'P1DZ' 487 : MLMCOM.MOTS(4) = 'P2DX' 488 : MLMCOM.MOTS(5) = 'P2DY' 489 : MLMCOM.MOTS(6) = 'P2DZ' 490 : MLMCOM.MOTS(7) = 'P3DX' 491 : MLMCOM.MOTS(8) = 'P3DY' 492 : MLMCOM.MOTS(9) = 'P3DZ' 493 : ENDIF 493 : CALL QUEPO1(IGRVC, 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) = 'CHPO5 = ??? ' 502 : CALL ERREUR(-301) 503 : 504 : GOTO 9999 505 : ENDIF 506 : C 507 : C**** Lecture du CHPOINT IALVC 508 : C 509 : ICOND = 1 509 : CALL QUETYP(MTYPR,ICOND,IRETOU) 510 : IF(IERR .NE. 0)GOTO 9999 511 : IF(MTYPR .NE. 'CHPOINT ')THEN 512 : C 513 : C******* Message d'erreur standard 514 : C 37 2 515 : C On ne trouve pas d'objet de type %m1:8 516 : C 517 : MOTERR(1:8) = 'CHPOINT ' 517 : CALL ERREUR(37) 518 : GOTO 9999 519 : ELSE 520 : ICOND = 1 520 : CALL LIROBJ(MTYPR,IALVC,ICOND,IRETOU) 521 : IF (IERR.NE.0) GOTO 9999 522 : ENDIF 523 : C 524 : C**** Control du CHPOINT: QUEPOI 525 : C 526 : JGN=4 527 : JGM=IDIM 528 : SEGINI MLMCOM 529 : MLMCOM.MOTS(1) = 'P1 ' 530 : MLMCOM.MOTS(2) = 'P2 ' 531 : IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'P3 ' 531 : CALL QUEPO1(IALVC, ICEN, MLMCOM) 532 : SEGSUP MLMCOM 533 : IF(IERR .NE. 0)THEN 534 : IERR0 = IERR 535 : 536 : C 537 : C******* Message d'erreur standard 538 : C -301 0 %m1:40 539 : C 540 : MOTERR(1:40) = 'CHPO6 = ??? ' 540 : CALL ERREUR(-301) 541 : 542 : GOTO 9999 543 : ENDIF 544 : C 545 : C**** Lecture du CHPOINT PC 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,IPC,ICOND,IRETOU) 559 : IF (IERR.NE.0) GOTO 9999 560 : ENDIF 561 : C 562 : C**** Control du CHPOINT 563 : C 564 : INDIC = 1 565 : NBCOMP = 1 566 : NOMTOT(1) = 'SCAL' 566 : CALL QUEPOI(IPC, ICEN, INDIC, NBCOMP, NOMTOT) 567 : IF(IERR .NE. 0)THEN 568 : IERR0 = IERR 569 : 570 : C 571 : C******* Message d'erreur standard 572 : C -301 0 %m1:40 573 : C 574 : MOTERR(1:40) = 'CHPO7 = ??? ' 574 : CALL ERREUR(-301) 575 : 576 : GOTO 9999 577 : ENDIF 578 : C 579 : C**** Lecture du CHPOINT GRADPC 580 : C 581 : ICOND = 1 581 : CALL QUETYP(MTYPR,ICOND,IRETOU) 582 : IF(IERR .NE. 0)GOTO 9999 583 : IF(MTYPR .NE. 'CHPOINT ')THEN 584 : C 585 : C******* Message d'erreur standard 586 : C 37 2 587 : C On ne trouve pas d'objet de type %m1:8 588 : C 589 : MOTERR(1:8) = 'CHPOINT ' 589 : CALL ERREUR(37) 590 : GOTO 9999 591 : ELSE 592 : ICOND = 1 592 : CALL LIROBJ(MTYPR,IGRPC,ICOND,IRETOU) 593 : IF (IERR.NE.0) GOTO 9999 594 : ENDIF 595 : C 596 : C**** Control du CHPOINT: QUEPOI 597 : C 598 : C 599 : JGN=4 600 : JGM=IDIM 601 : SEGINI MLMCOM 602 : MLMCOM.MOTS(1)='P1DX' 603 : MLMCOM.MOTS(2)='P1DY' 604 : IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'P1DZ' 604 : CALL QUEPO1(IGRPC, ICEN, MLMCOM) 605 : IF(IERR .NE. 0)THEN 606 : IERR0 = IERR 607 : 608 : C 609 : C******* Message d'erreur standard 610 : C -301 0 %m1:40 611 : C 612 : MOTERR(1:40) = 'CHPO8 = ??? ' 612 : CALL ERREUR(-301) 613 : 614 : GOTO 9999 615 : ENDIF 616 : C 617 : C**** Lecture du CHPOINT IALPC 618 : C 619 : ICOND = 1 619 : CALL QUETYP(MTYPR,ICOND,IRETOU) 620 : IF(IERR .NE. 0)GOTO 9999 621 : IF(MTYPR .NE. 'CHPOINT ')THEN 622 : C 623 : C******* Message d'erreur standard 624 : C 37 2 625 : C On ne trouve pas d'objet de type %m1:8 626 : C 627 : MOTERR(1:8) = 'CHPOINT ' 627 : CALL ERREUR(37) 628 : GOTO 9999 629 : ELSE 630 : ICOND = 1 630 : CALL LIROBJ(MTYPR,IALPC,ICOND,IRETOU) 631 : IF (IERR.NE.0) GOTO 9999 632 : ENDIF 633 : C 634 : C**** Control du CHPOINT: QUEPOI 635 : C 636 : INDIC = 1 637 : NBCOMP = 1 638 : NOMTOT(1) = 'P1' 638 : CALL QUEPOI(IALPC, ICEN, INDIC, NBCOMP, NOMTOT) 639 : IF(IERR .NE. 0)THEN 640 : IERR0 = IERR 641 : 642 : C 643 : C******* Message d'erreur standard 644 : C -301 0 %m1:40 645 : C 646 : MOTERR(1:40) = 'CHPO9 = ??? ' 646 : CALL ERREUR(-301) 647 : 648 : GOTO 9999 649 : ENDIF 650 : C 651 : C**** Lecture du CHPOINT YC 652 : C 653 : ICOND = 1 653 : CALL QUETYP(MTYPR,ICOND,IRETOU) 654 : IF(IERR .NE. 0)GOTO 9999 655 : IF(MTYPR .NE. 'CHPOINT ')THEN 656 : C 657 : C******* Message d'erreur standard 658 : C 37 2 659 : C On ne trouve pas d'objet de type %m1:8 660 : C 661 : MOTERR(1:8) = 'CHPOINT ' 661 : CALL ERREUR(37) 662 : GOTO 9999 663 : ELSE 664 : ICOND = 1 664 : CALL LIROBJ(MTYPR,IYC,ICOND,IRETOU) 665 : IF (IERR.NE.0) GOTO 9999 666 : ENDIF 667 : C 668 : C**** Control du CHPOINT 669 : C 669 : CALL QUEPO1(IYC, ICEN, MLMESP) 670 : IF(IERR .NE. 0)THEN 671 : IERR0 = IERR 672 : 673 : C 674 : C******* Message d'erreur standard 675 : C -301 0 %m1:40 676 : C 677 : MOTERR(1:40) = 'CHPO10 = ??? ' 677 : CALL ERREUR(-301) 678 : 679 : GOTO 9999 680 : ENDIF 681 : C 682 : C**** Lecture du CHPOINT GRADYC 683 : C 684 : ICOND = 1 684 : CALL QUETYP(MTYPR,ICOND,IRETOU) 685 : IF(IERR .NE. 0)GOTO 9999 686 : IF(MTYPR .NE. 'CHPOINT ')THEN 687 : C 688 : C******* Message d'erreur standard 689 : C 37 2 690 : C On ne trouve pas d'objet de type %m1:8 691 : C 692 : MOTERR(1:8) = 'CHPOINT ' 692 : CALL ERREUR(37) 693 : GOTO 9999 694 : ELSE 695 : ICOND = 1 695 : CALL LIROBJ(MTYPR,IGRYC,ICOND,IRETOU) 696 : IF (IERR.NE.0) GOTO 9999 697 : ENDIF 698 : C 699 : C**** Control du CHPOINT: QUEPOI 700 : C 701 : JGN=4 702 : JGM=IDIM*NESP 703 : SEGINI MLMCOM 704 : C NESP < 10 705 : IF(NESP .GE. 10)THEN 706 : WRITE(IOIMP,*) 'NESP >= 10!' 707 : C 708 : C******* Message d'erreur standard 709 : C 21 2 710 : C Données incompatibles 711 : C 711 : CALL ERREUR(21) 712 : GOTO 9999 713 : ENDIF 714 : C 715 : ICEL = 0 716 : DO I1 = 1, NESP, 1 717 : DO I2 = 1, IDIM 718 : ICEL = ICEL + 1 719 : ICOM = 3 * (I1 -1) + I2 720 : MLMCOM.MOTS(ICEL) = NOMGRA(ICOM) 721 : ENDDO 722 : ENDDO 722 : CALL QUEPO1(IGRYC, ICEN, MLMCOM) 723 : SEGSUP MLMCOM 724 : IF(IERR .NE. 0)THEN 725 : IERR0 = IERR 726 : 727 : C 728 : C******* Message d'erreur standard 729 : C -301 0 %m1:40 730 : C 731 : MOTERR(1:40) = 'CHPO11 = ??? ' 731 : CALL ERREUR(-301) 732 : 733 : GOTO 9999 734 : ENDIF 735 : C 736 : C**** Lecture du CHPOINT IALYC 737 : C 738 : ICOND = 1 738 : CALL QUETYP(MTYPR,ICOND,IRETOU) 739 : IF(IERR .NE. 0)GOTO 9999 740 : IF(MTYPR .NE. 'CHPOINT ')THEN 741 : C 742 : C******* Message d'erreur standard 743 : C 37 2 744 : C On ne trouve pas d'objet de type %m1:8 745 : C 746 : MOTERR(1:8) = 'CHPOINT ' 746 : CALL ERREUR(37) 747 : GOTO 9999 748 : ELSE 749 : ICOND = 1 749 : CALL LIROBJ(MTYPR,IALYC,ICOND,IRETOU) 750 : IF (IERR.NE.0) GOTO 9999 751 : ENDIF 752 : C 753 : C**** Control du CHPOINT: QUEPOI 754 : C 755 : JGN = 4 756 : JGM = NESP 757 : SEGINI MLMCOM 758 : DO I1 = 1, NESP, 1 759 : MLMCOM.MOTS(I1)=NOMLIM(I1) 760 : ENDDO 760 : CALL QUEPO1(IALYC, ICEN, MLMCOM) 761 : SEGSUP MLMCOM 762 : IF(IERR .NE. 0)THEN 763 : IERR0 = IERR 764 : 765 : C 766 : C******* Message d'erreur standard 767 : C -301 0 %m1:40 768 : C 769 : MOTERR(1:40) = 'CHPO12 = ??? ' 769 : CALL ERREUR(-301) 770 : 771 : GOTO 9999 772 : ENDIF 773 : C 774 : C**** Lecture du CHPOINT GAMC 775 : C 776 : ICOND = 1 776 : CALL QUETYP(MTYPR,ICOND,IRETOU) 777 : IF(IERR .NE. 0)GOTO 9999 778 : IF(MTYPR .NE. 'CHPOINT ')THEN 779 : C 780 : C******* Message d'erreur standard 781 : C 37 2 782 : C On ne trouve pas d'objet de type %m1:8 783 : C 784 : MOTERR(1:8) = 'CHPOINT ' 784 : CALL ERREUR(37) 785 : GOTO 9999 786 : ELSE 787 : ICOND = 1 787 : CALL LIROBJ(MTYPR,IGAMC,ICOND,IRETOU) 788 : IF (IERR.NE.0) GOTO 9999 789 : ENDIF 790 : C 791 : C**** Control du CHPOINT 792 : C 793 : INDIC = 1 794 : NBCOMP = 1 795 : NOMTOT(1) = 'SCAL' 795 : CALL QUEPOI(IGAMC, ICEN, INDIC, NBCOMP, NOMTOT) 796 : IF(IERR .NE. 0)THEN 797 : IERR0 = IERR 798 : 799 : C 800 : C******* Message d'erreur standard 801 : C -301 0 %m1:40 802 : C 803 : MOTERR(1:40) = 'CHPO10 = ??? ' 803 : CALL ERREUR(-301) 804 : 805 : GOTO 9999 806 : ENDIF 807 : IF(ORDTEM .EQ. 1)THEN 808 : C 809 : C******* Deux Dimensions, Une Espece, 2er ordre en espace, 1er ordre en 810 : C temps 811 : C 812 : LOGTEM = .FALSE. 813 : DELTAT = 0.0D0 814 : ELSE 815 : LOGTEM = .TRUE. 816 : ICOND = 1 816 : CALL LIRREE(DELTAT,ICOND,IRETOU) 817 : IF(IERR .NE. 0)GOTO 9999 818 : ENDIF 819 : IF(IDIM .EQ. 2)THEN 820 : C 821 : C******* Deux Dimensions, Une Espece, 1er ordre en espace, 1er ordre en 822 : C temps 823 : C 823 : CALL PRE221(LOGTEM, 824 : & ICEN,IFACE,IFACEL,INORM, 825 : & IROC, IGRROC, IALROC, 826 : & IVITC, IGRVC, IALVC, 827 : & IPC ,IGRPC, IALPC, 828 : & MLRECV, MLRECP, MLMESP, 829 : & IYC ,IGRYC, IALYC, 830 : & IGAMC, 831 : & DELTAT, 832 : & IROF,IVITF,IPF,IGAMF,IYF, 833 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 834 : ELSE 835 : C 836 : C******* Trois Dimensions, Une Espece, 1er ordre en espace, 1er ordre en 837 : C temps 838 : C 838 : CALL PRE222(LOGTEM, 839 : & ICEN,IFACE,IFACEL,INORM, 840 : & IROC, IGRROC, IALROC, 841 : & IVITC, IGRVC, IALVC, 842 : & IPC ,IGRPC, IALPC, 843 : & MLRECV, MLRECP, MLMESP, 844 : & IYC ,IGRYC, IALYC, 845 : & IGAMC, 846 : & DELTAT, 847 : & IROF,IVITF,IPF,IGAMF,IYF, 848 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 849 : ENDIF 850 : C 851 : C**** Messages d'erreur 852 : C 853 : IF(LOGAN)THEN 854 : C 855 : C******* Anomalie detectée 856 : C 857 : C 858 : C******* Message d'erreur standard 859 : C -301 0 860 : C %m1:40 861 : C 862 : MOTERR(1:40) = MESERR(1:40) 862 : CALL ERREUR(-301) 863 : C 864 : C******* Message d'erreur standard 865 : C 5 3 866 : C Erreur anormale.contactez votre support 867 : C 867 : CALL ERREUR(5) 868 : GOTO 9999 869 : C 870 : ELSEIF(LOGNEG)THEN 871 : C 872 : C******* Message d'erreur standard 873 : C 41 2 874 : C %m1:8 = %r1 inférieur à %r2 875 : C 876 : MOTERR(1:8) = MESERR(1:8) 877 : REAERR(1) = REAL(VALER) 878 : REAERR(2) = 0.0 878 : CALL ERREUR(41) 879 : GOTO 9999 880 : ELSEIF(LOGBOR)THEN 881 : C 882 : C******* Message d'erreur standard 883 : C 42 2 884 : C %m1:8 = %r1 non compris entre %r2 et %r3 885 : C 886 : MOTERR(1:8) = MESERR(1:8) 887 : REAERR(1) = REAL(VALER) 888 : REAERR(2) = REAL(VAL1) 889 : REAERR(3) = REAL(VAL2) 889 : CALL ERREUR(42) 890 : GOTO 9999 891 : ELSE 892 : C 893 : C******* Ecriture de ROF, VITF, PF, YF, GAMMAF 894 : C 895 : MTYPR = 'MCHAML' 895 : CALL ECROBJ(MTYPR,IGAMF) 895 : CALL ECROBJ(MTYPR,IYF) 895 : CALL ECROBJ(MTYPR,IPF) 895 : CALL ECROBJ(MTYPR,IVITF) 895 : CALL ECROBJ(MTYPR,IROF) 896 : ENDIF 897 : C 898 : SEGSUP MLRECP 899 : SEGSUP MLRECV 900 : SEGDES MLMESP 901 : C 902 : 9999 CONTINUE 903 : C 904 : RETURN 905 : END 906 : 907 : 908 : 909 : 910 : 911 : 912 : 913 : 914 : 915 : 916 : 917 : 918 :
© Cast3M 2003 - All rights reserved.
Disclaimer