Télécharger fpa.eso

Retour à la liste

Numérotation des lignes :

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

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