Télécharger raye3.eso

Retour à la liste

Numérotation des lignes :

  1. C RAYE3 SOURCE CHAT 12/06/07 21:15:57 7389
  2. SUBROUTINE RAYE3(MATR, EMIS, RES)
  3.  
  4. C ************************************************************
  5. C **** SUBROUTINE DE CALCUL DE LA MATRICE DE RAYONNEMENT ****
  6. C **** ****
  7. C **** En entree : MATR matrice des facteurs de forme ****
  8. C **** EMIS valeur de l'emissivite en chaque ****
  9. C **** element de surface ****
  10. C **** En sortie : RES matrice de rayonnement ****
  11. C **** ****
  12. C **** Le resultat obtenu est RES: ****
  13. C **** RES = (I - F)*(I - (I - EMIS)*F)**(-1)*S*EMIS ****
  14. C **********************************************************T(J)
  15.  
  16. IMPLICIT INTEGER(I-N)
  17. IMPLICIT REAL*8 (A-H,O-Z)
  18.  
  19. -INC CCREEL
  20. -INC CCOPTIO
  21.  
  22. C **********************************************************
  23. C **** Declaration de la structure des facteurs ****
  24. C **** de forme ****
  25. C **********************************************************
  26.  
  27. SEGMENT IFACFO
  28. INTEGER LFACT(NBEL1)
  29. ENDSEGMENT
  30. SEGMENT LFAC
  31. REAL *8 FACT(NBEL2)
  32. ENDSEGMENT
  33.  
  34. C **** Segment de travail pour l'inversion de matrice ****
  35.  
  36. SEGMENT TRAVAI
  37. REAL *8 A(NEL,NEL), BT(NEL,NEL)
  38. INTEGER IS(NEL)
  39. ENDSEGMENT
  40.  
  41. C **********************************************************
  42. C **** Declaration des variables du probleme ****
  43. C **********************************************************
  44.  
  45. POINTEUR MATR.IFACFO, RES.IFACFO
  46. POINTEUR LMATR.LFAC, LRES.LFAC
  47. POINTEUR PSUR.LFAC, B.LFAC, EMIS.LFAC
  48.  
  49. C **********************************************************
  50. C **** Activation de la matrice des facteurs de forme ****
  51. C **** par l'intermediaire de son pointeur. Sa ****
  52. C **** dimension est Nbel. Le dernier pointeur pointe ****
  53. C **** sur les elements de surface ****
  54. C **********************************************************
  55.  
  56. IF (IIMPI.GE.4) THEN
  57. WRITE(6,*) 'DEBUT DE RAYE3.ESO'
  58. ENDIF
  59.  
  60. SEGACT MATR
  61. Nel = MATR.LFACT(/1)
  62.  
  63. IF (IIMPI.GE.4) THEN
  64. WRITE(6,*) 'Nel =',Nel
  65. WRITE(6,*) 'On doit trouver comme NBEL1 (NBEL + 1)'
  66. ENDIF
  67.  
  68. Nel = Nel - 1
  69.  
  70. SEGINI TRAVAI
  71.  
  72. NBEL1 = Nel + 1
  73. NBEL2 = Nel
  74. PSUR = MATR.LFACT(NBEL1)
  75.  
  76. SEGACT EMIS
  77.  
  78. C **********************************************************
  79. C **** Calcul de (I - (I - EMIS)*F) ****
  80. C **** (EMIS matrice diagonale des emissivites) ****
  81. C **** Au debut, on travaille avec une structure ****
  82. C **** matricielle A(Nel, Nel) car la routine INVER ne ****
  83. C **** fonctionne que pour cette structure. ****
  84. C **********************************************************
  85.  
  86. DO 10 I = 1, Nel
  87. LMATR = MATR.LFACT(I)
  88.  
  89. SEGACT LMATR
  90.  
  91. DO 20 J = 1, Nel
  92. A(I,J)=-(1.D0-(EMIS.FACT(I)))*(LMATR.FACT(J))
  93. IF (I.EQ.J) A(I, I) = 1.D0 + A(I,J)
  94. 20 CONTINUE
  95.  
  96. SEGDES LMATR
  97.  
  98. 10 CONTINUE
  99.  
  100. SEGDES EMIS
  101.  
  102. C **********************************************************
  103. C **** Calcul de (I - (I - EMIS)*F)**(-1) grace a une ****
  104. C **** subroutine de calcul (INVER1) ****
  105. C **********************************************************
  106.  
  107. ICRIT = 0
  108. CALL INVER1(TRAVAI, Nel, ICRIT, XPETIT)
  109.  
  110.  
  111. C **********************************************************
  112. C **** Multiplication de RES par (I - F) ****
  113. C **********************************************************
  114.  
  115. SEGINI RES
  116.  
  117. RES.LFACT(NBEL1) = MATR.LFACT(NBEL1)
  118.  
  119. DO 50 I = 1, (NBEL1 - 1)
  120. SEGINI B
  121.  
  122. C **********************************************************
  123. C **** (I - F) est enregistre dans B ****
  124. C **********************************************************
  125.  
  126. LMATR = MATR.LFACT(I)
  127. SEGACT LMATR
  128.  
  129. DO 60 J = 1, NBEL2
  130. B.FACT(J) = -LMATR.FACT(J)
  131. IF (I.EQ.J) B.FACT(J) = 1.D0 + B.FACT(J)
  132. 60 CONTINUE
  133.  
  134. SEGINI LRES
  135. SEGACT PSUR
  136. SEGACT EMIS
  137.  
  138. DO 70 J = 1, NBEL2
  139.  
  140. C **********************************************************
  141. C **** LRES(i,j) = somm[B(i,k)*TEMP(k,j)] ****
  142. C **********************************************************
  143.  
  144. DO 80 K = 1, NBEL2
  145. LRES.FACT(J) = LRES.FACT(J) +
  146. # B.FACT(K)*A(K,J)
  147.  
  148. 80 CONTINUE
  149.  
  150. C **********************************************************
  151. C **** Multiplication par la surface et l'emissivite ****
  152. C **** LRES(i,j) = LRES(i,j)*S(i)*EMIS(j) ****
  153. C **********************************************************
  154.  
  155.  
  156.  
  157. LRES.FACT(J) = LRES.FACT(J)*PSUR.FACT(I)*
  158. # EMIS.FACT(J)
  159.  
  160.  
  161. C **********************************************************
  162. C **** Fin des differentes boucles de calcul ****
  163. C **********************************************************
  164.  
  165. 70 CONTINUE
  166. RES.LFACT(I) = LRES
  167. SEGDES PSUR
  168. SEGDES EMIS
  169. SEGDES LMATR
  170. SEGDES B
  171. SEGDES LRES
  172.  
  173. 50 CONTINUE
  174.  
  175. SEGSUP TRAVAI, B
  176. SEGDES RES
  177. SEGDES MATR
  178.  
  179. RETURN
  180. END
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  

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