Esope source files

   1 : C DBIT      SOURCE    CHAT      06/08/24    21:25:50     5529           
   2 :       SUBROUTINE DBIT
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   5 : C************************************************************************       
   6 : C
   7 : C OPERATEUR DBIT
   8 : C     CALCUL DU DEBIT D'UN VECTEUR A TRAVERS UNE LIGNE ou une SURFACE
   9 : C                                                             
  10 : C SYNTAXE DE1 = DBIT CHT1 OBJM   ;
  11 : C
  12 : C     CHT1 : OBJET CHAMPOINT DE TYPE VECT SOMMET
  13 : C     OBJM : Objet modèle 'Navier_Stokes'
  14 : C             : a la rigueur table DOMAINE
  15 : C     DE1  : FLOTTANT
  16 : C                                                                               
  17 : C                                                                               
  18 : C************************************************************************       
  19 :       CHARACTER*8 TYPE,LTAB(1),NOM
  20 : -INC CCOPTIO
  21 : -INC SMELEME
  22 :       POINTEUR MELES1.MELEME,IGEOME.MELEME
  23 : -INC SMCHPOI
  24 :       POINTEUR IZTUU.MPOVAL
  25 : -INC SMLENTI
  26 :       POINTEUR IZIPAD.MLENTI
  27 : C***********************************************************************
  28 :                IMPR=0
  29 :                IKF =0
  30 :                NM=0
  31 :  10            CONTINUE
  31 :                CALL LIRCHA(NOM,0,LCHAR)
  32 :                IF(LCHAR.NE.0.AND.NOM.EQ.'IMPR')THEN
  33 :                NM = NM+1
  34 :                IMPR=1
  35 :                IF(NM.LE.1)GO TO 10
  36 :                ENDIF
  37 :                IF(LCHAR.NE.0.AND.NOM.EQ.'ALGE')THEN
  38 :                NM = NM+1
  39 :                IKF =1
  40 :                IF(NM.LE.1)GO TO 10
  41 :                ENDIF
  42 : *
  43 : * Lecture du CHPOINT
  44 : *
  44 :       CALL LIROBJ('CHPOINT',IZTU,1,IRETOU)
  45 :       IF(IRETOU.EQ.0) THEN
  46 : C% Information manquante (objet CHPOINT) : pas de définition de la densité
  46 :       CALL ERREUR(839)
  47 :       RETURN
  48 :       ENDIF
  49 : *
  50 : * Lecture de l'objet modele 'Navier-Stokes' à la rigueur une table DOMAINE
  51 : *
  51 :       CALL LITDMD(MMODEL,MTABD,IRETOU)
  52 :       IF(IRETOU.EQ.0)RETURN
  52 :       IF(MTABD.EQ.0)CALL LEKMOD(MMODEL,MTABD,INEFMD)
  53 : C INEFMD=1 LINE  =2 MACRO  =3 QUADRATIQUE
  54 : 
  54 :       CALL LICHT(IZTU,IZTUU,TYPE,IGEOME)
  55 : *
  56 : * On s'assure que le champ est du type VECT/*
  57 : *
  58 :       NC=IZTUU.VPOCHA(/2)
  59 : 
  60 :       IF(NC.NE.IDIM) THEN
  61 :         SEGDES IZTUU
  62 : C        Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes
  63 :             MOTERR( 1: 8) = ' '
  64 :             MOTERR( 9:16) = 'CHPOINT '
  64 :             CALL ERREUR(784)
  65 :       RETURN
  66 :       ENDIF
  67 : *
  68 : * On v‚rifie que le support du champ comprend le maillage
  69 : * sur lequel on cherche le d‚bit.
  70 : *
  70 :       CALL KRIPAD(IGEOME,IZIPAD)
  71 :       MLENTI=IZIPAD
  72 :  
  72 :       CALL LEKTAB(MTABD,'SOMMET',MELES1)
  72 :       CALL LEKTAB(MTABD,'MAILLAGE',MELEME)
  73 :       IF (IERR.NE.0) RETURN
  74 :  
  75 :       SEGACT MELES1
  76 :       NPM=MELES1.NUM(/2)
  77 :       DO 1 I=1,NPM
  78 :       I1=MELES1.NUM(1,I)
  79 :  
  80 :       IF(LECT(I1).EQ.0)THEN
  81 :       SEGDES IZTUU
  82 : C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  83 :          MOTERR(1: 8) = ' '
  84 :          MOTERR(9:16) = 'CHPOINT '
  84 :          CALL ERREUR(788)
  85 :       SEGSUP IZIPAD
  86 :       SEGDES MELES1
  87 :       RETURN
  88 :       ENDIF
  89 :  1    CONTINUE
  90 :       SEGDES IGEOME,MELES1
  91 :  
  92 :  
  93 : *
  94 : * Calcul effectif du d‚bit
  95 : *
  96 :  
  97 :       IAXI=0
  98 :       IF(IFOMOD.EQ.0)IAXI=2
  98 :       CALL KFDBIT(IZTUU,MELEME,IZIPAD,IAXI,Q,ULP,ULM,IMPR)
  99 : 
 100 :       IF(IKF.EQ.0)THEN
 100 :       CALL ECRREE(Q)
 101 :       ELSE
 101 :       CALL ECRREE(ULM)
 101 :       CALL ECRREE(ULP)
 102 :       ENDIF
 103 :   
 104 :   
 105 :       SEGSUP IZIPAD
 106 :       RETURN
 107 :       END
 108 :  
 109 :