C COMALO SOURCE FANDEUR 13/01/16 21:15:06 7665 SUBROUTINE COMALO(ipmode,itruli,ipmel) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *-------------------------------------------------------- * CF DEVALO.ESO et DEVTRA.ESO * indexe infos deformees modales , deplacements *-------------------------------------------------------- -INC SMCOORD -INC DECHE -INC CCOPTIO -INC CCGEOME -INC SMCHAML -INC SMELEME -INC SMMODEL -INC SMLENTI -INC CCREEL * segment wrktvu integer jtvu(lilmel(/1)) endsegment segment mwinit integer jpdep,jpvit,jrepr endsegment * * Segment des variables g�n�ralis�es: * 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),XASM(NA1),XM(NA1) ENDSEGMENT * Segment pour Champoints SEGMENT,MSAM integer jplibb(NPLB) ENDSEGMENT * *** segment sous-structures dynamiques segment struli integer itlia,itbmod,momoda, mostat,itmail,molia integer ldefo(np1),lcgra(np1),lsstru(np1) integer nsstru,nndefo,nliab,nsb,na2,idimb integer ktliab,ktphi,ktq,ktres,kpref,ktkam,kcpr,ktpas INTEGER NIPALB,NXPALB,NPLBB,NPLB,NIP,jliaib * ichain segment MLENTI initialise dans dyne12 (tjs actif si > 0) INTEGER ICHAIN endsegment SEGMENT MOLIAI integer modtla,modtlb ENDSEGMENT * * Segment de travail pour reprise force POLYNOMIALE base A * SEGMENT,MTRA INTEGER IPLA(NTRA) ENDSEGMENT SEGMENT,ICPR(XCOOR(/1)/(IDIM+1)) SEGMENT,MCPR(XCOOR(/1)/(IDIM+1)) SEGMENT,MPREF INTEGER IPOREF(NPREF) ENDSEGMENT segment icma(0) segment icnna2(0) PARAMETER (MDEPL=20) LOGICAL REPRIS,LMODYN,RIGIDE,ilogmo,ilogst,ilogre,L0,LVA1,LVAR CHARACTER*4 LISDEP(MDEPL),LISVIT(MDEPL),TESDEP CHARACTER*6 MO2 CHARACTER*8 CMOT,TYPRET,MORIGI,CHARRE CHARACTER*10 MO1 CHARACTER*40 MONMOT DATA LISDEP/ 'UX ','UY ','UZ ','UR ','UT ','RX ','RY ', &'RZ ','RT ','ALFA','BETA','IUX ','IUY ','IUZ ','IUR ','IUT ', &'IRX ','IRY ','IRZ ','IRT '/ DATA LISVIT/ 'VTX ','VTY ','VTZ ','VTR ','VTT ','VWX ','VWY ', &'VWZ ','VWT ','VALF','VBET','IVTX','IVTY','IVTZ','IVTR','IVTT', &'IVWX','IVWY','IVWZ','IVWT'/ * * si IFOMOD = -1 : mod?le PLAN * si IFOMOD = 0 : mod?le AXIS * si IFOMOD = 1 : mod?le FOUR * si IFOMOD = 2 : mod?le TRID * * ITREP = 0 MTQ = 0 MTKAM = 0 MTPHI = 0 MTLIAA = 0 MTLIAB = 0 MTFEX = 0 MTPAS = 0 MTRES = 0 MTNUM = 0 MTRA = 0 XTINI = 0.D0 ITLA = 0 ITLB = 0 REPRIS = .FALSE. lilmel = ipmel struli = itruli jliaib = 0 nmost = 0 nmost0 = 0 kovaen = 0 kovare = 0 * identifie materiau MODAL ou STATIQUE itmod = ipmode * call ecrcha('MODAL') call ecrcha('MATE') call ecrobj('MMODEL',ITMOD) call exis call lirlog(ilogmo,0,iret) IF (ilogmo) THEN call ecrcha('MECANIQUE') call ecrcha('FORM') call ecrobj('MMODEL',ITMOD) call extrai call lirobj('MMODEL',momod1,0,iret) call ecrcha('MODAL') call ecrcha('MATE') call ecrobj('MMODEL',momod1) call extrai call lirobj('MMODEL',ipmodz,0,iret) momoda = ipmodz mmode1 = ipmodz segact mmode1 nmost0 = mmode1.kmodel(/1) nmost = nmost + nmost0 ENDIF call ecrcha('STATIQUE') call ecrcha('MATE') call ecrobj('MMODEL',ITMOD) call exis call lirlog(ilogst,0,iret) IF (ilogst) THEN call ecrcha('MECANIQUE') call ecrcha('FORM') call ecrobj('MMODEL',ITMOD) call extrai call lirobj('MMODEL',momod1,0,iret) call ecrcha('STATIQUE') call ecrcha('MATE') call ecrobj('MMODEL',momod1) call extrai call lirobj('MMODEL',ipmodz,0,iret) mostat = ipmodz mmode1 = ipmodz segact mmode1 nmost = nmost + mmode1.kmodel(/1) ENDIF na1 = nmost mmode2 = itlia segact mmode2 nliat = mmode2.kmodel(/1) mmode1 = ipmode segact mmode1 ilogre = (mmode1.kmodel(/1) - na1 - nliat).gt.0 n1 = nmost segini mmodel mmode1 = momoda do im = 1,nmost0 kmodel(im) = mmode1.kmodel(im) enddo IF (ilogst) THEN mmode1 = mostat do im = 1,mmode1.kmodel(/1) kmodel(nmost0 + im) = mmode1.kmodel(im) enddo ENDIF itbmod = mmodel np1 = nmost segadj struli * * collecte deplacements, vitesses, deformation , centre gravite segini wrktvu iptvu = wrktvu do 2010 mvu = 1,lilmel(/1) deche = lilmel(mvu) if(ilogmo) then if (nomdec.eq.'ALFA'.and.indec.eq.1) then jtvu(mvu) = 101 goto 2010 endif if (nomdec.eq.'ALFA'.and.indec.gt.1) then jtvu(mvu) = 102 goto 2010 endif if (nomdec.eq.'FALF'.and.indec.gt.1) then jtvu(mvu) = 105 goto 2010 endif if (nomdec.eq.'VALF'.and.indec.eq.1) then jtvu(mvu) = 106 goto 2010 endif if (nomdec.eq.'VALF'.and.indec.gt.1) then jtvu(mvu) = 107 goto 2010 endif endif if(ilogst) then if (nomdec.eq.'BETA'.and.indec.eq.1) then jtvu(mvu) = 201 goto 2010 endif if (nomdec.eq.'BETA'.and.indec.gt.1) then jtvu(mvu) = 202 goto 2010 endif if (nomdec.eq.'FBET'.and.indec.gt.1) then jtvu(mvu) = 205 goto 2010 endif if (nomdec.eq.'VBET'.and.indec.eq.1) then jtvu(mvu) = 206 goto 2010 endif if (nomdec.eq.'VBET'.and.indec.gt.1) then jtvu(mvu) = 207 goto 2010 endif endif if(ilogmo.or.ilogst) then if (nomdec.eq.'DEFO'.and.indec.gt.1) then jtvu(mvu)= 302 goto 2010 endif if (nomdec.eq.'AMOR'.and.indec.gt.1) then jtvu(mvu)= 305 goto 2010 endif endif if(ilogmo) then if (nomdec.eq.'CGRA'.and.indec.gt.1) then jtvu(mvu)= 303 goto 2010 endif if (nomdec.eq.'FREQ'.and.indec.gt.1) then jtvu(mvu)= 304 goto 2010 endif if (nomdec.eq.'MASS'.and.indec.gt.1) then jtvu(mvu)= 305 goto 2010 endif endif if (ilogre) then do mdep = 1,MDEPL if (nomdec.eq.lisdep(mdep)) then jtvu(mvu)= mdep goto 2010 endif if (nomdec.eq.lisvit(mdep)) then jtvu(mvu)= mdep * (-1) goto 2010 endif enddo endif if (nomdec.eq.'SORT') then jtvu(mvu) = 501 goto 2010 endif if (nomdec.eq.'VAEN') then jtvu(mvu) = 506 kovaen = kovaen + 1 goto 2010 endif if (nomdec.eq.'VARE') then jtvu(mvu) = 507 kovare = kovare + 1 goto 2010 endif jtvu(mvu) = -100 2010 continue IK = 0 SEGINI,ICPR LCPR = XCOOR(/1)/(IDIM+1) MMODEL = itbmod segact MMODEL do 60 im = 1,kmodel(/1) imodel = kmodel(im) segact imodel*nomod meleme = imamod segact meleme * a priori 1 seul point do ip = 1,num(/2) knoe = num(1,ip) IF (KNOE.NE.0) THEN IF (ICPR(KNOE).EQ.0) THEN IK = IK + 1 ICPR(KNOE) = IK IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'COMALO : basemo. ICPR(',KNOE,')=',ICPR(KNOE) ENDIF ENDIF ENDIF enddo 60 continue * * * 5/ Cr{ation du segment d{finissant les points supports: * NPREF = IK SEGINI,MPREF KPREF = MPREF ikpref = KPREF DO 100 I=1,LCPR IF (ICPR(I).NE.0) THEN IREF = ICPR(I) IPOREF(IREF) = I IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'COMALO : IPOREF(',IREF,')=',IPOREF(IREF) ENDIF ENDIF 100 CONTINUE * * creation et remplissage MTQ (revoir indices dans DYNE 1=actuel 2=avant) * NA1 = nmost segini MTQ,MTKAM ktq = MTQ ktkam = MTKAM do ia1 = 1,na1 xk(ia1) = 1.d0 enddo mmodel = itbmod do 3010 mvu = 1,lilmel(/1) if (jtvu(mvu).ne.101.and.jtvu(mvu).ne.102.and. &jtvu(mvu).ne.106.and.jtvu(mvu).ne.107.and. &jtvu(mvu).ne.201.and.jtvu(mvu).ne.202.and. &jtvu(mvu).ne.206.and.jtvu(mvu).ne.207.and. &jtvu(mvu).ne.105.and.jtvu(mvu).ne.205.and. &jtvu(mvu).ne.304.and.jtvu(mvu).ne.305) goto 3010 deche = lilmel(mvu) melval = ieldec segact melval do 3050 im = 1,kmodel(/1) imodel = kmodel(im) if (imadec.ne.imamod.or.condec.ne.conmod) goto 3050 meleme = imamod IA = ICPR(num(1,1)) * en gros ordre du MMODEL if (nomdec.eq.'ALFA'.or.nomdec.eq.'BETA') then if (indec.eq.1) Q1(ia,2) = velche(1,1) if (indec.gt.1) Q1(ia,1) = velche(1,1) q1(ia,3) = q1(ia,2) endif if (nomdec.eq.'VALF'.or.nomdec.eq.'VBET') then if (indec.eq.1) Q2(ia,2) = velche(1,1) if (indec.gt.1) Q2(ia,1) = velche(1,1) q2(ia,3) = q2(ia,2) endif if (nomdec.eq.'FALF'.or.nomdec.eq.'FBET') then if (indec.gt.1) then Q3(ia,2) = velche(1,1) endif endif if (nomdec.eq.'FREQ') then OMEGA = velche(1,1) * 2.d0* xpi xk(ia) = xk(ia) * omega * omega endif if (nomdec.eq.'MASS') then xm(ia) = velche(1,1) xk(ia) = velche(1,1) * xk(ia) endif if (nomdec.eq.'AMOR') then xasm(ia) = velche(1,1) endif goto 3009 3050 continue 3009 segdes melval 3010 continue segsup icpr 5001 continue * (kich : traitement sur base modale-stat pour l instant) * ipmodz = itbmod call ecrcha('MAIL') call ecrobj('MMODEL',ipmodz) call extrai call lirobj('MAILLAGE',ipt1,0,iret) itmail = ipt1 if (ierr.ne.0) return if (iret.ne.1) then write(6,*) 'pb developpement comalo' ierr = 2 return endif segact ipt1 segini mcpr do ie = 1,ipt1.num(/2) mcpr(ipt1.num(1,ie)) = 1 enddo mmodel = itlia segact mmodel n1 = kmodel(/1) segini mmode1,mmode2 klia = 0 klib = 0 do ik = 1,kmodel(/1) imodel = kmodel(ik) * liaisons issues de DYNE segact imodel meleme = imamod if (imatee.lt.23) then segact meleme if (mcpr(num(1,1)).gt.0) then klia = klia + 1 mmode1.kmodel(klia) = imodel else klib = klib + 1 mmode2.kmodel(klib) = imodel endif endif enddo nliady = klia+klib n1 = klia itla = mmode1 segadj mmode1 n1 = klib segadj mmode2 itlb = mmode2 segsup mcpr segini moliai modtla = itla if (klia.eq.0) modtla = 0 modtlb = itlb if (klib.eq.0) modtlb = 0 * distingue liaisons A et B IMOLIA = MOLIAI molia = moliai * recense variables internes de continuation, rustique ! if (kovare.eq.kovaen.and.kovare.eq.klia + klib) then segsup wrktvu return endif * * dimensionnement MTPHI : repere les deformees modales wrktvu =iptvu segini icma,icnna2 MMODEL = itbmod segact MMODEL kstru = 0 kdefo = 0 do 50 im = 1,kmodel(/1) imodel = kmodel(im) segact imodel*nomod meleme = imamod segact meleme ** recherche sommaire nombre de sous-structures independantes (NSB) ** nombre maxi de modes pour une meme sous-structure (NA2) do 46 in = 1,jtvu(/1) if (jtvu(in).ne.302.and.jtvu(in).ne.303) goto 46 deche = lilmel(in) if (condec(1:16).ne.conmod(1:16).or.imamod.ne.imadec) goto 46 * assume point support reduit à 1 point if (nomdec(1:4).eq.'CGRA') then * recherche corps rigide if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3 if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6 melval = ieldec segact melval icdg = ielche(1,1) lcgra(im) = icdg segdes melval else if (nomdec(1:4).eq.'DEFO') then melval = ieldec segact melval * assume que le maillage modele se reduit au point support icdef1 = ielche(1,1) segdes melval call ecrcha('NOMU') call ecrcha('MAIL') call ecrobj('CHPOINT ',icdef1) call extrai call lirobj('MAILLAGE', icmaio,1,iret) if (ierr.ne.0) return if (kstru.eq.0) goto 44 ipt5 = icmaio do ic = 1,kstru icmic = icma(ic) CALL INTERB(icmaio,icmic,IRETIB,icinte) if (iretib.eq.0) then ipt6 = icinte segact ipt6,ipt5 if (ipt5.num(/2).eq.ipt6.num(/2)) then segsup ipt6 icnna2(ic) = icnna2(ic) + 1 lsstru(im) = ic goto 45 endif segsup ipt6 endif enddo 44 continue kstru = kstru + 1 icma(**) = icmaio icnna2(**) = 1 lsstru(im) = kstru 45 continue do ism = 1,im if (icdef1.ne.0.and.icdef1.eq.ldefo(ism)) then c write(6,*) 'deformee ',icdef1,'utilisee autre support', ism,im call erreur(26) return endif enddo ldefo(im) = icdef1 kdefo = kdefo + 1 goto 46 endif 46 continue if (ldefo(im).eq.0) then c write(6,*) 'manque deformee modale pour support', imamod call erreur(26) return endif 47 continue 49 continue 50 continue NSB = icma(/1) NA2 = icnna2(1) do ic = 1,icnna2(/1) na2 = MAX(icnna2(ic),NA2) enddo nsstru = kstru nndefo = kdefo if (nndefo.ne.nmost) then call erreur(26) return endif if (nsstru.ne.nsb) then call erreur(26) return endif segsup icma,icnna2 segsup wrktvu * RETURN END