C FPT SOURCE CHAT 06/08/24 21:37:33 5529 SUBROUTINE FPT C********************************************************************** C C C FPT C ------> KFPT : calcul de H C ------> ECHIMP : calcul des fonctions de paroi C sur la temperature C SYNTAXE : C 'ZONE' $DOM 'OPER' FPT RO MU CP LB UET YP H TETA 'INCO' TN C C C $DOM Modèle NAVIER_STOKES C C RO Densité FLOTTANT ou CHPOINT SCAL SPG C C MU Viscosité dynamique moléculaire FLOTTANT ou CHPOINT SCAL SPG C C CP Chaleur spécifique FLOTTANT ou CHPOINT SCAL SPG C C LB Conductivité thermique FLOTTANT ou CHPOINT SCAL SPG C C UET Vitesse de frottement CHPOINT SCAL SPG C C YP Distance la paroi FLOTTANT C C H Coefficient d'échange thermique CHPOINT SCAL SPG C C TETA Température à la paroi CHPOINT SCAL SPG C C TN Température CHPOINT SCAL SOMMET C C IMPORTANT: C C Suivant la formulation EF ou EFM1 SPG doit être SOMMET ou CENTRE C C C*********************************************************************** IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C -INC CCOPTIO -INC SMCOORD -INC SMELEME -INC SMCHPOI POINTEUR MZNU.MPOVAL,MZUE.MPOVAL,MZYP.MPOVAL POINTEUR MZMU.MPOVAL,MZRO.MPOVAL,MZCP.MPOVAL,MZLB.MPOVAL POINTEUR MZH.MPOVAL,MZT0.MPOVAL CHARACTER*8 NOMI,NOMA,TYPE,NOMZ,TYPC PARAMETER (NTB=1) CHARACTER*8 LTAB(NTB) DIMENSION KTAB(NTB),IXV(3) * SAVE IPAS * DATA LTAB/'KIZX '/,IPAS/0/ DATA LTAB/'KIZX '/ C***************************************************************************** CFPT C write(6,*)' debut FPT ' CALL LITABS(LTAB,KTAB,NTB,1,IRET) IF(IRET.EQ.0)THEN WRITE(6,*)' Opérateur FPT' WRITE(6,*)' On attend un ensemble de table soustypes' RETURN ENDIF MTABX=KTAB(1) CALL LEKTAB(MTABX,'EQEX',MTAB1) IF(MTAB1.EQ.0)THEN WRITE(6,*)' Opérateur FPT' WRITE(6,*)' On ne trouve pas l''indice EQEX ? ' RETURN ENDIF CALL LEKTAB(MTAB1,'INCO',KINC) IF(KINC.EQ.0)THEN WRITE(6,*)' Opérateur FPT' WRITE(6,*)' Il n''y a pas de table INCO ? ?.' RETURN ENDIF C***************************************************************************** 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,'KIMPL',KIMPL) CALL ACME(KOPTI,'KFORM',KFORM) 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 C***************************************************************************** C C- Récupération de la table DOMAINE associée au domaine local C IF(KFORM.EQ.0)THEN CALL LEKTAB(MTABX,'DOMZ',MTABZ) IF(MTABZ.EQ.0)THEN WRITE(6,*)' Opérateur FPT' WRITE(6,*)' On ne trouve pas l''indice DOMZ ? ' RETURN ENDIF TYPE=' ' CALL ACMO(MTABZ,'CENTRE',TYPE,MELEMK) IF(TYPE.NE.'MAILLAGE')GO TO 90 ENDIF IF(KFORM.EQ.1)THEN CALL ACMM(MTABX,'NOMZONE',NOMZ) TYPE=' ' CALL ACMO(MTABX,'DOMZ',TYPE,MMDZ) IF(TYPE.NE.'MMODEL')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 C E/ MMODEL : Pointeur de la table contenant l'information cherchée C /S IPOINT : Pointeur sur la table DOMAINE C /S INEFMD : Type formulation INEFMD=1 LINE,=2 MACRO,=3 QUADRATIQUE C INEFMD=4 LINB CALL LEKMOD(MMDZ,MTABZ,INEFMD) CALL LEKTAB(MTABZ,'SOMMET',MELEMK) ENDIF C *** CALL ACME(MTABX,'IARG',IARG) C *** LECTURE DES COEFFICIENTS *** C 1er coefficient : ro IXV(1)=MELEMK IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur FPT :', & MTABX,KINC,1,IXV,MRO,MZRO,NPT1,NC1,IK1,IRET) IF(IRET.EQ.0)RETURN XRO=MZRO.VPOCHA(1,1) C 2ème coefficient : mu IXV(1)=MELEMK IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur FPT :', & MTABX,KINC,2,IXV,MMU,MZMU,NPT2,NC2,IK2,IRET) IF(IRET.EQ.0)RETURN XMU=MZMU.VPOCHA(1,1) C 3ème coefficient : cp IXV(1)=MELEMK IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur FPT :', & MTABX,KINC,3,IXV,MCP,MZCP,NPT3,NC3,IK3,IRET) IF(IRET.EQ.0)RETURN XCP=MZCP.VPOCHA(1,1) C 4ème coefficient : lambda IXV(1)=MELEMK IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur FPT :', & MTABX,KINC,4,IXV,MLB,MZLB,NPT4,NC4,IK4,IRET) IF(IRET.EQ.0)RETURN XLB=MZLB.VPOCHA(1,1) C 5ème coefficient : uet IXV(1)=MELEMK IXV(2)=0 IXV(3)=0 CALL LEKCOF('Opérateur FPT :', & MTABX,KINC,5,IXV,MUE,MZUE,NPT5,NC5,IK5,IRET) IF(IRET.EQ.0)RETURN C 6ème coefficient : yp IXV(1)=0 IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur FPT :', & MTABX,KINC,6,IXV,MYP,MZYP,NPT6,NC6,IK6,IRET) IF(IRET.EQ.0)RETURN C 7ème coefficient : h IXV(1)=MELEMK IXV(2)=0 IXV(3)=0 CALL LEKCOF('Opérateur FPT :', & MTABX,KINC,7,IXV,MH,MZH,NPT7,NC7,IK7,IRET) IF(IRET.EQ.0)RETURN C 8ème coefficient : Teta0 IXV(1)=MELEMK IXV(2)=1 IXV(3)=0 CALL LEKCOF('Opérateur FPT :', & MTABX,KINC,8,IXV,MT0,MZT0,NPT8,NC8,IK8,IRET) IF(IRET.EQ.0)RETURN IF(IK8.EQ.1)T0=MZT0.VPOCHA(1,1) C************************************************************************** C*****CALCUL DE H(NU,UET,YP,ALFA) C************************************************************************** NEL = MZH.VPOCHA(/1) CALL YKFPT (MZRO.VPOCHA(1,1),IK1,MZMU.VPOCHA(1,1),IK2, &MZCP.VPOCHA(1,1),IK3,MZLB.VPOCHA(1,1),IK4, &MZUE.VPOCHA,MZYP.VPOCHA,MZH.VPOCHA,NEL) CALL ECROBJ('TABLE',MTABX) CALL ECME(MTABX,'IARG',2) CALL ECMO(MTABX,'ARG1','CHPOINT',MH) IF(IK8.EQ.0)THEN CALL ECMO(MTABX,'ARG2','CHPOINT',MT0) ELSE CALL ECMF(MTABX,'ARG2',T0) ENDIF CALL ECHIMP CALL ECME(MTABX,'IARG',8) IF(IK1.EQ.0)THEN CALL ECMO(MTABX,'ARG1','CHPOINT',MRO) ELSE CALL ECMF(MTABX,'ARG1',XRO) ENDIF IF(IK2.EQ.0)THEN CALL ECMO(MTABX,'ARG2','CHPOINT',MMU) ELSE CALL ECMF(MTABX,'ARG2',XMU) ENDIF CALL ECMO(MTABX,'ARG5','CHPOINT',MUE) C*************************************************************************** RETURN 90 CONTINUE WRITE(6,*)' Opérateur FPT' RETURN END