Télécharger chal1.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAL1 SOURCE FANDEUR 17/12/20 21:15:11 9649
  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 et ISUPSO = 1, cela va bien.
  46. IPCARB = IPCARA
  47. IF (IPCARA.NE.0) THEN
  48. CALL CHASUP(IPMODE,IPCARA,IPCARB,iok,ISUPSO)
  49. IF (IERR.NE.0 .OR. iok.NE.0) THEN
  50. CALL ERREUR(21)
  51. RETURN
  52. ENDIF
  53. ENDIF
  54.  
  55. C =====
  56. C 2.1 - Activation du modele
  57. C =====
  58. MMODEL = IPMODE
  59. SEGACT,MMODEL
  60. NSOU = mmodel.KMODEL(/1)
  61. DO isou = 1, NSOU
  62. IMODEL = mmodel.KMODEL(isou)
  63. SEGACT,IMODEL
  64. ENDDO
  65. C =====
  66. C 2.2 - Activation des sources
  67. C =====
  68. MCHELM = IPCHSO
  69. SEGACT,MCHELM
  70. c* IF (mchelm.IMACHE(/1).NE.NSOU) THEN
  71. c* CALL ERREUR(21)
  72. c* RETURN
  73. c* ENDIF
  74. C =====
  75. C 2.3 - Activation de caracteristiques
  76. C =====
  77. IF (IPCARB.NE.0) THEN
  78. MCHELM = IPCARB
  79. SEGACT,MCHELM
  80. c* IF (mchelm.IMACHE(/1).NE.NSOU) THEN
  81. c* CALL ERREUR(21)
  82. c* RETURN
  83. c* ENDIF
  84. ENDIF
  85.  
  86. C 3 - CREATION DU MCHAML RESULTAT (GLOBAL)
  87. C ==========================================
  88. L1 = 18
  89. N1 = NSOU
  90. N3 = 6
  91. SEGINI,mchelm
  92. C* mchelm.IFOCHE = IFOMOD
  93. mchelm.IFOCHE = IFOUR
  94. mchelm.TITCHE = 'SOURCES.VOLUMIQUES'
  95. IPCHAL = mchelm
  96.  
  97. C 4 - CALCUL DES FLUX EQUIVALENTS AUX SOURCES VOLUMIQUES
  98. C ========================================================
  99. C 4.1 - Cas des elements MASSIFS (1D,2D,3D)
  100. C =====
  101. IF (ITYPEF.EQ.1) THEN
  102. CALL CHAMAS(IPMODE,IFORMU, IPCHSO,IPCARB,ISUPSO, MOCOMP,
  103. & IPCHAL)
  104. C =====
  105. C 4.2 - Cas des elements de COQUE
  106. C =====
  107. ELSE IF (ITYPEF.EQ.2) THEN
  108. CALL CHACOQ(IPMODE,IFORMU, IPCHSO,IPCARB,ISUPSO, MOCOMP,
  109. & IPCHAL)
  110. C =====
  111. C 4.3 - Cas des elements BARREs
  112. C =====
  113. c* ELSE IF (ITYPEF.EQ.3) THEN
  114. ELSE
  115. CALL CHABAT(IPMODE,IFORMU, IPCHSO,IPCARB,ISUPSO, MOCOMP,
  116. & IPCHAL)
  117. ENDIF
  118.  
  119. C 5 - DESACTIVATION DES OBJETS UTILISES
  120. C =======================================
  121. C* MMODEL = IPMODE
  122. DO isou = 1, NSOU
  123. IMODEL = mmodel.KMODEL(isou)
  124. SEGDES,IMODEL
  125. ENDDO
  126. SEGDES,MMODEL
  127.  
  128. mchelm = IPCHSO
  129. SEGDES,mchelm
  130.  
  131. IF (IPCARA.NE.0) THEN
  132. mchelm = IPCARB
  133. SEGDES,mchelm
  134. ENDIF
  135.  
  136. C Compactage eventuel du champ RESULTAT :
  137. mchelm = IPCHAL
  138. N1 = 0
  139. DO is = 1, NSOU
  140. IF (mchelm.IMACHE(is).NE.0) THEN
  141. N1 = N1 + 1
  142. mchelm.CONCHE(N1) = mchelm.CONCHE(is)
  143. mchelm.IMACHE(N1) = mchelm.IMACHE(is)
  144. mchelm.ICHAML(N1) = mchelm.ICHAML(is)
  145. DO js = 1, N3
  146. mchelm.INFCHE(N1,js) = mchelm.INFCHE(is,js)
  147. ENDDO
  148. ENDIF
  149. ENDDO
  150. IF (N1.NE.NSOU) THEN
  151. SEGADJ,mchelm
  152. ENDIF
  153. SEGDES,mchelm
  154.  
  155. C En cas d'erreur :
  156. IF (IERR.NE.0) THEN
  157. SEGSUP,mchelm
  158. IPCHAL = 0
  159. ENDIF
  160.  
  161. C Champ resultat (= 0 en cas d'erreur)
  162. IPFLUX = IPCHAL
  163.  
  164. RETURN
  165. END
  166.  
  167.  
  168.  

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