C D2VPAS SOURCE BP208322 20/09/18 21:15:19 10718 c SUBROUTINE D2VPAS(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) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Opérateur DYNE : algorithme des DIFFERENCES CENTREES * * ________________________________________________ * * * * 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 ) * * * *--------------------------------------------------------------------* * 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) cbp,2020-09 REAL*8 XOPM1(NB1,NB1,*),Q2DEMI(NA1),FAMOR(NA1) REAL*8 XOPM1(NB1,NB1,*),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) * c LOGICAL LWRITE LOGICAL RIGIDE * MTPHI = KTPHI NSB = XPHILB(/1) NPLSB = XPHILB(/2) NA2 = XPHILB(/3) C Parametres d'affichage (pour debuggage) c LWRITE=.false. c LWRITE=(NPAS.LE.20).OR.(MOD(NPAS,1000).EQ.0) c if(LWRITE) write(*,*) '-------- NPAS =',NPAS ************************************************************************ * Parametres temporels locaux ************************************************************************ tdeb = T tfin = T + PDT dt = PDT dt2=dt/2.D0 dt22=dt*dt2 ************************************************************************ * Déplacements généralisés ************************************************************************ DO 1 I = 1,NA1 Q1(I,1) = Q1(I,2) + Q2(I,2)*DT + Q3(I,2)*DT22 1 CONTINUE ************************************************************************ * Calcul des forces ************************************************************************ * Totalisation des forces extérieures pour la base A a la fin du pas CALL D2VFXA(FEXA,FTOTA,NPFEXA,NA1,NPC1,NPAS,FTEXB,FEXB, & NPLB,IDIMB,RIGIDE) * estimation de la vitesse (ici plutot que dans DEVLF*, bp,2020-09): * \dot{q}_n ~ \dot{q}_{n+1/2} = ({q}_n - {q}_{n-1}) / dt * on utilise Q2(I,1) temporairement (il sera "bien" rempli à la fin du pas) DO I=1,NA1 Q2(I,1)=(Q1(I,1)-Q1(I,2))/dt ENDDO * Ajout des forces de liaison IF (NLIAA.NE.0) THEN CALL D2VLFA(Q1,Q2,FTOTA,NA1,IPALA,IPLIA,XPALA,XVALA, & NLIAA,dt,tfin,NPAS,1,FINERT,0,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,dt,tfin, & NPAS,IBASB,IPLSB,INMSB,IORSB,NSB,NPLSB,NA2,1, & FEXPSM,NPC1,IERRD,FTEST2,XABSCI,XORDON,NIP, & FEXB,RIGIDE,IAROTA,XCHPFB, & KTOTXA,KTOTVA,KTOTXB,KTOTVB,.FALSE.) IF (IERRD.NE.0) RETURN ENDIF * Ajout des forces de raideur * F = F - K Q_1 CALL DEVLK0(Q1,XK,FTOTA,NA1,NB1K,1) * forces d'amortissement IF (NB1C.GT.1) THEN cbp,2020-09 DO 3 I=1,NA1 cbp,2020-09 Q2DEMI(i)=(q1(i,1) - q1(i,2))/dt cbp,2020-09 3 CONTINUE DO 4 I=1,NA1 FAMOR(I) = 0.D0 DO 42 J=1,NB1 cbp,2020-09 FAMOR(I) = FAMOR(I) + XASM(I,J) * Q2DEMI(J) FAMOR(I) = FAMOR(I) + XASM(I,J) * Q2(J,1) 42 CONTINUE 4 CONTINUE ELSE DO 41 I=1,NA1 cbp,2020-09 FAMOR(I) = XASM(I,1) * (q1(I,1) - q1(I,2))/dt FAMOR(I) = XASM(I,1) * Q2(I,1) 41 CONTINUE ENDIF ************************************************************************ * Accelerations et Vitesses généralisées ************************************************************************ c -Cas C ou M pleine 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,1)-FAMOR(J)) 6 CONTINUE * Vitesses généralisées Q2(I,1) = Q2(I,2) + (Q3(I,2) + Q3(I,1))*DT2 5 CONTINUE c -Cas C et M diagonales ELSE DO 51 I=1,NA1 c UNSM = 1.D0 / ( XM(I,1) - FINERT(I,1) ) cbp : pour les "vraies" differences centrees, il faut inclure l'amortissement UNSM = 1.D0 / ( XM(I,1) + dt2*XASM(I,1) - FINERT(I,1) ) Q3(I,1) = (FTOTA(I,1)-FAMOR(I)) * UNSM c Q3(I,1) = (FTOTA(I,1)-FAMOR(I)) / (XM(I,1) - FINERT(I,1)) * Vitesses généralisées Q2(I,1) = Q2(I,2) + (Q3(I,2) + Q3(I,1))*DT2 51 CONTINUE ENDIF ************************************************************************ * calcul des travaux + decalage pour pas suivant ************************************************************************ CALL D2VENE (NA1,1,NPAS,FEXA,Q1,Q2,FTOTA,WEXT,WINT, & XASM,NPC1,NB1C) END