Sources Esope | Cast3M

kfpt
C KFPT      SOURCE    CB215821  20/11/25    13:31:24     10792          
       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,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