Télécharger kcrepa.eso

Retour à la liste

Numérotation des lignes :

  1. C KCREPA SOURCE CHAT 05/01/13 00:53:04 5004
  2. SUBROUTINE KCREPA (DR,A,S,IES,NS,N,GG,SS)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5.  
  6. C---------------------------------------------------------------------
  7. C Calcul des facteurs de forme en 3D
  8. C Sp appele par KALPRE
  9. C Creation des patches: decoupage de la face 1
  10. C N : NOMBRE DE SOUS-ELEMENTS
  11. C GG(KES,N) : CENTRE DE GRAVITE
  12. C SS(N) : SURFACE RAPPORTEE A LA SURFACE 'S' DE L'ELEMENT
  13. C---------------------------------------------------------------------
  14. DIMENSION A(NS,*),GG(NS,*),SS(*),D(3)
  15. DIMENSION B(3,3),UU(4),GG1(3,200),SS1(200)
  16. E1 =0.1
  17. E2 =0.5
  18. C WRITE(6,*) '> KCREPA DR ',DR
  19. C
  20. CALL KSCLAS(A,D,IES,NS)
  21. C WRITE(6,*) ' DR D ',DR,D(1),D(2),D(3)
  22.  
  23. IF (D(3).LE.DR) THEN
  24. N=1
  25. SS(1)=S
  26. DO 1 K=1,IES
  27. GG(K,1)=(A(K,1)+A(K,2)+A(K,3))/3.
  28. 1 CONTINUE
  29. ELSE
  30. IF ((D(2)/D(1)-1.).LT.E1.AND.(2.-D(3)/D(1)).LT.E2) THEN
  31. C WRITE(6,*) ' DECOUPAGE EN 2 '
  32. DO 2 K=1,IES
  33. B(K,1) = A(K,1)
  34. B(K,2) = A(K,2)
  35. B(K,3) = (A(K,1)+A(K,3))/2.
  36. 2 CONTINUE
  37. CALL KNORM (IES,B,NS,UU,S1)
  38. C WRITE(6,*) ' S S1 ',S,S1
  39. CALL KSCLAS(B,D,IES,NS)
  40. CALL KSDEC (DR,B,D,S1,IES,NS,N,GG,SS)
  41.  
  42. DO 3 K=1,IES
  43. B(K,2) = A(K,2)
  44. B(K,3) = A(K,3)
  45. B(K,1) = (A(K,1)+A(K,3))/2.
  46. 3 CONTINUE
  47. CALL KSCLAS(B,D,IES,NS)
  48. CALL KSDEC (DR,B,D,S-S1,IES,NS,N1,GG1,SS1)
  49.  
  50. C WRITE(6,*) ' n n1 ',N,N1
  51. DO 30 I=1,N1
  52. DO 31 K=1,IES
  53. Gg(K,N+I)=GG1(K,I)
  54. 31 CONTINUE
  55. SS(N+I)=SS1(I)
  56. 30 CONTINUE
  57. N=N +N1
  58.  
  59. ELSE
  60. C WRITE(6,*) ' REGULIER DECOUPAGE '
  61. C WRITE(6,*) ' A ',A(1,3),A(2,3),A(3,3)
  62. CALL KSDEC (DR,A,D,S,IES,NS,N,GG,SS)
  63. ENDIF
  64.  
  65. ENDIF
  66. C WRITE(6,*) '< KCREPA ',N
  67.  
  68. RETURN
  69. END
  70.  
  71.  
  72.  
  73.  

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