Sources Esope | Cast3M

hvit
C HVIT      SOURCE    CB215821  24/04/12    21:16:17     11897          
      SUBROUTINE HVIT
C-----------------------------------------------------------------------
C Calcul de la vitesse aux centres des elements dans le cas d'une
C formulation DARCY en elements finis mixtes hybrides.
C
C On obtient la vitesse au centre des elements en exprimant
C l'interpolation mixte hybride aux points centres.
C
C On prend en compte l'orientation de la normale par l'intermediaire
C du MCHAML des orientations.
C
C---------------------------
C Phrase d'appel (GIBIANE) :
C---------------------------
C
C CHP1 = HVIT MODL1  CHP2
C
C------------------------
C Operandes et resultat :
C------------------------
C
C CHP1    : CHAMPOINT resultat contenant la vitesse au centre.
C MODL1   : Objet modele specifiant la formulation
C CHP2    : CHAMPOINT contenant le debit porte par la normale a la face
C
C-----------------------------------------------------------------------
C
C Langage : ESOPE + FORTRAN77
C
C Auteurs : F.DABBENE 09/93
C Modif 04/99 (F.Auriol) les informations de la table DOMAINE sont
C            dans le MODELE
C
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
*
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMCHPOI
-INC SMELEME
-INC SMMODEL
-INC SMTABLE
-INC SMCOORD
*
      SEGMENT IPMAHY
         INTEGER MAHYBR(NSOUS)
      ENDSEGMENT
*
      REAL*8 XVALIN,XVALRE
      CHARACTER*4 NOCOM1,NOMTOT(1)
      CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,LETYPE
*
      segact mcoord
*
* Lecture du MMODEL
*
      CALL LIROBJ('MMODEL  ',IPMODE,1,IRET1)
      CALL ACTOBJ('MMODEL  ',IPMODE,1)
      IF (IERR.NE.0) RETURN
      MMODEL = IPMODE
*
* Lecture de la TABLE domaine
*
      IPTABL = 0
C     CALL LIRTAB('DOMAINE',IPTABL,1,IRET)
      CALL LEKMOD(MMODEL,IPTABL,IRET)
      IF (IERR.NE.0) RETURN
      CHARIN = 'MAILLAGE'
      TYPOBJ = 'MAILLAGE'
      CALL LEKTAB(IPTABL,CHARIN,IOBRE)
      IF (IERR.NE.0) RETURN
      IPGEOM = IOBRE
      CALL LEKTAB(IPTABL,'ELTFA',IOBRE)
      IF (IERR.NE.0) RETURN
      IELTFA = IOBRE
      CALL LEKTAB(IPTABL,'CENTRE',IOBRE)
      IF (IERR.NE.0) RETURN
      IPGEOC = IOBRE
      CALL LEKTAB(IPTABL,'FACE',IOBRE)
      IF (IERR.NE.0) RETURN
      IPFACE = IOBRE
*
* Lecture du CHPO FLUX
*
      CALL LIROBJ('CHPOINT ',ICHP1,1,IRET1)
      CALL ACTOBJ('CHPOINT ',ICHP1,1)
      IF (IERR.NE.0) GOTO 100
*
* Lecture du CHAMELEM des orientations
*
*     CALL LIROBJ('MCHAML',IPCHEL,1,IRET1)
      CALL LEKTAB(IPTABL,'XXNORMAE',IPIN)
      CALL REDUAF(IPIN,IPMODE,IPCHEL,0,IR,KER)
      IF(IR   .NE. 1) CALL ERREUR(KER)
      IF(IERR .NE. 0) RETURN
      MCHELM = IPCHEL
*
* Test du CHPO FLUX
*
      INDIC     = 1
      NBCOMP    = 1
      NOMTOT(1) = 'FLUX'
      CALL QUEPOI(ICHP1,IPFACE,INDIC,NBCOMP,NOMTOT)
      IF (IERR.NE.0) RETURN
*
* Test de la formulation
*
      SEGACT MMODEL
      NSOUS  = KMODEL(/1)
      SEGINI IPMAHY
      IDARCY = 0
      IPT1=IPGEOM
      IPT2=IPGEOM
      DO 10 ISOUS=1,NSOUS
         IF(NSOUS.GT.1) THEN
              SEGACT IPT2
              IPT1= IPT2.LISOUS(ISOUS)
              SEGDES IPT2
         ENDIF
         IMODEL = KMODEL(ISOUS)
         SEGACT IMODEL
         LETYPE = FORMOD(1)
         IF (LETYPE.EQ.'DARCY') THEN
            IDARCY = IDARCY + 1
            MAHYBR(ISOUS) = IPT1
         ENDIF
         SEGDES IMODEL
 10   CONTINUE
      SEGDES MMODEL
      IF (IDARCY.EQ.0) THEN
         MOTERR = LETYPE
         CALL ERREUR(193)
         GOTO 100
      ENDIF
*
* Recuperation des pointeurs ELTFA pour les zones ou DARCY est defini
*
      MELEME = IELTFA
      SEGACT MELEME
      LZONES = LISOUS(/1)
      IF (LZONES.EQ.0) LZONES = 1
      IPT1   = IPGEOM
      SEGACT IPT1
      DO 30 ISOUS=1,NSOUS
         IMAMEL = MAHYBR(ISOUS)
         IF (IMAMEL.NE.0) THEN
            DO 20 ISZ=1,LZONES
               IF (LZONES.EQ.1) THEN
                  IPT2 = IPT1
                  IPT3 = MELEME
               ELSE
                  IPT2 = IPT1.LISOUS(ISZ)
                  IPT3 = LISOUS(ISZ)
               ENDIF
               IF (IPT2.EQ.IMAMEL) THEN
                  MAHYBR(ISOUS) = IPT3
                  GOTO 30
               ENDIF
 20         CONTINUE
            IF (IMAMEL.EQ.MAHYBR(ISOUS)) THEN
               MOTERR(1:8) = ' MODELE '
               MOTERR(9:16)= ' ELTFA  '
               INTERR(1)   = ISOUS
               CALL ERREUR(698)
               SEGDES IPT1
               SEGDES MELEME
               GOTO 100
            ENDIF
         ENDIF
 30   CONTINUE
      SEGDES IPT1
      SEGDES MELEME
*
* Test du CHAMELEM des orientations
*
      SEGACT MCHELM
      DO 40 ISOUS=1,NSOUS
         IF (MAHYBR(ISOUS).NE.0) THEN
            IF (MAHYBR(ISOUS).NE.IMACHE(ISOUS)) THEN
               MOTERR(1:8) = ' ORIENT '
               MOTERR(9:16)= ' ELTFA  '
               INTERR(1)   = ISOUS
               CALL ERREUR(698)
               SEGDES MCHELM
               GOTO 100
            ENDIF
         ENDIF
 40   CONTINUE
      SEGDES MCHELM
*
* Construction du CHAMPOINT de vitesse au centre des elements
*
      SEGDES IPMAHY
      CALL HVIT1(IPMODE,IPMAHY,IPGEOC,ICHP1,IPCHEL,IPGEOM,IRET)
      CALL ACTOBJ('CHPOINT ',IRET,1)
      CALL ECROBJ('CHPOINT ',IRET)
*
* Ménage
*
 100  CONTINUE
      SEGSUP IPMAHY
 
      END