Télécharger kcha1.eso

Retour à la liste

Numérotation des lignes :

  1. C KCHA1 SOURCE PV 09/03/12 21:25:58 6325
  2. SUBROUTINE KCHA1(MTRAV,IPGEOM,IPRESU)
  3. C-----------------------------------------------------------------------
  4. C Transforme un CHPO de support CENTRE en un MCHAML constant par élément
  5. C Le maillage IPGEOM est le maillage à partir duquel les points CENTRE
  6. C sont créés (verification faite dans kcha.eso).
  7. C-----------------------------------------------------------------------
  8. C
  9. C---------------------------
  10. C Paramètres Entrée/Sortie :
  11. C---------------------------
  12. C
  13. C E/ MTRAV : Segment de travail du CHPO de support centre.
  14. C Les valeurs du ième point de MTRAV sont
  15. C à affecter au ième élément de IPGEOM.
  16. C E/ IPGEOM : Support du MCHAML
  17. C /S IPRESU : Contient le MCHAML résultat de support IPGEOM
  18. C
  19. C----------------------
  20. C Variables en COMMON :
  21. C----------------------
  22. C
  23. C E/ IFOUR : cf CCOPTIO
  24. C E/ NIFOUR : cf CCOPTIO
  25. C
  26. C-----------------------------------------------------------------------
  27. C
  28. C Langage : ESOPE + FORTRAN77
  29. C
  30. C Auteurs : F.DABBENE
  31. C
  32. C-----------------------------------------------------------------------
  33. IMPLICIT INTEGER(I-N)
  34. IMPLICIT REAL*8 (A-H,O-Z)
  35. C
  36. -INC CCOPTIO
  37. -INC SMCHAML
  38. -INC SMCHPOI
  39. -INC SMELEME
  40. -INC TMTRAV
  41. C
  42. C- Initialisations
  43. C
  44. IELEM = 0
  45. ISTOP = 0
  46. MELEME = IPGEOM
  47. SEGACT MELEME
  48. NBSOUS = LISOUS(/1)
  49. IF (NBSOUS.EQ.0) NBSOUS=1
  50. C
  51. C - Création du MCHELM
  52. C
  53. C - Récupération du nombre total de composantes dans MTRAV
  54. C - Approximation d'une seule harmonique.
  55. C
  56. SEGACT MTRAV
  57. NNIN = IBIN(/1)
  58. C
  59. C - Création par zone élémentaire
  60. C
  61. L1 = 8
  62. N1 = NBSOUS
  63. N3 = 6
  64. SEGINI MCHELM
  65. IPRESU = MCHELM
  66. TITCHE = 'SCALAIRE'
  67. IFOCHE = IFOUR
  68. IF (NBSOUS.EQ.1) THEN
  69. NBNN = NUM(/1)
  70. MELE = ITYPEL
  71. IELE = NUMGEO(MELE)
  72. IMACHE(1) = MELEME
  73. N2 = NNIN
  74. SEGINI MCHAML
  75. DO 5 ICOMP=1,NNIN
  76. NOMCHE(ICOMP) = INCO(ICOMP)
  77. 5 CONTINUE
  78. ICHAML(1) = MCHAML
  79. CONCHE(1) = ' '
  80. INFCHE(1,1) = 0
  81. INFCHE(1,2) = 0
  82. INFCHE(1,3) = NIFOUR
  83. ISTOP = ISTOP + 1
  84. CALL RESHPT(1,NBNN,IELE,MELE,0,MINTE,IRT1)
  85. IF (IRT1.EQ.0) GOTO 100
  86. INFCHE(1,4) = MINTE
  87. INFCHE(1,5) = 0
  88. INFCHE(1,6) = 2
  89. SEGDES MCHAML
  90. ELSE
  91. IPOS = 0
  92. DO 10 I=1,NBSOUS
  93. IPT1 = LISOUS(I)
  94. SEGACT IPT1
  95. NBNN = IPT1.NUM(/1)
  96. NBELEM = IPT1.NUM(/2)
  97. MELE = IPT1.ITYPEL
  98. IELE = NUMGEO(MELE)
  99. IMACHE(I) = IPT1
  100. SEGDES IPT1
  101. CONCHE(I) = ' '
  102. N2 = NNIN
  103. SEGINI MCHAML
  104. C - Recherche du nombre de composantes réellement dans la zone :
  105. C On ne conserve que les composantes ayant une valeur pour au moins un
  106. C point du sous-maillage
  107. IN2 = 0
  108. DO 20 ICOMP=1,NNIN
  109. DO 30 NEL=1,NBELEM
  110. IF (IBIN(ICOMP,IPOS+NEL).EQ.1) THEN
  111. IN2 = IN2 + 1
  112. NOMCHE(IN2) = INCO(ICOMP)
  113. GOTO 20
  114. ENDIF
  115. 30 CONTINUE
  116. 20 CONTINUE
  117. C On ajuste la taille du MCHAML au nouveau nombre de composantes
  118. N2 = IN2
  119. SEGADJ MCHAML
  120. ICHAML(I) = MCHAML
  121. INFCHE(I,1) = 0
  122. INFCHE(I,2) = 0
  123. INFCHE(I,3) = NIFOUR
  124. ISTOP = ISTOP + 1
  125. CALL RESHPT(1,NBNN,IELE,MELE,0,MINTE,IRT1)
  126. IF (IRT1.EQ.0) GOTO 100
  127. INFCHE(I,4) = MINTE
  128. INFCHE(I,5) = 0
  129. INFCHE(I,6) = 2
  130. SEGDES MCHAML
  131. IPOS = IPOS + NBELEM
  132. 10 CONTINUE
  133. ENDIF
  134. SEGDES MELEME
  135. C
  136. C- Remplissage du MCHAML et du MELVAL de chaque sous zone
  137. C
  138. DO 40 I=1,NBSOUS
  139. MELEME = IMACHE(I)
  140. MCHAML = ICHAML(I)
  141. SEGACT MELEME
  142. SEGACT MCHAML*MOD
  143. N2 = NOMCHE(/2)
  144. N1PTEL = 1
  145. N1EL = MELEME.NUM(/2)
  146. N2PTEL = 0
  147. N2EL = 0
  148.  
  149. DO 50 ICOMP=1,N2
  150. SEGINI MELVAL
  151. TYPCHE(ICOMP) = 'REAL*8'
  152. IELVAL(ICOMP) = MELVAL
  153. IF (NBSOUS.EQ.1) THEN
  154. IPOS = ICOMP
  155. ELSE
  156. CALL PLACE(INCO,NNIN,IPOS,NOMCHE(ICOMP))
  157. ENDIF
  158. IPOS1 = IELEM
  159. DO 60 NEL=1,N1EL
  160. IPOS1 = IPOS1 + 1
  161. VELCHE(1,NEL) = BB(IPOS,IPOS1)
  162. 60 CONTINUE
  163. SEGDES MELVAL
  164. 50 CONTINUE
  165. SEGDES MCHAML
  166. SEGDES MELEME
  167. IELEM = IELEM + N1EL
  168. 40 CONTINUE
  169. SEGDES MCHELM
  170. SEGSUP MTRAV
  171. RETURN
  172. C
  173. C- Ménage en cas d'erreur
  174. C
  175. 100 CONTINUE
  176. SEGDES MCHAML
  177. SEGDES MCHELM
  178. SEGDES MELEME
  179. IPRESU = 0
  180. C
  181. RETURN
  182. END
  183.  
  184.  
  185.  

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