1 : C CLIM11 SOURCE HP1 10/07/20 21:15:04 6717 2 : SUBROUTINE CLIM11(IJAC) 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : CLIM11 8 : C 9 : C DESCRIPTION : Subroutine appellée par CLIM1 10 : C 11 : C Modelisation 2D/3D des equations d'Euler 12 : C Calcul de conditions aux bords 13 : C Inlet; Riemann invariants 14 : C 15 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 16 : C 17 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF 18 : C 19 : C************************************************************************ 20 : C 21 : C APPELES (Calcul) : 22 : C 23 : C************************************************************************ 24 : C 25 : C 26 : C************************************************************************ 27 : C 28 : C HISTORIQUE (Anomalies et modifications éventuelles) 29 : C 30 : C HISTORIQUE : 31 : C 32 : C************************************************************************ 33 : C 34 : IMPLICIT INTEGER(I-N) 35 : -INC CCOPTIO 36 : -INC SMLMOTS 37 : -INC SMELEME 38 : -INC SMLENTI 39 : -INC SMMATRIK 40 : POINTEUR MLMVIT.MLMOTS 41 : C 42 : C**** Variables de COOPTIO 43 : C 44 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 45 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 46 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 47 : C & ,IECHO, IIMPI, IOSPI 48 : C & ,IDIM, IFICLE, IPREFI 49 : C & ,MCOORD 50 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 51 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 52 : C & ,NORINC,NORVAL,NORIND,NORVAD 53 : C & ,NUCROU, IPSAUV 54 : C 55 : INTEGER IJAC, IJACO 56 : & ,IDOMA, IDBOR, IRET, MELEMC, MELEFE, MELEMF, ICHPVO, INORM 57 : & ,ICHPSU, MELECB, NBCOMP, INDIC, MELEFC, MELRES 58 : & ,JGN, JGM, NBELEM, NBNN, NBSOUS, NBREF, NGF, NLC 59 : & ,I1, ICEN, N1, ILIINP 60 : & ,ILIINC, IROC, IVITC, IPC, IGAMC, ICHLIM, NBOPT, ILIM 61 : & ,ICHRES, ICHRLI 62 : & ,NKID,NKMT,NMATRI,NRIGE,MMODEL,INEFMD 63 : PARAMETER (NBOPT=9) 64 : CHARACTER*8 LOPT(NBOPT) 65 : CHARACTER*4 MOT 66 : CHARACTER*8 TYPE 67 : C 68 : DATA LOPT/'INRI ','OUTRI ','INSS ','OUTSS ','OUTP ', 69 : & 'INSU ','INJE ','INJELM ','INSO '/ 70 : C 71 : C******************************* 72 : C**** La table domaine ********* 73 : C******************************* 74 : C 74 : CALL LIROBJ('MMODEL',MMODEL,1,IRET) 75 : IF(IERR.NE.0)GOTO 9999 75 : CALL LEKMOD(MMODEL,IDOMA,INEFMD) 76 : C INEFMD inutilisé 77 : IF(IERR .NE. 0)GOTO 9999 78 : C 78 : CALL LEKTAB(IDOMA,'CENTRE',MELEMC) 79 : IF(IERR .NE. 0) GOTO 9999 80 : C 80 : CALL LEKTAB(IDOMA,'FACE',MELEMF) 81 : IF(IERR .NE. 0) GOTO 9999 82 : C 83 : C**** Lecture du CHPOINT contenant les volumes 84 : C 84 : CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO) 85 : IF(IERR .NE. 0) GOTO 9999 86 : INDIC = 1 87 : NBCOMP = 1 88 : MOT = 'SCAL' 88 : CALL QUEPOI(ICHPVO, MELEMC, INDIC, NBCOMP, MOT) 89 : IF(IERR .NE. 0) GOTO 9999 90 : C 90 : CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU) 91 : IF(IERR .NE. 0) GOTO 9999 92 : INDIC = 1 93 : NBCOMP = 1 94 : MOT = 'SCAL' 94 : CALL QUEPOI(ICHPSU, MELEMF, INDIC, NBCOMP, MOT) 95 : IF(IERR .NE. 0) GOTO 9999 96 : C 97 : C**** Les normales aux faces 98 : C 99 : IF(IDIM .EQ. 2)THEN 100 : C Que les normales 100 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 101 : IF(IERR .NE. 0) GOTO 9999 102 : JGN = 4 103 : JGM = 2 104 : SEGINI MLMVIT 105 : MLMVIT.MOTS(1) = 'UX ' 106 : MLMVIT.MOTS(2) = 'UY ' 106 : CALL QUEPO1(INORM, MELEMF, MLMVIT) 107 : SEGSUP MLMVIT 108 : IF(IERR .NE. 0) GOTO 9999 109 : ELSE 110 : C 111 : C**** Les normales ('MX ', ...) 112 : C Les tangentes ('RX ', ...) 113 : C 114 : TYPE = ' ' 114 : CALL ACMO(IDOMA,'MATROT',TYPE,INORM) 115 : IF (TYPE .NE. 'CHPOINT ') THEN 115 : CALL MATRAN(IDOMA,INORM) 116 : IF(IERR .NE. 0) GOTO 9999 117 : ENDIF 118 : JGN = 4 119 : JGM = 9 120 : SEGINI MLMVIT 121 : MLMVIT.MOTS(1) = 'MX ' 122 : MLMVIT.MOTS(2) = 'MY ' 123 : MLMVIT.MOTS(3) = 'MZ ' 124 : MLMVIT.MOTS(4) = 'RX ' 125 : MLMVIT.MOTS(5) = 'RY ' 126 : MLMVIT.MOTS(6) = 'RZ ' 127 : MLMVIT.MOTS(7) = 'UX ' 128 : MLMVIT.MOTS(8) = 'UY ' 129 : MLMVIT.MOTS(9) = 'UZ ' 129 : CALL QUEPO1(INORM, MELEMF, MLMVIT) 130 : SEGSUP MLMVIT 131 : ENDIF 132 : C 133 : C********************************** 134 : C**** La table domaine du bord **** 135 : C********************************** 136 : C 136 : CALL LIROBJ('MMODEL',MMODEL,1,IRET) 137 : IF(IERR.NE.0)GOTO 9999 137 : CALL LEKMOD(MMODEL,IDBOR,INEFMD) 138 : C INEFMD inutilisé 139 : IF(IERR .NE. 0)GOTO 9999 140 : C 140 : CALL LEKTAB(IDBOR,'CENTRE',MELECB) 141 : IF(IERR .NE. 0) GOTO 9999 142 : C 143 : TYPE = ' ' 143 : CALL ACMO(IDBOR,'FACCEN',TYPE,MELEFC) 144 : IF (TYPE.NE.'MAILLAGE') THEN 145 : C 145 : CALL LEKTAB(IDOMA,'FACEL',MELEFE) 146 : IF(IERR .NE. 0) GOTO 9999 147 : C 148 : C******* On cree la connectivité face-centre 149 : C 150 : IPT1=MELECB 151 : IPT2=MELEFE 152 : SEGACT IPT1 153 : SEGACT IPT2 153 : CALL KRIPAD(IPT1,MLENTI) 154 : C SEGINI MLENTI 155 : NBELEM=IPT1.NUM(/2) 156 : NBNN=2 157 : NBSOUS=0 158 : NBREF=0 159 : SEGINI IPT3 160 : IPT3.ITYPEL=2 161 : N1=IPT2.NUM(/2) 162 : ICEN=0 163 : DO I1=1,N1,1 164 : NGF=IPT2.NUM(2,I1) 165 : NLC=MLENTI.LECT(NGF) 166 : IF(NLC.NE.0)THEN 167 : ICEN=ICEN+1 168 : IPT3.NUM(1,ICEN)=NGF 169 : IPT3.NUM(2,ICEN)=IPT2.NUM(1,I1) 170 : IF(IPT2.NUM(1,I1) .NE. IPT2.NUM(3,I1))THEN 171 : C Interior point 172 : C Donné incompatible 173 : WRITE(IOIMP,*) 'Internal boundary condition!!!' 173 : CALL ERREUR(21) 174 : ENDIF 175 : ENDIF 176 : ENDDO 177 : C 178 : IF(ICEN .NE. NBELEM)THEN 178 : CALL ERREUR(5) 179 : ENDIF 180 : SEGDES IPT1 181 : SEGDES IPT2 182 : SEGDES IPT3 183 : SEGSUP MLENTI 184 : C 185 : MELEFC=IPT3 185 : CALL ECMO(IDBOR,'FACCEN','MAILLAGE',IPT3) 186 : ENDIF 187 : C 188 : C**** Le SPG du residu 189 : C 190 : IPT1=MELEFC 191 : SEGACT IPT1 192 : NBELEM=IPT1.NUM(/2) 193 : NBNN=1 194 : NBSOUS=0 195 : NBREF=0 196 : SEGINI IPT2 197 : IPT2.ITYPEL=1 198 : DO I1=1,NBELEM,1 199 : IPT2.NUM(1,I1)=IPT1.NUM(2,I1) 200 : ENDDO 201 : MELRES=IPT2 202 : SEGDES IPT1 203 : SEGDES IPT2 204 : C 205 : C**** Noms de variables conservatives 206 : C 207 : TYPE='LISTMOTS' 207 : CALL LIROBJ(TYPE,ILIINC,1,IRET) 208 : IF(IERR .NE. 0) GOTO 9999 209 : MLMOTS = ILIINC 210 : SEGACT MLMOTS 211 : NBCOMP = MLMOTS.MOTS(/2) 212 : SEGDES MLMOTS 213 : IF(NBCOMP .NE. (IDIM+2))THEN 214 : MOTERR(1:40) = 'LISTINCO = ???' 215 : WRITE(IOIMP,*) MOTERR 216 : C 217 : C******* Message d'erreur standard 218 : C 21 2 219 : C Données incompatibles 220 : C 220 : CALL ERREUR(21) 221 : GOTO 9999 222 : ENDIF 223 : C 224 : C**** Noms de variables primitives 225 : C 226 : TYPE='LISTMOTS' 226 : CALL LIROBJ(TYPE,ILIINP,1,IRET) 227 : IF(IERR .NE. 0) GOTO 9999 228 : MLMOTS = ILIINP 229 : SEGACT MLMOTS 230 : NBCOMP = MLMOTS.MOTS(/2) 231 : SEGDES MLMOTS 232 : IF(NBCOMP .NE. (IDIM+2))THEN 233 : MOTERR(1:40) = 'LISTPRIM = ???' 234 : WRITE(IOIMP,*) MOTERR 235 : C 236 : C******* Message d'erreur standard 237 : C 21 2 238 : C Données incompatibles 239 : C 239 : CALL ERREUR(21) 240 : GOTO 9999 241 : ENDIF 242 : C 243 : C**** Lecture du CHPOINT RN 244 : C 245 : TYPE='CHPOINT ' 245 : CALL LIROBJ(TYPE,IROC,1,IRET) 246 : IF (IERR.NE.0) GOTO 9999 247 : C 248 : C**** Control du CHPOINT: QUEPOI 249 : C 250 : C INDIC = 1 -> on impose le pointeur du support geometrique 251 : C NBCOMP > 0 -> nombre des composantes 252 : C 253 : INDIC = 1 254 : NBCOMP = 1 255 : MOT = 'SCAL' 255 : CALL QUEPOI(IROC, MELEMC, INDIC, NBCOMP, MOT) 256 : IF(IERR .NE. 0)GOTO 9999 257 : C 258 : C**** Lecture du CHPOINT VITC 259 : C 259 : CALL LIROBJ('CHPOINT',IVITC,1,IRET) 260 : IF (IERR.NE.0) GOTO 9999 261 : C 262 : C**** Control du CHPOINT 263 : C 264 : JGN = 4 265 : JGM = IDIM 266 : SEGINI MLMVIT 267 : MLMVIT.MOTS(1) = 'UX ' 268 : MLMVIT.MOTS(2) = 'UY ' 269 : IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ ' 269 : CALL QUEPO1(IVITC, MELEMC, MLMVIT) 270 : SEGSUP MLMVIT 271 : IF(IERR .NE. 0)GOTO 9999 272 : C 273 : C**** Lecture du CHPOINT PC 274 : C 274 : CALL LIROBJ('CHPOINT',IPC,1,IRET) 275 : IF (IERR.NE.0) GOTO 9999 276 : C 277 : C**** Control du CHPOINT 278 : C 279 : INDIC = 1 280 : NBCOMP = 1 281 : MOT = 'SCAL' 281 : CALL QUEPOI(IPC, MELEMC, INDIC, NBCOMP, MOT) 282 : IF(IERR .NE. 0)GOTO 9999 283 : C 284 : C**** Lecture du CHPOINT GAMC 285 : C 285 : CALL LIROBJ('CHPOINT',IGAMC,1,IRET) 286 : IF (IERR.NE.0) GOTO 9999 287 : C 288 : C**** Control du CHPOINT 289 : C 290 : INDIC = 1 291 : NBCOMP = 1 292 : MOT = 'SCAL' 292 : CALL QUEPOI(IGAMC, MELEMC, INDIC, NBCOMP, MOT) 293 : IF(IERR .NE. 0)GOTO 9999 294 : C 295 : C**** CHPOINT condition limite 296 : C 296 : CALL LIROBJ('CHPOINT',ICHLIM,1,IRET) 297 : IF (IERR.NE.0) GOTO 9999 298 : C 299 : C**** Resultats 300 : C 301 : IF(IJAC .EQ.0)THEN 302 : TYPE=' ' 302 : CALL KRCHP1(TYPE,MELRES,ICHRES,ILIINC) 303 : C 304 : TYPE=' ' 304 : CALL KRCHP1(TYPE,MELECB,ICHRLI,ILIINP) 305 : ELSE 306 : ICHRES=0 307 : ICHRLI=0 308 : ENDIF 309 : C 310 : C**** TYPE DE CONDITION LIMITE 311 : C 311 : CALL LIRMOT(LOPT,NBOPT,ILIM,1) 312 : IF(IERR .NE. 0) GOTO 9999 313 : IF(ILIM .EQ. 1)THEN 314 : C 315 : C******** 'INRI ' 316 : C 317 : JGN = 4 318 : JGM = IDIM+2 319 : SEGINI MLMVIT 320 : MLMVIT.MOTS(1) = 'RN ' 321 : MLMVIT.MOTS(2) = 'UX ' 322 : MLMVIT.MOTS(3) = 'UY ' 323 : IF(IDIM .EQ. 3) MLMVIT.MOTS(4) = 'UZ ' 324 : MLMVIT.MOTS(2+IDIM)='PN ' 324 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 325 : SEGSUP MLMVIT 326 : IF (IERR.NE.0) GOTO 9999 327 : C 328 : IF(IJAC.EQ.0)THEN 328 : CALL CLI111(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU, 329 : & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI) 330 : IF(IERR.NE.0)GOTO 9999 331 : ELSE 332 : IF(IDIM.EQ.2)THEN 332 : CALL CLI112(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 333 : $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 334 : $ ,ILIINP,IJAC,IJACO) 335 : ELSE 335 : CALL CLI113(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 336 : $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 337 : $ ,ILIINP,IJAC,IJACO) 338 : ENDIF 339 : IF(IERR.NE.0)GOTO 9999 340 : ENDIF 341 : ELSEIF(ILIM .EQ. 2)THEN 342 : C 343 : C******** 'OUTRI ' 344 : C 345 : JGN = 4 346 : JGM = IDIM+2 347 : SEGINI MLMVIT 348 : MLMVIT.MOTS(1) = 'RN ' 349 : MLMVIT.MOTS(2) = 'UX ' 350 : MLMVIT.MOTS(3) = 'UY ' 351 : IF(IDIM .EQ. 3) MLMVIT.MOTS(4) = 'UZ ' 352 : MLMVIT.MOTS(2+IDIM)='PN ' 352 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 353 : SEGSUP MLMVIT 354 : IF (IERR.NE.0) GOTO 9999 355 : C 356 : IF(IJAC.EQ.0)THEN 356 : CALL CLI121(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU, 357 : & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI) 358 : IF(IERR.NE.0)GOTO 9999 359 : ELSE 360 : IF(IDIM.EQ.2)THEN 360 : CALL CLI122(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 361 : $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 362 : $ ,ILIINP,IJAC,IJACO) 363 : ELSE 363 : CALL CLI123(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 364 : $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 365 : $ ,ILIINP,IJAC,IJACO) 366 : ENDIF 367 : IF(IERR.NE.0)GOTO 9999 368 : ENDIF 369 : ELSEIF(ILIM .EQ. 3)THEN 370 : C 371 : C******** 'INSS ' 372 : C 373 : JGN = 4 374 : JGM = IDIM+2 375 : SEGINI MLMVIT 376 : MLMVIT.MOTS(1) = 'RN ' 377 : MLMVIT.MOTS(2) = 'UX ' 378 : MLMVIT.MOTS(3) = 'UY ' 379 : IF(IDIM .EQ. 3) MLMVIT.MOTS(4) = 'UZ ' 380 : MLMVIT.MOTS(2+IDIM)='PN ' 380 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 381 : SEGSUP MLMVIT 382 : IF (IERR.NE.0) GOTO 9999 383 : C 384 : IF(IJAC.EQ.0)THEN 384 : CALL CLI131(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU, 385 : & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI) 386 : IF(IERR.NE.0)GOTO 9999 387 : ELSE 388 : * Le Jacobien est une matrik vide 389 : NRIGE=7 390 : NMATRI=0 391 : NKID =9 392 : NKMT =7 393 : SEGINI MATRIK 394 : SEGDES MATRIK 395 : IJACO=MATRIK 396 : ENDIF 397 : ELSEIF(ILIM .EQ. 4)THEN 398 : C 399 : C******** 'OUTSS ' 400 : C 401 : C ICHLIM est un CHPOINT vide 402 : C Mais on fait pas de controlle 403 : C 404 : IF(IJAC.EQ.0)THEN 404 : CALL CLI141(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU, 405 : & IROC,IVITC,IPC,IGAMC,ICHRES,ICHRLI) 406 : IF(IERR.NE.0)GOTO 9999 407 : ELSE 408 : IF(IDIM.EQ.2)THEN 408 : CALL CLI142(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 409 : $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ILIINC 410 : $ ,ILIINP,IJAC,IJACO) 411 : ELSE 411 : CALL CLI143(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 412 : $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ILIINC 413 : $ ,ILIINP,IJAC,IJACO) 414 : ENDIF 415 : IF(IERR.NE.0)GOTO 9999 416 : ENDIF 417 : ELSEIF(ILIM .EQ. 5)THEN 418 : C 419 : C******** 'OUTP ' 420 : C 421 : JGN = 4 422 : JGM = 1 423 : SEGINI MLMVIT 424 : MLMVIT.MOTS(1)='PN ' 424 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 425 : SEGSUP MLMVIT 426 : IF (IERR.NE.0) GOTO 9999 427 : C 428 : IF(IJAC.EQ.0)THEN 428 : CALL CLI151(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU, 429 : & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI) 430 : IF(IERR.NE.0)GOTO 9999 431 : ELSE 432 : IF(IDIM.EQ.2)THEN 432 : CALL CLI152(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 433 : $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 434 : $ ,ILIINP,IJAC,IJACO) 435 : ELSE 435 : CALL CLI153(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 436 : $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 437 : $ ,ILIINP,IJAC,IJACO) 438 : ENDIF 439 : ENDIF 440 : ELSEIF(ILIM .EQ. 6)THEN 441 : C 442 : C******** 'INSU ' 443 : C 444 : JGN = 4 445 : JGM = 2 446 : SEGINI MLMVIT 447 : MLMVIT.MOTS(1) = 'HT ' 448 : MLMVIT.MOTS(2) = 'S ' 448 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 449 : SEGSUP MLMVIT 450 : IF (IERR.NE.0) GOTO 9999 451 : C 452 : IF(IJAC.EQ.0)THEN 452 : CALL CLI161(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU, 453 : & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI) 454 : IF(IERR.NE.0)GOTO 9999 455 : ELSE 456 : IF(IDIM.EQ.2)THEN 456 : CALL CLI162(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 457 : & ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 458 : & ,ILIINP,IJAC,IJACO) 459 : ELSE 459 : CALL CLI163(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 460 : $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 461 : $ ,ILIINP,IJAC,IJACO) 462 : ENDIF 463 : ENDIF 464 : ELSEIF(ILIM .EQ. 7)THEN 465 : C 466 : C******** 'INJE ' 467 : C 468 : JGN = 4 469 : JGM = 2 470 : SEGINI MLMVIT 471 : MLMVIT.MOTS(1) = 'MOME' 472 : MLMVIT.MOTS(2) = 'RT ' 472 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 473 : SEGSUP MLMVIT 474 : IF (IERR.NE.0) GOTO 9999 475 : C 476 : IF(IJAC.EQ.0)THEN 476 : CALL CLI181(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU, 477 : & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI) 478 : IF(IERR.NE.0)GOTO 9999 479 : ELSE 480 : IF(IDIM.EQ.2)THEN 480 : CALL CLI182(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 481 : & ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 482 : & ,ILIINP,IJAC,IJACO) 483 : ELSE 483 : CALL CLI183(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 484 : $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 485 : $ ,ILIINP,IJAC,IJACO) 486 : ENDIF 487 : ENDIF 488 : ELSEIF(ILIM .EQ. 8)THEN 489 : C 490 : C******** 'INJELM ' 491 : C 492 : JGN = 4 493 : JGM = 2 494 : SEGINI MLMVIT 495 : MLMVIT.MOTS(1) = 'MOME' 496 : MLMVIT.MOTS(2) = 'RT ' 496 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 497 : SEGSUP MLMVIT 498 : IF (IERR.NE.0) GOTO 9999 499 : C 500 : IF(IJAC.EQ.0)THEN 500 : CALL CLI171(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU, 501 : & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI) 502 : IF(IERR.NE.0)GOTO 9999 503 : ELSE 504 : IF(IDIM.EQ.2)THEN 504 : CALL CLI172(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 505 : & ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 506 : & ,ILIINP,IJAC,IJACO) 507 : ELSE 507 : CALL CLI173(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM 508 : $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC 509 : $ ,ILIINP,IJAC,IJACO) 510 : ENDIF 511 : ENDIF 512 : ELSEIF(ILIM .EQ. 9)THEN 513 : C 514 : C******** 'INSO ' 515 : C 516 : JGN = 4 517 : JGM = 2 518 : SEGINI MLMVIT 519 : MLMVIT.MOTS(1) = 'PSTA' 520 : MLMVIT.MOTS(2) = 'RSTA' 520 : CALL QUEPO1(ICHLIM, MELECB, MLMVIT) 521 : SEGSUP MLMVIT 522 : IF (IERR.NE.0) GOTO 9999 523 : C 524 : IF(IJAC.EQ.0)THEN 524 : CALL CLI191(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU, 525 : & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI) 526 : IF(IERR.NE.0)GOTO 9999 527 : ENDIF 528 : ENDIF 529 : C 530 : IF(IJAC.EQ.0)THEN 530 : CALL ECROBJ('CHPOINT ',ICHRES) 530 : CALL ECROBJ('CHPOINT ',ICHRLI) 531 : ELSE 531 : CALL ECROBJ('MATRIK ',IJACO) 532 : ENDIF 533 : C 534 : 9999 CONTINUE 535 : RETURN 536 : END 537 : 538 : 539 : 540 : 541 : 542 : 543 : 544 : 545 : 546 : 547 : 548 : 549 :
© Cast3M 2003 - All rights reserved.
Disclaimer