Télécharger fluma3.eso

Retour à la liste

Numérotation des lignes :

  1. C FLUMA3 SOURCE PV 09/03/12 21:22:51 6325
  2. SUBROUTINE FLUMA3(IPFLOD,IPGEOM,IPINTE,NUMPOI,IPFLEQ)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * F L U M A 3
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. * CALCUL DES FLUX NODAUX EQUIVALENTS
  13. * MODE TRIDIMENSIONNEL
  14. *
  15. * MODULES UTILISES:
  16. * -----------------
  17. *
  18. -INC CCOPTIO
  19. -INC CCREEL
  20. -INC SMCHAML
  21. -INC SMELEME
  22. -INC SMINTE
  23. -INC SMCOORD
  24. *
  25. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  26. * -----------
  27. *
  28. * IPFLOD (E) POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES
  29. * FLUX NODAUX
  30. * IPGEOM (E) POINTEUR SUR UN OBJET MAILLAGE ELEMENTAIRE
  31. * DE L'ENVELOPPE
  32. * IPINTE (E) POINTEUR SUR UN SEGMENT MINTE CONTENANT LES
  33. * CARACTERISTIQUES D'INTEGRATION DES FACES
  34. * +IDIM (E) VOIR CCOPTIO
  35. * +XZERO (E) VOIR CCREEL
  36. * +XPETIT (E) VOIR CCREEL
  37. * NUMPOI (E) REFERENCE LA DIRECTION DU FLUX DANS LE REPERE GLOBAL
  38. * = -1 LORSQUE LE FLUX EST NORMAL A LA SURFACE
  39. * MIS A 1 POUR LA SYNTAXE 3 ( FLUX D UN VECTEUR)
  40. * IPFLEQ (S) POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES
  41. * FLUX NODAUX EQUIVALENTS
  42. *
  43. INTEGER NUMPOI
  44. *
  45. * VARIABLES:
  46. * ----------
  47. *
  48. * XE(3,NBPTEL) = COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
  49. * SURF = SURFACE ELEMENTAIRE AU POINT DE GAUSS
  50. * A ET S = TABLEAUX DE TRAVAIL
  51. * COSDIR = COSINUS DIRECTEUR DE L'INCLINAISON DU FLUX
  52. *
  53. REAL*8 S(6)
  54. SEGMENT,MMAT1
  55. REAL*8 XE(3,NBPTEL)
  56. ENDSEGMENT
  57. *
  58. * CONSTANTES:
  59. * -----------
  60. *
  61. PARAMETER ( O1=1.D0 )
  62. PARAMETER ( O4=4.D0 )
  63. *
  64. * AUTEUR, DATE DE CREATION:
  65. * -------------------------
  66. *
  67. * DENIS ROBERT,LE 3 FEVRIER 1988.
  68. *
  69. * LANGAGE:
  70. * --------
  71. *
  72. * ESOPE + FORTRAN77
  73. *
  74. ************************************************************************
  75. *
  76. * ON RECUPERE LES VALEURS NODALES DU FLUX
  77.  
  78. *
  79. IF (NUMPOI.NE.1) THEN
  80.  
  81. MELVA1=IPFLOD
  82. SEGACT,MELVA1
  83. NBPTE1=MELVA1.VELCHE(/1)
  84. NEL1=MELVA1.VELCHE(/2)
  85. ELSE
  86. * numpoi a ete mis a 1 si ipflod a 2 ou 3 composantes .........
  87.  
  88. MCHAM1 = IPFLOD
  89. SEGACT,MCHAM1
  90. MELVA1= MCHAM1.IELVAL(1)
  91. MELVA2= MCHAM1.IELVAL(2)
  92. MELVA3= MCHAM1.IELVAL(3)
  93. MELVA4= MCHAM1.IELVAL(4)
  94. MELVA5= MCHAM1.IELVAL(5)
  95. MELVA6= MCHAM1.IELVAL(6)
  96.  
  97.  
  98. SEGACT,MELVA1,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6
  99. NBPTE1=MELVA1.VELCHE(/1)
  100. NEL1=MELVA1.VELCHE(/2)
  101. SEGDES,MCHAM1
  102. ENDIF
  103. *
  104. * ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION DES FACES
  105. *
  106. MINTE=IPINTE
  107. SEGACT,MINTE
  108. NBPGAU=POIGAU(/1)
  109. *
  110. * ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
  111. *
  112. MELEME=IPGEOM
  113. SEGACT,MELEME
  114. NBPTEL=NUM(/1)
  115. NEL=NUM(/2)
  116. *
  117. * MELVAL QUI CONTIENDRA LES FLUX NODAUX EQUIVALENTS
  118. *
  119. N1PTEL=NBPTEL
  120. N1EL=NEL
  121. N2PTEL=0
  122. N2EL=0
  123. SEGINI,MELVAL
  124. IPFLEQ=MELVAL
  125. SEGINI,MMAT1
  126. *
  127. * CAS D'UN FLUX INCLINE PAR RAPPORT A LA NORMALE A LA SURFACE
  128. *
  129. COSDIR=O1
  130. IF ((NUMPOI.NE.-1).AND.(NUMPOI.NE.1)) THEN
  131. *
  132. * ON RECUPERE LES COORDONNEES DU VECTEUR DIRECTION
  133. *
  134. CALL EXCOO1(NUMPOI,XDIR,YDIR,ZDIR,DENS)
  135. DNORME=SQRT(XDIR**2+YDIR**2+ZDIR**2)
  136. IF (DNORME.LT.XPETIT) THEN
  137. *
  138. * ERREUR DANS LA DONNEE DE LA DIRECTION DU FLUX
  139. *
  140. CALL ERREUR(417)
  141. RETURN
  142. ENDIF
  143. XDIRNO=XDIR/DNORME
  144. YDIRNO=YDIR/DNORME
  145. ZDIRNO=ZDIR/DNORME
  146. COSDIR=O4
  147. ENDIF
  148.  
  149.  
  150.  
  151. *
  152. * BOUCLE SUR LES ELEMENTS
  153. *
  154. DO 10 IEL=1,NEL
  155. *
  156. * ON CHERCHE LES COORDONNEES DES NOEUDS DANS LE REPERE GLOBAL
  157. *
  158. CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE)
  159. *
  160. * BOUCLE SUR LES POINTS DE GAUSS ET SUR LES NOEUDS
  161.  
  162. DO 40 IGAU=1,NBPGAU
  163. *
  164. * CALCUL DE LA SURFACE ELEMENTAIRE AU POINT DE GAUSS
  165. *
  166. SURFX=XZERO
  167. SURFY=XZERO
  168. SURFZ=XZERO
  169. DO 21 I=1,6
  170. S(I)=XZERO
  171. 21 CONTINUE
  172. * END DO
  173. DO 30 INOE=1,NBPTEL
  174. S(1)=S(1)+SHPTOT(2,INOE,IGAU)*XE(2,INOE)
  175. S(2)=S(2)+SHPTOT(3,INOE,IGAU)*XE(3,INOE)
  176. S(3)=S(3)+SHPTOT(3,INOE,IGAU)*XE(2,INOE)
  177. S(4)=S(4)+SHPTOT(2,INOE,IGAU)*XE(3,INOE)
  178. S(5)=S(5)+SHPTOT(3,INOE,IGAU)*XE(1,INOE)
  179. S(6)=S(6)+SHPTOT(2,INOE,IGAU)*XE(1,INOE)
  180. 30 CONTINUE
  181. * END DO
  182. SURFX=S(1)*S(2)-S(3)*S(4)
  183. SURFY=S(4)*S(5)-S(2)*S(6)
  184. SURFZ=S(6)*S(3)-S(5)*S(1)
  185. SURF=SQRT(SURFX**2+SURFY**2+SURFZ**2)
  186.  
  187. *
  188. * SI ON A UN FLUX INCLINE,CALCUL DU COSINUS DIRECTEUR
  189. *
  190. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  191. IBMN=MIN(IEL,MELVA1.VELCHE(/2))
  192. DIRNOR=COSDIR
  193. IF ((COSDIR.NE.O1).AND.(NUMPOI.NE.1)) THEN
  194. DIRNOR=ABS(XDIRNO*(SURFX/SURF)+YDIRNO*(SURFY/SURF)
  195. + +ZDIRNO*(SURFZ/SURF))
  196.  
  197. ENDIF
  198.  
  199.  
  200. IF (NUMPOI.EQ.1) THEN
  201. C on oriente la vraie normale suivant la pseudo
  202. S1 = MELVA4.VELCHE(IGMN,IBMN)
  203. S2 = MELVA5.VELCHE(IGMN,IBMN)
  204. S3 = MELVA6.VELCHE(IGMN,IBMN)
  205. AMUL = 1.D0
  206. PS = SURFX*S1+SURFY*S2+SURFZ*S3
  207. IF(PS.LT.0) AMUL = -1.D0
  208. T1 = ( POIGAU(IGAU)*( MELVA1.VELCHE(IGMN,IBMN)*SURFX +
  209. 1 MELVA2.VELCHE(IGMN,IBMN)*SURFY +
  210. 1 MELVA3.VELCHE(IGMN,IBMN)*SURFZ ))*AMUL
  211. ELSE
  212. T1 = POIGAU(IGAU)*DIRNOR*SURF*MELVA1.VELCHE(IGMN,IBMN)
  213. ENDIF
  214. DO 51 J=1,NBPTEL
  215. VELCHE(J,IEL) = VELCHE(J,IEL) +SHPTOT(1,J,IGAU)*T1
  216.  
  217. 51 CONTINUE
  218. 40 CONTINUE
  219. 10 CONTINUE
  220. * END DO
  221. *
  222. SEGSUP,MMAT1
  223. SEGDES,MELEME,MELVA1,MINTE
  224. SEGDES,MELVAL
  225. IF ( NUMPOI.EQ.1) THEN
  226. SEGDES MELVA2,MELVA3,MELVA4,MELVA5,MELVA6
  227. ENDIF
  228. *
  229. END
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  

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