Sources Esope | Cast3M

hvit1
C HVIT1     SOURCE    CB215821  24/04/12    21:16:17     11897          
      SUBROUTINE HVIT1(IPMODE,IPMAHY,IPGEOC,ICHP1,IPCHEL,IPGEOM,IRET)
C-----------------------------------------------------------------------
C Calcul de la vitesse au centre de chaque maille
C-----------------------------------------------------------------------
C
C---------------------------
C Parametres Entree/Sortie :
C---------------------------
C
C E/  IPMODE  : Pointeur vers l'objet MODELE
C E/  IPMAHY  : Segment contenant le pointeur vers le meleme des
C               connectivites elements/faces pour les zones du MMODEL
C               ou on a defini DARCY.
C E/  IPGEOC  : Pointeur vers l'objet maillage CENTRE
C E/  ICHP1   : Champoint des debits orientes
C E/  IPCHEL  : Mchaml des orientations de normale (1=out,-1=in)
C E/  IPGEOM  : Pointeur vers l'objet maillage sommet (MAILLAGE)
C  /S IRET    : Champoint resultat de composante SCAL
C
C----------------------
C Tableaux de travail :
C----------------------
C
C  ICPR(I)=J   : Le noeud I a le numero local J
C                Correspondance numerotation globale/locale
C  NNGOT       : Nombre de noeuds total du domaine
C
C-----------------------------------------------------------------------
C
C Langage : ESOPE + FORTRAN77
C
C Auteurs : F.DABBENE 09/93
C
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
*
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMCHPOI
-INC SMCOORD
-INC SMELEME
-INC SMINTE
-INC SMMODEL
*
      CHARACTER*1 BLAN1
*
      SEGMENT ICCPR
         INTEGER ICPR(NNGOT)
      ENDSEGMENT
      SEGMENT IPMAHY
         INTEGER MAHYBR(NSOUS)
      ENDSEGMENT
      SEGMENT HYBSTO
         REAL*8  HYBASE(NDIM,NBDDL,NBPP)
      ENDSEGMENT
      SEGMENT TRAV
         REAL*8  XE(3,NBNN)
         REAL*8  SHP(6,NBNN) , SHY(IDIM,NBDDL)
         REAL*8  ZJAC(IDIM,IDIM) , VECT(IDIM)
      ENDSEGMENT
*
      BLAN1=' '
*
*= Creation des tableaux ICPR et INUI pour le CHAMPOINT d'entree
*
      IK     = 0
      NNGOT  = nbpts
      SEGINI ICCPR
      MCHPOI = ICHP1
      SEGACT MCHPOI
      MSOUPO = IPCHP(1)
      SEGDES MCHPOI
      SEGACT MSOUPO
      NUMHAR = NOHARM(1)
      MPOVA1 = IPOVAL
      MELEME = IGEOC
      SEGACT MELEME
      N2 = NUM(/2)
      DO 10 I2=1,N2
         K = NUM(1,I2)
         IF (ICPR(K).EQ.0) THEN
            IK      = IK + 1
            ICPR(K) = IK
         ENDIF
  10  CONTINUE
      SEGDES MELEME
      SEGDES MSOUPO
*
*= Initialisation du CHAMPOINT resultat de nature DIFFUS
*
      NSOUPO = 1
      NAT    = 1
      SEGINI MCHPOI
      IRET      = MCHPOI
      MTYPOI    = 'CENTRE  '
      DO 11 ITIT=1,72
        MOCHDE(ITIT:ITIT)=BLAN1
 11   CONTINUE
      IFOPOI    = IFOUR
      JATTRI(1) = 1
      NC        = IDIM
      SEGINI MSOUPO
      IPCHP(1)  = MSOUPO
      SEGDES MCHPOI
      DO 20 I=1,NC
         NOHARM(I) = NUMHAR
 20   CONTINUE
      IGEOC     = IPGEOC
      NOCOMP(1) = 'VX  '
      NOCOMP(2) = 'VY  '
      IF (IDIM.EQ.3) NOCOMP(3) = 'VZ  '
      IPT2 = IPGEOC
      SEGACT IPT2
      N    = IPT2.NUM(/2)
      SEGDES IPT2
      SEGINI MPOVAL
      IPOVAL = MPOVAL
      SEGDES MSOUPO
