1 : C DEVALG SOURCE KICH 08/06/26 21:15:17 6133 2 : SUBROUTINE DEVALG(KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS, 3 : & KTRES,KTNUM,KPREF,NINS,KOCLFA,KOCLB1,REPRIS, 4 : & RIGIDE) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : *--------------------------------------------------------------------* 8 : * * 9 : * Opérateur DYNE : algorithme de Fu - de Vogelaere * 10 : * ________________________________________________ * 11 : * * 12 : * Mise en oeuvre de l'algorithme. * 13 : * * 14 : * Paramètres: * 15 : * * 16 : * es KTQ Segment contenant les variables généralisées * 17 : * (et les travaux) 18 : * es KTKAM Segment contenant les vecteurs XK, XASM et XM * 19 : * es KTPHI Segment contenant les déformées modales * 20 : * es KTLIAA Segment descriptif des liaisons en base A * 21 : * es KTLIAB Segment descriptif des liaisons en base B * 22 : * es KTFEX Segment contenant les chargements libres * 23 : * es KTPAS Segment des variables au cours d'un pas de temps * 24 : * es KTRES Segment de sauvegarde des résultats * 25 : * es KTNUM Segment contenant les paramètres numériques * 26 : * es KPREF Segment des points de référence * 27 : * e NINS On veut une sortie tous les NINS pas de calcul * 28 : * e REPRIS Vrai si reprise de calcul, faux sinon * 29 : * e RIGIDE Vrai si l'on a un corps rigide, faux sinon * 30 : * * 31 : * Auteur, date de creation: * 32 : * * 33 : * Denis ROBERT-MOUGIN, le 6 juin 1989. * 34 : * * 35 : *--------------------------------------------------------------------* 36 : SEGMENT,MTQ 37 : REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4) 38 : REAL*8 WEXT(NA1,2),WINT(NA1,2) 39 : ENDSEGMENT 40 : SEGMENT,MTKAM 41 : REAL*8 XK(NA1),XASM(NA1),XM(NA1) 42 : ENDSEGMENT 43 : SEGMENT,MTPHI 44 : INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) 45 : INTEGER IAROTA(NSB) 46 : REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) 47 : ENDSEGMENT 48 : SEGMENT,MTLIAA 49 : INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA) 50 : REAL*8 XPALA(NLIAA,NXPALA) 51 : ENDSEGMENT 52 : SEGMENT,MTLIAB 53 : INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) 54 : REAL*8 XPALB(NLIAB,NXPALB) 55 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) 56 : ENDSEGMENT 57 : SEGMENT,MTFEX 58 : REAL*8 FEXA(NPFEXA,NPC1,2) 59 : REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB) 60 : REAL*8 FTEXB(NPLB,NPC1,2,IDIM) 61 : INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB) 62 : ENDSEGMENT 63 : SEGMENT,MTPAS 64 : REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1) 65 : REAL*8 XPTB(NPLB,4,IDIMB),FINERT(NA1,4) 66 : REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR) 67 : REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB) 68 : ENDSEGMENT 69 : SEGMENT,MTRES 70 : REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES) 71 : REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB) 72 : REAL*8 XMREP(NLIAB,4,IDIMB) 73 : INTEGER ICHRES(NVES),IPORES(NRES,NPRES),IPOREP(NREP) 74 : INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA) 75 : INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB) 76 : INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR) 77 : INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR) 78 : INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4) 79 : INTEGER ILPOLA(NLIAA,2) 80 : ENDSEGMENT 81 : SEGMENT,MTNUM 82 : REAL*8 XDT(NPC1),XTEMPS(NPC1) 83 : ENDSEGMENT 84 : SEGMENT,MPREF 85 : INTEGER IPOREF(NPREF) 86 : ENDSEGMENT 87 : * Segment "local" pour DEVLFA ... 88 : SEGMENT,LOCLFA 89 : REAL*8 FTEST(NA1,4),FTOTA0(NA1,4) 90 : ENDSEGMENT 91 : * Segment "local" pour DEVLB1 ... 92 : SEGMENT,LOCLB1 93 : REAL*8 FTEST2(NPLB,6),FTOTB0(NPLB,6) 94 : ENDSEGMENT 95 : * 96 : LOGICAL L0,L1,REPRIS,RIGIDE 97 : CHARACTER*8 TYPRET 98 : * 99 : MTQ = KTQ 100 : MTKAM = KTKAM 101 : MTNUM = KTNUM 102 : MTFEX = KTFEX 103 : MPREF = KPREF 104 : MTRES = KTRES 105 : MTPAS = KTPAS 106 : LOCLFA = KOCLFA 107 : LOCLB1 = KOCLB1 108 : NP = XDT(/1) - 1 109 : NA1 = Q2(/1) 110 : NRES = XRES(/1) 111 : NREP = XREP(/1) 112 : NCRES = XRES(/2) 113 : NPRES = XRES(/3) 114 : NPFEXA = FEXA(/1) 115 : NPC1 = FEXA(/2) 116 : MTLIAA = KTLIAA 117 : NLIAA = IPALA(/1) 118 : NLSA = INULA(/1) 119 : MTPHI = KTPHI 120 : MTLIAB = KTLIAB 121 : NLIAB = IPALB(/1) 122 : NLSB = INULB(/1) 123 : NPLB = JPLIB(/1) 124 : NA2 = XPHILB(/3) 125 : IDIMB = XPHILB(/4) 126 : NTVAR = ILIREB(/2) 127 : NIP = XABSCI(/2) 128 : NSB = INMSB(/1) 129 : IERRD = 0 130 : * 131 : * Boucle sur les pas de calcul: 132 : * 133 : IINS = 0 134 : IINS2 = 0 135 : * 136 : * Calcul du premier pas: 137 : * 138 : c SEGMENT,MTPHI 139 : c INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) 140 : cc INTEGER IAROTA(NSB) 141 : c REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) 142 : c ENDSEGMENT 143 : c SEGMENT,MTPAS 144 : c REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1) 145 : c REAL*8 XPTB(NPLB,4,IDIMB),FINERT(NA1,4) 146 : c REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR) 147 : c REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB) 148 : c ENDSEGMENT 149 : 150 : c write(6,*) nplb,idimb,ntvar,nliab 151 : 151 : CALL DEVPAS(NA1,NPC1,XK,XASM,XM,XDT,1,FTOTA,FEXA,IFEXA, 151 : * CALL DEVPAS(Q1,Q2,Q3,NA1,NPC1,XK,XASM,XM,XDT,1,FTOTA,FEXA,IFEXA, 152 : & NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA, 153 : & NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB,XVALB, 154 : & FTOTB,FTOTBA,XPTB, 155 : & FEXPSM,FINERT,IERRD,FTEST,FTOTA0,FTEST2,FTOTB0, 156 : * & WEXT,WINT,XABSCI,XORDON,NIP,FTEXB,FEXB,RIGIDE, 157 : & KTQ,XABSCI,XORDON,NIP,FTEXB,FEXB,RIGIDE, 158 : & KTPHI,XCHPFB) 159 : IF (IERRD.NE.0) THEN 159 : IF (IERRD.EQ.1) CALL ERREUR(528) 160 : RETURN 161 : ENDIF 162 : * 163 : * Remplissage du tableau de sauvegarde: 164 : * 165 : IINS = IINS + 1 166 : IF ( .NOT. REPRIS ) THEN 167 : IINS2 = IINS2 + 1 167 : CALL DEVTRI(Q1,Q2,Q3,NA1,IINS2,FTOTA,XRES,ICHRES,NRES,NCRES, 168 : & NPRES,XVALA,INULA,NLIAA,NLSA,XRESLA,XVALB,INULB, 169 : & NLIAB,NLSB,XRESLB,ILIREA,ILIREB,NTVAR,WEXT,WINT, 170 : & XCHPFB,NPLB) 171 : ENDIF 172 : IF (IINS.EQ.NINS) THEN 173 : IINS = 0 174 : IINS2 = IINS2 + 1 174 : CALL DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES, 175 : & NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA, 176 : & XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA,ILIREB, 177 : & NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB,WEXT,WINT, 178 : & XCHPFB,NPLB) 179 : ENDIF 180 : * 181 : DO 10 I=2,NP 182 : * 183 : * D{calage ou mise a zero dans les tableaux pour le pas suivant: 184 : * 184 : CALL DYNE16(Q1,Q2,Q3,NA1,FTOTA,XPTB,NPLB,IDIMB,FINERT) 185 : * 186 : * Calcul d'un pas: 187 : * 187 : CALL DEVPAS(NA1,NPC1,XK,XASM,XM,XDT,I,FTOTA,FEXA,IFEXA, 187 : * CALL DEVPAS(Q1,Q2,Q3,NA1,NPC1,XK,XASM,XM,XDT,I,FTOTA,FEXA,IFEXA, 188 : & NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA, 189 : & NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB, 190 : & XVALB,FTOTB,FTOTBA,XPTB, 191 : & FEXPSM,FINERT,IERRD,FTEST,FTOTA0, 192 : * & FTEST2,FTOTB0,WEXT,WINT,XABSCI,XORDON,NIP,FTEXB, 193 : & FTEST2,FTOTB0,KTQ,XABSCI,XORDON,NIP,FTEXB, 194 : & FEXB,RIGIDE,KTPHI,XCHPFB) 195 : * 196 : 197 : * 198 : IF (IERRD.NE.0) THEN 198 : IF (IERRD.EQ.1) CALL ERREUR(528) 199 : RETURN 200 : ENDIF 201 : * 202 : * Remplissage du tableau de sauvegarde: 203 : * 204 : IINS = IINS + 1 205 : IF (IINS.EQ.NINS) THEN 206 : IINS = 0 207 : IINS2 = IINS2 + 1 207 : CALL DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES, 208 : & NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA, 209 : & XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA, 210 : & ILIREB,NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB, 211 : & WEXT,WINT,XCHPFB,NPLB) 212 : ENDIF 213 : 10 CONTINUE 214 : * end do 215 : * 216 : END 217 : 218 : 219 : 220 : 221 : 222 : 223 :
© Cast3M 2003 - All rights reserved.
Disclaimer