C HVIT SOURCE CB215821 20/11/25 13:29:59 10792 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