C DYNE33    SOURCE    CHAT      05/01/12    23:17:23     5004
      SUBROUTINE DYNE33(XPALB,IPALB,NLIAB,I,ID1,XSECT)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Calcule la section du profil mobile                            *
*                                                                    *
*     Param}tres:                                                    *
*                                                                    *
* e   XPALB   tableau de description des liaisons sur base B         *
* e   IPALB   tableau de description des liaisons sur base B         *
* e   NLIAB   nombre total de liaisons                               *
*  s  XSECT   section                                                *
*                                                                    *
*                                                                    *
*     Auteur, date de cr{ation:                                      *
*                                                                    *
*     Lionel VIVAN, le 1 f{vrier 1991.                               *
*                                                                    *
*--------------------------------------------------------------------*
*
      INTEGER IPALB(NLIAB,*)
      REAL*8 XPALB(NLIAB,*)
      PARAMETER ( ZERO = 0.D0 )
*
      IDIM   = IPALB(I,3)
      NOMBN1 = IPALB(I,4)
      NOMBN2 = IPALB(I,5)
      ID2 = ID1 + IDIM
      ID3 = ID1 + 2*IDIM
      ID4 = ID1 + 3*IDIM
      ID7 = ID1 + 5*IDIM + IDIM*NOMBN1
*     calcul du barycentre du profil mobile
      XBARY = ZERO
      YBARY = ZERO
      IPT1 = ID7
      DO 8 IN = 1,NOMBN2
         XP1 = ZERO
         YP1 = ZERO
         DO 10 ID = 1,IDIM
            XX1 = XPALB(I,IPT1+ID) - XPALB(I,ID2+ID)
            XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
            YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
 10         CONTINUE
*        end do
         IPT1 = IPT1 + IDIM
         XBARY = XBARY + XP1
         YBARY = YBARY + YP1
 8       CONTINUE
*     end do
      XBARY = XBARY / NOMBN2
      YBARY = YBARY / NOMBN2
*
      XSECT = ZERO
      IPT1 = ID7
      IPT2 = ID7 + IDIM
      DO 12 IS = 1,NOMBN2
         IF (IS.EQ.NOMBN2) IPT2 = ID7
*     calcul des coordonn{es dans le plan d{fini par les profils
         XP1 = ZERO
         YP1 = ZERO
         XP2 = ZERO
         YP2 = ZERO
         DO 14 ID = 1,IDIM
            XX1 = XPALB(I,IPT1+ID) - XPALB(I,ID2+ID)
            XX2 = XPALB(I,IPT2+ID) - XPALB(I,ID2+ID)
            XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
            YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
            XP2 = XP2 + ( XX2 * XPALB(I,ID3+ID) )
            YP2 = YP2 + ( XX2 * XPALB(I,ID4+ID) )
 14         CONTINUE
*        end do
         XP1P2 = XP2 - XP1
         YP1P2 = YP2 - YP1
         DA = SQRT( (XP1P2 ** 2) + (YP1P2 ** 2 ) )
         XP2G = XBARY - XP2
         YP2G = YBARY - YP2
         DB = SQRT( (XP2G ** 2) + (YP2G ** 2) )
         XGP1 = XP1 - XBARY
         YGP1 = YP1 - YBARY
         DC = SQRT( (XGP1 ** 2) + (YGP1 ** 2) )
         PERI = 0.5 * ( DA + DB + DC )
         SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
         XSECT = XSECT + SQRT(SURF)
*
         IPT1 = IPT2
         IPT2 = IPT2 + IDIM
 12      CONTINUE
*     end do
*
      END