1 : C YNS SOURCE MAGN 10/05/18 21:17:09 6675 2 : SUBROUTINE YNS 3 : PARAMETER (NTB=1) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : C*********************************************************************** 7 : C 8 : C CET OPERATEUR DISCRETISE LES EQUATIONS DE NAVIER STOKES 9 : C EN 2D SUR LES ELEMENTS QUA4 ET TRI3 PLAN OU AXI 10 : C EN 3D SUR LES ELEMENTS CUB8 ET PRI6 11 : C LES OPERATEURS SONT "SOUS-INTEGRES" 12 : C 13 : C SYNTAXE : 14 : C --------- 15 : C 1/ Cas incompressible 16 : C 17 : C du/dt + u Grad u = nu Lapl u - 1/ro Grad p < + S > 18 : C < + g beta (T-Tref) > 19 : C 20 : C 'OPER' 'NS' nu 'INCO' UN : 21 : C 'OPER' 'NS' nu s 'INCO' UN : 22 : C 'OPER' 'NS' nu gb tn tref 'INCO' UN : 23 : C 24 : C 25 : C 2/ Cas compressible 26 : C 27 : C dG/dt + u Grad G + G Div u = mu Lapl u - Grad p < + S > 28 : C 29 : C 'OPER' 'NS' mu un 'INCO' GN : 30 : C 'OPER' 'NS' mu un s 'INCO' GN : 31 : C 32 : C 33 : C nu,mu viscosité cinématique resp. dynamique 34 : C FLOTTANT ou CHPOINT SCAL CENTRE 35 : C s source volumique de qdm 36 : C POINT ou CHPOINT VECT CENTRE 37 : C gb coéfficient de flottabilité (g*beta où g est l'accéllération 38 : C de la pesanteur et beta le coéfficient de dilatabilité) 39 : C POINT ou CHPOINT VECT CENTRE 40 : C tn Champ de température CHPOINT SCAL SOMMET 41 : C tref température de référence 42 : C FLOTTANT ou CHPOINT SCAL SOMMET 43 : C 44 : C Champ de vitesse -> VITESS 45 : C un Champ de vitesse transportant -> UTRANS 46 : C CHPOINT VECT SOMMET 47 : C gn Champ de vitesse massique (transporté) -> IZTU1 (Inconnue) 48 : C CHPOINT VECT SOMMET 49 : C 50 : C************************************************************************ 51 : 52 : -INC CCOPTIO 53 : -INC CCGEOME 54 : -INC SIZFFB 55 : POINTEUR IZF1.IZFFM,IZH2.IZHR 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 : SEGMENT SOURCE 65 : REAL*8 SO(NBEL,NPG,KSDIM) 66 : ENDSEGMENT 67 : 68 : -INC SMCHAML 69 : -INC SMCOORD 70 : -INC SMLENTI 71 : POINTEUR IPADI.MLENTI,IPADU.MLENTI,IPADS.MLENTI,IPADF.MLENTI 72 : POINTEUR IPADQ.MLENTI 73 : -INC SMELEME 74 : POINTEUR MELEMC.MELEME,IGEOM0.MELEME,MELEMS.MELEME 75 : POINTEUR MELEMI.MELEME,MELEP1.MELEME,MELEMK.MELEME 76 : -INC SMCHPOI 77 : POINTEUR MCHPIN.MCHPOI 78 : POINTEUR IZTU1.MPOVAL,IZGG1.MPOVAL 79 : POINTEUR VITESS.MPOVAL,UTRANS.MPOVAL 80 : POINTEUR VISCO.MPOVAL,IZTGG2.MPOVAL 81 : POINTEUR IZTGG3.MPOVAL,IZTGG4.MPOVAL 82 : POINTEUR IZVOL.MPOVAL,IZTCO.MPOVAL 83 : 84 : -INC SMMATRIK 85 : POINTEUR IPM.IZAFM 86 : 87 : SEGMENT IMATRS 88 : INTEGER LIZAFS(NBSOUS,NBME) 89 : ENDSEGMENT 90 : POINTEUR IPMS.IZAFM,IPS1.IZAFM,IPS2.IZAFM,IPS3.IZAFM 91 : 92 : -INC SMLMOTS 93 : POINTEUR LINCO.MLMOTS 94 : LOGICAL IKMMDZ 95 : CHARACTER*8 NOMZ,NOMI,TYPE,TYPC,NOM0,NOMA,NOM,MTYP,CHAI 96 : CHARACTER*4 NOM4(3) 97 : CHARACTER*8 LTAB(NTB) 98 : DIMENSION KTAB(NTB),IXV(9),RO(1) 99 : SAVE IPAS 100 : DATA LTAB/'KIZX '/,IPAS/0/ 101 : C***************************************************************************** 102 : CNS 103 : c write(6,*)' DEBUT NS ' 104 : 105 : C Nouvelle directive EQUA de EQEX 106 : MTYP=' ' 107 : ro(1)=1.D0 107 : CALL QUETYP(MTYP,0,IRET) 108 : IF(IRET.EQ.0)THEN 109 : C% On attend un des objets : %m1:8 %m9:16 %m17:24 %m25:32 %m33:40 110 : MOTERR( 1: 8) = 'CHAI ' 111 : MOTERR( 9:16) = 'MMODEL ' 112 : MOTERR(17:24) = 'TABLE ' 112 : CALL ERREUR(472) 113 : RETURN 114 : ENDIF 115 : 116 : IF(MTYP.EQ.'MMODEL')THEN 116 : CALL YTCLSF('TCLS ','NS ') 117 : RETURN 118 : ELSEIF(MTYP.EQ.'MOT ')THEN 118 : CALL LIRCHA(CHAI,1,IRET) 118 : CALL YTCLSF(CHAI,'NS ') 119 : RETURN 120 : ENDIF 121 : C Fin Nouvelle directive EQUA de EQEX 122 : 122 : CALL LIROBJ('TABLE',MTABX,1,IRET) 123 : IF(IRET.EQ.0)THEN 124 : C% On ne trouve pas d'objet de type %m1:8 125 : MOTERR( 1: 8) = 'TABLE' 125 : CALL ERREUR(37) 126 : RETURN 127 : ENDIF 128 : 129 : C....................................................................... 130 : C 131 : C- Récupération de la table EQEX (pointeur MTAB1) 132 : C 132 : CALL LEKTAB(MTABX,'EQEX',MTAB1) 133 : IF(MTAB1.EQ.0)THEN 134 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 135 : MOTERR( 1: 8) = ' EQEX ' 136 : MOTERR( 9:16) = ' EQEX ' 137 : MOTERR(17:24) = ' KIZX ' 137 : CALL ERREUR(786) 138 : RETURN 139 : ENDIF 139 : CALL ACME(MTAB1,'NAVISTOK',NASTOK) 140 : IF(NASTOK.EQ.0)THEN 140 : CALL ZNS(MTABX,MTAB1) 141 : RETURN 142 : ENDIF 143 : C 144 : C- Récupération de la table INCO (pointeur KINC) 145 : C 145 : CALL LEKTAB(MTAB1,'INCO',KINC) 146 : IF(KINC.EQ.0)THEN 147 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 148 : MOTERR( 1: 8) = ' INCO ' 149 : MOTERR( 9:16) = ' INCO ' 150 : MOTERR(17:24) = ' EQEX ' 150 : CALL ERREUR(786) 151 : RETURN 152 : ENDIF 153 : C....................................................................... 154 : 154 : CALL ACMM(MTABX,'NOMZONE',NOMZ) 155 : 155 : CALL LIROBJ('MMODEL',MMDZ,0,IRET) 156 : IF(IRET.EQ.0)THEN 157 : TYPE=' ' 157 : CALL ACMO(MTABX,'DOMZ',TYPE,MMDZ) 158 : IF(TYPE.NE.'MMODEL')THEN 159 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 160 : MOTERR( 1: 8) = ' DOMZ ' 161 : MOTERR( 9:16) = ' DOMZ ' 162 : MOTERR(17:24) = ' KIZX ' 162 : CALL ERREUR(786) 163 : RETURN 164 : ENDIF 165 : ENDIF 166 : 167 : C***************************************************************************** 168 : C OPTIONS 169 : C KIMPL = 0 -> EXPL 1 -> IMPL 2 -> SEMI 170 : C KFORM = 0 -> SI 1 -> EF 2 -> VF 3 -> EFMC 171 : C IDCEN = 0-> rien 1-> CENTREE 2-> SUPGDC 3-> SUPG 4-> TVISQUEU 5-> CNG 172 : 173 : IAXI=0 174 : IF(IFOMOD.EQ.0)IAXI=2 175 : C 176 : C- Récupération de la table des options KOPT (pointeur KOPTI) 177 : C 177 : CALL LEKTAB(MTABX,'KOPT',KOPTI) 178 : IF (KOPTI.EQ.0) THEN 179 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 180 : MOTERR( 1: 8) = ' KOPT ' 181 : MOTERR( 9:16) = ' KOPT ' 182 : MOTERR(17:24) = ' KIZX ' 182 : CALL ERREUR(786) 183 : RETURN 184 : ENDIF 185 : 186 : C write(6,*)' Avant les options ' 186 : CALL ACME(KOPTI,'MTRMASS ',MMPG) 187 : IPG=0 188 : IF(MMPG.EQ.3)IPG=1 188 : CALL ACME(KOPTI,'IDCEN',IDCEN) 189 : KDIM=1 190 : IF(IDCEN.EQ.2)KDIM=IDIM 190 : CALL ACME(KOPTI,'IKOMP',IKOMP) 190 : CALL ACME(KOPTI,'ALE',KKALE) 190 : CALL ACME(KOPTI,'KIMPL',KIMPL) 190 : CALL ACME(KOPTI,'KPOIN',KPRE) 190 : CALL ACME(KOPTI,'KFORM',KFORM) 190 : CALL ACME(KOPTI,'IDIV',IDIV) 190 : CALL ACMF(KOPTI,'CMD',CMD) 191 : 192 : IF(KFORM.NE.0.AND.KFORM.NE.1)THEN 193 : C Option %m1:8 incompatible avec les données 194 : MOTERR( 1: 8) = 'EF/EFM1 ' 194 : CALL ERREUR(803) 195 : RETURN 196 : ENDIF 196 : CALL ACME(KOPTI,'KMACO',KMACO) 196 : CALL ACMF(KOPTI,'AIMPL',AIMPL) 197 : AG=AIMPL 198 : AD=AIMPL-1.D0 199 : IF (IERR.NE.0) RETURN 200 : 201 : C write(6,*)' Apres les options ' 202 : C***************************************************************************** 203 : C 204 : C- Récupération de la table DOMAINE associée au domaine local 205 : C 206 : 207 : C E/ MMODEL : Pointeur de la table contenant l'information cherchée 208 : C /S IPOINT : Pointeur sur la table DOMAINE 209 : C /S INEFMD : Type formulation INEFMD=1 LINE,=2 MACRO,=3 QUADRATIQUE 210 : C INEFMD=4 LINB 211 : 211 : CALL LEKMOD(MMDZ,MTABZ,INEFMD) 212 : 212 : CALL LEKTAB(MTABZ,'MAILLAGE',MELEME) 212 : CALL LEKTAB(MTABZ,'SOMMET',MELEMS) 212 : CALL LEKTAB(MTABZ,'CENTRE',MELEMC) 212 : CALL LEKTAB(MTABZ,'MACRO1',MELEMK) 213 : IF (IERR.NE.0) RETURN 214 : 215 : MELEMQ=MELEMC 216 : MELEP1=MELEMC 217 : IF(KPRE.EQ.3)THEN 217 : CALL LEKTAB(MTABZ,'CENTREP0',MELEMQ) 218 : MELEP1=MELEMQ 219 : ELSEIF(KPRE.EQ.4)THEN 219 : CALL LEKTAB(MTABZ,'CENTREP1',MELEMQ) 219 : CALL LEKTAB(MTABZ,'ELTP1NC ',MELEP1) 220 : ENDIF 221 : 222 : C************************************************************************* 223 : C VERIFICATIONS SUR LES INCONNUES 224 : C 225 : C- Récupération du nombre d'inconnues et du nom de l'inconnue NOMI 226 : C 227 : TYPE='LISTMOTS' 227 : CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO) 228 : IF (IERR.NE.0) RETURN 229 : SEGACT LINCO 230 : NBINC=LINCO.MOTS(/2) 231 : IF(NBINC.NE.1)THEN 232 : C Indice %m1:8 : contient plus de %i1 %m9:16 233 : MOTERR( 1:8) = 'LISTINCO' 234 : INTERR(1) = 1 235 : MOTERR(9:16) = ' MOTS ' 235 : CALL ERREUR(799) 236 : RETURN 237 : ENDIF 238 : 239 : NOMI=LINCO.MOTS(1) 240 : NOMA=NOMI 241 : DO 15 I=1,IDIM 242 : WRITE(NOM4(I),FMT='(I1,A3)')I,NOMI(1:3) 243 : 15 CONTINUE 244 : C 245 : C- Récupération de l'inconnue 246 : C 247 : TYPE=' ' 247 : CALL ACMO(KINC,NOMI,TYPE,MCHPOI) 248 : IF(TYPE.NE.'CHPOINT ')THEN 249 : C Indice %m1:8 : ne contient pas un objet de type %m9:16 250 : MOTERR( 1: 8) = 'INC '//NOMI 251 : MOTERR( 9:16) = 'CHPOINT ' 251 : CALL ERREUR(800) 252 : RETURN 253 : ELSE 253 : CALL LICHT(MCHPOI,IZTU1,TYPC,MELEMI) 254 : MCHPIN=MCHPOI 255 : NINKO = IZTU1.VPOCHA(/2) 256 : NPTI = IZTU1.VPOCHA(/1) 257 : IF (NINKO.NE.IDIM) THEN 258 : C Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes 259 : MOTERR( 1: 8) = 'INC '//NOMI 260 : MOTERR( 9:16) = 'CHPOINT ' 260 : CALL ERREUR(784) 261 : RETURN 262 : ENDIF 263 : C write(6,*)' MCHPOI,MELEMI=',MCHPOI,MELEMI 264 : C On fait pointer ces deux tableaux sur le champ U inconu (tjs présent) pour 265 : C eviter de les enlever lors de l'appel FORTRAN si les options sont absentes 266 : UTRANS=IZTU1 267 : IKW=0 268 : VITESS=IZTU1 269 : ENDIF 270 : 271 : C***************************************************************************** 272 : C Le domaine de definition est donne par le SPG de la premiere inconnue 273 : C Les inconnues suivantes devront posseder ce meme pointeur 274 : C On verifie que les points de la zone sont tous inclus dans ce SPG 275 : 275 : CALL KRIPAD(MELEMI,IPADI) 276 : IPADS=IPADI 277 : NPTS=NPTI 278 : IF(MELEMI.NE.MELEMS)THEN 278 : CALL KRIPAD(MELEMS,IPADS) 279 : NPTS=MELEMS.NUM(/2) 280 : ENDIF 281 : IPADU=IPADI 282 : NPTU=NPTI 283 : IPADF=IPADI 284 : NPTF=NPTS 285 : 286 : IF(IPAS.EQ.0)THEN 287 : IPAS=1 287 : CALL VERPAD(IPADI,MELEME,IRET) 288 : IF(IRET.NE.0)THEN 289 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 290 : MOTERR(1: 8) = 'INC '//NOMI 291 : MOTERR(9:16) = 'CHPOINT ' 291 : CALL ERREUR(788) 292 : RETURN 293 : ENDIF 294 : ENDIF 295 : 296 : C***************************************************************************** 297 : 298 : 299 : C--Cas non conservatif et non conservatif EF (KFORM=1) 300 : IF(KFORM.EQ.1)THEN 301 : IHV=1 302 : 303 : CMT=CMD 304 : DT=0.D0 305 : IF(IDCEN.EQ.4.OR.IDCEN.EQ.5)THEN 306 : C IDCEN 1-> CENTREE 2-> SUPGDC 3-> SUPG 4-> TVISQUEU 5-> CNG 307 : TYPE=' ' 307 : CALL ACMO(MTABT,'DELTAT',TYPE,IENT) 308 : IF(TYPE.NE.'ENTIER')THEN 309 : WRITE(6,*)' Opérateur NS ' 310 : WRITE(6,*)' On reclame un pas de temps' 311 : C Option %m1:8 incompatible avec les données 312 : MOTERR( 1: 8) = ' EF ' 312 : CALL ERREUR(803) 313 : RETURN 314 : ELSE 314 : CALL ACMF(MTABT,'DELTAT',DT) 315 : CMT=DT 316 : ENDIF 317 : ENDIF 318 : 318 : CALL YCLS('NS ',MTABX,IHV,MCHPIN,NOMI,MATRIK,MCHPO1) 319 : 319 : CALL ECROBJ('MATRIK',MATRIK) 319 : CALL ECROBJ('CHPOINT',MCHPO1) 320 : 321 : RETURN 322 : ENDIF 323 : 324 : 325 : C************************************************************************* 326 : C Lecture des coefficients 327 : C Type du coefficient : 328 : C IK1=0 CHPOINT IK1=1 scalaire IK1=2 vecteur 329 : 329 : CALL ACME(MTABX,'IARG',IARG) 330 : IF(IKOMP.EQ.0)THEN 331 : IF(IARG.NE.1.AND.IARG.NE.2.AND.IARG.NE.3.AND.IARG.NE.4. 332 : & AND.IARG.NE.5.AND.IARG.NE.6)THEN 333 : WRITE(6,*)' Opérateur NS : option incompressible ' 334 : WRITE(6,*)' Nombre d''arguments incorrect : ',IARG 335 : WRITE(6,*)' On attend 1 , 2 , 3 , 4 , 5 ou 6' 336 : C Indice %m1:8 : nombre d'arguments incorrect 337 : MOTERR(1:8) = 'IARG ' 337 : CALL ERREUR(804) 338 : RETURN 339 : ENDIF 340 : ELSEIF(IKOMP.EQ.1.AND.KFORM.NE.1)THEN 341 : IF(IARG.NE.2.AND.IARG.NE.3)THEN 342 : WRITE(6,*)' Opérateur NS : option conservative' 343 : WRITE(6,*)' Nombre d''arguments incorrect : ',IARG 344 : WRITE(6,*)' On attend 2 ou 3 ' 345 : C Indice %m1:8 : nombre d'arguments incorrect 346 : MOTERR(1:8) = 'IARG ' 346 : CALL ERREUR(804) 347 : RETURN 348 : ENDIF 349 : ENDIF 350 : 351 : IBOU=0 352 : IF(KKALE.NE.0)IARG=IARG-1 353 : 354 : IF(IKOMP.EQ.0)THEN 355 : C--Cas non conservatif 356 : IXV(1)=MELEMC 357 : IXV(2)=1 358 : IXV(3)=0 358 : CALL LEKCOF('Opérateur NS :', 359 : & MTABX,KINC,1,IXV,IZTG1,VISCO,NPT1,NC1,IK1,IRET) 360 : IF(IRET.EQ.0)RETURN 361 : 362 : IK2=-1 363 : IKG=-1 364 : IK3=-1 365 : IK4=-1 366 : IZTGG2=VISCO 367 : IZTGG3=VISCO 368 : IZTGG4=VISCO 369 : 370 : C 2ème coef -> source S 371 : IF(IARG.GE.2)THEN 372 : C?? IXV(1)=-MELEMQ 373 : IXV(1)=-MELEMC 374 : IXV(2)=0 375 : IXV(3)=1 376 : IXV(4)=-MELEMS 377 : c? IRET=3 378 : c? IF(KPRE.EQ.5)THEN 379 : IRET = 4 380 : c? ENDIF 380 : CALL LEKCOF('Opérateur NS :', 381 : & MTABX,KINC,2,IXV,IZTG2,IZTGG2,NELG,NC2,IKG,IRET) 382 : IF(IRET.EQ.0)RETURN 383 : 384 : IF(IKG.EQ.2)IKG=1 385 : 386 : 387 : IF(IARG.EQ.4)THEN 388 : C Cas incompressible Boussinesq 389 : IBOU = 1 390 : IXV(1)=MELEMS 391 : IXV(2)=0 392 : IXV(3)=0 392 : CALL LEKCOF('Opérateur NS :', 393 : & MTABX,KINC,3,IXV,IZTG3,IZTGG3,NPT3,NC3,IK3,IRET) 394 : IF(IRET.EQ.0)RETURN 395 : 396 : IXV(1)=MELEMS 397 : IXV(2)=1 398 : IXV(3)=0 398 : CALL LEKCOF('Opérateur NS :', 399 : & MTABX,KINC,4,IXV,IZTG4,IZTGG4,NPT4,NC4,IK4,IRET) 400 : IF(IRET.EQ.0)RETURN 401 : 402 : ENDIF 403 : ENDIF 404 : 405 : 406 : C--Cas compressible 407 : ELSEIF(IKOMP.EQ.1)THEN 408 : C 1er coef : mu , viscosité dynamique 409 : IXV(1)=MELEMC 410 : IXV(2)=1 411 : IXV(3)=0 411 : CALL LEKCOF('Opérateur NS :', 412 : & MTABX,KINC,1,IXV,IZTG1,VISCO,NPT1,NC1,IK1,IRET) 413 : IF(IRET.EQ.0)RETURN 414 : 415 : IK2=-1 416 : IKG=-1 417 : IK3=-1 418 : IK4=-1 419 : IZTGG2=VISCO 420 : IZTGG3=VISCO 421 : IZTGG4=VISCO 422 : 423 : IF(IARG.EQ.3)THEN 424 : C 3ème coef : rog 425 : IXV(1)=-MELEMC 426 : IXV(2)=0 427 : IXV(3)=1 428 : IXV(4)=-MELEMS 429 : IRET=3 430 : IF(KPRE.EQ.5)THEN 431 : IRET = 4 432 : ENDIF 432 : CALL LEKCOF('Opérateur NS :', 433 : & MTABX,KINC,3,IXV,IZTG2,IZTGG2,NELG,NC2,IKG,IRET) 434 : IF(IRET.EQ.0)RETURN 435 : 436 : IF(IKG.EQ.2)IKG=1 437 : 438 : ENDIF 439 : 440 : C 2ème coef : un , champ de vitesse transportant 441 : IXV(1)=-MELEMS 442 : IXV(2)=0 443 : IXV(3)=0 443 : CALL LEKCOF('Opérateur NS :', 444 : & MTABX,KINC,2,IXV,MUTRAN,UTRANS,NPTU,NC3,IKW,IRET) 445 : IF(IRET.EQ.0)RETURN 446 : IPADU=IPADS 447 : NPTU=NPTS 448 : VITESS=UTRANS 449 : NPTF=NPTS 450 : 451 : ENDIF 452 : 453 : IF(KKALE.NE.0)THEN 454 : 455 : IF(IKOMP.EQ.1)THEN 456 : WRITE(6,*)' Operateur NS : option compressible en ALE' 457 : WRITE(6,*)' Cas non prévu pour l''instant: ' 458 : C Option %m1:8 incompatible avec les données 459 : MOTERR( 1: 8) = ' EF ' 459 : CALL ERREUR(803) 460 : RETURN 461 : ENDIF 462 : 463 : C n+ unième coefficient champ de vitesse transportant pour l'option ALE 464 : IXV(1)=-MELEMS 465 : IXV(2)=0 466 : IXV(3)=0 466 : CALL LEKCOF('Opérateur NS :', 467 : & MTABX,KINC,(IARG+1),IXV,MUTRAN,UTRANS,NPTW,NCW,IKW,IRET) 468 : IF(IRET.EQ.0)RETURN 469 : IPADU=IPADS 470 : 471 : ENDIF 472 : 473 : C write(6,*)' Operateur NS : Fin lecture Arguments ' 474 : C Fin lecture Arguments ************************************************ 475 : 475 : IF(IPADS.EQ.0)CALL KRIPAD(MELEMS,IPADS) 476 : 476 : CALL LEKTAB(MTAB1,'PASDETPS',MTABT) 477 : IF(MTABT.EQ.0)THEN 477 : CALL CRTABL(MTABT) 477 : CALL ECMM(MTABT,'SOUSTYPE','PASDETPS') 477 : CALL ECMO(MTAB1,'PASDETPS','TABLE ',MTABT) 478 : DT=1.E30 479 : DTP=1.E30+DT 480 : IPAT=1 480 : CALL ECME(MTABT,'NUPASDT',IPAT) 481 : ELSE 481 : CALL ACMF(MTABT,'DELTAT',DTP) 482 : ENDIF 483 : 484 : C*********** FORMULATIONS ********** 485 : 486 : IF(KFORM.EQ.0)THEN 487 : C Formulation EFM1 488 : IF(INEFMD.NE.1.AND.INEFMD.NE.2)THEN 489 : C Option %m1:8 incompatible avec les données 490 : MOTERR( 1: 8) = ' EFM1 ' 490 : CALL ERREUR(803) 491 : RETURN 492 : ENDIF 493 : 494 : IF(KIMPL.NE.0)THEN 495 : WRITE(6,*)' Operateur NS ' 496 : C Option %m1:8 incompatible avec les données 497 : MOTERR( 1: 8) = ' EF ' 497 : CALL ERREUR(803) 498 : RETURN 499 : ENDIF 500 : 500 : CALL LEKTAB(MTABZ,'XXDXDY',MCHPOI) 501 : IF(MCHPOI.EQ.0)GO TO 90 501 : CALL LICHT(MCHPOI,IZTCO,TYPC,IGEOM) 502 : NELZ=IZTCO.VPOCHA(/1) 503 : 503 : CALL LEKTAB(MTABZ,'MATESI',MATRIK) 504 : IF(MATRIK.EQ.0)GO TO 90 505 : SEGACT MATRIK 506 : 507 : IMATRI=IRIGEL(4,1) 508 : SEGACT IMATRI 509 : 509 : CALL LEKTAB(MTABZ,'XXPSOML',MCHELM) 510 : IF(MCHELM.EQ.0)GO TO 90 511 : SEGACT MCHELM 512 : 512 : CALL LEKTAB(MTABZ,'XXVOLUM',MCHVOL) 513 : IF(MCHVOL.EQ.0)GO TO 90 513 : CALL LICHT(MCHVOL,IZVOL,TYPC,IGEOM) 514 : 515 : NC=IZTU1.VPOCHA(/2) 516 : TYPE='SOMMET' 516 : CALL KRCHPT(TYPE,MELEMS,NC,IZG1,NOM4) 517 : 517 : CALL LICHT(IZG1,IZGG1,TYPC,IGEOM) 518 : 519 : SEGACT MELEME 520 : NUTOEL=0 521 : DT=1.E30 522 : 523 : 524 : DO 1 L=1,MAX(1,LISOUS(/1)) 525 : IPT1=MELEME 526 : IF(LISOUS(/1).NE.0)IPT1=LISOUS(L) 527 : SEGACT IPT1 528 : IZAFM=LIZAFM(L,1) 529 : IPM1=IZAFM 530 : SEGACT IZAFM 531 : IF(IAXI.NE.0)THEN 532 : IPM1=LIZAFM(L,2) 533 : SEGACT IPM1 534 : ENDIF 535 : 536 : NOM0=NOMS(IPT1.ITYPEL)//' ' 536 : CALL KALPBG(NOM0,'FONFORM0',IZFFM) 537 : SEGACT IZFFM*MOD 538 : 539 : MCHAML=ICHAML(L) 540 : SEGACT MCHAML 541 : MELVAL=IELVAL(1) 542 : SEGACT MELVAL 543 : 544 : IF(IMACHE(L).NE.IPT1)THEN 545 : goto 90 546 : ENDIF 547 : 548 : NP =IPT1.NUM(/1) 549 : NBEL=IPT1.NUM(/2) 550 : IES=IDIM 551 : 551 : CALL YCVI(AM,IPM1.AM,VELCHE, 552 : & IPT1.NUM,NBEL,NUTOEL,NPTS,IES,NP,IAXI,IKOMP,IARG, 553 : & VISCO.VPOCHA,IK1,IZTGG2.VPOCHA,IKG,NELG,IZTGG3.VPOCHA,IK3, 554 : & IZTGG4.VPOCHA,IK4,IPADS.LECT, 555 : & UTRANS.VPOCHA,IPADU.LECT,NPTU, 556 : & IZTU1.VPOCHA,IZGG1.VPOCHA,IPADI.LECT, 557 : & VITESS.VPOCHA,IPADF.LECT,NPTF, 558 : & IZVOL.VPOCHA,IZTCO.VPOCHA,NELZ,IDCEN,IPG, 559 : & DTM1,DT,DTT1,DTT2,NUEL,DIAEL,IZFFM.FN) 560 : 561 : SEGDES IZAFM,IPT1 562 : IF(IAXI.NE.0)SEGDES IPM1 563 : NUTOEL=NUTOEL+NBEL 564 : 565 : 1 CONTINUE 566 : SEGDES MELEME 567 : SEGDES IZTCO 568 : 569 : 570 : IF(DT.LT.DTP)THEN 570 : CALL ECMF(MTABT,'DELTAT',DT) 570 : CALL ECMM(MTABT,'OPER','NS') 570 : CALL ECMM(MTABT,'ZONE',NOMZ) 570 : CALL ECMF(MTABT,'DTCONV',DTT1) 570 : CALL ECMF(MTABT,'DTDIFU',DTT2) 570 : CALL ECMF(MTABT,'DIAEL',DIAEL) 570 : CALL ECME(MTABT,'NUEL',NUEL) 571 : ENDIF 572 : 573 : SEGDES VISCO,IZTGG2,IZTGG3,IZTGG4 574 : SEGDES UTRANS,IZTU1 575 : SEGDES IZGG1 576 : SEGDES IZVOL,IZTCO 577 : SEGDES LINCO 578 : SEGDES MATRIK,IMATRI 579 : 580 : NRIGE=7 581 : NKID =9 582 : NKMT =7 583 : NMATRI=0 584 : SEGINI MATRIK 584 : CALL ECROBJ('MATRIK',MATRIK) 584 : CALL ECROBJ('CHPOINT',IZG1) 585 : 586 : C************************************************************************* 587 : ELSE IF(KFORM.EQ.1)THEN 588 : C CAS FORMULATION EF 589 : 590 : IF(KIMPL.EQ.0)THEN 591 : C Option %m1:8 incompatible avec les données 592 : MOTERR( 1: 8) = ' EF ' 592 : CALL ERREUR(803) 593 : RETURN 594 : ENDIF 595 : 596 : DT=0.D0 597 : IF(IDCEN.EQ.4)THEN 598 : TYPE=' ' 598 : CALL ACMO(MTABT,'DELTAT',TYPE,IENT) 599 : IF(TYPE.NE.'ENTIER')THEN 600 : WRITE(6,*)' Opérateur NS ' 601 : WRITE(6,*)' On reclame un pas de temps' 602 : C Option %m1:8 incompatible avec les données 603 : MOTERR( 1: 8) = ' EF ' 603 : CALL ERREUR(803) 604 : RETURN 605 : ELSE 605 : CALL ACMF(MTABT,'DELTAT',DT) 606 : ENDIF 607 : ENDIF 608 : 609 : IHV=1 610 : NUTOEL=0 611 : NINKO=VITESS.VPOCHA(/2) 612 : SEGACT MELEME 613 : 614 : TYPE=' ' 614 : CALL ACMO(MTABX,'MATELM',TYPE,MATRIK) 615 : IF(TYPE.EQ.'MATRIK'.AND.KMACO.NE.0)THEN 616 : SEGACT MATRIK 617 : NMATRI=IRIGEL(/2) 618 : MELEME=IRIGEL(1,1) 619 : SEGACT MELEME 620 : IMATRI=IRIGEL(4,1) 621 : SEGACT IMATRI 622 : NBME=LIZAFM(/2) 623 : NINKO=NBME 624 : MELEMS=KSPGP 625 : 626 : 627 : ELSE 628 : 629 : NRIGE=7 630 : NKID =9 631 : NKMT =7 632 : NMATRI=1 633 : SEGINI MATRIK 634 : IRIGEL(1,1)=MELEME 635 : IRIGEL(2,1)=MELEME 636 : 637 : IRIGEL(7,1)=2 638 : NBME=NINKO 639 : 640 : 641 : C --- CALCUL DU NOMBRE DE PAQUETS DE LRV ELEMENTS --- 641 : CALL KPLRVM(MELEME,LRV,NBSOUS) 642 : SEGACT MELEME 643 : 644 : SEGINI IMATRI,IMATRS 645 : IRIGEL(4,1)=IMATRI 646 : KSPGP=MELEMS 647 : KSPGD=MELEMS 648 : IF(NBME.EQ.1)THEN 649 : LISPRI(1)=NOMI(1:4)//' ' 650 : LISDUA(1)=NOMA(1:4)//' ' 651 : ELSE 652 : DO 102 I=1,NBME 653 : WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7) 654 : LISPRI(I)=NOM(1:4)//' ' 655 : WRITE(NOM,FMT='(I1,A7)')I,NOMA(1:7) 656 : LISDUA(I)=NOM(1:4)//' ' 657 : 102 CONTINUE 658 : ENDIF 659 : 660 : LL=0 661 : NUTOEL=0 662 : DO 101 L=1,MAX(1,LISOUS(/1)) 663 : IPT1=MELEME 664 : IF(LISOUS(/1).NE.0)IPT1=LISOUS(L) 665 : SEGACT IPT1 666 : NOM0=NOMS(IPT1.ITYPEL)//' ' 666 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 667 : SEGACT IZFFM*MOD 668 : IZHR=KZHR(1) 669 : SEGACT IZHR*MOD 670 : NES=GR(/1) 671 : NPG=GR(/3) 672 : 673 : NP = IPT1.NUM(/1) 674 : MP = NP 675 : NBELEM=IPT1.NUM(/2) 676 : 677 : NNN=MOD(NBELEM,LRV) 678 : IF(NNN.EQ.0) NPACK=NBELEM/LRV 679 : IF(NNN.NE.0) NPACK=1+(NBELEM-NNN)/LRV 680 : 681 : DO 701 KPACK=1,NPACK 682 : 683 : C --- POUR CHAQUE PAQUET DE LRV ELEMENTS ou moins 684 : KDEB=1+(KPACK-1)*LRV 685 : KFIN=MIN(NBELEM,KDEB+LRV-1) 686 : 687 : NBEL=KFIN-KDEB+1 688 : LL=LL+1 689 : 690 : SEGINI IPM1,IPS1 691 : LIZAFM(LL,1)=IPM1 692 : LIZAFS(LL,1)=IPS1 693 : IPM2=IPM1 694 : IPM3=IPM1 695 : IPS2=IPS1 696 : IPS3=IPS1 697 : IF(NBME.GE.2)THEN 698 : IF(IDCEN.EQ.2)SEGINI IPM2,IPS2 699 : LIZAFM(LL,2)=IPM2 700 : LIZAFS(LL,2)=IPS2 701 : ENDIF 702 : IF(NBME.GE.3)THEN 703 : IF(IDCEN.EQ.2)SEGINI IPM3,IPS3 704 : LIZAFM(LL,3)=IPM3 705 : LIZAFS(LL,3)=IPS3 706 : ENDIF 707 : 708 : 709 : KITT=2 710 : KJTT=IK1 711 : 712 : SEGINI PETROV 713 : 714 : C write(6,*)' YNS appel a XCONV ' 714 : CALL XCONV(FN,GR,PG,XYZ,HR,PGSQ,RPG,AJ, 715 : & NES,IDIM,NP,NPG,IAXI,AG,AD,IDIV,CMD,IKOMP,LRV, 716 : & WT,WS,HK,PGSK,RPGK,AIRE,AJK,UIL,DUIL,COEFK,ANUK, 717 : & RO,1,UTRANS.VPOCHA,NPTU,IPADU.LECT,VISCO.VPOCHA,IK1, 718 : & IPT1.NUM(1,KDEB),NBEL,NUTOEL,XCOOR, 719 : & IPM1.AM,IPM2.AM,IPM3.AM, 720 : & IPS1.AM,IPS2.AM,IPS3.AM, 721 : & NINKO,IDCEN,DT, 722 : & IZTU1.VPOCHA,NPTI,IPADI.LECT) 723 : SEGSUP PETROV 724 : 725 : C write(6,*)' YNS retour XCONV ' 725 : CALL XLAPL(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI, 726 : & VISCO.VPOCHA,VISCO.VPOCHA,VISCO.VPOCHA,KITT,KJTT,IK1, 727 : & IPT1.NUM(1,KDEB),NBEL,NUTOEL,XCOOR,AIMPL,IKOMP, 728 : & IPM1.AM,IPM2.AM,IPM3.AM, 729 : & IPS1.AM,IPS2.AM,IPS3.AM, 730 : & NINKO,IHV,IARG,VISCO.VPOCHA) 731 : C write(6,*)' YNS retour XLAPL ' 732 : 733 : NUTOEL=NUTOEL+NBEL 734 : SEGDES IPM1,IPS1 735 : IF(NBME.GE.2.AND.IDCEN.EQ.2)SEGDES IPM2,IPS2 736 : IF(NBME.GE.3.AND.IDCEN.EQ.2)SEGDES IPM3,IPS3 737 : 738 : 701 CONTINUE 739 : SEGDES IPT1 740 : 101 CONTINUE 741 : 742 : ENDIF 743 : 744 : 745 : IF(KIMPL.EQ.2.OR.KIMPL.EQ.0.OR.IARG.GT.1)THEN 746 : NAT=2 747 : NSOUPO=1 748 : SEGACT MELEMS 749 : N=MELEMS.NUM(/2) 750 : NC=NINKO 751 : SEGINI MCHPO1,MSOUP1,MPOVA1 752 : MCHPO1.IFOPOI=IFOMOD 753 : MCHPO1.MOCHDE=' ' 754 : MCHPO1.MTYPOI='SMBR' 755 : MCHPO1.JATTRI(1)=2 756 : MCHPO1.IPCHP(1)=MSOUP1 757 : DO 177 N=1,NINKO 758 : MSOUP1.NOCOMP(N)=LISDUA(N)(1:4) 759 : 177 CONTINUE 760 : MSOUP1.IGEOC=MELEMS 761 : MSOUP1.IPOVAL=MPOVA1 762 : ENDIF 763 : 764 : IF(IARG.EQ.2.OR.IARG.EQ.4)THEN 764 : CALL KRIPAD(MELEMQ,IPADQ) 765 : IF(IARG.EQ.2)THEN 766 : IKAS=2 767 : ELSEIF(IARG.EQ.4)THEN 768 : IKAS=3 769 : ENDIF 770 : 771 : 772 : 773 : IF(INEFMD.EQ.2.AND.KPRE.EQ.2)MELEMK=MELEME 774 : IF(KPRE.EQ.5)MELEMK=MELEME 775 : SEGACT MELEMK 776 : 777 : NUTOEL=0 778 : DO 1102 L=1,MAX(1,MELEMK.LISOUS(/1)) 779 : IPT1=MELEMK 780 : IF(MELEMK.LISOUS(/1).NE.0)IPT1=MELEMK.LISOUS(L) 781 : SEGACT IPT1 782 : 783 : 784 : C write(6,*)' KPRE.=',KPRE,' IBOU=',IBOU 785 : IF(KPRE.EQ.5)THEN 786 : 787 : NOM0=NOMS(IPT1.ITYPEL)//' ' 788 : 788 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 789 : 790 : 791 : SEGACT IZFFM*MOD 792 : IZHR=KZHR(1) 793 : IZH2=KZHR(2) 794 : SEGACT IZHR*MOD 795 : NES=GR(/1) 796 : NPG=GR(/3) 797 : IZF1=KTP(1) 798 : NP = IPT1.NUM(/1) 799 : NBEL=IPT1.NUM(/2) 800 : NPT =MPOVA1.VPOCHA(/1) 801 : 802 : KSDIM=IDIM 803 : SEGINI SOURCE 804 : 805 : IF(IBOU.EQ.0)THEN 806 : C 1ere CONFIG ROG seul 807 : IF(IKG.EQ.0)THEN 808 : C SOURCE CENTRE 809 : DO 3456 K=1,NBEL 810 : DO 3456 N=1,IDIM 811 : DO 3456 LG=1,NPG 812 : SO(K,LG,N)=IZTGG2.VPOCHA(K+NUTOEL,N) 813 : 3456 CONTINUE 814 : 815 : ELSEIF(IKG.EQ.1)THEN 816 : C SOURCE CONSTANTE 817 : DO 3457 K=1,NBEL 818 : DO 3457 N=1,IDIM 819 : DO 3457 LG=1,NPG 820 : SO(K,LG,N)=IZTGG2.VPOCHA(1,N) 821 : 3457 CONTINUE 822 : 823 : ELSEIF(IKG.EQ.4)THEN 824 : C SOURCE SOMMET 825 : DO 3458 K=1,NBEL 826 : DO 3458 N=1,IDIM 827 : DO 3458 LG=1,NPG 828 : U0=0.D0 829 : DO 3547 I=1,NP 830 : I1=IPADS.LECT(IPT1.NUM(I,K)) 831 : U0=U0+FN(I,LG)*IZTGG2.VPOCHA(I1,N) 832 : 3547 CONTINUE 833 : SO(K,LG,N)=U0 834 : 3458 CONTINUE 835 : 836 : ENDIF 837 : 838 : ELSEIF(IBOU.EQ.1)THEN 839 : C 2eme CONFIG ROG*(T-T0) Boussinesq 840 : 841 : IF(IKG.EQ.0)THEN 842 : C SOURCE CENTRE 843 : DO 4456 K=1,NBEL 844 : DO 4456 N=1,IDIM 845 : DO 4456 LG=1,NPG 846 : U0=0.D0 847 : DO 4548 I=1,NP 848 : I1=IPADS.LECT(IPT1.NUM(I,K)) 849 : I0=(1-I1)*IK4 + I1 850 : U0=U0-FN(I,LG)*(IZTGG2.VPOCHA(K+NUTOEL,N)* 851 : & (IZTGG3.VPOCHA(I1,1)-IZTGG4.VPOCHA(I0,1))) 852 : 4548 CONTINUE 853 : SO(K,LG,N)=U0 854 : 4456 CONTINUE 855 : 856 : ELSEIF(IKG.EQ.1)THEN 857 : C SOURCE CONSTANTE 858 : 859 : DO 4457 K=1,NBEL 860 : DO 4457 N=1,IDIM 861 : DO 4457 LG=1,NPG 862 : U0=0.D0 863 : DO 4549 I=1,NP 864 : I1=IPADF.LECT(IPT1.NUM(I,K)) 865 : I0=(1-I1)*IK4 + I1 866 : U0=U0-FN(I,LG)*(IZTGG2.VPOCHA(1,N) 867 : &*(IZTGG3.VPOCHA(I1,1)-IZTGG4.VPOCHA(I0,1))) 868 : 4549 CONTINUE 869 : SO(K,LG,N)=U0 870 : 4457 CONTINUE 871 : 872 : ELSEIF(IKG.EQ.4)THEN 873 : C SOURCE SOMMET 874 : DO 4458 K=1,NBEL 875 : DO 4458 N=1,IDIM 876 : DO 4458 LG=1,NPG 877 : U0=0.D0 878 : DO 4547 I=1,NP 879 : I1=IPADS.LECT(IPT1.NUM(I,K)) 880 : I0=(1-I1)*IK4 + I1 881 : U0=U0-FN(I,LG)*(IZTGG2.VPOCHA(I1,N)* 882 : & (IZTGG3.VPOCHA(I1,1)-IZTGG4.VPOCHA(I0,1))) 883 : 4547 CONTINUE 884 : SO(K,LG,N)=U0 885 : 4458 CONTINUE 886 : 887 : ENDIF 888 : ENDIF 889 : 890 : C write(6,*)' Appel a YSOUR' 890 : CALL YSOUR(FN,GR,PG,XYZ,HR,PGSQ,RPG, 891 : & NES,IDIM,NP,NPG,IAXI,IPT1.NUM,SO,IDIM,IPADS.LECT, 892 : & NBEL,NUTOEL,XCOOR,MPOVA1.VPOCHA,NPT) 893 : C write(6,*)' Retour YSOUR' 894 : 895 : SEGSUP IZFFM,IZF1,IZHR,IZH2 896 : SEGSUP SOURCE 897 : 898 : ELSE 899 : 900 : IF(INEFMD.EQ.3)THEN 901 : C Quadratiques 902 : IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//'PRP0' 903 : IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'PRP0' 904 : IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'PRP1' 905 : ELSEIF(INEFMD.EQ.2)THEN 906 : C Macro 907 : IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//' ' 908 : IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'MCP0' 909 : IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'MCP1' 910 : ELSE 911 : IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//' ' 912 : ENDIF 913 : 913 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 914 : 915 : 916 : SEGACT IZFFM*MOD 917 : IZHR=KZHR(1) 918 : IZH2=KZHR(2) 919 : SEGACT IZHR*MOD 920 : NES=GR(/1) 921 : NPG=GR(/3) 922 : IZF1=KTP(1) 923 : SEGACT IZF1*MOD 924 : MP1=IZF1.FN(/1) 925 : NP = IPT1.NUM(/1) 926 : MP = NP 927 : NBEL=IPT1.NUM(/2) 928 : NELG=IZTGG2.VPOCHA(/1) 929 : NPT =MPOVA1.VPOCHA(/1) 930 : 931 : SEGACT MELEP1 932 : C write(6,*)' Appel a XSOUR ' 932 : CALL XSOUR(FN,IZF1.FN,GR,PG,XYZ,HR,PGSQ,RPG, 933 : & NES,IDIM,NP,MP1,NPG,IAXI,IPT1.NUM,IKAS,KPRE, 934 : & IZTGG2.VPOCHA,IKG,NELG,IPADQ.LECT,MELEP1.NUM, 935 : & IZTGG3.VPOCHA,IK3,IZTGG4.VPOCHA,IK4,IPADS.LECT, 936 : & NBEL,NUTOEL,XCOOR,MPOVA1.VPOCHA,NPT) 937 : C write(6,*)' Retour XSOUR ' 938 : 939 : SEGSUP IZFFM,IZF1,IZHR,IZH2 940 : 941 : ENDIF 942 : 943 : NUTOEL=NUTOEL+NBEL 944 : 1102 CONTINUE 945 : 946 : ENDIF 947 : 948 : IF(KIMPL.EQ.2.OR.KIMPL.EQ.0)THEN 949 : 950 : SEGACT MELEME 951 : LL=0 952 : 953 : DO 1533 L=1,MAX(1,LISOUS(/1)) 954 : IPT1=MELEME 955 : IF(LISOUS(/1).NE.0)IPT1=LISOUS(L) 956 : SEGACT IPT1 957 : 958 : NP=IPT1.NUM(/1) 959 : NBELEM=IPT1.NUM(/2) 960 : 961 : NNN=MOD(NBELEM,LRV) 962 : IF(NNN.EQ.0) NPACK=NBELEM/LRV 963 : IF(NNN.NE.0) NPACK=1+(NBELEM-NNN)/LRV 964 : 965 : DO 1534 KPACK=1,NPACK 966 : 967 : C --- POUR CHAQUE PAQUET DE LRV ELEMENTS ou moins 968 : KDEB=1+(KPACK-1)*LRV 969 : KFIN=MIN(NBELEM,KDEB+LRV-1) 970 : NBEL=KFIN-KDEB+1 971 : LL=LL+1 972 : 973 : DO 2 N=1,NINKO 974 : IPMS=LIZAFS(LL,N) 975 : SEGACT IPMS 976 : DO 12 K=1,NBEL 977 : KI=KDEB+K-1 978 : 979 : DO 13 J=1,NP 980 : UU=0.D0 981 : IU=IPADS.LECT(IPT1.NUM(J,KI)) 982 : DO 14 I=1,NP 983 : IK=IPADI.LECT(IPT1.NUM(I,KI)) 984 : UU=UU+IPMS.AM(K,I,J)*IZTU1.VPOCHA(IK,N) 985 : 14 CONTINUE 986 : MPOVA1.VPOCHA(IU,N)=MPOVA1.VPOCHA(IU,N)+UU 987 : 13 CONTINUE 988 : 12 CONTINUE 989 : SEGDES IPMS 990 : 2 CONTINUE 991 : 992 : 1534 CONTINUE 993 : SEGDES IPT1 994 : 1533 CONTINUE 995 : ENDIF 996 : 997 : SEGDES IPM1,IPM2,IPM3 998 : IPS=IPS1 999 : SEGSUP IPS1 1000 : IF(IPS2.NE.IPS)SEGSUP IPS2 1001 : IF(IPS3.NE.IPS)SEGSUP IPS3 1002 : 1002 : CALL ECROBJ('MATRIK',MATRIK) 1003 : 1004 : IF(KIMPL.EQ.2.OR.KIMPL.EQ.0.OR.IARG.GT.1)THEN 1005 : 1005 : CALL ECROBJ('CHPOINT',MCHPO1) 1006 : ELSE 1007 : NAT=2 1008 : NSOUPO=0 1009 : SEGINI MCHPOI 1010 : JATTRI(1)=2 1010 : CALL ECROBJ('CHPOINT',MCHPOI) 1011 : ENDIF 1012 : 1013 : SEGDES IMATRI 1014 : SEGDES MELEME,MATRIK 1015 : IF(IK1.EQ.0)THEN 1016 : SEGDES VISCO 1017 : ENDIF 1018 : 1019 : C************************************************************************* 1020 : ELSE IF(KFORM.EQ.2)THEN 1021 : C CAS FORMULATION VF 1022 : WRITE(6,*)' FORMULATION VF NON DISPONIBLE ' 1023 : ENDIF 1024 : C************************************************************************* 1025 : 1026 : IPDI=IPADI 1027 : SEGSUP IPADI 1028 : IF(IPADS.NE.IPDI)SEGSUP IPADS 1029 : IPAS=1 1030 : C write(6,*)' FIN de NS' 1031 : RETURN 1032 : 90 CONTINUE 1033 : WRITE(6,*)' Interuption anormale de NS' 1034 : C Option %m1:8 incompatible avec les données 1035 : MOTERR( 1: 8) = ' EF ' 1035 : CALL ERREUR(803) 1036 : RETURN 1037 : 1002 FORMAT(10(1X,1PE11.4)) 1038 : 1008 FORMAT( 8(1X,1PE11.4)) 1039 : 1001 FORMAT(20(1X,I5)) 1040 : END 1041 : 1042 : 1043 : 1044 : 1045 : 1046 : 1047 : 1048 : 1049 : 1050 : 1051 : 1052 : 1053 : 1054 : 1055 : 1056 : 1057 : 1058 : 1059 : 1060 : 1061 : 1062 : 1063 : 1064 : 1065 : 1066 : 1067 : 1068 :
© Cast3M 2003 - All rights reserved.
Disclaimer