Sources Esope | Cast3M

dyne36
C DYNE36    SOURCE    CHAT      05/01/12    23:17:40     5004
      SUBROUTINE DYNE36(NUMEL1,NUMEL2,XBARY,YBARY,XP,YP,XPP,YPP,XPALB,
     &                  IPALB,NLIAB,I,ID1,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   XBARY   coordonn{e du barycentre                               *
* e   YBARY   coordonn{e du barycentre                               *
* e   NUMEL1  {l{ment du profil fixe                                 *
* e   NUMEL2  {l{ment du profil fixe                                 *
* 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                               *
* e   I       num{ro de la liaison trait{e                           *
*  s  SOMAIR  aire de la section                                     *
*                                                                    *
*     Auteur, date de cr{ation:                                      *
*                                                                    *
*     Lionel VIVAN, le 1 f{vrier 1991.                               *
*                                                                    *
*--------------------------------------------------------------------*
*
      INTEGER IPALB(NLIAB,*)
      REAL*8 XPALB(NLIAB,*)
      PARAMETER ( ZERO = 0.D0 )
*
      ITYP   = IPALB(I,1)
      IDIM   = IPALB(I,3)
      NOMBN1 = IPALB(I,4)
      ID2 = ID1 + IDIM
      ID3 = ID1 + 2*IDIM
      ID4 = ID1 + 3*IDIM
      ID6 = ID1 + 5*IDIM
*
      SOMAIR = ZERO
      IF (NUMEL1.EQ.NUMEL2) THEN
         XPPG = XBARY - XPP
         YPPG = YBARY - YPP
         DA = SQRT( (XPPG ** 2) + (YPPG ** 2) )
         XGP = XP - XBARY
         YGP = YP - YBARY
         DB = SQRT( (XGP ** 2) + (YGP ** 2) )
         XPPP = XPP - XP
         YPPP = YPP - YP
         DC = SQRT( (XPPP ** 2) + (YPPP ** 2) )
         PERI = 0.5 * ( DA + DB + DC )
         SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
         SOMAIR = SOMAIR + SQRT(SURF)
*
      ELSE
         NBELEM = 0
         IF (ITYP.EQ.31) THEN
            I2 = NUMEL1
 2          CONTINUE
            I2 = I2 + 1
            IF (I2.EQ.(NOMBN1+1)) I2 = 1
            IF (I2.EQ.NUMEL2) GOTO 4
            NBELEM = NBELEM + 1
            GOTO 2
 4          CONTINUE
         ELSE
            I6 = NUMEL1
 6          CONTINUE
            I6 = I6 - 1
            IF (I6.EQ.0) I6 = NOMBN1
            IF (I6.EQ.NUMEL2) GOTO 8
            NBELEM = NBELEM + 1
            GOTO 6
 8          CONTINUE
         ENDIF
         IF (ITYP.EQ.31) THEN
            IEE1 = NUMEL1 + 1
            IF (IEE1.EQ.(NOMBN1+1)) IEE1 = 1
            IE1 = ID6 + IDIM*(IEE1-1)
         ELSE
            IE1 = ID6 + IDIM*(NUMEL1-1)
         ENDIF
         XE1 = ZERO
         YE1 = ZERO
         DO 10 ID = 1,IDIM
            XX1 = XPALB(I,IE1+ID) - XPALB(I,ID2+ID)
            XE1 = XE1 + ( XX1 * XPALB(I,ID3+ID) )
            YE1 = YE1 + ( XX1 * XPALB(I,ID4+ID) )
 10        CONTINUE
*        end do
         XPE1 = XE1 - XP
         YPE1 = YE1 - YP
         DA = SQRT( (XPE1 ** 2) + (YPE1 ** 2) )
         XE1G = XBARY - XE1
         YE1G = YBARY - YE1
         DB = SQRT( (XE1G ** 2) + (YE1G ** 2) )
         XGP = XP - XBARY
         YGP = YP - YBARY
         DC = SQRT( (XGP ** 2) + (YGP ** 2) )
         PERI = 0.5 * ( DA + DB + DC )
         SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
         SOMAIR = SOMAIR + SQRT(SURF)
         IF (NBELEM.NE.0) THEN
            IE1 = NUMEL1
            DO 12 IE = 1,NBELEM
               IF (ITYP.EQ.31) THEN
                  IE1 = IE1 + 1
                  IF (IE1.EQ.(NOMBN1+1)) IE1 = 1
                  IE2 = IE1 + 1
                  IF (IE2.EQ.(NOMBN1+1)) IE2 = 1
                  IPT1 = ID6 + IDIM*(IE1-1)
                  IPT2 = ID6 + IDIM*(IE2-1)
               ELSE
                  IE2 =IE1 - 1
                  IF (IE2.EQ.0) IE2 = NOMBN1
                  IPT1 = ID6 + IDIM*(IE1-1)
                  IPT2 = ID6 + IDIM*(IE2-1)
                  IE1 = IE1 - 1
                  IF (IE1.EQ.0) IE1 = NOMBN1
               ENDIF
               XE1 = ZERO
               YE1 = ZERO
               XE2 = ZERO
               YE2 = ZERO
               DO 14 ID = 1,IDIM
                  XX1 = XPALB(I,IPT1+ID) - XPALB(I,ID2+ID)
                  XX2 = XPALB(I,IPT2+ID) - XPALB(I,ID2+ID)
                  XE1 = XE1 + ( XX1 * XPALB(I,ID3+ID) )
                  YE1 = YE1 + ( XX1 * XPALB(I,ID4+ID) )
                  XE2 = XE2 + ( XX2 * XPALB(I,ID3+ID) )
                  YE2 = YE2 + ( XX2 * XPALB(I,ID4+ID) )
 14               CONTINUE
*              end do
               XE1E2 = XE2 - XE1
               YE1E2 = YE2 - YE1
               DA = SQRT( (XE1E2 ** 2) + (YE1E2 ** 2) )
               XE2G = XBARY - XE2
               YE2G = YBARY - YE2
               DB = SQRT( (XE2G ** 2) + (YE2G ** 2) )
               XGE1 = XE1 - XBARY
               YGE1 = YE1 - YBARY
               DC = SQRT( (XGE1 ** 2) + (YGE1 ** 2) )
               PERI = 0.5 * ( DA + DB + DC )
               SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
               SOMAIR = SOMAIR + SQRT(SURF)
 12            CONTINUE
*           end do
            XE2PP = XPP - XE2
            YE2PP = YPP - YE2
            DA = SQRT( (XE2PP ** 2) + (YE2PP ** 2) )
            XPPG = XBARY - XPP
            YPPG = YBARY - YPP
            DB = SQRT( (XPPG ** 2) + (YPPG ** 2) )
            XGE2 = XE2 - XBARY
            YGE2 = YE2 - YBARY
            DC = SQRT( (XGE2 ** 2) + (YGE2 ** 2 ) )
            PERI = 0.5 * ( DA + DB + DC )
            SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
            SOMAIR = SOMAIR + SQRT(SURF)
         ELSE
            XE1PP = XPP - XE1
            YE1PP = YPP - YE1
            DA = SQRT( (XE1PP ** 2) + (YE1PP ** 2) )
            XPPG = XBARY - XPP
            YPPG = YBARY - YPP
            DB = SQRT( (XPPG ** 2) + (YPPG ** 2 ) )
            XGE1 = XE1 - XBARY
            YGE1 = YE1 - YBARY
            DC = SQRT( (XGE1 ** 2 ) + (YGE1 ** 2) )
            PERI = 0.5 * ( DA + DB + DC )
            SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
            SOMAIR = SOMAIR + SQRT(SURF)
         ENDIF
      ENDIF
*
      END