1 : C ZLAPL SOURCE MAGN 10/05/18 21:17:54 6675 2 : SUBROUTINE ZLAPL(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 LAPLACIEN 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 (discrétisation en 1D de l'équation 11 : C de conduction de la chaleur : 12 : C dérivée temporelle + laplacien) 13 : C 14 : C CET OPERATEUR EST "SOUS-INTEGRES" 15 : C 16 : C SYNTAXE : 17 : C --------- 18 : C 19 : C LAPL(ALF) INCO TN : 20 : C 21 : C COEFFICIENTS : 22 : C -------------- 23 : C 24 : C 25 : C ALF (SCAL DOMA) DIFFUSIVITE THERMIQUE 26 : C (SCAL ELEM) 27 : C 28 : C INCONNUES : 29 : C ----------- 30 : C 31 : C TN CHAMP DE TEMPERATURE 32 : C 33 : C************************************************************************ 34 : 35 : -INC CCVQUA4 36 : -INC CCOPTIO 37 : -INC CCGEOME 38 : -INC SMCOORD 39 : -INC SMLENTI 40 : POINTEUR IZIPAD.MLENTI 41 : -INC SMELEME 42 : POINTEUR MELEM1.MELEME,IGEOM0.MELEME,MELEMS.MELEME 43 : -INC SMCHPOI 44 : POINTEUR IZG1.MCHPOI, IZG2.MCHPOI 45 : POINTEUR MZLAM.MPOVAL 46 : POINTEUR IZGG1.MPOVAL,IZGG2.MPOVAL 47 : POINTEUR IZTU1.MPOVAL,IZTU2.MPOVAL,IZTU3.MPOVAL,IZTU4.MPOVAL 48 : POINTEUR IZTG5.MPOVAL 49 : POINTEUR IZVOL.MPOVAL,IZTCO.MPOVAL,IZDIAE.MPOVAL,IZTDI.MPOVAL 50 : 51 : -INC SIZFFB 52 : -INC SMMATRIK 53 : POINTEUR IPM.IZAFM 54 : 55 : C SEGMENT IMATRS 56 : C INTEGER LIZAFS(NBSOUS,NBME) 57 : C ENDSEGMENT 58 : POINTEUR IPMS.IZAFM,IPS1.IZAFM,IPS2.IZAFM,IPS3.IZAFM 59 : 60 : -INC SMLMOTS 61 : POINTEUR LINCO.MLMOTS 62 : CHARACTER*8 NOMZ,NOMI,NOMA,TYPE,TYPC,NOM,NOM0 63 : REAL*8 XVAL(9) 64 : LOGICAL LOGI 65 : PARAMETER (NTB=2) 66 : CHARACTER*8 LTAB(NTB) 67 : DIMENSION KTAB(NTB),IXV(3) 68 : C***************************************************************************** 69 : CLAPL 70 : C write(6,*)' DEBUT YLAPL' 71 : C 72 : C Deux traitements différents suivant la discrétisation 2D/3D ou 0D 73 : C (respectivement, table d'entrée de soustype KIZX 74 : C ou de soustype OPER_0D) 75 : C 76 : C 77 : C- Récupération de la table INCO (pointeur KINC) 78 : C 78 : CALL LEKTAB(MTAB1,'INCO',KINC) 79 : IF(KINC.EQ.0)THEN 80 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 81 : MOTERR( 1: 8) = ' INCO ' 82 : MOTERR( 9:16) = ' INCO ' 83 : MOTERR(17:24) = ' EQEX ' 83 : CALL ERREUR(786) 84 : RETURN 85 : ENDIF 86 : 87 : C***************************************************************************** 88 : C OPTIONS 89 : C KIMPL = 0 -> EXPL 1 -> IMPL 2 -> SEMI 90 : C KFORM = 0 -> SI 1 -> EF 2 -> VF 3 -> EFMC 91 : C IDCEN = 0-> rien 1-> CENTREE 2-> SUPGDC 3-> SUPG 4-> TVISQUEU 5-> CNG 92 : 93 : IAXI=0 94 : IF(IFOMOD.EQ.0)IAXI=2 95 : C 96 : C- Récupération de la table des options KOPT (pointeur KOPTI) 97 : C 97 : CALL LEKTAB(MTABX,'KOPT',KOPTI) 98 : IF (KOPTI.EQ.0) THEN 99 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 100 : MOTERR( 1: 8) = ' KOPT ' 101 : MOTERR( 9:16) = ' KOPT ' 102 : MOTERR(17:24) = ' KIZX ' 102 : CALL ERREUR(786) 103 : RETURN 104 : ENDIF 105 : 106 : C KIMPL = 0 -> EXPL 1 -> IMPL 2 -> SEMI 107 : C KFORM = 0 -> SI 1 -> EF 2 -> VF 108 : 108 : CALL ACME(KOPTI,'IKOMP',IKOMP) 108 : CALL ACME(KOPTI,'KIMPL',KIMPL) 108 : CALL ACME(KOPTI,'KFORM',KFORM) 108 : CALL ACME(KOPTI,'KMACO',KMACO) 108 : CALL ACMF(KOPTI,'AIMPL',AIMPL) 109 : 110 : C write(6,*)' ZLAPL : KFORM=',KFORM 111 : C***************************************************************************** 112 : C 113 : C- Récupération de la table DOMAINE associée au domaine local 114 : C 114 : CALL ACMM(MTABX,'NOMZONE',NOMZ) 114 : CALL LEKTAB(MTABX,'DOMZ',MTABZ) 115 : IF(MTABZ.EQ.0)THEN 116 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 117 : MOTERR( 1: 8) = ' DOMZ ' 118 : MOTERR( 9:16) = ' DOMZ ' 119 : MOTERR(17:24) = ' KIZX ' 119 : CALL ERREUR(786) 120 : RETURN 121 : ENDIF 122 : 122 : CALL LEKTAB(MTABZ,'MAILLAGE',MELEME) 122 : CALL LEKTAB(MTABZ,'SOMMET',MELEMS) 122 : CALL LEKTAB(MTABZ,'CENTRE',MELEMC) 123 : IF (IERR.NE.0) RETURN 124 : 125 : SEGACT MELEME 126 : 127 : IF(KIMPL.EQ.0)THEN 127 : CALL LEKTAB(MTABZ,'MATESI',MATRIK) 128 : SEGACT MATRIK 129 : IMATRI=IRIGEL(4,1) 130 : SEGACT IMATRI 131 : 131 : CALL LEKTAB(MTABZ,'XXDXDY',MCHPDX) 131 : CALL LEKTAB(MTABZ,'XXVOLUM',MCHPVO) 131 : CALL LEKTAB(MTABZ,'XXDIAME',MCHPDE) 131 : CALL LEKTAB(MTABZ,'XXDIEMIN',MCHPDI) 132 : IF (IERR.NE.0) RETURN 133 : 133 : CALL LICHT(MCHPDX,IZTCO,TYPC,IGEOM) 133 : CALL LICHT(MCHPDI,IZTDI,TYPC,IGEOM) 133 : CALL LICHT(MCHPDE,IZDIAE,TYPC,IGEOM) 133 : CALL LICHT(MCHPVO,IZVOL,TYPC,IGEOM) 134 : 135 : ENDIF 136 : 137 : C***************************************************************************** 138 : C VERIFICATIONS SUR LES INCONNUES 139 : C 140 : C- Récupération du nombre d'inconnues et du nom de l'inconnue NOMI 141 : C 142 : TYPE = 'LISTMOTS' 142 : CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO) 143 : IF (IERR.NE.0) RETURN 144 : SEGACT LINCO 145 : NBINC = LINCO.MOTS(/2) 146 : IF (NBINC.LE.0.OR.NBINC.GE.3) THEN 147 : C Indice %m1:8 : contient plus de %i1 %m9:16 148 : MOTERR( 1:8) = 'LISTINCO' 149 : INTERR(1) = 2 150 : MOTERR(9:16) = ' MOTS ' 150 : CALL ERREUR(799) 151 : RETURN 152 : ENDIF 153 : NOMI = LINCO.MOTS(1) 154 : NOMA = NOMI 155 : IF (NBINC.EQ.2) THEN 156 : IF (LINCO.MOTS(1).EQ.LINCO.MOTS(2)) THEN 157 : NINCO = 1 158 : ELSE 159 : IF (KFORM.EQ.0) THEN 160 : C Indice %m1:8 : contient plus de %i1 %m9:16 161 : MOTERR( 1:8) = 'LISTINCO' 162 : INTERR(1) = 1 163 : MOTERR(9:16) = ' MOTS ' 163 : CALL ERREUR(799) 164 : RETURN 165 : ELSE 166 : NOMA = LINCO.MOTS(2) 167 : ENDIF 168 : ENDIF 169 : ENDIF 170 : C 171 : C- Récupération de l'inconnue 172 : C 173 : TYPE = ' ' 173 : CALL ACMO(KINC,NOMI,TYPE,MCHPOI) 174 : IF (TYPE.NE.'CHPOINT ') THEN 175 : C Indice %m1:8 : ne contient pas un objet de type %m9:16 176 : MOTERR( 1: 8) = 'INC '//NOMI 177 : MOTERR( 9:16) = 'CHPOINT ' 177 : CALL ERREUR(800) 178 : RETURN 179 : ELSE 179 : CALL LICHT(MCHPOI,IZTU1,TYPC,MELEM1) 180 : IF (NBINC.EQ.2) THEN 181 : TYPE = ' ' 181 : CALL ACMO(KINC,NOMA,TYPE,MCHPO2) 182 : IF (TYPE.NE.'CHPOINT ') THEN 183 : C Indice %m1:8 : ne contient pas un objet de type %m9:16 184 : MOTERR( 1: 8) = 'INC '//NOMA 185 : MOTERR( 9:16) = 'CHPOINT ' 185 : CALL ERREUR(800) 186 : RETURN 187 : ELSE 187 : CALL LICHT(MCHPO2,IZTU2,TYPC,IGEOM2) 188 : IF (IGEOM2.NE.MELEM1) THEN 189 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 190 : MOTERR(1: 8) = 'INC '//NOMA 191 : MOTERR(9:16) = 'CHPOINT ' 191 : CALL ERREUR(788) 192 : RETURN 193 : ENDIF 194 : ENDIF 195 : ENDIF 196 : C***************************************************************************** 197 : C Le domaine de definition est donne par le SPG de la premiere inconnue 198 : C Les inconnues suivantes devront posseder ce meme pointeur 199 : C On verifie que les points de la zone sont tous inclus dans ce SPG 200 : IF (KFORM.NE.2) THEN 200 : CALL KRIPAD(MELEM1,IZIPAD) 200 : CALL VERPAD(IZIPAD,MELEME,IRET) 201 : IF (IRET.NE.0) THEN 202 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 203 : MOTERR(1: 8) = 'INC '//NOMI 204 : MOTERR(9:16) = 'CHPOINT ' 204 : CALL ERREUR(788) 205 : RETURN 206 : ENDIF 207 : ENDIF 208 : C***************************************************************************** 209 : ENDIF 210 : C***************************************************************************** 211 : C Lecture du coefficient 212 : C Type du coefficient : 213 : C IK1=0 CHPOINT IK1=1 scalaire IK1=2 vecteur 214 : 214 : CALL ACME(MTABX,'IARG',IARG) 215 : IF(IARG.GT.1)THEN 216 : WRITE(6,*)' Operateur LAPN ' 217 : WRITE(6,*)' Nombre d''arguments incorrect : ',IARG 218 : WRITE(6,*)' On attend 1 ' 219 : RETURN 220 : ENDIF 221 : 222 : IXV(1)=MELEMC 223 : IXV(2)=1 224 : IXV(3)=0 224 : CALL LEKCOF('Opérateur LAPN :', 225 : & MTABX,KINC,1,IXV,MLAM,MZLAM,NPT1,NC1,IK1,IRET) 226 : IF(IRET.EQ.0)RETURN 227 : 228 : C write(6,*)' KFORM,KIMPL=',KFORM,KIMPL 229 : C************************************************************************* 230 : IF(KFORM.EQ.0)THEN 231 : C CAS FORMULATION EF SI (GRESHO) 232 : 233 : IF(KIMPL.NE.0)THEN 234 : WRITE(6,*)' Opérateur LAPN :' 235 : C Option %m1:8 incompatible avec les données 236 : MOTERR( 1: 8) = ' EFM1 ' 237 : WRITE(6,*)' Options incompatibles : EFM1 et (IMPL ou SEMI) ' 237 : CALL ERREUR(803) 238 : RETURN 239 : ENDIF 240 : 240 : CALL LEKTAB(MTAB1,'KIZG',KIZG) 241 : IF(KIZG.EQ.0)THEN 241 : CALL CRTABL(KIZG) 241 : CALL ECMM(KIZG,'SOUSTYPE','KIZG') 241 : CALL ECMO(MTAB1,'KIZG','TABLE ',KIZG) 242 : ENDIF 243 : 244 : TYPE=' ' 244 : CALL ACMO(KIZG,NOMI,TYPE,IZG1) 245 : IF(TYPE.NE.'CHPOINT ')THEN 246 : NC=IZTU1.VPOCHA(/2) 247 : TYPE='SOMMET' 247 : CALL CRCHPT(TYPE,MELEM1,NC,IZG1) 247 : CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG1) 248 : ENDIF 249 : 249 : CALL LICHT(IZG1,IZGG1,TYPC,IGEOM) 250 : 251 : IF(IGEOM.NE.MELEM1)THEN 252 : WRITE(6,*)' Opérateur LAPN' 253 : WRITE(6,*)' Incompatibilite de SPG entre 1eres inconnues' 254 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 255 : MOTERR(1: 8) = 'INC '//NOMI 256 : MOTERR(9:16) = 'CHPOINT ' 256 : CALL ERREUR(788) 257 : RETURN 258 : ENDIF 259 : 260 : 261 : NPT=IZGG1.VPOCHA(/1) 262 : NCOT=IZTCO.VPOCHA(/1) 263 : 264 : SEGACT MELEME 265 : NBSOUS=LISOUS(/1) 266 : IF(NBSOUS.EQ.0)NBSOUS=1 267 : NUTOEL=0 268 : DT=1.E30 269 : 270 : 271 : DO 1 L=1,NBSOUS 272 : IPT1=MELEME 273 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 274 : SEGACT IPT1 275 : 276 : IZAFM=LIZAFM(L,1) 277 : IPM1=IZAFM 278 : SEGACT IZAFM 279 : IF(IAXI.NE.0)THEN 280 : IPM1=LIZAFM(L,2) 281 : SEGACT IPM1 282 : ENDIF 283 : 284 : NP =IPT1.NUM(/1) 285 : NBEL=IPT1.NUM(/2) 286 : IES=IDIM 287 : NINKO=IZTU1.VPOCHA(/2) 288 : 288 : CALL ZCLPLS(AM,IPM1.AM,IPT1.NUM, 289 : & NBEL,NUTOEL,NPT,NINKO,IES,NP,IAXI,IZIPAD.LECT, 290 : & MZLAM.VPOCHA,IK1, 291 : & IZTU1.VPOCHA,IZGG1.VPOCHA, 292 : & IZVOL.VPOCHA,IZTCO.VPOCHA,NCOT,IZDIAE.VPOCHA,IZTDI.VPOCHA, 293 : & DT,DTT2,NUEL,DIAEL) 294 : 295 : SEGDES IZAFM,IPT1 296 : IF(IAXI.NE.0)SEGDES IPM1 297 : NUTOEL=NUTOEL+NBEL 298 : 1 CONTINUE 299 : SEGDES MATRIK,IMATRI,MELEME 300 : DTT1=0. 301 : 301 : CALL LEKTAB(MTAB1,'PASDETPS',MTABT) 302 : 303 : IF(MTABT.EQ.0)THEN 303 : CALL CRTABL(MTABT) 303 : CALL ECMM(MTABT,'SOUSTYPE','PASDETPS') 303 : CALL ECMO(MTAB1,'PASDETPS','TABLE ',MTABT) 304 : DTP=1.E30+DT 305 : IPAT=1 306 : DTT1=0. 306 : CALL ECME(MTABT,'NUPASDT',IPAT) 307 : ELSE 307 : CALL ACMF(MTABT,'DELTAT',DTP) 308 : ENDIF 309 : 310 : IF(DT.LT.DTP)THEN 310 : CALL ECMF(MTABT,'DELTAT',DT) 310 : CALL ECMM(MTABT,'OPER','LAPL') 310 : CALL ECMM(MTABT,'ZONE',NOMZ) 310 : CALL ECMF(MTABT,'DTCONV',DTT1) 310 : CALL ECMF(MTABT,'DTDIFU',DTT2) 310 : CALL ECMF(MTABT,'DIAEL',DIAEL) 310 : CALL ECME(MTABT,'NUEL',NUEL) 311 : ENDIF 312 : 313 : SEGDES IZTU1 314 : SEGDES IZGG1 315 : IF(IK1.EQ.0)THEN 316 : SEGDES MZLAM 317 : ENDIF 318 : SEGDES IZVOL,IZTCO,IZDIAE,IZTDI 319 : SEGDES LINCO 320 : 321 : C************************************************************************* 322 : ELSE IF(KFORM.EQ.1)THEN 323 : C CAS FORMULATION EF 324 : 325 : IF(KIMPL.EQ.0)THEN 326 : WRITE(6,*)' Opérateur LAPN :' 327 : WRITE(6,*)' Option explicite invalide dans ce cas ' 328 : C Option %m1:8 incompatible avec les données 329 : MOTERR( 1: 8) = ' EF ' 330 : WRITE(6,*)' Options incompatibles : EF et EXPL ' 330 : CALL ERREUR(803) 331 : RETURN 332 : ENDIF 333 : 334 : NINKO=IZTU1.VPOCHA(/2) 335 : IHV=0 336 : IF(NINKO.EQ.IDIM)IHV=1 337 : NUTOEL=0 338 : SEGACT MELEME 339 : NBSOUS=LISOUS(/1) 340 : IF(NBSOUS.EQ.0)NBSOUS=1 341 : 342 : TYPE=' ' 342 : CALL ACMO(MTABX,'MATELM',TYPE,MATRIK) 343 : IF(TYPE.EQ.'MATRIK'.AND.KMACO.NE.0)THEN 344 : SEGACT MATRIK 345 : NMATRI=IRIGEL(/2) 346 : MELEME=IRIGEL(1,1) 347 : SEGACT MELEME 348 : IMATRI=IRIGEL(4,1) 349 : SEGACT IMATRI 350 : NBME=LIZAFM(/2) 351 : NINKO=NBME 352 : MELEMS=KSPGP 353 : 354 : 355 : ELSE 356 : 357 : NRIGE=7 358 : NKID =9 359 : NKMT =7 360 : NMATRI=1 361 : SEGINI MATRIK 362 : IRIGEL(1,1)=MELEME 363 : IRIGEL(2,1)=MELEME 364 : 365 : C write(6,*)' IRIGEL (1 et 2 )=',MELEME,MELEME 366 : C. write(6,*)' Entrez ici le cas sym (0) ou non sym (2)' 367 : C. read(5,*)ksymr 368 : C. IRIGEL(7,1)=ksymr 369 : 370 : IRIGEL(7,1)=0 371 : NBOP=0 372 : NBME=NINKO 373 : NBELC=0 373 : CALL LEKTAB(MTABZ,'SOMMET',MELEMS) 374 : SEGINI IMATRI 375 : IRIGEL(4,1)=IMATRI 376 : KSPGP=MELEMS 377 : KSPGD=MELEMS 378 : 379 : IF(NBME.EQ.1)THEN 380 : LISPRI(1)=NOMI(1:4)//' ' 381 : LISDUA(1)=NOMA(1:4)//' ' 382 : ELSE 383 : DO 102 I=1,NBME 384 : WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7) 385 : LISPRI(I)=NOM(1:4)//' ' 386 : WRITE(NOM,FMT='(I1,A7)')I,NOMA(1:7) 387 : LISDUA(I)=NOM(1:4)//' ' 388 : 102 CONTINUE 389 : ENDIF 390 : 391 : DO 101 L=1,NBSOUS 392 : IPT1=MELEME 393 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 394 : SEGACT IPT1 395 : NOM0 = NOMS(IPT1.ITYPEL)//' ' 395 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 396 : SEGACT IZFFM 397 : IZHR=KZHR(1) 398 : SEGACT IZHR*MOD 399 : NES=GR(/1) 400 : NPG=GR(/3) 401 : 402 : NP = IPT1.NUM(/1) 403 : MP = NP 404 : NBEL=IPT1.NUM(/2) 405 : SEGINI IPM1,IPS1 406 : LIZAFM(L,1)=IPM1 407 : C LIZAFS(L,1)=IPS1 408 : IPM2=IPM1 409 : IPM3=IPM1 410 : IPS2=IPS1 411 : IPS3=IPS1 412 : IF(NBME.GE.2)THEN 413 : SEGINI IPM2,IPS2 414 : LIZAFM(L,2)=IPM2 415 : C LIZAFS(L,2)=IPS2 416 : ENDIF 417 : IF(NBME.GE.3)THEN 418 : SEGINI IPM3,IPS3 419 : LIZAFM(L,3)=IPM3 420 : C LIZAFS(L,3)=IPS3 421 : ENDIF 422 : 423 : 424 : KITT=2 425 : KJTT=IK1 426 : 426 : CALL XLAPL(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI, 427 : & MZLAM.VPOCHA,MZLAM.VPOCHA,MZLAM.VPOCHA,KITT,KJTT,IK1, 428 : & IPT1.NUM,NBEL,NUTOEL,XCOOR,AIMPL,IKOMP, 429 : & IPM1.AM,IPM2.AM,IPM3.AM, 430 : & IPS1.AM,IPS2.AM,IPS3.AM, 431 : & NINKO,IHV,IARG,MZLAM.VPOCHA) 432 : 433 : NUTOEL=NUTOEL+NBEL 434 : 101 CONTINUE 435 : 436 : ENDIF 437 : 438 : IF(KIMPL.EQ.2)THEN 439 : 440 : NAT=2 441 : NSOUPO=1 442 : SEGACT MELEMS 443 : N=MELEMS.NUM(/2) 444 : NC=NINKO 445 : SEGINI MCHPO1,MSOUP1,MPOVA1 446 : MCHPO1.IFOPOI=IFOMOD 447 : MCHPO1.MOCHDE=TITREE 448 : MCHPO1.MTYPOI='SMBR' 449 : MCHPO1.JATTRI(1)=2 450 : MCHPO1.IPCHP(1)=MSOUP1 451 : DO 177 N=1,NINKO 452 : MSOUP1.NOCOMP(N)=LISDUA(N)(1:4) 453 : 177 CONTINUE 454 : MSOUP1.IGEOC=MELEMS 455 : MSOUP1.IPOVAL=MPOVA1 455 : CALL KRIPAD(MELEMS,MLENTI) 456 : 457 : NBSOUS=LISOUS(/1) 458 : IF(NBSOUS.EQ.0)NBSOUS=1 459 : 460 : DO 1533 L=1,NBSOUS 461 : IPT1=MELEME 462 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 463 : SEGACT IPT1 464 : NP=IPT1.NUM(/1) 465 : NBEL=IPT1.NUM(/2) 466 : DO 2 N=1,NINKO 467 : IPM=LIZAFM(L,N) 468 : SEGACT IPM 469 : DO 12 K=1,NBEL 470 : DO 13 J=1,NP 471 : UU=0.D0 472 : IU=LECT(IPT1.NUM(J,K)) 473 : IK=IZIPAD.LECT(IPT1.NUM(J,K)) 474 : DO 14 I=1,NP 475 : UU=UU+IPM.AM(K,I,J)*IZTU1.VPOCHA(IK,N)*(1.D0-AIMPL) 476 : 14 CONTINUE 477 : MPOVA1.VPOCHA(IU,N)=MPOVA1.VPOCHA(IU,N)-UU 478 : 13 CONTINUE 479 : 12 CONTINUE 480 : 481 : 2 CONTINUE 482 : 483 : 1533 CONTINUE 484 : 485 : SEGDES IPM1,IPM2,IPM3 486 : SEGSUP MLENTI 487 : 488 : TYPE=' ' 488 : CALL ACMO(MTAB1,'SMBR',TYPE,MCHPO2) 489 : IF(TYPE.NE.'CHPOINT')THEN 489 : CALL ECMO(MTAB1,'SMBR','CHPOINT',MCHPO1) 490 : ELSE 490 : CALL ECROBJ('CHPOINT',MCHPO2) 490 : CALL ECROBJ('CHPOINT',MCHPO1) 490 : CALL OPERAD 490 : CALL LIROBJ('CHPOINT',MCHPOI,1,IRET) 490 : CALL ECMO(MTAB1,'SMBR','CHPOINT',MCHPOI) 491 : ENDIF 492 : 493 : ENDIF 494 : 495 : SEGSUP IZIPAD 496 : 497 : SEGDES IMATRI 498 : SEGDES MELEME,MATRIK 499 : IF(IK1.EQ.0)THEN 500 : SEGDES MZLAM 501 : ENDIF 501 : CALL ECMO(MTABX,'MATELM','MATRIK',MATRIK) 502 : 503 : C************************************************************************* 504 : ELSE IF(KFORM.EQ.2)THEN 505 : C CAS FORMULATION VF 505 : CALL LAPLVF(MTABX) 506 : ENDIF 507 : C************************************************************************* 508 : 509 : C write(6,*)' FIN YLAPL' 510 : RETURN 511 : 1001 FORMAT(20(1X,I5)) 512 : 1002 FORMAT(10(1X,1PE11.4)) 513 : END 514 : 515 : 516 : 517 : 518 : 519 : 520 : 521 : 522 : 523 : 524 : 525 : 526 : 527 :
© Cast3M 2003 - All rights reserved.
Disclaimer