C DYFOR1 SOURCE BP208322 20/09/18 21:16:19 10718 C DYFORC SOURCE LAVARENN 96/11/05 21:22:41 2357 SUBROUTINE DYFOR1(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND &,IND2,PDTS2,I,iannul,IESC,IROLE,XCHPFB) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Opérateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Calcul des forces de choc sur base B pour les liaisons de * * type ligne_cercle * * * * Paramètres: * * * * e XPTB Tableau des déplacements des points * * 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. * * es XVALB Tableau contenant les variables internes de liaisons. * * es XCHPFB Tableau contenant les valeurs des futurs chpoints * * 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. * * e IESC numéro DYNE du noeud esclave * * e IROLE indique qui est le maitre et l'esclave * * = 0 premiere passe , =1 deuxième passe * * * * * * Auteur, date de création: * * * * Ibrahim PINTO, 05/97 ,liaisons ligne_cercle * *--------------------------------------------------------------------* * INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*) INTEGER ICAND(2) REAL*8 XPALB(NLIAB,*),XPTB(NPLB,2,*),XVALB(NLIAB,4,*) REAL*8 XXXN(3),XCHPFB(2,NLIAB,4,*),XTE(3),XNET * XEPSI = 0.0001 IGP = IPALB(I,2) IDIM = IPALB(I,3) * ILOCAL = IPALB(I,23) ITYP = IPALB(I,1) XPOID = 0.D0 XRAY=XPALB(I,2) * IF (ITYP.EQ.37 .OR. ITYP.EQ.39) THEN ID1 = 6 ELSE ID1 = 7 ENDIF * IF (IROLE.EQ.0) THEN KMAI = 0 IMAI = ID1 +4*IDIM IBUT = IMAI + IPALB(I,21)*IDIM KBUT = IPALB(I,21) LMAI = ID1 + (IPALB(I,21)+IPALB(I,22)+4)*IDIM LBUT = LMAI +IPALB(I,21)*IDIM JMAI = 26 + IPALB(I,21)+IPALB(I,22) JBUT = JMAI + IPALB(I,21) MBUT = LBUT +IPALB(I,22)*IDIM + & IPALB(I,21) NBUT = MBUT +IPALB(I,21)+IPALB(I,22) ELSE KMAI = IPALB(I,21) IBUT = ID1 + 4*IDIM IMAI = IBUT + IPALB(I,21)*IDIM KBUT = 0 LBUT = ID1 + (IPALB(I,21)+IPALB(I,22)+4)*IDIM LMAI = LBUT +IPALB(I,21)*IDIM JBUT = 26 + 2*(IPALB(I,21)+IPALB(I,22)) JMAI = JBUT +IPALB(I,21) MBUT = LMAI +IPALB(I,22)*IDIM NBUT = MBUT +IPALB(I,21)+IPALB(I,22) ENDIF ID2 = ID1 + IDIM ID4 = ID1 +3*IDIM CALL DYCAN1(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB, & XXXN,XNET,XTE,XPOID,ICAND,IESC,IROLE) XVITN =0.D0 IDCAN1 = IMAI + (ICAND(1)-1)*IDIM IDCAN2 = IMAI + (ICAND(2)-1)*IDIM DO 80 ID=1,IDIM * * Déplacement du point de contact au pas courant x1=(XPTB(IPLIB(I,KMAI+ICAND(2)),1,ID))*(1-XPOID) x2=(XPTB(IPLIB(I,KMAI+ICAND(1)),1,ID))*XPOID xde2=x1+x2 XVALB(I,IND,3+ID) = XVALB(I,IND,3+ID)+ &XPALB(I,IDCAN1+ID)*XPOID +XPALB(I,IDCAN2+ID)*(1-XPOID) cbp,2020-09* Déplacement du point de contact au pas précédent cbp,2020-09 XDM2 =(XPTB(IPLIB(I,KMAI+ICAND(2)),IND2,ID))*(1-XPOID) cbp,2020-09 & + (XPTB(IPLIB(I,KMAI+ICAND(1)),IND2,ID))*XPOID * Vitesse du point de contact au pas courant XVI2 =(XPTB(IPLIB(I,KMAI+ICAND(2)),2,ID))*(1-XPOID) & + (XPTB(IPLIB(I,KMAI+ICAND(1)),2,ID))*XPOID cbp,2020-09*-----Déplacement de la butee(point de contact sur le cercle) cbp,2020-09*-----on a neglige les rotations des butees cbp,2020-09 XDB = (XPTB(IPLIB(I,KBUT+IESC),IND,ID) cbp,2020-09 & -XPTB(IPLIB(I,KBUT+IESC),IND2,ID)) * Vitesse de la butee XVB = XPTB(IPLIB(I,KBUT+IESC),2,ID) * Vitesse de glissement cbp,2020-09 XPALB(I,ID2+ID)=(XDB+XDM2-XDE2)/PDTS2 XPALB(I,ID2+ID)=XVB-XVI2 * Vitesse normale cbp,2020-09 XVITN = XVITN + ((XDB+XDM2-XDE2)*XXXN(ID)/PDTS2) XVITN = XVITN + (XVB-XVI2)*XXXN(ID) 80 CONTINUE DO 82 ID=1,IDIM * Vitesse tangentielle XPALB(I,ID2+ID) = XPALB(I,ID2+ID) - (XVITN*XXXN(ID)) 82 CONTINUE * Calcul de la force de choc XPALB(I,1) = XPALB(I,MBUT+IESC) IF (ITYP.EQ.37 .OR. ITYP.EQ.39) THEN CALL DYCHE5(XNET,XTE,XXXN,IDIM,IGP,XPALB,NLIAB,I & ,IPALB,XFN,XFT,XPUS,iannul) ELSE XPALB(I,7) = XPALB(I,NBUT+IESC) CALL DYCHA5(XNET,XTE,XXXN,XVITN,IDIM,IGP,XPALB,NLIAB, &I,IPALB,XFN,XFT,XPUS,iannul) ENDIF XVALB(I,IND,3) = XVALB(I,IND,3) + XVITN IPALB(I,2) = IGP IF (IGP.EQ.1) THEN PS =0.D0 DO 84 ID=1,IDIM PS=PS+(XPALB(I,ID2+ID)*XPALB(I,ID2+ID)) 84 CONTINUE XVITT = SQRT(PS) ELSE XVITT = 0.D0 ENDIF XVALB(I,IND,11) = XVALB(I,IND,11)+XVITT IF (XNET.GE.XRAY) THEN DO 90 ID=1,IDIM XPALB(I,ID+LMAI+(ICAND(1)-1)*IDIM) =XPALB(I,ID+LMAI+ &(ICAND(1)-1)*IDIM)-XPOID * (XFN*XXXN(ID) + XPALB(I,ID4+ID)) XPALB(I,ID+LMAI+(ICAND(2)-1)*IDIM) =XPALB(I,ID+LMAI+(ICAND &(2)-1)*IDIM)- ( 1.-XPOID )*(XFN*XXXN(ID) + XPALB(I,ID4+ID)) XPALB(I,ID+LBUT+(IESC-1)*IDIM) =XPALB(I,ID+LBUT+ &(IESC-1)*IDIM) + XFN * XXXN(ID) + XPALB(I,ID4+ID) 90 CONTINUE XCHPFB(1,I,IND,IPLIB(I,KBUT+IESC))= &XCHPFB(1,I,IND,IPLIB(I,KBUT+IESC))+XFN XCHPFB(2,I,IND,IPLIB(I,KBUT+IESC))= &XCHPFB(2,I,IND,IPLIB(I,KBUT+IESC))+ABS(XFT) XCHPFB(1,I,IND,IPLIB(I,KMAI+ICAND(1)))= &XCHPFB(1,I,IND,IPLIB(I,KMAI+ICAND(1)))+XPOID *XFN XCHPFB(2,I,IND,IPLIB(I,KMAI+ICAND(1)))= &XCHPFB(2,I,IND,IPLIB(I,KMAI+ICAND(1)))+XPOID *ABS(XFT) XCHPFB(1,I,IND,IPLIB(I,KMAI+ICAND(2)))= &XCHPFB(1,I,IND,IPLIB(I,KMAI+ICAND(2)))+( 1.-XPOID )*XFN XCHPFB(2,I,IND,IPLIB(I,KMAI+ICAND(2)))= &XCHPFB(2,I,IND,IPLIB(I,KMAI+ICAND(2)))+( 1.-XPOID )*ABS(XFT) IF (XPOID.GT.XEPSI) THEN IPALB(I,JMAI+ICAND(1))=1 ENDIF IF ((1.0-XPOID).GT.XEPSI) THEN IPALB(I,JMAI+ICAND(2))=1 ENDIF IPALB(I,JBUT+IESC) = 1 XVALB(I,IND,1) = XVALB(I,IND,1)+XFN XVALB(I,IND,10) = XVALB(I,IND,10)+ ABS(XFT) XVALB(I,IND,12) = XVALB(I,IND,12)+ XPUS ENDIF * END