Télécharger hvit.eso

Retour à la liste

Numérotation des lignes :

  1. C HVIT SOURCE CB215821 16/12/05 21:39:35 9237
  2. SUBROUTINE HVIT
  3. C-----------------------------------------------------------------------
  4. C Calcul de la vitesse aux centres des elements dans le cas d'une
  5. C formulation DARCY en elements finis mixtes hybrides.
  6. C
  7. C On obtient la vitesse au centre des elements en exprimant
  8. C l'interpolation mixte hybride aux points centres.
  9. C
  10. C On prend en compte l'orientation de la normale par l'intermediaire
  11. C du MCHAML des orientations.
  12. C
  13. C---------------------------
  14. C Phrase d'appel (GIBIANE) :
  15. C---------------------------
  16. C
  17. C CHP1 = HVIT MODL1 CHP2
  18. C
  19. C------------------------
  20. C Operandes et resultat :
  21. C------------------------
  22. C
  23. C CHP1 : CHAMPOINT resultat contenant la vitesse au centre.
  24. C MODL1 : Objet modele specifiant la formulation
  25. C CHP2 : CHAMPOINT contenant le debit porte par la normale a la face
  26. C
  27. C-----------------------------------------------------------------------
  28. C
  29. C Langage : ESOPE + FORTRAN77
  30. C
  31. C Auteurs : F.DABBENE 09/93
  32. C Modif 04/99 (F.Auriol) les informations de la table DOMAINE sont
  33. C dans le MODELE
  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 SMELEME
  43. -INC SMMODEL
  44. -INC SMTABLE
  45. *
  46. SEGMENT IPMAHY
  47. INTEGER MAHYBR(NSOUS)
  48. ENDSEGMENT
  49. *
  50. REAL*8 XVALIN,XVALRE
  51. CHARACTER*4 NOCOM1,NOMTOT(1)
  52. CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,LETYPE
  53. *
  54. * Lecture du MMODEL
  55. *
  56. CALL LIROBJ('MMODEL',IPMODE,1,IRET1)
  57. IF (IERR.NE.0) RETURN
  58. MMODEL = IPMODE
  59. *
  60. * Lecture de la TABLE domaine
  61. *
  62. IPTABL = 0
  63. C CALL LIRTAB('DOMAINE',IPTABL,1,IRET)
  64. CALL LEKMOD(MMODEL,IPTABL,IRET)
  65. IF (IERR.NE.0) RETURN
  66. CHARIN = 'MAILLAGE'
  67. TYPOBJ = 'MAILLAGE'
  68. CALL LEKTAB(IPTABL,CHARIN,IOBRE)
  69. IF (IERR.NE.0) RETURN
  70. IPGEOM = IOBRE
  71. CALL LEKTAB(IPTABL,'ELTFA',IOBRE)
  72. IF (IERR.NE.0) RETURN
  73. IELTFA = IOBRE
  74. CALL LEKTAB(IPTABL,'CENTRE',IOBRE)
  75. IF (IERR.NE.0) RETURN
  76. IPGEOC = IOBRE
  77. CALL LEKTAB(IPTABL,'FACE',IOBRE)
  78. IF (IERR.NE.0) RETURN
  79. IPFACE = IOBRE
  80. *
  81. * Lecture du CHPO FLUX
  82. *
  83. CALL LIROBJ('CHPOINT',ICHP1,1,IRET1)
  84. IF (IERR.NE.0) GOTO 100
  85. *
  86. * Lecture du CHAMELEM des orientations
  87. *
  88. * CALL LIROBJ('MCHAML',IPCHEL,1,IRET1)
  89. CALL LEKTAB(IPTABL,'XXNORMAE',IPIN)
  90. CALL REDUAF(IPIN,IPMODE,IPCHEL,0,IR,KER)
  91. IF(IR .NE. 1) CALL ERREUR(KER)
  92. IF(IERR .NE. 0) RETURN
  93. MCHELM = IPCHEL
  94. *
  95. * Test du CHPO FLUX
  96. *
  97. INDIC = 1
  98. NBCOMP = 1
  99. NOMTOT(1) = 'FLUX'
  100. CALL QUEPOI(ICHP1,IPFACE,INDIC,NBCOMP,NOMTOT)
  101. IF (IERR.NE.0) RETURN
  102. *
  103. * Test de la formulation
  104. *
  105. SEGACT MMODEL
  106. NSOUS = KMODEL(/1)
  107. SEGINI IPMAHY
  108. IDARCY = 0
  109. IPT1=IPGEOM
  110. IPT2=IPGEOM
  111. DO 10 ISOUS=1,NSOUS
  112. IF(NSOUS.GT.1) THEN
  113. SEGACT IPT2
  114. IPT1= IPT2.LISOUS(ISOUS)
  115. SEGDES IPT2
  116. ENDIF
  117. IMODEL = KMODEL(ISOUS)
  118. SEGACT IMODEL
  119. LETYPE = FORMOD(1)
  120. IF (LETYPE.EQ.'DARCY') THEN
  121. IDARCY = IDARCY + 1
  122. MAHYBR(ISOUS) = IPT1
  123. ENDIF
  124. SEGDES IMODEL
  125. 10 CONTINUE
  126. SEGDES MMODEL
  127. IF (IDARCY.EQ.0) THEN
  128. MOTERR = LETYPE
  129. CALL ERREUR(193)
  130. GOTO 100
  131. ENDIF
  132. *
  133. * Recuperation des pointeurs ELTFA pour les zones ou DARCY est defini
  134. *
  135. MELEME = IELTFA
  136. SEGACT MELEME
  137. LZONES = LISOUS(/1)
  138. IF (LZONES.EQ.0) LZONES = 1
  139. IPT1 = IPGEOM
  140. SEGACT IPT1
  141. DO 30 ISOUS=1,NSOUS
  142. IMAMEL = MAHYBR(ISOUS)
  143. IF (IMAMEL.NE.0) THEN
  144. DO 20 ISZ=1,LZONES
  145. IF (LZONES.EQ.1) THEN
  146. IPT2 = IPT1
  147. IPT3 = MELEME
  148. ELSE
  149. IPT2 = IPT1.LISOUS(ISZ)
  150. IPT3 = LISOUS(ISZ)
  151. ENDIF
  152. IF (IPT2.EQ.IMAMEL) THEN
  153. MAHYBR(ISOUS) = IPT3
  154. GOTO 30
  155. ENDIF
  156. 20 CONTINUE
  157. IF (IMAMEL.EQ.MAHYBR(ISOUS)) THEN
  158. MOTERR(1:8) = ' MODELE '
  159. MOTERR(9:16)= ' ELTFA '
  160. INTERR(1) = ISOUS
  161. CALL ERREUR(698)
  162. SEGDES IPT1
  163. SEGDES MELEME
  164. GOTO 100
  165. ENDIF
  166. ENDIF
  167. 30 CONTINUE
  168. SEGDES IPT1
  169. SEGDES MELEME
  170. *
  171. * Test du CHAMELEM des orientations
  172. *
  173. SEGACT MCHELM
  174. DO 40 ISOUS=1,NSOUS
  175. IF (MAHYBR(ISOUS).NE.0) THEN
  176. IF (MAHYBR(ISOUS).NE.IMACHE(ISOUS)) THEN
  177. MOTERR(1:8) = ' ORIENT '
  178. MOTERR(9:16)= ' ELTFA '
  179. INTERR(1) = ISOUS
  180. CALL ERREUR(698)
  181. SEGDES MCHELM
  182. GOTO 100
  183. ENDIF
  184. ENDIF
  185. 40 CONTINUE
  186. SEGDES MCHELM
  187. *
  188. * Construction du CHAMPOINT de vitesse au centre des elements
  189. *
  190. SEGDES IPMAHY
  191. CALL HVIT1(IPMODE,IPMAHY,IPGEOC,ICHP1,IPCHEL,IPGEOM,IRET)
  192. CALL ECROBJ('CHPOINT',IRET)
  193. *
  194. * Ménage
  195. *
  196. 100 CONTINUE
  197. SEGSUP IPMAHY
  198. C
  199. RETURN
  200. END
  201.  
  202.  
  203.  

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