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