C D2VLB1 SOURCE CHAT 05/01/12 22:35:34 5004 C DEVLB1 SOURCE PETR 97/06/03 21:15:24 2709 SUBROUTINE D2VLB1(FTOTB,XPTB,IPALB,IPLIB,JPLIB,XPALB,XVALB,NLIAB, & NPLB,IDIMB,XDT,NPAS,IND,FEXPSM,NPC1,IERRD, & FTEST,FTOTB0,XABSCI,XORDON,NIP,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. * * * * Paramètres: * * * * es FTOTB Forces extérieures totalisées sur la base B. * * 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 JPLIB Tableau contenant les numéros "GIBI" de la liaison. * * e XPALB Tableau contenant les paramètres de la liaison. * * es XVALB Tableau contenant les variables internes de liaisons. * * e NLIAB Nombre de liaisons sur la base B. * * e NPLB Nombre total de points intervenant dans les liaisons. * * e IDIMB Nombre de directions. * * e XDT Tableau des pas de temps. * * e NPAS Numéro du pas de temps. * * e IND Indice du pas. * * e FEXPSM Tableau contenant les pseudo-modes. * * e NPC1 * * e XABSCI Tableau contenant les abscisses de la loi plastique * * pour la liaison point-point- ... -plastique * * e XORDON Tableau contenant les ordonnees de la loi plastique * * pour la liaison point-point- ... -plastique * * * * - FTEST Pour tester la force qui sert a enclencher * * les liaisons conditionnelles * * * * - FTOTB0 Pour conserver l'etat de FTOTB au cas ou l'increment * * est à annuler * * * * Auteur, date de création: * * * * Lionel VIVAN : le 22 Septembre 1989 : Création * * Bertrand BEAUFILS : le 31 Mai 1990 : Ajout frottement sec* * E de LANGRE : le 25 Aout1994 : liaison conditionnelle * * Ibrahim Pinto, 05/97 , liaisons ligne_cercle * *--------------------------------------------------------------------* * INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*),JPLIB(*) REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*) REAL*8 XVALB(NLIAB,4,*),XDT(*),FEXPSM(NPLB,NPC1,2,*) REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*) REAL*8 FTest(nplb,6) REAL*8 ftOTB0(NPLB,6),XCHPFB(2,NLIAB,4,*) ** npa, npam1, ind1, indm1 ne sevent que pour les modes negligés; ** mais comme de toute façon c'est mal fait car on ne tient pas compte des ** forces nl lors de la contribution des pseudomodes on s'en fiche NPA = NPAS NPAM1 = NPAS IND1 = 1 INDM1 = 2 * ind = 1 et ind2 = 2 sauf pour l'initialisation où ind = 2 et ind2 = 3 IND2 = IND + 1 PDT = XDT(NPAS) c PDTS2 = 0.5D0 * PDT PDTS2 = pdt * * Boucle sur le nombre de liaisons * DO 10 I = 1,NLIAB ITYP = IPALB(I,1) icond= IPALB(I,4) iannul= 0 * --- cas des liaisons conditionnelles if (icond .eq. 1 ) then c 20 car on a defini nipalb = 20 dans dyne22 DO 101 j = 5,20 jliai = ipalb(i,j) jpliai = abs ( jliai) if ( jliai . EQ. 0 ) then goto 101 else jtyp = ipalb(jpliai,1) do 102 ik = 1,nplb do 103 jk = 1,idimb ftest(ik,jk) = 0d0 ftotb0 (ik,jk) = ftotb(ik,jk) 103 continue 102 continue IF (jTYP.EQ.1 .OR. jTYP.EQ.3 .OR. jTYP.EQ.103 & .OR. jTYP.EQ.5 .OR. jTYP.EQ.6 .OR. jTYP.EQ.7 & .OR. jTYP.EQ.100 .OR. jTYP.EQ.101 .OR. jTYP.EQ.102) THEN CALL DEVFB1(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab, & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, & FEXPSM,NPC1,XABSCI,XORDON,NIP,jpliai,iannul) ELSE IF (jTYP.EQ.11 .or. jTYP.EQ.111 & .or. (abs(jTYP)).EQ.13 .OR. jTYP.EQ.113) THEN CALL DEVFB2(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab, & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, & FEXPSM,NPC1,XABSCI,XORDON,NIP,jpliai,iannul) ELSE IF (jTYP.EQ.21 .OR. jTYP.EQ.22 .OR. jTYP.EQ.23 .OR. & jTYP.EQ.24 .OR. jTYP.EQ.25 .OR. jTYP.EQ.26.OR.jTYP.EQ.33 + .OR. jTYP.EQ.34 ) THEN CALL DEVFB3(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab, & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, & FEXPSM,NPC1,jpliai,iannul) ELSE IF (jTYP.EQ.31 .OR. jTYP.EQ.32) THEN CALL DEVFB4(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab, & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, & FEXPSM,NPC1,jpliai,IERRD,iannul) ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17 .OR. & ITYP.EQ.50 .OR. ITYP.EQ.51) THEN CALL DEVFB5(jTYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, & FEXPSM,NPC1,I,XABSCI,XORDON,NIP,iannul) ELSE IF (jTYP.EQ.35 .OR. jTYP.EQ.36) THEN CALL DEVFB6(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab, & NPLB,IND,IND2,PDTS2,jpliai,iannul,XCHPFB) ELSE IF &(jTYP.EQ.37 .OR. jTYP.EQ.38 .OR. jTYP.EQ.39 .OR. JTYP.EQ.40) THEN CALL DEVFB7(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab, & NPLB,IND,IND2,PDTS2,jpliai,iannul,XCHPFB) IF (IERRD.NE.0) RETURN ENDIF xff = 0.d0 do 104 ik = 1,nplb do 105 jk = 1,idimb xff = xff + ( ftest(ik,jk) ** 2) 105 continue 104 continue xff = xff ** .5 if ( ((xff .le. 1e-20 ) .and. ( jliai .gt. 0) ) & .OR. ((xff .gt. 1e-20 ) .and. ( jliai .lt. 0) ) ) & then iannul = 1 endif endif 101 continue * --- fin du cas des liaisons conditionnelles endif * * ------ choc ..._PLAN * ** ianis IF (ITYP.EQ.1 .OR. ITYP.EQ.3 .OR. ITYP.EQ.103 & .OR. ITYP.EQ.5 .OR. ITYP.EQ.6 .OR. ITYP.EQ.7 & .OR. ITYP.EQ.100 .OR. ITYP.EQ.101 .OR. ITYP.EQ.102) THEN * CALL DEVFB1(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, & FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul) * * ------ choc ..._POINT * ELSE IF (ITYP.EQ.11 .or. ITYP.EQ.111 & .or. (abs(ITYP)).EQ.13 .OR. ITYP.EQ.113) THEN CALL DEVFB2(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, & FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul) * * ------ choc POINT_POINT_ ... _PLASTIQUE * ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17 .OR. & ITYP.EQ.50 .OR. ITYP.EQ.51) THEN * CALL DEVFB5(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,NPLB, & IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,FEXPSM,NPC1, & I,XABSCI,XORDON,NIP,iannul) * * ------ choc ..._CERCLE(sauf ligne_cercle) * ELSE IF (ITYP.EQ.21 .OR. ITYP.EQ.22 .OR. ITYP.EQ.23 .OR. & ITYP.EQ.24 .OR. ITYP.EQ.25 .OR. ITYP.EQ.26.OR.ITYP.EQ.33 + .OR. ITYP.EQ.34 ) THEN CALL DEVFB3(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, & FEXPSM,NPC1,I,iannul) * * ------ choc PROFIL_PROFIL_... * ELSE IF (ITYP.EQ.31 .OR. ITYP.EQ.32) THEN CALL DEVFB4(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, & FEXPSM,NPC1,I,IERRD,iannul) IF (IERRD.NE.0) RETURN * * ------ choc LIGNE_LIGNE * ELSE IF (ITYP.EQ.35 .OR. ITYP.EQ.36) THEN CALL DEVFB6(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB) * *---------choc LIGNE_CERCLE * ELSE IF (ITYP.EQ.37 .OR. ITYP.EQ.38 & .OR. ITYP.EQ.39 .OR. ITYP.EQ.40) THEN CALL DEVFB7(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB) * * ------ choc ........... * * ELSE IF (ITYP.EQ. ) THEN * CALL DEVFB (ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, * & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, * & FEXPSM,NPC1,I,iannul) ENDIF * la suite ne sert à rien après le passage de iannul dans les * s_p de calcul des forces de laison. * si la liaisn était annulée on l'annule * if ( ( icond.eq. 1 ) .and. ( iannul.eq.1)) then * on annulle l'increment de ftotb * do 112 ik = 1,nplb * do 113 jk = 1,idimb * ftotb (ik,jk) = ftotb0(ik,jk) * 113 continue * 112 continue * end if 10 CONTINUE END