C KREM3F    SOURCE    PV        22/04/21    21:15:06     11344          
      SUBROUTINE KREM3F(K2,KG,NG,KC1,NA2,NF2,NF3,NF1,NA3,NA1
     -                 ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C----------------------------------------------------------------------
C Calcul des facteurs de forme en 3D
C Sp appele par krem3g
C     3 FACES DIFFERENTES NON PARALLELES
C     ----------------------------------
C
C     IL EXISTE UNE FACE GENEREE  PAR L'ARETE NA2
C     -------------------------------------------
C
C----------------------------------------------------------------------
      DIMENSION KG(2),KH(2),KC1(2),U2(*)
-INC TFFOR3D

      SEGMENT SKCEL
      INTEGER  KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)
      REAL*8   RMAX
      ENDSEGMENT
      IF (IFA(3,NA2).EQ.NF1) THEN

      CALL KINITB(KBCEL,NRES,NRES,KG,NG)
      CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      CALL KREMPI(NIN,K2,KG,NG,NF2,C,U2,SHC3D,SKCEL,SKBUFF)

      CALL KINITB(KBCEL,NRES,NRES,KG,NG)
      CALL KREMPA(K2,KG,NG,NF3,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      CALL KREMPI(NIN,K2,KG,NG,NF3,C,U2,SHC3D,SKCEL,SKBUFF)

      CALL KINITB(KBCEL,NRES,NRES,KG,NG)
      CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      KH(1) = (KG(1)/2 + KC1(1))/2
      KH(2) = (KG(2)/2 + KC1(2))/2
      NG = 0
      KG(1) = 0
      KG(2) = 0
      CALL KREMPA(K2,KG,NG,NFN,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      KH(1) = (KG(1) + KH(1))/2
      KH(2) = (KG(2) + KH(2))/2
      CALL KREMPI(NIN,K2,KH,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)

      ELSE
      NFF = IFA(3,NA2)

C     WRITE(6,*) ' KREMPY NFF ',NFF
      CALL KINITB(KBCEL,NRES,NRES,KG,NG)
      CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      CALL KFINSO(NF1,NF3,KA,IM,KH)
      CALL KFINSO(NFF,NF3,KA,IM,KG)
      KH(1) = (KG(1) + KH(1))/2
      KH(2) = (KG(2) + KH(2))/2
      CALL KREMPI(NIN,K2,KH,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF)

      CALL KINITB(KBCEL,NRES,NRES,KG,NG)
      CALL KREMPA(K2,KG,NG,NF3,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      CALL KFINSO(NF1,NF2,KA,IM,KH)
      CALL KFINSO(NFF,NF2,KA,IM,KG)
      KH(1) = (KG(1) + KH(1))/2
      KH(2) = (KG(2) + KH(2))/2
      CALL KREMPI(NIN,K2,KH,1,NF3,C,U2,SHC3D,SKCEL,SKBUFF)

      CALL KINITB(KBCEL,NRES,NRES,KG,NG)
      CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      CALL KFINSO(NF2,NF3,KA,IM,KH)
      KH(1) = (KG(1)/2 + KH(1))/2
      KH(2) = (KG(2)/2 + KH(2))/2
      CALL KREMPI(NIN,K2,KH,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
C
      CALL KINITB(KBCEL,NRES,NRES,KG,NG)
      CALL KREMPA(K2,KG,NG,NFF,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
      CALL KFINSO(NF2,NF3,KA,IM,KG)
      CALL KREMPI(NIN,K2,KG,1,NFF,C,U2,SHC3D,SKCEL,SKBUFF)
      ENDIF

      RETURN
      END


 
