Télécharger la plaquette Cast3M


fr en

Télécharger coml11.eso

Retour à la liste

Numérotation des lignes : 

coml11

  1. C COML11    SOURCE    CB215821  24/04/12    21:15:21     11897          
  2.  
  3.       SUBROUTINE COML11(iqmod,wrk52,wrk53,ib,igau, itruli,iretou)
  4.  
  5.       IMPLICIT REAL*8(a-h,o-z)
  6.       IMPLICIT INTEGER(I-N)
  7.  
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC CCREEL
  12. * segment deroulant le mcheml
  13. -INC DECHE
  14. -INC SMCHPOI
  15. -INC SMELEME
  16. -INC SMLENTI
  17. -INC SMLREEL
  18. -INC SMMODEL
  19. *-------------------------------------------------------------
  20. * MODELES DE LIAISONS autres que DYNE
  21. *-------------------------------------------------------------
  22. ** segment sous-structures dynamiques
  23.       segment struli
  24.        integer itlia,itbmod,momoda, mostat,itmail,molia
  25.        integer ldefo(np1),lcgra(np1),lsstru(np1)
  26.        integer nsstru,nndefo,nliab,nsb,na2,idimb
  27.        integer ktliab,ktphi,ktq,ktres,kpref,ktkam,kcpr,ktpas
  28.        INTEGER NIPALB,NXPALB,NPLBB,NPLB,NIP,jliaib
  29. * ichain segment MLENTI initialise dans dyne12 (tjs actif si > 0)
  30.        INTEGER ICHAIN
  31.       endsegment
  32.  
  33.       SEGMENT,MTQ
  34.          REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4)
  35.          REAL*8 WEXT(NA1,2),WINT(NA1,2)
  36.       ENDSEGMENT
  37.  
  38.       SEGMENT,MPREF
  39.          INTEGER IPOREF(NPREF)
  40.       ENDSEGMENT
  41.       POINTEUR MPRE1.MPREF
  42. *
  43.       CHARACTER*(LOCOMP) mmcc
  44.  
  45.       imodel = iqmod
  46.       struli = itruli
  47.  
  48.       IF (CMATEE.eq.'NEWMOD') THEN
  49.  
  50.       xjeu = valmat(1)
  51.       xmass0 = valmat(2)
  52.       omeg0 = valmat(3)*2.*xpi 
  53.       xexce = 0.d0
  54.       if (valmat(/1).gt.1) then
  55.         xexce = valmat(4)
  56.         xmu = valmat(5)
  57.         mmode2 = int(valmat(6))
  58.       endif
  59.  
  60.       xdelt = tempf - temp0
  61.       if (xdelt.eq.0.or.xmass0.eq.0) then
  62.         moterr(1:50) = 'utilisation inappropriée revoir masse et pdt'
  63.         call erreur(-385)
  64.         interr(1) = imodel
  65.         moterr(1:16) = conmod
  66.         call erreur(-386)        
  67.         call erreur(21)
  68.         return
  69.       endif
  70.  
  71.       nexo = exova0(/1)
  72.       do ix = 1,nexo
  73.         if (nomexo(ix).eq.'VALF') then
  74.           alpoin0 = exova0(ix)
  75.         endif
  76.       enddo
  77.  
  78. * vitesse algo Newmark
  79.        unsurh = 1./xdelt
  80.        zdept = deplf(1) - depl0(1)
  81.        yviti = (2.d0*unsurh*zdept) - alpoin0
  82.  
  83.        xk0 = omeg0 * omeg0 * xmass0
  84. * applique correction Newmark, voir Verpeaux Charras
  85.       depchoc = 0.d0
  86.       if (xjeu.gt.0) then
  87.        if ((deplf(1) - xexce).ge.((1.d0 - xzprec)*xjeu)) then
  88.           depchoc = xjeu + xexce
  89.        endif
  90.       else if (xjeu.lt.0) then
  91.        if ((deplf(1) - xexce).le.((1.d0 - xzprec)*xjeu)) then
  92.           depchoc = xjeu + xexce
  93.        endif
  94.       endif
  95.  
  96.       if (depchoc.ne.0.d0) then
  97.         xreac = (xk0 + (xmass0*4.d0/xdelt/xdelt))*
  98.      &(depchoc - depl0(1)) - forcf(1) - forc0(1)
  99.      &+ (2.d0*xk0*depl0(1)) - (4.d0*xmass0*alpoin0/xdelt)
  100.  
  101.         deltaer = xreac * (depchoc - depl0(1)) / 2.d0
  102.  
  103.        upoint0 = (2.d0*(depchoc -depl0(1))/xdelt) - alpoin0
  104.         xb = xreac * xdelt * upoint0
  105.         xa = xdelt*xdelt*xreac*xreac/2.d0/xmass0
  106.         xdelta = xb*xb - xa*deltaer*4.d0
  107.       if (xdelta.lt.0.) then
  108.        call erreur(21)
  109.        return
  110.       endif
  111.         r_z = sqrt(xdelta)
  112.         xlambc1 = (-xb + r_z)/(2.d0*xa)
  113.         xlambc2 = (-xb - r_z)/(2.d0*xa)
  114.  
  115.         alpoinc1 = xlambc1*xdelt*xreac/xmass0
  116.         alpoinc2 = xlambc2*xdelt*xreac/xmass0
  117.  
  118.         if(((upoint0+alpoinc1)*xreac).gt.0.) then
  119.          xcvit = alpoinc1
  120.         elseif(((upoint0+alpoinc2)*xreac).gt.0.) then
  121.          xcvit = alpoinc2
  122.         else
  123.          xcvit = 0.d0
  124.         endif
  125.  
  126.           NC = 2
  127.         xreac = xreac * (-1.d0)
  128.       else
  129.         xreac = 0.d0
  130.         xcvit = 0.d0
  131.         varf(1) = 0.d0
  132.         return
  133.       endif
  134.  
  135.         meleme = itmail
  136.          segact meleme
  137.          if (lisous(/1).eq.0) then
  138.           ipmmod = itmail
  139.           ipmsta = 0
  140.          else
  141.           ipmmod = lisous(1)
  142.           ipmsta = lisous(2)
  143.          endif
  144.          segdes meleme
  145.          meleme = ipmail
  146.          segact meleme
  147.          ipt1 = ipmmod
  148.          segact ipt1
  149.          mmcc = ' '
  150.          do ijn =1,ipt1.num(/2)
  151.           if (num(igau,ib).eq.ipt1.num(1,ijn)) mmcc = 'FALF'
  152.          enddo
  153.          if (mmcc.ne.'FALF') then
  154.           ipt1 = ipmsta
  155.           segact ipt1
  156.           do ijn =1,ipt1.num(/2)
  157.            if (num(igau,ib).eq.ipt1.num(1,ijn)) mmcc = 'FBET'
  158.           enddo
  159.          endif
  160.  
  161.          NSOUPO = 1
  162.          NAT=1
  163.          SEGINI,MCHPOI
  164.          IPCHPO = MCHPOI
  165.          MTYPOI = 'FLIAISONS'
  166.          IFOPOI = IFOUR
  167. *          nature  diffuse
  168.          JATTRI(1) = 1
  169.        nmost0 = 0
  170.        KIPCHP = 0
  171.          SEGINI,MSOUPO
  172.          KIPCHP = KIPCHP + 1
  173.          IPCHP(KIPCHP)  = MSOUPO
  174.          NOCOMP(1) = mmcc
  175.          NOHARM(1) = NIFOUR
  176.            NBNN = 1
  177.            NBELEM = 1
  178.            NBSOUS = 0
  179.            NBREF = 0
  180.            SEGINI IPT2
  181.            IPT2.ITYPEL = 1
  182.            IPT2.NUM(1,1) = num(igau,ib)
  183.            segdes ipt2
  184.          IGEOC = ipt2
  185.          N = 1
  186.          SEGINI,MPOVAL
  187.          IPOVAL = MPOVAL
  188.           vpocha(1,1) = xreac
  189.  
  190.           if(NC.eq.2) then
  191.          NOCOMP(2) = mmcc
  192.          NOCOMP(2)(1:1) = 'V'
  193.          NOHARM(2) = NIFOUR
  194.           vpocha(1,2) = xcvit + yviti
  195.           endif
  196.          SEGDES,MPOVAL,MSOUPO
  197.  
  198.        varf(1) = IPCHPO
  199.  
  200. * avec frottement
  201.  
  202.        if (xmu.gt.0. .and.mmode2.gt.0) then
  203.         mpref = kpref
  204.         npref = iporef(/1)
  205.         segini mpre1
  206.         mtq = ktq
  207.         segact mmode2
  208.          nsoupo = 1 + mmode2.kmodel(/1)
  209.          segadj mchpoi
  210.         do im2 = 1, mmode2.kmodel(/1)
  211.          imode2  = mmode2.kmodel(im2)
  212.          segact imode2
  213.          nomid = lnomid(2)
  214.          segact nomid
  215.          NC = lesobl(/2) + lesfac(/2)
  216.          iptu = imode2.imamod
  217.          call change(iptu,1)
  218.          ipt3 = iptu
  219.          segact ipt3
  220.          N = ipt3.num(/2)
  221.          SEGINI,MPOVAL
  222.          do 187 in = 1,N
  223.           if (ipt3.num(1,in).eq.num(ib,igau)) then
  224. *           write(6,*) 'données erronnées'
  225.            call erreur(21)
  226.            return
  227.           endif
  228.           do lf = 1,npref
  229.             if (ipt3.num(1,in).eq.iporef(lf)) then
  230.               mpre1.iporef(lf) = mpre1.iporef(lf) + 1
  231.               if (mpre1.iporef(lf).gt.1) then
  232. *                write(6,*) 'données erronnées'
  233.                 call erreur(21)
  234.                 return
  235.               endif
  236.               do jj = 1,NC
  237.                 if (q2(lf,2).ne.0.d0) then
  238.                   vpocha(in,jj) = (-1.d0)*q2(lf,2)/ABS(q2(lf,2))
  239.                 else
  240.                   vpocha(in,jj) = 0.d0
  241.                 endif
  242.               enddo
  243.               goto 187
  244.             endif
  245.           enddo
  246. *           write(6,*)' ne fait pas partie du modele'
  247.           call erreur(21)
  248.           return
  249.  187     continue
  250. *
  251.          SEGINI,MSOUPO
  252.          KIPCHP = KIPCHP + 1
  253.          IPCHP(KIPCHP)  = MSOUPO
  254.           ncobl = lesobl(/2)
  255.          do jj = 1,ncobl
  256.           NOCOMP(jj) = lesobl(jj)
  257.           NOHARM(jj) = NIFOUR
  258.          enddo
  259.          if (lesfac(/2).gt.0) then
  260.          do jj = 1,lesfac(/2)
  261.           NOCOMP(ncobl + jj) = lesfac(jj)
  262.           NOHARM(ncobl + jj) = NIFOUR
  263.          enddo
  264.          endif
  265.          IGEOC = ipt3
  266.          IPOVAL = MPOVAL
  267. *
  268.          do ii = 1,N
  269.           do jj = 1, NC
  270.            vpocha(ii,jj) = vpocha(ii,jj)*xmu * ABS(xreac)
  271.           enddo
  272.          enddo
  273.  
  274.          SEGDES,MPOVAL,MSOUPO,imode2
  275.         enddo
  276.         segdes mmode2
  277.        endif
  278.  
  279.       segdes MCHPOI
  280.       varf(1) = IPCHPO
  281.  
  282.       ENDIF
  283.  
  284.       RETURN
  285.       END
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales