C DEVFB6 SOURCE BP208322 20/09/18 21:15:31 10718 SUBROUTINE DEVFB6(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, & NPLB,IND,IND2,PDTS2,I,iannul,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_LIGNE * * * * Paramètres: * * * * e ITYP type de la liaison. * * 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 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. * * * * * * Auteur, date de création: * * * * Samuel DURAND : le 18 Octobre 1996 : Création * * * *--------------------------------------------------------------------* * INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*) REAL*8 XPALB(NLIAB,*),XPTB(NPLB,2,*),FTOTB(NPLB,*) REAL*8 XVALB(NLIAB,4,*),XCHPFB(2,NLIAB,4,*) * * Initialisations * * XVALB(I,IND,1) =0.D0 XVALB(I,IND,3) =0.D0 XVALB(I,IND,4) =0.D0 XVALB(I,IND,5) =0.D0 XVALB(I,IND,6) =0.D0 XVALB(I,IND,10) = 0.D0 XVALB(I,IND,11) = 0.D0 XVALB(I,IND,12) = 0.D0 IDIM = IPALB(I,3) IF (ITYP.EQ.35) THEN ID1 = 6 ELSE ID1 = 7 ENDIF NNOEES = IPALB(I,22) NNOEMA=IPALB(I,21) IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM ICH = 26 + NNOEMA+NNOEES ICG = 26 + 2*(NNOEMA+NNOEES) DO 5 J=1,(NNOEMA+NNOEES) IPALB(I,ICH+J) = 0 IPALB(I,ICG+J) = 0 DO 7 ID=1,IDIM XPALB(I,IFO+ID) = 0.D0 7 CONTINUE IFO = IFO + IDIM 5 CONTINUE IF (IDIM.EQ.3) THEN IDIMB=6 ELSE IDIMB=3 ENDIF DO 8 IP=1,NPLB XCHPFB(1,I,IND,IP)=0.D0 XCHPFB(2,I,IND,IP)=0.D0 8 CONTINUE ******************************************************************* * On s'intéresse au choc des noeuds esclaves sur le maillage maitre ******************************************************************* ILOCAL=IPALB(I,23) * Recherche des plus proches voisins CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,0) * Boucle sur tous les noeuds esclaves DO 10 IESC=1,NNOEES CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND &,IND2,PDTS2,I,IANNUL,IESC,0,XCHPFB) 10 CONTINUE *************************** * Traitement symétrique *************************** ISYM=IPALB(I,26) IF (ISYM.EQ.0.OR.ISYM.EQ.1) THEN * On renverse les roles du maitre et de l esclave CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,1) IF (ISYM.EQ.0) THEN * symétrie globale * boucle sur tous les noeuds maitres DO 20 IMAI=1,NNOEMA CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND &,IND2,PDTS2,I,IANNUL,IMAI,1,XCHPFB) 20 CONTINUE ELSE * symétrie locale * * IREF=1 INOE=1 ICH = 26 + NNOEES+NNOEMA ICG = 26 + 2*(NNOEES+NNOEMA) 30 CONTINUE IF (IPALB(I,ICH+INOE).EQ.1) THEN * Ce noeud a précédemment été sollicité CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB, &IND,IND2,PDTS2,I,IANNUL,INOE,1,XCHPFB) IMOINS=INOE-1 35 CONTINUE IF (IMOINS.NE.0.AND.IMOINS.NE.IREF) THEN * On regarde avant CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB, &NLIAB,NPLB,IND,IND2,PDTS2,I,IANNUL,IMOINS,1,XCHPFB) IAPRES=IPALB(I,ICG+IMOINS)+IPALB(I,ICH+IMOINS) IF (IAPRES.GT.IPALB(I,ICH+IMOINS)) THEN IMOINS=IMOINS-1 GOTO 35 ENDIF ENDIF INOE=INOE+1 36 CONTINUE * On regarde apres CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB, &NLIAB,NPLB,IND,IND2,PDTS2,I,IANNUL,INOE,1,XCHPFB) IAPRES=IPALB(I,ICH+INOE)+IPALB(I,ICG+INOE) IF (IAPRES.GT.IPALB(I,ICH+INOE)) THEN IF (INOE.NE.NNOEMA) THEN INOE=INOE+1 GOTO 36 ENDIF ELSE IREF=INOE IF (INOE.NE.NNOEMA) THEN INOE=INOE+1 GOTO 30 ENDIF ENDIF ELSE IF (INOE.NE.NNOEMA) THEN INOE=INOE+1 GOTO 30 ENDIF ENDIF ENDIF * On pondère les forces ICH = 26 + NNOEES+NNOEMA ICG = 26 + 2*(NNOEES+NNOEMA) IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM DO 21 INOE=1,(NNOEES+NNOEMA) IPALB(I,ICH+INOE)=IPALB(I,ICH+INOE)+IPALB(I,ICG+INOE) IF (IPALB(I,ICH+INOE).EQ.2) THEN DO 22 ID=1,IDIM FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+ &XPALB(I,IFO+ID)/2. 22 CONTINUE XCHPFB(1,I,IND,IPLIB(I,INOE))= &XCHPFB(1,I,IND,IPLIB(I,INOE))/2. XCHPFB(2,I,IND,IPLIB(I,INOE))= &XCHPFB(2,I,IND,IPLIB(I,INOE))/2. ELSE DO 23 ID=1,IDIM FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+ &XPALB(I,IFO+ID) 23 CONTINUE ENDIF IFO = IFO+IDIM 21 CONTINUE ELSE ****************** * pas de symétrie ****************** IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM DO 40 INOE=1,(NNOEMA+NNOEES) DO 42 ID=1,IDIM FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+ &XPALB(I,IFO+ID) 42 CONTINUE IFO = IFO+IDIM 40 CONTINUE * * ENDIF * * END