Télécharger rlence.eso

Retour à la liste

Numérotation des lignes :

  1. C RLENCE SOURCE KK2000 14/04/10 21:15:37 8032
  2. SUBROUTINE RLENCE(MELCEN,MELTFA,MELFAC,MFACEL,MELEME)
  3. C
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : RLENCE
  9. C
  10. C DESCRIPTION : Cette subroutine est appellée par la subroutine
  11. C GRADGE (calcul des coefficient pour le gradient
  12. C d'un CHPOINT 'CENTRE')
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  15. C
  16. C AUTEUR : A. Beccantini, SFME/LTMF
  17. C
  18. C************************************************************************
  19. C
  20. C
  21. C APPELES (Outils) :
  22. C
  23. C APPELES (Calcul) :
  24. C
  25. C
  26. C************************************************************************
  27. C
  28. C INPUT : ICEN : 'CENTRE' points
  29. C
  30. C IELTFA : Element-faces
  31. C
  32. C IFAC : 'FACE' points
  33. C
  34. C IFACEL : Left center - face center -right center
  35. C
  36. C
  37. C OUTPUT : MELEME : stencil to compute gradient
  38. C
  39. C************************************************************************
  40. C
  41. C HISTORIQUE (Anomalies et modifications éventuelles)
  42. C
  43. C HISTORIQUE : 04.07.2003
  44. C
  45. C************************************************************************
  46. C
  47. IMPLICIT INTEGER(I-N)
  48. IMPLICIT REAL*8(A-H,O-Z)
  49.  
  50. C
  51. INTEGER NBSOUS, NSOU, JG, NBNN, NBELEM, NBREF
  52. & ,NGVOI,NLVOI,NCENG,NCEND, NCEN
  53. & ,ISOUS, ICEN, IELEM, IVOI
  54. C
  55. -INC CCOPTIO
  56. -INC SMLENTI
  57. -INC SMELEME
  58. POINTEUR MELCEN.MELEME,MELTFA.MELEME,MELFAC.MELEME,MFACEL.MELEME
  59. POINTEUR MLELTF.MLENTI, MLEFAC.MLENTI
  60.  
  61. C
  62. SEGACT MELCEN
  63. SEGACT MELTFA
  64. SEGACT MFACEL
  65. C
  66. CALL KRIPAD(MELFAC,MLEFAC)
  67. C SEGINI MLEFAC
  68. SEGACT MELFAC
  69. C
  70. C MELEME has the same structure than 'ELTFA'
  71. C Each element of MELEME has one point more than each element of
  72. C 'ELTFA'
  73. C
  74. NBSOUS=MELTFA.LISOUS(/1)
  75. NSOU=MAX(NBSOUS,1)
  76. JG=NSOU
  77. SEGINI MLENTI
  78. SEGINI MLELTF
  79. C
  80. C**** MLENTI contains the pointers of the elementary meshes
  81. C of ELTFA
  82. C
  83. IF (NSOU.EQ.1)THEN
  84. MLENTI.LECT(1)=MELTFA
  85. ELSE
  86. DO ISOUS=1,NSOU,1
  87. IPT1=MELTFA.LISOUS(ISOUS)
  88. MLENTI.LECT(ISOUS)=IPT1
  89. ENDDO
  90. ENDIF
  91. C
  92. ICEN=0
  93. DO ISOUS=1,NSOU,1
  94. IPT1=MLENTI.LECT(ISOUS)
  95. SEGACT IPT1
  96. NBNN=IPT1.NUM(/1)+1
  97. NBELEM=IPT1.NUM(/2)
  98. NBREF=0
  99. NBSOUS=0
  100. SEGINI IPT2
  101. MLELTF.LECT(ISOUS)=IPT2
  102. C POLY elts
  103. IPT2.ITYPEL=32
  104. DO IELEM=1,NBELEM,1
  105. ICEN=ICEN+1
  106. NCEN=MELCEN.NUM(1,ICEN)
  107. IPT2.NUM(NBNN,IELEM)=NCEN
  108. DO IVOI=1,NBNN-1,1
  109. NGVOI=IPT1.NUM(IVOI,IELEM)
  110. NLVOI=MLEFAC.LECT(NGVOI)
  111. NCENG=MFACEL.NUM(1,NLVOI)
  112. NCEND=MFACEL.NUM(3,NLVOI)
  113. IF(NCENG .EQ. NCEND)THEN
  114. C
  115. C**************** We are on the BC
  116. C
  117. IF(NCEND .NE. NCEN)THEN
  118. WRITE(IOIMP,*) 'subroutine rlence.eso. 1'
  119. CALL ERREUR(5)
  120. GOTO 9999
  121. ENDIF
  122. IPT2.NUM(IVOI,IELEM)=NGVOI
  123. ELSEIF(NCENG .EQ. NCEN)THEN
  124. IPT2.NUM(IVOI,IELEM)=NCEND
  125. ELSEIF(NCEND .EQ. NCEN)THEN
  126. IPT2.NUM(IVOI,IELEM)=NCENG
  127. ELSE
  128. WRITE(IOIMP,*) 'subroutine rlence.eso. 2'
  129. CALL ERREUR(5)
  130. GOTO 9999
  131. ENDIF
  132. ENDDO
  133. ENDDO
  134. SEGDES IPT1
  135. SEGDES IPT2
  136. ENDDO
  137. C
  138. SEGDES MELCEN
  139. SEGDES MELTFA
  140. SEGDES MELFAC
  141. SEGDES MFACEL
  142. SEGSUP MLENTI
  143. SEGSUP MLEFAC
  144. C
  145. IF(NSOU .EQ. 1)THEN
  146. MELEME=MLELTF.LECT(1)
  147. ELSE
  148. NBNN=0
  149. NBELEM=0
  150. NBSOUS=NSOU
  151. NBREF=0
  152. SEGINI MELEME
  153. DO ISOUS=1,NSOU,1
  154. MELEME.LISOUS(ISOUS)=MLELTF.LECT(ISOUS)
  155. ENDDO
  156. SEGDES MELEME
  157. ENDIF
  158. C
  159. SEGSUP MLELTF
  160. C
  161. 9999 RETURN
  162. END
  163.  
  164.  
  165.  
  166.  

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