C ZNSKE SOURCE GOUNAND 25/11/12 21:16:03 12399 SUBROUTINE ZNSKE(MTABX,MTAB1) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C C CET OPERATEUR DISCRETISE LES EQUATIONS DE NAVIER STOKES COUPLEES C AUX DEUX EQUATIONS DU MODELE K - EPSILON C EN 2D SUR LES ELEMENTS QUA4 ET TRI3 PLAN OU AXI C EN 3D SUR LES ELEMENTS CUB8 ET PRI6 C LES OPERATEURS SONT "SOUS-INTEGRES" C C SYNTAXE : C --------- C 1/ Cas incompressible C C du/dt + u Grad u = (nu+nut) Lapl u - 1/ro Grad p < + S > C < + g beta (T-Tref) > C C 'OPER' 'NSKE' nu nut 'INCO' UN : C 'OPER' 'NSKE' nu nut s 'INCO' UN : C 'OPER' 'NSKE' nu nut gb tn tref 'INCO' UN : C C C 2/ Cas compressible C C dG/dt + u Grad G + G Div u = (mu+mut)(Lapl u + 1/3 Grad Div u) C - Grad p < + S > C C 'OPER' 'NSKE' ro mu mut un 'INCO' GN : C 'OPER' 'NSKE' ro mu mut un S 'INCO' GN : C C ro densité C FLOTTANT ou CHPOINT SCAL CENTRE C nu,mu viscosité cinématique (resp. dynamique) moléculaire C FLOTTANT ou CHPOINT SCAL CENTRE C nut,mut viscosité cinématique (resp. dynamique) turbulente C CHPOINT SCAL CENTRE C s source volumique de qdm C POINT ou CHPOINT VECT CENTRE C gb coéfficient de flottabilité (g*beta où g est l'accéllération C de la pesanteur et beta le coéfficient de dilatabilité) C POINT ou CHPOINT VECT CENTRE C tn Champ de température CHPOINT SCAL SOMMET C tref température de référence C FLOTTANT ou CHPOINT SCAL SOMMET C C Champ de vitesse -> VITESS C un Champ de vitesse transportant -> UTRANS C CHPOINT VECT SOMMET C gn Champ de vitesse massique (transporté) -> IZTU1 (Inconnue) C CHPOINT VECT SOMMET C kn Energie cinétique turbulente C CHPOINT SCAL SOMMET C en Taux de disparition de k C CHPOINT SCAL SOMMET C Constantes du modèle K - Epsilon C cnu = 0.09 c1 = 1.41 c2 = 1.92 C C************************************************************************ -INC PPARAM -INC CCOPTIO -INC CCGEOME -INC SIZFFB POINTEUR IZF1.IZFFM -INC SMCHAML -INC SMCOORD -INC SMLENTI POINTEUR IPADI.MLENTI,IPADU.MLENTI,IPADF.MLENTI,IPADS.MLENTI POINTEUR IPADQ.MLENTI -INC SMELEME POINTEUR MELEM1.MELEME,MELEMC.MELEME,MELEMS.MELEME,MELEMI.MELEME POINTEUR MELEP1.MELEME -INC SMCHPOI POINTEUR IZG1.MCHPOI, IZG3.MCHPOI POINTEUR IZGG1.MPOVAL,IZGG2.MPOVAL,IZGG3.MPOVAL POINTEUR IZGDD2.MPOVAL,IZGDD3.MPOVAL POINTEUR IZDD2.MPOVAL,IZDD3.MPOVAL POINTEUR IZTU1.MPOVAL,IZTU2.MPOVAL,IZTU3.MPOVAL POINTEUR VITESS.MPOVAL,UTRANS.MPOVAL POINTEUR MZNU.MPOVAL,MZGB.MPOVAL,MZTN.MPOVAL,MZTR.MPOVAL POINTEUR MZRO.MPOVAL POINTEUR MZNT.MPOVAL POINTEUR IZVOL.MPOVAL,IZTCO.MPOVAL POINTEUR MCHVOL.MCHPOI,IZG2.MCHPOI,IZGD2.MCHPOI POINTEUR IZD2.MCHPOI,IZGD3.MCHPOI,IZD3.MCHPOI -INC SMMATRIK POINTEUR IPM.IZAFM SEGMENT IMATRS INTEGER LIZAFS(NBSOUS,NBME) ENDSEGMENT POINTEUR IPMS.IZAFM,IPS1.IZAFM,IPS2.IZAFM,IPS3.IZAFM -INC SMLMOTS POINTEUR LINCO.MLMOTS CHARACTER*8 NOMZ,NOMI,NOMA,TYPE,TYPC,NOM,NOM0 PARAMETER (NTB=1) CHARACTER*8 LTAB(NTB) DIMENSION KTAB(NTB),IXV(3),RO(1) SAVE IPAS DATA LTAB/'KIZX '/,IPAS/0/,RO/1.D0/ C***************************************************************************** CNSKE C write(6,*)' DEBUT NSKE ' C C- Récupération de la table INCO (pointeur KINC) C CALL LEKTAB(MTAB1,'INCO',KINC) IF(KINC.EQ.0)THEN C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 MOTERR( 1: 8) = ' INCO ' MOTERR( 9:16) = ' INCO ' MOTERR(17:24) = ' EQEX ' CALL ERREUR(786) RETURN ENDIF C***************************************************************************** C OPTIONS C KIMPL = 0 -> EXPL 1 -> IMPL 2 -> SEMI C KFORM = 0 -> SI 1 -> EF 2 -> VF 3 -> EFMC C IDCEN = 0-> rien 1-> CENTREE 2-> SUPGDC 3-> SUPG 4-> TVISQUEU 5-> CNG IAXI=0 IF(IFOMOD.EQ.0)IAXI=2 C C- Récupération de la table des options KOPT (pointeur KOPTI) C CALL LEKTAB(MTABX,'KOPT',KOPTI) IF (KOPTI.EQ.0) THEN C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 MOTERR( 1: 8) = ' KOPT ' MOTERR( 9:16) = ' KOPT ' MOTERR(17:24) = ' KIZX ' CALL ERREUR(786) RETURN ENDIF CALL ACME(KOPTI,'MTRMASS ',MMPG) IPG=0 IF(MMPG.EQ.3)IPG=1 CALL ACME(KOPTI,'IDCEN',IDCEN) CALL ACME(KOPTI,'RNG ',IMODEL) CALL ACME(KOPTI,'IKOMP',IKOMP) CALL ACME(KOPTI,'KIMPL',KIMPL) CALL ACME(KOPTI,'KPOIN',KPRE) CALL ACME(KOPTI,'KFORM',KFORM) CALL ACME(KOPTI,'KMACO',KMACO) CALL ACMF(KOPTI,'AIMPL',AIMPL) IF (IERR.NE.0) RETURN IF(KFORM.NE.0.AND.KFORM.NE.1)THEN C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = 'EF/EFM1 ' CALL ERREUR(803) RETURN ENDIF IF(KFORM.NE.0.AND.KPRE.NE.2)THEN C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = 'EFM1 ' CALL ERREUR(803) RETURN ENDIF C write(6,*)' Apres les options ' C***************************************************************************** C C- Récupération de la table DOMAINE associée au domaine local C CALL ACMM(MTABX,'NOMZONE',NOMZ) CALL LEKTAB(MTABX,'DOMZ',MTABZ) IF(MTABZ.EQ.0)THEN C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 MOTERR( 1: 8) = ' DOMZ ' MOTERR( 9:16) = ' DOMZ ' MOTERR(17:24) = ' KIZX ' CALL ERREUR(786) RETURN ENDIF CALL LEKTAB(MTABZ,'MAILLAGE',MELEME) CALL LEKTAB(MTABZ,'CENTRE',MELEMC) CALL LEKTAB(MTABZ,'SOMMET',MELEMS) IF (IERR.NE.0) RETURN MELEMQ=MELEMC MELEP1=MELEMC IF(KPRE.NE.2)THEN CALL LEKTAB(MTABZ,'MACRO',MACRO) CALL LEKTAB(MTABZ,'MACRO1',MELEMI) CALL LEKTAB(MTABZ,'QUADRATI',MQUAD) IF(KPRE.EQ.3)THEN CALL LEKTAB(MTABZ,'CENTREP0',MELEMQ) MELEP1=MELEMQ ELSEIF(KPRE.EQ.4)THEN CALL LEKTAB(MTABZ,'CENTREP1',MELEMQ) CALL LEKTAB(MTABZ,'ELTP1NC ',MELEP1) ENDIF ENDIF C************************************************************************* C VERIFICATIONS SUR LES INCONNUES C C- Récupération du nombre d'inconnues et du nom de l'inconnue NOMI C TYPE='LISTMOTS' CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO) IF (IERR.NE.0) RETURN SEGACT LINCO NBINC=LINCO.MOTS(/2) IF(NBINC.NE.3)THEN C Indice %m1:8 : contient plus de %i1 %m9:16 MOTERR( 1:8) = 'LISTINCO' INTERR(1) = 3 MOTERR(9:16) = ' MOTS ' CALL ERREUR(799) RETURN ENDIF NOMI=LINCO.MOTS(1) NOMA=NOMI C C- Récupération de l'inconnue C TYPE=' ' CALL ACMO(KINC,NOMI,TYPE,MCHPOI) IF(TYPE.NE.'CHPOINT ')THEN C Indice %m1:8 : ne contient pas un objet de type %m9:16 MOTERR( 1: 8) = 'INC '//NOMI MOTERR( 9:16) = 'CHPOINT ' CALL ERREUR(800) RETURN ELSE CALL LICHT(MCHPOI,IZTU1,TYPC,MELEM1) NINKO = IZTU1.VPOCHA(/2) IF (NINKO.NE.IDIM) THEN C Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes MOTERR( 1: 8) = 'INC '//NOMI MOTERR( 9:16) = 'CHPOINT ' CALL ERREUR(784) RETURN ENDIF C write(6,*)' MCHPOI,MELEM1=',MCHPOI,MELEM1 C On fait pointer ces deux tableaux sur le champ U inconu (tjs présent) pour C eviter de les enlever lors de l'appel FORTRAN si les options sont absentes UTRANS=IZTU1 IKW=0 VITESS=IZTU1 ENDIF C***************************************************************************** C Le domaine de definition est donne par le SPG de la premiere inconnue C Les inconnues suivantes devront posseder ce meme pointeur C On verifie que les points de la zone sont tous inclus dans ce SPG CALL KRIPAD(MELEM1,IPADI) IPADS=IPADI IPADD=IPADI IPADU=IPADI IF(MELEM1.NE.MELEMS)CALL KRIPAD(MELEMS,IPADS) IF(IPAS.EQ.0)THEN IPAS=1 CALL VERPAD(IPADI,MELEME,IRET) IF(IRET.NE.0)THEN C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR(1: 8) = 'INC '//NOMI MOTERR(9:16) = 'CHPOINT ' CALL ERREUR(788) RETURN ENDIF ENDIF C************************************************************************* C Lecture du coefficient C Type du coefficient : C IK1=0 CHPOINT IK1=1 scalaire IK1=2 vecteur C write(6,*)' Opérateur NSKE lecture des coefficients' CALL ACME(MTABX,'IARG',IARG) IF(IKOMP.EQ.0)THEN IF(IARG.NE.2.AND.IARG.NE.3.AND.IARG.NE.5)THEN WRITE(6,*)' Opérateur NSKE : option incompréssible ' WRITE(6,*)' Nombre d''arguments incorrect : ',IARG WRITE(6,*)' On attend 2 , 3 ou 5 ' C Indice %m1:8 : nombre d'arguments incorrect MOTERR(1:8) = 'IARG ' CALL ERREUR(804) RETURN ENDIF ELSEIF(IKOMP.EQ.1)THEN IF(IARG.NE.4.AND.IARG.NE.5)THEN WRITE(6,*)' Opérateur NSKE : option compréssible ' WRITE(6,*)' Nombre d''arguments incorrect : ',IARG WRITE(6,*)' On attend 4 ou 5 ' C Indice %m1:8 : nombre d'arguments incorrect MOTERR(1:8) = 'IARG ' CALL ERREUR(804) RETURN ENDIF ENDIF C--Cas incompréssible IF(IKOMP.EQ.0)THEN MZRO=IZTU1 C 1er coefficient : nu IXV(1)=MELEMC IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur NSKE :', & MTABX,KINC,1,IXV,MNU,MZNU,NPT1,NC1,IKN,IRET) IF(IRET.EQ.0)RETURN MZGB=MZNU MZTN=MZNU MZTR=MZNU C 2ème coefficient : nut IXV(1)=MELEMC IXV(2)=0 IXV(3)=0 CALL LEKCOF('Opérateur NSKE :', & MTABX,KINC,2,IXV,MNT,MZNT,NPT2,NC2,IKNT,IRET) IF(IRET.EQ.0)RETURN IF(IARG.GE.3)THEN C 3ème coefficient : gbeta IXV(1)=-MELEMC IXV(2)=0 IXV(3)=1 CALL LEKCOF('Opérateur NSKE :', & MTABX,KINC,3,IXV,MGB,MZGB,NELG,NC3,IKG,IRET) IF(IRET.EQ.0)RETURN IF(IKG.EQ.2)IKG=1 IF(IARG.EQ.5)THEN C 4ème coefficient : tn IXV(1)=MELEMS IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur NSKE :', & MTABX,KINC,4,IXV,MTN,MZTN,NPT4,NC4,IKTN,IRET) IF(IRET.EQ.0)RETURN C 5ème coefficient : tref IXV(1)=MELEMS IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur NSKE :', & MTABX,KINC,5,IXV,MTR,MZTR,NPT5,NC5,IKTR,IRET) IF(IRET.EQ.0)RETURN ENDIF ENDIF C--Cas compréssible ELSEIF(IKOMP.EQ.1)THEN C 1er coefficient : ro IXV(1)=MELEMC IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur NSKE :', & MTABX,KINC,1,IXV,MRO,MZRO,NPT1,NCR,IKR,IRET) IF(IRET.EQ.0)RETURN MZGB=MZRO MZTN=MZRO MZTR=MZRO C 2ème coefficient : mu IXV(1)=MELEMC IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur NSKE :', & MTABX,KINC,2,IXV,MNU,MZNU,NPT2,NC2,IKN,IRET) IF(IRET.EQ.0)RETURN C 3ème coefficient : mut IXV(1)=MELEMC IXV(2)=0 IXV(3)=0 CALL LEKCOF('Opérateur NSKE :', & MTABX,KINC,3,IXV,MNT,MZNT,NPT3,NC3,IKNT,IRET) IF(IRET.EQ.0)RETURN C 4ème coefficient : un (en compréssible) IXV(1)=-MELEMS IXV(2)=0 IXV(3)=0 CALL LEKCOF('Opérateur NSKE :', & MTABX,KINC,4,IXV,MUN,UTRANS,NPT4,NC4,IK4,IRET) IPADU=IPADS IF(IRET.EQ.0)RETURN IF(IARG.EQ.5)THEN C 5ème coefficient : s (en compréssible) IXV(1)=-MELEMC IXV(2)=0 IXV(3)=1 CALL LEKCOF('Opérateur NSKE :', & MTABX,KINC,5,IXV,MGB,MZGB,NELG,NC5,IKG,IRET) IF(IRET.EQ.0)RETURN IF(IKG.EQ.2)IKG=1 ENDIF ENDIF C write(6,*)' Opérateur NSKE : Fin lecture Arguments ' C Fin lecture Arguments ************************************************ CALL LEKTAB(MTABZ,'XXDXDY',MCHPDX) IF(IRET.EQ.0)RETURN CALL LICHT(MCHPDX,IZTCO,TYPC,IGEOM) NELZ=IZTCO.VPOCHA(/1) C write(6,*)' FORMULATION ',kform C*********** FORMULATIONS ********** IF(KFORM.EQ.0)THEN C Formulation EFM1 IF(KIMPL.NE.0)THEN WRITE(6,*)' Operateur NSKE' C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = ' EFM1 ' CALL ERREUR(803) RETURN ENDIF CALL LEKTAB(MTABZ,'MATESI',MATRIK) IF(MATRIK.EQ.0)GO TO 90 SEGACT MATRIK IMATRI=IRIGEL(4,1) SEGACT IMATRI CALL LEKTAB(MTABZ,'XXPSOML',MCHELM) CALL LEKTAB(MTABZ,'XXVOLUM',MCHVOL) IF(IRET.EQ.0)RETURN SEGACT MCHELM CALL LICHT(MCHVOL,IZVOL,TYPC,IGEOM) CALL LEKTAB(MTAB1,'KIZG',KIZG) IF(KIZG.EQ.0)THEN CALL CRTABL(KIZG) CALL ECMM(KIZG,'SOUSTYPE','KIZG') CALL ECMO(MTAB1,'KIZG','TABLE ',KIZG) ENDIF CALL LEKTAB(MTAB1,'KIZG1',KIZG1) IF(KIZG1.EQ.0)THEN CALL CRTABL(KIZG1) CALL ECMM(KIZG1,'SOUSTYPE','KIZG1') CALL ECMO(MTAB1,'KIZG1','TABLE ',KIZG1) ENDIF CALL LEKTAB(MTAB1,'KIZD',KIZD) IF(KIZD.EQ.0)THEN WRITE(6,*)'Il n''y a pas de table KIZD ' GO TO 90 ENDIF C***************************************************************************** TYPE=' ' CALL ACMO(KIZG,NOMI,TYPE,IZG1) IF(TYPE.NE.'CHPOINT ')THEN NC=IZTU1.VPOCHA(/2) TYPE='SOMMET' CALL CRCHPT(TYPE,MELEM1,NC,1,IZG1) CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG1) ENDIF CALL LICHT(IZG1,IZGG1,TYPC,IGEOM) IF(IGEOM.NE.MELEM1)THEN WRITE(6,*)' Opérateur NSKE' WRITE(6,*)'Incompatibilite de SPG entre 1eres inconnues ' C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR(1: 8) = 'INC '//NOMI MOTERR(9:16) = 'CHPOINT ' CALL ERREUR(788) RETURN ENDIF NOMI=LINCO.MOTS(2) TYPE=' ' CALL ACMO(KINC,NOMI,TYPE,MCHPOI) IF(TYPE.NE.'CHPOINT ')THEN WRITE(6,*)' L objet CHPOINT ',NOMI,' n existe pas dans la table' C Indice %m1:8 : ne contient pas un objet de type %m9:16 MOTERR( 1: 8) = 'INC '//NOMI MOTERR( 9:16) = 'CHPOINT ' CALL ERREUR(800) RETURN RETURN ELSE CALL LICHT(MCHPOI,IZTU2,TYPC,IGEOM0) IF(IGEOM0.NE.MELEM1)THEN WRITE(6,*)' Opérateur NSKE ' WRITE(6,*)' Le SPG de l''inconnue 2 n''est pas convenable' C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR(1: 8) = 'INC '//NOMI MOTERR(9:16) = 'CHPOINT ' CALL ERREUR(788) RETURN ENDIF ENDIF TYPE=' ' CALL ACMO(KIZG,NOMI,TYPE,IZG2) IF(TYPE.NE.'CHPOINT ')THEN NC=IZTU2.VPOCHA(/2) TYPE='SOMMET' CALL CRCHPT(TYPE,MELEM1,NC,1,IZG2) CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG2) ENDIF CALL LICHT(IZG2,IZGG2,TYPC,IGEOM) IF(IGEOM.NE.MELEM1)THEN WRITE(6,*)' Opérateur NSKE' WRITE(6,*)'Incompatibilite de SPG entre 2emes inconnues' C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR(1: 8) = 'INC '//NOMI MOTERR(9:16) = 'CHPOINT ' CALL ERREUR(788) RETURN ENDIF TYPE=' ' CALL ACMO(KIZG1,NOMI,TYPE,IZGD2) IF(TYPE.NE.'CHPOINT ')THEN NC=IZTU2.VPOCHA(/2) TYPE='SOMMET' CALL CRCHPT(TYPE,MELEM1,NC,1,IZGD2) CALL ECMO(KIZG1,NOMI,'CHPOINT ',IZGD2) ENDIF CALL LICHT(IZGD2,IZGDD2,TYPC,IGEOM) IF(IGEOM.NE.MELEM1)THEN WRITE(6,*)' Opérateur NSKE' WRITE(6,*)'Incompatibilite de SPG entre 2emes inconnues' C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR(1: 8) = 'INC '//NOMI MOTERR(9:16) = 'CHPOINT ' CALL ERREUR(788) RETURN ENDIF TYPE=' ' CALL ACMO(KIZD,NOMI,TYPE,IZD2) IF(TYPE.NE.'CHPOINT ')THEN WRITE(6,*)' Il n y a pas de diagonale associee a l''inconnue ', &NOMI GO TO 90 ENDIF CALL LICHT(IZD2,IZDD2,TYPC,IGEOM) NOMI=LINCO.MOTS(3) TYPE=' ' CALL ACMO(KINC,NOMI,TYPE,MCHPOI) IF(TYPE.NE.'CHPOINT ')THEN WRITE(6,*)' L objet CHPOINT ',NOMI,' n existe pas dans la table' C Indice %m1:8 : ne contient pas un objet de type %m9:16 MOTERR( 1: 8) = 'INC '//NOMI MOTERR( 9:16) = 'CHPOINT ' CALL ERREUR(800) RETURN ELSE CALL LICHT(MCHPOI,IZTU3,TYPC,IGEOM0) IF(IGEOM0.NE.MELEM1)THEN WRITE(6,*)' Opérateur NSKE ' WRITE(6,*)' Le SPG de l''inconnue 3 n''est pas convenable' C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR(1: 8) = 'INC '//NOMI MOTERR(9:16) = 'CHPOINT ' CALL ERREUR(788) RETURN ENDIF ENDIF TYPE=' ' CALL ACMO(KIZG,NOMI,TYPE,IZG3) IF(TYPE.NE.'CHPOINT ')THEN SEGACT IZTU3 NC=IZTU3.VPOCHA(/2) TYPE='SOMMET' CALL CRCHPT(TYPE,MELEM1,NC,1,IZG3) CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG3) ENDIF CALL LICHT(IZG3,IZGG3,TYPC,IGEOM) IF(IGEOM.NE.MELEM1)THEN WRITE(6,*)' Opérateur NSKE' WRITE(6,*)' Incompatibilite de SPG entre 3emes inconnues' C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR(1: 8) = 'INC '//NOMI MOTERR(9:16) = 'CHPOINT ' CALL ERREUR(788) RETURN ENDIF TYPE=' ' CALL ACMO(KIZG1,NOMI,TYPE,IZGD3) IF(TYPE.NE.'CHPOINT ')THEN NC=IZTU3.VPOCHA(/2) TYPE='SOMMET' CALL CRCHPT(TYPE,MELEM1,NC,1,IZGD3) CALL ECMO(KIZG1,NOMI,'CHPOINT ',IZGD3) ENDIF CALL LICHT(IZGD3,IZGDD3,TYPC,IGEOM) IF(IGEOM.NE.MELEM1)THEN WRITE(6,*)' Opérateur NSKE' WRITE(6,*)' Incompatibilite de SPG entre 3emes inconnues' C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR(1: 8) = 'INC '//NOMI MOTERR(9:16) = 'CHPOINT ' CALL ERREUR(788) RETURN ENDIF TYPE=' ' CALL ACMO(KIZD,NOMI,TYPE,IZD3) IF(TYPE.NE.'CHPOINT ')THEN WRITE(6,*)' Il n y a pas de diagonale associee a l''inconnue ', &NOMI GO TO 90 ENDIF CALL LICHT(IZD3,IZDD3,TYPC,IGEOM) NPT=IZGG1.VPOCHA(/1) SEGDES LINCO C###################################################################### SEGACT MELEME NBSOUS=LISOUS(/1) IF(NBSOUS.EQ.0)NBSOUS=1 NUTOEL=0 DT=1.D30 IES=IDIM DO 1 L=1,NBSOUS IPT1=MELEME IF(NBSOUS.NE.1)IPT1=LISOUS(L) SEGACT IPT1 IZAFM=LIZAFM(L,1) IPM1=IZAFM SEGACT IZAFM IF(IAXI.NE.0)THEN IPM1=LIZAFM(L,2) SEGACT IPM1 ENDIF MCHAML=ICHAML(L) SEGACT MCHAML MELVAL=IELVAL(1) SEGACT MELVAL IF(IMACHE(L).NE.IPT1)THEN write(*,*)'IPT1,IMACHE ',IPT1,IMACHE(L) goto 90 ENDIF NP =IPT1.NUM(/1) NBEL=IPT1.NUM(/2) CALL ZCVIT(AM,IPM1.AM,VELCHE, & IPT1.NUM,NBEL,NUTOEL,NPT,IES,NP,IAXI, & IPADI.LECT,IKOMP,IARG, & MZRO.VPOCHA,IKR, & MZNU.VPOCHA,IKN,MZGB.VPOCHA,IKG,NELG,MZTN.VPOCHA,IKTN, & MZTR.VPOCHA,IKTR,MZNT.VPOCHA, & IZTU1.VPOCHA,UTRANS.VPOCHA,IZTU2.VPOCHA,IZTU3.VPOCHA, & IZGG1.VPOCHA,IZGG2.VPOCHA,IZGG3.VPOCHA, & IZGDD2.VPOCHA,IZGDD3.VPOCHA, & IZDD2.VPOCHA,IZDD3.VPOCHA, & IZVOL.VPOCHA,IZTCO.VPOCHA,NELZ,IDCEN,IMODEL, & DT,DTT1,DTT2,NUEL,DIAEL,ECHLM) SEGDES IZAFM,IPT1,MCHAML,MELVAL NUTOEL=NUTOEL+NBEL 1 CONTINUE SEGDES MELEME SEGDES MATRIK,MCHELM SEGDES MZTN SEGDES IZTU1,IZTU2,IZTU3 SEGDES IZGG1,IZGG2,IZGG3 SEGDES IZGDD2,IZGDD3 SEGDES IZDD2,IZDD3 SEGDES IZVOL,IZTCO CALL LEKTAB(MTAB1,'PASDETPS',MTABT) IF(MTABT.EQ.0)THEN CALL CRTABL(MTABT) CALL ECMM(MTABT,'SOUSTYPE','PASDETPS') CALL ECMO(MTAB1,'PASDETPS','TABLE ',MTABT) DTP=1.D30+DT IPAT=1 CALL ECME(MTABT,'NUPASDT',IPAT) ELSE CALL ACMF(MTABT,'DELTAT',DTP) ENDIF IF(DT.LT.DTP)THEN CALL ECMF(MTABT,'DELTAT',DT) CALL ECMM(MTABT,'OPER','NSKE') CALL ACMM(MTABX,'NOMZONE',NOMZ) CALL ECMM(MTABT,'ZONE',NOMZ) CALL ECMF(MTABT,'DTCONV',DTT1) CALL ECMF(MTABT,'DTDIFU',DTT2) CALL ECMF(MTABT,'DIAEL',DIAEL) CALL ECME(MTABT,'NUEL',NUEL) ENDIF C************************************************************************* ELSE IF(KFORM.EQ.1)THEN C CAS FORMULATION EF IF(KIMPL.EQ.0)THEN C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = ' EF ' CALL ERREUR(803) RETURN ENDIF DT=0.D0 IF(IDCEN.EQ.4)THEN TYPE=' ' CALL ACMO(MTABT,'DELTAT',TYPE,IENT) IF(TYPE.NE.'ENTIER')THEN WRITE(6,*)' Opérateur NS ' WRITE(6,*)' On reclame un pas de temps' C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = ' EF ' CALL ERREUR(803) RETURN ELSE CALL ACMF(MTABT,'DELTAT',DT) ENDIF ENDIF IHV=1 NUTOEL=0 NINKO=VITESS.VPOCHA(/2) SEGACT MELEME NBSOUS=LISOUS(/1) IF(NBSOUS.EQ.0)NBSOUS=1 TYPE=' ' CALL ACMO(MTABX,'MATELM',TYPE,MATRIK) IF(TYPE.EQ.'MATRIK'.AND.KMACO.NE.0)THEN SEGACT MATRIK NMATRI=IRIGEL(/2) MELEME=IRIGEL(1,1) SEGACT MELEME IMATRI=IRIGEL(4,1) SEGACT IMATRI NBME=LIZAFM(/2) NINKO=NBME MELEMS=KSPGP ELSE NRIGE=7 NKID =9 NKMT =7 NMATRI=1 SEGINI MATRIK IRIGEL(1,1)=MELEME IRIGEL(2,1)=MELEME IRIGEL(7,1)=2 NBOP=0 NBME=NINKO NBELC=0 SEGINI IMATRI,IMATRS IRIGEL(4,1)=IMATRI KSPGP=MELEMS KSPGD=MELEMS IF(NBME.EQ.1)THEN LISPRI(1)=NOMI(1:4)//' ' LISDUA(1)=NOMA(1:4)//' ' ELSE DO 102 I=1,NBME WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7) LISPRI(I)=NOM(1:4)//' ' WRITE(NOM,FMT='(I1,A7)')I,NOMA(1:7) LISDUA(I)=NOM(1:4)//' ' 102 CONTINUE ENDIF NUTOEL=0 DO 101 L=1,NBSOUS IPT1=MELEME IF(NBSOUS.NE.1)IPT1=LISOUS(L) SEGACT IPT1 WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//' ' CALL KALPBG(NOM0,'FONFORM ',IZFFM) SEGACT IZFFM*MOD IZHR=KZHR(1) SEGACT IZHR*MOD NES=GR(/1) NPG=GR(/3) NP = IPT1.NUM(/1) MP = NP NBEL=IPT1.NUM(/2) SEGINI IPM1,IPS1 LIZAFM(L,1)=IPM1 LIZAFS(L,1)=IPS1 IPM2=IPM1 IPM3=IPM1 IPS2=IPS1 IPS3=IPS1 IF(NBME.GE.2)THEN SEGINI IPM2,IPS2 LIZAFM(L,2)=IPM2 LIZAFS(L,2)=IPS2 ENDIF IF(NBME.GE.3)THEN SEGINI IPM3,IPS3 LIZAFM(L,3)=IPM3 LIZAFS(L,3)=IPS3 ENDIF KITT=2 KJTT=IKN NPT=UTRANS.VPOCHA(/1) NPTG=IZTU1.VPOCHA(/1) CALL ZCONV(FN,GR,PG,XYZ,HR,PGSQ,RPG, & NES,IDIM,NP,NPG,IAXI,AIMPL,IKOMP, & RO,1,UTRANS.VPOCHA,IKW,NPT,IPADU.LECT,MZNU.VPOCHA,IKN, & IPT1.NUM,NBEL,NUTOEL,XCOOR, & IPM1.AM,IPM2.AM,IPM3.AM, & IPS1.AM,IPS2.AM,IPS3.AM, & NINKO,IDCEN,DT, & IZTU1.VPOCHA,0,NPTG,IPADI.LECT,IZTCO.VPOCHA,NELZ) CALL XLAPL(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI, & MZNU.VPOCHA,MZNU.VPOCHA,MZNU.VPOCHA,KITT,KJTT,IKN, & IPT1.NUM,NBEL,NUTOEL,XCOOR,AIMPL,IKOMP, & IPM1.AM,IPM2.AM,IPM3.AM, & IPS1.AM,IPS2.AM,IPS3.AM, & NINKO,IHV,IARG,MZNU.VPOCHA) NUTOEL=NUTOEL+NBEL 101 CONTINUE ENDIF IF(KIMPL.EQ.2.OR.KIMPL.EQ.0.OR.IARG.GT.1)THEN NAT=2 NSOUPO=1 SEGACT MELEMS N=MELEMS.NUM(/2) NC=NINKO SEGINI MCHPO1,MSOUP1,MPOVA1 MCHPO1.IFOPOI=IFOUR MCHPO1.MOCHDE=TITREE MCHPO1.MTYPOI='SMBR' MCHPO1.JATTRI(1)=2 MCHPO1.IPCHP(1)=MSOUP1 DO 177 N=1,NINKO MSOUP1.NOCOMP(N)=LISDUA(N) 177 CONTINUE MSOUP1.IGEOC=MELEMS MSOUP1.IPOVAL=MPOVA1 ENDIF IF(IARG.EQ.3.OR.IARG.EQ.5)THEN CALL KRIPAD(MELEMQ,IPADQ) IF(IARG.EQ.3)THEN IKAS=2 ELSEIF(IARG.EQ.5)THEN IKAS=3 ENDIF IF(MACRO.NE.0.AND.KPRE.EQ.2)MELEMI=MELEME SEGACT MELEMI NBSOUS=MELEMI.LISOUS(/1) IF(NBSOUS.EQ.0)NBSOUS=1 NUTOEL=0 DO 1102 L=1,NBSOUS IPT1=MELEMI IF(NBSOUS.NE.1)IPT1=MELEMI.LISOUS(L) SEGACT IPT1 IF(MQUAD.NE.0)THEN IF(KPRE.EQ.2)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'PRP0' IF(KPRE.EQ.3)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'PRP0' IF(KPRE.EQ.4)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'PRP1' ELSEIF(MACRO.NE.0)THEN IF(KPRE.EQ.2)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//' ' IF(KPRE.EQ.3)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'MCP0' IF(KPRE.EQ.4)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'MCP1' ELSE IF(KPRE.EQ.2)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//' ' ENDIF CALL KALPBG(NOM0,'FONFORM ',IZFFM) SEGACT IZFFM*MOD IZHR=KZHR(1) SEGACT IZHR*MOD NES=GR(/1) NPG=GR(/3) IZF1=KTP(1) SEGACT IZF1*MOD MP1=IZF1.FN(/1) NP = IPT1.NUM(/1) MP = NP NBEL=IPT1.NUM(/2) NELG=MZGB.VPOCHA(/1) NPT =MPOVA1.VPOCHA(/1) SEGACT MELEP1 CALL XSOUR(FN,IZF1.FN,GR,PG,XYZ,HR,PGSQ,RPG, & NES,IDIM,NP,MP1,NPG,IAXI,IPT1.NUM,IKAS,KPRE, & MZGB.VPOCHA,IKG,NELG,IPADQ.LECT,MELEP1.NUM, & MZTN.VPOCHA,IKTN,MZTR.VPOCHA,IKTR,IPADS.LECT, & NBEL,NUTOEL,XCOOR,MPOVA1.VPOCHA,NPT) NUTOEL=NUTOEL+NBEL 1102 CONTINUE ENDIF IF(KIMPL.EQ.2.OR.KIMPL.EQ.0)THEN NBSOUS=LISOUS(/1) IF(NBSOUS.EQ.0)NBSOUS=1 DO 1533 L=1,NBSOUS IPT1=MELEME IF(NBSOUS.NE.1)IPT1=LISOUS(L) SEGACT IPT1 NP=IPT1.NUM(/1) NBEL=IPT1.NUM(/2) DO 2 N=1,NINKO IPMS=LIZAFS(L,N) SEGACT IPMS DO 12 K=1,NBEL DO 13 J=1,NP UU=0.D0 IU=IPADS.LECT(IPT1.NUM(J,K)) DO 14 I=1,NP IK=IPADI.LECT(IPT1.NUM(I,K)) UU=UU+IPMS.AM(K,I,J)*IZTU1.VPOCHA(IK,N) 14 CONTINUE MPOVA1.VPOCHA(IU,N)=MPOVA1.VPOCHA(IU,N)+UU 13 CONTINUE 12 CONTINUE 2 CONTINUE 1533 CONTINUE ENDIF SEGDES IPM1,IPM2,IPM3 IPS=IPS1 SEGSUP IPS1 IF(IPS2.NE.IPS)SEGSUP IPS2 IF(IPS3.NE.IPS)SEGSUP IPS3 SEGDES IZTCO IF(KIMPL.EQ.2.OR.KIMPL.EQ.0.OR.IARG.GT.1)THEN TYPE=' ' CALL ACMO(MTAB1,'SMBR',TYPE,MCHPO2) IF(TYPE.NE.'CHPOINT')THEN CALL ECMO(MTAB1,'SMBR','CHPOINT',MCHPO1) ELSE CALL ECROBJ('CHPOINT',MCHPO2) CALL ECROBJ('CHPOINT',MCHPO1) C? CALL OPERAD CALL PRFUSE CALL LIROBJ('CHPOINT',MCHPOI,1,IRET) CALL ECMO(MTAB1,'SMBR','CHPOINT',MCHPOI) ENDIF ENDIF SEGDES IMATRI SEGDES MELEME,MATRIK IF(IKN.EQ.0)THEN SEGDES MZNU ENDIF CALL ECMO(MTABX,'MATELM','MATRIK',MATRIK) C************************************************************************* ELSE IF(KFORM.EQ.2)THEN C CAS FORMULATION VF WRITE(6,*)' FORMULATION VF NON DISPONIBLE ' C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = ' EF ' CALL ERREUR(803) RETURN ENDIF C************************************************************************* SEGSUP IPADI IPAS=1 C write(6,*)' FIN NSKE ' RETURN 90 CONTINUE WRITE(6,*)' Interuption anormale de NSKE' C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = ' EF ' CALL ERREUR(803) RETURN 1002 FORMAT(10(1X,1PE11.4)) END