Sources Esope | Cast3M

fluma3
C FLUMA3    SOURCE    CB215821  19/07/30    21:16:19     10273          
      SUBROUTINE FLUMA3(IPFLOD,IPGEOM,IPINTE,NUMPOI,IPFLEQ)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
************************************************************************
*
*                             F L U M A 3
*                             -----------
*
* FONCTION:
* ---------
*     CALCUL DES FLUX NODAUX EQUIVALENTS
*     MODE TRIDIMENSIONNEL
*
* MODULES UTILISES:
* -----------------
*
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMCHAML
-INC SMELEME
-INC SMINTE
-INC SMCOORD
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
* -----------
*
*     IPFLOD  (E)  POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES
*                  FLUX NODAUX
*     IPGEOM  (E)  POINTEUR SUR UN OBJET MAILLAGE ELEMENTAIRE
*                  DE L'ENVELOPPE
*     IPINTE  (E)  POINTEUR SUR UN SEGMENT MINTE CONTENANT LES
*                  CARACTERISTIQUES D'INTEGRATION DES FACES
*    +IDIM    (E)  VOIR CCOPTIO
*    +XZERO   (E)  VOIR CCREEL
*    +XPETIT  (E)  VOIR CCREEL
*     NUMPOI  (E)  REFERENCE LA DIRECTION DU FLUX DANS LE REPERE GLOBAL
*                  = -1 LORSQUE LE FLUX EST NORMAL A LA SURFACE
*                  MIS A 1  POUR LA SYNTAXE 3 ( FLUX D UN VECTEUR)
*     IPFLEQ  (S)  POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES
*                  FLUX NODAUX EQUIVALENTS
*
      INTEGER NUMPOI
*
* VARIABLES:
* ----------
*
*     XE(3,NBPTEL)  =  COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
*     SURF          =  SURFACE ELEMENTAIRE AU POINT DE GAUSS
*     A ET S        =  TABLEAUX DE TRAVAIL
*     COSDIR        =  COSINUS DIRECTEUR DE L'INCLINAISON DU FLUX
*
      REAL*8  S(6)
      SEGMENT,MMAT1
         REAL*8 XE(3,NBPTEL)
      ENDSEGMENT
*
* CONSTANTES:
* -----------
*
      PARAMETER ( O1=1.D0 )
      PARAMETER ( O4=4.D0 )
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     DENIS ROBERT,LE 3 FEVRIER 1988.
*
* LANGAGE:
* --------
*
*     ESOPE + FORTRAN77
*
************************************************************************
*
*     ON RECUPERE LES VALEURS NODALES DU FLUX
 
*
       IF (NUMPOI.NE.1) THEN
 
      MELVA1=IPFLOD
      NBPTE1=MELVA1.VELCHE(/1)
      NEL1=MELVA1.VELCHE(/2)
        ELSE
*  numpoi a ete mis a 1  si ipflod a 2 ou 3 composantes  .........
 
       MCHAM1 =  IPFLOD
      MELVA1= MCHAM1.IELVAL(1)
      MELVA2= MCHAM1.IELVAL(2)
      MELVA3= MCHAM1.IELVAL(3)
      MELVA4= MCHAM1.IELVAL(4)
      MELVA5= MCHAM1.IELVAL(5)
      MELVA6= MCHAM1.IELVAL(6)
 
 
      NBPTE1=MELVA1.VELCHE(/1)
      NEL1=MELVA1.VELCHE(/2)
        ENDIF
*
*     ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION DES FACES
*
      MINTE=IPINTE
      NBPGAU=POIGAU(/1)
*
*     ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
*
      MELEME=IPGEOM
      NBPTEL=NUM(/1)
      NEL=NUM(/2)
*
*     MELVAL QUI CONTIENDRA LES FLUX NODAUX EQUIVALENTS
*
      N1PTEL=NBPTEL
      N1EL=NEL
      N2PTEL=0
      N2EL=0
      SEGINI,MELVAL
      IPFLEQ=MELVAL
      SEGINI,MMAT1
*
*     CAS D'UN FLUX INCLINE PAR RAPPORT A LA NORMALE A LA SURFACE
*
      COSDIR=O1
      IF ((NUMPOI.NE.-1).AND.(NUMPOI.NE.1)) THEN
