Sources Esope | Cast3M

dyne35
C DYNE35    SOURCE    BP208322  20/09/18    21:16:27     10718          
      SUBROUTINE DYNE35(IPOIN1,IPOIN2,XBARY,YBARY,XP,YP,XPP,YPP,XPALB,
     &                  IPALB,XPTB,NLIAB,NPLB,I,NPOI,ID1,IND,SOMAIR)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Calcul de l'aire de la section qui n'a pas travers{ le         *
*     maillage fixe.                                                 *
*                                                                    *
*     Param}tres:                                                    *
*                                                                    *
* e   IPOIN1  point du profil mobile                                 *
* e   IPOIN2  point du profil mobile                                 *
* e   XBARY   coordonn{e du barycentre                               *
* e   YBARY   coordonn{e du barycentre                               *
* e   I       num{ro de la liaison trait{e                           *
* e   XP,YP   coordonn{es du point P d'intersection                  *
* e   XPP,YPP coordonn{es du point PP d'intersection                 *
* e   NLIAB   nombre total de liaisons                               *
*  s  SOMAIR  aire de la section                                     *
*                                                                    *
*     Auteur, date de cr{ation:                                      *
*                                                                    *
*     Lionel VIVAN, le 1 f{vrier 1991.                               *
*                                                                    *
*--------------------------------------------------------------------*
*
      INTEGER IPALB(NLIAB,*)
      REAL*8 XPTB(NPLB,2,*),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
      ID6 = ID1 + 5*IDIM
      ID7 = ID6 + IDIM*NOMBN1
      IPT1 = ID7 + IDIM*(IPOIN1-1)
      IPT2 = ID7 + IDIM*(IPOIN2-1)
*
      SOMAIR = ZERO
      XP1 = ZERO
      YP1 = ZERO
      XP2 = ZERO
      YP2 = ZERO
      DO 12 ID = 1,IDIM
         XX1 = XPTB(NPOI,1,ID) + XPALB(I,IPT1+ID)
     &                           - XPALB(I,ID2+ID)
         XX2 = XPTB(NPOI,1,ID) + 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) )
 12      CONTINUE
*     end do
      XPPP2 = XP2 - XPP
      YPPP2 = YP2 - YPP
      DA = SQRT( (XPPP2 ** 2) + (YPPP2 ** 2) )
      XP2G = XBARY - XP2
      YP2G = YBARY - YP2
      DB = SQRT( (XP2G ** 2) + (YP2G ** 2) )
      XGPP = XPP - XBARY
      YGPP = YPP - YBARY
      DC = SQRT( (XGPP ** 2) + (YGPP ** 2) )
      PERI = 0.5 * ( DA + DB + DC )
      SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
      SOMAIR = SOMAIR + SQRT(SURF)
      XP1P = XP - XP1
      YP1P = YP - YP1
      DA = SQRT( (XP1P ** 2) + (YP1P ** 2 ) )
      XPG = XBARY - XP
      YPG = YBARY - YP
      DB = SQRT( (XPG ** 2) + (YPG ** 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)
      SOMAIR = SOMAIR + SQRT(SURF)
      NBSURF = 0
      IF (IPOIN1.GT.IPOIN2 ) THEN
         ICAS = 1
         NBSURF = 1
         I2 = IPOIN1
 2       CONTINUE
         I2 = I2 - 1
         IF (I2.EQ.0) I2 = NOMBN2
         IF (I2.EQ.IPOIN2) GOTO 4
         NBSURF = NBSURF + 1
         GOTO 2
 4       CONTINUE
      ELSE IF (IPOIN1.LT.IPOIN2 ) THEN
         ICAS = 2
         NBSURF = 1
         I6 = IPOIN2
 6       CONTINUE
         I6 = I6 + 1
         IF (I6.EQ.(NOMBN2+1)) I6 = 1
         IF (I6.EQ.IPOIN1) GOTO 8
         NBSURF = NBSURF + 1
         GOTO 6
 8       CONTINUE
      ENDIF
      IF (NBSURF.NE.0) THEN
         IF (ICAS.EQ.1) THEN
            NUM1 = IPOIN1
         ELSE
            NUM1 = IPOIN2
         ENDIF
         DO 14 IS = 1,NBSURF
            IF (ICAS.EQ.1) THEN
               NUM2 = NUM1 - 1
               IF (NUM2.EQ.0) NUM2 = NOMBN2
            ELSE
               NUM2 = NUM1 + 1
               IF (NUM2.EQ.(NOMBN2+1)) NUM2 = 1
            ENDIF
            IPT1 = ID7 + IDIM*(NUM1-1)
            IPT2 = ID7 + IDIM*(NUM2-1)
            XP1 = ZERO
            YP1 = ZERO
            XP2 = ZERO
            YP2 = ZERO
            DO 16 ID = 1,IDIM
               XX1 = XPTB(NPOI,1,ID) + XPALB(I,IPT1+ID)
     &                                 - XPALB(I,ID2+ID)
               XX2 = XPTB(NPOI,1,ID) + 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) )
 16            CONTINUE
*           end do
            XP2P1 = XP1 - XP2
            YP2P1 = YP1 - YP2
            DA = SQRT( (XP2P1 ** 2) + (YP2P1 ** 2 ) )
            XP1G = XBARY - XP1
            YP1G = YBARY - YP1
            DB = SQRT( (XP1G ** 2) + (YP1G ** 2) )
            XGP2 = XP2 - XBARY
            YGP2 = YP2 - YBARY
            DC = SQRT( (XGP2 ** 2) + (YGP2 ** 2) )
            PERI = 0.5 * ( DA + DB + DC )
            SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
            SOMAIR = SOMAIR + SQRT(SURF)
            NUM1 = NUM2
 14         CONTINUE
*        end do
      ENDIF
*
      END