1 : C ZKONV SOURCE MAGN 10/05/18 21:17:51 6675 2 : SUBROUTINE ZKONV(MTABX,MTAB1) 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 SYNTAXE : 13 : C --------- 14 : C 15 : C KONV RO UNINCO TN : 16 : C 17 : C COEFFICIENTS : 18 : C -------------- 19 : C 20 : C 21 : C ALF (SCAL DOMA) DIFFUSIVITE THERMIQUE 22 : C (SCAL ELEM) 23 : C 24 : C INCONNUES : 25 : C ----------- 26 : C 27 : C TN CHAMP DE TEMPERATURE 28 : C 29 : C************************************************************************ 30 : 31 : -INC CCVQUA4 32 : -INC CCOPTIO 33 : -INC CCGEOME 34 : -INC SMCOORD 35 : -INC SMLENTI 36 : POINTEUR IZIPAD.MLENTI,IPADI.MLENTI,IPADS.MLENTI,IPADU.MLENTI 37 : -INC SMELEME 38 : POINTEUR MELEMS.MELEME,MELEMC.MELEME 39 : POINTEUR MELEMA.MELEME,MELEMF.MELEME 40 : -INC SMCHAML 41 : -INC SMCHPOI 42 : POINTEUR MZRO.MPOVAL,MZUN.MPOVAL,MZMU.MPOVAL,MZTN.MPOVAL 43 : POINTEUR MZDT.MPOVAL,MZPHI.MPOVAL 44 : POINTEUR IZG1.MCHPOI, IZG2.MCHPOI ,MRO.MCHPOI 45 : POINTEUR IZGG1.MPOVAL,IZGG2.MPOVAL 46 : POINTEUR IZTG2.MCHPOI,IZTG3.MCHPOI 47 : POINTEUR IZTGG2.MPOVAL,IZTGG3.MPOVAL 48 : POINTEUR IZTU1.MPOVAL,IZTU2.MPOVAL,IZTU3.MPOVAL,IZTU4.MPOVAL 49 : POINTEUR IZTG5.MPOVAL 50 : POINTEUR IZVOL.MPOVAL,IZTCO.MPOVAL,IZDIAE.MPOVAL,IZTDI.MPOVAL 51 : 52 : -INC SIZFFB 53 : -INC SMMATRIK 54 : POINTEUR IPM.IZAFM 55 : 56 : SEGMENT IMATRS 57 : INTEGER LIZAFS(NBSOUS,NBME) 58 : ENDSEGMENT 59 : POINTEUR IPS1.IZAFM,IPS2.IZAFM,IPS3.IZAFM,IPMS.IZAFM 60 : 61 : -INC SMTABLE 62 : POINTEUR KIZG.TABLE,MTABX.MTABLE,MTABT.MTABLE 63 : POINTEUR KINC.TABLE,RESU.MTABLE 64 : POINTEUR MTABZ.MTABLE 65 : -INC SMLMOTS 66 : POINTEUR LINCO.MLMOTS 67 : CHARACTER*8 NOMZ,NOMI,NOMA,TYPE,CHAI,TYPC,TYPCFI,NOM 68 : CHARACTER*8 NOM0,NOMII 69 : REAL*8 XYZI(24) 70 : LOGICAL LOGI 71 : PARAMETER (NTB=2) 72 : CHARACTER*8 LTAB(NTB) 73 : DIMENSION KTAB(NTB),IXV(3) 74 : * SAVE IPAS 75 : * data ipas/1/ 76 : C***************************************************************************** 77 : 78 : CKONV 79 : C WRITE(6,*)' Opérateur KONV' 80 : C 81 : C***************************************************************************** 82 : C 83 : 84 : C***************************************************************************** 85 : C Traitement des options 86 : C KIMPL = 0 -> EXPL 1 -> IMPL 2 -> CN 87 : C KFORM = 0 -> SI 1 -> EF 2 -> VF 3 -> EFMC 88 : C IDCEN = 0 -> rien 1 -> CENTREE 2 -> HU.BR 3 -> SUPG 4 -> T VISQ 89 : 90 : AIMPL=1.D0 91 : KIMPL=0 92 : KFORM=1 93 : IKOMP=0 94 : IDCEN=2 95 : IAXI=0 96 : IF(IFOMOD.EQ.0)IAXI=2 97 : KOPTI=0 98 : TYPE=' ' 98 : CALL ACMO(MTABX,'KOPT',TYPE,IENT) 99 : IF(TYPE.EQ.'TABLE')KOPTI=IENT 100 : IF(KOPTI.NE.0)THEN 101 : TYPE=' ' 101 : CALL ACMO(KOPTI,'IDCEN',TYPE,IENT) 101 : IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'IDCEN',IDCEN) 102 : TYPE=' ' 102 : CALL ACMO(KOPTI,'IKOMP',TYPE,IENT) 102 : IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'IKOMP',IKOMP) 103 : TYPE=' ' 103 : CALL ACMO(KOPTI,'KIMPL',TYPE,IENT) 103 : IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'KIMPL',KIMPL) 104 : TYPE=' ' 104 : CALL ACMO(KOPTI,'KFORM',TYPE,IENT) 104 : IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'KFORM',KFORM) 104 : CALL ACMF(KOPTI,'AIMPL',AIMPL) 105 : ENDIF 106 : 107 : C***************************************************************************** 108 : C***************************************************************************** 109 : C 110 : C ----- Cas d'un schéma Explicite en Volume Fini : 111 : C ---------------------------------------- 112 : if (KIMPL .EQ. 0 .and. KFORM . EQ. 2) then 112 : call ckon(MTABX) 113 : RETURN 114 : ENDIF 115 : C***************************************************************************** 116 : C***************************************************************************** 117 : C 117 : CALL ACMM(MTABX,'NOMZONE',NOMZ) 117 : CALL LEKTAB(MTABX,'DOMZ',MTABZ) 118 : IF(MTABZ.EQ.0)THEN 119 : WRITE(6,*)' Opérateur KONV :' 120 : WRITE(6,*)' On ne trouve pas l''indice DOMZ ? ' 121 : RETURN 122 : ENDIF 123 : 123 : CALL LEKTAB(MTABZ,'MAILLAGE',MELEME) 124 : IF(MELEME.EQ.0)GO TO 90 125 : SEGACT MELEME 126 : 126 : CALL LEKTAB(MTABZ,'XXDXDY',MCHPOI) 127 : IF(MCHPOI.EQ.0)GO TO 90 127 : CALL LICHT(MCHPOI,IZTCO,TYPC,IGEOM) 128 : NELZ=IZTCO.VPOCHA(/1) 129 : 130 : TYPE=' ' 130 : CALL ACMO(MTABZ,'SOMMET',TYPE,MELEMS) 131 : IF(TYPE.NE.'MAILLAGE')GO TO 90 132 : 133 : TYPE=' ' 133 : CALL ACMO(MTABZ,'CENTRE',TYPE,MELEMC) 134 : IF(TYPE.NE.'MAILLAGE')GO TO 90 135 : 136 : C************************************************************************* 137 : C VERIFICATIONS SUR LES INCONNUES 138 : C write(6,*)' Verification des inconnues ' 139 : 140 : TYPE='LISTMOTS' 140 : CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO) 141 : SEGACT LINCO 142 : 143 : NBINC=LINCO.MOTS(/2) 144 : IF((NBINC.NE.1).AND.(KFORM.NE.3))THEN 145 : WRITE(6,*)' Opérateur KONV :' 146 : WRITE(6,*)'Nombre d''inconnues incorrecte : ',NBINC,' On attend 1' 147 : RETURN 148 : ENDIF 149 : 150 : IF((NBINC.NE.2).AND.(KFORM.EQ.3))THEN 151 : WRITE(6,*)' Opérateur KONV :' 152 : WRITE(6,*)'Nombre d''inconnues incorrecte : ',NBINC,' On attend 2' 153 : RETURN 154 : ENDIF 155 : 156 : NOMI=LINCO.MOTS(1) 157 : IF (KFORM.EQ.3) NOMII=LINCO.MOTS(2) 158 : 158 : CALL LEKTAB(MTAB1,'INCO',KINC) 159 : IF(KINC.EQ.0)THEN 160 : WRITE(6,*)' Opérateur KONV :' 161 : WRITE(6,*)'Il n''y a pas de table INCO ? ?.' 162 : RETURN 163 : ENDIF 164 : 165 : TYPE=' ' 165 : CALL ACMO(KINC,NOMI,TYPE,MCHPOI) 166 : IF(TYPE.NE.'CHPOINT ')THEN 167 : WRITE(6,*)' Opérateur KONV :' 168 : WRITE(6,*)' L objet CHPOINT ',NOMI,' n existe pas dans la table' 169 : RETURN 170 : ELSE 170 : CALL LICHT(MCHPOI,IZTU1,TYPC,MELEM1) 171 : MZTN=IZTU1 172 : IKT=0 173 : ENDIF 174 : 175 : IF (KFORM.EQ.3) THEN 176 : TYPE=' ' 176 : CALL ACMO(KINC,NOMII,TYPE,MCHPOI) 177 : IF(TYPE.NE.'CHPOINT ')THEN 178 : WRITE(6,*)' Opérateur KONV :' 179 : WRITE(6,*)' L objet CHPOINT ',NOMII, 180 : & ' n existe pas dans la table' 181 : RETURN 182 : ELSE 182 : CALL LICHT(MCHPOI,IZTU2,TYPCFI,IGEOM0) 183 : MZPHI=IZTU2 184 : IKT=0 185 : ENDIF 186 : END IF 187 : C***************************************************************************** 188 : C Le domaine de definition est donne par le SPG de la premiere inconnue 189 : C Les inconnues suivantes devront posseder ce meme pointeur 190 : C On verifie que les points de la zone sont tous inclus dans ce SPG 191 : 191 : C? CALL KRIPAD(MELEMS,MLENTI) 191 : CALL KRIPAD(MELEM1,IPADI) 192 : IPADU=IPADI 193 : IPADS=IPADI 193 : CALL LEKTAB(MTABZ,'SOMMET',MELEMS) 194 : IF(MELEM1.NE.MELEMS)IPADS=0 195 : ** mise en comment aire des lignes suivantes car ipas ne ouvait etre nul 196 : * IF(IPAS.EQ.0)THEN 196 : * IF (KFORM.EQ.3) CALL KRIPAD(MELEMC,MLENT1) 196 : * CALL VERPAD(IPADI,MELEME,IRET) 197 : * IF(IRET.NE.0)THEN 198 : * WRITE(6,*)' Opérateur KONV' 199 : * WRITE(6,*)' La zone ',NOMZ,' n''est pas incluse dans le domaine' 200 : * IPAS=0 201 : * RETURN 202 : * ENDIF 203 : * ENDIF 204 : 205 : C***************************************************************************** 206 : 207 : 208 : C***************************************************************************** 209 : C Lecture du ou des coefficients 210 : C Type du coefficient : 211 : C IK1=0 CHPOINT IK1=1 scalaire IK1=2 vecteur 212 : 213 : C write(6,*)' Opérateur KONV lecture des coefficients' 213 : CALL ACME(MTABX,'IARG',IARG) 214 : IF((IARG.LT.2.AND.IDCEN.EQ.1) 215 : &.OR.(IARG.LT.3.AND.IDCEN.LT.4) 216 : &.OR.(IARG.LT.4.AND.IDCEN.GE.4))THEN 217 : WRITE(6,*)' Opérateur KONV : option incompréssible ' 218 : WRITE(6,*)' Nombre d''arguments incorrect : ',IARG 219 : WRITE(6,*)' On attend 2 ou plus suivant l''option' 220 : RETURN 221 : ENDIF 222 : 223 : C 1er coefficient Densité 224 : IXV(1)=MELEMC 225 : IXV(2)=1 226 : IXV(3)=0 226 : CALL LEKCOF('Opérateur KONV :', 227 : & MTABX,KINC,1,IXV,MRO,MZRO,NPT1,NC1,IKR,IRET) 228 : IF(IRET.EQ.0)GO TO 90 229 : 230 : IZTGG2=MZRO 231 : IZTGG3=MZRO 232 : 233 : C 2ème coefficient UN , champ de vitesse transportant 234 : IXV(1)=-MELEMS 235 : IXV(2)=0 236 : IXV(3)=1 236 : CALL LEKCOF('Opérateur KONV :', 237 : & MTABX,KINC,2,IXV,MUN,MZUN,NPTU,NC2,IKU,IRET) 238 : IF(IRET.EQ.0)GO TO 90 239 : IF(IKU.EQ.2)IKU=1 239 : IF(IPADS.EQ.0.AND.IKU.EQ.0)CALL KRIPAD(MELEMS,IPADS) 240 : IPADU=IPADS 241 : 242 : IF(IARG.GE.3)THEN 243 : C 3ème coefficient viscosité 244 : IXV(1)=MELEMC 245 : IXV(2)=1 246 : IXV(3)=0 246 : CALL LEKCOF('Opérateur KONV :', 247 : & MTABX,KINC,3,IXV,MMU,MZMU,NPT3,NC3,IKM,IRET) 248 : IF(IRET.EQ.0)GO TO 90 249 : ELSE 249 : CALL LEKTAB(MTABX,'ARGS3',MMU) 249 : CALL LICHT(MMU,MZMU,TYPC,IGEOM0) 250 : MZMU.VPOCHA(1,1)=1.D0 251 : IKM=1 252 : 253 : ENDIF 254 : 255 : IF(IARG.EQ.4)THEN 256 : C 4ème coefficient Dt 257 : IXV(1)=0 258 : IXV(2)=1 259 : IXV(3)=0 259 : CALL LEKCOF('Opérateur KONV :', 260 : & MTABX,KINC,4,IXV,MDT,MZDT,NPT4,NC4,IKT,IRET) 261 : IF(IRET.EQ.0)RETURN 262 : DT=MZDT.VPOCHA(1,1) 263 : ELSE 264 : DT=0. 265 : 266 : ENDIF 267 : 268 : C write(6,*)' Opérateur KONV : Fin lecture Arguments ' 269 : C Fin lecture Arguments ************************************************ 270 : 271 : 272 : C************************************************************************* 273 : IF(KFORM.EQ.0)THEN 274 : C CAS FORMULATION EF SI (GRESHO) 275 : 276 : WRITE(6,*)' Operateur KONV ' 277 : WRITE(6,*)' Option invalide ' 278 : GO TO 90 279 : C************************************************************************* 280 : ELSEIF(KFORM.EQ.1)THEN 281 : C CAS FORMULATION EF 282 : 283 : 284 : NUTOEL=0 285 : NINKO=IZTU1.VPOCHA(/2) 286 : SEGACT MELEME 287 : NBSOUS=LISOUS(/1) 288 : IF(NBSOUS.EQ.0)NBSOUS=1 289 : 290 : NRIGE=7 291 : NKID =9 292 : NKMT =7 293 : NMATRI=1 294 : SEGINI MATRIK 295 : IRIGEL(1,1)=MELEME 296 : IRIGEL(2,1)=MELEME 297 : IRIGEL(7,1)=2 298 : NBOP=0 299 : NBME=NINKO 300 : SEGINI IMATRI,IMATRS 301 : C write(6,*)' Creation IMATRI=',imatri 302 : IRIGEL(4,1)=IMATRI 303 : KSPGP=MELEMS 304 : KSPGD=MELEMS 305 : 306 : IF(NBME.EQ.1)THEN 307 : LISPRI(1)=NOMI(1:4)//' ' 308 : LISDUA(1)=NOMI(1:4)//' ' 309 : ELSE 310 : DO 102 I=1,NBME 311 : WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7) 312 : LISPRI(I)=NOM(1:4)//' ' 313 : LISDUA(I)=NOM(1:4)//' ' 314 : 102 CONTINUE 315 : ENDIF 316 : 317 : DO 101 L=1,NBSOUS 318 : IPT1=MELEME 319 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 320 : SEGACT IPT1 321 : NOM0=NOMS(IPT1.ITYPEL)//' ' 321 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 322 : SEGACT IZFFM 323 : IZHR=KZHR(1) 324 : SEGACT IZHR 325 : NES=GR(/1) 326 : NPG=GR(/3) 327 : 328 : 329 : NP = IPT1.NUM(/1) 330 : MP = NP 331 : NBEL=IPT1.NUM(/2) 332 : SEGINI IPM1,IPS1 333 : LIZAFM(L,1)=IPM1 334 : LIZAFS(L,1)=IPS1 335 : IPM2=IPM1 336 : IPM3=IPM1 337 : IPS2=IPS1 338 : IPS3=IPS1 339 : IF(NBME.GE.2)THEN 340 : SEGINI IPM2,IPS2 341 : LIZAFM(L,2)=IPM2 342 : LIZAFS(L,2)=IPS2 343 : ENDIF 344 : IF(NBME.GE.3)THEN 345 : SEGINI IPM3,IPS3 346 : LIZAFM(L,3)=IPM3 347 : LIZAFS(L,3)=IPS3 348 : ENDIF 349 : 350 : NPTU=MZUN.VPOCHA(/1) 351 : NPT =MZTN.VPOCHA(/1) 351 : CALL ZCONV(FN,GR,PG,XYZ,HR,PGSQ,RPG, 352 : & NES,IDIM,NP,NPG,IAXI,AIMPL,IKOMP, 353 : & MZRO.VPOCHA,IKR,MZUN.VPOCHA,IKU,NPTU,IPADU.LECT, 354 : & MZMU.VPOCHA,IKM, 355 : & IPT1.NUM,NBEL,NUTOEL,XCOOR, 356 : & IPM1.AM,IPM2.AM,IPM3.AM, 357 : & IPS1.AM,IPS2.AM,IPS3.AM, 358 : & NINKO,IDCEN,DT, 359 : & MZTN.VPOCHA,IKT,NPT,IPADI.LECT,IZTCO.VPOCHA,NELZ) 360 : 361 : C? SEGDES IPT1*NOMOD,IPM1 362 : NUTOEL=NUTOEL+NBEL 363 : 101 CONTINUE 364 : 365 : IF(KIMPL.EQ.2.OR.KIMPL.EQ.0)THEN 366 : C write(6,*)' CAS SEMI ou EXPLICITE ',AIMPL 367 : 368 : NAT=2 369 : NSOUPO=1 370 : SEGACT MELEMS 371 : N=MELEMS.NUM(/2) 372 : NC=NINKO 373 : SEGINI MCHPO1,MSOUP1,MPOVA1 374 : MCHPO1.IFOPOI=IFOMOD 375 : MCHPO1.MOCHDE=TITREE 376 : MCHPO1.MTYPOI='SMBR' 377 : MCHPO1.JATTRI(1)=2 378 : MCHPO1.IPCHP(1)=MSOUP1 379 : DO 177 N=1,NINKO 380 : MSOUP1.NOCOMP(N)=LISDUA(N)(1:4) 381 : C write(6,*)' comp=',MSOUP1.NOCOMP(N),MCHPO1,mpova1 382 : 177 CONTINUE 383 : MSOUP1.IGEOC=MELEMS 384 : MSOUP1.IPOVAL=MPOVA1 385 : 386 : NBSOUS=LISOUS(/1) 387 : IF(NBSOUS.EQ.0)NBSOUS=1 388 : 389 : DO 1533 L=1,NBSOUS 390 : IPT1=MELEME 391 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 392 : SEGACT IPT1 393 : NP=IPT1.NUM(/1) 394 : NBEL=IPT1.NUM(/2) 395 : DO 2 N=1,NINKO 396 : IPMS=LIZAFS(L,N) 397 : SEGACT IPMS 398 : DO 12 K=1,NBEL 399 : DO 13 J=1,NP 400 : UU=0.D0 401 : IU=IPADI.LECT(IPT1.NUM(J,K)) 402 : DO 14 I=1,NP 403 : IK=IPADI.LECT(IPT1.NUM(I,K)) 404 : UU=UU+IPMS.AM(K,I,J)*IZTU1.VPOCHA(IK,N) 405 : 14 CONTINUE 406 : MPOVA1.VPOCHA(IU,N)=MPOVA1.VPOCHA(IU,N)+UU 407 : 13 CONTINUE 408 : 12 CONTINUE 409 : 410 : 2 CONTINUE 411 : 412 : 1533 CONTINUE 413 : 414 : SEGDES IPM1,IPM2,IPM3 415 : IPS=IPS1 416 : SEGSUP IPS1 417 : IF(IPS2.NE.IPS)SEGSUP IPS2 418 : IF(IPS3.NE.IPS)SEGSUP IPS3 419 : IPDI=IPADI 420 : SEGSUP IPADI 421 : IF(IPADU.NE.IPDI)SEGSUP IPADU 422 : IF(IPADS.NE.IPDI)SEGSUP IPADS 423 : 424 : 425 : TYPE=' ' 425 : CALL ACMO(MTAB1,'SMBR',TYPE,MCHPO2) 426 : 427 : C if(ipas.eq.5)then 427 : C CALL ECROBJ('CHPOINT',MCHPO2) 427 : C[164qcall prlist 427 : C CALL ECROBJ('CHPOINT',MCHPO1) 427 : C call prlist 428 : C endif 429 : C ipas=ipas+1 430 : C segact mchpo2 431 : C nsoupo=mchpo2.ipchp(/1) 432 : C msoup2=mchpo2.ipchp(1) 433 : C segact msoup2 434 : C nc=msoup2.nocomp(/2) 435 : C do 6935 nnc=1,nc 436 : C write(6,*)'comp=',msoup2.nocomp(nnc) 437 : C write(6,*)'cons=',msoup2.nocons(nnc) 438 : C6935 continue 439 : 440 : IF(TYPE.NE.'CHPOINT')THEN 440 : CALL ECMO(MTAB1,'SMBR','CHPOINT',MCHPO1) 441 : ELSE 441 : CALL ECROBJ('CHPOINT',MCHPO2) 441 : CALL ECROBJ('CHPOINT',MCHPO1) 441 : C? CALL OPERAD 441 : CALL PRFUSE 441 : CALL LIROBJ('CHPOINT',MCHPOI,1,IRET) 441 : CALL ECMO(MTAB1,'SMBR','CHPOINT',MCHPOI) 442 : ENDIF 443 : 444 : ENDIF 445 : 446 : SEGDES IMATRI 447 : SEGSUP IMATRS 448 : SEGDES MELEME*NOMOD,MATRIK*NOMOD 448 : IF(KIMPL.NE.0)CALL ECMO(MTABX,'MATELM','MATRIK',MATRIK) 449 : 450 : RETURN 451 : C************************************************************************* 452 : ELSE IF(KFORM.EQ.2)THEN 453 : C CAS FORMULATION VF 454 : NINKO=IZTU1.VPOCHA(/2) 455 : 455 : C CALL LEKTAB(MTABZ,'FACE',MELEMF) 455 : C CALL LEKTAB(MTABZ,'CENTRE',MELEMC) 455 : CALL LEKTAB(MTABZ,'FACEL',MFACEL) 455 : CALL LEKTAB(MTABZ,'ELTFA',MELTFA) 455 : CALL LEKTAB(MTABZ,'ELKONV',MELEME) 455 : C CALL ELCONV(MELTFA,MFACEL,MELEMF,MELEMC,MELEME) 456 : 457 : SEGACT MELEME 458 : NBSOUS=LISOUS(/1) 459 : IF(NBSOUS.EQ.0)NBSOUS=1 460 : 461 : NRIGE=7 462 : NKID =9 463 : NKMT =7 464 : NMATRI=1 465 : SEGINI MATRIK 466 : IRIGEL(1,1)=MELEME 467 : IRIGEL(2,1)=MELEMC 468 : IRIGEL(7,1)=2 469 : NBOP=0 470 : NBME=NINKO 471 : SEGINI IMATRI,IMATRS 472 : IRIGEL(4,1)=IMATRI 473 : KSPGP=MELEMC 474 : KSPGD=MELEMC 475 : 476 : IF(NBME.EQ.1)THEN 477 : LISPRI(1)=NOMI(1:4)//' ' 478 : LISDUA(1)=NOMI(1:4)//' ' 479 : ELSE 480 : DO 202 I=1,NBME 481 : WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7) 482 : LISPRI(I)=NOM(1:4)//' ' 483 : LISDUA(I)=NOM(1:4)//' ' 484 : 202 CONTINUE 485 : ENDIF 486 : 487 : C* Lecture du tableau donnant le sens des normales par element 487 : CALL LEKTAB(MTABZ,'XXNORMAE',MCHELM) 488 : IF(MCHELM.EQ.0)GO TO 90 489 : SEGACT MCHELM 489 : CALL LEKTAB(MTABZ,'XXSURFAC',MCHPO1) 489 : CALL LICHT(MCHPO1,MPOVA1,TYPE,IGEOM) 490 : C* Lecture des connectivites elements/faces 490 : CALL LEKTAB(MTABZ,'ELTFA',MELEMA) 491 : IF(MELEMA.EQ.0)GO TO 90 492 : SEGACT MELEMA 492 : CALL KRIPAD(MELEMF,IPADI) 492 : IF(IKR.EQ.0)CALL KRIPAD(MELEMC,MLENT1) 493 : 494 : KK=0 495 : DO 201 L=1,NBSOUS 496 : IPT1=MELEME 497 : IPT2=MELEMA 498 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 499 : IF(NBSOUS.NE.1)IPT2=MELEMA.LISOUS(L) 500 : SEGACT IPT1,IPT2 501 : 502 : NP = IPT1.NUM(/1) 503 : NBF=NP-1 504 : MP = 1 505 : C write(6,*)' np,nbf,mp=',np,nbf,mp 506 : NBEL=IPT1.NUM(/2) 507 : SEGINI IPM1,IPMS 508 : LIZAFM(L,1)=IPM1 509 : LIZAFS(L,1)=IPMS 510 : IPM2=IPM1 511 : IPM3=IPM1 512 : IF(NBME.GE.2)THEN 513 : LIZAFM(L,2)=IPM1 514 : ENDIF 515 : IF(NBME.GE.3)THEN 516 : LIZAFM(L,3)=IPM1 517 : ENDIF 518 : 519 : MCHAML=ICHAML(L) 520 : SEGACT MCHAML 521 : MELVAL=IELVAL(1) 522 : SEGACT MELVAL 523 : 524 : C write(6,*)' IKR=',ikR 525 : 526 : IF(IKR.EQ.1)THEN 527 : C write(6,*)' NBEL=',NBEL,' NBF=',NBF 528 : DO 210 K=1,NBEL 529 : DO 211 I=1,NBF 530 : NF=IPT2.NUM(I,K) 531 : NF=IPADI.LECT(NF) 532 : C write(6,*)' NF=',NF,NP 533 : FI=IZTGG2.VPOCHA(NF,1)*MELVAL.VELCHE(I,K)*MPOVA1.VPOCHA(NF,1) 534 : &*MZRO.VPOCHA(1,1) 535 : IF(FI.LE.0.D0)THEN 536 : IPM1.AM(K,I,1)=FI 537 : ELSE 538 : IPM1.AM(K,NP,1)=IPM1.AM(K,NP,1)+FI 539 : ENDIF 540 : 211 CONTINUE 541 : 210 CONTINUE 542 : 543 : ELSEIF(IKR.EQ.0)THEN 544 : 545 : DO 212 K=1,NBEL 546 : KK=KK+1 547 : DO 213 I=1,NBF 548 : NF=IPT2.NUM(I,K) 549 : NF=IPADI.LECT(NF) 550 : NCR=MLENT1.LECT(KK) 551 : FI=IZTGG2.VPOCHA(NF,1)*MELVAL.VELCHE(I,K)*MPOVA1.VPOCHA(NF,1) 552 : &*MZRO.VPOCHA(NCR,1) 553 : IF(FI.LE.0.D0)THEN 554 : IPM1.AM(K,I,1)=FI 555 : ELSE 556 : IPM1.AM(K,NP,1)=IPM1.AM(K,NP,1)+FI 557 : ENDIF 558 : 213 CONTINUE 559 : 212 CONTINUE 560 : 561 : 562 : ENDIF 563 : 564 : 565 : 566 : SEGDES IPT1*NOMOD,IPM1,IPT2 567 : SEGSUP IPMS 568 : C write(6,*)' Fin bcl 201 ' 569 : 201 CONTINUE 570 : C write(6,*)' Apr bcl 201 ' 571 : SEGSUP IPADI 572 : SEGDES IMATRI 573 : SEGSUP IMATRS 574 : SEGDES MELEME*NOMOD,MATRIK*NOMOD 575 : 576 : IF(IKR.EQ.0)THEN 577 : SEGSUP MLENT1 578 : SEGDES MRO,MZRO 579 : ENDIF 580 : 580 : CALL ECMO(MTABX,'MATELM','MATRIK',MATRIK) 581 : 582 : RETURN 583 : C************************************************************************ 584 : C************************************************************************ 585 : C 586 : C ----- Cas d'un schéma en EFM0 : 587 : C ------------------------- 588 : ELSE IF (KFORM . EQ. 3) THEN 589 : c WRITE(6,*) 'Option EFM0 konv' 590 : 590 : CALL EF0KON(MTABX,MZTN,MZRO,MZUN,MZMU,TYPC,IERRKON, 591 : & MELEME,MTABZ,NOMI,IKR,IPADI,IAXI,NOMII,MZPHI, 592 : & TYPCFI,IZTCO,NELZ,IKU,IKM,AIMPL,IDCEN,MLENT1, 593 : & DT) 594 : 595 : IF (IERRKON.NE.0) GOTO 90 596 : c WRITE(6,*) 'Fin Option EFM0 konv' 597 : RETURN 598 : ENDIF 599 : C************************************************************************* 600 : 601 : 90 CONTINUE 602 : WRITE(6,*)' Interuption anormale de KONV' 603 : RETURN 604 : END 605 : 606 : 607 : 608 : 609 : 610 : 611 : 612 : 613 : 614 : 615 : 616 : 617 : 618 : 619 :
© Cast3M 2003 - All rights reserved.
Disclaimer