Télécharger fpt.eso

Retour à la liste

Numérotation des lignes :

  1. C FPT SOURCE CHAT 06/08/24 21:37:33 5529
  2. SUBROUTINE FPT
  3. C**********************************************************************
  4. C
  5. C
  6. C FPT
  7. C ------> KFPT : calcul de H
  8. C ------> ECHIMP : calcul des fonctions de paroi
  9. C sur la temperature
  10. C SYNTAXE :
  11. C 'ZONE' $DOM 'OPER' FPT RO MU CP LB UET YP H TETA 'INCO' TN
  12. C
  13. C
  14. C $DOM Modèle NAVIER_STOKES
  15. C
  16. C RO Densité FLOTTANT ou CHPOINT SCAL SPG
  17. C
  18. C MU Viscosité dynamique moléculaire FLOTTANT ou CHPOINT SCAL SPG
  19. C
  20. C CP Chaleur spécifique FLOTTANT ou CHPOINT SCAL SPG
  21. C
  22. C LB Conductivité thermique FLOTTANT ou CHPOINT SCAL SPG
  23. C
  24. C UET Vitesse de frottement CHPOINT SCAL SPG
  25. C
  26. C YP Distance la paroi FLOTTANT
  27. C
  28. C H Coefficient d'échange thermique CHPOINT SCAL SPG
  29. C
  30. C TETA Température à la paroi CHPOINT SCAL SPG
  31. C
  32. C TN Température CHPOINT SCAL SOMMET
  33. C
  34. C IMPORTANT:
  35. C
  36. C Suivant la formulation EF ou EFM1 SPG doit être SOMMET ou CENTRE
  37. C
  38. C
  39. C***********************************************************************
  40. IMPLICIT INTEGER(I-N)
  41. IMPLICIT REAL*8 (A-H,O-Z)
  42. C
  43. -INC CCOPTIO
  44. -INC SMCOORD
  45. -INC SMELEME
  46. -INC SMCHPOI
  47. POINTEUR MZNU.MPOVAL,MZUE.MPOVAL,MZYP.MPOVAL
  48. POINTEUR MZMU.MPOVAL,MZRO.MPOVAL,MZCP.MPOVAL,MZLB.MPOVAL
  49. POINTEUR MZH.MPOVAL,MZT0.MPOVAL
  50. CHARACTER*8 NOMI,NOMA,TYPE,NOMZ,TYPC
  51. PARAMETER (NTB=1)
  52. CHARACTER*8 LTAB(NTB)
  53. DIMENSION KTAB(NTB),IXV(3)
  54. * SAVE IPAS
  55. * DATA LTAB/'KIZX '/,IPAS/0/
  56. DATA LTAB/'KIZX '/
  57. C*****************************************************************************
  58. CFPT
  59. C write(6,*)' debut FPT '
  60. CALL LITABS(LTAB,KTAB,NTB,1,IRET)
  61. IF(IRET.EQ.0)THEN
  62. WRITE(6,*)' Opérateur FPT'
  63. WRITE(6,*)' On attend un ensemble de table soustypes'
  64. RETURN
  65. ENDIF
  66. MTABX=KTAB(1)
  67.  
  68. CALL LEKTAB(MTABX,'EQEX',MTAB1)
  69. IF(MTAB1.EQ.0)THEN
  70. WRITE(6,*)' Opérateur FPT'
  71. WRITE(6,*)' On ne trouve pas l''indice EQEX ? '
  72. RETURN
  73. ENDIF
  74.  
  75. CALL LEKTAB(MTAB1,'INCO',KINC)
  76. IF(KINC.EQ.0)THEN
  77. WRITE(6,*)' Opérateur FPT'
  78. WRITE(6,*)' Il n''y a pas de table INCO ? ?.'
  79. RETURN
  80. ENDIF
  81.  
  82. C*****************************************************************************
  83.  
  84. C
  85. C- Récupération de la table des options KOPT (pointeur KOPTI)
  86. C
  87. CALL LEKTAB(MTABX,'KOPT',KOPTI)
  88. IF (KOPTI.EQ.0) THEN
  89. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  90. MOTERR( 1: 8) = ' KOPT '
  91. MOTERR( 9:16) = ' KOPT '
  92. MOTERR(17:24) = ' KIZX '
  93. CALL ERREUR(786)
  94. RETURN
  95. ENDIF
  96.  
  97. CALL ACME(KOPTI,'KIMPL',KIMPL)
  98. CALL ACME(KOPTI,'KFORM',KFORM)
  99.  
  100. IF(KFORM.NE.0.AND.KFORM.NE.1)THEN
  101. C Option %m1:8 incompatible avec les données
  102. MOTERR( 1: 8) = 'EF/EFM1 '
  103. CALL ERREUR(803)
  104. RETURN
  105. ENDIF
  106.  
  107. C*****************************************************************************
  108. C
  109. C- Récupération de la table DOMAINE associée au domaine local
  110. C
  111. IF(KFORM.EQ.0)THEN
  112. CALL LEKTAB(MTABX,'DOMZ',MTABZ)
  113. IF(MTABZ.EQ.0)THEN
  114. WRITE(6,*)' Opérateur FPT'
  115. WRITE(6,*)' On ne trouve pas l''indice DOMZ ? '
  116. RETURN
  117. ENDIF
  118.  
  119. TYPE=' '
  120. CALL ACMO(MTABZ,'CENTRE',TYPE,MELEMK)
  121. IF(TYPE.NE.'MAILLAGE')GO TO 90
  122.  
  123. ENDIF
  124. IF(KFORM.EQ.1)THEN
  125. CALL ACMM(MTABX,'NOMZONE',NOMZ)
  126. TYPE=' '
  127. CALL ACMO(MTABX,'DOMZ',TYPE,MMDZ)
  128. IF(TYPE.NE.'MMODEL')THEN
  129. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  130. MOTERR( 1: 8) = ' DOMZ '
  131. MOTERR( 9:16) = ' DOMZ '
  132. MOTERR(17:24) = ' KIZX '
  133. CALL ERREUR(786)
  134. RETURN
  135. ENDIF
  136.  
  137. C E/ MMODEL : Pointeur de la table contenant l'information cherchée
  138. C /S IPOINT : Pointeur sur la table DOMAINE
  139. C /S INEFMD : Type formulation INEFMD=1 LINE,=2 MACRO,=3 QUADRATIQUE
  140. C INEFMD=4 LINB
  141.  
  142. CALL LEKMOD(MMDZ,MTABZ,INEFMD)
  143.  
  144. CALL LEKTAB(MTABZ,'SOMMET',MELEMK)
  145. ENDIF
  146.  
  147. C ***
  148.  
  149. CALL ACME(MTABX,'IARG',IARG)
  150.  
  151. C *** LECTURE DES COEFFICIENTS ***
  152. C 1er coefficient : ro
  153. IXV(1)=MELEMK
  154. IXV(2)=1
  155. IXV(3)=0
  156. CALL LEKCOF('Opérateur FPT :',
  157. & MTABX,KINC,1,IXV,MRO,MZRO,NPT1,NC1,IK1,IRET)
  158. IF(IRET.EQ.0)RETURN
  159. XRO=MZRO.VPOCHA(1,1)
  160.  
  161. C 2ème coefficient : mu
  162. IXV(1)=MELEMK
  163. IXV(2)=1
  164. IXV(3)=0
  165. CALL LEKCOF('Opérateur FPT :',
  166. & MTABX,KINC,2,IXV,MMU,MZMU,NPT2,NC2,IK2,IRET)
  167. IF(IRET.EQ.0)RETURN
  168. XMU=MZMU.VPOCHA(1,1)
  169.  
  170. C 3ème coefficient : cp
  171. IXV(1)=MELEMK
  172. IXV(2)=1
  173. IXV(3)=0
  174. CALL LEKCOF('Opérateur FPT :',
  175. & MTABX,KINC,3,IXV,MCP,MZCP,NPT3,NC3,IK3,IRET)
  176. IF(IRET.EQ.0)RETURN
  177. XCP=MZCP.VPOCHA(1,1)
  178.  
  179. C 4ème coefficient : lambda
  180. IXV(1)=MELEMK
  181. IXV(2)=1
  182. IXV(3)=0
  183. CALL LEKCOF('Opérateur FPT :',
  184. & MTABX,KINC,4,IXV,MLB,MZLB,NPT4,NC4,IK4,IRET)
  185. IF(IRET.EQ.0)RETURN
  186. XLB=MZLB.VPOCHA(1,1)
  187.  
  188. C 5ème coefficient : uet
  189. IXV(1)=MELEMK
  190. IXV(2)=0
  191. IXV(3)=0
  192. CALL LEKCOF('Opérateur FPT :',
  193. & MTABX,KINC,5,IXV,MUE,MZUE,NPT5,NC5,IK5,IRET)
  194. IF(IRET.EQ.0)RETURN
  195.  
  196. C 6ème coefficient : yp
  197. IXV(1)=0
  198. IXV(2)=1
  199. IXV(3)=0
  200. CALL LEKCOF('Opérateur FPT :',
  201. & MTABX,KINC,6,IXV,MYP,MZYP,NPT6,NC6,IK6,IRET)
  202. IF(IRET.EQ.0)RETURN
  203.  
  204. C 7ème coefficient : h
  205. IXV(1)=MELEMK
  206. IXV(2)=0
  207. IXV(3)=0
  208. CALL LEKCOF('Opérateur FPT :',
  209. & MTABX,KINC,7,IXV,MH,MZH,NPT7,NC7,IK7,IRET)
  210. IF(IRET.EQ.0)RETURN
  211.  
  212. C 8ème coefficient : Teta0
  213. IXV(1)=MELEMK
  214. IXV(2)=1
  215. IXV(3)=0
  216. CALL LEKCOF('Opérateur FPT :',
  217. & MTABX,KINC,8,IXV,MT0,MZT0,NPT8,NC8,IK8,IRET)
  218. IF(IRET.EQ.0)RETURN
  219. IF(IK8.EQ.1)T0=MZT0.VPOCHA(1,1)
  220.  
  221. C**************************************************************************
  222. C*****CALCUL DE H(NU,UET,YP,ALFA)
  223. C**************************************************************************
  224.  
  225. NEL = MZH.VPOCHA(/1)
  226. CALL YKFPT (MZRO.VPOCHA(1,1),IK1,MZMU.VPOCHA(1,1),IK2,
  227. &MZCP.VPOCHA(1,1),IK3,MZLB.VPOCHA(1,1),IK4,
  228. &MZUE.VPOCHA,MZYP.VPOCHA,MZH.VPOCHA,NEL)
  229.  
  230.  
  231. CALL ECROBJ('TABLE',MTABX)
  232.  
  233. CALL ECME(MTABX,'IARG',2)
  234. CALL ECMO(MTABX,'ARG1','CHPOINT',MH)
  235. IF(IK8.EQ.0)THEN
  236. CALL ECMO(MTABX,'ARG2','CHPOINT',MT0)
  237. ELSE
  238. CALL ECMF(MTABX,'ARG2',T0)
  239. ENDIF
  240.  
  241. CALL ECHIMP
  242.  
  243. CALL ECME(MTABX,'IARG',8)
  244. IF(IK1.EQ.0)THEN
  245. CALL ECMO(MTABX,'ARG1','CHPOINT',MRO)
  246. ELSE
  247. CALL ECMF(MTABX,'ARG1',XRO)
  248. ENDIF
  249.  
  250. IF(IK2.EQ.0)THEN
  251. CALL ECMO(MTABX,'ARG2','CHPOINT',MMU)
  252. ELSE
  253. CALL ECMF(MTABX,'ARG2',XMU)
  254. ENDIF
  255. CALL ECMO(MTABX,'ARG5','CHPOINT',MUE)
  256.  
  257. C***************************************************************************
  258. RETURN
  259.  
  260. 90 CONTINUE
  261. WRITE(6,*)' Opérateur FPT'
  262. RETURN
  263. END
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales