Esope source files

   1 : C KVOL      SOURCE    PV        11/03/08    21:15:42     6888           
   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
  30 :       CALL CRCHPT(TYPE,MELEMC,NC,MCHPOI)
  30 :       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  31 :       SEGDES MELEMC
  32 : 
  33 :       SEGACT MELEME
  34 : 
  35 :       IAXI=0
  36 :       IF(IFOMOD.EQ.0)IAXI=2
  37 : 
  38 :       NBSOUS=LISOUS(/1)
  39 :       IF(NBSOUS.EQ.0)NBSOUS=1
  40 : 
  41 :       KK=0
  42 :       DO 1 L=1,NBSOUS
  43 :       IPT1=MELEME
  44 :       IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  45 :       SEGACT IPT1
  46 :       NP=IPT1.NUM(/1)
  47 :       NEL=IPT1.NUM(/2)
  48 :       TYPE=NOMS(IPT1.ITYPEL)//'    '
  48 :       CALL KALPBG(TYPE,'FONFORM ',IZFFM)
  49 :       SEGACT IZFFM*MOD
  50 :       IZHR=KZHR(1)
  51 :       SEGACT IZHR*MOD
  52 :       NES=GR(/1)
  53 :       NPG=GR(/3)
  54 : 
  55 :       DO 10 K=1,NEL
  56 :       KK=KK+1                                                                   
  57 :       NPGR=0                                                                    
  58 :       IF(IAXI.NE.0)NPGR=NPG                                                     
  59 : C                                                                               
  60 : C     REMPLISSAGE DE XYZ                                                        
  61 : C     ------------------                                                        
  62 : C                                                                               
  63 :       DO 12 I=1,NP                                                              
  64 :       J=IPT1.NUM(I,K)                                                           
  65 :       DO 12 N=1,IDIM
  66 :       XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
  67 :  12   CONTINUE                                                                  
  68 : 
  69 :       MP1=0                                                                     
  69 :       CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE)
  70 :                                                                                 
  71 : C             CALCUL DU VOLUME / AIRE                                           
  72 : 
  73 :       VPOCHA(KK,1)=AIRE
  74 :                                                                                 
  75 :  10   CONTINUE                                                                  
  76 :       SEGDES IPT1
  77 :  1    CONTINUE
  78 :       SEGDES MELEME,MPOVAL,MCHPOI
  79 : C                                                                               
  80 :       RETURN
  81 : 
  82 :  90   CONTINUE
  83 :       WRITE(6,*)' Interruption anormale de KVOL'
  84 :       RETURN                                                                    
  85 :  1001 FORMAT(20(1X,I5))                                                         
  86 :       END                                                                       
  87 :  
  88 :  
  89 :  
  90 :  
  91 :  
  92 :  
  93 :  
  94 :  
  95 :  
  96 :  
  97 :  
  98 :