C D2VALG SOURCE BP208322 20/09/18 21:15:12 10718 C DEVALG SOURCE LAVARENN 96/10/30 21:15:20 2349 SUBROUTINE D2VALG(KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS, & KTRES,KTNUM,KPREF,NINS,KOCLFA,KOCLB1,REPRIS, & RIGIDE) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Opérateur DYNE : algorithme differences centrees * * ________________________________________________ * * * * Mise en oeuvre de l'algorithme. * * * * Paramètres: * * * * es KTQ Segment contenant les variables généralisées * * (et les travaux) * es KTKAM Segment contenant les vecteurs XK, XASM et XM * * es KTPHI Segment contenant les déformées modales * * es KTLIAA Segment descriptif des liaisons en base A * * es KTLIAB Segment descriptif des liaisons en base B * * es KTFEX Segment contenant les chargements libres * * es KTPAS Segment des variables au cours d'un pas de temps * * es KTRES Segment de sauvegarde des résultats * * es KTNUM Segment contenant les paramètres numériques * * es KPREF Segment des points de référence * * e NINS On veut une sortie tous les NINS pas de calcul * * e REPRIS Vrai si reprise de calcul, faux sinon * * e RIGIDE Vrai si l'on a un corps rigide, faux sinon * * * * Auteur, date de creation: * * * * Denis ROBERT-MOUGIN, le 6 juin 1989. * * * *--------------------------------------------------------------------* SEGMENT,MTQ REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4) REAL*8 WEXT(NA1,2),WINT(NA1,2) ENDSEGMENT SEGMENT,MTKAM REAL*8 XK(NA1,NB1K),XASM(NA1,NB1C),XM(NA1,NB1M) REAL*8 XOPER(NB1,NB1,NOPER) ENDSEGMENT SEGMENT,MTPHI INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) INTEGER IAROTA(NSB) REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) ENDSEGMENT SEGMENT,MTLIAA INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA) REAL*8 XPALA(NLIAA,NXPALA) ENDSEGMENT SEGMENT,MTLIAB INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) REAL*8 XPALB(NLIAB,NXPALB) REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) ENDSEGMENT SEGMENT,MTFEX REAL*8 FEXA(NPFEXA,NPC1,2) REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB) REAL*8 FTEXB(NPLB,NPC1,2,IDIM) * INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB) ENDSEGMENT SEGMENT,MTPAS REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1) REAL*8 XPTB(NPLB,2,IDIMB),FINERT(NA1,4) REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR) REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB) ENDSEGMENT SEGMENT,MTRES REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES) REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB) REAL*8 XMREP(NLIAB,4,IDIMB) INTEGER ICHRES(NVES),IPORES(NRESPO,NPRES),IPOREP(NREP) INTEGER ILIRES(NRESLI,NCRES) INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA) INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB) INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR) INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR) INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4) INTEGER ILPOLA(NLIAA,2) ENDSEGMENT SEGMENT,MTNUM REAL*8 XDT(NPC1),XTEMPS(NPC1) ENDSEGMENT SEGMENT,MPREF INTEGER IPOREF(NPREF) ENDSEGMENT * Segment "local" pour DEVLFA ... SEGMENT,LOCLFA REAL*8 FTEST(NA1,4) ENDSEGMENT * Segment "local" pour DEVLB1 ... SEGMENT,LOCLB1 REAL*8 FTEST2(NPLB,6) ENDSEGMENT * LOGICAL L0,L1,REPRIS,RIGIDE CHARACTER*8 TYPRET * MTQ = KTQ MTKAM = KTKAM MTNUM = KTNUM MTFEX = KTFEX MPREF = KPREF MTRES = KTRES MTPAS = KTPAS LOCLFA = KOCLFA LOCLB1 = KOCLB1 NP = XDT(/1) - 1 NA1 = Q2(/1) NB1K = XK(/2) NB1C = XASM(/2) NB1M = XM(/2) NB1 = XOPER(/1) NOPER = XOPER(/3) NRES = XRES(/1) NREP = XREP(/1) NCRES = XRES(/2) NPRES = XRES(/3) NPFEXA = FEXA(/1) NPC1 = FEXA(/2) MTLIAA = KTLIAA NLIAA = IPALA(/1) NLSA = INULA(/1) MTPHI = KTPHI MTLIAB = KTLIAB NLIAB = IPALB(/1) NLSB = INULB(/1) NPLB = JPLIB(/1) NA2 = XPHILB(/3) IDIMB = XPHILB(/4) NTVAR = ILIREB(/2) NIP = XABSCI(/2) NSB = INMSB(/1) IERRD = 0 * * Boucle sur les pas de calcul: * IINS = 0 IINS2 = 0 * * Calcul du premier pas: * c write(*,*) '=== Calcul du premier pas ===' c write(*,*) 'Q1(:,2) =',(Q1(iou,2),iou=1,NA1) c write(*,*) 'Q2(:,2) =',(Q2(iou,2),iou=1,NA1) c write(*,*) 'Q3(:,2) =',(Q3(iou,2),iou=1,NA1) PDT=XDT(1) T=XTEMPS(1) CALL D2VPAS(Q1,Q2,Q3,NA1,NPC1,XK,XASM,XM,PDT,T,1,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,XOPER,NB1,NB1K,NB1C,NB1M) IF (IERRD.NE.0) THEN IF (IERRD.EQ.1) CALL ERREUR(528) RETURN ENDIF * * Remplissage du tableau de sauvegarde: * IINS = IINS + 1 IF ( .NOT. REPRIS ) THEN IINS2 = IINS2 + 1 CALL D2VTRI(Q1,Q2,Q3,NA1,IINS2,FTOTA,XRES,ICHRES,NRES,NCRES, & NPRES,XVALA,INULA,NLIAA,NLSA,XRESLA,XVALB,INULB, & NLIAB,NLSB,XRESLB,ILIREA,ILIREB,NTVAR,WEXT,WINT, & XCHPFB,NPLB) ENDIF IF (IINS.EQ.NINS) THEN IINS = 0 IINS2 = IINS2 + 1 CALL DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES, & NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA, & XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA,ILIREB, & NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB,WEXT,WINT, & XCHPFB,NPLB) ENDIF * DO 10 I=2,NP * * Decalage ou mise a zero dans les tableaux pour le pas suivant: * CALL D2NE16(Q1,Q2,Q3,NA1,FTOTA,XPTB,NPLB,IDIMB,FINERT,WEXT,WINT) * * Calcul d'un pas: * PDT=XDT(I) T=XTEMPS(I) * c if(I.le.5) write(*,*) '=== Calcul du pas ===',I CALL D2VPAS(Q1,Q2,Q3,NA1,NPC1,XK,XASM,XM,PDT,T,I,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,XOPER,NB1,NB1K,NB1C,NB1M) * * IF (IERRD.NE.0) THEN IF (IERRD.EQ.1) CALL ERREUR(528) RETURN ENDIF * * Remplissage du tableau de sauvegarde: * IINS = IINS + 1 IF (IINS.EQ.NINS) THEN IINS = 0 IINS2 = IINS2 + 1 CALL DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES, & NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA, & XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA, & ILIREB,NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB, & WEXT,WINT,XCHPFB,NPLB) ENDIF 10 CONTINUE * end do * END