Télécharger echi1.eso

Retour à la liste

Numérotation des lignes :

  1. C ECHI1 SOURCE MAGN 17/02/24 21:15:07 9323
  2. SUBROUTINE ECHI1(IKAS,IVOL1,MTAB1,MTAB2,MPOVA1,MPOVA2,IKH,IKT,
  3. & MELEMD,MELEVF,MLENTI,MLENT1,NOMD)
  4. C-----------------------------------------------------------------------
  5. C Discrétisation de l'opérateur ECHIMP en explicite EFM1 et VF, le
  6. C coeff d'échange étant un SCAL ou CHPO CENTRE, le champ exterieur
  7. C un SCAL, un CHPO CENTRE ou un CHPO SOMMET.
  8. C-----------------------------------------------------------------------
  9. C
  10. C--------------------
  11. C Paramètres Entrée :
  12. C--------------------
  13. C
  14. C E/ IKAS : Type de situation à traiter (1=EF, 2 ou 3=VF)
  15. C E/ IVOL1 : Type d'échange (0=surfacique, 1=volumique)
  16. C E/ MTAB1 : Pointeur de la table EQEX
  17. C E/ MTAB2 : Pointeur de la table DOMAINE locale
  18. C E/ MPOVA1 : MPOVAL des valeurs du coefficient d'échange
  19. C E/ MPOVA2 : MPOVAL des valeurs du champ exterieur
  20. C E/ IKH : Forme originel du coefficient d'échange
  21. C (0=CHPO CENTRE, 1=FLOTTANT)
  22. C E/ IKT : Forme originel du champ exterieur
  23. C (0=CHPO CENTRE, 1=FLOTTANT, 4=CHPO SOMMET)
  24. C E/ MELEMD : Pointeur du spg de l'inconnue
  25. C E/ MELEVF : Pointeur vers les points CENTRE du maillage volumique
  26. C en correspondance avec les points CENTRE surfacique
  27. C (Utilisé en Formulation VF et échange surfacique)
  28. C E/ MLENTI : Correspondance numéotation globale/numérotation locale
  29. C LECT(I)=J : le point numéro I est le Jième de MELEMD
  30. C E/ MLENT1 : Idem MLENTI pour le spg du champ exterieur
  31. C (Utilisé lorsque le champ exterieur est au SOMMET)
  32. C E/ NOMD : Nom de l'inconnue
  33. C
  34. C------------------
  35. C Champs calculés :
  36. C------------------
  37. C
  38. C MPOVA3 : MPOVAL des valeurs de la matrice diagonale
  39. C Stocké à l'indice NOMD de la table KIZG1
  40. C MPOVA4 : MPOVAL des valeurs du second membre
  41. C Stocké à l'indice NOMD de la table KIZG
  42. C
  43. C-----------------------------------------------------------------------
  44. IMPLICIT INTEGER(I-N)
  45. IMPLICIT REAL*8 (A-H,O-Z)
  46. C
  47. -INC CCOPTIO
  48. -INC SMCHPOI
  49. -INC SMCHAML
  50. -INC SMELEME
  51. POINTEUR MELEMD.MELEME
  52. -INC SMLENTI
  53. C
  54. CHARACTER*8 NOMD,TYPE,TYPC,TYPS
  55. C
  56. C- Initialisations
  57. C
  58. NBCOMP = 1
  59. IF (IKAS.EQ.1) THEN
  60. TYPS = 'SOMMET '
  61. ELSE
  62. TYPS = 'CENTRE '
  63. ENDIF
  64. C
  65. NRIGE=7
  66. NKID =9
  67. NKMT =7
  68. NMATRI=1
  69. SEGINI MATRIK
  70. IRIGEL(1,1)=MELEMD
  71. IRIGEL(2,1)=MELEMD
  72. IRIGEL(7,1)=5
  73. NBME=1
  74. NBSOUS=1
  75. SEGINI IMATRI
  76. IRIGEL(4,1)=IMATRI
  77. SEGACT MELEMD
  78. KSPGP=MELEMD
  79. KSPGD=MELEMD
  80. LISPRI(1)=NOMD
  81. LISDUA(1)=NOMD
  82. NP=1
  83. MP=1
  84. NBEL=MELEMD.NUM(/2)
  85. SEGINI IZAFM
  86. LIZAFM(1,1)=IZAFM
  87. LIZAFM(1,1)=IZAFM
  88. SEGDES MATRIK,IMATRI
  89. CALL KRCHPT(TYPS,MELEMD,NBCOMP,IZG,NOMD(1:4))
  90. CALL LICHTM(IZG,MPOVA4,TYPC,IGEOM)
  91. C
  92. C- Activation
  93. C
  94. SEGACT MPOVA1
  95. SEGACT MPOVA2
  96. SEGACT MLENTI
  97. SEGACT MLENT1
  98. C
  99. C----------------------------------------------------------------------
  100. C- Traitement d'une formulation EF ou EMM1 explicite, le champ
  101. C- exterieur étant 1) un SCAL ou un CHPO CENTRE, 2) un CHPO SOMMET.
  102. C- Dans les deux cas, l'indice XXPSOML de la table domaine local suffit
  103. C- (contient l'intégrale sur chaque élément des fonctions de forme).
  104. C- En effet, en explicite les matrices masses sont condensées (EF=EFM1)
  105. C----------------------------------------------------------------------
  106. C
  107. IF (IKAS.EQ.1) THEN
  108. CALL LEKTAB(MTAB2,'MAILLAGE',MELEME)
  109. CALL LEKTAB(MTAB2,'XXPSOML ',MCHELM)
  110. IF (IERR.NE.0) RETURN
  111. SEGACT MCHELM
  112. SEGACT MELEME
  113. NBSOUS = LISOUS(/1)
  114. IF (NBSOUS.EQ.0) NBSOUS=1
  115. NUTOEL = 0
  116. DO 30 L=1,NBSOUS
  117. IPT1 = MELEME
  118. IF (NBSOUS.NE.1) IPT1=LISOUS(L)
  119. SEGACT IPT1
  120. NP = IPT1.NUM(/1)
  121. NBEL = IPT1.NUM(/2)
  122. MCHAML = ICHAML(L)
  123. SEGACT MCHAML
  124. MELVAL = IELVAL(1)
  125. SEGACT MELVAL
  126. DO 20 K=1,NBEL
  127. NK = NUTOEL + K
  128. KPOS = 1 + (1-IKH)*(NK-1)
  129. DO 10 I=1,NP
  130. II = IPT1.NUM(I,K)
  131. IPOS = LECT(II)
  132. VAL1 = MPOVA1.VPOCHA(KPOS,1)*VELCHE(I,K)
  133. AM(IPOS,1,1) = AM(IPOS,1,1) + VAL1
  134. IF (IKT.EQ.4) THEN
  135. JPOS = MLENT1.LECT(II)
  136. ELSE
  137. JPOS = 1 + (1-IKT)*(NK-1)
  138. ENDIF
  139. VAL2 = VAL1 * MPOVA2.VPOCHA(JPOS,1)
  140. MPOVA4.VPOCHA(IPOS,1) = MPOVA4.VPOCHA(IPOS,1) + VAL2
  141. 10 CONTINUE
  142. 20 CONTINUE
  143. SEGDES IPT1
  144. SEGDES MCHAML,MELVAL
  145. NUTOEL = NUTOEL + NBEL
  146. 30 CONTINUE
  147. IF (NBSOUS.NE.1) SEGDES MELEME
  148. SEGDES MCHELM
  149. C
  150. C----------------------------------------------------------------------
  151. C- Traitement d'une formulation VF Explicite, le champ exterieur étant
  152. C- 1) un SCAL ou un CHPO CENTRE, 2) un CHPO SOMMET.
  153. C-
  154. C- Le traitement différe pour le second membre :
  155. C- Dans le premier cas, l'indice XXVOLUM de la table domaine local,
  156. C- utilisé pour calculer la matrice suffit (contient le volume de
  157. C- chaque élément). Dans le deuxième cas, on a également besoin de
  158. C- l'indice XXPSOML que l'on sature par le champ exterieur au sommet.
  159. C-
  160. C- Le spg des champoints résultats dépend du type d'échange :
  161. C- Lorsque l'échange est volumique, les points CENTRE de la table
  162. C- domaine local sont à considerer. En surfacique, on a construit
  163. C- la correspondance entre centre(volume)-centre(surface); les CENTRE
  164. C- des volumes concernés sont rangés dans MELEVF.
  165. C----------------------------------------------------------------------
  166. C
  167. ELSE
  168. CALL LEKTAB(MTAB2,'XXVOLUM ',MCHPOI)
  169. CALL LICHTL(MCHPOI,MPOVA5,TYPC,MELEMC)
  170. IF (IVOL1.EQ.0) THEN
  171. IPT2 = MELEVF
  172. ELSE
  173. IPT2 = MELEMC
  174. ENDIF
  175. SEGACT IPT2
  176. IF (IKT.EQ.0 .OR. IKT.EQ.1) THEN
  177. NBEL = IPT2.NUM(/2)
  178. DO 40 K=1,NBEL
  179. IPOS = LECT(IPT2.NUM(1,K))
  180. KPOS = 1 + (1-IKH)*(K-1)
  181. KTEX = 1 + (1-IKT)*(K-1)
  182. VAL1 = MPOVA1.VPOCHA(KPOS,1) * MPOVA5.VPOCHA(K,1)
  183. AM(IPOS,1,1) = AM(IPOS,1,1) + VAL1
  184. VAL2 = MPOVA2.VPOCHA(KTEX,1) * VAL1
  185. MPOVA4.VPOCHA(IPOS,1) = MPOVA4.VPOCHA(IPOS,1) + VAL2
  186. 40 CONTINUE
  187. ELSE
  188. CALL LEKTAB(MTAB2,'MAILLAGE',MELEME)
  189. CALL LEKTAB(MTAB2,'XXPSOML ',MCHELM)
  190. IF (IERR.NE.0) RETURN
  191. SEGACT MCHELM
  192. SEGACT MELEME
  193. NBSOUS = LISOUS(/1)
  194. IF (NBSOUS.EQ.0) NBSOUS=1
  195. NUTOEL = 0
  196. DO 70 L=1,NBSOUS
  197. IPT1 = MELEME
  198. IF (NBSOUS.NE.1) IPT1=LISOUS(L)
  199. SEGACT IPT1
  200. NP = IPT1.NUM(/1)
  201. NBEL = IPT1.NUM(/2)
  202. MCHAML = ICHAML(L)
  203. SEGACT MCHAML
  204. MELVAL = IELVAL(1)
  205. SEGACT MELVAL
  206. DO 60 K=1,NBEL
  207. NK = NUTOEL + K
  208. IPOS = LECT(IPT2.NUM(1,NK))
  209. KPOS = 1 + (1-IKH)*(NK-1)
  210. VAL1 = MPOVA1.VPOCHA(KPOS,1) * MPOVA5.VPOCHA(NK,1)
  211. AM(IPOS,1,1) = AM(IPOS,1,1) + VAL1
  212. VAL2 = 0.D0
  213. DO 50 I=1,NP
  214. II = IPT1.NUM(I,K)
  215. JPOS = MLENT1.LECT(II)
  216. VAL2 = VAL2 + MPOVA1.VPOCHA(KPOS,1)
  217. & * MPOVA2.VPOCHA(JPOS,1) * VELCHE(I,K)
  218. 50 CONTINUE
  219. MPOVA4.VPOCHA(IPOS,1) = MPOVA4.VPOCHA(IPOS,1) + VAL2
  220. 60 CONTINUE
  221. NUTOEL = NUTOEL + NBEL
  222. SEGDES IPT1
  223. SEGDES MELVAL,MCHAML
  224. 70 CONTINUE
  225. IF (NBSOUS.NE.1) SEGDES MELEME
  226. SEGDES MCHELM
  227. ENDIF
  228. SEGDES IPT2
  229. SEGDES MPOVA5
  230. ENDIF
  231. C
  232. C- Désactivation
  233. C
  234. SEGDES MPOVA1
  235. SEGDES MPOVA2
  236. SEGDES MPOVA4
  237. SEGSUP MLENTI
  238. SEGSUP MLENT1
  239. C
  240. CALL ECROBJ('MATRIK',MATRIK)
  241. CALL ECROBJ('CHPOINT',IZG)
  242.  
  243. RETURN
  244. END
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  

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