Sources Esope | Cast3M

fluma2
C FLUMA2    SOURCE    CB215821  19/08/20    21:17:47     10287          
      SUBROUTINE FLUMA2(IPFLOD,IPGEOM,IPINTE,NUMPOI,IPFLEQ)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
************************************************************************
*
*                             F L U M A 2
*                             -----------
*
* FONCTION:
* ---------
*     CALCUL DES FLUX NODAUX EQUIVALENTS
*     MODE BIDIMENSIONNEL OU MODE AXISYMETRIQUE
*
* 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
*    +XPI     (E)  VOIR CCREEL
*     NUMPOI  (E)  REFERENCE LA DIRECTION DU FLUX DANS LE REPERE GLOBAL
*                  = -1 LORSQUE LE FLUX EST NORMAL A LA FACE
*                  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)  =  CORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
*     FACE          =  FACE DE L'ELEMENT
*     COSDIR        =  COSINUS DIRECTEUR DE L'INCLINAISON DU FLUX
*
      SEGMENT,MMAT1
         REAL*8 XE(3,NBPTEL),SHP(6,NBPTEL)
      ENDSEGMENT
*
* CONSTANTES:
* -----------
*
      PARAMETER ( O1=1.D0 )
      PARAMETER ( O2=2.D0 )
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     DENIS ROBERT,LE 2 FEVRIER 1988.
*
* LANGAGE:
* --------
*
*     ESOPE + FORTRAN77
*
************************************************************************
*
*     ON RECUPERE LES VALEURS NODALES DU FLUX
*
      IF(NUMPOI.NE.1) THEN
      MELVA1=IPFLOD
      SEGACT,MELVA1
      NBPTE1=MELVA1.VELCHE(/1)
      NEL1=MELVA1.VELCHE(/2)
      ELSE
      MCHAM1=IPFLOD
      SEGACT,MCHAM1
      MELVA1=MCHAM1.IELVAL(1)
      MELVA2=MCHAM1.IELVAL(2)
      MELVA3=MCHAM1.IELVAL(3)
      MELVA4=MCHAM1.IELVAL(4)
      SEGACT MELVA1,MELVA2,MELVA3,MELVA4
      NBPTE1 = MELVA1.VELCHE(/1)
      NEL1 =  MELVA1.VELCHE(/2)
      ENDIF
*
*     ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION DES FACES
*
      MINTE=IPINTE
      SEGACT,MINTE
      NBPGAU=POIGAU(/1)
*
*     ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
*
      MELEME=IPGEOM
      SEGACT,MELEME
      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 FACE
*
      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)
*
*        ON PROJETTE LA DIRECTION DANS LE PLAN (OX|OY)
*
         DNORME=SQRT(XDIR**2+YDIR**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
         COSDIR=O2
      ENDIF
*
*     BOUCLE SUR LES ELEMENTS
*
      DO 10 IEL=1,NEL
*
*        ON CHERCHE LES COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
*
         CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE)
 
*
*        BOUCLES SUR LES POINTS DE GAUSS
*
         DO 40 IGAU=1,NBPGAU
            AXIS=O1
*
*           CONTRIBUTION DE LA FACE AU POINT DE GAUSS
*
            DLX=XZERO
            DLY=XZERO
            DO 30 INOE=1,NBPTEL
               DLX=DLX+SHPTOT(2,INOE,IGAU)*XE(1,INOE)
               DLY=DLY+SHPTOT(2,INOE,IGAU)*XE(2,INOE)
 30            CONTINUE
*           END DO
            FACE=SQRT(DLX**2+DLY**2)
*
*           SI ON A UN FLUX INCLINE,CALCUL DU COSINUS DIRECTEUR
            DIRNOR=COSDIR
            IF ((COSDIR.NE.O1).AND.(NUMPOI.NE.1)) THEN
               DIRNOR=ABS(YDIRNO*(DLX/FACE)-XDIRNO*(DLY/FACE))
            ENDIF
            IF (IFOMOD.EQ.0) THEN
*
*              CAS DES ELEMENTS AXISYMETRIQUES
*
               DO 41 NP=1,NBPTEL
                  SHP(1,NP)=SHPTOT(1,NP,IGAU)
                  SHP(2,NP)=SHPTOT(2,NP,IGAU)
                  SHP(3,NP)=SHPTOT(3,NP,IGAU)
 41               CONTINUE
*              END DO
               CALL DISTRR(XE,SHP,NBPTEL,RR)
               AXIS=O2*XPI*RR
             ENDIF
            IEMIN = MIN(IEL,NEL1)
            IGMN = MIN(IGAU,NBPTE1)
 
            IF (NUMPOI.EQ.1) THEN
C  on oriente la vraie normale suivant la pseudo
           S1 = MELVA3.VELCHE(IGMN,IEMIN)
           S2 = MELVA4.VELCHE(IGMN,IEMIN)
           amul = 1.D0
           ps = -S1*dly+S2*dlx
           if(ps.lt.0) amul = -1.D0
           dlx= dlx*amul
           dly= dly*amul
            T1 = POIGAU(IGAU)*(MELVA2.VELCHE(IGMN,IEMIN)*DLX
     1       -MELVA1.VELCHE(IGMN,IEMIN)*DLY)*AXIS
 
             ELSE
                 T1 =POIGAU(IGAU)*AXIS*DIRNOR*FACE*
     1           MELVA1.VELCHE(IGMN,IEMIN)
             ENDIF
            DO 50 J=1,NBPTEL
            VELCHE(J,IEL) =  VELCHE(J,IEL) + SHPTOT(1,J,IGAU)*T1
 50         CONTINUE
 
*           END DO
 40         CONTINUE
*        END DO
 
*        END DO
 10      CONTINUE
*     END DO
      SEGSUP,MMAT1
      IF(NUMPOI.EQ.1) THEN
      ENDIF
 
      END