Télécharger hvit1.eso

Retour à la liste

Numérotation des lignes :

  1. C HVIT1 SOURCE CHAT 11/03/16 21:25:00 6902
  2. SUBROUTINE HVIT1(IPMODE,IPMAHY,IPGEOC,ICHP1,IPCHEL,IPGEOM,IRET)
  3. C-----------------------------------------------------------------------
  4. C Calcul de la vitesse au centre de chaque maille
  5. C-----------------------------------------------------------------------
  6. C
  7. C---------------------------
  8. C Parametres Entree/Sortie :
  9. C---------------------------
  10. C
  11. C E/ IPMODE : Pointeur vers l'objet MODELE
  12. C E/ IPMAHY : Segment contenant le pointeur vers le meleme des
  13. C connectivites elements/faces pour les zones du MMODEL
  14. C ou on a defini DARCY.
  15. C E/ IPGEOC : Pointeur vers l'objet maillage CENTRE
  16. C E/ ICHP1 : Champoint des debits orientes
  17. C E/ IPCHEL : Mchaml des orientations de normale (1=out,-1=in)
  18. C E/ IPGEOM : Pointeur vers l'objet maillage sommet (MAILLAGE)
  19. C /S IRET : Champoint resultat de composante SCAL
  20. C
  21. C----------------------
  22. C Tableaux de travail :
  23. C----------------------
  24. C
  25. C ICPR(I)=J : Le noeud I a le numero local J
  26. C Correspondance numerotation globale/locale
  27. C NNGOT : Nombre de noeuds total du domaine
  28. C
  29. C-----------------------------------------------------------------------
  30. C
  31. C Langage : ESOPE + FORTRAN77
  32. C
  33. C Auteurs : F.DABBENE 09/93
  34. C
  35. C-----------------------------------------------------------------------
  36. IMPLICIT INTEGER(I-N)
  37. IMPLICIT REAL*8 (A-H,O-Z)
  38. *
  39. -INC CCOPTIO
  40. -INC SMCHAML
  41. -INC SMCHPOI
  42. -INC SMCOORD
  43. -INC SMELEME
  44. -INC SMINTE
  45. -INC SMMODEL
  46. *
  47. CHARACTER*1 BLAN1
  48. *
  49. SEGMENT ICCPR
  50. INTEGER ICPR(NNGOT)
  51. ENDSEGMENT
  52. SEGMENT IPMAHY
  53. INTEGER MAHYBR(NSOUS)
  54. ENDSEGMENT
  55. SEGMENT HYBSTO
  56. REAL*8 HYBASE(NDIM,NBDDL,NBPP)
  57. ENDSEGMENT
  58. SEGMENT TRAV
  59. REAL*8 XE(3,NBNN)
  60. REAL*8 SHP(6,NBNN) , SHY(IDIM,NBDDL)
  61. REAL*8 ZJAC(IDIM,IDIM) , VECT(IDIM)
  62. ENDSEGMENT
  63. *
  64. BLAN1=' '
  65. *
  66. *= Creation des tableaux ICPR et INUI pour le CHAMPOINT d'entree
  67. *
  68. IK = 0
  69. NNGOT = XCOOR(/1)/(IDIM+1)
  70. SEGINI ICCPR
  71. MCHPOI = ICHP1
  72. SEGACT MCHPOI
  73. MSOUPO = IPCHP(1)
  74. SEGDES MCHPOI
  75. SEGACT MSOUPO
  76. NUMHAR = NOHARM(1)
  77. MPOVA1 = IPOVAL
  78. MELEME = IGEOC
  79. SEGACT MELEME
  80. N2 = NUM(/2)
  81. DO 10 I2=1,N2
  82. K = NUM(1,I2)
  83. IF (ICPR(K).EQ.0) THEN
  84. IK = IK + 1
  85. ICPR(K) = IK
  86. ENDIF
  87. 10 CONTINUE
  88. SEGDES MELEME
  89. SEGDES MSOUPO
  90. *
  91. *= Initialisation du CHAMPOINT resultat de nature DIFFUS
  92. *
  93. NSOUPO = 1
  94. NAT = 1
  95. SEGINI MCHPOI
  96. IRET = MCHPOI
  97. MTYPOI = 'CENTRE '
  98. DO 11 ITIT=1,72
  99. MOCHDE(ITIT:ITIT)=BLAN1
  100. 11 CONTINUE
  101. IFOPOI = IFOMOD
  102. JATTRI(1) = 1
  103. NC = IDIM
  104. SEGINI MSOUPO
  105. IPCHP(1) = MSOUPO
  106. SEGDES MCHPOI
  107. DO 20 I=1,NC
  108. NOHARM(I) = NUMHAR
  109. 20 CONTINUE
  110. IGEOC = IPGEOC
  111. NOCOMP(1) = 'VX '
  112. NOCOMP(2) = 'VY '
  113. IF (IDIM.EQ.3) NOCOMP(3) = 'VZ '
  114. IPT2 = IPGEOC
  115. SEGACT IPT2
  116. N = IPT2.NUM(/2)
  117. SEGDES IPT2
  118. SEGINI MPOVAL
  119. IPOVAL = MPOVAL
  120. SEGDES MSOUPO
  121. *
  122. *= Activation des segments MCHELM et MMODEL
  123. *
  124. MCHELM = IPCHEL
  125. SEGACT MCHELM
  126. MMODEL = IPMODE
  127. SEGACT MMODEL
  128. NBMAIL = KMODEL(/1)
  129. SEGACT MPOVA1
  130. *
  131. *---------------------------------------
  132. *= Boucle sur les maillages elementaires
  133. *---------------------------------------
  134. *
  135. ITELEM = 0
  136. SEGACT IPMAHY
  137. DO 90 IMAIL=1,NBMAIL
  138. IF (MAHYBR(IMAIL).EQ.0) GOTO 90
  139. *
  140. * Recuperation des informations issues du MODELE et du MCHAML
  141. * et du maillage sommet
  142. *
  143. IMODEL = KMODEL(IMAIL)
  144. SEGACT IMODEL
  145. IPT2 = IPGEOM
  146. IPT3 = IPGEOM
  147. IF(NBMAIL.GT.1) THEN
  148. SEGACT IPT3
  149. IPT2= IPT3.LISOUS(IMAIL)
  150. SEGDES IPT3
  151. ENDIF
  152. NEFHYB = NEFMOD
  153. NEF = NUMGEO(NEFHYB)
  154. SEGDES IMODEL
  155. *
  156. MELEME = MAHYBR(IMAIL)
  157. SEGACT MELEME
  158. NBDDL = NUM(/1)
  159. NBELEM = NUM(/2)
  160. SEGACT IPT2
  161. NBNN = IPT2.NUM(/1)
  162. *
  163. *- Récupération des fonctions de forme au centre de l'élément
  164. *
  165. SEGINI TRAV
  166. CALL RESHPT(1,NBNN,NEF,NEF,0,IPINTE,IRT1)
  167. CALL HYSHPT(NEFHYB,NBDDL,IPINTE,IPTHYB)
  168. MINTE = IPINTE
  169. SEGACT MINTE
  170. HYBSTO = IPTHYB
  171. SEGACT HYBSTO
  172. *-----------------------------------------
  173. *- Boucle sur les elements du sous domaine
  174. *-----------------------------------------
  175. MCHAML = ICHAML(IMAIL)
  176. SEGACT MCHAML
  177. MELVAL = IELVAL(1)
  178. SEGDES MCHAML
  179. SEGACT MELVAL
  180. NDIM = IDIM * (IDIM + 1)
  181. IGAU = 1
  182. DO 80 IEL=1,NBELEM
  183. ITELEM = ITELEM + 1
  184. CALL DOXE(XCOOR,IDIM,NBNN,IPT2.NUM,IEL,XE)
  185. CALL MHYBR3(IGAU,NBNN,NBDDL,NDIM,IDIM,IDIM,XE,HYBASE,
  186. S SHPTOT,SHY,SHP,ZJAC,DJAC)
  187. DO 70 IDDL=1,NBDDL
  188. DO 30 I=1,IDIM
  189. VECT(I) = 0.D0
  190. 30 CONTINUE
  191. DO 50 J=1,IDIM
  192. DO 40 I=1,IDIM
  193. VECT(I) = VECT(I) + ZJAC(I,J) * SHY(J,IDDL)
  194. 40 CONTINUE
  195. 50 CONTINUE
  196. QDDL = MPOVA1.VPOCHA(ICPR(NUM(IDDL,IEL)),1)
  197. ORIEN = VELCHE(IDDL,IEL)
  198. COEF = QDDL * ORIEN / ABS(DJAC)
  199. DO 60 I=1,IDIM
  200. VPOCHA(ITELEM,I) = VPOCHA(ITELEM,I) + COEF * VECT(I)
  201. 60 CONTINUE
  202. 70 CONTINUE
  203. 80 CONTINUE
  204. SEGSUP TRAV, HYBSTO, MINTE
  205. SEGDES MELVAL
  206. SEGDES MELEME, IPT2
  207. 90 CONTINUE
  208. SEGDES MPOVAL
  209. SEGDES MPOVA1, MCHELM, MMODEL, IPMAHY
  210. SEGSUP ICCPR
  211. *
  212. RETURN
  213. END
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  

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