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

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