C KSUBCR    SOURCE    CHAT      05/01/13    01:09:07     5004
      SUBROUTINE KSUBCR(O1,KSUB,NSUB,AA,SHC3D,SPROGP,SPROJA)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C----------------------------------------------------------------------
C Calcul des facteurs de forme en 3D
C Sp appele par Kprojf
C     Determination de la projection des sommets et des aretes
C
C     O1      : POINT DE VUE PRIS SUR K1
C     AA      : SOMMETS DU TRIANGLE DE LA FACE K2
C     U2      : NORMALE A LA FACE K2
C
C----------------------------------------------------------------------
C
      DIMENSION U2(4),AA(3,3,4)
      DIMENSION X1(3),X2(3),KC1(2),KC2(2)
      DIMENSION O1(3),O2(3),XG1(3),XG2(3)
      DIMENSION KG(2),KH(2)
-INC TFFOR3D
      SEGMENT SPROGP
      INTEGER  KF(NPT),ICOO(2,NPT)
      REAL*8   XR(3,NPT)
      ENDSEGMENT
C
      NPT=KF(/1)
      NSE=NFA(/1)
C     WRITE(6,*) ' KSUBCR : NPT NSE KSUB NSUB ',NPT,NSE,KSUB,NSUB

C    SOMMETS
C    -------
            DO 320 I = 1,NPT
              DO 322 K=1,KES
              O2(K) = AA(K,I,KSUB)
 322          CONTINUE

              CALL KAPCUB(KES,O2,O1,NRES,X1,KF(I),ICOO(1,I),ICOO(2,I))
C             WRITE(6,*) KF(I),ICOO(1,I),ICOO(2,I)
C             WRITE(6,*) ' XR ',(X1(I1),I1=1,KES)

              DO 323 K = 1,KES
              XR(K,I) = X1(K)
 323          CONTINUE
 320        CONTINUE
C
C   ARETES
C   ------
            DO 330 I = 1,NSE
              NP1 = I
              NP2 = I + 1
              IF(I.EQ.3) NP2 = 1
              DO 331 K = 1,KES
              X1(K) = XR(K,NP1)
              X2(K) = XR(K,NP2)
              XG1(K) = AA(K,NP1,KSUB)
              XG2(K) = AA(K,NP2,KSUB)
 331          CONTINUE

              KC1(1) = ICOO(1,NP1)
              KC1(2) = ICOO(2,NP1)
              KC2(1) = ICOO(1,NP2)
              KC2(2) = ICOO(2,NP2)
              KF1 = KF(NP1)
              KF2 = KF(NP2)
              CALL KPROJA(O1,XG1,XG2,X1,KF1,KC1,X2,KF2,KC2
     &                  ,I,SPROJA,SHC3D)

 330        CONTINUE
C
C     WRITE(6,*) '<KSUBCR : NPT NSE KSUB NSUB ',NPT,NSE,KSUB,NSUB
      RETURN
      END