*
*        ON RECUPERE LES COORDONNEES DU VECTEUR DIRECTION
*
         CALL EXCOO1(NUMPOI,XDIR,YDIR,ZDIR,DENS)
         DNORME=SQRT(XDIR**2+YDIR**2+ZDIR**2)
         IF (DNORME.LT.XPETIT) THEN
*
*           ERREUR DANS LA DONNEE DE LA DIRECTION DU FLUX
*
            CALL ERREUR(417)
            RETURN
         ENDIF
         XDIRNO=XDIR/DNORME
         YDIRNO=YDIR/DNORME
         ZDIRNO=ZDIR/DNORME
         COSDIR=O4
      ENDIF
 
 
 
*
*     BOUCLE SUR LES ELEMENTS
*
      DO 10 IEL=1,NEL
*
*        ON CHERCHE LES COORDONNEES DES NOEUDS DANS LE REPERE GLOBAL
*
         CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE)
*
*        BOUCLE SUR LES POINTS DE GAUSS ET SUR LES NOEUDS
 
         DO 40 IGAU=1,NBPGAU
*
*           CALCUL DE LA SURFACE ELEMENTAIRE AU POINT DE GAUSS
*
            SURFX=XZERO
            SURFY=XZERO
            SURFZ=XZERO
            DO 21 I=1,6
               S(I)=XZERO
 21            CONTINUE
*           END DO
            DO 30 INOE=1,NBPTEL
               S(1)=S(1)+SHPTOT(2,INOE,IGAU)*XE(2,INOE)
               S(2)=S(2)+SHPTOT(3,INOE,IGAU)*XE(3,INOE)
               S(3)=S(3)+SHPTOT(3,INOE,IGAU)*XE(2,INOE)
               S(4)=S(4)+SHPTOT(2,INOE,IGAU)*XE(3,INOE)
               S(5)=S(5)+SHPTOT(3,INOE,IGAU)*XE(1,INOE)
               S(6)=S(6)+SHPTOT(2,INOE,IGAU)*XE(1,INOE)
 30            CONTINUE
*      END DO
            SURFX=S(1)*S(2)-S(3)*S(4)
            SURFY=S(4)*S(5)-S(2)*S(6)
            SURFZ=S(6)*S(3)-S(5)*S(1)
            SURF=SQRT(SURFX**2+SURFY**2+SURFZ**2)
 
*
*           SI ON A UN FLUX INCLINE,CALCUL DU COSINUS DIRECTEUR
*
            IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
            IBMN=MIN(IEL,MELVA1.VELCHE(/2))
            DIRNOR=COSDIR
            IF ((COSDIR.NE.O1).AND.(NUMPOI.NE.1)) THEN
           DIRNOR=ABS(XDIRNO*(SURFX/SURF)+YDIRNO*(SURFY/SURF)
     +                    +ZDIRNO*(SURFZ/SURF))
 
            ENDIF
 
 
                 IF (NUMPOI.EQ.1) THEN
C  on oriente la vraie normale suivant la pseudo
           S1 = MELVA4.VELCHE(IGMN,IBMN)
           S2 = MELVA5.VELCHE(IGMN,IBMN)
           S3 = MELVA6.VELCHE(IGMN,IBMN)
           AMUL = 1.D0
           PS = SURFX*S1+SURFY*S2+SURFZ*S3
           IF(PS.LT.0) AMUL = -1.D0
            T1 = ( POIGAU(IGAU)*( MELVA1.VELCHE(IGMN,IBMN)*SURFX +
     1        MELVA2.VELCHE(IGMN,IBMN)*SURFY  +
     1        MELVA3.VELCHE(IGMN,IBMN)*SURFZ ))*AMUL
                 ELSE
             T1 = POIGAU(IGAU)*DIRNOR*SURF*MELVA1.VELCHE(IGMN,IBMN)
                 ENDIF
            DO 51 J=1,NBPTEL
         VELCHE(J,IEL) = VELCHE(J,IEL) +SHPTOT(1,J,IGAU)*T1
 
 51         CONTINUE
 40         CONTINUE
 10      CONTINUE
*     END DO
*
      SEGSUP,MMAT1
      IF ( NUMPOI.EQ.1) THEN
      ENDIF
 
      END