Télécharger la plaquette Cast3M


fr en

Télécharger dbit.eso

Retour à la liste

Numérotation des lignes : 

dbit

  1. C DBIT      SOURCE    CB215821  20/11/25    13:24:09     10792          
  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.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. -INC SMELEME
  24.       POINTEUR MELES1.MELEME,IGEOME.MELEME
  25. -INC SMCHPOI
  26.       POINTEUR IZTUU.MPOVAL
  27. -INC SMLENTI
  28.       POINTEUR IZIPAD.MLENTI
  29. -INC SMCOORD
  30. C***********************************************************************
  31.                segact mcoord
  32.                IMPR=0
  33.                IKF =0
  34.                NM=0
  35.  10            CONTINUE
  36.                CALL LIRCHA(NOM,0,LCHAR)
  37.                IF(LCHAR.NE.0.AND.NOM.EQ.'IMPR')THEN
  38.                NM = NM+1
  39.                IMPR=1
  40.                IF(NM.LE.1)GO TO 10
  41.                ENDIF
  42.                IF(LCHAR.NE.0.AND.NOM.EQ.'ALGE')THEN
  43.                NM = NM+1
  44.                IKF =1
  45.                IF(NM.LE.1)GO TO 10
  46.                ENDIF
  47. *
  48. * Lecture du CHPOINT
  49. *
  50.       CALL LIROBJ('CHPOINT',IZTU,1,IRETOU)
  51.       IF(IRETOU.EQ.0) THEN
  52. C% Information manquante (objet CHPOINT) : pas de définition de la densité
  53.       CALL ERREUR(839)
  54.       RETURN
  55.       ENDIF
  56. *
  57. * Lecture de l'objet modele 'Navier-Stokes' à la rigueur une table DOMAINE
  58. *
  59.       CALL LITDMD(MMODEL,MTABD,IRETOU)
  60.       IF(IRETOU.EQ.0)RETURN
  61.       IF(MTABD.EQ.0)CALL LEKMOD(MMODEL,MTABD,INEFMD)
  62. C INEFMD=1 LINE  =2 MACRO  =3 QUADRATIQUE
  63.  
  64.       CALL LICHT(IZTU,IZTUU,TYPE,IGEOME)
  65. *
  66. * On s'assure que le champ est du type VECT/*
  67. *
  68.       NC=IZTUU.VPOCHA(/2)
  69.  
  70.       IF(NC.NE.IDIM) THEN
  71.         SEGDES IZTUU
  72. C        Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes
  73.             MOTERR( 1: 8) = ' '
  74.             MOTERR( 9:16) = 'CHPOINT '
  75.             CALL ERREUR(784)
  76.       RETURN
  77.       ENDIF
  78. *
  79. * On v‚rifie que le support du champ comprend le maillage
  80. * sur lequel on cherche le d‚bit.
  81. *
  82.       CALL KRIPAD(IGEOME,IZIPAD)
  83.       MLENTI=IZIPAD
  84.  
  85.       CALL LEKTAB(MTABD,'SOMMET',MELES1)
  86.       CALL LEKTAB(MTABD,'MAILLAGE',MELEME)
  87.       IF (IERR.NE.0) RETURN
  88.  
  89.       SEGACT MELES1
  90.       NPM=MELES1.NUM(/2)
  91.       DO 1 I=1,NPM
  92.       I1=MELES1.NUM(1,I)
  93.  
  94.       IF(LECT(I1).EQ.0)THEN
  95.       SEGDES IZTUU
  96. C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  97.          MOTERR(1: 8) = ' '
  98.          MOTERR(9:16) = 'CHPOINT '
  99.          CALL ERREUR(788)
  100.       SEGSUP IZIPAD
  101.       SEGDES MELES1
  102.       RETURN
  103.       ENDIF
  104.  1    CONTINUE
  105.       SEGDES IGEOME,MELES1
  106.  
  107.  
  108. *
  109. * Calcul effectif du d‚bit
  110. *
  111.  
  112.       IAXI=0
  113.       IF(IFOMOD.EQ.0)IAXI=2
  114.       CALL KFDBIT(IZTUU,MELEME,IZIPAD,IAXI,Q,ULP,ULM,IMPR)
  115.  
  116.       IF(IKF.EQ.0)THEN
  117.       CALL ECRREE(Q)
  118.       ELSE
  119.       CALL ECRREE(ULM)
  120.       CALL ECRREE(ULP)
  121.       ENDIF
  122.  
  123.  
  124.       SEGSUP IZIPAD
  125.       RETURN
  126.       END
  127.  
  128.  
  129.  
  130.  
  131.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales