Télécharger kcha1.eso

Retour à la liste

Numérotation des lignes :

  1. C KCHA1 SOURCE CB215821 18/09/11 21:15:18 9913
  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.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC SMCHAML
  40. -INC SMCHPOI
  41. -INC SMELEME
  42. -INC TMTRAV
  43. C
  44. C- Initialisations
  45. C
  46. IELEM = 0
  47. ISTOP = 0
  48. MELEME = IPGEOM
  49. SEGACT MELEME
  50. NBSOUS = LISOUS(/1)
  51. IF (NBSOUS.EQ.0) NBSOUS=1
  52. C
  53. C - Création du MCHELM
  54. C
  55. C - Récupération du nombre total de composantes dans MTRAV
  56. C - Approximation d'une seule harmonique.
  57. C
  58. SEGACT MTRAV
  59. NNIN = IBIN(/1)
  60. C
  61. C - Création par zone élémentaire
  62. C
  63. L1 = 8
  64. N1 = NBSOUS
  65. N3 = 6
  66. SEGINI MCHELM
  67. IPRESU = MCHELM
  68. TITCHE = 'SCALAIRE'
  69. IFOCHE = IFOUR
  70. IF (NBSOUS.EQ.1) THEN
  71. NBNN = NUM(/1)
  72. MELE = ITYPEL
  73. IELE = NUMGEO(MELE)
  74. IMACHE(1) = MELEME
  75. N2 = NNIN
  76. SEGINI MCHAML
  77. DO 5 ICOMP=1,NNIN
  78. NOMCHE(ICOMP) = INCO(ICOMP)
  79. 5 CONTINUE
  80. ICHAML(1) = MCHAML
  81. CONCHE(1) = ' '
  82. INFCHE(1,1) = 0
  83. INFCHE(1,2) = 0
  84. INFCHE(1,3) = NIFOUR
  85. ISTOP = ISTOP + 1
  86. CALL RESHPT(1,NBNN,IELE,MELE,0,MINTE,IRT1)
  87. IF (IRT1.EQ.0) GOTO 100
  88. INFCHE(1,4) = MINTE
  89. INFCHE(1,5) = 0
  90. INFCHE(1,6) = 2
  91. SEGACT MCHAML
  92. ELSE
  93. IPOS = 0
  94. DO 10 I=1,NBSOUS
  95. IPT1 = LISOUS(I)
  96. SEGACT IPT1
  97. NBNN = IPT1.NUM(/1)
  98. NBELEM = IPT1.NUM(/2)
  99. MELE = IPT1.ITYPEL
  100. IELE = NUMGEO(MELE)
  101. IMACHE(I) = IPT1
  102. SEGACT IPT1
  103. CONCHE(I) = ' '
  104. N2 = NNIN
  105. SEGINI MCHAML
  106. C - Recherche du nombre de composantes réellement dans la zone :
  107. C On ne conserve que les composantes ayant une valeur pour au moins un
  108. C point du sous-maillage
  109. IN2 = 0
  110. DO 20 ICOMP=1,NNIN
  111. DO 30 NEL=1,NBELEM
  112. IF (IBIN(ICOMP,IPOS+NEL).EQ.1) THEN
  113. IN2 = IN2 + 1
  114. NOMCHE(IN2) = INCO(ICOMP)
  115. GOTO 20
  116. ENDIF
  117. 30 CONTINUE
  118. 20 CONTINUE
  119. C On ajuste la taille du MCHAML au nouveau nombre de composantes
  120. N2 = IN2
  121. SEGADJ MCHAML
  122. ICHAML(I) = MCHAML
  123. INFCHE(I,1) = 0
  124. INFCHE(I,2) = 0
  125. INFCHE(I,3) = NIFOUR
  126. ISTOP = ISTOP + 1
  127. CALL RESHPT(1,NBNN,IELE,MELE,0,MINTE,IRT1)
  128. IF (IRT1.EQ.0) GOTO 100
  129. INFCHE(I,4) = MINTE
  130. INFCHE(I,5) = 0
  131. INFCHE(I,6) = 2
  132. SEGACT MCHAML
  133. IPOS = IPOS + NBELEM
  134. 10 CONTINUE
  135. ENDIF
  136. SEGACT MELEME
  137. C
  138. C- Remplissage du MCHAML et du MELVAL de chaque sous zone
  139. C
  140. DO 40 I=1,NBSOUS
  141. MELEME = IMACHE(I)
  142. MCHAML = ICHAML(I)
  143. SEGACT MELEME
  144. SEGACT MCHAML*MOD
  145. N2 = NOMCHE(/2)
  146. N1PTEL = 1
  147. N1EL = MELEME.NUM(/2)
  148. N2PTEL = 0
  149. N2EL = 0
  150.  
  151. DO 50 ICOMP=1,N2
  152. SEGINI MELVAL
  153. TYPCHE(ICOMP) = 'REAL*8'
  154. IELVAL(ICOMP) = MELVAL
  155. IF (NBSOUS.EQ.1) THEN
  156. IPOS = ICOMP
  157. ELSE
  158. CALL PLACE(INCO,NNIN,IPOS,NOMCHE(ICOMP))
  159. ENDIF
  160. IPOS1 = IELEM
  161. DO 60 NEL=1,N1EL
  162. IPOS1 = IPOS1 + 1
  163. VELCHE(1,NEL) = BB(IPOS,IPOS1)
  164. 60 CONTINUE
  165. SEGACT MELVAL
  166. 50 CONTINUE
  167. SEGACT MCHAML
  168. SEGACT MELEME
  169. IELEM = IELEM + N1EL
  170. 40 CONTINUE
  171. SEGACT MCHELM
  172. SEGSUP MTRAV
  173. RETURN
  174. C
  175. C- Ménage en cas d'erreur
  176. C
  177. 100 CONTINUE
  178. SEGACT MCHAML
  179. SEGACT MCHELM
  180. SEGACT MELEME
  181. IPRESU = 0
  182. C
  183. RETURN
  184. END
  185.  
  186.  
  187.  
  188.  

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