Télécharger rayen.eso

Retour à la liste

Numérotation des lignes :

  1. C RAYEN SOURCE CHAT 12/06/07 21:15:58 7389
  2. SUBROUTINE RAYEN(modl,mchel1,mchel2,mchel3,errj,mchel4)
  3.  
  4. C **********************************************************
  5. C **** OPERATEUR RAYE ****
  6. C **** ****
  7. C **** SYNTAXE : CH2 = RAYE MODL1 CHAM1 CHAM2 ****
  8. C **** ou ****
  9. C **** CH2 = RAYE MODL1 CHAM1 CHAM2 CHAM3 ****
  10. C **** (PREC) ****
  11. C **** 'TABS' VAL ****
  12. C **** MODL1 : type MMODEL ****
  13. C **** MCHEL1 : type MCHELM ****
  14. C **** MCHEL2 : type MCHELM ****
  15. C **** MCHEL3 : type MCHELM ****
  16. C **** PREC : flottant ****
  17. C **** VAL : flottant (T milieu absorbant)****
  18. C **** ****
  19. C Rayonnement en milieu transparent dans une cavité ****
  20. C 2 possibilités: ****
  21. C 1- calcul de la matrice de rayonnement ****
  22. C Phi = R. T**4 ****
  23. C 2- calcul de la temperature Trad ****
  24. C Phi = emis.sigma.(T**4-Trad**4) ****
  25. C **********************************************************
  26.  
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8 (A-H,O-Z)
  29.  
  30. C **********************************************************
  31. C **** Entree des includes ****
  32. C **********************************************************
  33.  
  34. -INC CCOPTIO
  35. -INC SMCHAML
  36. -INC SMMODEL
  37.  
  38. C **********************************************************
  39. C **** Declaration des variables du probleme ****
  40. C **********************************************************
  41.  
  42. POINTEUR MODL.MMODEL
  43. POINTEUR CHAME.MCHELM, CHAMF.MCHELM, CHAMT.MCHELM
  44. CHARACTER*8 TYPE
  45. CHARACTER*4 MOTCLE
  46.  
  47. C POINTEUR IMCHFA.MCHAML
  48. C **********************************************************
  49. C **** Lecture des entrees ****
  50. C **********************************************************
  51.  
  52. KABS=0
  53. KMATR=1
  54. IF (IIMPI.GE.4) WRITE(6,*) 'DEBUT DE RAYT.ESO'
  55. if(mchel3.ne.0) then
  56. segact mchel2
  57. kabs=0
  58. kmatr=0
  59. do io=1,mchel2.imache(/1)
  60. mchaml=mchel2.ichaml(io)
  61. segact mchaml
  62. do ia=1,nomche(/2)
  63. if( nomche(ia).eq.'TABS' ) then
  64. kabs=1
  65. melval=ielval(ia)
  66. segact melval
  67. Tabs= velche(1,1)
  68. segdes melval
  69. go to 1
  70. endif
  71. enddo
  72. 1 continue
  73. segdes mchaml
  74. enddo
  75. segdes mchel2
  76. endif
  77. * write(6,*) ' kmatr kabs ' , kmatr , kabs
  78. * write(6,*) ' errj , tabs ' , errj , tabs
  79. IF(KMATR.EQ.1) THEN
  80.  
  81. C Calcul de la matrice de rayonnement
  82.  
  83.  
  84. C **********************************************************
  85. C **** Verification sur l'egalite des supports des ****
  86. C **** differents champs. ****
  87. C **********************************************************
  88. CALL RAYN1(MODL, MCHEL1)
  89. CALL RAYN1(MODL, MCHEL2)
  90.  
  91. C **********************************************************
  92. C **** Reconnaissance des deux CHAMELEM ****
  93. C **** MCHEL1 contient les facteurs de forme ****
  94. C **** MCHEL2 contient les emissivites ****
  95. C **********************************************************
  96.  
  97. SEGACT MCHEL1, MCHEL2
  98.  
  99. IF ((MCHEL1.TITCHE).NE.'FACTEURS DE FORME ') THEN
  100. CHAME = MCHEL1
  101. CHAMF = MCHEL2
  102. ELSE
  103. CHAME = MCHEL2
  104. CHAMF = MCHEL1
  105. ENDIF
  106.  
  107. SEGDES, MCHEL1, MCHEL2
  108. CALL RAYE0(MODL, INFOEL)
  109.  
  110. C **********************************************************
  111. C **** Conversion des MCHELM en matrices ****
  112. C **********************************************************
  113. * call zpchel(mchel1,1)
  114. CALL RAYE1(MCHEL1, INFOEL, IFACFO)
  115. * call zpchel(mchel2,1)
  116. CALL RAYE2(MCHEL2, MODL, INFOEL, IEMIS)
  117.  
  118. C **********************************************************
  119. C **** Calcul de la matrice de rayonnement associe ****
  120. C **********************************************************
  121.  
  122. CALL RAYE3(IFACFO, IEMIS, IRES)
  123.  
  124. IF (IIMPI.GE.3) THEN
  125. CALL PRFACF(IRES)
  126. ENDIF
  127.  
  128. C **********************************************************
  129. C **** Conversion du resultat en un MCHELM ****
  130. C **********************************************************
  131.  
  132. LTITR = 0
  133. CALL FFMCHA(MODL, INFOEL, IRES, MCHEL3, LTITR)
  134.  
  135. C **********************************************************
  136. C **** Ecriture des resultats ****
  137. C **********************************************************
  138. mchel4=mchel3
  139. * CALL ECROBJ('MCHAML ', MCHEL3)
  140.  
  141. ELSE
  142.  
  143. C Calcul de la temperature Trad
  144.  
  145. C **********************************************************
  146. C **** Verification sur l'egalite des supports des ****
  147. C **** differents champs. ****
  148. C **********************************************************
  149.  
  150. CALL RAYN1(MODL, MCHEL1)
  151. CALL RAYN1(MODL, MCHEL2)
  152. CALL RAYN1(MODL, MCHEL3)
  153.  
  154. C **********************************************************
  155. C **** Reconnaissance des deux CHAMELEM ****
  156. C **** MCHEL1 contient les facteurs de forme ****
  157. C **** MCHEL2 contient les emissivites par element)****
  158. C **** MCHEL3 contient les temperatures par element***
  159. C **********************************************************
  160.  
  161.  
  162. SEGACT MCHEL1, MCHEL2, MCHEL3
  163. IF ((MCHEL1.TITCHE).EQ.'FACTEURS DE FORME ') THEN
  164. CHAMF = MCHEL1
  165. IF((MCHEL2.TITCHE).EQ.'CARACTERISTIQUES') THEN
  166. CHAME = MCHEL2
  167. CHAMT = MCHEL3
  168. ELSE
  169. CHAME = MCHEL3
  170. CHAMT = MCHEL2
  171. ENDIF
  172. ELSEIF((MCHEL1.TITCHE).EQ.'CARACTERISTIQUES') THEN
  173. CHAME = MCHEL1
  174. IF((MCHEL2.TITCHE).EQ.'FACTEURS DE FORME ') THEN
  175. CHAMF = MCHEL2
  176. CHAMT = MCHEL3
  177. ELSE
  178. CHAMF = MCHEL3
  179. CHAMT = MCHEL2
  180. ENDIF
  181. ELSE
  182. CHAMT = MCHEL1
  183. IF((MCHEL2.TITCHE).EQ.'FACTEURS DE FORME ') THEN
  184. CHAMF = MCHEL2
  185. CHAME = MCHEL3
  186. ELSE
  187. CHAMF = MCHEL3
  188. CHAME = MCHEL2
  189. ENDIF
  190.  
  191. ENDIF
  192.  
  193. CALL RAYE0(MODL, INFOEL)
  194.  
  195. C **********************************************************
  196. C **** Conversion des MCHELM en matrices ****
  197. C **********************************************************
  198.  
  199. CALL RAYE1(CHAMF, INFOEL, IFACFO)
  200.  
  201. CALL RAYE2(CHAME , MODL, INFOEL, IEMIS)
  202.  
  203. CALL RAYE2(CHAMT , MODL, INFOEL, ITEMP)
  204.  
  205. C **********************************************************
  206. C **** Calcul du tableau TRAD ****
  207. C **********************************************************
  208.  
  209. CALL RAYT1(IFACFO, IEMIS, ITEMP, ERRJ , IRES, KABS, TABS)
  210.  
  211.  
  212. C **********************************************************
  213. C **** Conversion du resultat en un MCHELM ****
  214. C **********************************************************
  215.  
  216. C WRITE(6,*) ' infoel',INFOEL
  217. C on ne traite pas les coques
  218. INFOEL = 0
  219. CALL RAYT2(MODL, INFOEL, CHAMT , IRES, MCHEL4)
  220.  
  221. C **********************************************************
  222. C **** Ecriture des resultats ****
  223. C **********************************************************
  224.  
  225. * CALL ECROBJ('MCHAML ', MCHEL4)
  226.  
  227. ENDIF
  228.  
  229. IF (IIMPI.GE.4) WRITE(6,*) 'FIN RAYT OK'
  230.  
  231. END
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  

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