C DBIT SOURCE CHAT 06/08/24 21:25:50 5529 SUBROUTINE DBIT IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C************************************************************************ C C OPERATEUR DBIT C CALCUL DU DEBIT D'UN VECTEUR A TRAVERS UNE LIGNE ou une SURFACE C C SYNTAXE DE1 = DBIT CHT1 OBJM ; C C CHT1 : OBJET CHAMPOINT DE TYPE VECT SOMMET C OBJM : Objet modèle 'Navier_Stokes' C : a la rigueur table DOMAINE C DE1 : FLOTTANT C C C************************************************************************ CHARACTER*8 TYPE,LTAB(1),NOM -INC CCOPTIO -INC SMELEME POINTEUR MELES1.MELEME,IGEOME.MELEME -INC SMCHPOI POINTEUR IZTUU.MPOVAL -INC SMLENTI POINTEUR IZIPAD.MLENTI C*********************************************************************** IMPR=0 IKF =0 NM=0 10 CONTINUE CALL LIRCHA(NOM,0,LCHAR) IF(LCHAR.NE.0.AND.NOM.EQ.'IMPR')THEN NM = NM+1 IMPR=1 IF(NM.LE.1)GO TO 10 ENDIF IF(LCHAR.NE.0.AND.NOM.EQ.'ALGE')THEN NM = NM+1 IKF =1 IF(NM.LE.1)GO TO 10 ENDIF * * Lecture du CHPOINT * CALL LIROBJ('CHPOINT',IZTU,1,IRETOU) IF(IRETOU.EQ.0) THEN C% Information manquante (objet CHPOINT) : pas de définition de la densité CALL ERREUR(839) RETURN ENDIF * * Lecture de l'objet modele 'Navier-Stokes' à la rigueur une table DOMAINE * CALL LITDMD(MMODEL,MTABD,IRETOU) IF(IRETOU.EQ.0)RETURN IF(MTABD.EQ.0)CALL LEKMOD(MMODEL,MTABD,INEFMD) C INEFMD=1 LINE =2 MACRO =3 QUADRATIQUE CALL LICHT(IZTU,IZTUU,TYPE,IGEOME) * * On s'assure que le champ est du type VECT/* * NC=IZTUU.VPOCHA(/2) IF(NC.NE.IDIM) THEN SEGDES IZTUU C Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes MOTERR( 1: 8) = ' ' MOTERR( 9:16) = 'CHPOINT ' CALL ERREUR(784) RETURN ENDIF * * On v‚rifie que le support du champ comprend le maillage * sur lequel on cherche le d‚bit. * CALL KRIPAD(IGEOME,IZIPAD) MLENTI=IZIPAD CALL LEKTAB(MTABD,'SOMMET',MELES1) CALL LEKTAB(MTABD,'MAILLAGE',MELEME) IF (IERR.NE.0) RETURN SEGACT MELES1 NPM=MELES1.NUM(/2) DO 1 I=1,NPM I1=MELES1.NUM(1,I) IF(LECT(I1).EQ.0)THEN SEGDES IZTUU C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR(1: 8) = ' ' MOTERR(9:16) = 'CHPOINT ' CALL ERREUR(788) SEGSUP IZIPAD SEGDES MELES1 RETURN ENDIF 1 CONTINUE SEGDES IGEOME,MELES1 * * Calcul effectif du d‚bit * IAXI=0 IF(IFOMOD.EQ.0)IAXI=2 CALL KFDBIT(IZTUU,MELEME,IZIPAD,IAXI,Q,ULP,ULM,IMPR) IF(IKF.EQ.0)THEN CALL ECRREE(Q) ELSE CALL ECRREE(ULM) CALL ECRREE(ULP) ENDIF SEGSUP IZIPAD RETURN END