1 : C KSCLAS SOURCE CHAT 05/01/13 01:07:44 5004 2 : SUBROUTINE KSCLAS (A,D1,IES,NS) KSC00020 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) KSC00030 5 : C Calcul des facteurs de forme en 3D 6 : C Sp appele par KCREPA (decoupage des faces) KSC00070 7 : C Dete 8 : C A : SOMMETS KSC00080 9 : C D : LONGUEUR DES COTES KSC00090 10 : C KSC00100 11 : C KSC00110 12 : DIMENSION A(IES,NS),D1(NS) KSC00040 13 : DIMENSION B(3,3),D(3) KSC00050 14 : DIMENSION KA(3),KD(3) KSC00060 15 : C KSC00120 16 : D(1)=0. KSC00130 17 : DO 1 K = 1,NS KSC00140 18 : D(1) = D(1) + (A(K,2)-A(K,1))*(A(K,2)-A(K,1)) KSC00150 19 : 1 CONTINUE KSC00160 20 : D(1) = DSQRT(D(1)) KSC00170 21 : KSC00180 22 : D(2)=0. KSC00190 23 : DO 2 K = 1,NS KSC00200 24 : D(2) = D(2) + (A(K,3)-A(K,2))*(A(K,3)-A(K,2)) KSC00210 25 : 2 CONTINUE KSC00220 26 : D(2) = DSQRT(D(2)) KSC00230 27 : C KSC00240 28 : D(3) = 0. KSC00250 29 : DO 3 K = 1,NS KSC00260 30 : D(3) = D(3) + (A(K,1)-A(K,3))*(A(K,1)-A(K,3)) KSC00270 31 : 3 CONTINUE KSC00280 32 : D(3) = DSQRT(D(3)) KSC00290 33 : KSC00300 34 : C WRITE(6,*) ' D ',D(1),D(2),D(3) KSC00310 35 : DO 10 I = 1,NS KSC00320 36 : DO 11 K = 1,IES KSC00330 37 : B(K,I)=A(K,I) KSC00340 38 : 11 CONTINUE KSC00350 39 : 10 CONTINUE KSC00360 40 : KSC00370 41 : IF (D(1).LE.D(2)) THEN KSC00380 42 : IF (D(2).LE.D(3)) THEN KSC00390 43 : KD(1)=1 KSC00400 44 : KD(2)=2 KSC00410 45 : KD(3)=3 KSC00420 46 : KA(1)=1 KSC00430 47 : KA(2)=2 KSC00440 48 : KA(3)=3 KSC00450 49 : ELSE KSC00460 50 : IF (D(1).LE.D(3)) THEN KSC00470 51 : KD(1)=1 KSC00480 52 : KD(2)=3 KSC00490 53 : KD(3)=2 KSC00500 54 : KA(1)=2 KSC00510 55 : KA(2)=1 KSC00520 56 : KA(3)=3 KSC00530 57 : ELSE KSC00540 58 : KD(1)=3 KSC00550 59 : KD(2)=1 KSC00560 60 : KD(3)=2 KSC00570 61 : KA(1)=3 KSC00580 62 : KA(2)=1 KSC00590 63 : KA(3)=2 KSC00600 64 : ENDIF KSC00610 65 : ENDIF KSC00620 66 : ELSE KSC00630 67 : IF (D(1).LE.D(3)) THEN KSC00640 68 : KD(1)=2 KSC00650 69 : KD(2)=1 KSC00660 70 : KD(3)=3 KSC00670 71 : KA(1)=3 KSC00680 72 : KA(2)=2 KSC00690 73 : KA(3)=1 KSC00700 74 : ELSE KSC00710 75 : IF (D(2).LE.D(3)) THEN KSC00720 76 : KD(1)=2 KSC00730 77 : KD(2)=3 KSC00740 78 : KD(3)=1 KSC00750 79 : KA(1)=2 KSC00760 80 : KA(2)=3 KSC00770 81 : KA(3)=1 KSC00780 82 : ELSE KSC00790 83 : KD(1)=3 KSC00800 84 : KD(2)=2 KSC00810 85 : KD(3)=1 KSC00820 86 : KA(1)=1 KSC00830 87 : KA(2)=3 KSC00840 88 : KA(3)=2 KSC00850 89 : ENDIF KSC00860 90 : ENDIF KSC00870 91 : ENDIF KSC00880 92 : KSC00890 93 : DO 20 I = 1,NS KSC00900 94 : D1(I)=D(KD(I)) KSC00910 95 : DO 21 K = 1,IES KSC00920 96 : A(K,I)=B(K,KA(I)) KSC00930 97 : 21 CONTINUE KSC00940 98 : 20 CONTINUE KSC00950 99 : KSC00960 100 : C WRITE(6,*) ' D1 ',D1(1),D1(2),D1(3) KSC00970 101 : KSC00980 102 : RETURN KSC00990 103 : END KSC01000 104 : 105 :
© Cast3M 2003 - All rights reserved.
Disclaimer