Télécharger kvol.eso

Retour à la liste

Numérotation des lignes :

  1. C KVOL SOURCE MAGN 17/02/24 21:15:20 9323
  2. SUBROUTINE KVOL(MELEME,MELEMC,TYPP,MCHPOI)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*************************************************************************
  6. C
  7. C OBJET : Cree un CHAMPOINT CENTRE contenant le volume des éléments
  8. C du domaine
  9. C
  10. C SYNTAXE : CHPC = KVOL OBJDOM ;
  11. C
  12. C OBJDOM : TABLE de SOUSTYPE DOMAINE
  13. C
  14. C*************************************************************************
  15. -INC CCOPTIO
  16. -INC CCGEOME
  17. -INC SMELEME
  18. POINTEUR MELEMC.MELEME
  19. -INC SMCOORD
  20. -INC SMCHPOI
  21. -INC SIZFFB
  22.  
  23. REAL*8 AAJ(3,3,9),U,XC(3)
  24. PARAMETER (NTB=1)
  25. CHARACTER*8 LTAB(NTB),TYPE,TYPC
  26. CHARACTER*(*) TYPP
  27. C***
  28. SEGACT MELEMC
  29. NC=1
  30. TYPE=TYPP
  31. CALL CRCHPT(TYPE,MELEMC,NC,MCHPOI)
  32. CALL LICHTM(MCHPOI,MPOVAL,TYPC,IGEOM)
  33. SEGDES MELEMC
  34.  
  35. SEGACT MELEME
  36.  
  37. IAXI=0
  38. IF(IFOMOD.EQ.0)IAXI=2
  39.  
  40. NBSOUS=LISOUS(/1)
  41. IF(NBSOUS.EQ.0)NBSOUS=1
  42.  
  43. KK=0
  44. DO 1 L=1,NBSOUS
  45. IPT1=MELEME
  46. IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  47. SEGACT IPT1
  48. NP=IPT1.NUM(/1)
  49. NEL=IPT1.NUM(/2)
  50. TYPE=NOMS(IPT1.ITYPEL)//' '
  51. CALL KALPBG(TYPE,'FONFORM ',IZFFM)
  52. SEGACT IZFFM*MOD
  53. IZHR=KZHR(1)
  54. SEGACT IZHR*MOD
  55. NES=GR(/1)
  56. NPG=GR(/3)
  57.  
  58. DO 10 K=1,NEL
  59. KK=KK+1
  60. NPGR=0
  61. IF(IAXI.NE.0)NPGR=NPG
  62. C
  63. C REMPLISSAGE DE XYZ
  64. C ------------------
  65. C
  66. DO 12 I=1,NP
  67. J=IPT1.NUM(I,K)
  68. DO 12 N=1,IDIM
  69. XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
  70. 12 CONTINUE
  71.  
  72. MP1=0
  73. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE)
  74.  
  75. C CALCUL DU VOLUME / AIRE
  76.  
  77. VPOCHA(KK,1)=AIRE
  78.  
  79. 10 CONTINUE
  80. SEGDES IPT1
  81. 1 CONTINUE
  82. SEGDES MELEME,MPOVAL,MCHPOI
  83. C
  84. RETURN
  85.  
  86. 90 CONTINUE
  87. WRITE(6,*)' Interruption anormale de KVOL'
  88. RETURN
  89. 1001 FORMAT(20(1X,I5))
  90. END
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  

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