C D3VPAS SOURCE BP208322 20/09/18 21:15:21 10718 SUBROUTINE D3VPAS(Q1,Q2,Q3,NA1,NPC1,XK,XASM,XM,PDT,T,NPAS, & FTOTA,FEXA,NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA, & NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB,XVALB,FTOTB, & FTOTBA,XPTB,FEXPSM, & FINERT,IERRD,FTEST,FTEST2,WEXT,WINT, & XABSCI,XORDON,NIP,FTEXB,FEXB,RIGIDE,KTPHI,XCHPFB, & XOPM1,NB1,NB1K,NB1C,NB1M,B1,B2,B3,B4) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Opérateur DYNE : algorithme de Newmark * * (Acceleration moyenne par defaut) * * ________________________________________________ * * * * Calcul d'un pas de temps, appel aux s-p spécifiques. * * * * Paramètres: * * * * es Q1(,) Vecteur des déplacements généralisés * * es Q2(,) Vecteur des vitesses généralisées * * es Q3(,) Vecteur des accélérations généralisées * * es NA1 Nombre total d'inconnues en base A * * es NPC1 Nombre de pas de calcul - 1 * * es XK Vecteur des raideurs généralisées * * es XASM Vecteur des amortissements généralisés * * es XM Vecteur des masses généralisées * * e PDT pas de temps courant * * e T temps courant * * e NPAS Numéro du pas de temps * * es FTOTA Forces extérieures totalisées, sur la base A * * es FEXA Evolution des forces extérieures en base A * * e FTEXB Evolution des forces extérieures en base B * * e FEXB Forces extérieures sur la base B, servant au calcul * * des moments pour les corps rigides. * * e RIGIDE Vrai si corps rigide, faux sinon * * es IFEXA Numéro du mode correspondant au point de chargement * * (supprime le 2018-12-14 par bp) * es NPFEXA Nombre de points de chargement * * e NLIAA Nombre de liaisons sur la base A * * e NLSA Nombre de liaisons A en sortie * * e IPALA Tableau renseignant sur le type de liaison (base A) * * e IPLIA Tableau contenant les numéros "DYNE" des points * * e XPALA Tableau contenant les paramètres des liaisons * * es XVALA Tableau contenant les variables internes de liaison A * * XPHILB Vecteur des deformees modales * * e NLIAB Nombre de liaisons sur la base B * * e NLSB Nombre de liaisons base B en sortie * * e NPLB Nombre total de points de liaisons (base B) * * e IDIMB Nombre de directions * * e IPALB Tableau renseignant sur le type de liaison * * e IPLIB Tableau contenant les numeros "DYNE" des points * * e JPLIB Tableau contenant les numeros "GIBI" des points * * e XPALB Tableau contenant les parametres des liaisons (base B) * * es XVALB Tableau contenant les variables internes de liaison B * * FTOTB Forces exterieures totalisees sur la base B * * e XABSCI Tableau contenant les abscisses de la loi plastique * * e XORDON Tableau contenant les ordonnees de la loi plastique * * e NIP Nbr de points dans l'evolution de la loi plastique * * FTOTBA Forces totales base B projetees base A * * XPTB Deplacements des points de liaison * * IBASB Appartenance des points de liaison a une sous-base * * IPLSB Position du point de liaison dans la sous-base * * INMSB Nombre de modes dans la sous-base * * IORSB Position du 1er mode de la sous-base dans ens. modes * * IAROTA Indique la position des modes de rotation * * NSB Nombre de sous-bases * * NPLSB Nombre de points de liaison par sous-base * * NA2 Nombre d'inconnues dans la sous-base * * FEXPSM Pseudo-Modes base B * * FINERT Forces d'inertie base B * * IERRD Indicateur d'erreur * * - FTEST Tableau local FTEST de la subroutine D2VLFA * * - FTEST2 Tableau local FTEST de la subroutine DEVLB1 * * e,s WEXT travail des forces exterieures * e,s WINT travail des forces interieures (rigidite et * amortissement et forces de liaison ) * * * inspire de D2VPAS * * * *--------------------------------------------------------------------* * SEGMENT,MTPHI INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) INTEGER IAROTA(NSB) REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) ENDSEGMENT * * INTEGER IFEXA(*),IPALA(NLIAA,*),IPLIA(NLIAA,*) INTEGER IPALA(NLIAA,*),IPLIA(NLIAA,*) INTEGER IPALB(NLIAB,*),IPLIB(NLIAA,*),JPLIB(*) REAL*8 Q1(NA1,*),Q2(NA1,*),Q3(NA1,*) REAL*8 XVALA(NLIAA,4,*),XPALA(NLIAA,*),XM(NA1,*),XK(NA1,*) REAL*8 XPALB(NLIAB,*),XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*) REAL*8 XASM(NA1,*),FTOTA(NA1,*),FEXA(NPFEXA,NPC1,*) REAL*8 FTOTB(NPLB,*),FTOTBA(*),XPTB(NPLB,2,*),FINERT(NA1,*) REAL*8 WEXT(NA1,2),WINT(NA1,2) REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*),FEXB(NPLB,2,*) REAL*8 FTEST(NA1,4), FTEST2(NPLB,6) REAL*8 FTEXB(NPLB,NPC1,2,*),XCHPFB(2,NLIAB,4,NPLB) REAL*8 XOPM1(NB1,NB1,*),Q2DEMI(NA1),FAMOR(NA1) * TODO : KTOTXA et KTOTVA a allouer dans le segment LOCLFA ? REAL*8 KTOTXA(NA1,NA1), KTOTVA(NA1,NA1) * TODO : KTOTXB et KTOTVB a allouer dans le segment LOCLFB ? REAL*8 KTOTXB(NPLB,IDIMB,IDIMB),KTOTVB(NPLB,IDIMB,IDIMB) * LOGICAL RIGIDE LOGICAL LWRITE * MTPHI = KTPHI NSB = XPHILB(/1) NPLSB = XPHILB(/2) NA2 = XPHILB(/3) IVINIT = 0 III = 1 * ************************************************************************ * Predicteurs des déplacements et vitesses ************************************************************************ DO 1 I = 1,NA1 Q1(I,1) = Q1(I,2) + Q2(I,2)*pdt + Q3(i,2)*B1 Q2(I,1) = Q2(I,2) + Q3(I,2)*B2 1 CONTINUE ************************************************************************ * Calcul des forces ************************************************************************ * * Totalisation des forces extérieures pour la base A * pour la fin du pas precedent CALL D2VFXA(FEXA,FTOTA,NPFEXA,NA1,NPC1,NPAS,FTEXB,FEXB, & NPLB,IDIMB,RIGIDE) * Ajout des forces de raideur * F_1 = FEXT_1 - K Q_1 CALL DEVLK0(Q1,XK,FTOTA,NA1,NB1K,III) * Ajout des forces d'amortissement * F_1 = FEXT_1 - K Q_1 - C Q_2 CALL DEVLK0(Q2,XASM,FTOTA,NA1,NB1C,III) * Ajout des forces de liaison IF (NLIAA.NE.0) THEN CALL D2VLFA(Q1,Q2,FTOTA,NA1,IPALA,IPLIA,XPALA,XVALA, & NLIAA,PDT,T,NPAS,III,FINERT,IVINIT,FTEST, & KTOTXA,KTOTVA,.FALSE.) ENDIF IF (NLIAB.NE.0) THEN CALL D2VLFB(Q1,Q2,FTOTA,NA1,IPALB,IPLIB,XPALB,XVALB,NLIAB, & XPHILB,JPLIB,NPLB,IDIMB,FTOTB,FTOTBA,XPTB,PDT,T, & NPAS,IBASB,IPLSB,INMSB,IORSB,NSB,NPLSB,NA2,III, & FEXPSM,NPC1,IERRD,FTEST2,XABSCI,XORDON,NIP, & FEXB,RIGIDE,IAROTA,XCHPFB, & KTOTXA,KTOTVA,KTOTXB,KTOTVB,.FALSE.) IF (IERRD.NE.0) RETURN ENDIF * Accelerations c -Cas C ou M pleine ou K (on utilise l'operateur inverse par d2vtra) IF (NB1.NE.1) THEN DO 5 I=1,NA1 Q3(I,1) = 0.D0 DO 6 J=1,NB1 Q3(I,1) = Q3(I,1) + XOPM1(I,J,1)*FTOTA(J,III) 6 CONTINUE 5 CONTINUE c -Cas C et M diagonales ELSE DO 51 I=1,NA1 Q3(I,1) = FTOTA(I,III) / & ( XM(I,1) + B3*XASM(I,1) + B4*XK(I,1) - FINERT(I,III) ) 51 CONTINUE ENDIF * Deplacements et vitesses DO 7 I = 1,NA1 Q1(I,1) = Q1(I,1) + B4*Q3(I,1) Q2(I,1) = Q2(I,1) + B3*Q3(I,1) 7 CONTINUE * calcul des travaux CALL D2VENE (NA1,III,NPAS,FEXA,Q1,Q2,FTOTA,WEXT,WINT, & XASM,NPC1,NB1C) END