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