Télécharger fluma3.eso

Retour à la liste

Numérotation des lignes :

  1. C FLUMA3 SOURCE CB215821 19/07/30 21:16:19 10273
  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. NBPTE1=MELVA1.VELCHE(/1)
  83. NEL1=MELVA1.VELCHE(/2)
  84. ELSE
  85. * numpoi a ete mis a 1 si ipflod a 2 ou 3 composantes .........
  86.  
  87. MCHAM1 = IPFLOD
  88. MELVA1= MCHAM1.IELVAL(1)
  89. MELVA2= MCHAM1.IELVAL(2)
  90. MELVA3= MCHAM1.IELVAL(3)
  91. MELVA4= MCHAM1.IELVAL(4)
  92. MELVA5= MCHAM1.IELVAL(5)
  93. MELVA6= MCHAM1.IELVAL(6)
  94.  
  95.  
  96. NBPTE1=MELVA1.VELCHE(/1)
  97. NEL1=MELVA1.VELCHE(/2)
  98. ENDIF
  99. *
  100. * ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION DES FACES
  101. *
  102. MINTE=IPINTE
  103. NBPGAU=POIGAU(/1)
  104. *
  105. * ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
  106. *
  107. MELEME=IPGEOM
  108. NBPTEL=NUM(/1)
  109. NEL=NUM(/2)
  110. *
  111. * MELVAL QUI CONTIENDRA LES FLUX NODAUX EQUIVALENTS
  112. *
  113. N1PTEL=NBPTEL
  114. N1EL=NEL
  115. N2PTEL=0
  116. N2EL=0
  117. SEGINI,MELVAL
  118. IPFLEQ=MELVAL
  119. SEGINI,MMAT1
  120. *
  121. * CAS D'UN FLUX INCLINE PAR RAPPORT A LA NORMALE A LA SURFACE
  122. *
  123. COSDIR=O1
  124. IF ((NUMPOI.NE.-1).AND.(NUMPOI.NE.1)) THEN
  125. *
  126. * ON RECUPERE LES COORDONNEES DU VECTEUR DIRECTION
  127. *
  128. CALL EXCOO1(NUMPOI,XDIR,YDIR,ZDIR,DENS)
  129. DNORME=SQRT(XDIR**2+YDIR**2+ZDIR**2)
  130. IF (DNORME.LT.XPETIT) THEN
  131. *
  132. * ERREUR DANS LA DONNEE DE LA DIRECTION DU FLUX
  133. *
  134. CALL ERREUR(417)
  135. RETURN
  136. ENDIF
  137. XDIRNO=XDIR/DNORME
  138. YDIRNO=YDIR/DNORME
  139. ZDIRNO=ZDIR/DNORME
  140. COSDIR=O4
  141. ENDIF
  142.  
  143.  
  144.  
  145. *
  146. * BOUCLE SUR LES ELEMENTS
  147. *
  148. DO 10 IEL=1,NEL
  149. *
  150. * ON CHERCHE LES COORDONNEES DES NOEUDS DANS LE REPERE GLOBAL
  151. *
  152. CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE)
  153. *
  154. * BOUCLE SUR LES POINTS DE GAUSS ET SUR LES NOEUDS
  155.  
  156. DO 40 IGAU=1,NBPGAU
  157. *
  158. * CALCUL DE LA SURFACE ELEMENTAIRE AU POINT DE GAUSS
  159. *
  160. SURFX=XZERO
  161. SURFY=XZERO
  162. SURFZ=XZERO
  163. DO 21 I=1,6
  164. S(I)=XZERO
  165. 21 CONTINUE
  166. * END DO
  167. DO 30 INOE=1,NBPTEL
  168. S(1)=S(1)+SHPTOT(2,INOE,IGAU)*XE(2,INOE)
  169. S(2)=S(2)+SHPTOT(3,INOE,IGAU)*XE(3,INOE)
  170. S(3)=S(3)+SHPTOT(3,INOE,IGAU)*XE(2,INOE)
  171. S(4)=S(4)+SHPTOT(2,INOE,IGAU)*XE(3,INOE)
  172. S(5)=S(5)+SHPTOT(3,INOE,IGAU)*XE(1,INOE)
  173. S(6)=S(6)+SHPTOT(2,INOE,IGAU)*XE(1,INOE)
  174. 30 CONTINUE
  175. * END DO
  176. SURFX=S(1)*S(2)-S(3)*S(4)
  177. SURFY=S(4)*S(5)-S(2)*S(6)
  178. SURFZ=S(6)*S(3)-S(5)*S(1)
  179. SURF=SQRT(SURFX**2+SURFY**2+SURFZ**2)
  180.  
  181. *
  182. * SI ON A UN FLUX INCLINE,CALCUL DU COSINUS DIRECTEUR
  183. *
  184. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  185. IBMN=MIN(IEL,MELVA1.VELCHE(/2))
  186. DIRNOR=COSDIR
  187. IF ((COSDIR.NE.O1).AND.(NUMPOI.NE.1)) THEN
  188. DIRNOR=ABS(XDIRNO*(SURFX/SURF)+YDIRNO*(SURFY/SURF)
  189. + +ZDIRNO*(SURFZ/SURF))
  190.  
  191. ENDIF
  192.  
  193.  
  194. IF (NUMPOI.EQ.1) THEN
  195. C on oriente la vraie normale suivant la pseudo
  196. S1 = MELVA4.VELCHE(IGMN,IBMN)
  197. S2 = MELVA5.VELCHE(IGMN,IBMN)
  198. S3 = MELVA6.VELCHE(IGMN,IBMN)
  199. AMUL = 1.D0
  200. PS = SURFX*S1+SURFY*S2+SURFZ*S3
  201. IF(PS.LT.0) AMUL = -1.D0
  202. T1 = ( POIGAU(IGAU)*( MELVA1.VELCHE(IGMN,IBMN)*SURFX +
  203. 1 MELVA2.VELCHE(IGMN,IBMN)*SURFY +
  204. 1 MELVA3.VELCHE(IGMN,IBMN)*SURFZ ))*AMUL
  205. ELSE
  206. T1 = POIGAU(IGAU)*DIRNOR*SURF*MELVA1.VELCHE(IGMN,IBMN)
  207. ENDIF
  208. DO 51 J=1,NBPTEL
  209. VELCHE(J,IEL) = VELCHE(J,IEL) +SHPTOT(1,J,IGAU)*T1
  210.  
  211. 51 CONTINUE
  212. 40 CONTINUE
  213. 10 CONTINUE
  214. * END DO
  215. *
  216. SEGSUP,MMAT1
  217. IF ( NUMPOI.EQ.1) THEN
  218. ENDIF
  219.  
  220. END
  221.  
  222.  
  223.  

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