Télécharger chabat.eso

Retour à la liste

Numérotation des lignes :

  1. C CHABAT SOURCE FANDEUR 16/11/30 21:15:03 9222
  2.  
  3. C=======================================================================
  4. C= C H A B A T =
  5. C= ----------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Calcul des flux equivalents a des sources volumiques dans le cas =
  10. C= des elements BARRE (THERMIQUE) et TUYAU (ADVECTION) =
  11. C= =
  12. C= Parametres : (E)=Entree (S)=Sortie =
  13. C= ------------ =
  14. C= IPMODL (E) Pointeur du MMODEL a traiter =
  15. C= IFORMU (E) Entier indiquant la formulation du modele a traiter =
  16. C= IPCHSO (E) Pointeur du MCHAML de sources =
  17. C= IPCHEB (E) Pointeur du MCHAML de CARACTERISTIQUES =
  18. C= (necessaire pour les elements BARRes et TUYAux) =
  19. C= ISUPCH (E) Support des champs en entree =
  20. C= NOMDUA (E) Nom de la composante du champ de flux equivalents =
  21. C= IPCHAL (S) Pointeur du champ aux noeuds des flux equivalents =
  22. C=======================================================================
  23.  
  24. SUBROUTINE CHABAT (IPMODL,IFORMU, IPCHSO,IPCHEB,ISUPCH, NOMDUA,
  25. & IPCHAL)
  26.  
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8 (A-H,O-Z)
  29.  
  30. -INC CCOPTIO
  31. -INC CCREEL
  32.  
  33. -INC SMCOORD
  34. -INC SMCHAML
  35. -INC SMELEME
  36. -INC SMINTE
  37. -INC SMMODEL
  38.  
  39. SEGMENT INFO
  40. INTEGER INFELL(JG)
  41. ENDSEGMENT
  42.  
  43. SEGMENT MMAT1
  44. REAL*8 XEL(3,NBPTEL),AEL(NBPTEL,NBPTEL)
  45. ENDSEGMENT
  46.  
  47. CHARACTER*(*) NOMDUA
  48.  
  49. MMODEL = IPMODL
  50. ** SEGACT,MMODEL <- Modele actif en E/S
  51. NSOU = KMODEL(/1)
  52.  
  53. MCHELM = IPCHAL
  54. c* SEGACT,MCHELM <- Champ par element actif et modifiable en E/S
  55. c* NSZC = MCHELM.IMACHE(/1) <- On a ici : NSZC = NSOU
  56.  
  57. MCHEL1 = IPCHSO
  58. c* SEGACT,MCHEL1 <- Champ par element actif en E/S
  59. NSZ1 = MCHEL1.IMACHE(/1)
  60.  
  61. MCHEL2 = IPCHEB
  62. c* SEGACT,MCHEL2 <- Champ par element actif en E/S
  63. NSZ2 = MCHEL2.IMACHE(/1)
  64.  
  65. C BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (ISOU)
  66. C ====================================================
  67. DO 100 ISOU = 1, NSOU
  68.  
  69. C Modele elementaire ISOU
  70. C =====
  71. IMODEL = mmodel.KMODEL(ISOU)
  72. c* SEGACT,IMODEL
  73. C =====
  74. C Recherche dans le MCHAML des sources (IPCHSO) de la sous-zone
  75. C associee au modele elementaire ISOU (IMAMOD et CONMOD), puis
  76. C recuperation des valeurs du champ elementaire de sources (MELVA1)
  77. C =====
  78. MELVA1 = 0
  79. DO is = 1, NSZ1
  80. IF (MCHEL1.IMACHE(is).EQ.imodel.IMAMOD .AND.
  81. & MCHEL1.CONCHE(is).EQ.imodel.CONMOD) THEN
  82. mchaml = MCHEL1.ICHAML(is)
  83. SEGACT,mchaml
  84. c il faudrait chercher la composante si le champ en a plus d'une.
  85. MELVA1 = mchaml.IELVAL(1)
  86. SEGDES,mchaml
  87. GOTO 10
  88. ENDIF
  89. ENDDO
  90. 10 CONTINUE
  91. IF (MELVA1.EQ.0) GOTO 100
  92. C =====
  93. C Recherche dans le MCHMAL des caracteristiques (IPCHEB) du
  94. C maillage (IMAMOD) associe au modele elementaire ISOU, puis
  95. C recuperation du MCHAML elementaire associe (MELVA2)
  96. C =====
  97. MELVA2 = 0
  98. DO is = 1, NSZ2
  99. IF (MCHEL2.IMACHE(is).EQ.imodel.IMAMOD .AND.
  100. & MCHEL2.CONCHE(is).EQ.imodel.CONMOD) THEN
  101. mchaml = MCHEL2.ICHAML(is)
  102. SEGACT,mchaml
  103. NCOELE = mchaml.NOMCHE(/2)
  104. IPOSI = 0
  105. CALL PLACE(mchaml.NOMCHE,NCOELE,IPOSI,'SECT')
  106. IF (IPOSI.NE.0) THEN
  107. MELVA2 = mchaml.IELVAL(IPOSI)
  108. ENDIF
  109. SEGDES,mchaml
  110. GOTO 20
  111. ENDIF
  112. ENDDO
  113. 20 CONTINUE
  114. IF (MELVA2.EQ.0) THEN
  115. MOTERR(1:4) = 'SECT'
  116. MOTERR(5:8) = 'CARA'
  117. CALL ERREUR(77)
  118. GOTO 100
  119. ENDIF
  120. C =====
  121. C Informations sur l'element fini du modele ISOU
  122. C =====
  123. NEF = imodel.NEFMOD
  124. MELEME = imodel.IMAMOD
  125. IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2) THEN
  126. c*??? CALL TSHAPE(NEF,'NOEUDS',IPINTE)
  127. CALL TSHAPE(NEF,'GAUSS',IPINTE)
  128. ELSE
  129. IF (imodel.INFMOD(/1).LT.2+ISUPCH) THEN
  130. CALL ELQUOI(NEF,0,ISUPCH,ipinf,imodel)
  131. IF (IERR.NE.0) GOTO 100
  132. info = ipinf
  133. IPINTE = info.INFELL(11)
  134. SEGSUP,info
  135. ELSE
  136. IPINTE = imodel.INFMOD(2+ISUPCH)
  137. ENDIF
  138. ENDIF
  139. C =====
  140. C 3.6 - Calcul des flux nodaux equivalents (segment MELVAL)
  141. C =====
  142. C 3.6.1 - Recuperation d'informations sur le maillage elementaire
  143. MELEME = imodel.IMAMOD
  144. SEGACT,MELEME
  145. NBPTEL = meleme.NUM(/1)
  146. NBELT = meleme.NUM(/2)
  147. C 3.6.2 - Recuperation d'informations sur l'element fini du maillage
  148. MINTE = IPINTE
  149. SEGACT,MINTE
  150. NBPGAU = minte.POIGAU(/1)
  151. c* NBNO = minte.SHPTOT(/2)
  152. C 3.6.3 - Activation du MCHAML contenant les valeurs des sources
  153. SEGACT,MELVA1
  154. NBPTE1 = MELVA1.VELCHE(/1)
  155. NEL1 = MELVA1.VELCHE(/2)
  156. C 3.6.4 - Element fini BARRe : recuperation de la section
  157. SEGACT,MELVA2
  158. IF (IFOMOD.NE.0 .AND. IFOMOD.NE.1) THEN
  159. iBarre = 1
  160. iVA1 = MELVA2.VELCHE(/1)
  161. iMin1 = MIN(1,iVA1)
  162. iMin2 = MIN(2,iVA1)
  163. iVA2 = MELVA2.VELCHE(/2)
  164. ELSE
  165. iBarre = 0
  166. SMoy = 1.D0
  167. ENDIF
  168. C 3.6.5 - Initialisation du segment de travail MMAT1
  169. SEGINI,MMAT1
  170. C 3.6.6 - Initialisation du segment resultat MELVAL des valeurs
  171. C des flux nodaux pour chaque element du maillage (IMAMOD)
  172. N1PTEL = NBPTEL
  173. N1EL = NBELT
  174. N2PTEL = 0
  175. N2EL = 0
  176. SEGINI,MELVAL
  177. C 3.6.7 - Boucle sur les elements du maillage elementaire IMAMOD
  178. DO iELT = 1, NBELT
  179. CALL ZERO(AEL,NBPTEL,NBPTEL)
  180. CALL DOXE(XCOOR,IDIM,NBPTEL,meleme.NUM,iELT,XEL)
  181. IF (iBarre.EQ.1) THEN
  182. i = MIN(iELT,iVA2)
  183. SMoy = (MELVA2.VELCHE(iMin1,i)+MELVA2.VELCHE(iMin2,i))*0.5D0
  184. ENDIF
  185. IF (IDIM.EQ.3) THEN
  186. DO iGau = 1, NBPGAU
  187. DLX = XZERO
  188. DLY = XZERO
  189. DLZ = XZERO
  190. DO i = 1, NBPTEL
  191. r_z = minte.SHPTOT(2,i,iGau)
  192. DLX = DLX + r_z * XEL(1,i)
  193. DLY = DLY + r_z * XEL(2,i)
  194. DLZ = DLZ + r_z * XEL(3,i)
  195. ENDDO
  196. Volu = SMoy * SQRT(DLX*DLX+DLY*DLY+DLZ*DLZ)
  197. & * minte.POIGAU(iGau)
  198. DO i = 1, NBPTEL
  199. r_z = minte.SHPTOT(1,i,iGau) * Volu
  200. DO j = 1, NBPTEL
  201. AEL(i,j) = AEL(i,j) + minte.SHPTOT(1,j,iGau) * r_z
  202. ENDDO
  203. ENDDO
  204. ENDDO
  205. ELSE IF (IDIM.EQ.2) THEN
  206. DO iGau = 1, NBPGAU
  207. DLX = XZERO
  208. DLY = XZERO
  209. DO i = 1, NBPTEL
  210. r_z = minte.SHPTOT(2,i,iGau)
  211. DLX = DLX + r_z * XEL(1,i)
  212. DLY = DLY + r_z * XEL(2,i)
  213. ENDDO
  214. Volu = SMoy*SQRT(DLX*DLX+DLY*DLY)*POIGAU(iGau)
  215. DO i = 1, NBPTEL
  216. r_z = minte.SHPTOT(1,i,iGau) * Volu
  217. DO j = 1,NBPTEL
  218. AEL(i,j) = AEL(i,j) + minte.SHPTOT(1,j,iGau) * r_z
  219. ENDDO
  220. ENDDO
  221. ENDDO
  222. ENDIF
  223. IEMIN = MIN(NEL1,iELT)
  224. DO i = 1, NBPTEL
  225. r_z = XZERO
  226. DO j = 1, NBPTEL
  227. k = MIN(NBPTE1,j)
  228. r_z = r_z + MELVA1.VELCHE(k,IEMIN) * AEL(j,i)
  229. ENDDO
  230. melval.VELCHE(i,iElt) = r_z
  231. ENDDO
  232. ENDDO
  233. C 3.6.8 - Fin du traitement
  234. SEGSUP,MMAT1
  235. SEGDES,MELEME,MINTE
  236. SEGDES,MELVAL,MELVA1,MELVA2
  237. C =====
  238. C Initialisation du MCHAML des flux de chaleur nodaux equivalents
  239. C (MCHAML) associe au modele elementaire ISOU (maillage IMAMOD)
  240. C Remplissage des donnees associees a MCHAML dans MCHELM (global)
  241. C =====
  242. N2 = 1
  243. SEGINI,MCHAML
  244. mchaml.NOMCHE(1) = NOMDUA
  245. mchaml.TYPCHE(1) = 'REAL*8'
  246. mchaml.IELVAL(1) = MELVAL
  247. SEGDES,MCHAML
  248.  
  249. mchelm.CONCHE(ISOU) = imodel.CONMOD
  250. mchelm.IMACHE(ISOU) = MELEME
  251. mchelm.ICHAML(ISOU) = MCHAML
  252. mchelm.INFCHE(ISOU,3) = NIFOUR
  253. mchelm.INFCHE(ISOU,6) = 1
  254.  
  255. C===
  256. 100 CONTINUE
  257. C===
  258. C Fin de la boucle sur les sous-modeles elementaires
  259.  
  260. RETURN
  261. END
  262.  
  263.  
  264.  

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