Sources Esope | Cast3M

ksdec
C KSDEC     SOURCE    PV        11/03/07    21:17:21     6885
      SUBROUTINE KSDEC  (DR,A,D,S,IES,NS,N,GG,SS)                       KSD00020
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                                         KSD00030
C
C Calcul des facteurs de forme en 3D
C Sp appele par KCREPA (decoupage des faces)
C                                                                       KSD00060
C     DR        : LONGUEUR DE REFERENCE POUR LE DECOUPAGE               KSD00070
C     A , D , S : SOMMETS, LONGUEURS DES COTES ORDONNES, SURFACES       KSD00080
C     N         : NOMBRE DE SOUS-ELEMENTS                               KSD00090
C     GG(IES,N) : CENTRE DE GRAVITE                                     KSD00100
C     SS(N)     : SURFACE RAPPORTEE A LA SURFACE 'S' DE L'ELEMENT       KSD00110
C                                                                       KSD00120
      DIMENSION A(IES,NS),D(NS),GG(IES,1),SS(1)                         KSD00040
      DIMENSION X1(3),X2(3)                                             KSD00050
C     WRITE(6,*) ' KSDEC DR ',DR                                        KSD00130
C     WRITE(6,*) ' A1 ',A(1,1),A(2,1),A(3,1)                            KSD00140
C     WRITE(6,*) ' A2 ',A(1,2),A(2,2),A(3,2)                            KSD00150
C     WRITE(6,*) ' A3 ',A(1,3),A(2,3),A(3,3)                            KSD00160
      AL = 1./2.                                                        KSD00170
      N = 0                                                             KSD00180
      DT=0.                                                             KSD00190
      N3 = INT(D(3)/DR) + 1                                             KSD00200
C     WRITE(6,*) ' N3 ',N3                                              KSD00210
      DO 1 I=1,N3                                                       KSD00220
         X = AL/N3 +(I-1.)/N3                                           KSD00230
C        WRITE(6,*) ' I X ',I,X                                         KSD00240
         DI=0.                                                          KSD00250
         DO 11 K=1,IES                                                  KSD00260
         X1(K)= A(K,3)*X +A(K,1)*(1.-X)                                 KSD00270
         X2(K)= A(K,3)*X +A(K,2)*(1.-X)                                 KSD00280
C        WRITE(6,*) 'M1 M2',X1(K),X2(K)                                 KSD00290
         DI = DI + (X1(K)-X2(K))*(X1(K)-X2(K))                          KSD00300
 11      CONTINUE                                                       KSD00310
         DI=SQRT(DI)                                                    KSD00320
C        WRITE(6,*) ' DI ',DI                                           KSD00330
         DT = DT + DI                                                   KSD00340
                                                                        KSD00350
         NI = INT(DI/DR) + 1                                            KSD00360
C        WRITE(6,*) ' NI ',NI                                           KSD00370
         DO 2 J=1,NI                                                    KSD00380
            N = N + 1                                                   KSD00390
C           WRITE(6,*) ' N ',N                                          KSD00400
            Y = 1./2/NI +(J-1.)/NI                                      KSD00410
            DO 21 K=1,IES                                               KSD00420
            GG(K,N)=X1(K)*(1.-Y) + X2(K)*Y                              KSD00430
 21         CONTINUE                                                    KSD00440
            SS(N)= DI/NI                                                KSD00450
C           WRITE(6,*) ' SS ',SS(N)                                     KSD00460
 2       CONTINUE                                                       KSD00470
                                                                        KSD00480
 1    CONTINUE                                                          KSD00490
                                                                        KSD00500
      DO 3 I=1,N                                                        KSD00510
      SS(I)=SS(I)*S/DT                                                  KSD00520
 3    CONTINUE                                                          KSD00530
C     WRITE(6,*) ' NB POINTS ',N                                        KSD00540
C     WRITE(6,*) ' SURFACES  '                                          KSD00550
      RETURN                                                            KSD00560
      END                                                               KSD00570