Télécharger chacoq.eso

Retour à la liste

Numérotation des lignes :

chacoq
  1. C CHACOQ SOURCE CB215821 23/04/28 21:15:04 11660
  2.  
  3. C=======================================================================
  4. C= C H A C O Q =
  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 COQUEs. =
  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= (Epaisseur necessaire pour les elements COQUEs) =
  19. C= ISUPCH (E) Support des champs en entree =
  20. C= IPCHAL (S) Pointeur du champ aux noeuds des flux equivalents =
  21. C=======================================================================
  22.  
  23. SUBROUTINE CHACOQ (IPMODL,IFORMU, IPCHSO,IPCHEB,ISUPCH, IPCHAL)
  24.  
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8 (A-H,O-Z)
  27.  
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC CCREEL
  32.  
  33. -INC SMCHAML
  34. -INC SMMODEL
  35.  
  36. SEGMENT INFO
  37. INTEGER INFELL(JG)
  38. ENDSEGMENT
  39.  
  40. MMODEL = IPMODL
  41. c* SEGACT,mmodel <- Actif en E/S (non modifie)
  42. NSOU = mmodel.KMODEL(/1)
  43.  
  44. mchelm = IPCHAL
  45. c* SEGACT,mchelm <- Actif en E/S et modifiable
  46. c* NSZC = mchelm.IMACHE(/1) <- On a ici : NSZC = NSOU
  47.  
  48. MCHEL1 = IPCHSO
  49. c* SEGACT,mchel1 <- Actif en E/S (non modifie)
  50. NSZ1 = mchel1.IMACHE(/1)
  51.  
  52. mchel2 = IPCHEB
  53. c* SEGACT,mchel2 <- Actif en E/S (non modifie)
  54. NSZ2 = mchel2.IMACHE(/1)
  55.  
  56. C BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (ISOU)
  57. C ==================================================
  58. DO 100 ISOU = 1, NSOU
  59.  
  60. C Modele elementaire ISOU
  61. C =====
  62. IMODEL = mmodel.KMODEL(ISOU)
  63. C* SEGACT,IMODEL
  64. C =====
  65. C Recherche dans le MCHAML des sources (IPCHSO) de la sous-zone
  66. C associee au modele elementaire ISOU (IMAMOD et CONMOD), puis
  67. C recuperation des valeurs du champ elementaire de sources (MELVA1)
  68. C =====
  69. IPSON1 = 0
  70. IPSON2 = 0
  71. IPSON3 = 0
  72. DO is = 1, NSZ1
  73. IF (MCHEL1.IMACHE(is).EQ.imodel.IMAMOD .AND.
  74. & MCHEL1.CONCHE(is).EQ.imodel.CONMOD) THEN
  75. mchaml = MCHEL1.ICHAML(is)
  76. SEGACT,mchaml
  77. NCOELE = mchaml.NOMCHE(/2)
  78. ipo1 = 0
  79. ipo2 = 0
  80. ipo3 = 0
  81. CALL PLACE(mchaml.NOMCHE,NCOELE,ipo1,'QINF')
  82. CALL PLACE(mchaml.NOMCHE,NCOELE,ipo2,'QVOL')
  83. CALL PLACE(mchaml.NOMCHE,NCOELE,ipo3,'QSUP')
  84. IF (ipo1.NE.0 .AND. ipo2.NE.0 .AND. ipo3.NE.0) THEN
  85. IPSON1 = mchaml.IELVAL(ipo1)
  86. IPSON2 = mchaml.IELVAL(ipo2)
  87. IPSON3 = mchaml.IELVAL(ipo3)
  88. ENDIF
  89. GOTO 10
  90. ENDIF
  91. ENDDO
  92. 10 CONTINUE
  93. IF (IPSON1.EQ.0) GOTO 100
  94. C =====
  95. C Recherche dans le MCHAML des caracteristiques (IPCHEB) du
  96. C maillage (IMAMOD) associe au modele elementaire ISOU, puis
  97. C recuperation du MCHAML elementaire associe (MELVA2)
  98. C =====
  99. MELVA2 = 0
  100. DO is = 1, NSZ2
  101. IF (MCHEL2.IMACHE(is).EQ.imodel.IMAMOD .AND.
  102. & MCHEL2.CONCHE(is).EQ.imodel.CONMOD) THEN
  103. mchaml = MCHEL2.ICHAML(is)
  104. SEGACT,mchaml
  105. NCOELE = mchaml.NOMCHE(/2)
  106. IPOSI = 0
  107. CALL PLACE(mchaml.NOMCHE,NCOELE,IPOSI,'EPAI')
  108. IF (IPOSI.NE.0) THEN
  109. MELVA2 = mchaml.IELVAL(IPOSI)
  110. ENDIF
  111. GOTO 20
  112. ENDIF
  113. ENDDO
  114. 20 CONTINUE
  115. IF (MELVA2.EQ.0) THEN
  116. MOTERR(1:4) = 'EPAI'
  117. MOTERR(5:8) = 'CARA'
  118. CALL ERREUR(77)
  119. GOTO 100
  120. ENDIF
  121. C =====
  122. C Informations sur l'element fini du modele ISOU
  123. C =====
  124. NEF = imodel.NEFMOD
  125. IPOGEO = imodel.IMAMOD
  126. C Recuperation des caracteristiques d'integration
  127. IPINT1 = 0
  128. IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2) THEN
  129. CALL TSHAPE(NEF,'GAUSS',IPINTE)
  130. C COQ6 COQ4 COQ8
  131. IF (NEF.EQ.41 .OR. NEF.EQ.49 .OR. NEF.EQ.56) THEN
  132. CALL TSHAPE(NEF,'NOEUD',IPINT1)
  133. ENDIF
  134. ELSE
  135. C A priori pour l'instant : formulations non prevues
  136. IPINTE = 0
  137. IPINT1 = 0
  138. CALL ERREUR(19)
  139. GOTO 100
  140. ENDIF
  141. C =====
  142. C Calcul des flux nodaux equivalents
  143. C =====
  144. IPCHQ1 = 0
  145. IPCHQ2 = 0
  146. IPCHQ3 = 0
  147. C Element fini de type COQ2 COQ3
  148. IF (NEF.EQ.44 .OR. NEF.EQ.27) THEN
  149. CALL CHACO1(IPSON1,IPSON2,IPSON3, MELVA2,
  150. & IPOGEO, IPINTE,
  151. & IPCHQ1,IPCHQ2,IPCHQ3)
  152. C Element fini de type COQ8 COQ6 COQ4
  153. ELSE IF (NEF.EQ.41 .OR. NEF.EQ.56 .OR. NEF.EQ.49) THEN
  154. CALL CHACO2(IPSON1,IPSON2,IPSON3, MELVA2,
  155. & IPOGEO, IPINTE,IPINT1,
  156. & IPCHQ1,IPCHQ2,IPCHQ3)
  157. ELSE
  158. CALL ERREUR(19)
  159. GOTO 100
  160. ENDIF
  161. C =====
  162. C Initialisation du MCHAML des flux de chaleur nodaux equivalents
  163. C (MCHAML) associe au modele elementaire ISOU (maillage IMAMOD)
  164. C Remplissage des donnees associees a MCHAML dans MCHELM (global)
  165. C =====
  166. C Recuperation du nom de la composante duale dans le modele
  167. NOMID = imodel.LNOMID(2)
  168.  
  169. N2 = 3
  170. SEGINI,MCHAML
  171. NBROBL=NOMID.LESOBL(/2)
  172. IF(NBROBL .NE. 3)THEN
  173. CALL ERREUR(21)
  174. RETURN
  175. ENDIF
  176. mchaml.NOMCHE(1) = NOMID.LESOBL(1)
  177. mchaml.NOMCHE(2) = NOMID.LESOBL(2)
  178. mchaml.NOMCHE(3) = NOMID.LESOBL(3)
  179. mchaml.TYPCHE(1) = 'REAL*8'
  180. mchaml.TYPCHE(2) = 'REAL*8'
  181. mchaml.TYPCHE(3) = 'REAL*8'
  182. mchaml.IELVAL(1) = IPCHQ1
  183. mchaml.IELVAL(2) = IPCHQ2
  184. mchaml.IELVAL(3) = IPCHQ3
  185.  
  186. mchelm.CONCHE(ISOU) = imodel.CONMOD
  187. mchelm.IMACHE(ISOU) = IPOGEO
  188. mchelm.ICHAML(ISOU) = MCHAML
  189. mchelm.INFCHE(ISOU,3) = NIFOUR
  190. mchelm.INFCHE(ISOU,6) = 1
  191. C===
  192. 100 CONTINUE
  193. C===
  194. C Fin de la boucle sur les sous-modeles elementaires
  195.  
  196. END
  197.  
  198.  

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