1 : C KSDEC SOURCE PV 11/03/07 21:17:21 6885 2 : SUBROUTINE KSDEC (DR,A,D,S,IES,NS,N,GG,SS) KSD00020 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) KSD00030 5 : C 6 : C Calcul des facteurs de forme en 3D 7 : C Sp appele par KCREPA (decoupage des faces) 8 : C KSD00060 9 : C DR : LONGUEUR DE REFERENCE POUR LE DECOUPAGE KSD00070 10 : C A , D , S : SOMMETS, LONGUEURS DES COTES ORDONNES, SURFACES KSD00080 11 : C N : NOMBRE DE SOUS-ELEMENTS KSD00090 12 : C GG(IES,N) : CENTRE DE GRAVITE KSD00100 13 : C SS(N) : SURFACE RAPPORTEE A LA SURFACE 'S' DE L'ELEMENT KSD00110 14 : C KSD00120 15 : DIMENSION A(IES,NS),D(NS),GG(IES,1),SS(1) KSD00040 16 : DIMENSION X1(3),X2(3) KSD00050 17 : C WRITE(6,*) ' KSDEC DR ',DR KSD00130 18 : C WRITE(6,*) ' A1 ',A(1,1),A(2,1),A(3,1) KSD00140 19 : C WRITE(6,*) ' A2 ',A(1,2),A(2,2),A(3,2) KSD00150 20 : C WRITE(6,*) ' A3 ',A(1,3),A(2,3),A(3,3) KSD00160 21 : AL = 1./2. KSD00170 22 : N = 0 KSD00180 23 : DT=0. KSD00190 24 : N3 = INT(D(3)/DR) + 1 KSD00200 25 : C WRITE(6,*) ' N3 ',N3 KSD00210 26 : DO 1 I=1,N3 KSD00220 27 : X = AL/N3 +(I-1.)/N3 KSD00230 28 : C WRITE(6,*) ' I X ',I,X KSD00240 29 : DI=0. KSD00250 30 : DO 11 K=1,IES KSD00260 31 : X1(K)= A(K,3)*X +A(K,1)*(1.-X) KSD00270 32 : X2(K)= A(K,3)*X +A(K,2)*(1.-X) KSD00280 33 : C WRITE(6,*) 'M1 M2',X1(K),X2(K) KSD00290 34 : DI = DI + (X1(K)-X2(K))*(X1(K)-X2(K)) KSD00300 35 : 11 CONTINUE KSD00310 36 : DI=SQRT(DI) KSD00320 37 : C WRITE(6,*) ' DI ',DI KSD00330 38 : DT = DT + DI KSD00340 39 : KSD00350 40 : NI = INT(DI/DR) + 1 KSD00360 41 : C WRITE(6,*) ' NI ',NI KSD00370 42 : DO 2 J=1,NI KSD00380 43 : N = N + 1 KSD00390 44 : C WRITE(6,*) ' N ',N KSD00400 45 : Y = 1./2/NI +(J-1.)/NI KSD00410 46 : DO 21 K=1,IES KSD00420 47 : GG(K,N)=X1(K)*(1.-Y) + X2(K)*Y KSD00430 48 : 21 CONTINUE KSD00440 49 : SS(N)= DI/NI KSD00450 50 : C WRITE(6,*) ' SS ',SS(N) KSD00460 51 : 2 CONTINUE KSD00470 52 : KSD00480 53 : 1 CONTINUE KSD00490 54 : KSD00500 55 : DO 3 I=1,N KSD00510 56 : SS(I)=SS(I)*S/DT KSD00520 57 : 3 CONTINUE KSD00530 58 : C WRITE(6,*) ' NB POINTS ',N KSD00540 59 : C WRITE(6,*) ' SURFACES ' KSD00550 60 : RETURN KSD00560 61 : END KSD00570 62 : 63 : 64 :
© Cast3M 2003 - All rights reserved.
Disclaimer