C KFPT SOURCE GOUNAND 25/11/12 21:15:21 12399 SUBROUTINE KFPT C******************************************************************** C C CALCUL DE H : COEFFICIENT D'ECHANGE THERMIQUE C D'ORIGINE CONVECTIVE C C Dans le cadre de l'opérateur FPT : C C FPT C ------> KFPT : calcul de H C ------> ECHIMP : calcul des fonctions de paroi C sur la temperature C SYNTAXE : C H TETA = KFPT $DOM RO MU CP LB UET YP TN ; C C C C NU VISCOSITE CINEMATIQUE ---> flottant C UET U* ---> chpoint scal C YP DISTANCE A LA PAROI ---> flottant C ALFA DIFFUSIVITE ---> flottant C H COEFFICIENT D'ECHANGE ---> chpoint scal C THERMIQUE C TETA TEMPERATURE A LA PAROI ---> chpoint scal C C TN TEMPERATURE ---> chpoint scal C C C********************************************************************* IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) CHARACTER*8 TYPE,MTYP C -INC SMCHPOI -INC SMLENTI -INC PPARAM -INC CCOPTIO POINTEUR MZUE.MPOVAL,MZYP.MPOVAL POINTEUR MZMU.MPOVAL,MZRO.MPOVAL,MZCP.MPOVAL,MZLB.MPOVAL POINTEUR MRO.MCHPOI,MMU.MCHPOI,MCP.MCHPOI,MLB.MCHPOI POINTEUR MZH.MPOVAL,MH.MCHPOI,MUE.MCHPOI C***************************************************************************** CFPT CALL LIROBJ('MMODEL',MMDZ,1,IRETOU) IF(IRETOU.NE.1)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',MELEMS) NC=1 TYPE=' ' CALL CRCHPT(TYPE,MELEMS,NC,1,MH) SEGACT MH MSOUPO=MH.IPCHP(1) SEGACT MSOUPO MZH=IPOVAL SEGACT MZH NPT=MZH.VPOCHA(/1) C *** C *** LECTURE DES COEFFICIENTS *** C 1er coefficient : ro CALL QUETYP(MTYP,0,IRETOU) IF(IRETOU.EQ.0)THEN C% On ne trouve pas d'objet de type %m1:8 MOTERR( 1: 8) = 'CHPOINT ' CALL ERREUR(37) RETURN ENDIF IF(MTYP.EQ.'FLOTTANT')THEN IK1=1 CALL LIRREE(XRO,1,IRETOU) N=1 NC=1 SEGINI MZRO MZRO.VPOCHA(1,1)=XRO ELSEIF(MTYP.EQ.'CHPOINT')THEN IK1=0 CALL LIROBJ(MTYP,MRO,1,IRETOU) CALL LRCHT(MRO,MZRO,TYPE,IGEOM) CALL KRIPAD(IGEOM,MLENT1) CALL VERPAD(MLENT1,MELEMS,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) = 'RO ' MOTERR(9:16) = 'CHPOINT ' WRITE(IOIMP,*)'Opérateur : KFPT' CALL ERREUR(788) RETURN ENDIF ELSE C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = 'EF/EFM1 ' CALL ERREUR(803) RETURN ENDIF C 2ème coefficient : mu CALL QUETYP(MTYP,0,IRETOU) IF(IRETOU.EQ.0)THEN C% On ne trouve pas d'objet de type %m1:8 MOTERR( 1: 8) = 'CHPOINT ' CALL ERREUR(37) RETURN ENDIF IF(MTYP.EQ.'FLOTTANT')THEN IK2=1 CALL LIRREE(XMU,1,IRETOU) N=1 NC=1 SEGINI MZMU MZMU.VPOCHA(1,1)=XMU ELSEIF(MTYP.EQ.'CHPOINT')THEN IK2=0 CALL LIROBJ(MTYP,MMU,1,IRETOU) CALL LRCHT(MMU,MZMU,TYPE,IGEOM) CALL KRIPAD(IGEOM,MLENT1) CALL VERPAD(MLENT1,MELEMS,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) = 'MU ' MOTERR(9:16) = 'CHPOINT ' WRITE(IOIMP,*)'Opérateur : KFPT' CALL ERREUR(788) RETURN ENDIF ELSE C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = 'EF/EFM1 ' CALL ERREUR(803) RETURN ENDIF C 3ème coefficient : cp CALL QUETYP(MTYP,0,IRETOU) IF(IRETOU.EQ.0)THEN C% On ne trouve pas d'objet de type %m1:8 MOTERR( 1: 8) = 'CHPOINT ' CALL ERREUR(37) RETURN ENDIF IF(MTYP.EQ.'FLOTTANT')THEN IK3=1 CALL LIRREE(XCP,1,IRETOU) N=1 NC=1 SEGINI MZCP MZCP.VPOCHA(1,1)=XCP ELSEIF(MTYP.EQ.'CHPOINT')THEN IK3=0 CALL LIROBJ(MTYP,MCP,1,IRETOU) CALL LRCHT(MCP,MZCP,TYPE,IGEOM) CALL KRIPAD(IGEOM,MLENT1) CALL VERPAD(MLENT1,MELEMS,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) = 'CP ' MOTERR(9:16) = 'CHPOINT ' WRITE(IOIMP,*)'Opérateur : KFPT' CALL ERREUR(788) RETURN ENDIF ELSE C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = 'EF/EFM1 ' CALL ERREUR(803) RETURN ENDIF C 4ème coefficient : lambda CALL QUETYP(MTYP,0,IRETOU) IF(IRETOU.EQ.0)THEN C% On ne trouve pas d'objet de type %m1:8 MOTERR( 1: 8) = 'CHPOINT ' CALL ERREUR(37) RETURN ENDIF IF(MTYP.EQ.'FLOTTANT')THEN IK4=1 CALL LIRREE(XLB,1,IRETOU) N=1 NC=1 SEGINI MZLB MZLB.VPOCHA(1,1)=XLB ELSEIF(MTYP.EQ.'CHPOINT')THEN IK4=0 CALL LIROBJ(MTYP,MLB,1,IRETOU) CALL LRCHT(MLB,MZLB,TYPE,IGEOM) CALL KRIPAD(IGEOM,MLENT1) CALL VERPAD(MLENT1,MELEMS,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) = 'LB ' MOTERR(9:16) = 'CHPOINT ' WRITE(IOIMP,*)'Opérateur : KFPT' CALL ERREUR(788) RETURN ENDIF ELSE C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = 'EF/EFM1 ' CALL ERREUR(803) RETURN ENDIF C 5ème coefficient : uet CALL QUETYP(MTYP,0,IRETOU) IF(IRETOU.EQ.0)THEN C% On ne trouve pas d'objet de type %m1:8 MOTERR( 1: 8) = 'CHPOINT ' CALL ERREUR(37) RETURN ENDIF IF(MTYP.EQ.'CHPOINT')THEN IK5=0 CALL LIROBJ(MTYP,MUE,1,IRETOU) CALL LRCHT(MUE,MZUE,TYPE,IGEOM) CALL KRIPAD(IGEOM,MLENT1) CALL VERPAD(MLENT1,MELEMS,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) = 'UE ' MOTERR(9:16) = 'CHPOINT ' WRITE(IOIMP,*)'Opérateur : KFPT' CALL ERREUR(788) RETURN ENDIF ELSE C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = 'EF/EFM1 ' CALL ERREUR(803) RETURN ENDIF C 6ème coefficient : yp IK6=1 CALL LIRREE(YP,1,IRETOU) IF(IRETOU.EQ.0)RETURN N=1 NC=1 SEGINI MZYP MZYP.VPOCHA(1,1)=YP C 7ème coefficient : h IK7 = 0 C************************************************************************** C*****CALCUL DE H(NU,UET,YP,ALFA) C************************************************************************** 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,NPT) SEGDES MZUE,MZH,MZYP SEGDES MUE,MH IF(IK1.EQ.0)THEN SEGDES MRO,MZRO ELSE SEGSUP MZRO ENDIF IF(IK2.EQ.0)THEN SEGDES MMU,MZMU ELSE SEGSUP MZMU ENDIF IF(IK3.EQ.0)THEN SEGDES MCP,MZCP ELSE SEGSUP MZCP ENDIF IF(IK4.EQ.0)THEN SEGDES MLB,MZLB ELSE SEGSUP MZLB ENDIF CALL ECROBJ('CHPOINT',MH) RETURN END