Télécharger chaga2.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAGA2 SOURCE PASCAL 19/11/19 21:15:10 10384
  2.  
  3. C=======================================================================
  4. C= C H A G A 2 =
  5. C= ----------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Calcule la chaleur totale imposee et la "renormalise" a celle =
  10. C= demandee par les modeles de source de chaleur qui le necessite =
  11. C= (caracteristique QTOT pour source gaussienne). =
  12. C= =
  13. C= La quantite totale de chaleur fournie par les modeles qui ne =
  14. C= necessite pas de renormalisation sur leur sous-zone de definition =
  15. C= doit etre ajoutee a la quantite totale de chaleur demandee. =
  16. C= =
  17. C= Parametres : (E)=Entree (S)=Sortie =
  18. C= ------------ =
  19. C= IPMODE (E) Pointeur du MMODEL a traiter =
  20. C= IPCHSO (E) Pointeur du MCHAML de caracteristiques des sources =
  21. C= IPCHA1 (E) Pointeur du MCHAML de flux de chaleur integres =
  22. C= IPCHA2 (S) Pointeur du MCHAML de flux de chaleur "renormalise" =
  23. C= =
  24. C=======================================================================
  25.  
  26. SUBROUTINE CHAGA2(IPMODE,IPCHSO,IPCHA1,IPCHA2)
  27.  
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8 (A-H,O-Z)
  30.  
  31. -INC CCOPTIO
  32. -INC SMCHAML
  33. -INC SMMODEL
  34. -INC CCREEL
  35.  
  36. CHARACTER*4 MQTOT(1)
  37.  
  38. DATA MQTOT /'QTOT'/
  39.  
  40. SEGMENT TRAVSP1
  41. INTEGER LNCONS(NS1)
  42. ENDSEGMENT
  43. SEGMENT TRAVSP2
  44. REAL*8 LQCONS(NC1)
  45. ENDSEGMENT
  46.  
  47. C=====
  48. C Initialisations
  49. C=====
  50. MMODEL = IPMODE
  51. NSOU = KMODEL(/1)
  52. MCHELM = IPCHSO
  53. MCHEL1 = IPCHA1
  54. IPCHA2 = 0
  55.  
  56. C Segment L(J)=I, Je sous-zone, Ie constituant : mise a zero
  57. NS1 = NSOU
  58. SEGINI,TRAVSP1
  59. DO 1 IS1 = 1,NS1
  60. LNCONS(IS1) = 0
  61. 1 CONTINUE
  62. C
  63. C=====
  64. C Precondionnement : identification du nb. de constituants
  65. C et de leurs sous-zones resp.
  66. C=====
  67. NBCONS = 0
  68. DO 10 ISOU = 1,NSOU
  69. IF (LNCONS(ISOU).NE.0) GOTO 10
  70. NBCONS = NBCONS + 1
  71. IMODEL = MMODEL.KMODEL(ISOU)
  72. NLCONI = IMODEL.CONMOD(/1)
  73. DO 11 JSOU = ISOU,NSOU
  74. IF (LNCONS(JSOU).NE.0) GOTO 11
  75. IMODE1 = MMODEL.KMODEL(JSOU)
  76. NLCONJ = IMODE1.CONMOD(/1)
  77. IF (NLCONJ.EQ.NLCONI) THEN
  78. IF (IMODEL.CONMOD.EQ.IMODE1.CONMOD) THEN
  79. LNCONS(JSOU) = NBCONS
  80. ENDIF
  81. ENDIF
  82. 11 CONTINUE
  83. 10 CONTINUE
  84. c write(6,*) ' LNCONS =',(LNCONS(i),i=1,nsou)
  85. C
  86. IF (NBCONS.EQ.0) THEN
  87. WRITE(IOIMP,*) ' Probleme identification constituants'
  88. CALL ERREUR(21)
  89. RETURN
  90. ENDIF
  91. C
  92. C=====
  93. C Boucle Sommation des flux nodaux de IPCHA1 (MCHEL1)
  94. C=====
  95. C LQCONS : quantite totale de chaleur par constituant
  96. C
  97. C Mise a zero de LQCONS
  98. NC1 = NBCONS
  99. SEGINI,TRAVSP2
  100. DO 20 IC1 = 1,NC1
  101. LQCONS(IC1) = 0.D0
  102. 20 CONTINUE
  103. C
  104. XQT0 = 0.D0
  105. XQT1 = 0.D0
  106. NCON = 0
  107.  
  108. DO 100 ISOU = 1, NSOU
  109. C
  110. C Distinction sous-zone modele avec QTOT ou non
  111. MCHAML = MCHELM.ICHAML(ISOU)
  112. SEGACT,MCHAML
  113. N2 = MCHAML.NOMCHE(/2)
  114. CALL PLACE(MCHAML.NOMCHE,N2,IPLACE,MQTOT(1))
  115. IF (IPLACE.EQ.0) GOTO 100
  116. C
  117. C Calcul de XQT1
  118. ICONS = LNCONS(ISOU)
  119. MCHAM1 = MCHEL1.ICHAML(ISOU)
  120. MELVA1 = MCHAM1.IELVAL(1)
  121. NBPT1 = MELVA1.VELCHE(/1)
  122. NBEL1 = MELVA1.VELCHE(/2)
  123. DO 110 IEL1=1,NBEL1
  124. DO 111 IPT1=1,NBPT1
  125. LQCONS(ICONS) = LQCONS(ICONS) + MELVA1.VELCHE(IPT1,IEL1)
  126. 111 CONTINUE
  127. 110 CONTINUE
  128. 100 CONTINUE
  129. C======
  130. C Fin boucle somme flux nodaux
  131. C======
  132. C
  133. C
  134. C======
  135. C Boucle Renormalisation
  136. C======
  137. DO 200 ISOU = 1, NSOU
  138. C Distinction sous-zone modele avec QTOT ou non
  139. MCHAML = MCHELM.ICHAML(ISOU)
  140. N2 = MCHAML.IELVAL(/1)
  141. CALL PLACE(MCHAML.NOMCHE,N2,IPLACE,MQTOT(1))
  142. IF (IPLACE.EQ.0) GOTO 200
  143. C XQT0 : Quantite totale de chaleur specifie (QTOT)
  144. IF (MCHAML.TYPCHE(IPLACE).EQ.'REAL*8') THEN
  145. MELVAL = IELVAL(IPLACE)
  146. N1PTEL = MELVAL.VELCHE(/1)
  147. N1EL = MELVAL.VELCHE(/2)
  148. IF (N1PTEL.NE.1.AND.N1EL.NE.1) GOTO 999
  149. XQT0 = MELVAL.VELCHE(1,1)
  150. c write(6,*) 'XQT0 =',XQT0
  151. ELSE
  152. GOTO 998
  153. ENDIF
  154. C XQT1 : Quantite totale de chaleur integree
  155. ICONS = LNCONS(ISOU)
  156. XQT1 = LQCONS(ICONS)
  157. C Facteur de renormalisation
  158. IF (ABS(XQT1).GT.XPETIT) THEN
  159. XQT1 = XQT0 / XQT1
  160. ELSE
  161. XQT1 = 0.D0
  162. ENDIF
  163. C Acces au valeurs (MELVAL)
  164. MCHAM1 = MCHEL1.ICHAML(ISOU)
  165. MELVA1 = MCHAM1.IELVAL(1)
  166. NBPT1 = MELVA1.VELCHE(/1)
  167. NBEL1 = MELVA1.VELCHE(/2)
  168. C Nouveau MELVAL
  169. N1PTEL = NBPT1
  170. N1EL = NBEL1
  171. N2PTEL = 0
  172. N2EL = 0
  173. SEGINI,MELVA2
  174. DO 210 IEL1=1,NBEL1
  175. DO 211 IPT1=1,NBPT1
  176. MELVA2.VELCHE(IPT1,IEL1) = XQT1 * MELVA1.VELCHE(IPT1,IEL1)
  177. 211 CONTINUE
  178. 210 CONTINUE
  179. SEGSUP,MELVA1
  180. MCHAM1.IELVAL(1) = MELVA2
  181. SEGACT,MCHAM1*NOMOD
  182. 200 CONTINUE
  183. C======
  184. C fin boucle renormalisation
  185. C======
  186. C
  187. SEGSUP,TRAVSP1,TRAVSP2
  188. IPCHA2 = IPCHA1
  189. C
  190. RETURN
  191. C
  192. C==== Gestion erreurs et fin
  193.  
  194. C Le nom de la composante ne correspond pas a des variables reelles.
  195. 998 CONTINUE
  196. CALL ERREUR(671)
  197. RETURN
  198. C
  199. C La composante est attendue constante par sous-zones
  200. 999 CONTINUE
  201. MOTERR(1:4) = MQTOT(1)
  202. MOTERR(5:20) = 'CARACTERISTIQUES'
  203. CALL ERREUR(1065)
  204. RETURN
  205.  
  206. END
  207.  
  208.  
  209.  

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