Télécharger raye2.eso

Retour à la liste

Numérotation des lignes :

  1. C RAYE2 SOURCE CHAT 12/06/07 21:15:56 7389
  2. SUBROUTINE RAYE2(CHAMP, MODL, INFOEL, EMIS)
  3.  
  4. C **********************************************************
  5. C **** SUBROUTINE D'INTERFACAGE CHAMELEM -->EMISSIVITE ****
  6. C **** ****
  7. C **** En entree : CHAMP champ par element ****
  8. C **** MODL modele sur lequel s'appuie le ****
  9. C **** probleme ****
  10. C **** INFOEL pointeur contenant des ****
  11. C **** informations relatives au maillage ****
  12. C **** ****
  13. C **** En sortie : EMIS matrice des composantes ****
  14. C **** des emissivites ****
  15. C **** ****
  16. C **********************************************************
  17.  
  18. IMPLICIT INTEGER(I-N)
  19. IMPLICIT REAL*8 (A-H,O-Z)
  20.  
  21. C **********************************************************
  22. C **** Structure des elements utilises ****
  23. C **********************************************************
  24.  
  25. -INC SMCHAML
  26. -INC SMELEME
  27. -INC SMMODEL
  28. -INC CCOPTIO
  29.  
  30. SEGMENT MATR
  31. REAL*8 VAL(NTOT)
  32. ENDSEGMENT
  33.  
  34. SEGMENT ADRES
  35. INTEGER V(NBS, 3)
  36. ENDSEGMENT
  37.  
  38. C **** ADRES contient les informations suivantes ****
  39. C **** V(j,1) : Numero du type d'element dans ****
  40. C **** MODL ****
  41. C **** V(j,2) : Numero correspondant au meme ****
  42. C **** element que le precedent mais ****
  43. C **** dans le CHAMELEM ****
  44. C **** V(j,3) : Nombre de surfaces dans cet ****
  45. C **** ensemble ****
  46.  
  47. SEGMENT INFOEL
  48. LOGICAL KCOQ(N1), KQUAD(N1)
  49. ENDSEGMENT
  50.  
  51. POINTEUR EMIS.MATR
  52. POINTEUR CHAMP.MCHELM
  53. POINTEUR PCHAMP.MCHAML
  54. POINTEUR DCHAM.MELVAL, DCHAM1.MELVAL, DCHAM2.MELVAL
  55. POINTEUR MAILL.MELEME, SMAILL.MELEME
  56. POINTEUR MODL.MMODEL
  57. POINTEUR ID0.IMODEL
  58. CHARACTER*8 MOT
  59.  
  60. C **********************************************************
  61. C **** Declaration des variables utilisees ****
  62. C **********************************************************
  63.  
  64. IF (IIMPI.GE.4) WRITE(6,*) 'DEBUT DE RAYE2.ESO'
  65.  
  66. SEGACT CHAMP
  67. NBS = CHAMP.IMACHE(/1)
  68. SEGINI ADRES
  69. NTOT = 0
  70. SEGACT MODL
  71.  
  72. NBS2 = MODL.KMODEL(/1)
  73.  
  74. SEGACT INFOEL
  75.  
  76. DO 10 J = 1, NBS2
  77. ID0 = MODL.KMODEL(J)
  78.  
  79. SEGACT ID0
  80. ID2 = ID0.IMAMOD
  81. SEGDES ID0
  82. DO 20 I = 1, NBS
  83.  
  84. ADRES.V(J,1) = J
  85. MAILL = CHAMP.IMACHE(I)
  86. ID1 = MAILL
  87.  
  88. IF (ID1.EQ.ID2) THEN
  89. ADRES.V(J, 2) = I
  90. SEGACT MAILL
  91. NBSOUS = MAILL.LISOUS(/1)
  92.  
  93. IF (NBSOUS.EQ.0) THEN
  94. NEL = MAILL.NUM(/2)
  95. ELSE
  96. DO 30 L = 1, NBSOUS
  97. SMAILL = MAILL.LISOUS(L)
  98. SEGACT SMAILL
  99. NEL = NEL + SMAILL.NUM(/2)
  100. SEGDES SMAILL
  101. 30 CONTINUE
  102. ENDIF
  103.  
  104. ADRES.V(J,3) = NEL
  105.  
  106. IF (KCOQ(I)) NEL = NEL + NEL
  107.  
  108. SEGDES MAILL
  109. ENDIF
  110. 20 CONTINUE
  111. NTOT = NTOT + NEL
  112.  
  113. 10 CONTINUE
  114.  
  115. C **** NTOT designe la dimension du vecteur EMIS ****
  116.  
  117. SEGDES INFOEL
  118.  
  119. IF (IIMPI.GE.4) THEN
  120. WRITE(6,*) 'Dimension du vecteur d''emissivite =',NTOT
  121. ENDIF
  122.  
  123. SEGINI EMIS
  124. N = 1
  125.  
  126. DO 40 K = 1, NBS
  127. I = ADRES.V(K,2)
  128.  
  129. PCHAMP = CHAMP.ICHAML(I)
  130.  
  131. SEGACT PCHAMP
  132. NBST = PCHAMP.IELVAL(/1)
  133. nbs2=nbsT
  134.  
  135. *
  136. *on cherche les positions des EMIS ou EINF et ESUP position ie1 ie2
  137. *
  138. lemis=0
  139. leinf=0
  140. lesup=0
  141. do iva=1,nbst
  142. if( PCHAMP.NOMCHE(iva).eq.'EMIS') lemis=iva
  143. if( PCHAMP.NOMCHE(iva).eq.'EINF') leinf=iva
  144. if( PCHAMP.NOMCHE(iva).eq.'ESUP') lesup=iva
  145. enddo
  146. nbs2=1
  147. if(lemis.eq.0) then
  148. if( (leinf.eq.0.or.lesup.eq.0).and.nbst.ne.1) then
  149. moterr(1:4)='EMIS'
  150. call erreur( 77)
  151. return
  152. endif
  153. if(nbst.ne.1) nbs2=2
  154. endif
  155. if (nbs2.eq.1.and. nbst.eq.1) lemis =1
  156. IF (IIMPI.GE.4.AND.NBS2.GT.2) THEN
  157. WRITE(6,*) 'Dimensions incompatibles'
  158. ENDIF
  159.  
  160. IF (NBS2.EQ.2) THEN
  161. C **** Il y a des elements COQ ****
  162. DCHAM1 = PCHAMP.IELVAL(lesup)
  163. DCHAM2 = PCHAMP.IELVAL(leinf)
  164. SEGACT DCHAM1, DCHAM2
  165.  
  166. N1PTEL = DCHAM1.VELCHE(/1)
  167. N1EL = DCHAM1.VELCHE(/2)
  168.  
  169. IF (N1EL.EQ.1) THEN
  170. * write(6,*) 'k,, ADRES.V(K,3 dcham1', k , ADRES.V(K,3),dcham1
  171. DO 70 M = 1, ADRES.V(K,3)
  172. EMIS.VAL(N) = DCHAM1.VELCHE(1,1)
  173. IF (IIMPI.GE.4) THEN
  174. WRITE(6,*) 'EMIS =',EMIS.VAL(N)
  175. ENDIF
  176. N = N + 1
  177.  
  178. EMIS.VAL(N) = DCHAM2.VELCHE(1,1)
  179. IF (IIMPI.GE.4) THEN
  180. WRITE(6,*) 'EMIS =',EMIS.VAL(N)
  181. ENDIF
  182. N = N + 1
  183. 70 CONTINUE
  184. ENDIF
  185.  
  186. IF (N1EL.NE.1) THEN
  187. DO 75 M = 1, ADRES.V(K,3)
  188. EMIS.VAL(N) = DCHAM1.VELCHE(1,M)
  189. IF (IIMPI.GE.4) THEN
  190. WRITE(6,*) 'EMIS =',EMIS.VAL(N)
  191. ENDIF
  192. N = N + 1
  193.  
  194. EMIS.VAL(N) = DCHAM2.VELCHE(1,M)
  195. IF (IIMPI.GE.4) THEN
  196. WRITE(6,*) 'EMIS =',EMIS.VAL(N)
  197. ENDIF
  198. N = N + 1
  199. 75 CONTINUE
  200.  
  201. ENDIF
  202.  
  203. SEGDES DCHAM1, DCHAM2
  204.  
  205.  
  206. ENDIF
  207.  
  208. IF (NBS2.EQ.1) THEN
  209. C **** Il n'y a pas d'elements COQ ****
  210.  
  211. MOT = PCHAMP.NOMCHE(1)
  212. IF (IIMPI.GE.4) WRITE(6,*) 'MOT =',MOT
  213.  
  214. DCHAM = PCHAMP.IELVAL(1)
  215. SEGACT DCHAM
  216.  
  217. N1PTEL = DCHAM.VELCHE(/1)
  218. N1EL = DCHAM.VELCHE(/2)
  219.  
  220. IF (N1EL.EQ.1) THEN
  221. DO 90 M = 1, ADRES.V(K,3)
  222. EMIS.VAL(N) = DCHAM.VELCHE(1,1)
  223. IF (IIMPI.GE.4) THEN
  224. WRITE(6,*) 'EMIS =',EMIS.VAL(N)
  225. ENDIF
  226. N = N + 1
  227. 90 CONTINUE
  228. ENDIF
  229.  
  230. IF (N1EL.NE.1) THEN
  231. DO 95 M = 1, ADRES.V(K,3)
  232. EMIS.VAL(N) = DCHAM.VELCHE(1,M)
  233. IF (IIMPI.GE.4) THEN
  234. WRITE(6,*) 'EMIS =',EMIS.VAL(N)
  235. ENDIF
  236. N = N + 1
  237. 95 CONTINUE
  238.  
  239. ENDIF
  240. SEGDES DCHAM
  241. ENDIF
  242.  
  243. SEGDES PCHAMP
  244. 40 CONTINUE
  245.  
  246. IF (IIMPI.GE.4) THEN
  247. WRITE(6,*) 'Nombre de surfaces traitees', N - 1
  248. ENDIF
  249.  
  250. SEGDES MODL, EMIS, CHAMP
  251. SEGDES ADRES
  252.  
  253. RETURN
  254. END
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  

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