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 19 : CALL KSCLAS(A,D,IES,NS) 20 : C WRITE(6,*) ' DR D ',DR,D(1),D(2),D(3) 21 : 22 : IF (D(3).LE.DR) THEN 23 : N=1 24 : SS(1)=S 25 : DO 1 K=1,IES 26 : GG(K,1)=(A(K,1)+A(K,2)+A(K,3))/3. 27 : 1 CONTINUE 28 : ELSE 29 : IF ((D(2)/D(1)-1.).LT.E1.AND.(2.-D(3)/D(1)).LT.E2) THEN 30 : C WRITE(6,*) ' DECOUPAGE EN 2 ' 31 : DO 2 K=1,IES 32 : B(K,1) = A(K,1) 33 : B(K,2) = A(K,2) 34 : B(K,3) = (A(K,1)+A(K,3))/2. 35 : 2 CONTINUE 35 : CALL KNORM (IES,B,NS,UU,S1) 36 : C WRITE(6,*) ' S S1 ',S,S1 36 : CALL KSCLAS(B,D,IES,NS) 36 : CALL KSDEC (DR,B,D,S1,IES,NS,N,GG,SS) 37 : 38 : DO 3 K=1,IES 39 : B(K,2) = A(K,2) 40 : B(K,3) = A(K,3) 41 : B(K,1) = (A(K,1)+A(K,3))/2. 42 : 3 CONTINUE 42 : CALL KSCLAS(B,D,IES,NS) 42 : CALL KSDEC (DR,B,D,S-S1,IES,NS,N1,GG1,SS1) 43 : 44 : C WRITE(6,*) ' n n1 ',N,N1 45 : DO 30 I=1,N1 46 : DO 31 K=1,IES 47 : Gg(K,N+I)=GG1(K,I) 48 : 31 CONTINUE 49 : SS(N+I)=SS1(I) 50 : 30 CONTINUE 51 : N=N +N1 52 : 53 : ELSE 54 : C WRITE(6,*) ' REGULIER DECOUPAGE ' 55 : C WRITE(6,*) ' A ',A(1,3),A(2,3),A(3,3) 55 : CALL KSDEC (DR,A,D,S,IES,NS,N,GG,SS) 56 : ENDIF 57 : 58 : ENDIF 59 : C WRITE(6,*) '< KCREPA ',N 60 : 61 : RETURN 62 : END 63 : 64 : 65 :
© Cast3M 2003 - All rights reserved.
Disclaimer