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

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