Télécharger la plaquette Cast3M


fr en

Télécharger kcrepa.eso

Retour à la liste

Numérotation des lignes : 

kcrepa

  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