*
*= Activation des segments MCHELM et MMODEL
*
      MCHELM = IPCHEL
      SEGACT MCHELM
      MMODEL = IPMODE
      SEGACT MMODEL
      NBMAIL = KMODEL(/1)
      SEGACT MPOVA1
*
*---------------------------------------
*= Boucle sur les maillages elementaires
*---------------------------------------
*
      ITELEM = 0
      SEGACT IPMAHY
      DO 90 IMAIL=1,NBMAIL
         IF (MAHYBR(IMAIL).EQ.0) GOTO 90
*
* Recuperation des informations issues du MODELE et du MCHAML
*                                          et du maillage sommet
*
         IMODEL = KMODEL(IMAIL)
         SEGACT IMODEL
         IPT2   = IPGEOM
         IPT3   = IPGEOM
         IF(NBMAIL.GT.1) THEN
              SEGACT IPT3
              IPT2= IPT3.LISOUS(IMAIL)
              SEGDES IPT3
         ENDIF
         NEFHYB = NEFMOD
         NEF    = NUMGEO(NEFHYB)
         SEGDES IMODEL
*
         MELEME = MAHYBR(IMAIL)
         SEGACT MELEME
         NBDDL  = NUM(/1)
         NBELEM = NUM(/2)
         SEGACT IPT2
         NBNN   = IPT2.NUM(/1)
*
*- Récupération des fonctions de forme au centre de l'élément
*
         SEGINI TRAV
         CALL RESHPT(1,NBNN,NEF,NEF,0,IPINTE,IRT1)
         CALL HYSHPT(NEFHYB,NBDDL,IPINTE,IPTHYB)
         MINTE = IPINTE
         SEGACT MINTE
         HYBSTO = IPTHYB
         SEGACT HYBSTO
*-----------------------------------------
*- Boucle sur les elements du sous domaine
*-----------------------------------------
         MCHAML = ICHAML(IMAIL)
         SEGACT MCHAML
         MELVAL = IELVAL(1)
         SEGDES MCHAML
         SEGACT MELVAL
         NDIM = IDIM * (IDIM + 1)
         IGAU = 1
         DO 80 IEL=1,NBELEM
            ITELEM = ITELEM + 1
            CALL DOXE(XCOOR,IDIM,NBNN,IPT2.NUM,IEL,XE)
            CALL MHYBR3(IGAU,NBNN,NBDDL,NDIM,IDIM,IDIM,XE,HYBASE,
     S                  SHPTOT,SHY,SHP,ZJAC,DJAC)
            DO 70 IDDL=1,NBDDL
               DO 30 I=1,IDIM
                  VECT(I) = 0.D0
 30            CONTINUE
               DO 50 J=1,IDIM
                  DO 40 I=1,IDIM
                     VECT(I) = VECT(I) + ZJAC(I,J) * SHY(J,IDDL)
 40               CONTINUE
 50            CONTINUE
               QDDL  = MPOVA1.VPOCHA(ICPR(NUM(IDDL,IEL)),1)
               ORIEN = VELCHE(IDDL,IEL)
               COEF  = QDDL * ORIEN / ABS(DJAC)
               DO 60 I=1,IDIM
                  VPOCHA(ITELEM,I) = VPOCHA(ITELEM,I) + COEF * VECT(I)
 60            CONTINUE
 70         CONTINUE
 80      CONTINUE
         SEGSUP TRAV, HYBSTO, MINTE
         SEGDES MELVAL
         SEGDES MELEME, IPT2
 90   CONTINUE
      SEGDES MPOVAL
      SEGDES MPOVA1, MCHELM, MMODEL, IPMAHY
      SEGSUP ICCPR
*
      RETURN
      END