Télécharger chal1.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAL1 SOURCE FANDEUR 16/11/30 21:15:06 9222
  2.  
  3. C=======================================================================
  4. C= C H A L 1 =
  5. C= --------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Calcul des flux equivalents a des sources volumiques =
  10. C= =
  11. C= Parametres : (E)=Entree (S)=Sortie =
  12. C= ------------ =
  13. C= IPMODE (E) Pointeur sur le segment MMODEL de la structure =
  14. C= IPCHSO (E) Pointeur sur le segment MCHAML de sources donnees =
  15. C= en chaque element de la structure (champ variable) =
  16. C= IPCARA (E) Pointeur sur le segment MCHALM de CARACTERISTIQUES =
  17. C= dans le cas des COQues et des BARRes =
  18. C= MOCOMP (E) Nom de la composante du champ de flux equivalents =
  19. C= IPFLUX (S) Pointeur sur le champ des flux nodaux equivalents =
  20. C= =
  21. C= Remarque : Le MODELE doit contenir exclusivement un seul type =
  22. C= ---------- d'elements, soit MASSIFs, soit COQUEs, soit BARREs. =
  23. C=======================================================================
  24.  
  25. SUBROUTINE CHAL1 (IPMODE,IFORMU,ITYPEF, IPCHSO,ISUPSO, IPCARA,
  26. & MOCOMP, IPFLUX)
  27.  
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8 (A-H,O-Z)
  30.  
  31. -INC CCOPTIO
  32.  
  33. -INC SMMODEL
  34. -INC SMCHAML
  35.  
  36. CHARACTER*(*) MOCOMP
  37.  
  38. IPFLUX = 0
  39.  
  40. C 1 - CHANGEMENT DU SUPPORT DU MCHAML DE CARACTERISTIQUES S'IL EXISTE
  41. C ====
  42. C Transport des points de Gauss aux noeuds si necessaire ?
  43. C On devrait plutot le faire sur ISUPSO ?
  44. C Mais comme pour l'instant on utilise IPCARA que pour des modeles ou
  45. C tout est calcule aux noeuds, cela va bien.
  46. IPCARB = IPCARA
  47. IF (IPCARA.NE.0) THEN
  48. CALL CHASUP(IPMODE,IPCARA,IPCARB,iok,1)
  49. c? CALL CHASUP(IPMODE,IPCARA,IPCARB,iok,ISUPSO)
  50. IF (IERR.NE.0 .OR. iok.NE.0) THEN
  51. CALL ERREUR(21)
  52. RETURN
  53. ENDIF
  54. ENDIF
  55.  
  56. C =====
  57. C 2.1 - Activation du modele
  58. C =====
  59. MMODEL = IPMODE
  60. SEGACT,MMODEL
  61. NSOU = mmodel.KMODEL(/1)
  62. DO isou = 1, NSOU
  63. IMODEL = mmodel.KMODEL(isou)
  64. SEGACT,IMODEL
  65. ENDDO
  66. C =====
  67. C 2.2 - Activation des sources
  68. C =====
  69. MCHELM = IPCHSO
  70. SEGACT,MCHELM
  71. c* IF (mchelm.IMACHE(/1).NE.NSOU) THEN
  72. c* CALL ERREUR(21)
  73. c* RETURN
  74. c* ENDIF
  75. C =====
  76. C 2.3 - Activation de caracteristiques
  77. C =====
  78. IF (IPCARB.NE.0) THEN
  79. MCHELM = IPCARB
  80. SEGACT,MCHELM
  81. c* IF (mchelm.IMACHE(/1).NE.NSOU) THEN
  82. c* CALL ERREUR(21)
  83. c* RETURN
  84. c* ENDIF
  85. ENDIF
  86.  
  87. C 3 - CREATION DU MCHAML RESULTAT (GLOBAL)
  88. C ==========================================
  89. L1 = 18
  90. N1 = NSOU
  91. N3 = 6
  92. SEGINI,mchelm
  93. C* mchelm.IFOCHE = IFOMOD
  94. mchelm.IFOCHE = IFOUR
  95. mchelm.TITCHE = 'SOURCES.VOLUMIQUES'
  96. IPCHAL = mchelm
  97.  
  98. C 4 - CALCUL DES FLUX EQUIVALENTS AUX SOURCES VOLUMIQUES
  99. C ========================================================
  100. C 4.1 - Cas des elements MASSIFS (1D,2D,3D)
  101. C =====
  102. IF (ITYPEF.EQ.1) THEN
  103. CALL CHAMAS(IPMODE,IFORMU, IPCHSO,IPCARB,ISUPSO, MOCOMP,
  104. & IPCHAL)
  105. C =====
  106. C 4.2 - Cas des elements de COQUE
  107. C =====
  108. ELSE IF (ITYPEF.EQ.2) THEN
  109. CALL CHACOQ(IPMODE,IFORMU, IPCHSO,IPCARB,ISUPSO, MOCOMP,
  110. & IPCHAL)
  111. C =====
  112. C 4.3 - Cas des elements BARREs
  113. C =====
  114. c* ELSE IF (ITYPEF.EQ.3) THEN
  115. ELSE
  116. CALL CHABAT(IPMODE,IFORMU, IPCHSO,IPCARB,ISUPSO, MOCOMP,
  117. & IPCHAL)
  118. ENDIF
  119.  
  120. C 5 - DESACTIVATION DES OBJETS UTILISES
  121. C =======================================
  122. C* MMODEL = IPMODE
  123. DO isou = 1, NSOU
  124. IMODEL = mmodel.KMODEL(isou)
  125. SEGDES,IMODEL
  126. ENDDO
  127. SEGDES,MMODEL
  128.  
  129. mchelm = IPCHSO
  130. SEGDES,mchelm
  131.  
  132. IF (IPCARA.NE.0) THEN
  133. mchelm = IPCARB
  134. SEGDES,mchelm
  135. ENDIF
  136.  
  137. C Compactage eventuel du champ RESULTAT :
  138. mchelm = IPCHAL
  139. N1 = 0
  140. DO is = 1, NSOU
  141. IF (mchelm.IMACHE(is).NE.0) THEN
  142. N1 = N1 + 1
  143. mchelm.CONCHE(N1) = mchelm.CONCHE(is)
  144. mchelm.IMACHE(N1) = mchelm.IMACHE(is)
  145. mchelm.ICHAML(N1) = mchelm.ICHAML(is)
  146. DO js = 1, N3
  147. mchelm.INFCHE(N1,js) = mchelm.INFCHE(is,js)
  148. ENDDO
  149. ENDIF
  150. ENDDO
  151. IF (N1.NE.NSOU) THEN
  152. SEGADJ,mchelm
  153. ENDIF
  154. SEGDES,mchelm
  155.  
  156. C En cas d'erreur :
  157. IF (IERR.NE.0) THEN
  158. SEGSUP,mchelm
  159. IPCHAL = 0
  160. ENDIF
  161.  
  162. C Champ resultat (= 0 en cas d'erreur)
  163. IPFLUX = IPCHAL
  164.  
  165. RETURN
  166. END
  167.  
  168.  
  169.  

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