1 : C ZTSCAL SOURCE MAGN 10/05/18 21:18:05 6675 2 : SUBROUTINE ZTSCAL(MTABX,MTAB1) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C 7 : C CET OPERATEUR DISCRETISE UNE EQUATION 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 LES OPERATEURS SONT "SOUS-INTEGRES" 11 : C 12 : C SYNTAXE : 13 : C --------- 14 : C 1/ Cas incompréssible 15 : C 16 : C de/dt + u Grad e = alpha Lapl e < + S > 17 : C 18 : C 'OPER' 'TSCAL' al 'UN' s 'INCO' EN : 19 : C 'OPER' 'TSCAL' al 'UN' s alt sgt 'INCO' EN : 20 : C 21 : C 2/ Cas compréssible 22 : C 23 : C dh/dt + u Grad h + h Div u = alpha Lapl(tn) < + S > 24 : C 25 : C 'OPER' 'TSCAL' lb 'UN' s tn 'INCO' HN : 26 : C 'OPER' 'TSCAL' lb 'UN' s tn lbt sgt 'INCO' HN : 27 : C 28 : C 29 : C al,alt Diffusivité thermique moléculaire ou turbulente 30 : C FLOTTANT où CHPOINT SCAL CENTRE 31 : C lb,lbt Conductivité thermiquemoléculaire ou turbulente 32 : C FLOTTANT où CHPOINT SCAL CENTRE 33 : C sgt Prandtl turbulent 34 : C s source volumique 35 : C POINT où CHPOINT SCAL CENTRE 36 : C 37 : C un Champ de vitesse transportant 38 : C CHPOINT VECT SOMMET 39 : C tn Champ de température 40 : C CHPOINT SCAL SOMMET 41 : C 42 : C*********************************************************************** 43 : 44 : -INC CCVQUA4 45 : -INC CCOPTIO 46 : -INC CCGEOME 47 : -INC SIZFFB 48 : POINTEUR IZF1.IZFFM 49 : -INC SMCHAML 50 : -INC SMCOORD 51 : -INC SMLENTI 52 : POINTEUR IPADI.MLENTI,IPADS.MLENTI 53 : POINTEUR IPADU.MLENTI,IPADD.MLENTI 54 : POINTEUR IPADQ.MLENTI,MELEMI.MELEME,MELEP1.MELEME 55 : -INC SMELEME 56 : POINTEUR MELEM1.MELEME,MELEMC.MELEME,MELEMS.MELEME 57 : POINTEUR MELEMQ.MELEME 58 : -INC SMCHPOI 59 : POINTEUR IZGG1.MPOVAL 60 : POINTEUR IZTU1.MPOVAL 61 : POINTEUR VISCO.MPOVAL 62 : POINTEUR IZTGG3.MPOVAL,IZTGG4.MPOVAL 63 : POINTEUR IZTGG6.MPOVAL 64 : POINTEUR MZALT.MPOVAL,MZST.MPOVAL 65 : POINTEUR IZVOL.MPOVAL,IZTCO.MPOVAL 66 : POINTEUR VITESS.MPOVAL,UTRANS.MPOVAL 67 : -INC SMMATRIK 68 : POINTEUR IPM.IZAFM 69 : SEGMENT IMATRS 70 : INTEGER LIZAFS(NBSOUS,NBME) 71 : ENDSEGMENT 72 : POINTEUR IPMS.IZAFM,IPS1.IZAFM,IPS2.IZAFM,IPS3.IZAFM 73 : -INC SMLMOTS 74 : POINTEUR LINCO.MLMOTS 75 : CHARACTER*8 NOMZ,NOMI,NOM0,TYPE,TYPC,NOM,NOMA 76 : PARAMETER (NTB=1) 77 : CHARACTER*8 LTAB(NTB) 78 : DIMENSION KTAB(NTB),IXV(3),RO(1) 79 : SAVE IPAS 80 : DATA LTAB/'KIZX '/,IPAS/0/,RO/1.D0/ 81 : C***************************************************************************** 82 : CTSCAL 83 : C write(6,*)' Debut TSCAL' 84 : 85 : C 86 : C- Récupération de la table DOMAINE associée au domaine local 87 : C 87 : CALL ACMM(MTABX,'NOMZONE',NOMZ) 87 : CALL LEKTAB(MTABX,'DOMZ',MTABZ) 88 : IF(MTABZ.EQ.0)THEN 89 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 90 : MOTERR( 1: 8) = ' DOMZ ' 91 : MOTERR( 9:16) = ' DOMZ ' 92 : MOTERR(17:24) = ' KIZX ' 92 : CALL ERREUR(786) 93 : RETURN 94 : ENDIF 95 : C 96 : C- Récupération de la table INCO (pointeur KINC) 97 : C 97 : CALL LEKTAB(MTAB1,'INCO',KINC) 98 : IF(KINC.EQ.0)THEN 99 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 100 : MOTERR( 1: 8) = ' INCO ' 101 : MOTERR( 9:16) = ' INCO ' 102 : MOTERR(17:24) = ' EQEX ' 102 : CALL ERREUR(786) 103 : RETURN 104 : ENDIF 105 : 106 : C***************************************************************************** 107 : C OPTIONS 108 : 109 : C 110 : C- Récupération de la table des options KOPT (pointeur KOPTI) 111 : C 111 : CALL LEKTAB(MTABX,'KOPT',KOPTI) 112 : IF (KOPTI.EQ.0) THEN 113 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 114 : MOTERR( 1: 8) = ' KOPT ' 115 : MOTERR( 9:16) = ' KOPT ' 116 : MOTERR(17:24) = ' KIZX ' 116 : CALL ERREUR(786) 117 : RETURN 118 : ENDIF 119 : 120 : IAXI=0 121 : IF(IFOMOD.EQ.0)IAXI=2 122 : 122 : CALL ACME(KOPTI,'MTRMASS ',MMPG) 123 : IPG=0 124 : IF(MMPG.EQ.3)IPG=1 124 : CALL ACME(KOPTI,'IDCEN',IDCEN) 124 : CALL ACME(KOPTI,'IKOMP',IKOMP) 124 : CALL ACME(KOPTI,'KIMPL',KIMPL) 124 : CALL ACMF(KOPTI,'AIMPL',AIMPL) 124 : CALL ACME(KOPTI,'KFORM',KFORM) 124 : CALL ACME(KOPTI,'KPOIN',KPRE) 124 : CALL ACME(KOPTI,'KMACO',KMACO) 125 : IF (IERR.NE.0) RETURN 126 : 127 : C***************************************************************************** 128 : 128 : CALL LEKTAB(MTABZ,'MAILLAGE',MELEME) 128 : CALL LEKTAB(MTABZ,'SOMMET',MELEMS) 128 : CALL LEKTAB(MTABZ,'CENTRE',MELEMC) 128 : CALL LEKTAB(MTABZ,'MACRO',MACRO) 128 : CALL LEKTAB(MTABZ,'MACRO1',MELEMI) 128 : CALL LEKTAB(MTABZ,'QUADRATI',MQUAD) 129 : IF (IERR.NE.0) RETURN 130 : 131 : MELEMQ=MELEMC 132 : MELEP1=MELEMC 133 : C write(6,*)' KPRE=',kpre,' MACRO=',macro,' QUADR=',MQUAD 134 : IF(KPRE.LE.3.AND.MACRO.EQ.0.AND.MQUAD.EQ.0.AND.KFORM.NE.0)THEN 135 : WRITE(6,*)' Operateur TSCA ' 136 : WRITE(6,*)' Incompatibilité du terme source et des éléments' 137 : WRITE(6,*)' MACRO ou QUADRATIQUE attendu ' 138 : WRITE(6,*)' Interuption anormale de TSCA' 139 : C Option %m1:8 incompatible avec les données 140 : MOTERR( 1: 8) = ' EF ' 140 : CALL ERREUR(803) 141 : RETURN 142 : ELSEIF(KPRE.EQ.3)THEN 142 : CALL LEKTAB(MTABZ,'CENTREP0',MELEMQ) 143 : MELEP1=MELEMQ 144 : ELSEIF(KPRE.EQ.4)THEN 144 : CALL LEKTAB(MTABZ,'CENTREP1',MELEMQ) 144 : CALL LEKTAB(MTABZ,'ELTP1NC ',MELEP1) 145 : ENDIF 146 : 146 : CALL LEKTAB(MTABZ,'XXPSOML',MCHELM) 146 : CALL LEKTAB(MTABZ,'XXDXDY',MCHPDX) 146 : CALL LEKTAB(MTABZ,'XXVOLUM',MCHPVO) 147 : IF (IERR.NE.0) RETURN 148 : 149 : SEGACT MCHELM 149 : CALL LICHT(MCHPDX,IZTCO,TYPC,IGEOM) 150 : NELZ=IZTCO.VPOCHA(/1) 150 : CALL LICHT(MCHPVO,IZVOL,TYPC,IGEOM) 151 : C*** 152 : 153 : 154 : C************************************************************************* 155 : C VERIFICATIONS SUR LES INCONNUES 156 : C 157 : C- Récupération du nombre d'inconnues et du nom de l'inconnue NOMI 158 : C 159 : TYPE='LISTMOTS' 159 : CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO) 160 : IF (IERR.NE.0) RETURN 161 : SEGACT LINCO 162 : NBINC=LINCO.MOTS(/2) 163 : IF(NBINC.NE.1)THEN 164 : C Indice %m1:8 : contient plus de %i1 %m9:16 165 : MOTERR( 1:8) = 'LISTINCO' 166 : INTERR(1) = 1 167 : MOTERR(9:16) = ' MOTS ' 167 : CALL ERREUR(799) 168 : RETURN 169 : ENDIF 170 : 171 : NOMI=LINCO.MOTS(1) 172 : NOMA=NOMI 173 : C 174 : C- Récupération de l'inconnue 175 : C 176 : TYPE=' ' 176 : CALL ACMO(KINC,NOMI,TYPE,MCHPOI) 177 : IF(TYPE.NE.'CHPOINT ')THEN 178 : C Indice %m1:8 : ne contient pas un objet de type %m9:16 179 : MOTERR( 1: 8) = 'INC '//NOMI 180 : MOTERR( 9:16) = 'CHPOINT ' 180 : CALL ERREUR(800) 181 : RETURN 182 : ELSE 182 : CALL LICHT(MCHPOI,IZTU1,TYPC,MELEM1) 183 : NINKO = IZTU1.VPOCHA(/2) 184 : IF (NINKO.NE.1) THEN 185 : C Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes 186 : MOTERR( 1: 8) = 'INC '//NOMI 187 : MOTERR( 9:16) = 'CHPOINT ' 187 : CALL ERREUR(784) 188 : RETURN 189 : ENDIF 190 : ENDIF 191 : 192 : C***************************************************************************** 193 : C Le domaine de definition est donne par le SPG de la premiere inconnue 194 : C Les inconnues suivantes devront posseder ce meme pointeur 195 : C On verifie que les points de la zone sont tous inclus dans ce SPG 196 : 196 : CALL KRIPAD(MELEM1,IPADI) 197 : IPADS=IPADI 198 : IPADD=IPADI 198 : IF(MELEM1.NE.MELEMS)CALL KRIPAD(MELEMS,IPADS) 199 : IPADU=IPADS 200 : 201 : IF(IPAS.EQ.0)THEN 201 : CALL VERPAD(IPADI,MELEME,IRET) 202 : IF(IRET.NE.0)THEN 203 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 204 : MOTERR(1: 8) = 'INC '//NOMI 205 : MOTERR(9:16) = 'CHPOINT ' 205 : CALL ERREUR(788) 206 : RETURN 207 : ENDIF 208 : ENDIF 209 : 210 : C***************************************************************************** 211 : C Lecture des coefficient 212 : C Type du coefficient : 213 : C IK1=0 CHPOINT IK1=1 scalaire IK1=2 vecteur 214 : 215 : C write(6,*)' Opérateur TSCAL lecture des coefficients' 215 : CALL ACME(MTABX,'IARG',IARG) 216 : IF(IKOMP.EQ.0)THEN 217 : IF(IARG.NE.3.AND.IARG.NE.5)THEN 218 : WRITE(6,*)' Opérateur TSCAL : option incompréssible ' 219 : WRITE(6,*)' Nombre d''arguments incorrect : ',IARG 220 : WRITE(6,*)' On attend 3 ou 5 ' 221 : C Indice %m1:8 : nombre d'arguments incorrect 222 : MOTERR(1:8) = 'IARG ' 222 : CALL ERREUR(804) 223 : RETURN 224 : ENDIF 225 : ELSEIF(IKOMP.EQ.1)THEN 226 : IF(IARG.NE.4.AND.IARG.NE.6)THEN 227 : WRITE(6,*)' Opérateur TSCAL : option compréssible ' 228 : WRITE(6,*)' Nombre d''arguments incorrect : ',IARG 229 : WRITE(6,*)' On attend 4 ou 6 ' 230 : C Indice %m1:8 : nombre d'arguments incorrect 231 : MOTERR(1:8) = 'IARG ' 231 : CALL ERREUR(804) 232 : RETURN 233 : ENDIF 234 : ENDIF 235 : 236 : C--Cas incompréssible 237 : IF(IKOMP.EQ.0)THEN 238 : C 1er coefficient Alpha 239 : IXV(1)=MELEMC 240 : IXV(2)=1 241 : IXV(3)=0 241 : CALL LEKCOF('Opérateur TSCAL :', 242 : & MTABX,KINC,1,IXV,MCOF,VISCO,NPT1,NC1,IKL,IRET) 243 : IF(IRET.EQ.0)RETURN 244 : 245 : IK2=-1 246 : IKG=-1 247 : IK3=-1 248 : IK4=-1 249 : IZTGG4=IZTU1 250 : MZALT=VISCO 251 : MZST=VISCO 252 : 253 : C 2ème coefficient UN 254 : IXV(1)=-MELEMS 255 : IXV(2)=0 256 : IXV(3)=1 256 : CALL LEKCOF('Opérateur TSCAL :', 257 : & MTABX,KINC,2,IXV,MUTR,UTRANS,NPTU,NC2,IKU,IRET) 258 : IF(IRET.EQ.0)RETURN 259 : IF(IKU.EQ.2)IKU=1 260 : 261 : C 3ème coefficient source 262 : IXV(1)=MELEMC 263 : IXV(2)=1 264 : IXV(3)=0 264 : CALL LEKCOF('Opérateur TSCAL :', 265 : & MTABX,KINC,3,IXV,IZTG3,IZTGG3,NPT3,NC3,IKS,IRET) 266 : IF(IRET.EQ.0)RETURN 267 : 268 : IF(IARG.EQ.5)THEN 269 : C alpha turbulent 270 : IXV(1)=MELEMC 271 : IXV(2)=0 272 : IXV(3)=0 272 : CALL LEKCOF('Opérateur TSCAL :', 273 : & MTABX,KINC,4,IXV,MALT,MZALT,NPT4,NC4,IK4,IRET) 274 : IF(IRET.EQ.0)RETURN 275 : 276 : C sigma turbulent 277 : IXV(1)=0 278 : IXV(2)=1 279 : IXV(3)=0 279 : CALL LEKCOF('Opérateur TSCAL :', 280 : & MTABX,KINC,5,IXV,MST,MZST,NPT5,NC5,IK5,IRET) 281 : IF(IRET.EQ.0)RETURN 282 : IF(MZST.VPOCHA(1,1).LE.0.D0)THEN 283 : WRITE(6,*)' Opérateur TSCAL :' 284 : WRITE(6,*)'Valeur du Prandtl turbulent érronée' 285 : RETURN 286 : ENDIF 287 : ENDIF 288 : 289 : C--Cas compréssible 290 : ELSEIF(IKOMP.EQ.1)THEN 291 : C 1er coefficient Lambda 292 : IXV(1)=MELEMC 293 : IXV(2)=1 294 : IXV(3)=0 294 : CALL LEKCOF('Opérateur TSCAL :', 295 : & MTABX,KINC,1,IXV,MCOF,VISCO,NPT1,NC1,IKL,IRET) 296 : IF(IRET.EQ.0)RETURN 297 : 298 : IK2=-1 299 : IKG=-1 300 : IK3=-1 301 : IK4=-1 302 : MZALT=VISCO 303 : MZST=VISCO 304 : 305 : C 2ème coefficient UN 306 : IXV(1)=-MELEMS 307 : IXV(2)=0 308 : IXV(3)=1 308 : CALL LEKCOF('Opérateur TSCAL :', 309 : & MTABX,KINC,2,IXV,MUTR,UTRANS,NPTU,NC2,IKU,IRET) 310 : IF(IRET.EQ.0)RETURN 311 : IF(IKU.EQ.2)IKU=1 312 : 313 : C 3ème coefficient source 314 : IXV(1)=MELEMC 315 : IXV(2)=1 316 : IXV(3)=0 316 : CALL LEKCOF('Opérateur TSCAL :', 317 : & MTABX,KINC,3,IXV,IZTG3,IZTGG3,NPT3,NC3,IKS,IRET) 318 : IF(IRET.EQ.0)RETURN 319 : 320 : C 4ème coefficient tn 321 : IXV(1)=MELEMS 322 : IXV(2)=0 323 : IXV(3)=0 323 : CALL LEKCOF('Opérateur TSCAL :', 324 : & MTABX,KINC,4,IXV,IZTG4,IZTGG4,NPT4,NC4,IK4,IRET) 325 : IPADD=IPADS 326 : IF(IRET.EQ.0)RETURN 327 : 328 : IF(IARG.EQ.6)THEN 329 : C lambda turbulent 330 : IXV(1)=MELEMC 331 : IXV(2)=0 332 : IXV(3)=0 332 : CALL LEKCOF('Opérateur TSCAL :', 333 : & MTABX,KINC,5,IXV,MALT,MZALT,NPT5,NC5,IK5,IRET) 334 : IF(IRET.EQ.0)RETURN 335 : 336 : C sigma turbulent 337 : IXV(1)=0 338 : IXV(2)=1 339 : IXV(3)=0 339 : CALL LEKCOF('Opérateur TSCAL :', 340 : & MTABX,KINC,6,IXV,MST,MZST,NPT6,NC6,IK6,IRET) 341 : IF(IRET.EQ.0)RETURN 342 : IF(MZST.VPOCHA(1,1).LE.0.D0)THEN 342 : call erreur(992) 343 : RETURN 344 : ENDIF 345 : ENDIF 346 : 347 : ENDIF 348 : 349 : C write(6,*)' Opérateur TSCAL : Fin lecture Arguments ' 350 : C Fin lecture Arguments ************************************************ 351 : 352 : 352 : CALL LEKTAB(MTAB1,'PASDETPS',MTABT) 353 : IF(MTABT.EQ.0)THEN 353 : CALL CRTABL(MTABT) 353 : CALL ECMM(MTABT,'SOUSTYPE','PASDETPS') 353 : CALL ECMO(MTAB1,'PASDETPS','TABLE ',MTABT) 354 : DT=1.D30 355 : DTP=1.D30+DT 356 : IPAT=1 356 : CALL ECME(MTABT,'NUPASDT',IPAT) 357 : DTM1=1.D-20 357 : CALL ECMF(MTABT,'DELTAT-1',DTM1) 358 : ELSE 358 : CALL ACMF(MTABT,'DELTAT',DTP) 358 : CALL ACMF(MTABT,'DELTAT-1',DTM1) 359 : ENDIF 360 : 361 : C*********** FORMULATIONS ********** 362 : C*********** FORMULATIONS ********** 363 : C*********** FORMULATIONS ********** 364 : 365 : 366 : 367 : C************************** FORMULATION EFM1 *************************** 368 : IF(KFORM.EQ.0)THEN 369 : C Formulation EFM1 370 : C Vérification des options 371 : 372 : IF(KIMPL.NE.0)THEN 373 : C Option %m1:8 incompatible avec les données 374 : MOTERR( 1: 8) = ' EFM1 ' 375 : WRITE(6,*)' Options incompatibles : EFM1 et (IMPL ou SEMI) ' 375 : CALL ERREUR(803) 376 : RETURN 377 : ENDIF 378 : 379 : IF(IKOMP.EQ.1.AND.(IDCEN.EQ.6.OR.IDCEN.EQ.7))THEN 380 : C Option %m1:8 incompatible avec les données 381 : MOTERR( 1: 8) = ' EFM1 ' 382 : WRITE(6,*)' Option de décentrement non prévue en', 383 : & ' formulation conservative ' 383 : CALL ERREUR(803) 384 : RETURN 385 : ENDIF 386 : 387 : IF(IDCEN.GE.4.AND.(IDCEN.NE.6.AND.IDCEN.NE.7))THEN 388 : C Option %m1:8 incompatible avec les données 389 : MOTERR( 1: 8) = ' EFM1 ' 390 : WRITE(6,*)' Option de décentrement non prévue en', 391 : & ' formulation EFM1 ' 391 : CALL ERREUR(803) 392 : RETURN 393 : ENDIF 394 : 395 : IF(IDIM.EQ.3.AND.(IDCEN.EQ.6.OR.IDCEN.EQ.7))THEN 396 : C Option %m1:8 incompatible avec les données 397 : MOTERR( 1: 8) = ' EFM1 ' 398 : WRITE(6,*)' Option de décentrement non prévue en 3D' 398 : CALL ERREUR(803) 399 : RETURN 400 : ENDIF 401 : 401 : CALL LEKTAB(MTAB1,'KIZG',KIZG) 402 : IF(KIZG.EQ.0)THEN 402 : CALL CRTABL(KIZG) 402 : CALL ECMM(KIZG,'SOUSTYPE','KIZG') 402 : CALL ECMO(MTAB1,'KIZG','TABLE ',KIZG) 403 : ENDIF 404 : 405 : TYPE=' ' 405 : CALL ACMO(KIZG,NOMI,TYPE,IZG1) 406 : IF(TYPE.NE.'CHPOINT ')THEN 407 : NC=IZTU1.VPOCHA(/2) 408 : TYPE='SOMMET' 408 : CALL CRCHPT(TYPE,MELEM1,NC,IZG1) 408 : CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG1) 409 : ENDIF 410 : 410 : CALL LICHT(IZG1,IZGG1,TYPC,IGEOM) 411 : 412 : IF(IGEOM.NE.MELEM1)THEN 413 : WRITE(6,*)' Opérateur TSCAL' 414 : WRITE(6,*)'Incompatibilite de SPG entre 1eres inconnues' 415 : C Option %m1:8 incompatible avec les données 416 : MOTERR( 1: 8) = ' EFM1 ' 416 : CALL ERREUR(803) 417 : RETURN 418 : ENDIF 419 : 419 : CALL LEKTAB(MTABZ,'MATESI',MATRIK) 420 : IF (IERR.NE.0) RETURN 421 : SEGACT MATRIK 422 : 423 : IMATRI=IRIGEL(4,1) 424 : SEGACT IMATRI 425 : C--- 426 : 427 : SEGACT MELEME 428 : NBSOUS=LISOUS(/1) 429 : IF(NBSOUS.EQ.0)NBSOUS=1 430 : NUTOEL=0 431 : DT=1.E30 432 : 433 : DO 1 L=1,NBSOUS 434 : IPT1=MELEME 435 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 436 : SEGACT IPT1 437 : 438 : NOM0=NOMS(IPT1.ITYPEL)//' ' 438 : CALL KALPBG(NOM0,'FONFORM0',IZFFM) 439 : SEGACT IZFFM*MOD 440 : 441 : MCHAML=ICHAML(L) 442 : SEGACT MCHAML 443 : MELVAL=IELVAL(1) 444 : SEGACT MELVAL 445 : 446 : IF(IMACHE(L).NE.IPT1)THEN 447 : write(*,*)'IPT1,IMACHE ',IPT1,IMACHE(L) 448 : goto 90 449 : ENDIF 450 : 451 : IZAFM=LIZAFM(L,1) 452 : IPM1=IZAFM 453 : SEGACT IZAFM 454 : IF(IAXI.NE.0)THEN 455 : IPM1=LIZAFM(L,2) 456 : SEGACT IPM1 457 : ENDIF 458 : 459 : NP =IPT1.NUM(/1) 460 : NBEL=IPT1.NUM(/2) 461 : IES=IDIM 462 : 463 : NPTU=UTRANS.VPOCHA(/1) 464 : NPTT=IZTGG4.VPOCHA(/1) 465 : NPTI=IZTGG4.VPOCHA(/1) 466 : 467 : IF(IDCEN.GE.1.AND.IDCEN.LE.3)THEN 468 : 469 : IF(IKOMP.EQ.0)THEN 470 : 470 : CALL ZCTSCL(AM,IPM1.AM,VELCHE,IPT1.NUM,NBEL,NUTOEL,IES,NP, 471 : & IAXI,IPADI.LECT,IPADU.LECT,IPADD.LECT,IKOMP,IARG, 472 : & VISCO.VPOCHA,IKL,UTRANS.VPOCHA,IKU,NPTU,IZTGG4.VPOCHA,NPTT, 473 : & IZTGG3.VPOCHA,IKS, 474 : & IZTU1.VPOCHA,IZGG1.VPOCHA,NPTI, 475 : & MZALT.VPOCHA,MZST.VPOCHA, 476 : & IZVOL.VPOCHA,IZTCO.VPOCHA,NELZ,IDCEN,IPG, 477 : & DTM1,DT,DTT1,DTT2,NUEL,DIAEL,IZFFM.FN) 478 : 479 : ELSEIF(IKOMP.EQ.1)THEN 480 : 481 : NPT=IZGG1.VPOCHA(/1) 481 : CALL ZCTSCA(AM,IPM1.AM,VELCHE,IPT1.NUM,NBEL,NUTOEL,NPT,IES,NP, 482 : & IAXI,IPADI.LECT,IKOMP,IARG,IPADU.LECT,IPADD.LECT, 483 : & VISCO.VPOCHA,IKL,UTRANS.VPOCHA,IKU,NPTU,IZTGG4.VPOCHA, 484 : & IZTGG3.VPOCHA,IKS,IZTU1.VPOCHA, 485 : & IZGG1.VPOCHA,MZALT.VPOCHA,MZST.VPOCHA, 486 : & IZVOL.VPOCHA,IZTCO.VPOCHA,NELZ,IDCEN, 487 : & DTM1,DT,DTT1,DTT2,NUEL,DIAEL) 488 : 489 : ENDIF 490 : 491 : ELSEIF(IDCEN.EQ.6)THEN 492 : 493 : 494 : N=NPTU 495 : NC=1 496 : SEGINI MPOVA6 497 : 497 : CALL ZPSI(AM,IPM1.AM,VELCHE,IPT1.NUM,NBEL,NUTOEL,NPT,IES,NP, 498 : & IAXI,IPADI.LECT,IKOMP,IARG, 499 : & VISCO.VPOCHA,IKL,UTRANS.VPOCHA,IKU,NPTU,IPADU.LECT, 500 : & IZTGG4.VPOCHA,IZTGG3.VPOCHA,IKS,IZTU1.VPOCHA, 501 : & IZGG1.VPOCHA,MZALT.VPOCHA,MZST.VPOCHA, 502 : & IZVOL.VPOCHA,IZTCO.VPOCHA,NELZ,MPOVA6.VPOCHA, 503 : & DTM1,DT,DTT1,DTT2,NUEL,DIAEL) 504 : 505 : SEGSUP MPOVA6 506 : 507 : 508 : 509 : ELSEIF(IDCEN.EQ.7)THEN 510 : 510 : CALL ZJOHNS(AM,IPM1.AM,VELCHE,IPT1.NUM,NBEL,NUTOEL,NPT,IES,NP, 511 : & IAXI,IPADI.LECT,IKOMP,IARG, 512 : & VISCO.VPOCHA,IKL,UTRANS.VPOCHA,IKU,NPTU,IPADU.LECT, 513 : & IZTGG4.VPOCHA,IZTGG3.VPOCHA,IKS,IZTU1.VPOCHA, 514 : & IZGG1.VPOCHA,MZALT.VPOCHA,MZST.VPOCHA, 515 : & IZVOL.VPOCHA,IZTCO.VPOCHA,NELZ, 516 : & DTM1,DT,DTT1,DTT2,NUEL,DIAEL) 517 : 518 : ENDIF 519 : 520 : 521 : SEGDES IZAFM*NOMOD,IPT1*NOMOD,MCHAML*NOMOD,MELVAL*NOMOD 522 : IF(IAXI.NE.0)SEGDES IPM1*NOMOD 523 : NUTOEL=NUTOEL+NBEL 524 : 525 : 1 CONTINUE 526 : SEGDES MATRIK*NOMOD,MCHELM*NOMOD 527 : SEGDES IMATRI 528 : 529 : IF(DT.LT.DTP)THEN 529 : CALL ECMF(MTABT,'DELTAT',DT) 529 : CALL ECMM(MTABT,'OPER','TSCAL') 529 : CALL ECMM(MTABT,'ZONE',NOMZ) 529 : CALL ECMF(MTABT,'DTCONV',DTT1) 529 : CALL ECMF(MTABT,'DTDIFU',DTT2) 529 : CALL ECMF(MTABT,'DIAEL',DIAEL) 529 : CALL ECME(MTABT,'NUEL',NUEL) 530 : ENDIF 531 : SEGDES VISCO,UTRANS 532 : IF(IKOMP.EQ.0.AND.IARG.EQ.3)SEGDES IZTGG3*NOMOD 533 : IF(IKOMP.EQ.1.AND.IARG.EQ.4)SEGDES IZTGG3*NOMOD,IZTGG4*NOMOD 534 : IF(IKOMP.EQ.1.AND.IARG.EQ.6)SEGDES IZTGG3*NOMOD,IZTGG4*NOMOD 535 : & ,MZALT*NOMOD,MZST*NOMOD 536 : SEGDES IZTU1*NOMOD 537 : SEGDES IZGG1 538 : SEGDES IZVOL*NOMOD,IZTCO*NOMOD 539 : SEGDES LINCO 540 : 541 : C************************************************************************* 542 : ELSE IF(KFORM.EQ.1)THEN 543 : C CAS FORMULATION EF 544 : 545 : DT=0.D0 546 : IF(IDCEN.EQ.4)THEN 547 : TYPE=' ' 547 : CALL ACMO(MTABT,'DELTAT',TYPE,IENT) 548 : IF(TYPE.NE.'ENTIER')THEN 549 : WRITE(6,*)' Opérateur TSCA' 550 : WRITE(6,*)' On reclame un pas de temps' 551 : C Option %m1:8 incompatible avec les données 552 : MOTERR( 1: 8) = ' EF ' 552 : CALL ERREUR(803) 553 : RETURN 554 : ELSE 554 : CALL ACMF(MTABT,'DELTAT',DT) 555 : ENDIF 556 : ENDIF 557 : 558 : IHV=0 559 : NUTOEL=0 560 : NINKO=IZTU1.VPOCHA(/2) 561 : SEGACT MELEME 562 : NBSOUS=LISOUS(/1) 563 : IF(NBSOUS.EQ.0)NBSOUS=1 564 : 565 : TYPE=' ' 565 : CALL ACMO(MTABX,'MATELM',TYPE,MATRIK) 566 : IF(TYPE.EQ.'MATRIK'.AND.KMACO.NE.0)THEN 567 : SEGACT MATRIK 568 : NMATRI=IRIGEL(/2) 569 : MELEME=IRIGEL(1,1) 570 : SEGACT MELEME 571 : IMATRI=IRIGEL(4,1) 572 : SEGACT IMATRI 573 : NBME=LIZAFM(/2) 574 : NINKO=NBME 575 : MELEMS=KSPGP 576 : 577 : 578 : ELSE 579 : 580 : NRIGE=7 581 : NKID =9 582 : NKMT =7 583 : NMATRI=1 584 : SEGINI MATRIK 585 : IRIGEL(1,1)=MELEME 586 : IRIGEL(2,1)=MELEME 587 : IRIGEL(7,1)=2 588 : NBOP=0 589 : NBME=NINKO 590 : NBELC=0 590 : CALL LEKTAB(MTABZ,'SOMMET',MELEMS) 591 : SEGINI IMATRI,IMATRS 592 : IRIGEL(4,1)=IMATRI 593 : KSPGP=MELEMS 594 : KSPGD=MELEMS 595 : 596 : IF(NBME.EQ.1)THEN 597 : LISPRI(1)=NOMI(1:4)//' ' 598 : LISDUA(1)=NOMA(1:4)//' ' 599 : ELSE 600 : DO 102 I=1,NBME 601 : WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7) 602 : LISPRI(I)=NOM(1:4)//' ' 603 : WRITE(NOM,FMT='(I1,A7)')I,NOMA(1:7) 604 : LISDUA(I)=NOM(1:4)//' ' 605 : 102 CONTINUE 606 : ENDIF 607 : 608 : NUTOEL=0 609 : DO 101 L=1,NBSOUS 610 : IPT1=MELEME 611 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 612 : SEGACT IPT1 613 : NOM0=NOMS(IPT1.ITYPEL)//' ' 613 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 614 : SEGACT IZFFM*MOD 615 : IZHR=KZHR(1) 616 : SEGACT IZHR*MOD 617 : NES=GR(/1) 618 : NPG=GR(/3) 619 : 620 : NP = IPT1.NUM(/1) 621 : MP = NP 622 : NBEL=IPT1.NUM(/2) 623 : SEGINI IPM1,IPS1 624 : LIZAFM(L,1)=IPM1 625 : LIZAFS(L,1)=IPS1 626 : IPM2=IPM1 627 : IPM3=IPM1 628 : IPS2=IPS1 629 : IPS3=IPS1 630 : IF(NBME.GE.2)THEN 631 : SEGINI IPM2,IPS2 632 : LIZAFM(L,2)=IPM2 633 : LIZAFS(L,2)=IPS2 634 : ENDIF 635 : IF(NBME.GE.3)THEN 636 : SEGINI IPM3,IPS3 637 : LIZAFM(L,3)=IPM3 638 : LIZAFS(L,3)=IPS3 639 : ENDIF 640 : 641 : 642 : KITT=2 643 : KJTT=IKL 644 : NPT=UTRANS.VPOCHA(/1) 645 : NPTG=IZTU1.VPOCHA(/1) 646 : 646 : CALL ZCONV(FN,GR,PG,XYZ,HR,PGSQ,RPG, 647 : & NES,IDIM,NP,NPG,IAXI,AIMPL,IKOMP, 648 : & RO,1,UTRANS.VPOCHA,IKU,NPT,IPADU.LECT,VISCO.VPOCHA,IKL, 649 : & IPT1.NUM,NBEL,NUTOEL,XCOOR, 650 : & IPM1.AM,IPM2.AM,IPM3.AM, 651 : & IPS1.AM,IPS2.AM,IPS3.AM, 652 : & NINKO,IDCEN,DT, 653 : & IZTU1.VPOCHA,0,NPTG,IPADI.LECT,IZTCO.VPOCHA,NELZ) 654 : 654 : CALL XLAPL(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI, 655 : & VISCO.VPOCHA,VISCO.VPOCHA,VISCO.VPOCHA,KITT,KJTT,IKL, 656 : & IPT1.NUM,NBEL,NUTOEL,XCOOR,AIMPL,IKOMP, 657 : & IPM1.AM,IPM2.AM,IPM3.AM, 658 : & IPS1.AM,IPS2.AM,IPS3.AM, 659 : & NINKO,IHV,IARG,VISCO.VPOCHA) 660 : 661 : NUTOEL=NUTOEL+NBEL 662 : 101 CONTINUE 663 : 664 : ENDIF 665 : 666 : C On cree le CHPOINT pour les sources et eventuellement le semi 667 : C 668 : NAT=2 669 : NSOUPO=1 670 : SEGACT MELEMS 671 : N=MELEMS.NUM(/2) 672 : NC=NINKO 673 : SEGINI MCHPO1,MSOUP1,MPOVA1 674 : MCHPO1.IFOPOI=IFOMOD 675 : MCHPO1.MOCHDE=TITREE 676 : MCHPO1.MTYPOI='SMBR' 677 : MCHPO1.JATTRI(1)=2 678 : MCHPO1.IPCHP(1)=MSOUP1 679 : DO 177 N=1,NINKO 680 : MSOUP1.NOCOMP(N)=LISDUA(N)(1:4) 681 : 177 CONTINUE 682 : MSOUP1.IGEOC=MELEMS 683 : MSOUP1.IPOVAL=MPOVA1 684 : 684 : CALL KRIPAD(MELEMQ,IPADQ) 685 : 686 : SEGACT MELEMI 687 : NBSOUS=MELEMI.LISOUS(/1) 688 : IF(NBSOUS.EQ.0)NBSOUS=1 689 : 690 : NUTOEL=0 691 : DO 1102 L=1,NBSOUS 692 : IPT1=MELEMI 693 : IF(NBSOUS.NE.1)IPT1=MELEMI.LISOUS(L) 694 : SEGACT IPT1 695 : 696 : IF(MQUAD.NE.0)THEN 697 : IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//'PRP0' 698 : IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'PRP0' 699 : IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'PRP1' 700 : ELSEIF(MACRO.NE.0)THEN 701 : IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//' ' 702 : IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'MCP0' 703 : IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'MCP1' 704 : ELSE 705 : IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//' ' 706 : ENDIF 707 : 707 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 708 : 709 : 710 : SEGACT IZFFM*MOD 711 : IZHR=KZHR(1) 712 : SEGACT IZHR*MOD 713 : NES=GR(/1) 714 : NPG=GR(/3) 715 : IZF1=KTP(1) 716 : SEGACT IZF1*MOD 717 : MP1=IZF1.FN(/1) 718 : NP = IPT1.NUM(/1) 719 : MP = NP 720 : NBEL=IPT1.NUM(/2) 721 : NELG=IZTGG3.VPOCHA(/1) 722 : NPT =MPOVA1.VPOCHA(/1) 723 : SEGACT MELEP1 724 : 725 : IKAS=1 725 : CALL XSOUR(FN,IZF1.FN,GR,PG,XYZ,HR,PGSQ,RPG, 726 : & NES,IDIM,NP,MP1,NPG,IAXI,IPT1.NUM,IKAS,KPRE, 727 : & IZTGG3.VPOCHA,IKS,NELG,IPADQ.LECT,MELEP1.NUM, 728 : & IZTGG3.VPOCHA,IKS,IZTGG3.VPOCHA,IKS,IPADS.LECT, 729 : & NBEL,NUTOEL,XCOOR,MPOVA1.VPOCHA,NPT) 730 : 731 : NUTOEL=NUTOEL+NBEL 732 : 1102 CONTINUE 733 : SEGSUP IPADQ 734 : 735 : 736 : IF(KIMPL.EQ.0.OR.KIMPL.EQ.2)THEN 737 : 738 : NBSOUS=LISOUS(/1) 739 : IF(NBSOUS.EQ.0)NBSOUS=1 740 : 741 : DO 1533 L=1,NBSOUS 742 : IPT1=MELEME 743 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 744 : SEGACT IPT1 745 : NP=IPT1.NUM(/1) 746 : NBEL=IPT1.NUM(/2) 747 : DO 2 N=1,NINKO 748 : IPMS=LIZAFS(L,N) 749 : SEGACT IPMS 750 : DO 12 K=1,NBEL 751 : DO 13 J=1,NP 752 : UU=0.D0 753 : IU=IPADS.LECT(IPT1.NUM(J,K)) 754 : DO 14 I=1,NP 755 : IK=IPADI.LECT(IPT1.NUM(I,K)) 756 : UU=UU+IPMS.AM(K,I,J)*IZTU1.VPOCHA(IK,N) 757 : 14 CONTINUE 758 : MPOVA1.VPOCHA(IU,N)=MPOVA1.VPOCHA(IU,N)+UU 759 : 13 CONTINUE 760 : 12 CONTINUE 761 : 762 : 2 CONTINUE 763 : 764 : 1533 CONTINUE 765 : 766 : SEGDES IPM1,IPM2,IPM3 767 : IPS=IPS1 768 : SEGSUP IPS1 769 : IF(IPS2.NE.IPS)SEGSUP IPS2 770 : IF(IPS3.NE.IPS)SEGSUP IPS3 771 : SEGDES IZTCO 772 : ENDIF 773 : 774 : TYPE=' ' 774 : CALL ACMO(MTAB1,'SMBR',TYPE,MCHPO2) 775 : IF(TYPE.NE.'CHPOINT')THEN 775 : CALL ECMO(MTAB1,'SMBR','CHPOINT',MCHPO1) 776 : ELSE 776 : CALL ECROBJ('CHPOINT',MCHPO2) 776 : CALL ECROBJ('CHPOINT',MCHPO1) 776 : CALL OPERAD 776 : CALL LIROBJ('CHPOINT',MCHPOI,1,IRET) 776 : CALL ECMO(MTAB1,'SMBR','CHPOINT',MCHPOI) 777 : ENDIF 778 : 779 : SEGDES IMATRI 780 : SEGDES MELEME,MATRIK 781 : IF(IKL.EQ.0)THEN 782 : SEGDES VISCO 783 : ENDIF 783 : CALL ECMO(MTABX,'MATELM','MATRIK',MATRIK) 784 : 785 : C************************************************************************* 786 : ELSE IF(KFORM.EQ.2)THEN 787 : C CAS FORMULATION VF 788 : WRITE(6,*)' FORMULATION VF NON DISPONIBLE ' 789 : C Option %m1:8 incompatible avec les données 790 : MOTERR( 1: 8) = ' EF ' 790 : CALL ERREUR(803) 791 : RETURN 792 : 793 : ENDIF 794 : 795 : C write(6,*)' RETOUR DE TSCA ' 796 : IPDI=IPADI 797 : SEGSUP IPADI 798 : IF(IPADS.NE.IPDI)SEGSUP IPADS 799 : IPAS=1 800 : RETURN 801 : 802 : 803 : 90 CONTINUE 804 : WRITE(6,*)' Interuption anormale de TSCAL ' 805 : C Option %m1:8 incompatible avec les données 805 : CALL ERREUR(803) 806 : RETURN 807 : 1002 FORMAT(10(1X,1PE11.4)) 808 : 1001 FORMAT(20(1X,I5)) 809 : END 810 : 811 : 812 : 813 : 814 : 815 : 816 : 817 : 818 : 819 : 820 : 821 : 822 : 823 : 824 : 825 :
© Cast3M 2003 - All rights reserved.
Disclaimer