1 : C KONV SOURCE MAGN 10/05/18 21:15:55 6675 2 : SUBROUTINE KONV 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C 7 : C CET OPERATEUR DISCRETISE LE TERME DE TRANSPORT 8 : C EN 2D SUR LES ELEMENTS QUA4 ET TRI3 PLAN OU AXI 9 : C EN 3D SUR LES ELEMENTS CUB8 ET PRI6 10 : C EN 0D SUR LES ELEMENTS POI1 11 : C 12 : C EN VOLUMES FINIS, DISCRETISATION DES EQUATIONS D'EULERS 13 : C 14 : C 15 : C SYNTAXE : 16 : C --------- 17 : C 18 : C KONV RO UNINCO TN : 19 : C 20 : C COEFFICIENTS : 21 : C -------------- 22 : C 23 : C 24 : C ALF (SCAL DOMA) DIFFUSIVITE THERMIQUE 25 : C (SCAL ELEM) 26 : C 27 : C INCONNUES : 28 : C ----------- 29 : C 30 : C TN CHAMP DE TEMPERATURE 31 : C 32 : C************************************************************************ 33 : 34 : -INC CCVQUA4 35 : -INC CCOPTIO 36 : -INC CCGEOME 37 : -INC SMCOORD 38 : -INC SMLENTI 39 : POINTEUR IZIPAD.MLENTI,IPADI.MLENTI,IPADS.MLENTI,IPADU.MLENTI 40 : -INC SMELEME 41 : POINTEUR MELEMS.MELEME,MELEMC.MELEME,MELEMI.MELEME 42 : POINTEUR MELEMA.MELEME,MELEMF.MELEME 43 : -INC SMCHAML 44 : -INC SMCHPOI 45 : POINTEUR MCHPIN.MCHPOI 46 : POINTEUR MZUN.MPOVAL,MZUN2.MPOVAL,MZMU.MPOVAL 47 : POINTEUR MZDT.MPOVAL,MZPHI.MPOVAL 48 : POINTEUR MRO.MCHPOI,MZRO.MPOVAL 49 : POINTEUR IZTG2.MCHPOI,IZTG3.MCHPOI 50 : POINTEUR IZTGG2.MPOVAL,IZTGG3.MPOVAL 51 : POINTEUR IZTU1.MPOVAL,IZTU2.MPOVAL,IZTU3.MPOVAL,IZTU4.MPOVAL 52 : POINTEUR IZTG5.MPOVAL 53 : POINTEUR IZVOL.MPOVAL,IZTCO.MPOVAL,IZDIAE.MPOVAL,IZTDI.MPOVAL 54 : 55 : -INC SIZFFB 56 : PARAMETER (LRV=64) 57 : SEGMENT PETROV 58 : REAL*8 WT(LRV,NP,NPG,KDIM),WS(LRV,NP,NPG,KDIM),HK(LRV,IDIM,NP,NPG) 59 : REAL*8 UIL(LRV,IDIM,NPG),DUIL(LRV,IDIM,NPG) 60 : REAL*8 PGSK(LRV,NPG),RPGK(LRV,NPG),AIRE(LRV),ANUK(LRV),COEFK(LRV) 61 : REAL*8 AJK(LRV,IDIM,IDIM,NPG) 62 : ENDSEGMENT 63 : 64 : -INC SMMATRIK 65 : POINTEUR IPM.IZAFM 66 : 67 : SEGMENT IMATRS 68 : INTEGER LIZAFS(NBSOUS,NBME) 69 : ENDSEGMENT 70 : POINTEUR IPS1.IZAFM,IPS2.IZAFM,IPS3.IZAFM,IPMS.IZAFM 71 : 72 : -INC SMTABLE 73 : POINTEUR KIZG.TABLE,MTABX.MTABLE,MTABT.MTABLE 74 : POINTEUR KINC.TABLE,RESU.MTABLE 75 : POINTEUR MTABZ.MTABLE 76 : -INC SMLMOTS 77 : POINTEUR LINCO.MLMOTS 78 : CHARACTER*8 NOMZ,NOMI,NOMA,TYPE,CHAI,TYPC,TYPCFI,NOM 79 : CHARACTER*8 NOM0,NOMII,MTYP,NMACO 80 : CHARACTER*4 NOM4(3), CELCAR 81 : REAL*8 XYZI(24) 82 : LOGICAL LOGI 83 : PARAMETER (NTB=2) 84 : CHARACTER*8 LTAB(NTB) 85 : DIMENSION KTAB(NTB),IXV(3) 86 : * save ipas 87 : * data ipas/1/ 88 : C 89 : C**** EN VOLUMES FINIS, KONV est un operatéur normal, 90 : C (voir KONV1) 91 : C i.e. 92 : C 93 : C JACO RESI DELTAT = 'KONV' 'VF' ... 94 : C 95 : C***************************************************************************** 96 : 97 : CKONV 98 : C WRITE(6,*)' Opérateur KONV' 99 : C 100 : C***************************************************************************** 101 : C 102 : C Deux traitements différents suivant la discrétisation 2D/3D ou 0D 103 : C (respectivement, table d'entrée de soustype KIZX 104 : C ou de soustype OPER_0D) 105 : C 106 : 107 : 108 : C Nouvelle directive EQUA de EQEX 109 : MTYP=' ' 109 : CALL QUETYP(MTYP,0,IRET) 110 : IF(IRET.EQ.0)THEN 111 : C% On attend un des objets : %m1:8 %m9:16 %m17:24 %m25:32 %m33:40 112 : MOTERR( 1: 8) = 'CHAI ' 113 : MOTERR( 9:16) = 'MMODEL ' 114 : C MOTERR(17:24) = 'TABLE ' 114 : CALL ERREUR(472) 115 : RETURN 116 : ENDIF 117 : 118 : IF(MTYP.EQ.'MMODEL')THEN 118 : CALL LIRCHA(CHAI,1,IRET) 119 : IF(CHAI.EQ. 'VF ')THEN 119 : CALL KONV1 120 : GOTO 9999 121 : ENDIF 121 : CALL YTCLSF(' C ','KONV ') 122 : RETURN 123 : ELSEIF(MTYP.EQ.'MOT ')THEN 123 : CALL LIRCHA(CHAI,1,IRET) 124 : IF(CHAI.EQ. 'VF ')THEN 124 : CALL KONV1 125 : GOTO 9999 126 : ELSE 126 : CALL YTCLSF(CHAI,'KONV ') 127 : ENDIF 128 : RETURN 129 : ENDIF 130 : C Fin Nouvelle directive EQUA de EQEX 131 : 132 : 133 : 134 : LTAB(1) = 'KIZX ' 135 : LTAB(2) = 'OPER_0D ' 136 : KTAB(1) = 0 137 : KTAB(2) = 0 137 : CALL LITABS(LTAB,KTAB,NTB,0,IRET) 138 : IF(IRET.EQ.0)THEN 139 : WRITE(6,*)' Opérateur KONV :' 140 : WRITE(6,*)' On attend un ensemble de table soustypes' 141 : RETURN 142 : ENDIF 143 : C 144 : C Bifurcation en cas de discrétisation 0D 145 : C 146 : IF (KTAB(1).NE.0) THEN 147 : MTABX = KTAB(1) 148 : 148 : CALL LEKTAB(MTABX,'EQEX',MTAB1) 149 : IF(MTAB1.EQ.0)THEN 150 : WRITE(6,*)' Opérateur KONV :' 151 : WRITE(6,*)' On ne trouve pas l''indice EQEX ? ' 152 : RETURN 153 : ENDIF 153 : CALL ACME(MTAB1,'NAVISTOK',NASTOK) 154 : IF(NASTOK.EQ.0)THEN 154 : CALL ZKONV(MTABX,MTAB1) 155 : RETURN 156 : ENDIF 157 : ELSEIF (KTAB(2).NE.0) THEN 158 : IPTAB1 = KTAB(2) 158 : CALL TOCONV (IPTAB1) 159 : RETURN 160 : ELSE 161 : WRITE(6,*)' Opérateur KONV :' 162 : WRITE(6,*)' On attend une table de soustype KIZX ou OPER_0D' 163 : RETURN 164 : ENDIF 165 : 166 : 167 : C***************************************************************************** 168 : C Traitement des options 169 : C KIMPL = 0 -> EXPL 1 -> IMPL 2 -> CN 170 : C KFORM = 0 -> SI 1 -> EF 2 -> VF 3 -> EFMC 171 : C IDCEN = 0 -> rien 1 -> CENTREE 2 -> HU.BR 3 -> SUPG 4 -> T VISQ 172 : 173 : C 174 : C- Récupération de la table des options KOPT (pointeur KOPTI) 175 : C 175 : CALL LEKTAB(MTABX,'KOPT',KOPTI) 176 : IF (KOPTI.EQ.0) THEN 177 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 178 : MOTERR( 1: 8) = ' KOPT ' 179 : MOTERR( 9:16) = ' KOPT ' 180 : MOTERR(17:24) = ' KIZX ' 180 : CALL ERREUR(786) 181 : RETURN 182 : ENDIF 183 : 184 : IAXI=0 185 : IF(IFOMOD.EQ.0)IAXI=2 186 : 187 : KDIM=1 187 : CALL ACME(KOPTI,'IDCEN',IDCEN) 188 : IF(IDCEN.EQ.2)KDIM=IDIM 188 : CALL ACME(KOPTI,'IKOMP',IKOMP) 188 : CALL ACME(KOPTI,'KIMPL',KIMPL) 188 : CALL ACME(KOPTI,'KFORM',KFORM) 188 : CALL ACME(KOPTI,'ISCHT',ISCHT) 188 : CALL ACME(KOPTI,'IDIV',IDIV) 188 : CALL ACMF(KOPTI,'CMD',CMD) 188 : CALL ACME(KOPTI,'KMACO',KMACO) 188 : CALL ACMF(KOPTI,'AIMPL',AIMPL) 189 : AG=AIMPL 190 : AD=AIMPL-1.D0 191 : IF(ISCHT.EQ.2)THEN 192 : AG=1.D0 193 : AD=-1.D0 194 : ENDIF 195 : IF (IERR.NE.0) RETURN 196 : 197 : C***************************************************************************** 198 : C***************************************************************************** 199 : C 200 : C ----- Cas d'un schéma Explicite en Volume Fini : 201 : C ---------------------------------------- 202 : if (KIMPL .EQ. 0 .and. KFORM . EQ. 2) then 202 : call ckon(MTABX) 203 : RETURN 204 : ENDIF 205 : C***************************************************************************** 206 : C 207 : C- Récupération de la table DOMAINE associée au domaine local 208 : C 208 : CALL ACMM(MTABX,'NOMZONE',NOMZ) 208 : CALL LEKTAB(MTABX,'DOMZ',MTABZ) 209 : IF(MTABZ.EQ.0)THEN 210 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 211 : MOTERR( 1: 8) = ' DOMZ ' 212 : MOTERR( 9:16) = ' DOMZ ' 213 : MOTERR(17:24) = ' KIZX ' 213 : CALL ERREUR(786) 214 : RETURN 215 : ENDIF 216 : 216 : CALL LEKTAB(MTABZ,'MAILLAGE',MELEME) 216 : CALL LEKTAB(MTABZ,'SOMMET',MELEMS) 216 : CALL LEKTAB(MTABZ,'CENTRE',MELEMC) 217 : IF (IERR.NE.0) RETURN 218 : 219 : C************************************************************************* 220 : C VERIFICATIONS SUR LES INCONNUES 221 : C write(6,*)' Verification des inconnues ' 222 : 223 : TYPE='LISTMOTS' 223 : CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO) 224 : SEGACT LINCO 225 : 226 : NBINC=LINCO.MOTS(/2) 227 : IF((NBINC.NE.1).AND.(KFORM.NE.3))THEN 228 : WRITE(6,*)' Opérateur KONV :' 229 : WRITE(6,*)'Nombre d''inconnues incorrecte : ',NBINC,' On attend 1' 230 : RETURN 231 : ENDIF 232 : 233 : IF((NBINC.NE.2).AND.(KFORM.EQ.3))THEN 234 : WRITE(6,*)' Opérateur KONV :' 235 : WRITE(6,*)'Nombre d''inconnues incorrecte : ',NBINC,' On attend 2' 236 : RETURN 237 : ENDIF 238 : 239 : NOMI=LINCO.MOTS(1) 240 : 241 : IF (KFORM.EQ.3) NOMII=LINCO.MOTS(2) 242 : 242 : CALL LEKTAB(MTAB1,'INCO',KINC) 243 : IF(KINC.EQ.0)THEN 244 : WRITE(6,*)' Opérateur KONV :' 245 : WRITE(6,*)'Il n''y a pas de table INCO ? ?.' 246 : RETURN 247 : ENDIF 248 : 249 : TYPE=' ' 249 : CALL ACMO(KINC,NOMI,TYPE,MCHPOI) 250 : IF(TYPE.NE.'CHPOINT ')THEN 251 : WRITE(6,*)' Opérateur KONV :' 252 : WRITE(6,*)' L objet CHPOINT ',NOMI,' n existe pas dans la table' 253 : RETURN 254 : ELSE 254 : CALL LICHT(MCHPOI,IZTU1,TYPC,MELEMI) 255 : MCHPIN=MCHPOI 256 : IKT=0 257 : ENDIF 258 : 259 : NINKO=IZTU1.VPOCHA(/2) 260 : NPTI = IZTU1.VPOCHA(/1) 261 : IF(NINKO.EQ.1)THEN 262 : WRITE(NOM4(1),FMT='(A4)')NOMI(1:4) 263 : ELSE 264 : DO 15 I=1,NINKO 265 : WRITE(NOM4(I),FMT='(I1,A3)')I,NOMI(1:3) 266 : 15 CONTINUE 267 : ENDIF 268 : 269 : IF (KFORM.EQ.3) THEN 270 : TYPE=' ' 270 : CALL ACMO(KINC,NOMII,TYPE,MCHPOI) 271 : IF(TYPE.NE.'CHPOINT ')THEN 272 : WRITE(6,*)' Opérateur KONV :' 273 : WRITE(6,*)' L objet CHPOINT ',NOMII, 274 : & ' n existe pas dans la table' 275 : RETURN 276 : ELSE 276 : CALL LICHT(MCHPOI,IZTU2,TYPCFI,IGEOM0) 277 : MZPHI=IZTU2 278 : IKT=0 279 : ENDIF 280 : END IF 281 : C***************************************************************************** 282 : C Le domaine de definition est donne par le SPG de la premiere inconnue 283 : C Les inconnues suivantes devront posseder ce meme pointeur 284 : C On verifie que les points de la zone sont tous inclus dans ce SPG 285 : 285 : CALL KRIPAD(MELEMI,IPADI) 286 : IPADS=IPADI 287 : NPTS=NPTI 288 : IF(MELEMI.NE.MELEMS)THEN 288 : CALL KRIPAD(MELEMS,IPADS) 289 : NPTS=MELEMS.NUM(/2) 290 : ENDIF 291 : IPADU=IPADI 292 : NPTU=NPTI 293 : * TC mise en commentaired des lignes suivantes car ipasn'est jamais =0 294 : * IF(IPAS.EQ.0)THEN 294 : * IF (KFORM.EQ.3) CALL KRIPAD(MELEMC,MLENT1) 294 : * CALL VERPAD(IPADI,MELEME,IRET) 295 : * IF(IRET.NE.0)THEN 296 : * WRITE(6,*)' Opérateur KONV' 297 : * WRITE(6,*)' La zone ',NOMZ,' n''est pas incluse dans le domaine' 298 : * IPAS=0 299 : * RETURN 300 : * ENDIF 301 : * ENDIF 302 : 303 : C***************************************************************************** 304 : 305 : IF(KFORM.NE.1)THEN 306 : C***************************************************************************** 307 : C Lecture du ou des coefficients 308 : C Type du coefficient : 309 : C IK1=0 CHPOINT IK1=1 scalaire IK1=2 vecteur 310 : 311 : c write(6,*)' Opérateur KONV lecture des coefficients' 311 : CALL ACME(MTABX,'IARG',IARG) 312 : ICD=0 313 : IF(ISCHT.EQ.2)ICD=1 314 : IF((IARG.LT.(2+ICD).AND.IDCEN.EQ.1) 315 : &.OR.(IARG.LT.(3+ICD).AND.IDCEN.LT.4) 316 : &.OR.(IARG.LT.(4+ICD).AND.IDCEN.GE.4))THEN 317 : WRITE(6,*)' Opérateur KONV : option incompréssible ' 318 : WRITE(6,*)' Nombre d''arguments incorrect : ',IARG 319 : WRITE(6,*)' On attend 2 ou plus suivant l''option' 320 : RETURN 321 : ENDIF 322 : 323 : c write(6,*)' KONV IARG=',iarg,melemc 324 : C 1er coefficient Densité 325 : IXV(1)=MELEMC 326 : IXV(2)=1 327 : IXV(3)=0 327 : CALL LEKCOF('Opérateur KONV :', 328 : & MTABX,KINC,1,IXV,MRO,MZRO,NPT1,NC1,IKR,IRET) 329 : IF(IRET.EQ.0)GO TO 90 330 : c write(6,*)' Apres LEKCOF' 331 : 332 : IZTGG2=MZRO 333 : IZTGG3=MZRO 334 : 335 : C 2ème coefficient UN , champ de vitesse transportant 336 : IXV(1)=-MELEMS 337 : IXV(2)=0 338 : IXV(3)=1 338 : CALL LEKCOF('Opérateur KONV :', 339 : & MTABX,KINC,2,IXV,MUN,MZUN,NPTU,NC2,IKU,IRET) 340 : IF(IRET.EQ.0)GO TO 90 341 : IF(IKU.EQ.2)IKU=1 341 : IF(IPADS.EQ.0.AND.IKU.EQ.0)CALL KRIPAD(MELEMS,IPADS) 342 : IPADU=IPADS 343 : 344 : IF(ISCHT.EQ.2)THEN 345 : C si ISCHT=2 TN-2 ou UN-2 , champ transporte au temps n-2 346 : IXV(1)=-MELEMS 347 : IF(NINKO.EQ.1)IXV(1)=MELEMS 348 : IXV(2)=0 349 : IXV(3)=1 349 : CALL LEKCOF('Opérateur KONV :', 350 : & MTABX,KINC,(2+ICD),IXV,MUN,MZUN2,NPTU,NC2,IKU,IRET) 351 : IF(IRET.EQ.0)GO TO 90 352 : IF(IKU.EQ.2)IKU=1 352 : IF(IPADS.EQ.0.AND.IKU.EQ.0)CALL KRIPAD(MELEMS,IPADS) 353 : IPADU=IPADS 354 : ENDIF 355 : 356 : IF(IARG.GE.(3+ICD))THEN 357 : C 3ème coefficient viscosité 358 : IXV(1)=MELEMC 359 : IXV(2)=1 360 : IXV(3)=0 360 : CALL LEKCOF('Opérateur KONV :', 361 : & MTABX,KINC,(3+ICD),IXV,MMU,MZMU,NPT3,NC3,IKM,IRET) 362 : IF(IRET.EQ.0)GO TO 90 363 : ELSE 363 : CALL LEKTAB(MTABX,'ARGS3',MMU) 363 : CALL LICHT(MMU,MZMU,TYPC,IGEOM0) 364 : MZMU.VPOCHA(1,1)=1.D0 365 : IKM=1 366 : 367 : ENDIF 368 : 369 : IF(IARG.EQ.(4+ICD))THEN 370 : C 4ème coefficient Dt 371 : IXV(1)=0 372 : IXV(2)=1 373 : IXV(3)=0 373 : CALL LEKCOF('Opérateur KONV :', 374 : & MTABX,KINC,(4+ICD),IXV,MDT,MZDT,NPT4,NC4,IKT,IRET) 375 : IF(IRET.EQ.0)RETURN 376 : DT=MZDT.VPOCHA(1,1) 377 : ELSE 378 : DT=0.D0 379 : 380 : ENDIF 381 : 382 : c write(6,*)' Opérateur KONV : Fin lecture Arguments ' 383 : C Fin lecture Arguments ************************************************ 384 : ENDIF 385 : 386 : 387 : C************************************************************************* 388 : IF(KFORM.EQ.0)THEN 389 : C CAS FORMULATION EF SI (GRESHO) 390 : 391 : WRITE(6,*)' Operateur KONV ' 392 : WRITE(6,*)' Option invalide ' 393 : GO TO 90 394 : C************************************************************************* 395 : ELSEIF(KFORM.EQ.1)THEN 396 : C CAS FORMULATION EF 397 : 398 : c write(6,*)' On va appeler YCLS ' 399 : NINKO=IZTU1.VPOCHA(/2) 400 : IHV=0 401 : IF(NINKO.EQ.IDIM)IHV=1 402 : 402 : CALL YCLS('KONV ',MTABX,IHV,MCHPIN,NOMI,MATRIK,MCHPO1) 403 : 403 : CALL ECROBJ('MATRIK',MATRIK) 403 : CALL ECROBJ('CHPOINT',MCHPO1) 404 : 405 : RETURN 406 : C************************************************************************* 407 : ELSE IF(KFORM.EQ.2)THEN 408 : C CAS FORMULATION VF 409 : 409 : C CALL LEKTAB(MTABZ,'FACE',MELEMF) 409 : C CALL LEKTAB(MTABZ,'CENTRE',MELEMC) 409 : CALL LEKTAB(MTABZ,'FACEL',MFACEL) 409 : CALL LEKTAB(MTABZ,'ELTFA',MELTFA) 409 : CALL LEKTAB(MTABZ,'ELKONV',MELEME) 409 : C CALL ELCONV(MELTFA,MFACEL,MELEMF,MELEMC,MELEME) 410 : 411 : SEGACT MELEME 412 : NBSOUS=LISOUS(/1) 413 : IF(NBSOUS.EQ.0)NBSOUS=1 414 : 415 : NRIGE=7 416 : NKID =9 417 : NKMT =7 418 : NMATRI=1 419 : SEGINI MATRIK 420 : IRIGEL(1,1)=MELEME 421 : IRIGEL(2,1)=MELEMC 422 : IRIGEL(7,1)=2 423 : NBOP=0 424 : NBME=NINKO 425 : SEGINI IMATRI,IMATRS 426 : IRIGEL(4,1)=IMATRI 427 : KSPGP=MELEMC 428 : KSPGD=MELEMC 429 : 430 : IF(NBME.EQ.1)THEN 431 : LISPRI(1)=NOMI(1:4)//' ' 432 : LISDUA(1)=NOMI(1:4)//' ' 433 : ELSE 434 : DO 202 I=1,NBME 435 : WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7) 436 : LISPRI(I)=NOM(1:4)//' ' 437 : LISDUA(I)=NOM(1:4)//' ' 438 : 202 CONTINUE 439 : ENDIF 440 : 441 : C* Lecture du tableau donnant le sens des normales par element 441 : CALL LEKTAB(MTABZ,'XXNORMAE',MCHELM) 442 : IF(MCHELM.EQ.0)GO TO 90 443 : SEGACT MCHELM 443 : CALL LEKTAB(MTABZ,'XXSURFAC',MCHPO1) 443 : CALL LICHT(MCHPO1,MPOVA1,TYPE,IGEOM) 444 : C* Lecture des connectivites elements/faces 444 : CALL LEKTAB(MTABZ,'ELTFA',MELEMA) 445 : IF(MELEMA.EQ.0)GO TO 90 446 : SEGACT MELEMA 446 : CALL KRIPAD(MELEMF,IPADI) 446 : IF(IKR.EQ.0)CALL KRIPAD(MELEMC,MLENT1) 447 : 448 : KK=0 449 : DO 201 L=1,NBSOUS 450 : IPT1=MELEME 451 : IPT2=MELEMA 452 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 453 : IF(NBSOUS.NE.1)IPT2=MELEMA.LISOUS(L) 454 : SEGACT IPT1,IPT2 455 : 456 : NP = IPT1.NUM(/1) 457 : NBF=NP-1 458 : MP = 1 459 : C write(6,*)' np,nbf,mp=',np,nbf,mp 460 : NBEL=IPT1.NUM(/2) 461 : SEGINI IPM1,IPMS 462 : LIZAFM(L,1)=IPM1 463 : LIZAFS(L,1)=IPMS 464 : IPM2=IPM1 465 : IPM3=IPM1 466 : IF(NBME.GE.2)THEN 467 : LIZAFM(L,2)=IPM1 468 : ENDIF 469 : IF(NBME.GE.3)THEN 470 : LIZAFM(L,3)=IPM1 471 : ENDIF 472 : 473 : MCHAML=ICHAML(L) 474 : SEGACT MCHAML 475 : MELVAL=IELVAL(1) 476 : SEGACT MELVAL 477 : 478 : C write(6,*)' IKR=',ikr 479 : 480 : IF(IKR.EQ.1)THEN 481 : C write(6,*)' NBEL=',NBEL,' NBF=',NBF 482 : DO 210 K=1,NBEL 483 : DO 211 I=1,NBF 484 : NF=IPT2.NUM(I,K) 485 : NF=IPADI.LECT(NF) 486 : C write(6,*)' NF=',NF,NP 487 : FI=IZTGG2.VPOCHA(NF,1)*MELVAL.VELCHE(I,K)*MPOVA1.VPOCHA(NF,1) 488 : &*MZRO.VPOCHA(1,1) 489 : IF(FI.LE.0.D0)THEN 490 : IPM1.AM(K,I,1)=FI 491 : ELSE 492 : IPM1.AM(K,NP,1)=IPM1.AM(K,NP,1)+FI 493 : ENDIF 494 : 211 CONTINUE 495 : 210 CONTINUE 496 : 497 : ELSEIF(IKR.EQ.0)THEN 498 : 499 : DO 212 K=1,NBEL 500 : KK=KK+1 501 : DO 213 I=1,NBF 502 : NF=IPT2.NUM(I,K) 503 : NF=IPADI.LECT(NF) 504 : NCR=MLENT1.LECT(KK) 505 : FI=IZTGG2.VPOCHA(NF,1)*MELVAL.VELCHE(I,K)*MPOVA1.VPOCHA(NF,1) 506 : &*MZRO.VPOCHA(NCR,1) 507 : IF(FI.LE.0.D0)THEN 508 : IPM1.AM(K,I,1)=FI 509 : ELSE 510 : IPM1.AM(K,NP,1)=IPM1.AM(K,NP,1)+FI 511 : ENDIF 512 : 213 CONTINUE 513 : 212 CONTINUE 514 : 515 : 516 : ENDIF 517 : 518 : 519 : 520 : SEGDES IPT1,IPM1,IPT2 521 : SEGSUP IPMS 522 : C write(6,*)' Fin bcl 201 ' 523 : 201 CONTINUE 524 : C write(6,*)' Apr bcl 201 ' 525 : SEGSUP IPADI 526 : SEGDES IMATRI 527 : SEGSUP IMATRS 528 : SEGDES MELEME,MATRIK 529 : 530 : IF(IKR.EQ.0)THEN 531 : SEGSUP MLENT1 532 : SEGDES MRO,MZRO 533 : ENDIF 534 : 534 : CALL ECMO(MTABX,'MATELM','MATRIK',MATRIK) 535 : 536 : RETURN 537 : C************************************************************************ 538 : ENDIF 539 : C************************************************************************* 540 : 541 : 90 CONTINUE 542 : WRITE(6,*)' Interuption anormale de KONV' 543 : 9999 RETURN 544 : END 545 : 546 : 547 : 548 : 549 : 550 : 551 : 552 : 553 : 554 : 555 : 556 : 557 : 558 : 559 : 560 : 561 : 562 : 563 : 564 : 565 : 566 : 567 : 568 : 569 : 570 :
© Cast3M 2003 - All rights reserved.
Disclaimer