1 : C DEVPAS SOURCE PV 11/03/08 21:15:22 6888 2 : * SUBROUTINE DEVPAS(Q1,Q2,Q3,NA1,NPC1,XK,XASM,XM,XDT,NPAS,FTOTA, 3 : SUBROUTINE DEVPAS(NA1,NPC1,XK,XASM,XM,XDT,NPAS,FTOTA, 4 : & FEXA,IFEXA,NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA, 5 : & NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB,XVALB,FTOTB, 6 : & FTOTBA,XPTB,FEXPSM, 7 : c & FINERT,IERRD,FTEST,FTOTA0,FTEST2,FTOTB0,WEXT,WINT, 8 : & FINERT,IERRD,FTEST,FTOTA0,FTEST2,FTOTB0,KTQ, 9 : & XABSCI,XORDON,NIP,FTEXB,FEXB,RIGIDE,KTPHI,XCHPFB) 10 : IMPLICIT INTEGER(I-N) 11 : IMPLICIT REAL*8(A-H,O-Z) 12 : *--------------------------------------------------------------------* 13 : * * 14 : * Opérateur DYNE : algorithme de Fu - de Vogelaere * 15 : * ________________________________________________ * 16 : * * 17 : * Calcul d'un pas de temps, appel aux s-p spécifiques. * 18 : * * 19 : * Paramètres: * 20 : * * 21 : * es Q1(,) Vecteur des déplacements généralisés * 22 : * es Q2(,) Vecteur des vitesses généralisées * 23 : * es Q3(,) Vecteur des accélérations généralisées * 24 : * es NA1 Nombre total d'inconnues en base A * 25 : * es NPC1 Nombre de pas de calcul * 26 : * es XK Vecteur des raideurs généralisées * 27 : * es XASM Vecteur des amortissements généralisés * 28 : * es XM Vecteur des masses généralisées * 29 : * es XDT Valeurs des pas de temps * 30 : * es NPAS Numéro du pas de temps * 31 : * es FTOTA Forces extérieures totalisées, sur la base A * 32 : * es FEXA Evolution des forces extérieures en base A * 33 : * e FTEXB Evolution des forces extérieures en base B * 34 : * e FEXB Forces extérieures sur la base B, servant au calcul * 35 : * des moments pour les corps rigides. * 36 : * e RIGIDE Vrai si corps rigide, faux sinon * 37 : * es IFEXA Numéro du mode correspondant au point de chargement * 38 : * es NPFEXA Nombre de points de chargement * 39 : * e NLIAA Nombre de liaisons sur la base A * 40 : * e NLSA Nombre de liaisons A en sortie * 41 : * e IPALA Tableau renseignant sur le type de liaison (base A) * 42 : * e IPLIA Tableau contenant les numéros "DYNE" des points * 43 : * e XPALA Tableau contenant les paramètres des liaisons * 44 : * es XVALA Tableau contenant les variables internes de liaison A * 45 : * XPHILB Vecteur des deformees modales * 46 : * e NLIAB Nombre de liaisons sur la base B * 47 : * e NLSB Nombre de liaisons base B en sortie * 48 : * e NPLB Nombre total de points de liaisons (base B) * 49 : * e IDIMB Nombre de directions * 50 : * e IPALB Tableau renseignant sur le type de liaison * 51 : * e IPLIB Tableau contenant les numeros "DYNE" des points * 52 : * e JPLIB Tableau contenant les numeros "GIBI" des points * 53 : * e XPALB Tableau contenant les parametres des liaisons (base B) * 54 : * es XVALB Tableau contenant les variables internes de liaison B * 55 : * FTOTB Forces exterieures totalisees sur la base B * 56 : * e XABSCI Tableau contenant les abscisses de la loi plastique * 57 : * e XORDON Tableau contenant les ordonnees de la loi plastique * 58 : * e NIP Nbr de points dans l'evolution de la loi plastique * 59 : * FTOTBA Forces totales base B projetees base A * 60 : * XPTB Deplacements des points de liaison * 61 : * IBASB Appartenance des points de liaison a une sous-base * 62 : * IPLSB Position du point de liaison dans la sous-base * 63 : * INMSB Nombre de modes dans la sous-base * 64 : * IORSB Position du 1er mode de la sous-base dans ens. modes * 65 : * IAROTA Indique la position des modes de rotation * 66 : * NSB Nombre de sous-bases * 67 : * NPLSB Nombre de points de liaison par sous-base * 68 : * NA2 Nombre d'inconnues dans la sous-base * 69 : * FEXPSM Forces exterieures base B * 70 : * FINERT Forces d'inertie base B * 71 : * IERRD Indicateur d'erreur * 72 : * - FTEST Tableau local FTEST de la subroutine DEVLFA * 73 : * - FTOTA0 Tableau local FTOTA0 de la subroutine DEVLFA * 74 : * - FTEST2 Tableau local FTEST de la subroutine DEVLB1 * 75 : * - FTOTB0 Tableau local FTOTB0 de la subroutine DEVLB1 * 76 : * e,s WEXT travail des forces exterieures 77 : * e,s WINT travail des forces interieures (rigidite et 78 : * amortissement et forces de liaison ) 79 : * * 80 : * Auteur, date de création: * 81 : * * 82 : * Denis ROBERT-MOUGIN, le 26 mai 1989. * 83 : * * 84 : *--------------------------------------------------------------------* 85 : * 86 : SEGMENT,MTPHI 87 : INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) 88 : INTEGER IAROTA(NSB) 89 : REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) 90 : ENDSEGMENT 91 : * 92 : SEGMENT,MTQ 93 : REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4) 94 : REAL*8 WEXT(NA1,2),WINT(NA1,2) 95 : ENDSEGMENT 96 : * 97 : INTEGER IFEXA(*),IPALA(NLIAA,*),IPLIA(NLIAA,*) 98 : INTEGER IPALB(NLIAB,*),IPLIB(NLIAA,*),JPLIB(*) 99 : * REAL*8 Q1(NA1,*),Q2(NA1,*),Q3(NA1,*) 100 : REAL*8 XVALA(NLIAA,4,*),XPALA(NLIAA,*),XM(*),XK(*) 101 : REAL*8 XPALB(NLIAB,*),XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*) 102 : REAL*8 XASM(*),XDT(*),FTOTA(NA1,*),FEXA(NPFEXA,NPC1,*) 103 : REAL*8 FTOTB(NPLB,*),FTOTBA(*),XPTB(NPLB,4,*),FINERT(NA1,*) 104 : * REAL*8 WEXT(NA1,2),WINT(NA1,2) 105 : REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*),FEXB(NPLB,2,*) 106 : REAL*8 FTEXB(NPLB,NPC1,2,*),XCHPFB(2,NLIAB,4,NPLB) 107 : * 108 : LOGICAL RIGIDE 109 : * 110 : MTQ = KTQ 111 : MTPHI = KTPHI 112 : NSB = XPHILB(/1) 113 : NPLSB = XPHILB(/2) 114 : NA2 = XPHILB(/3) 115 : IVINIT = 0 116 : III = 2 117 : * 118 : * Totalisation des forces extérieures pour la base A 119 : * pour la fin du pas 119 : CALL DEVFXA(FEXA,IFEXA,FTOTA,NPFEXA,NA1,NPC1,NPAS,FTEXB,FEXB, 120 : & NPLB,IDIMB,RIGIDE) 121 : * 122 : * Déplacements généralisés pour le premier demi-pas de temps 123 : * 123 : CALL DEVEQ1(Q1,Q2,NA1,XK,XASM,XM,XDT,NPAS,FTOTA,FINERT) 124 : * 125 : * Ajout des forces de raideur @ l'issue du premier demi-pas 126 : * 126 : CALL DEVLK0(Q1,XK,XM,FTOTA,NA1,NPAS,III) 127 : * 128 : * Ajout des forces de liaison 129 : * 130 : IF (NLIAA.NE.0) THEN 130 : CALL DEVLFA(Q1,Q2,FTOTA,XM,NA1,IPALA,IPLIA,XPALA,XVALA, 131 : & NLIAA,XDT,NPAS,III,FINERT,IVINIT,FTEST,FTOTA0) 132 : ENDIF 133 : IF (NLIAB.NE.0) THEN 133 : CALL DEVLFB(Q1,FTOTA,XM,NA1,IPALB,IPLIB,XPALB,XVALB,NLIAB, 134 : & XPHILB,JPLIB,NPLB,IDIMB,FTOTB,FTOTBA,XPTB,XDT, 135 : & NPAS,IBASB,IPLSB,INMSB,IORSB,NSB,NPLSB,NA2,III, 136 : & FEXPSM,NPC1,IERRD,FTEST2,FTOTB0, 137 : & XABSCI,XORDON,NIP,FEXB,RIGIDE,IAROTA,XCHPFB) 138 : IF (IERRD.NE.0) RETURN 139 : ENDIF 140 : * 141 : * Vitesses généralisées pour le premier demi-pas de temps 142 : * 142 : CALL DEVEQ2(Q2,NA1,XK,XASM,XM,XDT,NPAS,FTOTA,FINERT) 143 : * accelerations généralisées pour le premier demi-pas de temps 144 : DO 10 I = 1,NA1 145 : UNSM2 = 1.D0 / ( XM(I) - FINERT(I,III) ) 146 : Q3(I,2) = (FTOTA(I,III)*UNSM2) - (XASM(I)*UNSM2*Q2(I,III)) 147 : 10 CONTINUE 148 : * end do 149 : 150 : c calcul des travaux pour le premier demi-pas de temps 151 : 151 : CALL DEVENE (NA1,III,NPAS,FEXA,Q1,Q2,FTOTA,WEXT,WINT, 152 : & XASM,NPC1) 153 : III = 1 154 : * 155 : * Déplacements généralisés pour le second demi-pas de temps 156 : * 156 : CALL DEVEQ3(Q1,Q2,NA1,XK,XASM,XM,XDT,NPAS,FTOTA,FINERT) 157 : * 158 : * Ajout des forces extérieures @ l'issue du deuxième demi-pas 159 : * 159 : CALL DEVLK0(Q1,XK,XM,FTOTA,NA1,NPAS,III) 160 : 161 : * 162 : * Ajout des forces de liaison 163 : * 164 : IF (NLIAA.NE.0) THEN 164 : CALL DEVLFA(Q1,Q2,FTOTA,XM,NA1,IPALA,IPLIA,XPALA,XVALA, 165 : & NLIAA,XDT,NPAS,III,FINERT,IVINIT,FTEST,FTOTA0) 166 : ENDIF 167 : IF (NLIAB.NE.0) THEN 167 : CALL DEVLFB(Q1,FTOTA,XM,NA1,IPALB,IPLIB,XPALB,XVALB,NLIAB, 168 : & XPHILB,JPLIB,NPLB,IDIMB,FTOTB,FTOTBA,XPTB,XDT, 169 : & NPAS,IBASB,IPLSB,INMSB,IORSB,NSB,NPLSB,NA2,III, 170 : & FEXPSM,NPC1,IERRD,FTEST2,FTOTB0, 171 : & XABSCI,XORDON,NIP,FEXB,RIGIDE,IAROTA,XCHPFB) 172 : IF (IERRD.NE.0) RETURN 173 : ENDIF 174 : * 175 : * Vitesses généralisées pour le second demi-pas de temps 176 : * 176 : CALL DEVEQ4(Q2,NA1,XK,XASM,XM,XDT,NPAS,FTOTA,FINERT) 177 : * 178 : * accelerations généralis{es pour le second demi-pas de temps 179 : DO 20 I = 1,NA1 180 : UNSM1 = 1.D0 / ( XM(I) - FINERT(I,III) ) 181 : Q3(I,1) = (FTOTA(I,III)*UNSM1) - (XASM(I)*UNSM1*Q2(I,III)) 182 : 20 CONTINUE 183 : * end do 184 : 185 : c calcul des travaux pour le premier demi-pas de temps 186 : 186 : CALL DEVENE (NA1,III,NPAS,FEXA,Q1,Q2,FTOTA,WEXT,WINT, 187 : & XASM,NPC1) 188 : * 189 : END 190 : 191 : 192 : 193 : 194 : 195 : 196 :
© Cast3M 2003 - All rights reserved.
Disclaimer