C DEVPAS SOURCE PV 11/03/08 21:15:22 6888 * SUBROUTINE DEVPAS(Q1,Q2,Q3,NA1,NPC1,XK,XASM,XM,XDT,NPAS,FTOTA, SUBROUTINE DEVPAS(NA1,NPC1,XK,XASM,XM,XDT,NPAS,FTOTA, & FEXA,IFEXA,NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA, & NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB,XVALB,FTOTB, & FTOTBA,XPTB,FEXPSM, c & FINERT,IERRD,FTEST,FTOTA0,FTEST2,FTOTB0,WEXT,WINT, & FINERT,IERRD,FTEST,FTOTA0,FTEST2,FTOTB0,KTQ, & XABSCI,XORDON,NIP,FTEXB,FEXB,RIGIDE,KTPHI,XCHPFB) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Opérateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * 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 * * 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 * * es XDT Valeurs des pas de temps * * es 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 * * 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 Forces exterieures base B * * FINERT Forces d'inertie base B * * IERRD Indicateur d'erreur * * - FTEST Tableau local FTEST de la subroutine DEVLFA * * - FTOTA0 Tableau local FTOTA0 de la subroutine DEVLFA * * - FTEST2 Tableau local FTEST de la subroutine DEVLB1 * * - FTOTB0 Tableau local FTOTB0 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 ) * * * Auteur, date de création: * * * * Denis ROBERT-MOUGIN, le 26 mai 1989. * * * *--------------------------------------------------------------------* * SEGMENT,MTPHI INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) INTEGER IAROTA(NSB) REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) ENDSEGMENT * SEGMENT,MTQ REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4) REAL*8 WEXT(NA1,2),WINT(NA1,2) ENDSEGMENT * INTEGER IFEXA(*),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(*),XK(*) REAL*8 XPALB(NLIAB,*),XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*) REAL*8 XASM(*),XDT(*),FTOTA(NA1,*),FEXA(NPFEXA,NPC1,*) REAL*8 FTOTB(NPLB,*),FTOTBA(*),XPTB(NPLB,4,*),FINERT(NA1,*) * REAL*8 WEXT(NA1,2),WINT(NA1,2) REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*),FEXB(NPLB,2,*) REAL*8 FTEXB(NPLB,NPC1,2,*),XCHPFB(2,NLIAB,4,NPLB) * LOGICAL RIGIDE * MTQ = KTQ MTPHI = KTPHI NSB = XPHILB(/1) NPLSB = XPHILB(/2) NA2 = XPHILB(/3) IVINIT = 0 III = 2 * * Totalisation des forces extérieures pour la base A * pour la fin du pas CALL DEVFXA(FEXA,IFEXA,FTOTA,NPFEXA,NA1,NPC1,NPAS,FTEXB,FEXB, & NPLB,IDIMB,RIGIDE) * * Déplacements généralisés pour le premier demi-pas de temps * CALL DEVEQ1(Q1,Q2,NA1,XK,XASM,XM,XDT,NPAS,FTOTA,FINERT) * * Ajout des forces de raideur @ l'issue du premier demi-pas * CALL DEVLK0(Q1,XK,XM,FTOTA,NA1,NPAS,III) * * Ajout des forces de liaison * IF (NLIAA.NE.0) THEN CALL DEVLFA(Q1,Q2,FTOTA,XM,NA1,IPALA,IPLIA,XPALA,XVALA, & NLIAA,XDT,NPAS,III,FINERT,IVINIT,FTEST,FTOTA0) ENDIF IF (NLIAB.NE.0) THEN CALL DEVLFB(Q1,FTOTA,XM,NA1,IPALB,IPLIB,XPALB,XVALB,NLIAB, & XPHILB,JPLIB,NPLB,IDIMB,FTOTB,FTOTBA,XPTB,XDT, & NPAS,IBASB,IPLSB,INMSB,IORSB,NSB,NPLSB,NA2,III, & FEXPSM,NPC1,IERRD,FTEST2,FTOTB0, & XABSCI,XORDON,NIP,FEXB,RIGIDE,IAROTA,XCHPFB) IF (IERRD.NE.0) RETURN ENDIF * * Vitesses généralisées pour le premier demi-pas de temps * CALL DEVEQ2(Q2,NA1,XK,XASM,XM,XDT,NPAS,FTOTA,FINERT) * accelerations généralisées pour le premier demi-pas de temps DO 10 I = 1,NA1 UNSM2 = 1.D0 / ( XM(I) - FINERT(I,III) ) Q3(I,2) = (FTOTA(I,III)*UNSM2) - (XASM(I)*UNSM2*Q2(I,III)) 10 CONTINUE * end do c calcul des travaux pour le premier demi-pas de temps CALL DEVENE (NA1,III,NPAS,FEXA,Q1,Q2,FTOTA,WEXT,WINT, & XASM,NPC1) III = 1 * * Déplacements généralisés pour le second demi-pas de temps * CALL DEVEQ3(Q1,Q2,NA1,XK,XASM,XM,XDT,NPAS,FTOTA,FINERT) * * Ajout des forces extérieures @ l'issue du deuxième demi-pas * CALL DEVLK0(Q1,XK,XM,FTOTA,NA1,NPAS,III) * * Ajout des forces de liaison * IF (NLIAA.NE.0) THEN CALL DEVLFA(Q1,Q2,FTOTA,XM,NA1,IPALA,IPLIA,XPALA,XVALA, & NLIAA,XDT,NPAS,III,FINERT,IVINIT,FTEST,FTOTA0) ENDIF IF (NLIAB.NE.0) THEN CALL DEVLFB(Q1,FTOTA,XM,NA1,IPALB,IPLIB,XPALB,XVALB,NLIAB, & XPHILB,JPLIB,NPLB,IDIMB,FTOTB,FTOTBA,XPTB,XDT, & NPAS,IBASB,IPLSB,INMSB,IORSB,NSB,NPLSB,NA2,III, & FEXPSM,NPC1,IERRD,FTEST2,FTOTB0, & XABSCI,XORDON,NIP,FEXB,RIGIDE,IAROTA,XCHPFB) IF (IERRD.NE.0) RETURN ENDIF * * Vitesses généralisées pour le second demi-pas de temps * CALL DEVEQ4(Q2,NA1,XK,XASM,XM,XDT,NPAS,FTOTA,FINERT) * * accelerations généralis{es pour le second demi-pas de temps DO 20 I = 1,NA1 UNSM1 = 1.D0 / ( XM(I) - FINERT(I,III) ) Q3(I,1) = (FTOTA(I,III)*UNSM1) - (XASM(I)*UNSM1*Q2(I,III)) 20 CONTINUE * end do c calcul des travaux pour le premier demi-pas de temps CALL DEVENE (NA1,III,NPAS,FEXA,Q1,Q2,FTOTA,WEXT,WINT, & XASM,NPC1) * END