Sources Esope | Cast3M

fpt
C FPT       SOURCE    CB215821  20/11/25    13:29:24     10792          
      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 PPARAM
-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