Télécharger chal1.eso

Retour à la liste

Numérotation des lignes :

chal1
  1. C CHAL1 SOURCE CB215821 24/04/12 21:15:13 11897
  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= IPFLUX (S) Pointeur sur le champ des flux nodaux equivalents =
  19. C= =
  20. C= Remarque : Le MODELE doit contenir exclusivement un seul type =
  21. C= ---------- d'elements, soit MASSIFs, soit COQUEs, soit BARREs. =
  22. C=======================================================================
  23.  
  24. SUBROUTINE CHAL1 (IPMODE,IFORMU,ITYPEF, IPCHSO,ISUPSO, IPCARA,
  25. & IPFLUX)
  26.  
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8 (A-H,O-Z)
  29.  
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33.  
  34. -INC SMMODEL
  35. -INC SMCHAML
  36.  
  37. IPFLUX = 0
  38.  
  39. C 1 - CHANGEMENT DU SUPPORT DU MCHAML DE CARACTERISTIQUES S'IL EXISTE
  40. C ====
  41. C Transport des points de Gauss aux noeuds si necessaire ?
  42. C On devrait plutot le faire sur ISUPSO ?
  43. C Mais comme pour l'instant on utilise IPCARA que pour des modeles ou
  44. C tout est calcule aux noeuds et ISUPSO = 1, cela va bien.
  45. IPCARB = IPCARA
  46. IF (IPCARA.NE.0) THEN
  47. CALL CHASUP(IPMODE,IPCARA,IPCARB,iok,ISUPSO)
  48. IF (IERR.NE.0 .OR. iok.NE.0) THEN
  49. CALL ERREUR(21)
  50. RETURN
  51. ENDIF
  52. ENDIF
  53.  
  54. MMODEL = IPMODE
  55. NSOU = mmodel.KMODEL(/1)
  56.  
  57. C 3 - CREATION DU MCHAML RESULTAT (GLOBAL)
  58. C ==========================================
  59. L1 = 18
  60. N1 = NSOU
  61. N3 = 6
  62. SEGINI,mchelm
  63. mchelm.IFOCHE = IFOUR
  64. mchelm.TITCHE = 'SOURCES.VOLUMIQUES'
  65. IPCHAL = mchelm
  66.  
  67. C 4 - CALCUL DES FLUX EQUIVALENTS AUX SOURCES VOLUMIQUES
  68. C ========================================================
  69. C 4.1 - Cas des elements MASSIFS (1D,2D,3D)
  70. C =====
  71. IF (ITYPEF.EQ.1) THEN
  72. CALL CHAMAS(IPMODE,IFORMU, IPCHSO,ISUPSO, IPCHAL)
  73. C =====
  74. C 4.2 - Cas des elements de COQUE
  75. C =====
  76. ELSE IF (ITYPEF.EQ.2) THEN
  77. CALL CHACOQ(IPMODE,IFORMU, IPCHSO,IPCARB,ISUPSO, IPCHAL)
  78. C =====
  79. C 4.3 - Cas des elements BARREs
  80. C =====
  81. ELSE IF (ITYPEF.EQ.3) THEN
  82. CALL CHABAT(IPMODE,IFORMU,IPCHSO,IPCARB,ISUPSO,IPCHAL)
  83.  
  84. ELSE
  85. CALL ERREUR(21)
  86. RETURN
  87. ENDIF
  88.  
  89. C 5 - DESACTIVATION DES OBJETS UTILISES
  90. C =======================================
  91.  
  92. C Compactage eventuel du champ RESULTAT :
  93. mchelm = IPCHAL
  94. N1 = 0
  95. DO is = 1, NSOU
  96. IF (mchelm.IMACHE(is).NE.0) THEN
  97. N1 = N1 + 1
  98. mchelm.CONCHE(N1) = mchelm.CONCHE(is)
  99. mchelm.IMACHE(N1) = mchelm.IMACHE(is)
  100. mchelm.ICHAML(N1) = mchelm.ICHAML(is)
  101. DO js = 1, N3
  102. mchelm.INFCHE(N1,js) = mchelm.INFCHE(is,js)
  103. ENDDO
  104. ENDIF
  105. ENDDO
  106. IF (N1.NE.NSOU) THEN
  107. SEGADJ,mchelm
  108. ENDIF
  109.  
  110. C En cas d'erreur :
  111. IF (IERR.NE.0) IPCHAL = 0
  112.  
  113. C Champ resultat (= 0 en cas d'erreur)
  114. IPFLUX = IPCHAL
  115.  
  116. END
  117.  
  118.  
  119.  

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