Télécharger fpa.eso

Retour à la liste

Numérotation des lignes :

fpa
  1. C FPA SOURCE CB215821 20/11/25 13:29:16 10792
  2. SUBROUTINE FPA
  3. C**********************************************************************
  4. C
  5. C OBJET : CALCUL DES FONCTIONS DE PAROIS AEROSOLS
  6. C
  7. C SYNTAXE : 'ZONE' $DOM 'OPER' FPA NU YP UET NORM AK ROG RAP
  8. C
  9. C
  10. C NU : FLOTTANT (VISCOSITE)
  11. C YP : FLOTTANT (EPAISSEUR DE LA COUCHE LIMITE)
  12. C UET : CHPOINT SCAL CENTRE (VITESSE DE FROTTEMENT)
  13. C NORM : CHPOINT VECT FACE (NORMALES A LA PAROI)
  14. C AK : CHPOINT SCAL CENTRE (VITESSE DE DEPOT)
  15. C ROG : POINT (MASSE VOLUMIQUE * G)
  16. C RAP : FLOTTANT (RAYON DES PARTICULES)
  17. C
  18. C***********************************************************************
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8 (A-H,O-Z)
  21. C
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC CCVQUA4
  26. -INC SMCOORD
  27. -INC SMELEME
  28. POINTEUR MELEMC.MELEME
  29. -INC SMCHPOI
  30. POINTEUR MUET.MCHPOI, MAK.MCHPOI, MNORM.MCHPOI
  31. POINTEUR NNU.MPOVAL,NYP.MPOVAL,NUET.MPOVAL,NNORM.MPOVAL,NAK.MPOVAL
  32. POINTEUR NROG.MPOVAL,NRAP.MPOVAL
  33.  
  34. -INC SMLMOTS
  35. CHARACTER*8 NOMZ,NOMI,NOMA,TYPE,CHAI,TYPC
  36. LOGICAL LOGI
  37. PARAMETER (NTB=1)
  38. CHARACTER*8 LTAB(NTB)
  39. DIMENSION KTAB(NTB),IXV(3)
  40. * SAVE IPAS
  41. * DATA LTAB/'KIZX '/,IPAS/0/
  42. DATA LTAB/'KIZX '/
  43. C*****************************************************************************
  44. CFPA
  45. C write(6,*)' DEBUT FPA '
  46.  
  47. CALL LITABS(LTAB,KTAB,NTB,1,IRET)
  48. IF(IRET.EQ.0)THEN
  49. WRITE(6,*)' Opérateur FPA :'
  50. WRITE(6,*)' On attend un ensemble de table soustypes'
  51. RETURN
  52. ENDIF
  53. MTABX=KTAB(1)
  54.  
  55. CALL LEKTAB(MTABX,'EQEX',MTAB1)
  56. IF(MTAB1.EQ.0)THEN
  57. WRITE(6,*)' Opérateur FPA :'
  58. WRITE(6,*)' On ne trouve pas l''indice EQEX ? '
  59. RETURN
  60. ENDIF
  61.  
  62. CALL LEKTAB(MTAB1,'INCO',KINC)
  63. IF(KINC.EQ.0)THEN
  64. WRITE(6,*)' Opérateur FPA :'
  65. WRITE(6,*)' Il n''y a pas de table INCO ? ?.'
  66. RETURN
  67. ENDIF
  68.  
  69. C***********************************************************************
  70. C OPTIONS
  71. C
  72. IKOMP=0
  73. KFORM=0
  74. KIMPL=0
  75. IAXI=0
  76. IF(IFOMOD.EQ.0)IAXI=2
  77. KOPTI=0
  78. TYPE=' '
  79. CALL ACMO(MTABX,'KOPT',TYPE,IENT)
  80. IF(TYPE.EQ.'TABLE')KOPTI=IENT
  81. IF(KOPTI.NE.0)THEN
  82. TYPE=' '
  83. CALL ACMO(KOPTI,'KFORM',TYPE,IENT)
  84. IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'KFORM',KFORM)
  85. IF(KFORM.EQ.2)THEN
  86. WRITE(6,*)' Opérateur FPA '
  87. WRITE(6,*)' Option VF non prevue '
  88. RETURN
  89. ENDIF
  90. TYPE=' '
  91. CALL ACMO(KOPTI,'KIMPL',TYPE,IENT)
  92. IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'KIMPL',KIMPL)
  93. TYPE=' '
  94. CALL ACMO(KOPTI,'IDCEN',TYPE,IENT)
  95. IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'IDCEN',IDCEN)
  96. TYPE=' '
  97. CALL ACMO(KOPTI,'IKOMP',TYPE,IENT)
  98. IF(TYPE.EQ.'ENTIER')CALL ACME(KOPTI,'IKOMP',IKOMP)
  99. IF(KIMPL.NE.0)THEN
  100. WRITE(6,*)' Opérateur FPA '
  101. WRITE(6,*)' Seule l''option explicite est prévue'
  102. RETURN
  103. ENDIF
  104.  
  105. ENDIF
  106.  
  107. C*****************************************************************************
  108. C
  109. CALL ACMM(MTABX,'NOMZONE',NOMZ)
  110. CALL LEKTAB(MTABX,'DOMZ',MTABZ)
  111. IF(MTABZ.EQ.0)THEN
  112. WRITE(6,*)' Opérateur FPA '
  113. WRITE(6,*)' On ne trouve pas l''indice DOMZ ? '
  114. RETURN
  115. ENDIF
  116.  
  117. CALL LEKTAB(MTABZ,'CENTRE',MELEMC)
  118. IF(MELEMC.EQ.0)GO TO 90
  119. C
  120.  
  121.  
  122.  
  123. C***********************************************************************
  124. C Lecture des arguments
  125.  
  126. CALL ACME(MTABX,'IARG',IARG)
  127. IF (IARG.NE.7)THEN
  128. WRITE(6,*)'Opérateur FPA : nombre d''argument incorrect'
  129. RETURN
  130. ENDIF
  131.  
  132. C *** Lecture de NU ****
  133. IXV(1)=0
  134. IXV(2)=1
  135. IXV(3)=0
  136. CALL LEKCOF('Opérateur FPA :',
  137. & MTABX,KINC,1,IXV,MNU,NNU,NPT1,NC1,IKNU,IRET)
  138. IF(IRET.EQ.0)RETURN
  139. IF(NNU.VPOCHA(1,1).LT.0.D0)THEN
  140. WRITE(6,*)'Opérateur FPA : '
  141. WRITE(6,*)' Le 1er argument n''est pas convenable'
  142. WRITE(6,*)' Il s''agit de la viscosite. On attend un flottant > 0'
  143. RETURN
  144. ENDIF
  145. XNU=NNU.VPOCHA(1,1)
  146.  
  147. C *** Lecture de YP ****
  148. IXV(1)=0
  149. IXV(2)=1
  150. IXV(3)=0
  151. CALL LEKCOF('Opérateur FPA :',
  152. & MTABX,KINC,2,IXV,MYP,NYP,NPT2,NC2,IKYP,IRET)
  153. IF(IRET.EQ.0)RETURN
  154. IF(NYP.VPOCHA(1,1).LT.0.D0)THEN
  155. WRITE(6,*)'Opérateur FPA : '
  156. WRITE(6,*)' Le 2eme argument n''est pas convenable'
  157. WRITE(6,*)' On attend un flottant > 0'
  158. RETURN
  159. ENDIF
  160. XYP=NYP.VPOCHA(1,1)
  161.  
  162. C *** Lecture de uet ****
  163. IXV(1)=MELEMC
  164. IXV(2)=0
  165. IXV(3)=0
  166. CALL LEKCOF('Opérateur FPA :',
  167. & MTABX,KINC,3,IXV,MUET,NUET,NPT3,NC3,IKUET,IRET)
  168. IF(IRET.EQ.0)RETURN
  169.  
  170. C *** Lecture de NORM ***
  171. IXV(1)=-MELEMC
  172. IXV(2)=0
  173. IXV(3)=0
  174. CALL LEKCOF('Opérateur FPA :',
  175. & MTABX,KINC,4,IXV,MNORM,NNORM,NPT4,NC4,IKNORM,IRET)
  176. IF(IRET.EQ.0)RETURN
  177.  
  178. C *** Lecture de AK ***
  179. IXV(1)=MELEMC
  180. IXV(2)=0
  181. IXV(3)=0
  182. CALL LEKCOF('Opérateur FPA :',
  183. & MTABX,KINC,5,IXV,MAK,NAK,NPT5,NC5,IKAK,IRET)
  184. IF(IRET.EQ.0)RETURN
  185.  
  186. C
  187. C *** Lecture de ROG ***
  188. IXV(1)=0
  189. IXV(2)=0
  190. IXV(3)=1
  191. CALL LEKCOF('Opérateur FPA :',
  192. & MTABX,KINC,6,IXV,MROG,NROG,NPT6,NC6,IKROG,IRET)
  193. IF(IRET.EQ.0)RETURN
  194.  
  195. C
  196. C *** Lecture de RAP ****
  197. IXV(1)=0
  198. IXV(2)=1
  199. IXV(3)=0
  200. CALL LEKCOF('Opérateur FPA :',
  201. & MTABX,KINC,7,IXV,MRAP,NRAP,NPT7,NC7,IKRAP,IRET)
  202. IF(IRET.EQ.0)RETURN
  203. IF(NRAP.VPOCHA(1,1).LT.0.D0)THEN
  204. WRITE(6,*)'Opérateur FPA : '
  205. WRITE(6,*)' Le 7eme argument n''est pas convenable'
  206. WRITE(6,*)
  207. &' Il s''agit du rayon des particules, on attend un flottant > 0'
  208. RETURN
  209. ENDIF
  210.  
  211. C
  212. C
  213. C**************************************************************************
  214. C*****CALCUL DE AK(NU,YP,UET,NORM,ROG,RAP)
  215. C**************************************************************************
  216.  
  217. C
  218. N = NAK.VPOCHA(/1)
  219. CALL XFPA(NNU.VPOCHA,NYP.VPOCHA,NROG.VPOCHA,NRAP.VPOCHA,N,
  220. 1 NUET.VPOCHA,NNORM.VPOCHA,NAK.VPOCHA)
  221. C
  222.  
  223.  
  224.  
  225. C CALL KFPA
  226. C CALL LIROBJ('CHPOINT',MCHPO1,1,IRET)
  227. C CALL LICHT(MCHPO1,MPOVA1,TYPE,IGEOM)
  228. C DO 20 I=1,N
  229. C NAK.VPOCHA(I,1)=MPOVA1.VPOCHA(I,1)
  230. C20 CONTINUE
  231. C**************************************************************************
  232. C CALL ECROBJ('CHPOINT',MAK)
  233. C CALL ECROBJ('CHPOINT',MTTA)
  234. CALL ECROBJ('TABLE',MTABX)
  235.  
  236. CALL ECME(MTABX,'IARG',2)
  237. CALL ECMO(MTABX,'ARG1','CHPOINT',MAK)
  238. XVAL=0.D0
  239. CALL ECMF(MTABX,'ARG2',XVAL)
  240.  
  241. CALL ECHIMP
  242.  
  243. CALL ECME(MTABX,'IARG',7)
  244. CALL ECMF(MTABX,'ARG1',XNU)
  245. CALL ECMF(MTABX,'ARG2',XYP)
  246.  
  247. C***************************************************************************
  248. C SEGDES MUET,MAK,NAK,MNORM
  249. C SEGDES MELEMC
  250. C SEGSUP MPOVA1,MCHPO1
  251. 90 CONTINUE
  252. RETURN
  253. END
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  

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