Télécharger la plaquette Cast3M


fr en

Télécharger dycan1.eso

Retour à la liste

Numérotation des lignes : 

dycan1

  1. C DYCAN1    SOURCE    BP208322  20/09/18    21:16:16     10718          
  2. C DYCAND    SOURCE    LAVARENN  96/11/05    21:22:27     2357
  3.         SUBROUTINE DYCAN1(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,
  4.      &                    XXXN,XNET,XTE,XPOID,ICAND,IESC,IROLE)
  5.       IMPLICIT INTEGER(I-N)
  6.         IMPLICIT REAL*8(A-H,O-Z)
  7. *-----------------------------------------------------------------------*
  8. *                                                                       *
  9. *     Opérateur DYNE : algorithme de Fu - de Vogelaere                  *
  10. *     ________________________________________________                  *
  11. *                                                                       *
  12. *       Pour la liaison Ligne_cercle ,                                  *
  13. *     Donne le segment du maillage le plus proche du point butée ,      *
  14. *     calcule la normale de contact, le déplacement suivant             *
  15. *     cette normale et la position du point de contact sur le segment   *
  16. *                                                                       *
  17. *                                                                       *
  18. *     Paramètres                                                        *
  19. *                                                                       *
  20. * e   IPALB   Renseigne sur la liaison.                                 *
  21. * e   IPLIB   Tableau contenant les numéros "DYNE" de la liaison.       *
  22. * e   XPALB   Tableau contenant les paramètres de la liaison.           *                                                       *
  23. * e   XPTB    Tableau des d{placements des points                       *
  24. * e   NLIAB   Nombre de liaisons sur la base B.                         *
  25. * e   NPLB    Nombre total de points intervenant dans les liaisons.     *
  26. * e   IND     Indice du pas.                                            *
  27. * e   I       numéro de la liaison.                                     *
  28. * es  ICAND   Numéros 'dyne' des noeuds du segment candidat.            *
  29. * es  XPOID   Position relative du point de contact sur le segment.     *
  30. * es  XXXN    Normale au contact                                        *
  31. * es  XNET    distance du centre du cercle(E) au point du               *
  32. *             segment candidat dans le plan du cercle (T)               *
  33. *  s  XTE     vecteur TE (T POINT DE CONTACT, E CENTRE DU CERCLE )       *
  34. *                                                                       *
  35. *     Auteur, date de création:                                         *
  36. *                                                                       *
  37. *     IBRAHIM PINTO, 05/97                                              *
  38. *                                                                       *
  39. *-----------------------------------------------------------------------*
  40.         INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  41.         INTEGER ICAND(2)
  42.         REAL*8  XPTB(NPLB,2,*),XPALB(NLIAB,*)
  43.         REAL*8  XXMA(3),PSC(2),AE(3),AB(3), PCONT(3),XTE(3)
  44.         REAL*8  XXXN(3),XXXC(2,3),U(3)
  45. *
  46.  
  47.  
  48.         ITYP = IPALB(I,1)
  49.         IDIM = IPALB(I,3)
  50.         XRAIT = XPALB(I,5)
  51.         IF (ITYP.EQ.37 .OR. ITYP.EQ.39) THEN
  52.            ID1 = 6
  53.         ELSE
  54.            ID1 = 7
  55.         ENDIF
  56.         IF (IROLE.EQ.0) THEN
  57.            KMAI = 0
  58.            IMAI = ID1 +4*IDIM
  59.            IBUT = IMAI + (IPALB(I,21))*IDIM
  60.            NNOEMA= IPALB(I,21)
  61.            IFERMA= IPALB(I,24)
  62.            KBUT = IPALB(I,21)
  63.            JVOI=26
  64.         ELSE
  65.            KMAI =  IPALB(I,21)
  66.            IBUT = ID1 + 4*IDIM
  67.            IMAI = IBUT + (IPALB(I,21))*IDIM
  68.            NNOEMA= IPALB(I,22)
  69.            IFERMA= IPALB(I,25)
  70.            KBUT = 0
  71.            JVOI=26+IPALB(I,22)
  72.         ENDIF
  73.         IM = IPALB(I,JVOI+IESC)
  74.  
  75.  
  76.  
  77. *
  78. *****************************************
  79. *   Recherche du segment candidat       *
  80. *****************************************
  81.         IM2 = IM +1
  82.         IM1 = IM -1
  83.         IDM = IMAI +(IM-1)*IDIM
  84.         PXXC1  = 0.D0
  85.         PXXC2  = 0.D0
  86.         XLONG  = 0.D0
  87.         PSC(1) = 0.D0
  88.         PSC(2) = 0.D0
  89.         XNET   = 0.D0
  90. *   Prise en compte des extrémitées pour contour fermé
  91.         IF (IM1.EQ.0.AND.IFERMA.EQ.1) THEN
  92.                 IM1 = NNOEMA
  93.         ENDIF
  94.         IF (IM2.EQ.(NNOEMA+1).AND.IFERMA.EQ.1) THEN
  95.                 IM2 = 1
  96.         ENDIF
  97.         IDM2 = IMAI +(IM2-1)*IDIM
  98.         IDM1 = IMAI +(IM1-1)*IDIM
  99. *   Tangentes au contour
  100.         DO 500 ID=1,IDIM
  101.            IF (IM2.NE.(NNOEMA+1)) THEN
  102.                    XXXC(2,ID) =XPALB(I,IDM2+ID)
  103.      &+XPTB(IPLIB(I,KMAI+IM2),1,ID)
  104.      &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),1,ID)
  105.            ELSE
  106.                    XXXC(2,ID) = -XPALB(I,IDM+ID)
  107.      &-XPTB(IPLIB(I,KMAI+IM),1,ID)
  108.      &+XPALB(I,IDM1+ID)+XPTB(IPLIB(I,KMAI+IM1),1,ID)
  109.            ENDIF
  110.            IF (IM1.NE.0) THEN
  111.                    XXXC(1,ID) = -XPALB(I,IDM+ID)
  112.      &-XPTB(IPLIB(I,KMAI+IM),1,ID)
  113.      &+XPALB(I,IDM1+ID)+XPTB(IPLIB(I,KMAI+IM1),1,ID)
  114.            ELSE
  115.                    XXXC(1,ID) = XPALB(I,IDM2+ID)
  116.      &+XPTB(IPLIB(I,KMAI+IM2),1,ID)
  117.      &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),1,ID)
  118.            ENDIF
  119.            PXXC1 = PXXC1 + XXXC(1,ID)*XXXC(1,ID)
  120.            PXXC2 = PXXC2 + XXXC(2,ID)*XXXC(2,ID)
  121.  500       CONTINUE
  122. *   Normalisation des tangentes
  123.         PXXC1 = SQRT(PXXC1)
  124.         PXXC2 = SQRT(PXXC2)
  125.         DO 504 ID=1,IDIM
  126.            XXXC(1,ID) = XXXC(1,ID)/PXXC1
  127.            XXXC(2,ID) = XXXC(2,ID)/PXXC2
  128.  504       CONTINUE
  129. *   Projections sur les deux segments
  130.         IDESC=IBUT+(IESC-1)*IDIM
  131.         DO 508 ID=1,IDIM
  132.            XXMA(ID) = XPALB(I,IDESC+ID) + XPTB(IPLIB(I,KBUT+IESC),1,ID)
  133.      &     - XPALB(I,IDM+ID) - XPTB(IPLIB(I,KMAI+IM),1,ID)
  134.            PSC(1) = PSC(1) + XXMA(ID)*XXXC(1,ID)
  135.            PSC(2) = PSC(2) + XXMA(ID)*XXXC(2,ID)
  136.  508       CONTINUE
  137. *   Choix du segment
  138.         ICAND(1) = IM
  139.         IF (PSC(2).GT.PSC(1)) THEN
  140.            IPT = 2
  141.            ICAND(2) = IM2
  142.         ELSE
  143.            IPT = 1
  144.            ICAND(2) = IM1
  145.         ENDIF
  146.  
  147.  
  148. * Pour un contour ouvert arrivee en limite
  149. * mise a zero de xnet pour indiquer qu'il n'a pas
  150. * contact
  151.  
  152.       IF (ICAND(2).EQ.0) THEN
  153.          ICAND(2) = 2
  154.          XNET = 0
  155.       ENDIF
  156.       IF (ICAND(1).EQ.(NNOEMA+1)) THEN
  157.          ICAND(2)= NNOEMA-1
  158.          XNET=0
  159.       ENDIF
  160.  
  161.  
  162.  
  163. *---position relative du point de contact sur le segment candidat
  164.  
  165.  
  166.        IDCAN1 = IMAI +(ICAND(1) -1)*IDIM
  167.        IDCAN2 = IMAI +(ICAND(2) -1)*IDIM
  168.        PSNAE = 0.D0
  169.        PSNAB = 0.D0
  170.  
  171.  
  172.  
  173. *------calcul des produits scalaires necessaires
  174.  
  175. *--------calcul des coordonnees des vecteurs icand1iesc(AE) et icand1icand2(AB)
  176.  
  177.        DO 510 ID=1,IDIM
  178.         AE(ID) = XPALB(I,IDESC+ID)+XPTB(IPLIB(I,KBUT+IESC),1,
  179.      &ID)-XPALB(I,IDCAN1+ID)-XPTB(IPLIB(I,KMAI+ICAND(1)),1,ID)
  180.  
  181.        AB(ID)= XPALB(I,IDCAN2+ID)+XPTB(IPLIB(I,KMAI+ICAND(2)),1,
  182.      &ID)-XPALB(I,IDCAN1+ID)-XPTB(IPLIB(I,KMAI+ICAND(1)),1,ID)
  183.  510      CONTINUE
  184.  
  185.  
  186.  
  187. *------calcul des produits scalaires
  188. *------AVEC LA NORMALE AU PLAN DU CERCLE
  189.  
  190.        DO 512 ID=1,IDIM
  191.           PSNAE=PSNAE+XPALB(I,ID1+ID)*AE(ID)
  192.           PSNAB=PSNAB+XPALB(I,ID1+ID)*AB(ID)
  193.  512      CONTINUE
  194.  
  195. *------CALCUL DE LA POSITION RELATIVE DU POINT DU
  196. *------SEGMENT DANS LE PLAN DU CERCLE(ORIGINE:LE+PROCHE VOISIN MAITRE)
  197.  
  198.        XNHU=0.D0
  199.        XNHU=PSNAE/PSNAB
  200.  
  201.  
  202.  
  203.       IF (XNHU.GE.0) THEN
  204.  
  205.  
  206. *------CALCUL DES COORDONNES CARTESIENNES
  207. *------DU "POINT DE CONTACT POTENTIEL"(POINT T)
  208.  
  209.        DO 514 ID=1,IDIM
  210.           PCONT(ID)=0.D0
  211.           PCONT(ID)=(1-XNHU)*(XPALB(I,IDCAN1+ID)
  212.      &+XPTB(IPLIB(I,KMAI+ICAND(1)),1,ID))+
  213.      &XNHU*(XPALB(I,IDCAN2+ID)
  214.      &+XPTB(IPLIB(I,KMAI+ICAND(2)),1,ID))
  215.  514      CONTINUE
  216.  
  217.  
  218. *-----CALCUL DE LA DISTANCE ENTRE LE NOEUD ESCLAVE(CENTRE DU CERCLE)
  219. *-----ET LE POINT DU SEGMENT DANS LE PLAN DU CERCLE( DISTANCE ET)
  220.  
  221.        XNET=0.D0
  222.        PSET2=0.D0
  223.  
  224.  
  225.  
  226.  
  227.        DO 516 ID=1,IDIM
  228.           XA=-PCONT(ID)
  229.           XB=XPALB(I,IDESC+ID)
  230.           XC=XPTB(IPLIB(I,KBUT+IESC),1,ID)
  231.           XTE(ID)=XA+XB+XC
  232. *       XTE(ID)=-PCONT(ID)+XPALB(I,IDESC+ID)+XPTB(IPLIB(I,KBUT+IESC),1,ID)
  233.           PSET2=PSET2+XTE(ID)*XTE(ID)
  234.  
  235.  
  236.  
  237.  516   CONTINUE
  238.  
  239.  
  240.        XNET=SQRT(PSET2)
  241.  
  242.  
  243. *-----CALCUL DU POIDS EN CAS DE CONTACT
  244.  
  245.        XPOID=0.D0
  246.        XRAY=XPALB(I,2)
  247.  
  248.        IF (XNET.GE.XRAY) THEN
  249.           XPOID=1-XNHU
  250.        ENDIF
  251.  
  252.       ELSE
  253. *--------SINON TOUT SE PASSE COMME S'IL N'Y AVAIT
  254. *--------PAS CONTACT;ON MET XNET A ZERO
  255.  
  256.         XNET=0.D0
  257.  
  258.       ENDIF
  259.  
  260. *----ENDIF DU XNHU.GE.0
  261.  
  262.  
  263.  
  264.  
  265. *-----CALCUL DE LA NORMALE AU PLAN DE CONTACT
  266.  
  267.  
  268.        IF (ITYP.EQ.37 .OR. ITYP.EQ.38) THEN
  269. *-----SI ON SUPPOSE LA NORMALE DANS LE PLAN DU CERCLE
  270. *-----NORMALE=TE, ON NE DIFFERENCIE PAS CAS  2D ET 3D(SANREAC)
  271.  
  272.           DO 517 ID=1,IDIM
  273.              XXXN(ID)=XTE(ID)/XNET
  274.  517      CONTINUE
  275.  
  276.  
  277.  
  278.        ELSE
  279.  
  280. *-----DANS LE CAS GENERAL (REACNOR)
  281. *-----ON A BESOIN DE LA NORMALE AU PLAN ABE
  282.  
  283.            PSN=0.D0
  284.            PSN2=0.D0
  285.  
  286. *-------CALCUL DE LA NORMALE AU PLAN ABE(U)
  287.            IF (IDIM.EQ.3) THEN
  288.               U(1)=AB(2)*AE(3)-AB(3)*AE(2)
  289.               U(2)=AB(3)*AE(1)-AB(1)*AE(3)
  290.               U(3)=AB(1)*AE(2)-AB(2)*AE(1)
  291.  
  292.  
  293. *-------CALCUL DE LA NORMALE AU PLAN DE CONTACT EN 3D
  294.  
  295.               XXXN(1)=U(2)*AB(3)-U(3)*AB(2)
  296.               XXXN(2)=U(3)*AB(1)-U(1)*AB(3)
  297.               XXXN(3)=U(1)*AB(2)-U(2)*AB(1)
  298.  
  299.  
  300.            ELSE
  301.  
  302. *-------calcul de la normale en 2d
  303.                XXXN(1)=-(AB(1)*AE(2)-AB(2)*AE(1))*AB(2)
  304.                XXXN(2)=(AB(1)*AE(2)-AB(2)*AE(1))*AB(1)
  305.            ENDIF
  306.  
  307. *-------NORMALISATION,INDEPENDANTE DE LA DIMENSION
  308.                DO 522 ID=1,IDIM
  309.                    PSN2=PSN2 + XXXN(ID)*XXXN(ID)
  310.  522           CONTINUE
  311.                PSN=SQRT(PSN2)
  312.                DO 524 ID=1,IDIM
  313.                  XXXN(ID)=XXXN(ID)/PSN
  314.   524          CONTINUE
  315.  
  316.        ENDIF
  317.  
  318.  
  319.  
  320.  
  321.  
  322. C
  323.  
  324.        END
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  

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