Télécharger la plaquette Cast3M


fr en

Télécharger dycand.eso

Retour à la liste

Numérotation des lignes : 

dycand

  1. C DYCAND    SOURCE    BP208322  20/09/18    21:16:17     10718          
  2.         SUBROUTINE DYCAND(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,
  3.      &                    XXXN,XDEP,XPOID,ICAND,IESC,IROLE)
  4.       IMPLICIT INTEGER(I-N)
  5.         IMPLICIT REAL*8(A-H,O-Z)
  6. *-----------------------------------------------------------------------*
  7. *                                                                       *
  8. *     Opérateur DYNE : algorithme de Fu - de Vogelaere                  *
  9. *     ________________________________________________                  *
  10. *                                                                       *
  11. *       Pour la liaison Ligne_Ligne ,                                   *
  12. *     Donne le segment du maillage le plus proche du point butée ,      *
  13. *     calcule la normale intérieure au segment, le déplacement suivant  *
  14. *     cette normale et la position du point de contact sur le segment   *
  15. *                                                                       *
  16. *                                                                       *
  17. *     Paramètres                                                        *
  18. *                                                                       *
  19. * e   IPALB   Renseigne sur la liaison.                                 *
  20. * e   IPLIB   Tableau contenant les numéros "DYNE" de la liaison.       *
  21. * e   XPALB   Tableau contenant les paramètres de la liaison.           *                                                       *
  22. * e   XPTB    Tableau des d{placements des points                       *
  23. * e   NLIAB   Nombre de liaisons sur la base B.                         *
  24. * e   NPLB    Nombre total de points intervenant dans les liaisons.     *
  25. * e   IND     Indice du pas.                                            *
  26. * e   I       numéro de la liaison.                                     *
  27. * es  ICAND   Numéros 'dyne' des noeuds du segment candidat.            *
  28. * es  XPOID   Position relative du point de contact sur le segment.     *
  29. * es  XXXN    Normale intérieur au segment candidat.                    *
  30. * es  XDEP    Déplacement suivant la normale.                           *
  31. *                                                                       *
  32. *                                                                       *
  33. *     Auteur, date de création:                                         *
  34. *                                                                       *
  35. *     Samuel DURAND      : le 08 Aout 1996 : Création                   *
  36. *                                                                       *
  37. *-----------------------------------------------------------------------*
  38.         INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  39.         INTEGER ICAND(2)
  40.         REAL*8  XPTB(NPLB,2,*),XPALB(NLIAB,*)
  41.         REAL*8  XXMA(3),PSC(2)
  42.         REAL*8  XXXN(3),XXXC(2,3)
  43. *
  44.         ITYP = IPALB(I,1)
  45.         IDIM = IPALB(I,3)
  46.         IF (ITYP.EQ.35) THEN
  47.            ID1 = 6
  48.         ELSE
  49.            ID1 = 7
  50.         ENDIF
  51.         IF (IROLE.EQ.0) THEN
  52.            KMAI = 0
  53.            IMAI = ID1 +4*IDIM
  54.            IBUT = IMAI + (IPALB(I,21))*IDIM
  55.            NNOEMA= IPALB(I,21)
  56.            IFERMA= IPALB(I,24)
  57.            KBUT = IPALB(I,21)
  58.            JVOI=26
  59.         ELSE
  60.            KMAI =  IPALB(I,21)
  61.            IBUT = ID1 + 4*IDIM
  62.            IMAI = IBUT + (IPALB(I,21))*IDIM
  63.            NNOEMA= IPALB(I,22)
  64.            IFERMA= IPALB(I,25)
  65.            KBUT = 0
  66.            JVOI=26+IPALB(I,22)
  67.         ENDIF
  68.         IM = IPALB(I,JVOI+IESC)
  69. *
  70. *****************************************
  71. *   Recherche du segment candidat       *
  72. *****************************************
  73.         IM2 = IM +1
  74.         IM1 = IM -1
  75.         IDM = IMAI +(IM-1)*IDIM
  76.         PXXC1  = 0.D0
  77.         PXXC2  = 0.D0
  78.         XLONG  = 0.D0
  79.         PSC(1) = 0.D0
  80.         PSC(2) = 0.D0
  81.         XDEP   = 0.D0
  82. *   Prise en compte des extrémitées pour contour fermé
  83.         IF (IM1.EQ.0.AND.IFERMA.EQ.1) THEN
  84.                 IM1 = NNOEMA
  85.         ENDIF
  86.         IF (IM2.EQ.(NNOEMA+1).AND.IFERMA.EQ.1) THEN
  87.                 IM2 = 1
  88.         ENDIF
  89.         IDM2 = IMAI +(IM2-1)*IDIM
  90.         IDM1 = IMAI +(IM1-1)*IDIM
  91. *   Tangentes au contour
  92.         DO 500 ID=1,IDIM
  93.            IF (IM2.NE.(NNOEMA+1)) THEN
  94.                    XXXC(2,ID) =XPALB(I,IDM2+ID)
  95.      &+XPTB(IPLIB(I,KMAI+IM2),1,ID)
  96.      &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),1,ID)
  97.            ELSE
  98.                    XXXC(2,ID) = XPALB(I,IDM+ID)
  99.      &+XPTB(IPLIB(I,KMAI+IM),1,ID)
  100.      &-XPALB(I,IDM1+ID)-XPTB(IPLIB(I,KMAI+IM1),1,ID)
  101.            ENDIF
  102.            IF (IM1.NE.0) THEN
  103.                    XXXC(1,ID) = XPALB(I,IDM+ID)
  104.      &+XPTB(IPLIB(I,KMAI+IM),1,ID)
  105.      &-XPALB(I,IDM1+ID)-XPTB(IPLIB(I,KMAI+IM1),1,ID)
  106.            ELSE
  107.                    XXXC(1,ID) = XPALB(I,IDM2+ID)
  108.      &+XPTB(IPLIB(I,KMAI+IM2),1,ID)
  109.      &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),1,ID)
  110.            ENDIF
  111.            PXXC1 = PXXC1 + XXXC(1,ID)*XXXC(1,ID)
  112.            PXXC2 = PXXC2 + XXXC(2,ID)*XXXC(2,ID)
  113.  500       CONTINUE
  114. *   Normalisation des tangentes
  115.         PXXC1 = SQRT(PXXC1)
  116.         PXXC2 = SQRT(PXXC2)
  117.         DO 504 ID=1,IDIM
  118.            XXXC(1,ID) = XXXC(1,ID)/PXXC1
  119.            XXXC(2,ID) = XXXC(2,ID)/PXXC2
  120.  504       CONTINUE
  121. *   Projections sur les deux segments
  122.         IDESC=IBUT+(IESC-1)*IDIM
  123.         DO 508 ID=1,IDIM
  124.            XXMA(ID) = XPALB(I,IDESC+ID) + XPTB(IPLIB(I,KBUT+IESC),1,ID)
  125.      &     - XPALB(I,IDM+ID) - XPTB(IPLIB(I,KMAI+IM),1,ID)
  126.            PSC(1) = PSC(1) - XXMA(ID)*XXXC(1,ID)
  127.            PSC(2) = PSC(2) + XXMA(ID)*XXXC(2,ID)
  128.  508       CONTINUE
  129. *   Choix du segment
  130.         ICAND(1) = IM
  131.         IF (PSC(2).GT.PSC(1)) THEN
  132.            IPT = 2
  133.            ICAND(2) = IM2
  134.         ELSE
  135.            IPT = 1
  136.            ICAND(2) = IM1
  137.         ENDIF
  138. *   Normale extérieure retenue
  139.         IF (IDIM.EQ.3) THEN
  140.           XXXN(1) = XPALB(I,ID1+2)*XXXC(IPT,3)-XPALB(I,ID1+3)*
  141.      &XXXC(IPT,2)
  142.           XXXN(2) = XPALB(I,ID1+3)*XXXC(IPT,1)-XPALB(I,ID1+1)*
  143.      &XXXC(IPT,3)
  144.           XXXN(3) = XPALB(I,ID1+1)*XXXC(IPT,2)-XPALB(I,ID1+2)*
  145.      &XXXC(IPT,1)
  146.         ELSE
  147.           XXXN(1) = -XXXC(IPT,2)
  148.           XXXN(2) =  XXXC(IPT,1)
  149.         ENDIF
  150. *   Projection sur la normale
  151.         DO 510 ID=1,IDIM
  152.            XDEP = XDEP + XXMA(ID)*XXXN(ID)
  153.  510       CONTINUE
  154. *   Pour un contour ouvert,arrivée en limite
  155.         IF (ICAND(2).EQ.0) THEN
  156.            ICAND(2) = 2
  157.            XDEP = - ABS(XDEP)
  158.         ENDIF
  159.         IF (ICAND(2).EQ.(NNOEMA+1)) THEN
  160.            ICAND(2) = NNOEMA-1
  161.            XDEP = - ABS(XDEP)
  162.         ENDIF
  163. *   En cas de pénétration ,on récupère le poids associé
  164.         XPOID = 0
  165.         IF (XDEP.GE.0) THEN
  166.            IF (PSC(IPT).GE.0) THEN
  167.                 IDCAN1 = IMAI +(ICAND(1) -1)*IDIM
  168.                 IDCAN2 = IMAI +(ICAND(2) -1)*IDIM
  169.                 DO 512 ID=1,IDIM
  170. *   Longueur du segment
  171.                    XAIDE = (XPALB(I,IDCAN1+ID)
  172.      &+XPTB(IPLIB(I,KMAI+ICAND(1)),1,ID)-XPALB(I,IDCAN2+ID)
  173.      &-XPTB(IPLIB(I,KMAI+ICAND(2)),1,ID))
  174.                    XLONG = XLONG + XAIDE*XAIDE
  175.  512               CONTINUE
  176.                 XLONG = SQRT(XLONG)
  177.                 XPOID = (1-PSC(IPT)/XLONG)
  178.            ELSE
  179.                 PS = 0.D0
  180.                 DO 514 ID=1,IDIM
  181.                    PS = PS + XXMA(ID)*XXMA(ID)
  182.  514               CONTINUE
  183.                 PS = SQRT(PS)
  184.                 DO 516 ID=1,IDIM
  185.                    XXXN(ID) = XXMA(ID)/PS
  186.  516            CONTINUE
  187.                 XPOID = 1
  188.            ENDIF
  189.         ENDIF
  190.         END
  191.  
  192.  
  193.  
  194.  
  195.  

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