Télécharger la plaquette Cast3M


fr en

Télécharger hdebi2.eso

Retour à la liste

Numérotation des lignes : 

hdebi2

  1. C HDEBI2    SOURCE    CB215821  20/11/25    13:29:53     10792          
  2. C HDEBI1    SOURCE    CHAT      97/12/23    22:20:50     3021
  3.       SUBROUTINE HDEBI2(IPMAHY,IPFACE,IPDARC,ICHP0,IPCHEL,
  4.      S     ICHP1,ICHP2,ITTH,INORM,IORIE,ISURF,IPFORC,IFORC,IRET)
  5. C-----------------------------------------------------------------------
  6. C Calcul le débit aux faces et orientation suivant le sens de la normale
  7. C   lorsqu'on connait la concentrations au centre
  8. C-----------------------------------------------------------------------
  9. C
  10. C---------------------------
  11. C Parametres Entree/Sortie :
  12. C---------------------------
  13. C
  14. C E/  IPMAHY  : MELEME des connectivités éléments/faces pour Darcy
  15. C E/  IPFACE  : MELEME des points FACEs                    -1
  16. C E/  IPDARC  : RIGIDITE de sous type DARCY (contient RE  ).
  17. C E/  ICHP0   : CHPO face des traces de concentration au temps n
  18. C E/  IPCHEL  : MCHAML des orientations de normale (1=out,-1=in)
  19. C E/  ICHP1   : CHPO concentration au centre au temps n
  20. C
  21. C Parametre optionnel
  22. C E/  ICHP2   : CHPO face flux de vitesse
  23. C
  24. C  /S IRET    : CHPO face des flux les noms des composantes sont
  25. C                ceux des composantes de ITPN et IPCH1.
  26. C               Si ICHP2 est donné on ajoute le flux convectif
  27. C
  28. C----------------------
  29. C Variables en COMMON :
  30. C----------------------
  31. C
  32. C E/  IFOUR   : cf CCOPTIO
  33. C E/  IDIM    : cf CCOPTIO
  34. C
  35. C----------------------
  36. C Tableaux de travail :
  37. C----------------------
  38. C
  39. C  ICPR(I)=J : Le noeud I a le numero J dans le MELEME des faces
  40. C              Correspondance numérotation globale/locale
  41. C  ITES      : Nombre de noeuds FACE
  42. C  NNGOT     : Nombre de noeuds total du domaine
  43. C  IVAA(I)   : indice du CHAMPOINT au Ieme noeud global
  44. C
  45. C-----------------------------------------------------------------------
  46. C
  47. C Langage : ESOPE + FORTRAN77
  48. C
  49. C Auteurs : 09/93 F.DABBENE - Cas permanent
  50. C           09/94 X.NOUVELLON - Extension au cas transitoire
  51. C           02/96 L.V.BENET - Prise en compte de forces de volume
  52. C           05/98 F.AURIOL expression en fonction des concentrations
  53. C                         (charges) et traces de concentrations (traces
  54. C                          de concentrations) possibilités de champs
  55. C                         à plusieurs composantes, en transitoire.
  56. C
  57. C-----------------------------------------------------------------------
  58.       IMPLICIT INTEGER(I-N)
  59.       IMPLICIT REAL*8 (A-H,O-Z)
  60. *
  61.  
  62. -INC PPARAM
  63. -INC CCOPTIO
  64. -INC SMELEME
  65. -INC SMCHPOI
  66.       POINTEUR MCHPO5.MCHPOI,MCHPO6.MCHPOI,MSOUP6.MSOUPO
  67. -INC SMCHAML
  68. -INC SMRIGID
  69. -INC SMCOORD
  70. *
  71.       CHARACTER*(LOCOMP) MOREFD,MOREFP
  72.       SEGMENT IPMAHY
  73.          INTEGER MAHYBR(NSOUS)
  74.       ENDSEGMENT
  75.       SEGMENT ICCPR
  76.          INTEGER ICPR(NNGOT)
  77.       ENDSEGMENT
  78.       SEGMENT IORGA
  79.          INTEGER IVAA(ITES), IVBB(ITES)
  80.       ENDSEGMENT
  81.       SEGMENT ITRAV
  82.          REAL*8  RLIGNE(NBDDL)
  83.          REAL*8 FLFOR(NBDDL),RFOR(NBDDL)
  84.       ENDSEGMENT
  85. C
  86. C
  87. *' Initialisations'
  88. C
  89.       MRIGID = IPDARC
  90.       RI1    = IPFORC
  91.       MCHELM = IPCHEL
  92.       IPT1   = IPFACE
  93.       MCHPO1 = ICHP0
  94.       MCHPO2 = ICHP1
  95.       MCHPO3 = ICHP2
  96.       IRET   = 0
  97.       MCHEL2 = IORIE
  98.       MCHPO4 = IFORC
  99.       MCHPO5 = INORM
  100.       MCHPO6 = ISURF
  101. C
  102.       SEGACT IPMAHY
  103.       NBMAIL = MAHYBR(/1)
  104.       SEGACT MRIGID
  105. *
  106. *' Creation du tableau ICPR pour le maillage IPT1'
  107. *
  108.       NNGOT  = nbpts
  109.       SEGINI ICCPR
  110.       SEGACT IPT1
  111.       N2 = IPT1.NUM(/2)
  112.       IK = 0
  113.       DO 15 I2=1,N2
  114.          K = IPT1.NUM(1,I2)
  115.          IF (ICPR(K).EQ.0) THEN
  116.             IK      = IK + 1
  117.             ICPR(K) = IK
  118.          ENDIF
  119.  15   CONTINUE
  120.       SEGDES IPT1
  121.       ITES = IK
  122. *
  123. *' Activation du MPOVAL du CHPO  de traces de concentrations
  124. *
  125.       SEGACT MCHPO1
  126.       MSOUP1 = MCHPO1.IPCHP(1)
  127.       SEGDES MCHPO1
  128.       SEGACT MSOUP1
  129.       MPOVA1 = MSOUP1.IPOVAL
  130.       SEGACT MPOVA1
  131.       NBCOMP= MPOVA1.VPOCHA(/2)
  132. *
  133. * Activation du MPOVAL du CHPO des concentrations au centre
  134. *
  135.       SEGACT MCHPO2
  136.       MSOUP2 = MCHPO2.IPCHP(1)
  137.       SEGDES MCHPO2
  138.       SEGACT MSOUP2
  139.       MPOVA2 = MSOUP2.IPOVAL
  140.       SEGACT MPOVA2
  141. *
  142. * Activation du MPOVAL du CHPO flux de vitesses aux faces
  143. *
  144.       IF (ICHP2.NE.0) THEN
  145.          SEGACT MCHPO3
  146.          MSOUP3 = MCHPO3.IPCHP(1)
  147.          SEGDES MCHPO3
  148.          SEGACT MSOUP3
  149.          MPOVA3 = MSOUP3.IPOVAL
  150.          SEGACT MPOVA3
  151.       ENDIF
  152. *
  153. * activation des objets liés à la présence d'une force volumique
  154. *
  155.       IF (IFORC.NE.0) THEN
  156. *
  157. * Activation du MPOVAL du CHPO force appuyé au centre des éléments volumiques
  158. *
  159.          SEGACT MCHPO4
  160.          MSOUP4 = MCHPO4.IPCHP(1)
  161.          SEGDES MCHPO4
  162.          SEGACT MSOUP4
  163.          MPOVA4 = MSOUP4.IPOVAL
  164.          SEGDES MSOUP4
  165.          SEGACT MPOVA4
  166. *
  167. * Activation du MPOVAL du CHPO des vecteurs normales appuyé au centre des faces
  168. *
  169.          SEGACT MCHPO5
  170.          MSOUP5 = MCHPO5.IPCHP(1)
  171.          SEGDES MCHPO5
  172.          SEGACT MSOUP5
  173.          MPOVA5 = MSOUP5.IPOVAL
  174.          SEGDES MSOUP5
  175.          SEGACT MPOVA5
  176. *
  177. * Activation du MPOVAL du CHPO des surfaces appuyé au centre des faces
  178. *
  179.          SEGACT MCHPO6
  180.          MSOUP6 = MCHPO6.IPCHP(1)
  181.          SEGDES MCHPO6
  182.          SEGACT MSOUP6
  183.          MPOVA6 = MSOUP6.IPOVAL
  184.          SEGDES MSOUP6
  185.          SEGACT MPOVA6
  186. *
  187. * Activation du MCHEL des orientations des faces
  188. *
  189.          SEGACT MCHEL2
  190. *
  191. * Activation du MRIGI de la matrice masse hybride
  192. *
  193.          SEGACT RI1
  194.       ENDIF
  195. *
  196. * On recherche l ordre des traces de concentrations par rapport à IPT1
  197. *
  198.       SEGINI IORGA
  199.       MELEME = MSOUP1.IGEOC
  200.       SEGACT MELEME
  201.       N2 = NUM(/2)
  202.       DO 25 I2=1,N2
  203.          K = NUM(1,I2)
  204.          IF (ICPR(K).EQ.0) THEN
  205.             INTERR(1)   = K
  206.             MOTERR(1:8) = 'FACE    '
  207.             CALL ERREUR(64)
  208.             SEGDES  MELEME, MSOUP1
  209.             SEGDES MCHPO2, MRIGID, IPMAHY
  210.             SEGSUP ICCPR, IORGA
  211.             RETURN
  212.          ELSE
  213.             IVAA(ICPR(K)) = I2
  214.          ENDIF
  215.   25  CONTINUE
  216.       SEGDES MELEME
  217.       CALL INITI( IVBB,ITES,0)
  218. *
  219. * Construction de CHPOIN resultat les composantes ont les noms
  220. *   de celles des concentrations au centre ( ou aux faces)
  221. *
  222.       SEGACT IPT1
  223.       NPN=IPT1.NUM(/2)
  224.       SEGDES IPT1
  225.       NSOUPO=1
  226.       NAT=1
  227.       SEGINI MCHPOI
  228.       MTYPOI='        '
  229.       MOCHDE='      CHPOIN CREE PAR HDEBI1                    '
  230.       IFOPOI=IFOUR
  231.       JATTRI(1)=2
  232.       NC=NBCOMP
  233.       SEGINI MSOUPO
  234.       IPCHP(1)=MSOUPO
  235.       DO 5 L=1,NBCOMP
  236.             NOCOMP(L)=MSOUP1.NOCOMP(L)
  237.             NOHARM(L)=MSOUP1.NOHARM(L)
  238.     5 CONTINUE
  239.       IGEOC=IPFACE
  240.       N=NPN
  241.       SEGINI MPOVAL
  242.       IPOVAL=MPOVAL
  243.       NB=N*NC
  244.       CALL INITD(VPOCHA,NB,0.D0)
  245.       IF(ITTH.EQ.1) THEN
  246. C
  247. C  cas des traces de charges récupération du nom des composantes
  248. C
  249.       NBMAIL = MAHYBR(/1)
  250.       DO 27 IMAIL=1,NBMAIL
  251.          IF (MAHYBR(IMAIL).NE.0) THEN
  252.             DESCR  = IRIGEL(3,IMAIL)
  253.             SEGACT DESCR
  254.             MOREFD = LISDUA(1)
  255.             MOREFP = LISINC(1)
  256.             SEGDES DESCR
  257.             GOTO 30
  258.          ENDIF
  259.  27   CONTINUE
  260.  30   CONTINUE
  261.       NOCOMP(1)=MOREFD
  262.       ENDIF
  263. *
  264. *
  265. *
  266. C
  267. C--------------------------------------------------
  268. *' Boucle 310 sur les OBJETS RIGIDITES ELEMENTAIRES'
  269. C--------------------------------------------------
  270. C
  271.       ITELEM = 0
  272.       SEGACT MCHELM
  273.       DO 310 IRI=1,NBMAIL
  274. C
  275. C Récupération MELEME ou Darcy est défini
  276. C
  277.          MELEME = MAHYBR(IRI)
  278.          IF (MELEME.EQ.0) GOTO 310
  279.          SEGACT MELEME
  280.          N1 = NUM(/1)
  281.          N2 = NUM(/2)
  282. C
  283. C Récupération des infos pour la zone IRI dans le chapeau MRIGID
  284. C
  285.          DESCR  = IRIGEL(3,IRI)
  286.          SEGACT DESCR
  287.          NBDDL  = LISDUA(/2)
  288.          SEGDES DESCR
  289.          SEGINI ITRAV
  290.          xMATRI = IRIGEL(4,IRI)
  291.          SEGACT xMATRI
  292. C
  293. C Activation du MELVAL du MCHAML d'orientation
  294. C
  295.          MCHAML = ICHAML(IRI)
  296.          SEGACT MCHAML
  297.          MELVAL = IELVAL(1)
  298.          SEGDES MCHAML
  299.          SEGACT MELVAL
  300. *
  301. * Activation des objets necessaires à la prise en compte des forces de volumes
  302. *
  303.          IF (IFORC.NE.0) THEN
  304.            MCHAM2 = MCHEL2.ICHAML(IRI)
  305.            SEGACT MCHAM2
  306.            MELVA2 = MCHAM2.IELVAL(1)
  307.            SEGDES MCHAM2
  308.            SEGACT MELVA2
  309.            xMATR1 = RI1.IRIGEL(4,IRI)
  310.            SEGACT xMATR1
  311.          ELSE
  312.             DO 35 I=1,NBDDL
  313.                RFOR(I)=0.D0
  314.    35       CONTINUE
  315.          ENDIF
  316. C
  317. C------------------------------------------
  318. *' Boucle 300 sur les MATRICES ELEMENTAIRES.'
  319. C------------------------------------------
  320. C
  321.          DO 300 I2=1,N2
  322.             ITELEM = ITELEM + 1
  323.  
  324.             IF (IFORC.NE.0) THEN
  325. *
  326. *- calcul des flux de forces aux faces de l'element
  327. *
  328.                DO 55 IDDL=1,NBDDL
  329.                  FLFOR(IDDL)= 0.D0
  330.                  IPOPTS = ICPR(NUM(IDDL,I2))
  331.                  DO 50 I=1,IDIM
  332.                    FLFOR(IDDL) = FLFOR(IDDL) + MPOVA5.VPOCHA(IPOPTS,I) *
  333.      S             MELVA2.VELCHE(IDDL,I2) * MPOVA4.VPOCHA(ITELEM,I) *
  334.      S             MPOVA6.VPOCHA(IPOPTS,1)
  335.   50             CONTINUE
  336.   55           CONTINUE
  337. *
  338. *- Construction du tableau aux faces M.FORCE
  339. *
  340. *               XMATR1 = IMATR1.IMATTT(I2)
  341. *              SEGACT XMATR1
  342.                DO 65 I=1,NBDDL
  343.                   RFOR(I)=0.D0
  344.                   DO 60 J=1,NBDDL
  345.                      RFOR(I)   = RFOR(I) + XMATR1.RE(I,J,i2)*FLFOR(J)
  346.   60              CONTINUE
  347.   65           CONTINUE
  348. *               SEGDES XMATR1
  349.             ENDIF
  350. *
  351. * Recuperation de la matrice elementaire
  352. *
  353. *            XMATRI = IMATTT(I2)
  354. *            SEGACT XMATRI
  355. *
  356. *- De la somme des coefs pour une ligne
  357. *-               -1 t
  358. *-     LIGNE = RE  * DIV
  359. *-                           -1  t
  360.             DO 140 I=1,NBDDL
  361.                RLIGNE(I) = 0.D0
  362.                DO 130 J=1,NBDDL
  363.                   RLIGNE(I)   = RLIGNE(I) + RE(I,J,i2)
  364.  130           CONTINUE
  365.  140        CONTINUE
  366. C
  367. C Calcul du flux aux faces
  368. C
  369.             DO 200 IN=1,NBDDL
  370.                NUMFA = ICPR(NUM(IN,I2))
  371.                IF (IVBB(NUMFA).EQ.0) THEN
  372.                VVV= 0.D0
  373.                IF(ICHP2.NE.0)THEN
  374.                     VVV=MPOVA3.VPOCHA(NUMFA,1)
  375.                ENDIF
  376.                DO 180 K=1,NBCOMP
  377.                   VA1 = 0.D0
  378.                   VA2 = 0.D0
  379.                   DO 190 JN=1,NBDDL
  380.                   VA1 = VA1+RE(IN,JN,i2)*(MPOVA1.VPOCHA(
  381.      S            IVAA(ICPR(NUM(JN,I2))),K)-RFOR(JN))
  382.  190              CONTINUE
  383.                   VA2=RLIGNE(IN)*MPOVA2.VPOCHA(ITELEM,K)
  384.                   VA3= VVV*MPOVA1.VPOCHA(NUMFA,K)
  385.                   VPOCHA(NUMFA,K) = (VA2 -VA1+ VA3 ) * VELCHE(IN,I2)
  386.  180           CONTINUE
  387.                IVBB(NUMFA)=1
  388.                ENDIF
  389.  200        CONTINUE
  390. *            SEGDES XMATRI
  391.  300     CONTINUE
  392.  
  393.          SEGDES MELVAL, xMATRI, MELEME
  394.          SEGSUP ITRAV
  395.          IF (IFORC.NE.0) THEN
  396.             SEGDES MELVA2, xMATR1
  397.          ENDIF
  398.  310  CONTINUE
  399. C
  400. C     Nettoyage final
  401. C
  402.       SEGDES MCHELM, MRIGID, IPMAHY, MSOUPO, MPOVAL, MCHEL2
  403.       SEGDES MSOUP1, MPOVA1
  404.       SEGDES MSOUP2, MPOVA2
  405.       IF (MCHPO3.NE.0) SEGDES MPOVA3,MSOUP3
  406.       IF (IFORC.NE.0) THEN
  407.          SEGDES RI1
  408.          SEGDES MSOUP4, MPOVA4
  409.          SEGDES MSOUP5, MPOVA5
  410.          SEGDES MSOUP6, MPOVA6
  411.       ENDIF
  412. C
  413.       SEGDES MCHPOI
  414.       IRET = MCHPOI
  415. C
  416.       SEGSUP IORGA, ICCPR
  417. C
  418.       RETURN
  419.       END
  420.  
  421.  
  422.  
  423.  
  424.  
  425.  
  426.  
  427.  
  428.  
  429.  
  430.  
  431.  
  432.  
  433.  
  434.  

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