Télécharger hvit1.eso

Retour à la liste

Numérotation des lignes :

  1. C HVIT1 SOURCE PV 20/03/30 21:19:50 10567
  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.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC SMCHAML
  43. -INC SMCHPOI
  44. -INC SMCOORD
  45. -INC SMELEME
  46. -INC SMINTE
  47. -INC SMMODEL
  48. *
  49. CHARACTER*1 BLAN1
  50. *
  51. SEGMENT ICCPR
  52. INTEGER ICPR(NNGOT)
  53. ENDSEGMENT
  54. SEGMENT IPMAHY
  55. INTEGER MAHYBR(NSOUS)
  56. ENDSEGMENT
  57. SEGMENT HYBSTO
  58. REAL*8 HYBASE(NDIM,NBDDL,NBPP)
  59. ENDSEGMENT
  60. SEGMENT TRAV
  61. REAL*8 XE(3,NBNN)
  62. REAL*8 SHP(6,NBNN) , SHY(IDIM,NBDDL)
  63. REAL*8 ZJAC(IDIM,IDIM) , VECT(IDIM)
  64. ENDSEGMENT
  65. *
  66. BLAN1=' '
  67. *
  68. *= Creation des tableaux ICPR et INUI pour le CHAMPOINT d'entree
  69. *
  70. IK = 0
  71. NNGOT = nbpts
  72. SEGINI ICCPR
  73. MCHPOI = ICHP1
  74. SEGACT MCHPOI
  75. MSOUPO = IPCHP(1)
  76. SEGDES MCHPOI
  77. SEGACT MSOUPO
  78. NUMHAR = NOHARM(1)
  79. MPOVA1 = IPOVAL
  80. MELEME = IGEOC
  81. SEGACT MELEME
  82. N2 = NUM(/2)
  83. DO 10 I2=1,N2
  84. K = NUM(1,I2)
  85. IF (ICPR(K).EQ.0) THEN
  86. IK = IK + 1
  87. ICPR(K) = IK
  88. ENDIF
  89. 10 CONTINUE
  90. SEGDES MELEME
  91. SEGDES MSOUPO
  92. *
  93. *= Initialisation du CHAMPOINT resultat de nature DIFFUS
  94. *
  95. NSOUPO = 1
  96. NAT = 1
  97. SEGINI MCHPOI
  98. IRET = MCHPOI
  99. MTYPOI = 'CENTRE '
  100. DO 11 ITIT=1,72
  101. MOCHDE(ITIT:ITIT)=BLAN1
  102. 11 CONTINUE
  103. IFOPOI = IFOMOD
  104. JATTRI(1) = 1
  105. NC = IDIM
  106. SEGINI MSOUPO
  107. IPCHP(1) = MSOUPO
  108. SEGDES MCHPOI
  109. DO 20 I=1,NC
  110. NOHARM(I) = NUMHAR
  111. 20 CONTINUE
  112. IGEOC = IPGEOC
  113. NOCOMP(1) = 'VX '
  114. NOCOMP(2) = 'VY '
  115. IF (IDIM.EQ.3) NOCOMP(3) = 'VZ '
  116. IPT2 = IPGEOC
  117. SEGACT IPT2
  118. N = IPT2.NUM(/2)
  119. SEGDES IPT2
  120. SEGINI MPOVAL
  121. IPOVAL = MPOVAL
  122. SEGDES MSOUPO
  123. *
  124. *= Activation des segments MCHELM et MMODEL
  125. *
  126. MCHELM = IPCHEL
  127. SEGACT MCHELM
  128. MMODEL = IPMODE
  129. SEGACT MMODEL
  130. NBMAIL = KMODEL(/1)
  131. SEGACT MPOVA1
  132. *
  133. *---------------------------------------
  134. *= Boucle sur les maillages elementaires
  135. *---------------------------------------
  136. *
  137. ITELEM = 0
  138. SEGACT IPMAHY
  139. DO 90 IMAIL=1,NBMAIL
  140. IF (MAHYBR(IMAIL).EQ.0) GOTO 90
  141. *
  142. * Recuperation des informations issues du MODELE et du MCHAML
  143. * et du maillage sommet
  144. *
  145. IMODEL = KMODEL(IMAIL)
  146. SEGACT IMODEL
  147. IPT2 = IPGEOM
  148. IPT3 = IPGEOM
  149. IF(NBMAIL.GT.1) THEN
  150. SEGACT IPT3
  151. IPT2= IPT3.LISOUS(IMAIL)
  152. SEGDES IPT3
  153. ENDIF
  154. NEFHYB = NEFMOD
  155. NEF = NUMGEO(NEFHYB)
  156. SEGDES IMODEL
  157. *
  158. MELEME = MAHYBR(IMAIL)
  159. SEGACT MELEME
  160. NBDDL = NUM(/1)
  161. NBELEM = NUM(/2)
  162. SEGACT IPT2
  163. NBNN = IPT2.NUM(/1)
  164. *
  165. *- Récupération des fonctions de forme au centre de l'élément
  166. *
  167. SEGINI TRAV
  168. CALL RESHPT(1,NBNN,NEF,NEF,0,IPINTE,IRT1)
  169. CALL HYSHPT(NEFHYB,NBDDL,IPINTE,IPTHYB)
  170. MINTE = IPINTE
  171. SEGACT MINTE
  172. HYBSTO = IPTHYB
  173. SEGACT HYBSTO
  174. *-----------------------------------------
  175. *- Boucle sur les elements du sous domaine
  176. *-----------------------------------------
  177. MCHAML = ICHAML(IMAIL)
  178. SEGACT MCHAML
  179. MELVAL = IELVAL(1)
  180. SEGDES MCHAML
  181. SEGACT MELVAL
  182. NDIM = IDIM * (IDIM + 1)
  183. IGAU = 1
  184. DO 80 IEL=1,NBELEM
  185. ITELEM = ITELEM + 1
  186. CALL DOXE(XCOOR,IDIM,NBNN,IPT2.NUM,IEL,XE)
  187. CALL MHYBR3(IGAU,NBNN,NBDDL,NDIM,IDIM,IDIM,XE,HYBASE,
  188. S SHPTOT,SHY,SHP,ZJAC,DJAC)
  189. DO 70 IDDL=1,NBDDL
  190. DO 30 I=1,IDIM
  191. VECT(I) = 0.D0
  192. 30 CONTINUE
  193. DO 50 J=1,IDIM
  194. DO 40 I=1,IDIM
  195. VECT(I) = VECT(I) + ZJAC(I,J) * SHY(J,IDDL)
  196. 40 CONTINUE
  197. 50 CONTINUE
  198. QDDL = MPOVA1.VPOCHA(ICPR(NUM(IDDL,IEL)),1)
  199. ORIEN = VELCHE(IDDL,IEL)
  200. COEF = QDDL * ORIEN / ABS(DJAC)
  201. DO 60 I=1,IDIM
  202. VPOCHA(ITELEM,I) = VPOCHA(ITELEM,I) + COEF * VECT(I)
  203. 60 CONTINUE
  204. 70 CONTINUE
  205. 80 CONTINUE
  206. SEGSUP TRAV, HYBSTO, MINTE
  207. SEGDES MELVAL
  208. SEGDES MELEME, IPT2
  209. 90 CONTINUE
  210. SEGDES MPOVAL
  211. SEGDES MPOVA1, MCHELM, MMODEL, IPMAHY
  212. SEGSUP ICCPR
  213. *
  214. RETURN
  215. END
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  

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