Télécharger chamas.eso

Retour à la liste

Numérotation des lignes :

chamas
  1. C CHAMAS SOURCE CB215821 21/03/03 21:15:10 10910
  2.  
  3. C=======================================================================
  4. C= C H A M A S =
  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 MASSIFs (1D, 2D, 3D). =
  11. C= =
  12. C= Parametres : (E)=Entree (S)=Sortie =
  13. C= ------------ =
  14. C= IPMODE (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= ISUPCH (E) Support des champs en entree =
  18. C= NOMDUA (E) Nom de la composante du champ de flux equivalents =
  19. C= IPCHAL (S) Pointeur sur le champ des flux equivalents =
  20. C=======================================================================
  21.  
  22. SUBROUTINE CHAMAS (IPMODE,IFORMU, IPCHSO,ISUPCH, NOMDUA, IPCHAL)
  23.  
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8 (A-H,O-Z)
  26.  
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMCHAML
  31. -INC SMMODEL
  32. -INC CCREEL
  33.  
  34. SEGMENT INFO
  35. INTEGER INFELL(JG)
  36. ENDSEGMENT
  37.  
  38. CHARACTER*(*) NOMDUA
  39.  
  40. MMODEL = IPMODE
  41. NSOU=KMODEL(/1)
  42. MCHELM = IPCHAL
  43. MCHEL1 = IPCHSO
  44. NSZ1 = MCHEL1.IMACHE(/1)
  45.  
  46. C 3 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (ISOU)
  47. C ========================================================
  48. C IQGAU : indicateur modele source gaussienne
  49. IQGAU = 0
  50. DO 100 ISOU = 1, NSOU
  51. C =====
  52. C 3.1 - Modele elementaire ISOU
  53. C =====
  54. IMODEL = mmodel.KMODEL(ISOU)
  55. C =====
  56. C 3.2 - Recherche dans le MCHAML des sources (IPCHSO) du maillage
  57. C (IMAMOD) associe au modele elementaire iSou, puis recuperation
  58. C du MCHAML elementaire de sources associe (IPSONO)
  59. C =====
  60. IS0 = 0
  61. IPCHAM = 0
  62. IPSONO = 0
  63. DO is = 1, NSZ1
  64. IF (MCHEL1.IMACHE(is).EQ.imodel.IMAMOD .AND.
  65. & MCHEL1.CONCHE(is).EQ.imodel.CONMOD) THEN
  66. IS0 = IS
  67. IPCHAM = MCHEL1.ICHAML(is)
  68. mchaml = IPCHAM
  69. c il faudrait chercher la composante si le champ en a plus qu'une.
  70. IPSONO = mchaml.IELVAL(1)
  71. GOTO 10
  72. ENDIF
  73. ENDDO
  74. 10 CONTINUE
  75. IF (IPSONO.EQ.0) GOTO 100
  76. C
  77. C =====
  78. C 3.2.x FORMULATION SOURCE
  79. C Construction du MELVAL des valeurs de la distribution
  80. C de chaleur specifiee par le modele
  81. C =====
  82. IK1 = 0
  83. NEF = imodel.NEFMOD
  84. IPGEO = imodel.IMAMOD
  85. IF (IMODEL.MATMOD(1).EQ.'SOURCE ') THEN
  86. C
  87. NMAT = IMODEL.MATMOD(/2)
  88. C Source "sans rien" => rien a faire !
  89. IF (NMAT.EQ.1) THEN
  90. C
  91. C Source GAUSSIENNE
  92. ELSEIF (IMODEL.MATMOD(2).EQ.'GAUSSIENNE') THEN
  93. IK1 = 1
  94. IQGAU = 1
  95. IF (IMODEL.MATMOD(3).EQ.'ISOTROPE_TRANSVE') IK1 = 2
  96. IF (ISUPCH.NE.6) THEN
  97. MOTERR(1:8)='MCHAML'
  98. CALL ERREUR(981)
  99. RETURN
  100. ENDIF
  101. CALL TSHAPE(NEF,'GAUSS',IPINTE)
  102. CALL CHAGA1(IPCHAM,IPGEO,IPINTE,IK1,IPSON1,XQT0)
  103. IF (IERR.NE.0) RETURN
  104. IPSONO=IPSON1
  105. C
  106. C Sinon ERREUR 251
  107. ELSE
  108. CALL ERREUR(251)
  109. RETURN
  110. ENDIF
  111. ENDIF
  112. C
  113. C =====
  114. C 3.3 - Recuperation d'informations sur l'element fini du modele
  115. C elementaire iSou (NEF)
  116. C =====
  117. IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2 .OR. IFORMU.EQ.3) THEN
  118. C* A ce jour : diffusion = thermique (en attendant retour diffusion = mecanique)
  119. C* IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2) THEN
  120. IF (ISUPCH.EQ.6) THEN
  121. CALL TSHAPE(NEF,'GAUSS',IPINTE)
  122. ELSE
  123. write(ioimp,*) 'CHAMAS : inchorence IFORMU ISUPCH'
  124. CALL ERREUR(5)
  125. RETURN
  126. ENDIF
  127. ELSE
  128. IF (imodel.INFMOD(/1).LT.2+ISUPCH) THEN
  129. CALL ELQUOI(NEF,0,ISUPCH,ipinf,imodel)
  130. IF (IERR.NE.0) RETURN
  131. info = ipinf
  132. IPINTE = info.INFELL(11)
  133. SEGSUP,info
  134. ELSE
  135. IPINTE = imodel.INFMOD(2+ISUPCH)
  136. ENDIF
  137. ENDIF
  138. C =====
  139. C 3.4 - Calcul des flux nodaux equivalents (segment MELVAL)
  140. C =====
  141. IF (IDIM.EQ.3) THEN
  142. CALL CHAMA3(IPSONO,IPGEO,IPINTE,IPCHEQ)
  143. ELSE IF (IDIM.EQ.2) THEN
  144. CALL CHAMA2(IPSONO,IPGEO,IPINTE,IPCHEQ)
  145. ELSE IF (IDIM.EQ.1) THEN
  146. CALL CHAMA1(IPSONO,IPGEO,IPINTE,IPCHEQ)
  147. ENDIF
  148. IF (IERR.NE.0) GOTO 100
  149. C =====
  150. C 3.5 - Initialisation du MCHAML des flux de chaleur nodaux equivalents
  151. C (MCHAML) associe au modele elementaire iSou (maillage IMAMOD)
  152. C Remplissage des donnees associees a MCHAML dans MCHELM (global)
  153. C =====
  154. N2 = 1
  155. SEGINI,MCHAML
  156. IF(NOMDUA .NE. ' ') THEN
  157. mchaml.NOMCHE(1) = NOMDUA
  158. ELSE
  159. NOMID=LNOMID(2)
  160. NBROBL=NOMID.LESOBL(/2)
  161. IF(NBROBL .GT. 1)THEN
  162. CALL ERREUR(21)
  163. RETURN
  164. ENDIF
  165. mchaml.NOMCHE(1) = NOMID.LESOBL(1)
  166. ENDIF
  167. mchaml.TYPCHE(1) ='REAL*8'
  168. mchaml.IELVAL(1) = IPCHEQ
  169.  
  170. mchelm.CONCHE(ISOU) = imodel.CONMOD
  171. mchelm.IMACHE(ISOU) = IPGEO
  172. mchelm.ICHAML(ISOU) = MCHAML
  173. mchelm.INFCHE(ISOU,3) = NIFOUR
  174. mchelm.INFCHE(ISOU,6) = 1
  175.  
  176. 100 CONTINUE
  177. C=====
  178. C Fin de la boucle sur les sous-modeles elementaires
  179. C=====
  180. C
  181. END
  182.  
  183.  

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