C DEVLB2 SOURCE BP208322 20/09/18 21:15:37 10718 SUBROUTINE DEVLB2(IPLIB,IPALB,XPALB,XPTB,NLIAB,IND,IDIMB, & NPLB,XABSCI,XORDON,NIP) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Opérateur DYNE : * * Initialisation du tableau contenant les paramètres de liaison * * * *--------------------------------------------------------------------* * * * Paramètres: * * * * e IPALB Renseigne sur la liaison. * * e/s XPALB Tableau contenant les paramètres de la liaison. * * e NLIAB Nombre de liaisons sur la base B. * * e IDIMB Nombre de directions. * * e IND Indice du pas. * * * *--------------------------------------------------------------------* INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*) REAL*8 XPALB(NLIAB,*),XPTB(NPLB,2,*),XPTP2(3) REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*) * IND2 = IND + 1 * * Boucle sur le nombre de liaisons * DO 10 I = 1,NLIAB ITYP = IPALB(I,1) * * ------ choc élémentaire POINT_CERCLE_FROTTEMENT * cbp,2020 IF (ITYP.EQ.23 .OR. ITYP.EQ.24) THEN cbp,2020 : rem : il n'y avait pas 123 et 124 ??? IF (ITYP.EQ.24 .OR. ITYP.EQ.124) THEN NPOI = IPLIB(I,1) IDIM = IPALB(I,3) cbp,2020 IF (ITYP.EQ.23) THEN cbp,2020 ID1 = 6 cbp,2020 ELSE cbp,2020 ID1 = 7 ID1 = 10 cbp,2020 ENDIF ID7 = ID1 + 6*IDIM DO 230 ID=1,IDIM * déjà effectué dans devcoi , avec prise en compte de * la rotation initiale * XPTB(NPOI,2,ID) = XPTB(NPOI,1,ID) XPALB(I,ID7+ID) = XPTB(NPOI,1,ID) 230 CONTINUE * end do * * ------ choc élémentaire POINT_CERCLE_MOBILE * ELSE IF (ITYP.EQ. 33 .OR. ITYP.EQ. 34 & .OR. ITYP.EQ.133 .OR. ITYP.EQ.134) THEN NPOA = IPLIB(I,1) NPOB = IPLIB(I,2) IDIM = IPALB(I,3) IF (ITYP.EQ.33) THEN ID1 = 6 ELSE ID1 = 7 ENDIF ID7 = ID1 + 6*IDIM DO 330 ID=1,IDIM * XPTB(NPOa,2,ID) = XPTB(NPOa,1,ID) * XPTB(NPOb,2,ID) = XPTB(NPOb,1,ID) XPALB(I,ID7+ID) = XPTB(NPOa,1,ID) & - XPTB(NPOb,1,ID) 330 CONTINUE * * ------ choc élémentaire CERCLE_CERCLE_FROTTEMENT * ELSE IF (ITYP.EQ. 25 .OR. ITYP.EQ. 26 & .OR. ITYP.EQ.125 .OR. ITYP.EQ.126) THEN NPOI = IPLIB(I,1) IDIM = IPALB(I,3) IF (ITYP.EQ.25) THEN ID1 = 6 ELSE ID1 = 7 ENDIF ID2 = ID1 + IDIM ID3 = ID1 + 2*IDIM ID7 = ID1 + 6*IDIM ID10 = ID1 + 9*IDIM XRAYT = XPALB(I,ID10+1) * Calcul du déplacement du point fibre neutre dans le plan du cercle * Calcul de la normale de choc PSXPN = 0.D0 DO 250 ID = 1,IDIM PSXPN = PSXPN + ( XPTB(NPOI,1,ID) * XPALB(I,ID1+ID) ) 250 CONTINUE * end do PSXPME = 0.D0 DO 252 ID = 1,IDIM XXPME = ( XPTB(NPOI,1,ID) - ( PSXPN * XPALB(I,ID1+ID) ) ) & - XPALB(I,ID2+ID) XPALB(I,ID3+ID) = XXPME PSXPME = PSXPME + ( XXPME * XXPME ) 252 CONTINUE * end do PSXPME = SQRT(PSXPME) IF (PSXPME.GT.1D-20) THEN DO 254 ID = 1,IDIM XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / PSXPME 254 CONTINUE * end do ENDIF * Calcul du déplacement du point de contact au pas courant XPTP2(1) = XPTB(NPOI,1,1) + & ( XPALB(I,ID3+1) * XRAYT ) XPTP2(2) = XPTB(NPOI,1,2) + & ( XPALB(I,ID3+2) * XRAYT ) XPTP2(3) = XPTB(NPOI,1,3) + & ( XPALB(I,ID3+3) * XRAYT ) * Initialisation de la position origine adherence DO 256 ID=1,IDIM * XPTB(NPOI,2,ID) = XPTB(NPOI,1,ID) XPALB(I,ID7+ID) = XPTP2(ID) 256 CONTINUE * end do * * ------ choc élémentaire POINT_POINT_FROTTEMENT * ELSE IF ((abs(ITYP)).EQ.13 .OR. ITYP.EQ.113) THEN NPOa = IPLIB(I,1) NPOb = IPLIB(I,2) IDIM = IPALB(I,3) ID1 = 7 ID5 = ID1 + 4*IDIM DO 31 ID=1,IDIM * XPTB(NPOa,2,ID) = XPTB(NPOa,1,ID) * XPTB(NPOb,2,ID) = XPTB(NPOb,1,ID) XPALB(I,ID5+ID) = XPTB(NPOa,1,ID) & - XPTB(NPOb,1,ID) 31 CONTINUE * * ------ choc élémentaire POINT_PLAN_FROTTEMENT * ELSE IF (ITYP.EQ.3 .OR. ITYP.EQ.103 ) THEN NPOI = IPLIB(I,1) IDIM = IPALB(I,3) c ID1 = 7 c ID5 = ID1 + 4*IDIM ID1 = 9 ID5 = ID1 + 5*IDIM c position au debut de l'adherence ? DO 30 ID=1,IDIM * XPTB(NPOI,2,ID) = XPTB(NPOI,1,ID) XPALB(I,ID5+ID) = XPTB(NPOI,1,ID) 30 CONTINUE * end do * * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT * ELSE IF (ITYP.EQ.5 .OR. ITYP.EQ.6) THEN NPOI = IPLIB(I,1) IDIM = IPALB(I,3) IF (ITYP.EQ.5) THEN ID1 = 6 ELSE ID1 = 7 ENDIF ID5 = ID1 + 4*IDIM ID8 = ID1 + 7*IDIM XRAYT = XPALB(I,ID8+1) * calcul du déplacement du point de contact au pas courant XPTP2(1) = XPTB(NPOI,1,1) + & ( ( XPTB(NPOI,1,5) * XPALB(I,ID1+3) * XRAYT ) - & ( XPTB(NPOI,1,6) * XPALB(I,ID1+2) * XRAYT ) ) XPTP2(2) = XPTB(NPOI,1,2) + & ( ( XPTB(NPOI,1,6) * XPALB(I,ID1+1) * XRAYT ) - & ( XPTB(NPOI,1,4) * XPALB(I,ID1+3) * XRAYT ) ) XPTP2(3) = XPTB(NPOI,1,3) + & ( ( XPTB(NPOI,1,4) * XPALB(I,ID1+2) * XRAYT ) - & ( XPTB(NPOI,1,5) * XPALB(I,ID1+1) * XRAYT ) ) DO 50 ID = 1,IDIM * XPTB(NPOI,2,ID) = XPTB(NPOI,1,ID) XPALB(I,ID5+ID) = XPTP2(ID) 50 CONTINUE * end do * * ------ choc élémentaire POINT_PLAN_FLUIDE * ELSE IF (ITYP.EQ.7) THEN IDIM = IPALB(I,3) ID1 = 6 + IDIM XPALB(I,ID1+1) = 0.D0 XPALB(I,ID1+2) = 0.D0 XPALB(I,ID1+3) = 0.D0 * ------ choc élémentaire POINT_PLAN avec SEUIL_PLASTIQUE ? ** ianis ELSE IF (ITYP.EQ.100) THEN XPALB(I,(5 + IDIMB)) = 0.D0 * * ------ choc elementaire POINT_POINT_ ... _PLASTIQUE * ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.50) THEN IDIM = IPALB(I,3) XPALB(I,2+IDIM) = 0.D0 XPALB(I,3+IDIM) = XABSCI(I,2) XPALB(I,4+IDIM) = 0.D0 * ELSE IF (ITYP.EQ.17 .OR. ITYP.EQ.51) THEN IDIM = IPALB(I,3) XPALB(I,3+IDIM) = 0.D0 XPALB(I,4+IDIM) = XABSCI(I,2) XPALB(I,5+IDIM) = 0.D0 * * ------ choc élémentaire LIGNE_LIGNE_FROTTEMENT * ELSE IF (ITYP.EQ.35.OR.ITYP.EQ.36) THEN NNOEMA = IPALB(I,21) NNOEES = IPALB(I,22) * Initialisation de la recherche du noeud maitre voisin IGLOBA = 1 DO 340 INOE=1,NNOEES CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB, & NPLB,IGLOBA,0) 340 CONTINUE DO 342 INOE=1,NNOEMA CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB, & NPLB,IGLOBA,1) 342 CONTINUE * * ------ choc élémentaire LIGNE_CERCLE * ELSE IF (ITYP.EQ.37.OR.ITYP.EQ.38 & .OR. ITYP.EQ.39.OR.ITYP.EQ.40) THEN NNOEMA = IPALB(I,21) NNOEES = IPALB(I,22) * Initialisation de la recherche du noeud maitre voisin IGLOBA = 1 DO 440 INOE=1,NNOEES CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB, & NPLB,IGLOBA,0) 440 CONTINUE DO 442 INOE=1,NNOEMA CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB, & NPLB,IGLOBA,1) 442 CONTINUE * ------ choc ........... * * ELSE IF (ITYP.EQ. ) THEN * ....... * ....... * ENDIF 10 CONTINUE * end do * END