C DYCAND SOURCE BP208322 20/09/18 21:16:17 10718 SUBROUTINE DYCAND(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB, & XXXN,XDEP,XPOID,ICAND,IESC,IROLE) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *-----------------------------------------------------------------------* * * * Opérateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Pour la liaison Ligne_Ligne , * * Donne le segment du maillage le plus proche du point butée , * * calcule la normale intérieure au segment, le déplacement suivant * * cette normale et la position du point de contact sur le segment * * * * * * Paramètres * * * * e IPALB Renseigne sur la liaison. * * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. * * e XPALB Tableau contenant les paramètres de la liaison. * * * e XPTB Tableau des d{placements des points * * e NLIAB Nombre de liaisons sur la base B. * * e NPLB Nombre total de points intervenant dans les liaisons. * * e IND Indice du pas. * * e I numéro de la liaison. * * es ICAND Numéros 'dyne' des noeuds du segment candidat. * * es XPOID Position relative du point de contact sur le segment. * * es XXXN Normale intérieur au segment candidat. * * es XDEP Déplacement suivant la normale. * * * * * * Auteur, date de création: * * * * Samuel DURAND : le 08 Aout 1996 : Création * * * *-----------------------------------------------------------------------* INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*) INTEGER ICAND(2) REAL*8 XPTB(NPLB,2,*),XPALB(NLIAB,*) REAL*8 XXMA(3),PSC(2) REAL*8 XXXN(3),XXXC(2,3) * ITYP = IPALB(I,1) IDIM = IPALB(I,3) IF (ITYP.EQ.35) THEN ID1 = 6 ELSE ID1 = 7 ENDIF IF (IROLE.EQ.0) THEN KMAI = 0 IMAI = ID1 +4*IDIM IBUT = IMAI + (IPALB(I,21))*IDIM NNOEMA= IPALB(I,21) IFERMA= IPALB(I,24) KBUT = IPALB(I,21) JVOI=26 ELSE KMAI = IPALB(I,21) IBUT = ID1 + 4*IDIM IMAI = IBUT + (IPALB(I,21))*IDIM NNOEMA= IPALB(I,22) IFERMA= IPALB(I,25) KBUT = 0 JVOI=26+IPALB(I,22) ENDIF IM = IPALB(I,JVOI+IESC) * ***************************************** * Recherche du segment candidat * ***************************************** IM2 = IM +1 IM1 = IM -1 IDM = IMAI +(IM-1)*IDIM PXXC1 = 0.D0 PXXC2 = 0.D0 XLONG = 0.D0 PSC(1) = 0.D0 PSC(2) = 0.D0 XDEP = 0.D0 * Prise en compte des extrémitées pour contour fermé IF (IM1.EQ.0.AND.IFERMA.EQ.1) THEN IM1 = NNOEMA ENDIF IF (IM2.EQ.(NNOEMA+1).AND.IFERMA.EQ.1) THEN IM2 = 1 ENDIF IDM2 = IMAI +(IM2-1)*IDIM IDM1 = IMAI +(IM1-1)*IDIM * Tangentes au contour DO 500 ID=1,IDIM IF (IM2.NE.(NNOEMA+1)) THEN XXXC(2,ID) =XPALB(I,IDM2+ID) &+XPTB(IPLIB(I,KMAI+IM2),1,ID) &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),1,ID) ELSE XXXC(2,ID) = XPALB(I,IDM+ID) &+XPTB(IPLIB(I,KMAI+IM),1,ID) &-XPALB(I,IDM1+ID)-XPTB(IPLIB(I,KMAI+IM1),1,ID) ENDIF IF (IM1.NE.0) THEN XXXC(1,ID) = XPALB(I,IDM+ID) &+XPTB(IPLIB(I,KMAI+IM),1,ID) &-XPALB(I,IDM1+ID)-XPTB(IPLIB(I,KMAI+IM1),1,ID) ELSE XXXC(1,ID) = XPALB(I,IDM2+ID) &+XPTB(IPLIB(I,KMAI+IM2),1,ID) &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),1,ID) ENDIF PXXC1 = PXXC1 + XXXC(1,ID)*XXXC(1,ID) PXXC2 = PXXC2 + XXXC(2,ID)*XXXC(2,ID) 500 CONTINUE * Normalisation des tangentes PXXC1 = SQRT(PXXC1) PXXC2 = SQRT(PXXC2) DO 504 ID=1,IDIM XXXC(1,ID) = XXXC(1,ID)/PXXC1 XXXC(2,ID) = XXXC(2,ID)/PXXC2 504 CONTINUE * Projections sur les deux segments IDESC=IBUT+(IESC-1)*IDIM DO 508 ID=1,IDIM XXMA(ID) = XPALB(I,IDESC+ID) + XPTB(IPLIB(I,KBUT+IESC),1,ID) & - XPALB(I,IDM+ID) - XPTB(IPLIB(I,KMAI+IM),1,ID) PSC(1) = PSC(1) - XXMA(ID)*XXXC(1,ID) PSC(2) = PSC(2) + XXMA(ID)*XXXC(2,ID) 508 CONTINUE * Choix du segment ICAND(1) = IM IF (PSC(2).GT.PSC(1)) THEN IPT = 2 ICAND(2) = IM2 ELSE IPT = 1 ICAND(2) = IM1 ENDIF * Normale extérieure retenue IF (IDIM.EQ.3) THEN XXXN(1) = XPALB(I,ID1+2)*XXXC(IPT,3)-XPALB(I,ID1+3)* &XXXC(IPT,2) XXXN(2) = XPALB(I,ID1+3)*XXXC(IPT,1)-XPALB(I,ID1+1)* &XXXC(IPT,3) XXXN(3) = XPALB(I,ID1+1)*XXXC(IPT,2)-XPALB(I,ID1+2)* &XXXC(IPT,1) ELSE XXXN(1) = -XXXC(IPT,2) XXXN(2) = XXXC(IPT,1) ENDIF * Projection sur la normale DO 510 ID=1,IDIM XDEP = XDEP + XXMA(ID)*XXXN(ID) 510 CONTINUE * Pour un contour ouvert,arrivée en limite IF (ICAND(2).EQ.0) THEN ICAND(2) = 2 XDEP = - ABS(XDEP) ENDIF IF (ICAND(2).EQ.(NNOEMA+1)) THEN ICAND(2) = NNOEMA-1 XDEP = - ABS(XDEP) ENDIF * En cas de pénétration ,on récupère le poids associé XPOID = 0 IF (XDEP.GE.0) THEN IF (PSC(IPT).GE.0) THEN IDCAN1 = IMAI +(ICAND(1) -1)*IDIM IDCAN2 = IMAI +(ICAND(2) -1)*IDIM DO 512 ID=1,IDIM * Longueur du segment XAIDE = (XPALB(I,IDCAN1+ID) &+XPTB(IPLIB(I,KMAI+ICAND(1)),1,ID)-XPALB(I,IDCAN2+ID) &-XPTB(IPLIB(I,KMAI+ICAND(2)),1,ID)) XLONG = XLONG + XAIDE*XAIDE 512 CONTINUE XLONG = SQRT(XLONG) XPOID = (1-PSC(IPT)/XLONG) ELSE PS = 0.D0 DO 514 ID=1,IDIM PS = PS + XXMA(ID)*XXMA(ID) 514 CONTINUE PS = SQRT(PS) DO 516 ID=1,IDIM XXXN(ID) = XXMA(ID)/PS 516 CONTINUE XPOID = 1 ENDIF ENDIF END