Download ksubdv.eso

Back to the list

   1 : C KSUBDV    SOURCE    CHAT      05/01/13    01:09:11     5004           
   2 :       SUBROUTINE KSUBDV(A2,AA,NSUB)                                             
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   5 : C                                                                               
   6 : C Calcul des facteurs de forme en 3D
   7 : C Sp appele par KPROJF
   8 : C     Subdivision d'un triangle en 4 triangles
   9 : C
  10 :       DIMENSION A1(3,3)                                                         
  11 :       DIMENSION A2(3,3),AA(3,3,4)                                               
  12 :                                                                                 
  13 :       NSUB = 4                                                                  
  14 : C                                                                               
  15 : C     SOMMETS                                                                   
  16 : C                                                                               
  17 :       DO 10 K=1,3                                                               
  18 :       A1(K,1) = (A2(K,1)+A2(K,2))/2.                                            
  19 :       A1(K,2) = (A2(K,2)+A2(K,3))/2.                                            
  20 :       A1(K,3) = (A2(K,3)+A2(K,1))/2.                                            
  21 :  10   CONTINUE                                                                  
  22 : C                                                                               
  23 : C     4 ELEMENTS                                                                
  24 : C                                                                               
  25 :       DO 11 K =1,3                                                              
  26 :       AA(K,1,1) = A2(K,1)                                                       
  27 :       AA(K,2,1) = A1(K,1)                                                       
  28 :       AA(K,3,1) = A1(K,3)                                                       
  29 :  11   CONTINUE                                                                  
  30 : C                                                                               
  31 :       DO 12 K =1,3                                                              
  32 :       AA(K,1,2) = A2(K,2)                                                       
  33 :       AA(K,2,2) = A1(K,2)                                                       
  34 :       AA(K,3,2) = A1(K,1)                                                       
  35 :  12   CONTINUE                                                                  
  36 :                                                                                 
  37 :       DO 13 K =1,3                                                              
  38 :       AA(K,1,3) = A2(K,3)                                                       
  39 :       AA(K,2,3) = A1(K,3)                                                       
  40 :       AA(K,3,3) = A1(K,2)                                                       
  41 :  13   CONTINUE                                                                  
  42 :                                                                                 
  43 :       DO 14 K =1,3                                                              
  44 :       AA(K,1,4) = A1(K,1)                                                       
  45 :       AA(K,2,4) = A1(K,2)                                                       
  46 :       AA(K,3,4) = A1(K,3)                                                       
  47 :  14   CONTINUE                                                                  
  48 :                                                                                 
  49 :       RETURN                                                                    
  50 :       END                                                                       
  51 :  
  52 :  

© Cast3M 2003 - All rights reserved.
Disclaimer