Sources Esope | Cast3M

ksclas
C KSCLAS    SOURCE    CB215821  16/04/22    21:15:03     8922           
      SUBROUTINE KSCLAS (A,D1,IES,NS)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
C Calcul des facteurs de forme en 3D
C Sp appele par KCREPA (decoupage des faces)
C     Dete
C     A         : SOMMETS
C     D         : LONGUEUR DES COTES
C
C
      DIMENSION A(IES,NS),D1(NS)
      DIMENSION B(3,3),D(3)
      DIMENSION KA(3),KD(3)
C
       D(1)=0.D0
       DO 1 K = 1,NS
         D(1) = D(1) + (A(K,2)-A(K,1))*(A(K,2)-A(K,1))
 1     CONTINUE
       D(1) = SQRT(D(1))
 
       D(2)=0.D0
       DO 2 K = 1,NS
         D(2) = D(2) + (A(K,3)-A(K,2))*(A(K,3)-A(K,2))
 2     CONTINUE
       D(2) = SQRT(D(2))
C
       D(3) = 0.D0
       DO 3 K = 1,NS
         D(3) = D(3) + (A(K,1)-A(K,3))*(A(K,1)-A(K,3))
 3     CONTINUE
       D(3) = SQRT(D(3))
 
C      WRITE(6,*) ' D ',D(1),D(2),D(3)
       DO 10 I = 1,NS
       DO 11 K = 1,IES
         B(K,I)=A(K,I)
 11    CONTINUE
 10    CONTINUE
 
       IF (D(1).LE.D(2)) THEN
          IF (D(2).LE.D(3)) THEN
          KD(1)=1
          KD(2)=2
          KD(3)=3
          KA(1)=1
          KA(2)=2
          KA(3)=3
          ELSE
            IF (D(1).LE.D(3)) THEN
               KD(1)=1
               KD(2)=3
               KD(3)=2
               KA(1)=2
               KA(2)=1
               KA(3)=3
            ELSE
               KD(1)=3
               KD(2)=1
               KD(3)=2
               KA(1)=3
               KA(2)=1
               KA(3)=2
            ENDIF
          ENDIF
       ELSE
          IF (D(1).LE.D(3)) THEN
          KD(1)=2
          KD(2)=1
          KD(3)=3
          KA(1)=3
          KA(2)=2
          KA(3)=1
          ELSE
            IF (D(2).LE.D(3)) THEN
               KD(1)=2
               KD(2)=3
               KD(3)=1
               KA(1)=2
               KA(2)=3
               KA(3)=1
            ELSE
               KD(1)=3
               KD(2)=2
               KD(3)=1
               KA(1)=1
               KA(2)=3
               KA(3)=2
            ENDIF
          ENDIF
       ENDIF
 
       DO 20 I = 1,NS
         D1(I)=D(KD(I))
       DO 21 K = 1,IES
         A(K,I)=B(K,KA(I))
 21    CONTINUE
 20    CONTINUE
 
C      WRITE(6,*) ' D1 ',D1(1),D1(2),D1(3)
 
      RETURN
      END