Télécharger la plaquette Cast3M


fr en

Télécharger fluma1.eso

Retour à la liste

Numérotation des lignes : 

fluma1

  1. C FLUMA1    SOURCE    FANDEUR   22/01/12    21:15:01     11264          
  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. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC CCREEL
  32.  
  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.       PARAMETER (XUn=1.D0)
  43. C= Quelques constantes (2.Pi et 4.Pi)
  44.       PARAMETER (X2Pi=6.283185307179586476925286766559D0)
  45.       PARAMETER (X4Pi=12.566370614359172953850573533118D0)
  46.  
  47.       IPFLEQ = 0
  48.  
  49. C ON RECUPERE LES VALEURS NODALES DU FLUX
  50.       IF (NUMPOI.NE.1) THEN
  51.         MELVA1=IPFLOD
  52.         NBPTE1=MELVA1.VELCHE(/1)
  53.         NEL1  =MELVA1.VELCHE(/2)
  54.       ELSE
  55.         MCHAM1=IPFLOD
  56.         MELVA1=MCHAM1.IELVAL(1)
  57.         MELVA2=MCHAM1.IELVAL(2)
  58.         NBPTE1=MELVA1.VELCHE(/1)
  59.         NEL1  =MELVA1.VELCHE(/2)
  60.       ENDIF
  61.  
  62. * ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION DES FACES
  63.       MINTE =IPINTE
  64.       NBPGAU=POIGAU(/1)
  65.  
  66. * ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
  67.       MELEME=IPGEOM
  68.       NBPTEL=NUM(/1)
  69.       NEL   =NUM(/2)
  70.  
  71. C*OF  IF ((NBPGAU.NE.1).OR.(NBPTEL.NE.1)) THEN
  72. C*OF    WRITE(6,*) 'ERREUR FATALE : FLUMA1'
  73. C*OF    RETURN
  74. C*OF  ENDIF
  75.  
  76. * MELVAL QUI CONTIENDRA LES FLUX NODAUX EQUIVALENTS
  77.       N1PTEL=NBPTEL
  78.       N1EL  =NEL
  79.       N2PTEL=0
  80.       N2EL  =0
  81.       SEGINI,MELVAL
  82.  
  83. * Segment de travail local
  84.       SEGINI,MMAT1
  85.  
  86. C= ON RECUPERE LES COORDONNEES DU VECTEUR DIRECTION
  87. C= ERREUR SI LA DONNEE DE LA DIRECTION DU FLUX EST NULLE
  88.       XDIR=XUn
  89.       IF ((NUMPOI.NE.-1).AND.(NUMPOI.NE.1)) THEN
  90.         CALL EXCOO1(NUMPOI,XDIR,YDIR,ZDIR,DENS)
  91.         IF (ABS(XDIR).LT.XPETIT) THEN
  92.           CALL ERREUR(417)
  93.           RETURN
  94.         ENDIF
  95.         XDIR=SIGN(XUn,XDIR)
  96.       ENDIF
  97.  
  98. C= BOUCLE SUR LES ELEMENTS
  99.       DO IEL=1,NEL
  100.  
  101. *  ON CHERCHE LES COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
  102.         CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE)
  103.  
  104. C= Cas des elements AXISymetriques et SPHEriques
  105.         IF (IFOUR.GE.12.AND.IFOUR.LE.14) THEN
  106.           Volu=X2Pi*XE(1,1)
  107.         ELSE IF (IFOUR.EQ.15) THEN
  108.           RR=XE(1,1)
  109.           Volu=X4Pi*RR*RR
  110.         ELSE
  111.           Volu=XUn
  112.         ENDIF
  113.         IEMIN=MIN(IEL,NEL1)
  114. C  on oriente la vraie normale suivant la pseudo
  115.         IF (NUMPOI.EQ.1) THEN
  116.           S1=MELVA2.VELCHE(1,IEMIN)
  117.           IF (ABS(S1).LT.XPETIT) THEN
  118.             CALL ERREUR(417)
  119.             RETURN
  120.           ENDIF
  121.           XDIR=SIGN(XUn,S1)
  122.         ENDIF
  123.         VELCHE(1,IEL)=VELCHE(1,IEL)+Volu*XDIR*MELVA1.VELCHE(1,IEMIN)
  124.       ENDDO
  125.  
  126.       SEGSUP,MMAT1
  127.  
  128.       IPFLEQ=MELVAL
  129.  
  130. c      RETURN
  131.       END
  132.  
  133.  
  134.  

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