Télécharger la plaquette Cast3M


fr en

Télécharger dyne33.eso

Retour à la liste

Numérotation des lignes : 

dyne33

  1. C DYNE33    SOURCE    CHAT      05/01/12    23:17:23     5004
  2.       SUBROUTINE DYNE33(XPALB,IPALB,NLIAB,I,ID1,XSECT)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *
  8. *     ________________________________________________               *
  9. *                                                                    *
  10. *     Calcule la section du profil mobile                            *
  11. *                                                                    *
  12. *     Param}tres:                                                    *
  13. *                                                                    *
  14. * e   XPALB   tableau de description des liaisons sur base B         *
  15. * e   IPALB   tableau de description des liaisons sur base B         *
  16. * e   NLIAB   nombre total de liaisons                               *
  17. *  s  XSECT   section                                                *
  18. *                                                                    *
  19. *                                                                    *
  20. *     Auteur, date de cr{ation:                                      *
  21. *                                                                    *
  22. *     Lionel VIVAN, le 1 f{vrier 1991.                               *
  23. *                                                                    *
  24. *--------------------------------------------------------------------*
  25. *
  26.       INTEGER IPALB(NLIAB,*)
  27.       REAL*8 XPALB(NLIAB,*)
  28.       PARAMETER ( ZERO = 0.D0 )
  29. *
  30.       IDIM   = IPALB(I,3)
  31.       NOMBN1 = IPALB(I,4)
  32.       NOMBN2 = IPALB(I,5)
  33.       ID2 = ID1 + IDIM
  34.       ID3 = ID1 + 2*IDIM
  35.       ID4 = ID1 + 3*IDIM
  36.       ID7 = ID1 + 5*IDIM + IDIM*NOMBN1
  37. *     calcul du barycentre du profil mobile
  38.       XBARY = ZERO
  39.       YBARY = ZERO
  40.       IPT1 = ID7
  41.       DO 8 IN = 1,NOMBN2
  42.          XP1 = ZERO
  43.          YP1 = ZERO
  44.          DO 10 ID = 1,IDIM
  45.             XX1 = XPALB(I,IPT1+ID) - XPALB(I,ID2+ID)
  46.             XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
  47.             YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
  48.  10         CONTINUE
  49. *        end do
  50.          IPT1 = IPT1 + IDIM
  51.          XBARY = XBARY + XP1
  52.          YBARY = YBARY + YP1
  53.  8       CONTINUE
  54. *     end do
  55.       XBARY = XBARY / NOMBN2
  56.       YBARY = YBARY / NOMBN2
  57. *
  58.       XSECT = ZERO
  59.       IPT1 = ID7
  60.       IPT2 = ID7 + IDIM
  61.       DO 12 IS = 1,NOMBN2
  62.          IF (IS.EQ.NOMBN2) IPT2 = ID7
  63. *     calcul des coordonn{es dans le plan d{fini par les profils
  64.          XP1 = ZERO
  65.          YP1 = ZERO
  66.          XP2 = ZERO
  67.          YP2 = ZERO
  68.          DO 14 ID = 1,IDIM
  69.             XX1 = XPALB(I,IPT1+ID) - XPALB(I,ID2+ID)
  70.             XX2 = XPALB(I,IPT2+ID) - XPALB(I,ID2+ID)
  71.             XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
  72.             YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
  73.             XP2 = XP2 + ( XX2 * XPALB(I,ID3+ID) )
  74.             YP2 = YP2 + ( XX2 * XPALB(I,ID4+ID) )
  75.  14         CONTINUE
  76. *        end do
  77.          XP1P2 = XP2 - XP1
  78.          YP1P2 = YP2 - YP1
  79.          DA = SQRT( (XP1P2 ** 2) + (YP1P2 ** 2 ) )
  80.          XP2G = XBARY - XP2
  81.          YP2G = YBARY - YP2
  82.          DB = SQRT( (XP2G ** 2) + (YP2G ** 2) )
  83.          XGP1 = XP1 - XBARY
  84.          YGP1 = YP1 - YBARY
  85.          DC = SQRT( (XGP1 ** 2) + (YGP1 ** 2) )
  86.          PERI = 0.5 * ( DA + DB + DC )
  87.          SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
  88.          XSECT = XSECT + SQRT(SURF)
  89. *
  90.          IPT1 = IPT2
  91.          IPT2 = IPT2 + IDIM
  92.  12      CONTINUE
  93. *     end do
  94. *
  95.       END
  96.  
  97.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales