Télécharger la plaquette Cast3M


fr en

Télécharger cmoda2.eso

Retour à la liste

Numérotation des lignes : 

cmoda2

  1. C CMODA2    SOURCE    CB215821  25/04/23    21:15:05     12247          
  2.       SUBROUTINE CMODA2(wrk52,wrk53,xdt,
  3.      &  IB,IGAU,NBPGAU,NBGMAT,NELMAT,IFOURB)
  4. *
  5. *
  6. *
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8 (A-H,O-Z)
  9.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. -INC CCREEL
  13. -INC DECHE
  14. -INC SMLREEL
  15. -INC SMEVOLL
  16. -INC SMLMOTS
  17. -INC SMELEME
  18. -INC SMCHPOI
  19. -INC SMCOORD
  20.  
  21.       CHARACTER*4 lesinc(7),lesdua(7)
  22.       DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR'/
  23.       DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR'/
  24. *
  25.       IF (cmate.eq.'MODAL') THEN
  26. c caracteristiques freq, mass
  27.        freq1 = valmat(1)
  28.        xmass1 = valmat(2)
  29.        omeg1 = 2. * xpi * freq1
  30.        xamor1 = valmat(4)
  31. *
  32.        do jj = 1,epstf(/1)
  33.         if (jj.eq.1) jjsi = 1
  34.         if (jj.eq.2) jjsi = 3
  35.         effx = epstf(jj)
  36.         sigf(jjsi) = effx * xmass1 * omeg1 * omeg1
  37. c        write(6,*) 'cda2 ', jj, effx, xmass1,omeg1,sigf(jjsi)
  38.        if (ifomod.eq.6.) then
  39.          omef = 2.*xpi*tempf
  40.          sigf(jjsi) = sigf(jjsi) - (effx * xmass1 * omef * omef)
  41. *        write(6,*) sigf(1), effx, xmass1 , (omef*omef)
  42.         if (jj.eq.2) sigf(jjsi) = sigf(jjsi) * (-1)
  43.         if (xamor1.ne.0..and.epstf(/1).gt.1) then
  44.           if (jj.eq.1) j2 = 2
  45.           if (jj.eq.2) j2 = 1
  46.          sigf(jjsi) = sigf(jjsi) + omef*xamor1*omeg1*xmass1*epstf(j2)
  47.         endif
  48. *        write(6,*) 'cda2 ', jj, effx, freq1,xmass1,omeg1,sigf(jjsi)
  49.        endif
  50.        enddo
  51.       ENDIF
  52.  
  53.       IF (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') THEN
  54.  
  55.          IPCHPO = 0
  56.        if (cmate.eq.'STATIQUE') then
  57.         if (valmat(5).gt.0) then
  58.          lricr = nint(valmat(5))
  59.          ipmmod = nint(valmat(6))
  60.          ipmsta = nint(valmat(7))
  61.          lmacr = nint(valmat(8))
  62.          lamcr = nint(valmat(9))
  63.         else
  64.          call erreur(26)
  65.          return
  66.         endif
  67.        elseif(cmate.eq.'MODAL') then
  68.         if (valmat(7).gt.0) then
  69.          lricr = nint(valmat(7))
  70.          ipmmod = 0
  71.          ipmsta = nint(valmat(8))
  72.          lmacr = nint(valmat(9))
  73.          lamcr = nint(valmat(10))
  74.         else
  75.           return
  76.         endif
  77.        endif
  78.          mlreel = lricr
  79.          segact mlreel
  80.  
  81.         if(ifomod.eq.6) then
  82.          mlree1 = lmacr
  83.          segact mlree1
  84.          omef = 2.*xpi*tempf
  85.          if (mlree1.prog(/1).le.0)then
  86.            call erreur(5)
  87.            return
  88.          endif
  89.          if (lamcr.gt.0) then
  90.           mlree2 = lamcr
  91.           segact mlree2
  92.          endif
  93.         endif
  94. *
  95.         if (prog(/1).le.0) then
  96.            call erreur(5)
  97.            return
  98.         endif
  99.  
  100.          JG0 = 0
  101.        DO 212 jj = 1,epstf(/1)
  102.         if (jj.eq.1) jjsi = 1
  103.         if (jj.eq.2) jjsi = 3
  104.           if (jj.eq.1) j2 = 2
  105.           if (jj.eq.2) j2 = 1
  106.         effx = epstf(jj)
  107.         sigf(2) = 0
  108. c         write(6,*) 'c2',prog(/1),mlree1.prog(/1),lamcr,effx
  109.  
  110.       IF (cmate.eq.'STATIQUE') THEN
  111.        if (prog(/1).eq.1) then
  112.          sigf(jjsi) = effx * prog(1)
  113.         if(ifomod.eq.6) then
  114.         sigf(jjsi) = sigf(jjsi) - (effx * mlree1.prog(1) * omef * omef)
  115.          if (jj.eq.2) sigf(jjsi) = sigf(jjsi) * (-1)
  116.          if (lamcr.gt.0) then
  117.           if (mlree2.prog(1).ne.0..and.epstf(/1).gt.1) then
  118.            sigf(jjsi) = sigf(jjsi) + omef*mlree2.prog(1)*epstf(j2)
  119.           endif
  120.          endif
  121.         endif
  122.         goto 212
  123.         if (jj.eq.epstf(/1)) then
  124.            segdes mlreel
  125.            if (ifomod.eq.6) then
  126.             segdes mlree1
  127.             if (lamcr.gt.0) segdes mlree2
  128.            endif
  129.            return
  130.         endif
  131.        else
  132.         sigf(jjsi) = 0.d0
  133.        endif
  134.       ENDIF
  135.  
  136. *
  137.       if (jj.eq.1) then
  138.          NSOUPO = 1
  139.          if(ipmmod.gt.0.and.ipmsta.gt.0) NSOUPO = 2
  140.          NAT=1
  141.          SEGINI,MCHPOI
  142.          IPCHPO = MCHPOI
  143.          MTYPOI = 'FMODSTA'
  144.          IFOPOI = IFOUR
  145. *          nature  diffuse
  146.          JATTRI(1) = 1
  147.        nmo0 = 0
  148.        KIPCHP = 0
  149.        if (ipmmod.gt.0) then
  150.          NC = epstf(/1)
  151.          SEGINI,MSOUPO
  152.          KIPCHP = KIPCHP + 1
  153.          IPCHP(KIPCHP)  = MSOUPO
  154.          NOCOMP(1) = 'FALF'
  155.          NOHARM(1) = NIFOUR
  156.          if (epstf(/1).eq.2) then
  157.           NOCOMP(2) = 'IFAL'
  158.           NOHARM(2) = NIFOUR
  159.          endif
  160.          IGEOC = ipmmod
  161.          ipt1 = ipmmod
  162.          segact ipt1
  163.          N = ipt1.num(/2)
  164.          nmo0 = N
  165.          JG0 = JG0 + N
  166.          SEGINI,MPOVAL
  167.          IPOVAL = MPOVAL
  168.          ipomo0 = ipoval
  169.        endif
  170.       endif
  171. *
  172.        if (ipmmod.gt.0) then
  173.          N = nmo0
  174.          mpoval = ipomo0
  175.          do ii = 1,N
  176. c          write(6,*) 'cc',vpocha(/1),vpocha(/2),ii,jj,prog(/1)
  177.           vpocha(ii,jj) = prog(ii)*effx
  178.           if (ifomod.eq.6) then
  179.         vpocha(ii,jj) = vpocha(ii,jj) - (effx*mlree1.prog(ii)*omef*omef)
  180.            if (jj.eq.2) vpocha(ii,jj) =  vpocha(ii,jj) * (-1)
  181.         if (lamcr.gt.0) then
  182.          if (mlree2.prog(ii).ne.0..and.epstf(/1).gt.1) then
  183.          vpocha(ii,jj) = vpocha(ii,jj) + omef*mlree2.prog(ii)*epstf(j2)
  184.          endif
  185.         endif
  186.           endif
  187. *      write(6,*)'m',effx,ii,ipt1.num(1,ii),mlree1.prog(ii),vpocha(ii,1)
  188.          enddo
  189.  
  190.          if (jj.eq.epstf(/1)) SEGDES,MPOVAL,MSOUPO
  191.        endif
  192.  
  193.       if (jj.eq.1) then
  194.        if (ipmsta.gt.0) then
  195.          NC = epstf(/1)
  196.          SEGINI,MSOUPO
  197.          KIPCHP = KIPCHP + 1
  198.          IPCHP(KIPCHP)  = MSOUPO
  199.          NOCOMP(1) = 'FBET'
  200.          NOHARM(1) = NIFOUR
  201.          if (epstf(/1).eq.2) then
  202.           NOCOMP(2) = 'IFBE'
  203.           NOHARM(2) = NIFOUR
  204.          endif
  205.          IGEOC = ipmsta
  206.          ipt1 = ipmsta
  207.          segact ipt1
  208.          N = ipt1.num(/2)
  209.          nst0 = N
  210.          SEGINI,MPOVAL
  211.          IPOVAL = MPOVAL
  212.          ipost0 = ipoval
  213.        endif
  214.       endif
  215. *
  216.        if (ipmsta.gt.0) then
  217.          N = nst0
  218.          mpoval = ipost0
  219.          do ii = 1,N
  220.           vpocha(ii,jj) = prog(JG0 + ii)*effx
  221.           if (ifomod.eq.6) then
  222.          vpocha(ii,jj) = vpocha(ii,jj) -
  223.      & (effx*mlree1.prog(JG0 + ii)*omef*omef)
  224.            if (jj.eq.2) vpocha(ii,jj) =  vpocha(ii,jj) * (-1)
  225.         if (lamcr.gt.0) then
  226.          if (mlree2.prog(JG0 + ii).ne.0..and.epstf(/1).gt.1) then
  227.          vpocha(ii,jj) = vpocha(ii,jj) +
  228.      &omef*mlree2.prog(JG0 + ii)*epstf(j2)
  229.          endif
  230.         endif
  231.           endif
  232. c      write(6,*)'s',effx,ii,ipt1.num(1,ii),mlree2.prog(JG0 +ii),
  233. c     &vpocha(ii,1),ipchpo
  234.          enddo
  235. c      write(6,*)'s',(mlree2.prog(JG0+ii),ii=1,N),(vpocha(ii,jj),ii=1,N)
  236.          if (jj.eq.epstf(/1)) SEGDES,MPOVAL
  237.        endif
  238.  
  239.  212   CONTINUE
  240. *       ENDDO
  241.  
  242.         if (IPCHPO.gt.0) segdes MCHPOI
  243.        sigf(2) = IPCHPO
  244. c       write(6,*) cmate,epstf(/1),epstf(1),epstf(2)
  245. c       write(6,*)'c2',cmate,sigf(/1),jj,(sigf(ll),ll = 1,sigf(/1))
  246.            segdes mlreel
  247.            if (ifomod.eq.6) then
  248.             segdes mlree1
  249.             if (lamcr.gt.0) segdes mlree2
  250.            endif
  251.        return
  252.       ENDIF
  253.  
  254.  
  255.       IF (cmate.EQ.'IMPELAST'.or.cmate.eq.'IMPVOIGT') THEN
  256.         xraid = xmat(1)
  257.  
  258.          do ig = 1,epstf(/1)
  259.           sigf(ig) = xraid * epstf(ig)
  260.          enddo
  261. *        write(6,*) 'cmoda2', (sigf(ll), ll = 1,3)
  262.             IF (cmate.eq.'IMPVOIGT') THEN
  263.              xvisc = xmat(2)
  264.          do ig = 1,epstf(/1)
  265.           sigf(ig) = sigf(ig) + (xvisc* (epstf(ig) - epst0(ig)) / xdt)
  266.          enddo
  267.             ENDIF
  268.         IF (mele.eq.45) THEN
  269.         ENDIF
  270.       ENDIF
  271.  
  272.  
  273.       IF (cmate.EQ.'IMPREUSS') THEN
  274.         xraid = xmat(1)
  275.         xvisc = xmat(2)
  276.         do ig = 1,epstf(/1)
  277.          xepe0 = var0(ig)
  278.  
  279.         if (xdt.ne.0) then
  280. *         xx = (epstf(ig) - epst0(ig) + xepe0) * xvisc / xdt
  281.          yy = (xraid + (xvisc /xdt))
  282.          xx = (xraid*epstf(ig)) + (xvisc*xepe0/xdt)
  283.          varf(ig) = xx / yy
  284.         else
  285.           varf(ig) = var0(ig)
  286.         endif
  287.          sigf(ig) = (epstf(ig)- varf(ig)) * xraid
  288.         enddo
  289. *      write(6,*) 'cmoda2 ',epstf(/1), epin0(/1),xepe0, epstf(1)
  290.       ENDIF
  291.  
  292.         if(ifomod.eq.6) then
  293.       IF (cmate.EQ.'IMPCOMPL') THEN
  294.         xraid = xmat(1)
  295.         xamo1 = xmat(3)
  296.         xmass1 = xmat(4)
  297.          omef = 2.*xpi*tempf
  298. *      write(6,*) 'ccompl', xraid,xamo1,xmass1,epstf(/1),sigf(/1)
  299.          do ig = 1,epstf(/1)
  300.           if (ig.eq.1) j2 = 2
  301.           if (ig.eq.2) j2 = 1
  302.           effx = epstf(ig)
  303.           sigf(ig) = xraid * epstf(ig)
  304.          if(xmass1.gt.0) then
  305.            sigf(1) = sigf(1) - (effx * xmass1 * omef * omef)
  306. *        write(6,*) sigf(1), effx, xmass1 , (omef*omef)
  307.          endif
  308.           if (ig.eq.2) sigf(ig) = sigf(ig)*(-1)
  309.           if (xamo1.ne.0.) sigf(ig) = sigf(ig) + xamo1*omef*epstf(j2)
  310.          enddo
  311. *          write(6,*) (epstf(ij),ij=1,2),(sigf(ij),ij=1,2)
  312.       ENDIF
  313.         endif
  314.  
  315.       RETURN
  316.       END
  317.  
  318.  
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  

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