Télécharger hdebi2.eso

Retour à la liste

Numérotation des lignes :

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

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