C COML11 SOURCE CB215821 25/04/23 21:15:06 12247 SUBROUTINE COML11(iqmod,wrk52,wrk53,ib,igau, itruli,iretou) IMPLICIT REAL*8(a-h,o-z) IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC CCREEL * segment deroulant le mcheml -INC DECHE -INC SMCHPOI -INC SMCOORD -INC SMELEME -INC SMLENTI -INC SMLREEL -INC SMMODEL *------------------------------------------------------------- * MODELES DE LIAISONS autres que DYNE *------------------------------------------------------------- ** 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,MTQ REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4) REAL*8 WEXT(NA1,2),WINT(NA1,2) ENDSEGMENT SEGMENT,MPREF INTEGER IPOREF(NPREF) ENDSEGMENT POINTEUR MPRE1.MPREF * CHARACTER*(LOCOMP) mmcc imodel = iqmod struli = itruli IF (CMATEE.eq.'NEWMOD') THEN xjeu = valmat(1) xmass0 = valmat(2) omeg0 = valmat(3)*2.*xpi xexce = 0.d0 if (valmat(/1).gt.1) then xexce = valmat(4) xmu = valmat(5) mmode2 = int(valmat(6)) endif xdelt = tempf - temp0 if (xdelt.eq.0.or.xmass0.eq.0) then moterr(1:50) = 'utilisation inappropriée revoir masse et pdt' call erreur(-385) interr(1) = imodel moterr(1:16) = conmod call erreur(-386) call erreur(21) return endif nexo = exova0(/1) do ix = 1,nexo if (nomexo(ix).eq.'VALF') then alpoin0 = exova0(ix) endif enddo * vitesse algo Newmark unsurh = 1./xdelt zdept = deplf(1) - depl0(1) yviti = (2.d0*unsurh*zdept) - alpoin0 xk0 = omeg0 * omeg0 * xmass0 * applique correction Newmark, voir Verpeaux Charras depchoc = 0.d0 if (xjeu.gt.0) then if ((deplf(1) - xexce).ge.((1.d0 - xzprec)*xjeu)) then depchoc = xjeu + xexce endif else if (xjeu.lt.0) then if ((deplf(1) - xexce).le.((1.d0 - xzprec)*xjeu)) then depchoc = xjeu + xexce endif endif if (depchoc.ne.0.d0) then xreac = (xk0 + (xmass0*4.d0/xdelt/xdelt))* &(depchoc - depl0(1)) - forcf(1) - forc0(1) &+ (2.d0*xk0*depl0(1)) - (4.d0*xmass0*alpoin0/xdelt) deltaer = xreac * (depchoc - depl0(1)) / 2.d0 upoint0 = (2.d0*(depchoc -depl0(1))/xdelt) - alpoin0 xb = xreac * xdelt * upoint0 xa = xdelt*xdelt*xreac*xreac/2.d0/xmass0 xdelta = xb*xb - xa*deltaer*4.d0 if (xdelta.lt.0.) then call erreur(21) return endif r_z = sqrt(xdelta) xlambc1 = (-xb + r_z)/(2.d0*xa) xlambc2 = (-xb - r_z)/(2.d0*xa) alpoinc1 = xlambc1*xdelt*xreac/xmass0 alpoinc2 = xlambc2*xdelt*xreac/xmass0 if(((upoint0+alpoinc1)*xreac).gt.0.) then xcvit = alpoinc1 elseif(((upoint0+alpoinc2)*xreac).gt.0.) then xcvit = alpoinc2 else xcvit = 0.d0 endif NC = 2 xreac = xreac * (-1.d0) else xreac = 0.d0 xcvit = 0.d0 varf(1) = 0.d0 return endif meleme = itmail segact meleme if (lisous(/1).eq.0) then ipmmod = itmail ipmsta = 0 else ipmmod = lisous(1) ipmsta = lisous(2) endif segdes meleme meleme = ipmail segact meleme ipt1 = ipmmod segact ipt1 mmcc = ' ' do ijn =1,ipt1.num(/2) if (num(igau,ib).eq.ipt1.num(1,ijn)) mmcc = 'FALF' enddo if (mmcc.ne.'FALF') then ipt1 = ipmsta segact ipt1 do ijn =1,ipt1.num(/2) if (num(igau,ib).eq.ipt1.num(1,ijn)) mmcc = 'FBET' enddo endif NSOUPO = 1 NAT=1 SEGINI,MCHPOI IPCHPO = MCHPOI MTYPOI = 'FLIAISONS' IFOPOI = IFOUR * nature diffuse JATTRI(1) = 1 nmost0 = 0 KIPCHP = 0 SEGINI,MSOUPO KIPCHP = KIPCHP + 1 IPCHP(KIPCHP) = MSOUPO NOCOMP(1) = mmcc NOHARM(1) = NIFOUR NBNN = 1 NBELEM = 1 NBSOUS = 0 NBREF = 0 SEGINI IPT2 IPT2.ITYPEL = 1 IPT2.NUM(1,1) = num(igau,ib) segdes ipt2 IGEOC = ipt2 N = 1 SEGINI,MPOVAL IPOVAL = MPOVAL vpocha(1,1) = xreac if(NC.eq.2) then NOCOMP(2) = mmcc NOCOMP(2)(1:1) = 'V' NOHARM(2) = NIFOUR vpocha(1,2) = xcvit + yviti endif SEGDES,MPOVAL,MSOUPO varf(1) = IPCHPO * avec frottement if (xmu.gt.0. .and.mmode2.gt.0) then mpref = kpref npref = iporef(/1) segini mpre1 mtq = ktq segact mmode2 nsoupo = 1 + mmode2.kmodel(/1) segadj mchpoi do im2 = 1, mmode2.kmodel(/1) imode2 = mmode2.kmodel(im2) segact imode2 nomid = lnomid(2) segact nomid NC = lesobl(/2) + lesfac(/2) iptu = imode2.imamod call change(iptu,1) ipt3 = iptu segact ipt3 N = ipt3.num(/2) SEGINI,MPOVAL do 187 in = 1,N if (ipt3.num(1,in).eq.num(ib,igau)) then * write(6,*) 'données erronnées' call erreur(21) return endif do lf = 1,npref if (ipt3.num(1,in).eq.iporef(lf)) then mpre1.iporef(lf) = mpre1.iporef(lf) + 1 if (mpre1.iporef(lf).gt.1) then * write(6,*) 'données erronnées' call erreur(21) return endif do jj = 1,NC if (q2(lf,2).ne.0.d0) then vpocha(in,jj) = (-1.d0)*q2(lf,2)/ABS(q2(lf,2)) else vpocha(in,jj) = 0.d0 endif enddo goto 187 endif enddo * write(6,*)' ne fait pas partie du modele' call erreur(21) return 187 continue * SEGINI,MSOUPO KIPCHP = KIPCHP + 1 IPCHP(KIPCHP) = MSOUPO ncobl = lesobl(/2) do jj = 1,ncobl NOCOMP(jj) = lesobl(jj) NOHARM(jj) = NIFOUR enddo if (lesfac(/2).gt.0) then do jj = 1,lesfac(/2) NOCOMP(ncobl + jj) = lesfac(jj) NOHARM(ncobl + jj) = NIFOUR enddo endif IGEOC = ipt3 IPOVAL = MPOVAL * do ii = 1,N do jj = 1, NC vpocha(ii,jj) = vpocha(ii,jj)*xmu * ABS(xreac) enddo enddo SEGDES,MPOVAL,MSOUPO,imode2 enddo segdes mmode2 endif segdes MCHPOI varf(1) = IPCHPO ENDIF RETURN END