C KSCLAS SOURCE CHAT 05/01/13 01:07:44 5004 SUBROUTINE KSCLAS (A,D1,IES,NS) KSC00020 IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) KSC00030 C Calcul des facteurs de forme en 3D C Sp appele par KCREPA (decoupage des faces) KSC00070 C Dete C A : SOMMETS KSC00080 C D : LONGUEUR DES COTES KSC00090 C KSC00100 C KSC00110 DIMENSION A(IES,NS),D1(NS) KSC00040 DIMENSION B(3,3),D(3) KSC00050 DIMENSION KA(3),KD(3) KSC00060 C KSC00120 D(1)=0. KSC00130 DO 1 K = 1,NS KSC00140 D(1) = D(1) + (A(K,2)-A(K,1))*(A(K,2)-A(K,1)) KSC00150 1 CONTINUE KSC00160 D(1) = DSQRT(D(1)) KSC00170 KSC00180 D(2)=0. KSC00190 DO 2 K = 1,NS KSC00200 D(2) = D(2) + (A(K,3)-A(K,2))*(A(K,3)-A(K,2)) KSC00210 2 CONTINUE KSC00220 D(2) = DSQRT(D(2)) KSC00230 C KSC00240 D(3) = 0. KSC00250 DO 3 K = 1,NS KSC00260 D(3) = D(3) + (A(K,1)-A(K,3))*(A(K,1)-A(K,3)) KSC00270 3 CONTINUE KSC00280 D(3) = DSQRT(D(3)) KSC00290 KSC00300 C WRITE(6,*) ' D ',D(1),D(2),D(3) KSC00310 DO 10 I = 1,NS KSC00320 DO 11 K = 1,IES KSC00330 B(K,I)=A(K,I) KSC00340 11 CONTINUE KSC00350 10 CONTINUE KSC00360 KSC00370 IF (D(1).LE.D(2)) THEN KSC00380 IF (D(2).LE.D(3)) THEN KSC00390 KD(1)=1 KSC00400 KD(2)=2 KSC00410 KD(3)=3 KSC00420 KA(1)=1 KSC00430 KA(2)=2 KSC00440 KA(3)=3 KSC00450 ELSE KSC00460 IF (D(1).LE.D(3)) THEN KSC00470 KD(1)=1 KSC00480 KD(2)=3 KSC00490 KD(3)=2 KSC00500 KA(1)=2 KSC00510 KA(2)=1 KSC00520 KA(3)=3 KSC00530 ELSE KSC00540 KD(1)=3 KSC00550 KD(2)=1 KSC00560 KD(3)=2 KSC00570 KA(1)=3 KSC00580 KA(2)=1 KSC00590 KA(3)=2 KSC00600 ENDIF KSC00610 ENDIF KSC00620 ELSE KSC00630 IF (D(1).LE.D(3)) THEN KSC00640 KD(1)=2 KSC00650 KD(2)=1 KSC00660 KD(3)=3 KSC00670 KA(1)=3 KSC00680 KA(2)=2 KSC00690 KA(3)=1 KSC00700 ELSE KSC00710 IF (D(2).LE.D(3)) THEN KSC00720 KD(1)=2 KSC00730 KD(2)=3 KSC00740 KD(3)=1 KSC00750 KA(1)=2 KSC00760 KA(2)=3 KSC00770 KA(3)=1 KSC00780 ELSE KSC00790 KD(1)=3 KSC00800 KD(2)=2 KSC00810 KD(3)=1 KSC00820 KA(1)=1 KSC00830 KA(2)=3 KSC00840 KA(3)=2 KSC00850 ENDIF KSC00860 ENDIF KSC00870 ENDIF KSC00880 KSC00890 DO 20 I = 1,NS KSC00900 D1(I)=D(KD(I)) KSC00910 DO 21 K = 1,IES KSC00920 A(K,I)=B(K,KA(I)) KSC00930 21 CONTINUE KSC00940 20 CONTINUE KSC00950 KSC00960 C WRITE(6,*) ' D1 ',D1(1),D1(2),D1(3) KSC00970 KSC00980 RETURN KSC00990 END KSC01000