1 : C ZLAP11 SOURCE MAGN 09/07/30 21:23:33 6458 2 : SUBROUTINE ZLAP11() 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : ZLAP11 8 : C 9 : C DESCRIPTION : Voir YLAPL1 10 : C 11 : C 12 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 13 : C 14 : C AUTEURS : A. BECCANTINI, DRN/DMT/SEMT/LTMF 15 : C Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 16 : C mél : gounand@semt2.smts.cea.frC 17 : C************************************************************************ 18 : C 19 : C 20 : C APPELES (E/S) : LIRMOT, ERREUR 21 : C 22 : C 23 : C APPELES : 24 : C 25 : C************************************************************************ 26 : C*** ENTREE / SORTIE (voir Phrase d'appel GIBIANE) 27 : C*********************************************************************** 28 : C HISTORIQUE (Anomalies et modifications éventuelles) 29 : C HISTORIQUE : 3.12.03 - added option for discretisation of 30 : C the diffusive terms in k-\eps equations 31 : C (explicit) 32 : C 12.1.04 - deliberatly put all the formation enthalpies 33 : C to 0.0D0; these contributions will be 34 : C positioned in the source term 35 : C************************************************************************ 36 : C 37 : IMPLICIT INTEGER(I-N) 38 : -INC CCOPTIO 39 : -INC SMMATRIK 40 : INTEGER NKID,NKMT,NMATRI,NRIGE 41 : -INC SMCHPOI 42 : POINTEUR MU.MCHPOI, MUT.MCHPOI, MUN.MCHPOI 43 : POINTEUR KAPPA.MCHPOI 44 : POINTEUR CVTOT.MCHPOI 45 : -INC SMLREEL 46 : -INC SMLMOTS 47 : POINTEUR MLMOEU.MLMOTS 48 : POINTEUR MLMNOM.MLMOTS 49 : POINTEUR MLDEFO.MLMOTS 50 : INTEGER JGM,JGN 51 : -INC SMCHAML 52 : POINTEUR ICOGRV.MCHELM 53 : POINTEUR ICOGRT.MCHELM 54 : -INC SMTABLE 55 : POINTEUR IPGAZ.MTABLE 56 : C 57 : C**** Variables pour ACCTAB 58 : C 59 : INTEGER IVALI, IRETI,IVALR, IRETR 60 : REAL*8 XVALI, XVALR 61 : LOGICAL LOGII, LOGIR 62 : CHARACTER*(8) MTYPI, MTYPR, CHARR 63 : C 64 : C**** Segment des caractéristiques du gaz 65 : C 66 : SEGMENT PROPHY 67 : CHARACTER*4 NOMESP(NESP+1) 68 : REAL*8 CV(NESP+1) 69 : REAL*8 R(NESP+1) 70 : REAL*8 H0K(NESP+1) 71 : POINTEUR CDIFF(NESP+1).MCHPOI 72 : POINTEUR YK(NESP+1).MCHPOI 73 : POINTEUR GRADYK(NESP+1).MCHPOI 74 : POINTEUR CGRYK(NESP+1).MCHELM 75 : POINTEUR CLYK(NESP+1).MCHPOI 76 : ENDSEGMENT 77 : INTEGER NESP 78 : C 79 : C**** Variables du programme 80 : C 81 : INTEGER IESP 82 : INTEGER ICELL, IRET, INDIC, NBCOMP 83 : & , IDOMA, MELEMC, MELEMF, MELEFL, ICHPSU, ICHPDI, ICHPVO 84 : & , INORM, IGRKEP 85 : & , IRN, IVN, ITN, IGRVN, IGRTN 86 : & , IVNIMP, ITAUIM, ITIMP,IQIMP,IRIMP 87 : & , ILIINC, NC, INEFMD, ICOND 88 : & , IJACO, ICHRES, NSOUPO,I1,NORD,NORDP1,IKEPS 89 : INTEGER ICHFLU,ICHFL2,ICHFL3,ICHTM1,ICHTMP 90 : REAL*8 DELTAT,DELTA2,DELTA3,TSIGK,TSIGE 91 : CHARACTER*(40) MESERR 92 : CHARACTER*4 NOMMOT, MOT, LFLUX(2), LIMPL(2) 93 : CHARACTER*8 TYPE 94 : LOGICAL LOGRES,LOGIMP,LOGAN 95 : C 96 : DATA LFLUX/'FLUX','RESI'/ 97 : DATA LIMPL/'EXPL','IMPL'/ 98 : C 99 : C**** Initialisation des variables pour la gestion des erreurs. 100 : C 101 : MESERR = ' ' 102 : LOGAN = .FALSE. 103 : IKEPS = 0 104 : C 105 : C******* Flux ou residu? 106 : C 106 : CALL LIRMOT(LFLUX,2,ICELL,1) 107 : IF(IERR .NE. 0)GOTO 9999 108 : IF(ICELL .EQ. 1)THEN 109 : LOGRES = .FALSE. 110 : ELSEIF(ICELL .EQ. 2)THEN 111 : LOGRES = .TRUE. 112 : ELSE 113 : C 114 : C******** Message d'erreur standard 115 : C 251 2 116 : C Tentative d'utilisation d'une option non implémentée 117 : C 117 : CALL ERREUR(251) 118 : ENDIF 119 : C 120 : C 120 : CALL LIRMOT(LIMPL,2,ICELL,1) 121 : IF(IERR .NE. 0)GOTO 9999 122 : IF(ICELL .EQ. 1)THEN 123 : LOGIMP=.FALSE. 124 : ELSEIF(ICELL .EQ. 2)THEN 125 : LOGIMP=.TRUE. 126 : ELSE 127 : WRITE(IOIMP,*) 'Erreur de programmation' 127 : CALL ERREUR(5) 128 : GOTO 9999 129 : ENDIF 130 : C 131 : C********************************** 132 : C**** Lecture de l'objet MODELE *** 133 : C********************************** 134 : C 135 : ICOND = 1 135 : CALL QUETYP(TYPE,ICOND,IRET) 136 : 137 : IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN 138 : WRITE(6,*)' On attend un objet MMODEL' 139 : RETURN 140 : ENDIF 140 : CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET) 141 : IF(IERR.NE.0)GOTO 9999 141 : CALL LEKMOD(MMODEL,IDOMA,INEFMD) 142 : IF(IERR.NE.0)GOTO 9999 143 : C 144 : C**** Centre, FACE et FACEL 145 : C 145 : CALL LEKTAB(IDOMA,'CENTRE',MELEMC) 146 : IF(IERR .NE. 0) GOTO 9999 147 : C 147 : CALL LEKTAB(IDOMA,'FACE',MELEMF) 148 : IF(IERR .NE. 0) GOTO 9999 149 : C 149 : CALL LEKTAB(IDOMA,'FACEL',MELEFL) 150 : IF(IERR .NE. 0) GOTO 9999 151 : C 152 : C**** Lecture du CHPOINT contenant les surfaces des faces. 153 : C 153 : CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU) 154 : IF(IERR .NE. 0) GOTO 9999 155 : C 156 : C**** Lecture du CHPOINT contenant les diametres minimums. 157 : C 157 : CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI) 158 : IF(IERR .NE. 0) GOTO 9999 159 : C 160 : C**** Lecture du CHPOINT contenant les volumes 161 : C 161 : CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO) 162 : IF(IERR .NE. 0) GOTO 9999 163 : C 164 : C********** Les normales aux faces 165 : C 165 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 166 : IF(IERR .NE. 0) GOTO 9999 167 : C 168 : C******************************** 169 : C**** Fin table domaine ********* 170 : C******************************** 171 : C******************************** 172 : C**** La table IPGAZ ******* 173 : C******************************** 174 : C 175 : C 176 : C**** Lecture de la table qui contient le proprieté du gaz 177 : C Cette table est controlle par l'operateur PRIM 178 : C 178 : CALL LIROBJ('TABLE',IPGAZ,1,IRET) 179 : IF(IERR .NE. 0)GOTO 9999 180 : C 181 : C**** NORD: degree des polynoms cv(T) 182 : C 183 : MTYPI = 'MOT ' 184 : MTYPR = ' ' 184 : CALL ACCTAB(IPGAZ,MTYPI,IVALI,XVALI,'NORD',LOGII,IRETI, 185 : & MTYPR,NORD,XVALR,CHARR,LOGIR,IRETR) 186 : IF(MTYPR .NE. 'ENTIER ')THEN 187 : C 188 : C**** Message d'erreur standard 189 : C -301 0 %m1:40 190 : C 191 : MOTERR(1:40) = 'ARG1 . NORD = ??? ' 192 : WRITE(IOIMP,*) MOTERR 193 : C 194 : C**** Message d'erreur standard 195 : C 21 2 196 : C Données incompatibles 197 : C 197 : CALL ERREUR(21) 198 : GOTO 9999 199 : ENDIF 200 : NORDP1 = NORD + 1 201 : IF (NORDP1.NE.1) THEN 202 : C 203 : C**** Message d'erreur standard 204 : C -301 0 %m1:40 205 : C 206 : MOTERR(1:40) = 'ARG1 . NORD .NE. 0 ' 207 : WRITE(IOIMP,*) MOTERR 208 : C 209 : C**** Message d'erreur standard 210 : C 21 2 211 : C Données incompatibles 212 : C 212 : CALL ERREUR(21) 213 : GOTO 9999 214 : ENDIF 215 : C 216 : C**** Nom de l'espece qui n'est pas dans les equations de Navier-Stokes 217 : C 218 : MTYPI = 'MOT ' 219 : MTYPR = ' ' 219 : CALL ACCTAB(IPGAZ,MTYPI,IVALI,XVALI,'ESPNEULE',LOGII,IRETI, 220 : & MTYPR,IVALR,XVALR,CHARR,LOGIR,IRETR) 221 : IF(MTYPR .NE. 'MOT ')THEN 222 : C 223 : C**** Message d'erreur standard 224 : C -301 0 %m1:40 225 : C 226 : MOTERR(1:40) = 'ARG1 . ESPNEULE = ??? ' 227 : WRITE(IOIMP,*) MOTERR 228 : C 229 : C******* Message d'erreur standard 230 : C 21 2 231 : C Données incompatibles 232 : C 232 : CALL ERREUR(21) 233 : GOTO 9999 234 : ENDIF 235 : C 236 : C**** Les especes qui sont dans les Equations de Navier-Stokes 237 : C 238 : MTYPR = ' ' 238 : CALL ACMO(IPGAZ,'ESPEULE',MTYPR,MLMOEU) 239 : IF(MTYPR .NE. 'LISTMOTS')THEN 240 : C 241 : C**** Message d'erreur standard 242 : C -301 0 %m1:40 243 : C 244 : MOTERR(1:40) = 'ARG1 . ESPEULE = ??? ' 245 : WRITE(IOIMP,*) MOTERR 246 : C 247 : C**** Message d'erreur standard 248 : C 21 2 249 : C Données incompatibles 250 : C 250 : CALL ERREUR(21) 251 : GOTO 9999 252 : ELSE 253 : SEGACT MLMOEU 254 : NESP = MLMOEU.MOTS(/2) 255 : SEGINI PROPHY 256 : DO 1 I1 = 1, NESP 257 : PROPHY.NOMESP(I1) = MLMOEU.MOTS(I1) 258 : 1 CONTINUE 259 : PROPHY.NOMESP(NESP+1)=CHARR(1:4) 260 : SEGDES MLMOEU 261 : ENDIF 262 : C 263 : C**** On remplit le segment PROPHY 264 : C Ordre: IPGAZ . 'ESPEULE' + IPGAZ . 'ESPNEULE' 265 : C On controle aussi la compatibilite des 266 : C donnees de la table 267 : C 268 : DO 3 I1 = 1, NESP+1 269 : NOMMOT = PROPHY.NOMESP(I1) 270 : C 270 : C******* CALL ACMF(...) ne marche pas parce que on a 271 : C des espaces dans nos noms de composantes 272 : C 273 : MTYPI = 'MOT ' 274 : MTYPR = ' ' 274 : CALL ACCTAB(IPGAZ,MTYPI,IVALI,XVALI,NOMMOT, LOGII,IRETI, 275 : & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP) 276 : C 277 : C******* En IESP il y a la table IPGAZ.NOMMOT 278 : C 279 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'TABLE ')) THEN 280 : 281 : C 282 : C********** Message d'erreur standard 283 : C -301 0 %m1:40 284 : C 285 : MOTERR = ' ' 286 : MOTERR(1:7) = 'ARG1 . ' 287 : MOTERR(8:11) = NOMMOT 288 : MOTERR(13:17) = '= ???' 289 : WRITE(IOIMP,*) MOTERR 290 : C 291 : C********** Message d'erreur standard 292 : C 21 2 293 : C Données incompatibles 294 : C 294 : CALL ERREUR(21) 295 : GOTO 9999 296 : ENDIF 297 : C 298 : C******* R 299 : C 300 : MTYPI = 'MOT ' 301 : MTYPR = ' ' 301 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'R' , LOGII,IRETI, 302 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR) 303 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN 304 : 305 : C 306 : C********** Message d'erreur standard 307 : C -301 0 %m1:40 308 : C 309 : MOTERR = ' ' 310 : MOTERR(1:7) = 'ARG1 . ' 311 : MOTERR(8:11) = NOMMOT 312 : MOTERR(13:23) = ' . R = ??? ' 313 : WRITE(IOIMP,*) MOTERR 314 : C 315 : C********** Message d'erreur standard 316 : C 21 2 317 : C Données incompatibles 318 : C 318 : CALL ERREUR(21) 319 : GOTO 9999 320 : ENDIF 321 : PROPHY.R(I1)=XVALR 322 : C 323 : C******* H0K 324 : C 325 : MTYPI = 'MOT ' 326 : MTYPR = ' ' 326 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'H0K' , LOGII,IRETI, 327 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR) 328 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN 329 : 330 : C 331 : C********** Message d'erreur standard 332 : C -301 0 %m1:40 333 : C 334 : MOTERR = ' ' 335 : MOTERR(1:7) = 'ARG1 . ' 336 : MOTERR(8:11) = NOMMOT 337 : MOTERR(13:25) = ' . H0K = ??? ' 338 : WRITE(IOIMP,*) MOTERR 339 : C 340 : C********** Message d'erreur standard 341 : C 21 2 342 : C Données incompatibles 343 : C 343 : CALL ERREUR(21) 344 : GOTO 9999 345 : ENDIF 346 : C------------------------------------- 347 : C Attention! we put all h_k^0 to 0.0D0 348 : C all chemistry goes to the source term 349 : C------------------------------------- 350 : c PROPHY.H0K(I1)=XVALR 351 : PROPHY.H0K(I1)=0.0D0 352 : C 353 : C******* CDIFF 354 : C 355 : MTYPI = 'MOT ' 356 : MTYPR = ' ' 356 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'CDIFF' , LOGII,IRETI, 357 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR) 358 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'CHPOINT ')) THEN 359 : 360 : C 361 : C********** Message d'erreur standard 362 : C -301 0 %m1:40 363 : C 364 : MOTERR = ' ' 365 : MOTERR(1:7) = 'ARG1 . ' 366 : MOTERR(8:11) = NOMMOT 367 : MOTERR(13:25) = ' . CDIFF = ??' 368 : WRITE(IOIMP,*) MOTERR 369 : C 370 : C********** Message d'erreur standard 371 : C 21 2 372 : C Données incompatibles 373 : C 373 : CALL ERREUR(21) 374 : GOTO 9999 375 : ENDIF 376 : PROPHY.CDIFF(I1)=IRETR 377 : C 378 : C******* A 379 : C 380 : MTYPI = 'MOT ' 381 : MTYPR = ' ' 381 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'A' , LOGII,IRETI, 382 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR) 383 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'LISTREEL')) THEN 384 : 385 : C 386 : C********** Message d'erreur standard 387 : C -301 0 %m1:40 388 : C 389 : MOTERR = ' ' 390 : MOTERR(1:7) = 'ARG1 . ' 391 : MOTERR(8:11) = NOMMOT 392 : MOTERR(13:23) = ' . A = ??? ' 393 : WRITE(IOIMP,*) MOTERR 394 : C 395 : C********** Message d'erreur standard 396 : C 21 2 397 : C Données incompatibles 398 : C 398 : CALL ERREUR(21) 399 : GOTO 9999 400 : ENDIF 401 : MLREEL = IRETR 402 : SEGACT MLREEL 403 : PROPHY.CV(I1)=MLREEL.PROG(1) 404 : SEGDES MLREEL 405 : C 406 : C******* YK 407 : C 408 : MTYPI = 'MOT ' 409 : MTYPR = ' ' 409 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'YK' , LOGII,IRETI, 410 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR) 411 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'CHPOINT ')) THEN 412 : 413 : C 414 : C********** Message d'erreur standard 415 : C -301 0 %m1:40 416 : C 417 : MOTERR = ' ' 418 : MOTERR(1:7) = 'ARG1 . ' 419 : MOTERR(8:11) = NOMMOT 420 : MOTERR(13:28) = ' . YK = ??? ' 421 : WRITE(IOIMP,*) MOTERR 422 : C 423 : C********** Message d'erreur standard 424 : C 21 2 425 : C Données incompatibles 426 : C 426 : CALL ERREUR(21) 427 : GOTO 9999 428 : ENDIF 429 : PROPHY.YK(I1)=IRETR 430 : C 431 : C******* GRADYK 432 : C 433 : MTYPI = 'MOT ' 434 : MTYPR = ' ' 434 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'GRADYK' , LOGII,IRETI, 435 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR) 436 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'CHPOINT ')) THEN 437 : 438 : C 439 : C********** Message d'erreur standard 440 : C -301 0 %m1:40 441 : C 442 : MOTERR = ' ' 443 : MOTERR(1:7) = 'ARG1 . ' 444 : MOTERR(8:11) = NOMMOT 445 : MOTERR(13:28) = ' . GRADYK = ??? ' 446 : WRITE(IOIMP,*) MOTERR 447 : C 448 : C********** Message d'erreur standard 449 : C 21 2 450 : C Données incompatibles 451 : C 451 : CALL ERREUR(21) 452 : GOTO 9999 453 : ENDIF 454 : PROPHY.GRADYK(I1)=IRETR 455 : C 456 : C******* CGRYK 457 : C 458 : MTYPI = 'MOT ' 459 : MTYPR = ' ' 459 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'CGRYK' , LOGII,IRETI, 460 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR) 461 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'MCHAML ')) THEN 462 : 463 : C 464 : C********** Message d'erreur standard 465 : C -301 0 %m1:40 466 : C 467 : MOTERR = ' ' 468 : MOTERR(1:7) = 'ARG1 . ' 469 : MOTERR(8:11) = NOMMOT 470 : MOTERR(13:28) = ' . CGRYK = ??? ' 471 : WRITE(IOIMP,*) MOTERR 472 : C 473 : C********** Message d'erreur standard 474 : C 21 2 475 : C Données incompatibles 476 : C 476 : CALL ERREUR(21) 477 : GOTO 9999 478 : ENDIF 479 : PROPHY.CGRYK(I1)=IRETR 480 : C 481 : C******* CLYK 482 : C 483 : MTYPI = 'MOT ' 484 : MTYPR = ' ' 484 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'CLYK' , LOGII,IRETI, 485 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR) 486 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'CHPOINT ')) THEN 487 : 488 : IF (MTYPR .NE. ' ') THEN 489 : C 490 : C********** Message d'erreur standard 491 : C -301 0 %m1:40 492 : C 493 : MOTERR = ' ' 494 : MOTERR(1:7) = 'ARG1 . ' 495 : MOTERR(8:11) = NOMMOT 496 : MOTERR(13:28) = ' . CLYK = ??? ' 497 : WRITE(IOIMP,*) MOTERR 498 : C 499 : C********** Message d'erreur standard 500 : C 21 2 501 : C Données incompatibles 502 : C 502 : CALL ERREUR(21) 503 : GOTO 9999 504 : ENDIF 505 : IRETR = 0 506 : ELSE 507 : MCHPOI = IRETR 508 : SEGACT MCHPOI 509 : NSOUPO = MCHPOI.IPCHP(/1) 510 : SEGDES MCHPOI 511 : IF(NSOUPO .GT.0)THEN 512 : JGN = 4 513 : JGM = 1 514 : SEGINI MLMNOM 515 : MLMNOM.MOTS(1) = 'SCAL' 515 : CALL QUEPO1(IRETR, 0, MLMNOM) 516 : IF(IERR .NE. 0) GOTO 9999 517 : SEGSUP MLMNOM 518 : ELSE 519 : IRETR=0 520 : ENDIF 521 : ENDIF 522 : PROPHY.CLYK(I1)=IRETR 523 : 3 CONTINUE 524 : SEGDES PROPHY 525 : C 526 : C**** La table IPGAZ donc a ete controllee et PROPHY est rempli 527 : C 528 : C 529 : C**** Viscosité dynamique (kg/m/sec) 530 : C 531 : TYPE = 'CHPOINT ' 531 : CALL LIROBJ(TYPE,MU,1,IRET) 532 : IF(IERR .NE. 0) GOTO 9999 533 : INDIC = 1 534 : NBCOMP = 1 535 : MOT = 'SCAL' 535 : CALL QUEPOI(MU, MELEMC, INDIC, NBCOMP, MOT) 536 : C 537 : C**** Conductivité thermique (J/sec/m/K) 538 : C 539 : TYPE = 'CHPOINT ' 539 : CALL LIROBJ(TYPE,KAPPA,1,IRET) 540 : IF(IERR .NE. 0) GOTO 9999 541 : INDIC = 1 542 : NBCOMP = 1 543 : MOT = 'SCAL' 543 : CALL QUEPOI(KAPPA, MELEMC, INDIC, NBCOMP, MOT) 544 : C 545 : C**** Chaleur specifique (J/kg/K) 546 : C 547 : TYPE = 'CHPOINT ' 547 : CALL LIROBJ(TYPE,CVTOT,1,IRET) 548 : IF(IERR .NE. 0) GOTO 9999 549 : INDIC = 1 550 : NBCOMP = 1 551 : MOT = 'SCAL' 551 : CALL QUEPOI(CVTOT, MELEMC, INDIC, NBCOMP, MOT) 552 : C 553 : C**** Densité 554 : C 555 : TYPE = 'CHPOINT ' 555 : CALL LIROBJ(TYPE,IRN,1,IRET) 556 : IF(IERR .NE. 0) GOTO 9999 557 : INDIC = 1 558 : NBCOMP = 1 559 : MOT = 'SCAL' 559 : CALL QUEPOI(IRN, MELEMC, INDIC, NBCOMP, MOT) 560 : C 561 : C**** Vitesse 562 : C 563 : TYPE='CHPOINT ' 563 : CALL LIROBJ(TYPE,IVN,1,IRET) 564 : IF(IERR .NE. 0) GOTO 9999 565 : JGN = 4 566 : JGM = IDIM 567 : SEGINI MLMNOM 568 : MLMNOM.MOTS(1) = 'UX ' 569 : MLMNOM.MOTS(2) = 'UY ' 570 : IF(IDIM.EQ.3) MLMNOM.MOTS(3) = 'UZ ' 570 : CALL QUEPO1(IVN, MELEMC, MLMNOM) 571 : IF(IERR .NE. 0) GOTO 9999 572 : SEGSUP MLMNOM 573 : C 574 : C**** Température 575 : C 576 : TYPE='CHPOINT ' 576 : CALL LIROBJ(TYPE,ITN,1,IRET) 577 : IF(IERR .NE. 0) GOTO 9999 578 : JGN = 4 579 : JGM = 1 580 : SEGINI MLMNOM 581 : MLMNOM.MOTS(1) = 'SCAL' 581 : CALL QUEPO1(ITN, MELEMC, MLMNOM) 582 : IF(IERR .NE. 0) GOTO 9999 583 : SEGSUP MLMNOM 584 : C 585 : C**** Gradient de la vitesse 586 : C 587 : TYPE='CHPOINT ' 587 : CALL LIROBJ(TYPE,IGRVN,1,IRET) 588 : IF(IERR .NE. 0) GOTO 9999 589 : JGN = 4 590 : JGM =IDIM*IDIM 591 : SEGINI MLMNOM 592 : IF(IDIM.EQ.2)THEN 593 : MLMNOM.MOTS(1) = 'P1DX' 594 : MLMNOM.MOTS(2) = 'P1DY' 595 : MLMNOM.MOTS(3) = 'P2DX' 596 : MLMNOM.MOTS(4) = 'P2DY' 597 : ELSE 598 : MLMNOM.MOTS(1) = 'P1DX' 599 : MLMNOM.MOTS(2) = 'P1DY' 600 : MLMNOM.MOTS(3) = 'P1DZ' 601 : MLMNOM.MOTS(4) = 'P2DX' 602 : MLMNOM.MOTS(5) = 'P2DY' 603 : MLMNOM.MOTS(6) = 'P2DZ' 604 : MLMNOM.MOTS(7) = 'P3DX' 605 : MLMNOM.MOTS(8) = 'P3DY' 606 : MLMNOM.MOTS(9) = 'P3DZ' 607 : ENDIF 607 : CALL QUEPO1(IGRVN, MELEMF, MLMNOM) 608 : IF(IERR .NE. 0) GOTO 9999 609 : SEGSUP MLMNOM 610 : C 611 : C**** Gradient de la temperature 612 : C 613 : TYPE='CHPOINT ' 613 : CALL LIROBJ(TYPE,IGRTN,1,IRET) 614 : IF(IERR .NE. 0) GOTO 9999 615 : JGN = 4 616 : JGM=IDIM 617 : SEGINI MLMNOM 618 : MLMNOM.MOTS(1) = 'P1DX' 619 : MLMNOM.MOTS(2) = 'P1DY' 620 : IF(IDIM.EQ.3) MLMNOM.MOTS(3) = 'P1DZ ' 620 : CALL QUEPO1(IGRTN, MELEMF, MLMNOM) 621 : IF(IERR .NE. 0) GOTO 9999 622 : SEGSUP MLMNOM 623 : C 624 : C 625 : IF (LOGIMP) THEN 625 : CALL LIROBJ('MCHAML ',ICOGRV,1,IRET) 626 : IF(IERR .NE. 0) GOTO 9999 627 : ENDIF 628 : C 629 : C 630 : IF (LOGIMP) THEN 630 : CALL LIROBJ('MCHAML ',ICOGRT,1,IRET) 631 : IF(IERR .NE. 0) GOTO 9999 632 : ENDIF 633 : C-------------------------------------------------- 634 : C**** Conditions limites 635 : C-------------------------------------------------- 636 : C Vitesse imposée à la paroi 637 : C 637 : CALL LIRCHA(MOT,0,IRET) 638 : IF(IRET .NE. 0)THEN 639 : IF(MOT .EQ. 'VIMP')THEN 640 : TYPE='CHPOINT ' 640 : CALL LIROBJ(TYPE,IVNIMP,1,IRET) 641 : IF(IERR .NE. 0) GOTO 9999 642 : MCHPOI = IVNIMP 643 : SEGACT MCHPOI 644 : NSOUPO = MCHPOI.IPCHP(/1) 645 : SEGDES MCHPOI 646 : IF(NSOUPO .GT. 0)THEN 647 : JGN = 4 648 : JGM = IDIM 649 : SEGINI MLMNOM 650 : MLMNOM.MOTS(1) = 'UX ' 651 : MLMNOM.MOTS(2) = 'UY ' 652 : IF(IDIM.EQ.3) MLMNOM.MOTS(3) = 'UZ ' 652 : CALL QUEPO1(IVNIMP, 0, MLMNOM) 653 : IF(IERR .NE. 0) GOTO 9999 654 : SEGSUP MLMNOM 655 : ELSE 656 : IVNIMP=0 657 : ENDIF 658 : ELSE 659 : IVNIMP=0 660 : C 661 : C********** Je m'excuse et je le remets dans la pile 662 : C 662 : CALL REFUS 663 : ENDIF 664 : ELSE 665 : IVNIMP=0 666 : ENDIF 667 : C 668 : C Tenseur des contraintes visqueux 669 : C 669 : CALL LIRCHA(MOT,0,IRET) 670 : IF(IRET .NE. 0)THEN 671 : IF(MOT .EQ. 'TAUI')THEN 672 : TYPE='CHPOINT ' 672 : CALL LIROBJ(TYPE,ITAUIM,1,IRET) 673 : IF(IERR .NE. 0) GOTO 9999 674 : MCHPOI = ITAUIM 675 : SEGACT MCHPOI 676 : NSOUPO = MCHPOI.IPCHP(/1) 677 : SEGDES MCHPOI 678 : IF(NSOUPO .GT. 0)THEN 679 : JGN = 4 680 : C 2D only 681 : JGM = 3*(IDIM-1) 682 : SEGINI MLMNOM 683 : IF(IDIM .EQ.2)THEN 684 : MLMNOM.MOTS(1) = 'TXX' 685 : MLMNOM.MOTS(2) = 'TYY' 686 : MLMNOM.MOTS(3) = 'TXY' 687 : ELSE 688 : MLMNOM.MOTS(1) = 'TXX' 689 : MLMNOM.MOTS(2) = 'TYY' 690 : MLMNOM.MOTS(3) = 'TZZ' 691 : MLMNOM.MOTS(4) = 'TXY' 692 : MLMNOM.MOTS(5) = 'TXZ' 693 : MLMNOM.MOTS(6) = 'TYZ' 694 : ENDIF 694 : CALL QUEPO1(ITAUIM, 0, MLMNOM) 695 : IF(IERR .NE. 0) GOTO 9999 696 : SEGSUP MLMNOM 697 : ELSE 698 : ITAUIM=0 699 : ENDIF 700 : ELSE 701 : ITAUIM=0 702 : C 703 : C********** Je m'excuse et je le remets dans la pile 704 : C 704 : CALL REFUS 705 : ENDIF 706 : ELSE 707 : ITAUIM=0 708 : ENDIF 709 : C 710 : C Flux thermique 711 : C 711 : CALL LIRCHA(MOT,0,IRET) 712 : IF(IRET .NE. 0)THEN 713 : IF(MOT .EQ. 'QIMP')THEN 714 : TYPE='CHPOINT ' 714 : CALL LIROBJ(TYPE,IQIMP,1,IRET) 715 : IF(IERR .NE. 0) GOTO 9999 716 : MCHPOI = IQIMP 717 : SEGACT MCHPOI 718 : NSOUPO = MCHPOI.IPCHP(/1) 719 : SEGDES MCHPOI 720 : IF(NSOUPO .GT.0)THEN 721 : JGN = 4 722 : JGM = IDIM 723 : SEGINI MLMNOM 724 : MLMNOM.MOTS(1) = 'UX ' 725 : MLMNOM.MOTS(2) = 'UY ' 726 : IF(IDIM .EQ. 3) MLMNOM.MOTS(3) = 'UZ ' 726 : CALL QUEPO1(IQIMP, 0, MLMNOM) 727 : IF(IERR .NE. 0) GOTO 9999 728 : SEGSUP MLMNOM 729 : ELSE 730 : IQIMP=0 731 : ENDIF 732 : ELSE 733 : IQIMP=0 734 : C 735 : C********** Je m'excuse et je le remets dans la pile 736 : C 736 : CALL REFUS 737 : ENDIF 738 : ELSE 739 : IQIMP=0 740 : ENDIF 741 : C 742 : C Température imposée 743 : C 743 : CALL LIRCHA(MOT,0,IRET) 744 : IF(IRET .NE. 0)THEN 745 : IF(MOT .EQ. 'TIMP')THEN 746 : TYPE='CHPOINT ' 746 : CALL LIROBJ(TYPE,ITIMP,1,IRET) 747 : IF(IERR .NE. 0) GOTO 9999 748 : MCHPOI = ITIMP 749 : SEGACT MCHPOI 750 : NSOUPO = MCHPOI.IPCHP(/1) 751 : SEGDES MCHPOI 752 : IF(NSOUPO .GT.0)THEN 753 : JGN = 4 754 : JGM = 1 755 : SEGINI MLMNOM 756 : MLMNOM.MOTS(1) = 'SCAL' 756 : CALL QUEPO1(ITIMP, 0, MLMNOM) 757 : IF(IERR .NE. 0) GOTO 9999 758 : SEGSUP MLMNOM 759 : ELSE 760 : ITIMP=0 761 : ENDIF 762 : ELSE 763 : ITIMP=0 764 : C 765 : C********** Je m'excuse et je le remets dans la pile 766 : C 766 : CALL REFUS 767 : ENDIF 768 : ELSE 769 : ITIMP=0 770 : ENDIF 771 : C 772 : C Densité imposée 773 : C 773 : CALL LIRCHA(MOT,0,IRET) 774 : IF(IRET .NE. 0)THEN 775 : IF(MOT .EQ. 'RIMP')THEN 776 : TYPE='CHPOINT ' 776 : CALL LIROBJ(TYPE,IRIMP,1,IRET) 777 : IF(IERR .NE. 0) GOTO 9999 778 : MCHPOI = IRIMP 779 : SEGACT MCHPOI 780 : NSOUPO = MCHPOI.IPCHP(/1) 781 : SEGDES MCHPOI 782 : IF(NSOUPO .GT.0)THEN 783 : JGN = 4 784 : JGM = 1 785 : SEGINI MLMNOM 786 : MLMNOM.MOTS(1) = 'SCAL' 786 : CALL QUEPO1(IRIMP, 0, MLMNOM) 787 : IF(IERR .NE. 0) GOTO 9999 788 : SEGSUP MLMNOM 789 : ELSE 790 : IRIMP=0 791 : ENDIF 792 : ELSE 793 : IRIMP=0 794 : C 795 : C********** Je m'excuse et je le remets dans la pile 796 : C 796 : CALL REFUS 797 : ENDIF 798 : ELSE 799 : IRIMP=0 800 : ENDIF 801 : C 802 : C**** Les noms des inconnues 803 : C 804 : TYPE='LISTMOTS' 804 : CALL LIROBJ(TYPE,ILIINC,1,IRET) 805 : IF(IERR .NE. 0) GOTO 9999 806 : MLMOTS = ILIINC 807 : SEGACT MLMOTS 808 : NC = MLMOTS.MOTS(/2) 809 : SEGDES MLMOTS 810 : IF(NC .EQ. (IDIM+4+NESP)) IKEPS = 1 811 : IF(IKEPS .EQ. 0) THEN 812 : IF((NC .NE. (IDIM+2+NESP)))THEN 813 : MESERR='LMOT1 = ??? ' 814 : WRITE(IOIMP,*) MESERR 815 : C 816 : C********** Message d'erreur standard 817 : C 21 2 818 : C Données incompatibles 819 : C 819 : CALL ERREUR(21) 820 : GOTO 9999 821 : ENDIF 822 : ENDIF 823 : *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 824 : IF(IKEPS .GT. 0) THEN 825 : C************************************************************ 826 : C The turbulent kinetic energy and rate of dissipation 827 : C------------------------------------------------------------ 828 : MTYPI = 'MOT ' 829 : MTYPR = ' ' 829 : CALL ACCTAB(IPGAZ,MTYPI,IVALI,XVALI,'MUTURB',LOGII,IRETI, 830 : & MTYPR,IVALR,XVALR,CHARR,LOGIR,IRETR) 831 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'CHPOINT ')) THEN 832 : C------------------------------ 833 : C Message d'erreur standard 834 : C -301 0 %m1:40 835 : C------------------------------ 836 : MOTERR = 'TAB1 . MUTURB = ??? ' 837 : WRITE(IOIMP,*) MOTERR(1:40) 838 : C------------------------------ 839 : C Message d'erreur standard 840 : C 21 2 841 : C Données incompatibles 842 : C------------------------------ 842 : CALL ERREUR(21) 843 : GOTO 9999 844 : ENDIF 845 : MUT = IRETR 846 : INDIC = 1 847 : NBCOMP = 1 848 : MOT = 'SCAL' 848 : CALL QUEPOI(MUT, MELEMC, INDIC, NBCOMP, MOT) 849 : C--------- \sigma_ka 849 : CALL ACMF(IPGAZ,'SIGK',XVALR) 850 : TSIGK = XVALR 851 : C--------- \sigma_eps 851 : CALL ACMF(IPGAZ,'SIGE',XVALR) 852 : TSIGE = XVALR 853 : C-------------------------------------------- 854 : C Creating the "new" turbulence for momentum 855 : C equations \mu_n = \mu + \mu_t 856 : C-------------------------------------------- 856 : CALL ADCHPO(MU,MUT,MUN,1.D0,1.D0) 857 : C************************************************************* 858 : C The gradient at the faces of the turb. kin. en. and epsilon 859 : C------------------------------------------------------------- 860 : TYPE='CHPOINT ' 860 : CALL LIROBJ(TYPE,IGRKEP,1,IRET) 861 : IF(IERR .NE. 0) GOTO 9999 862 : JGN = 4 863 : IF(IDIM.EQ.2) THEN 864 : JGM = 4 865 : ELSE 866 : JGM = 6 867 : ENDIF 868 : SEGINI MLMNOM 869 : IF(IDIM.EQ.2)THEN 870 : MLMNOM.MOTS(1) = 'P1DX' 871 : MLMNOM.MOTS(2) = 'P1DY' 872 : MLMNOM.MOTS(3) = 'P2DX' 873 : MLMNOM.MOTS(4) = 'P2DY' 874 : ELSE 875 : MLMNOM.MOTS(1) = 'P1DX' 876 : MLMNOM.MOTS(2) = 'P1DY' 877 : MLMNOM.MOTS(3) = 'P1DZ' 878 : MLMNOM.MOTS(4) = 'P2DX' 879 : MLMNOM.MOTS(5) = 'P2DY' 880 : MLMNOM.MOTS(6) = 'P2DZ' 881 : ENDIF 881 : CALL QUEPO1(IGRKEP, MELEMF, MLMNOM) 882 : IF(IERR .NE. 0) GOTO 9999 883 : SEGSUP MLMNOM 884 : C------------------------------------------- 885 : C End of reading of the additional information 886 : C needed for the turbulent terms 887 : C------------------------------------------- 888 : ENDIF 889 : C-------------------------------- 890 : C Fin de la lecture des données 891 : C-------------------------------- 892 : C 893 : C Création de la matrice jacobienne du résidu du laplacien VF 894 : C 895 : IF (LOGIMP) THEN 896 : IF (IDIM.EQ.2) THEN 896 : CALL XLAP1A(MU,KAPPA,CVTOT,IRN,IVN,ITN, 897 : $ IGRVN,ICOGRV,ICOGRT, 898 : $ IVNIMP,ITAUIM,ITIMP,IQIMP, 899 : $ MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPVO,MLMOTS, 900 : $ IJACO) 900 : CALL ZLAP1A(PROPHY,IRN,ITN, 901 : $ ITIMP,IRIMP, 902 : $ MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPVO,MLMOTS, 903 : $ IJACO) 904 : ELSEIF (IDIM.EQ.3) THEN 904 : CALL XLAP2A(MU,KAPPA,CVTOT,IRN,IVN,ITN, 905 : $ IGRVN,ICOGRV,ICOGRT, 906 : $ IVNIMP,ITAUIM,ITIMP,IQIMP, 907 : $ MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPVO,MLMOTS, 908 : $ IJACO) 908 : CALL ZLAP2A(PROPHY,IRN,ITN, 909 : $ ITIMP,IRIMP, 910 : $ MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPVO,MLMOTS, 911 : $ IJACO) 912 : ELSE 913 : WRITE(IOIMP,*) 'IDIM=',IDIM,' ILLICITE.' 913 : CALL ERREUR(5) 914 : GOTO 9999 915 : ENDIF 916 : ELSE 917 : C 918 : C******* Objet MATRIK vide en explicite 919 : C 920 : NRIGE=7 921 : NMATRI=0 922 : NKID =9 923 : NKMT =7 924 : SEGINI MATRIK 925 : SEGDES MATRIK 926 : IJACO = MATRIK 927 : ENDIF 928 : C 929 : C**** Creation des flux aux interfaces 930 : C 931 : JGN=4 932 : JGM=IDIM+NESP+1 933 : IF(IKEPS .GT. 0) JGM=IDIM+NESP+3 934 : SEGINI MLDEFO 935 : SEGACT MLMOTS 936 : DO ICELL=1,JGM,1 937 : MLDEFO.MOTS(ICELL)=MLMOTS.MOTS(ICELL+1) 938 : ENDDO 939 : SEGDES MLMOTS 940 : TYPE = 'CHPOINT ' 940 : CALL KRCHP1(TYPE, MELEMF, ICHFLU, MLDEFO) 940 : CALL KRCHP1(TYPE, MELEMF, ICHFL2, MLDEFO) 941 : IF(IKEPS .GT. 0) THEN 941 : CALL KRCHP1(TYPE, MELEMF, ICHFL3, MLDEFO) 942 : ENDIF 943 : C 944 : C**** Calcul des flux et du pas du temps. 945 : C 946 : IF(IDIM.EQ.2)THEN 947 : IF(IKEPS .GT. 0) THEN 947 : CALL XLAP12(MUN,KAPPA,CVTOT,IRN,IVN,IGRVN,IGRTN, 948 : & IVNIMP,ITAUIM,IQIMP, 949 : & MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPDI,ICHFLU,DELTAT) 950 : ELSE 950 : CALL XLAP12(MU,KAPPA,CVTOT,IRN,IVN,IGRVN,IGRTN, 951 : & IVNIMP,ITAUIM,IQIMP, 952 : & MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPDI,ICHFLU,DELTAT) 953 : ENDIF 953 : CALL ZLAP12(PROPHY,IRN,ITN, 954 : & ITIMP,IRIMP, 955 : & MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPDI,ICHFL2,DELTA2) 956 : IF(IKEPS .GT. 0) THEN 956 : CALL TLAP12(NESP,MU,MUT,TSIGK,TSIGE,IGRKEP, 957 : & MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPDI,ICHFL3,DELTA3) 958 : ENDIF 959 : C------------------------------------------ 960 : C ET sur les chpoints 961 : C------------------------------------------ 961 : CALL ADCHPO(ICHFLU,ICHFL2,ICHTM1,1.D0,1.D0) 962 : IF (ICHTM1.EQ.0) THEN 963 : WRITE(IOIMP,*) 'Pas pu faire le ET des chpoints...' 964 : GOTO 9999 965 : ENDIF 966 : IF(IKEPS .GT. 0) THEN 966 : CALL ADCHPO(ICHTM1,ICHFL3,ICHTMP,1.D0,1.D0) 967 : IF (ICHTMP.EQ.0) THEN 968 : WRITE(IOIMP,*) 'Pas pu faire le ET des chpoints...' 969 : GOTO 9999 970 : ENDIF 971 : ENDIF 971 : CALL DTCHPO(ICHFLU) 971 : CALL DTCHPO(ICHFL2) 972 : IF(IKEPS .GT. 0) THEN 972 : CALL DTCHPO(ICHFL3) 972 : CALL DTCHPO(ICHTM1) 973 : ICHFLU=ICHTMP 974 : DELTAT=MIN(DELTAT,DELTA2) 975 : ELSE 976 : ICHFLU=ICHTM1 977 : DELTAT=MIN(DELTAT,DELTA2) 978 : ENDIF 979 : ELSE 980 : c---------------------------------------- 981 : IF(IKEPS .GT. 0) THEN 981 : CALL XLAP13(MUN,KAPPA,CVTOT,IRN,IVN,IGRVN,IGRTN, 982 : & IVNIMP,ITAUIM,IQIMP, 983 : & MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPDI,ICHFLU,DELTAT) 984 : ELSE 984 : CALL XLAP13(MU,KAPPA,CVTOT,IRN,IVN,IGRVN,IGRTN, 985 : & IVNIMP,ITAUIM,IQIMP, 986 : & MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPDI,ICHFLU,DELTAT) 987 : ENDIF 988 : c---------------------------------------- 988 : CALL ZLAP13(PROPHY,IRN,ITN, 989 : & ITIMP,IRIMP, 990 : & MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPDI,ICHFL2,DELTA2) 991 : IF(IKEPS .GT. 0) THEN 991 : CALL TLAP13(NESP,MU,MUT,TSIGK,TSIGE,IGRKEP, 992 : & MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPDI,ICHFL3,DELTA3) 993 : ENDIF 994 : C--------------------------------------------------------- 995 : C ET sur les chpoints 996 : C--------------------------------------------------------- 996 : CALL ADCHPO(ICHFLU,ICHFL2,ICHTM1,1.D0,1.D0) 997 : IF (ICHTM1.EQ.0) THEN 998 : WRITE(IOIMP,*) 'Pas pu faire le ET des chpoints...' 999 : GOTO 9999 1000 : ENDIF 1001 : IF(IKEPS .GT. 0) THEN 1001 : CALL ADCHPO(ICHTM1,ICHFL3,ICHTMP,1.D0,1.D0) 1002 : IF (ICHTMP.EQ.0) THEN 1003 : WRITE(IOIMP,*) 'Pas pu faire le ET des chpoints...' 1004 : GOTO 9999 1005 : ENDIF 1006 : ENDIF 1006 : CALL DTCHPO(ICHFLU) 1006 : CALL DTCHPO(ICHFL2) 1007 : IF(IKEPS .GT. 0) THEN 1007 : CALL DTCHPO(ICHFL3) 1007 : CALL DTCHPO(ICHTM1) 1008 : ICHFLU=ICHTMP 1009 : DELTAT=MIN(DELTAT,DELTA2) 1010 : ELSE 1011 : ICHFLU=ICHTM1 1012 : DELTAT=MIN(DELTAT,DELTA2) 1013 : ENDIF 1014 : ENDIF 1015 : IF(IERR .NE. 0)GOTO 9999 1016 : C 1017 : C**** Calcul de residu (si LOGRES = .TRUE.) 1018 : C 1019 : IF(LOGRES)THEN 1020 : TYPE = 'CHPOINT ' 1020 : CALL KRCHP1(TYPE, MELEMC, ICHRES, MLDEFO) 1021 : IF(IERR.NE.0) GOTO 9999 1022 : C 1022 : CALL KONRE1(MELEMC,MELEMF,MELEFL,ICHPVO, 1023 : & ICHFLU, ICHRES, 1024 : & LOGAN,MESERR) 1025 : IF(LOGAN)THEN 1026 : C 1027 : C******* Anomalie detectée 1028 : C 1029 : C 1030 : C******* Message d'erreur standard 1031 : C -301 0 1032 : C %m1:40 1033 : C 1034 : MOTERR(1:40) = MESERR(1:40) 1035 : WRITE(IOIMP,*) MOTERR(1:40) 1036 : C 1037 : C******* Message d'erreur standard 1038 : C 5 3 1039 : C Erreur anormale.contactez votre support 1040 : C 1040 : CALL ERREUR(5) 1041 : GOTO 9999 1042 : ENDIF 1043 : ELSE 1044 : SEGSUP MLDEFO 1045 : ICHRES = 0 1046 : ENDIF 1047 : C 1048 : C**** Sortie 1049 : C 1049 : CALL ECRREE(DELTAT) 1050 : TYPE = 'CHPOINT ' 1050 : * IF(ICHRES .NE. 0) CALL ECROBJ(TYPE,ICHRES) 1050 : * IF(ICHFLU .NE. 0) CALL ECROBJ(TYPE,ICHFLU) 1050 : CALL ECROBJ(TYPE,ICHRES) 1051 : TYPE='MATRIK ' 1051 : CALL ECROBJ(TYPE,IJACO) 1052 : C 1053 : 9999 RETURN 1054 : END 1055 : 1056 : 1057 : 1058 : 1059 : 1060 : 1061 : 1062 : 1063 : 1064 : 1065 : 1066 : 1067 : 1068 : 1069 : 1070 : 1071 :
© Cast3M 2003 - All rights reserved.
Disclaimer