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

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