Télécharger fluma1.eso

Retour à la liste

Numérotation des lignes :

  1. C FLUMA1 SOURCE PV 09/03/12 21:22:49 6325
  2.  
  3. C=======================================================================
  4. C= F L U M A 1 =
  5. C= ----------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Calcul des flux nodaux equivalents dans le cas UNDIMENSIONNEL =
  10. C= =
  11. C= Parametres : (E)=Entree (S)=Sortie =
  12. C= ------------ =
  13. C= IPFLOD (E) Pointeur sur le segment MELVAL des FLUX NODAUX =
  14. C= IPGEOM (E) Pointeur sur un objet MAILLAGE elementaire =
  15. C= IPINTE (E) Pointeur sur un segment MINTE contenant les =
  16. C= caracteristiques d'integration =
  17. C= NUMPOI (E) Indique la direction du flux dans le repere global =
  18. C= = -1 lorsque le flux est normal a la face =
  19. C= = 1 pour la syntaxe 3 (flux d un vecteur) =
  20. C= IPFLEQ (S) Pointeur sur un segment MELVAL contenant les =
  21. C= flux nodaux equivalents =
  22. C=======================================================================
  23.  
  24. SUBROUTINE FLUMA1 (IPFLOD,IPGEOM,IPINTE,NUMPOI,IPFLEQ)
  25.  
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8 (A-H,O-Z)
  28.  
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC CCREEL
  33. -INC SMCHAML
  34. -INC SMELEME
  35. -INC SMINTE
  36. -INC SMCOORD
  37.  
  38. SEGMENT MMAT1
  39. REAL*8 XE(3,NBPTEL),SHP(6,NBPTEL)
  40. ENDSEGMENT
  41.  
  42. C= Quelques constantes (2.Pi et 4.Pi)
  43. PARAMETER (X2Pi=6.283185307179586476925286766559D0)
  44. PARAMETER (X4Pi=12.566370614359172953850573533118D0)
  45.  
  46. C ON RECUPERE LES VALEURS NODALES DU FLUX
  47. IF (NUMPOI.NE.1) THEN
  48. MELVA1=IPFLOD
  49. SEGACT,MELVA1
  50. NBPTE1=MELVA1.VELCHE(/1)
  51. NEL1=MELVA1.VELCHE(/2)
  52. ELSE
  53. MCHAM1=IPFLOD
  54. SEGACT,MCHAM1
  55. MELVA1=MCHAM1.IELVAL(1)
  56. MELVA2=MCHAM1.IELVAL(2)
  57. SEGACT,MELVA1,MELVA2
  58. NBPTE1=MELVA1.VELCHE(/1)
  59. NEL1=MELVA1.VELCHE(/2)
  60. SEGDES,MCHAM1
  61. ENDIF
  62.  
  63. * ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION DES FACES
  64. MINTE=IPINTE
  65. SEGACT,MINTE
  66. NBPGAU=POIGAU(/1)
  67.  
  68. * ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
  69. MELEME=IPGEOM
  70. SEGACT,MELEME
  71. NBPTEL=NUM(/1)
  72. NEL=NUM(/2)
  73.  
  74. C*OF IF ((NBPGAU.NE.1).OR.(NBPTEL.NE.1)) THEN
  75. C*OF WRITE(6,*) 'ERREUR FATALE : FLUMA1'
  76. C*OF RETURN
  77. C*OF ENDIF
  78.  
  79. * MELVAL QUI CONTIENDRA LES FLUX NODAUX EQUIVALENTS
  80. N1PTEL=NBPTEL
  81. N1EL=NEL
  82. N2PTEL=0
  83. N2EL=0
  84. SEGINI,MELVAL
  85. IPFLEQ=MELVAL
  86. SEGINI,MMAT1
  87.  
  88. C= ON RECUPERE LES COORDONNEES DU VECTEUR DIRECTION
  89. C= ERREUR SI LA DONNEE DE LA DIRECTION DU FLUX EST NULLE
  90. XDIR=1.
  91. IF ((NUMPOI.NE.-1).AND.(NUMPOI.NE.1)) THEN
  92. CALL EXCOO1(NUMPOI,XDIR,YDIR,ZDIR,DENS)
  93. DNORME=ABS(XDIR)
  94. IF (DNORME.LT.XPETIT) THEN
  95. CALL ERREUR(417)
  96. RETURN
  97. ENDIF
  98. XDIR=XDIR/DNORME
  99. ENDIF
  100.  
  101. C= BOUCLE SUR LES ELEMENTS
  102. DO IEL=1,NEL
  103.  
  104. * ON CHERCHE LES COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
  105. CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE)
  106.  
  107. C= Cas des elements AXISymetriques et SPHEriques
  108. IF (IFOUR.GE.12.AND.IFOUR.LE.14) THEN
  109. Volu=X2Pi*XE(1,1)
  110. ELSE IF (IFOUR.EQ.15) THEN
  111. RR=XE(1,1)
  112. Volu=X4Pi*RR*RR
  113. ELSE
  114. Volu=1.
  115. ENDIF
  116. IEMIN=MIN(IEL,NEL1)
  117. C on oriente la vraie normale suivant la pseudo
  118. IF (NUMPOI.EQ.1) THEN
  119. S1=MELVA2.VELCHE(1,IEMIN)
  120. XDIR=S1/ABS(S1)
  121. ENDIF
  122. VELCHE(1,IEL)=VELCHE(1,IEL)+Volu*XDIR*MELVA1.VELCHE(1,IEMIN)
  123. ENDDO
  124.  
  125. SEGSUP,MMAT1
  126. SEGDES,MELEME,MELVA1,MINTE
  127. SEGDES,MELVAL
  128. IF (NUMPOI.EQ.1) SEGDES,MELVA2
  129.  
  130. RETURN
  131. END
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  

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